      SUBROUTINE IRCINT( X, F, G, IPOW, XTAB, FTAB, GTAB, ITAB, NKPTS )

C     Internal reflection coefficient interpolator

C     Returns F,G,IPOW for given X using tabulated values

C     Uses polynomial interpolation using the two nearest abscissas

      PARAMETER ( MAXN = 10 )

      IMPLICIT REAL*8 (A-H, O-Z)

      INTEGER ITAB(*)
      REAL*8 XTAB(*)
      COMPLEX*16 FTAB(*), GTAB(*), XT(MAXN), FT(MAXN), GT(MAXN),
     &   PZ, X, F, G

      TEN = 10.0
      XR = DBLE( X )
      ILEFT = 1
      IRIGHT = NKPTS

C     Three cases: X left, in, or right of tabulated interval

      IF ( XR .LT. XTAB( ILEFT ) ) THEN
         F    = FTAB( ILEFT )
         G    = GTAB( ILEFT )
         IPOW = ITAB( ILEFT )
      ELSE IF( XR .GT. XTAB( IRIGHT ) ) THEN
         F    = FTAB( IRIGHT )
         G    = GTAB( IRIGHT )
         IPOW = ITAB( IRIGHT )
      ELSE 

C        Search for bracketting abscissas:
C        Log base 2 (NPTS) stabs required for a bracket

C        ------ DO WHILE ...
 1000    IF ( ILEFT .NE. IRIGHT-1 ) THEN
            IMID = ( ILEFT + IRIGHT )/2
            IF ( XTAB( IMID ) .GT. XR ) THEN
               IRIGHT = IMID
            ELSE
               ILEFT = IMID
            ENDIF
         GOTO 1000
         ENDIF

C        Extract the subset for interpolation and scale

         N = 3
         ILEFT = MAX( ILEFT - (N-2)/2, 1 )
         IRIGHT = MIN( IRIGHT + (N-1)/2, NKPTS )

         N = IRIGHT - ILEFT + 1
         DO 2000 I = 1, N
            J = I + ILEFT-1
            IDEL = ITAB( J ) - ITAB( ILEFT )
            XT( I ) = XTAB( J )
            FT( I ) = FTAB( J )*TEN**IDEL
            GT( I ) = GTAB( J )*TEN**IDEL
 2000    CONTINUE

C        Construct the interpolate

         F    = PZ( X, XT, FT, N )
         G    = PZ( X, XT, GT, N )
         IPOW = ITAB( ILEFT )
      ENDIF

      RETURN
      END
