InterpolateIRC Subroutine

public subroutine InterpolateIRC(x, f, g, iPower, xTab, fTab, gTab, iTab, NkTab)

Uses

  • proc~~interpolateirc~~UsesGraph proc~interpolateirc InterpolateIRC module~polymod PolyMod proc~interpolateirc->module~polymod

Arguments

Type IntentOptional Attributes Name
complex(kind=8), intent(in) :: x
complex(kind=8), intent(out) :: f
complex(kind=8), intent(out) :: g
integer, intent(out) :: iPower
real(kind=8), intent(in) :: xTab(NkTab)
complex(kind=8), intent(in) :: fTab(NkTab)
complex(kind=8), intent(in) :: gTab(NkTab)
integer, intent(in) :: iTab(NkTab)
integer, intent(in) :: NkTab

Calls

proc~~interpolateirc~~CallsGraph proc~interpolateirc InterpolateIRC interface~poly Poly proc~interpolateirc->interface~poly proc~polyc PolyC interface~poly->proc~polyc proc~polyr PolyR interface~poly->proc~polyr proc~polyz PolyZ interface~poly->proc~polyz

Source Code

  SUBROUTINE InterpolateIRC( x, f, g, iPower, xTab, fTab, gTab, iTab, NkTab )

    ! Internal reflection coefficient interpolator.
    ! Returns f, g, iPower for given x using tabulated values.
    ! Uses polynomial interpolation to approximate the function between the tabulated values

    USE PolyMod
    IMPLICIT NONE

    INTEGER, PARAMETER :: N = 3                    ! order of the polynomial for interpolation
    INTEGER,            INTENT( IN  ) :: NkTab, iTab( NkTab )
    REAL    ( KIND=8 ), INTENT( IN  ) :: xTab( NkTab )
    COMPLEX ( KIND=8 ), INTENT( IN  ) :: fTab( NkTab ), gTab( NkTab ), x
    INTEGER,            INTENT( OUT ) :: iPower
    COMPLEX ( KIND=8 ), INTENT( OUT ) :: f, g
    INTEGER            :: i, j, iDel, iLeft, iMid, iRight, NAct
    REAL    ( KIND=8 ) :: xReal
    COMPLEX ( KIND=8 ) :: xT( N ), fT( N ), gT( N )

    xReal  = DBLE( x )        ! taking the real part
    iLeft  = 1
    iRight = NkTab

    ! Three cases: x left, in, or right of tabulated interval

    IF (     xReal < xTab( iLeft  ) ) THEN
       f      = fTab( iLeft  )
       g      = gTab( iLeft  )
       iPower = iTab( iLeft  )
    ELSE IF( xReal > xTab( iRight ) ) THEN
       f      = fTab( iRight )
       g      = gTab( iRight )
       iPower = iTab( iRight )
    ELSE

       ! Search for bracketing abscissas:
       ! Log base 2 (NPts) stabs required for a bracket

       DO WHILE ( iLeft /= iRight-1 )
          iMid = ( iLeft + iRight )/2
          IF ( xTab( iMid ) > xReal ) THEN
             iRight = iMid
          ELSE
             iLeft  = iMid
          ENDIF
       END DO

       ! Extract the subset for interpolation and scale

       iLeft  = MAX( iLeft  - ( N - 2 ) / 2, 1     )
       iRight = MiN( iRight + ( N - 1 ) / 2, NkTab )

       NAct = iRight - iLeft + 1
       DO i = 1, NAct
          j       = i + iLeft - 1
          iDel    = iTab( j ) - iTab( iLeft )
          xT( i ) = xTab( j )
          fT( i ) = fTab( j ) * 10.0D0 ** iDel
          gT( i ) = gTab( j ) * 10.0D0 ** iDel
       END DO

       ! Construct the interpolate

       f      = Poly( x, xT, fT, NAct )
       g      = Poly( x, xT, gT, NAct )
       iPower = iTab( iLeft )
    ENDIF

  END SUBROUTINE InterpolateIRC