SUBROUTINE ReadReflectionCoefficient( FileRoot, BotRC, TopRC, PRTFile )
! Optionally read in reflection coefficient for Top or Bottom boundary
USE MathConstants
IMPLICIT NONE
INTEGER, INTENT( IN ) :: PRTFile ! unit number for print file
CHARACTER (LEN=1 ), INTENT( IN ) :: BotRC, TopRC ! flag set to 'F' if refl. coef. is to be read from a File
CHARACTER (LEN=80), INTENT( IN ) :: FileRoot
INTEGER :: itheta, ik, IOStat, iAllocStat
REAL ( KIND = 8 ) :: freq
CHARACTER (LEN=80) :: Title2
IF ( BotRC == 'F' ) THEN
WRITE( PRTFile, * ) '__________________________________________________________________________'
WRITE( PRTFile, * )
WRITE( PRTFile, * ) 'Using tabulated bottom reflection coef.'
OPEN( FilE = TRIM( FileRoot ) // '.brc', UNIT = BRCFile, STATUS = 'OLD', IOSTAT = IOStat, ACTION = 'READ' )
IF ( IOStat /= 0 ) THEN
WRITE( PRTFile, * ) 'BRCFile = ', TRIM( FileRoot ) // '.brc'
CALL ERROUT( 'ReadReflectionCoefficient', 'Unable to open Bottom Reflection Coefficient file' )
END IF
READ( BRCFile, * ) NBotPts
WRITE( PRTFile, * ) 'Number of points in bottom reflection coefficient = ', NBotPts
IF ( ALLOCATED( RBot ) ) DEALLOCATE( RBot )
ALLOCATE( RBot( NBotPts ), Stat = IAllocStat )
IF ( IAllocStat /= 0 ) &
CALL ERROUT( 'ReadReflectionCoefficient', 'Insufficient memory for bot. refl. coef.: reduce # points' )
READ( BRCFile, * ) ( RBot( itheta ), itheta = 1, NBotPts )
IF ( .NOT. monotonic( RBot( : )%theta, NBotPts ) ) THEN
CALL ERROUT( 'ReadReflectionCoefficient', 'Bottom reflection coefficients must be monotonically increasing' )
END IF
CLOSE( BRCFile )
RBot%phi = DegRad * RBot%phi ! convert to radians
ELSE ! should allocate something anyway, since variable is passed
IF ( ALLOCATED( RBot ) ) DEALLOCATE( RBot )
ALLOCATE( RBot( 1 ), Stat = IAllocStat )
ENDIF
! Optionally read in top reflection coefficient
IF ( TopRC == 'F' ) THEN
WRITE( PRTFile, * ) '__________________________________________________________________________'
WRITE( PRTFile, * )
WRITE( PRTFile, * ) 'Using tabulated top reflection coef.'
OPEN( FILE = TRIM( FileRoot ) // '.trc', UNIT = TRCFile, STATUS = 'OLD', IOSTAT = IOStat, ACTION = 'READ' )
IF ( IOStat /= 0 ) THEN
WRITE( PRTFile, * ) 'TRCFile = ', TRIM( FileRoot ) // '.trc'
CALL ERROUT( 'ReadReflectionCoefficient', 'Unable to open Top Reflection Coefficient file' )
END IF
READ( TRCFile, * ) NTopPts
WRITE( PRTFile, * ) 'Number of points in top reflection coefficient = ', NTopPts
IF ( ALLOCATED( RTop ) ) DEALLOCATE( RTop )
ALLOCATE( RTop( NTopPts ), Stat = IAllocStat )
IF ( iAllocStat /= 0 ) &
CALL ERROUT( 'ReadReflectionCoefficient', 'Insufficient memory for top refl. coef.: reduce # points' )
READ( TRCFile, * ) ( RTop( itheta ), itheta = 1, NTopPts )
IF ( .NOT. monotonic( RTop( : )%theta, NTopPts ) ) THEN
CALL ERROUT( 'ReadReflectionCoefficient', 'Top reflection coefficients must be monotonically increasing' )
END IF
CLOSE( TRCFile )
RTop%phi = DegRad * RTop%phi ! convert to radians
ELSE ! should allocate something anyway, since variable is passed
IF ( ALLOCATED( RTop ) ) DEALLOCATE( RTop )
ALLOCATE( RTop( 1 ), Stat = iAllocStat )
ENDIF
! Optionally read in internal reflection coefficient data
IF ( BotRC == 'P' ) THEN
WRITE( PRTFile, * ) 'Reading precalculated refl. coeff. table'
OPEN( FILE = TRIM( FileRoot ) // '.irc', UNIT = IRCFile, STATUS = 'OLD', IOSTAT = IOStat, ACTION = 'READ' )
IF ( IOStat /= 0 ) CALL ERROUT( 'ReadReflectionCoefficient', &
'Unable to open Internal Reflection Coefficient file' )
READ( IRCFile, * ) Title2, freq
READ( IRCFile, * ) NkTab
WRITE( PRTFile, * )
WRITE( PRTFile, * ) 'Number of points in internal reflection coefficient = ', NkTab
IF ( ALLOCATED( xTab ) ) DEALLOCATE( xTab, fTab, gTab, iTab )
ALLOCATE( xTab( NkTab ), fTab( NkTab ), gTab( NkTab ), iTab( NkTab ), Stat = iAllocStat )
IF ( iAllocStat /= 0 ) CALL ERROUT( 'ReadReflectionCoefficient', 'Too many points in reflection coefficient' )
READ( IRCFile, FMT = "( 5G15.7, I5 )" ) ( xTab( ik ), fTab( ik ), gTab( ik ), iTab( ik ), ik = 1, NkTab )
CLOSE( IRCFile )
ENDIF
END SUBROUTINE ReadReflectionCoefficient
