C @(#)alint.for 17.1.1.1 (ES0-DMD) 01/25/02 17:11:36 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 REAL FUNCTION ALINT(X,Y,N,ARG,N1,N2) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.PURPOSE: linear interpolation over a range in values C.VERSION: 910115 RHW IMPLICIT NONE added C------------------------------------------------------------------- IMPLICIT NONE INTEGER N REAL X(N) REAL Y(N) REAL ARG INTEGER N1 INTEGER N2 C INTEGER I, I0, I1 DOUBLE PRECISION DX0,DX1,DY0,DY1 DOUBLE PRECISION DARG C C *** Select effective interval DO 10 I = N1,N2 I1 = I IF (X(I1).GT.ARG) THEN GOTO 2 ENDIF 10 CONTINUE C 2 CONTINUE IF (I1.EQ.N1) THEN I1 = I1 + 1 ENDIF C C 2 CONTINUE I0 = I1 - 1 DX0 = X(I0) DX1 = X(I1) DY0 = Y(I0) DY1 = Y(I1) DARG = ARG ALINT = DY0+(DY1-DY0)*(DARG-DX0)/(DX1-DX0) RETURN END REAL FUNCTION AITKEN(X,Y,N,ARG,N1,N2,IDEG) C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.PURPOSE: Polynomial interpolation C.VERSION: 910115 RHW IMPLICIT NONE added C------------------------------------------------------------------- IMPLICIT NONE INTEGER N REAL X(N) REAL Y(N) REAL ARG INTEGER N1 INTEGER N2 INTEGER IDEG C INTEGER I, ID, IP INTEGER J INTEGER K INTEGER NE, NS C DOUBLE PRECISION DA DOUBLE PRECISION DX(10),DY(10) C DA = ARG DO 10 I = N1,N2-1 IP = I + 1 IF (ARG.GE.X(I).AND.ARG.LT.X(IP)) THEN GOTO 2 ENDIF 10 CONTINUE C 2 NS = MAX(N1,IP-IDEG+1) NE = NS + IDEG IF (NE.LE.N2) THEN GOTO 3 ENDIF NE = N2 NS = NE - IDEG C 3 ID = 0 DO 20 K = NS,NE ID = ID + 1 DX(ID) = X(K) DY(ID) = Y(K) 20 CONTINUE C DO 30 I = 1,ID DO 40 J = I,ID DY(J+1) = DY(I) + (DA-DX(I))*(DY(J+1)-DY(I))/(DX(J+1)-DX(I)) 40 CONTINUE 30 CONTINUE AITKEN = DY(ID+1) RETURN END