      SUBROUTINE INTERP(X,Y,Z,XA,YA,ZA,IDVOUT,MXTAB,NTAB)
      IMPLICIT NONE
C Arguments:
      INTEGER IDVOUT,MXTAB,NTAB
      REAL X,Y,Z
      REAL XA(MXTAB),YA(MXTAB),ZA(MXTAB)
C Local variables:
      INTEGER I1,I2,I3,I4,INC
      REAL SGN,X1,X2,X3,X4,Y1,Y2,Y3,Y4
C***********************************************************************
C Given array of tabulated values XA(1-NTAB), YA(1-NTAB), ZA(1-NTAB),
C and given independent variable X, this routine interpolates for two
C dependent variables: Y and Z.
C Uses only parabolic interpolation for safety.
C When called with X outside range of tabulated values XA, returns
C extrapolated values Y and Z but issues warning statement.
C Note: XA values must be either monotonically increasing OR
C       monotonically decreasing.
C B.T.Draine, Princeton Univ. Observatory
C 89/12/19 (BTD): Revised.
C 91/05/02 (BTD): Added IDVOUT to argument list.
C                 Changed WRITE(0 -> WRITE(IDVOUT
C 92/03/24 (BTD): Added test IF(I2.GE.NTAB) in case INTERP is used for
C                 data sets with different lengths.
C
C Copyright (C) 1993, B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
      DATA I2/1/
      IF(I2.GE.NTAB)I2=NTAB-1
      INC=0
      SGN=1.
C*** Check whether X is increasing or decreasing:
      IF(XA(1).GE.XA(NTAB))SGN=-1.
C*** Check whether outside table limits
      IF((SGN*(X-XA(1))).LT.0.)THEN
         I2=2
         WRITE(IDVOUT,6990)X
         GOTO 4600
      ENDIF
      IF(SGN*(X-XA(NTAB)).GT.0.)THEN
         I2=NTAB-1
         WRITE(IDVOUT,6990)X
         GOTO 4600
      ENDIF
C*** X is within table limits.  Find I2
 1000 IF(SGN*(XA(I2)-X))2000,3000,4000
 2000 IF(INC)2100,2200,2200
 2100 IF(I2+2-NTAB)4700,4700,2500
 2200 INC=1
      I2=I2+1
      IF(I2+1.LE.NTAB)GO TO 1000
 2500 I2=NTAB-1
      GO TO 4600
 3000 Y=YA(I2)
      Z=ZA(I2)
      RETURN
 4000 IF(INC)4200,4200,4100
 4100 I2=I2-1
      IF(I2-2)4500,4700,4700
 4200 INC=-1
      I2=I2-1
      IF(I2.GE.2)GOTO 1000
 4500 I2=2
 4600 I1=I2-1
      I3=I2+1
      X1=XA(I1)
      X2=XA(I2)
      X3=XA(I3)
      Y1=YA(I1)
      Y2=YA(I2)
      Y3=YA(I3)
      CALL PARAB3(X,Y,X1,X2,X3,Y1,Y2,Y3)
      Y1=ZA(I1)
      Y2=ZA(I2)
      Y3=ZA(I3)
      CALL PARAB3(X,Z,X1,X2,X3,Y1,Y2,Y3)
      RETURN
 4700 I1=I2-1
      I3=I2+1
      I4=I2+2
      X1=XA(I1)
      X2=XA(I2)
      X3=XA(I3)
      X4=XA(I4)
      Y1=YA(I1)
      Y2=YA(I2)
      Y3=YA(I3)
      Y4=YA(I4)
      CALL PARAB4(X,Y,X1,X2,X3,X4,Y1,Y2,Y3,Y4)
      Y1=ZA(I1)
      Y2=ZA(I2)
      Y3=ZA(I3)
      Y4=ZA(I4)
      CALL PARAB4(X,Z,X1,X2,X3,X4,Y1,Y2,Y3,Y4)
      RETURN
 6990 FORMAT('Warning from INTERP: outside table limits for X=',1PE12.5)
      END

      SUBROUTINE PARAB3(X,Y,X1,X2,X3,Y1,Y2,Y3)
      REAL A,B,X,X1,X2,X3,Y,Y1,Y2,Y3
C***********************************************************************
C Subroutine PARAB3 does parabolic interpolation, with parabola
C constrained to fit (x1,y1),(x2,y2),(x3,y3) exactly.
C B.T.Draine, Institute for Advanced Study, March 1980.
C
C Copyright (C) 1993, B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
C***********************************************************************
      A=(Y3-Y2-(X3-X2)*(Y1-Y2)/(X1-X2))/((X3-X2)*(X3-X1))
      B=(Y1-Y2)/(X1-X2)-A*(X1-X2)
      Y=(A*(X-X2)+B)*(X-X2)+Y2
      RETURN
      END

      SUBROUTINE PARAB4(X,Y,X1,X2,X3,X4,Y1,Y2,Y3,Y4)
      REAL A,B,X,X1,X2,X3,X4,Y,Y1,Y2,Y3,Y4
C***********************************************************************
C Subroutine PARAB4 is designed to do parabolic interpolation, with
C parabola constrained to match (x2,y2) and (x3,y3) exactly, and to
C minimize sum of squared deviations from (x1,y1) and (x4,y4).
C It is assumed that x1.lt.x2.le.x.lt.x3.lt.x4
C Fit parabola Y=A*(X-X2)**2+B*(X-X2)+Y2
C B.T.Draine, Institute for Advanced Study, March 1980.
C
C Copyright (C) 1993, B.T. Draine and P.J. Flatau
C This code is covered by the GNU General Public License.
***********************************************************************
      A=((X1-X2)*(Y3-Y2)/(X3-X2)+Y2-Y1)*(X1-X2)*(X1-X3)
     &  +((X4-X2)*(Y3-Y2)/(X3-X2)+Y2-Y4)*(X4-X2)*(X4-X3)
      A=-A/(((X1-X2)*(X1-X3))**2+((X4-X2)*(X4-X3))**2)
      B=(Y3-Y2)/(X3-X2)-A*(X3-X2)
      Y=(A*(X-X2)+B)*(X-X2)+Y2
      RETURN
      END
