C @(#)poly3d.for 17.1.1.1 (ES0-DMD) 01/25/02 17:10:52 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Corresponding concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C SUBROUTINE POLY3D(X,NP,PARAM,Y1,DERIV) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 18:01 - 21 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C C-------------------------------------------------------------- C********************************************* C C IMPLICIT NONE C FIT WITH A THREE-DIMENSIONAL POLYNOMIAL C C********************************************* C C Author: O.-G. Richter, ESO Garching C INTEGER I,J,K,L,NP,MAX REAL X(3),A DOUBLE PRECISION Y1,PARAM(NP),DERIV(NP) C PARAMETER (MAX=4) DOUBLE PRECISION B(MAX,MAX,MAX),C(MAX*MAX*MAX) C A = 1.0D0 DO 10 I = 1,MAX B(1,1,I) = A A = A*X(1) 10 CONTINUE DO 30 I = 2,MAX DO 20 J = 1,MAX B(1,I,J) = B(1,I-1,J)*X(2) 20 CONTINUE 30 CONTINUE DO 60 I = 2,MAX DO 50 J = 1,MAX DO 40 K = 1,MAX B(I,J,K) = B(I-1,J,K)*X(3) 40 CONTINUE 50 CONTINUE 60 CONTINUE L = 0 DO 90 I = 1,MAX DO 80 J = 1,I DO 70 K = 1,J L = L + 1 C(L) = B(K,J-K+1,I-J+1) 70 CONTINUE 80 CONTINUE 90 CONTINUE Y1 = 0.0D0 DO 100 I = 1,NP DERIV(I) = C(I) Y1 = Y1 + C(I)*PARAM(I) 100 CONTINUE RETURN END