Reads in the bottom bathymetry
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=80), | intent(in) | :: | FileRoot | |||
character(len=1), | intent(in) | :: | BotBTY | |||
real(kind=8), | intent(in) | :: | DepthB | |||
integer, | intent(in) | :: | PRTFile |
SUBROUTINE ReadBTY3D( FileRoot, BotBTY, DepthB, PRTFile ) !! Reads in the bottom bathymetry CHARACTER (LEN= 1), INTENT( IN ) :: BotBTY ! Set to '~' if bathymetry is not flat INTEGER, INTENT( IN ) :: PRTFile ! unit number for print file REAL (KIND=8), INTENT( IN ) :: DepthB ! Nominal bottom depth CHARACTER (LEN=80), INTENT( IN ) :: FileRoot REAL (KIND=8), ALLOCATABLE :: Temp( : ) REAL (KIND=8), ALLOCATABLE :: BotGlobalx( : ), BotGlobaly( : ) SELECT CASE ( BotBTY ) CASE ( '~', '*' ) WRITE( PRTFile, * ) '__________________________________________________________________________' WRITE( PRTFile, * ) WRITE( PRTFile, * ) 'Using bottom-bathymetry file' OPEN( UNIT = BTYFile, FILE = TRIM( FileRoot ) // '.bty', STATUS = 'OLD', IOSTAT = IOStat, ACTION = 'READ' ) IF ( IOStat /= 0 ) THEN WRITE( PRTFile, * ) 'BTYFile = ', TRIM( FileRoot ) // '.bty' CALL ERROUT( 'ReadBTY3D', 'Unable to open bathymetry file' ) END IF READ( BTYFile, * ) btyType SELECT CASE ( btyType ) CASE ( 'R' ) WRITE( PRTFile, * ) 'Regular grid for a 3D run' CASE ( 'C' ) WRITE( PRTFile, * ) 'Regular grid for a 3D run (curvilinear)' CASE DEFAULT CALL ERROUT( 'ReadBTY3D', 'Unknown option for selecting bathymetry interpolation' ) END SELECT ! x values READ( BTYFile, * ) NbtyPts( 1 ) WRITE( PRTFile, * ) WRITE( PRTFile, * ) 'Number of bathymetry points in x', NbtyPts( 1 ) ALLOCATE( BotGlobalx( MAX( NbtyPts( 1 ), 3 ) ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) & CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Insufficient memory for bathymetry data: reduce # bty points' ) BotGlobalx( 3 ) = -999.9 READ( BTYFile, * ) BotGlobalx( 1 : NbtyPts( 1 ) ) CALL SubTab( BotGlobalx, NbtyPts( 1 ) ) WRITE( PRTFile, "( 5G14.6 )" ) ( BotGlobalx( ix ), ix = 1, MIN( NbtyPts( 1 ), Number_to_Echo ) ) IF ( NbtyPts( 1 ) > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', BotGlobalx( NbtyPts( 1 ) ) IF ( .NOT. monotonic( BotGlobalx, NbtyPts( 1 ) ) ) THEN CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Bathymetry X values are not monotonically increasing' ) END IF ! y values READ( BTYFile, * ) NbtyPts( 2 ) WRITE( PRTFile, * ) WRITE( PRTFile, * ) 'Number of bathymetry points in y', NbtyPts( 2 ) ALLOCATE( BotGlobaly( MAX( NbtyPts( 2 ), 3 ) ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) & CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Insufficient memory for bathymetry data: reduce # bty points' ) BotGlobaly( 3 ) = -999.9 READ( BTYFile, * ) BotGlobaly( 1 : NbtyPts( 2 ) ) CALL SubTab( BotGlobaly, NbtyPts( 2 ) ) WRITE( PRTFile, "( 5G14.6 )" ) ( BotGlobaly( iy ), iy = 1, MIN( NbtyPts( 2 ), Number_to_Echo ) ) IF ( NbtyPts( 2 ) > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', BotGlobaly( NbtyPts( 2 ) ) IF ( .NOT. monotonic( BotGlobaly, NbtyPts( 2 ) ) ) THEN CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Bathymetry Y values are not monotonically increasing' ) END IF BotGlobalx = 1000. * BotGlobalx ! convert km to m BotGlobaly = 1000. * BotGlobaly ! z values ALLOCATE( Bot( NbtyPts( 1 ), NbtyPts( 2 ) ), Temp( NbtyPts( 1 ) ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) & CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Insufficient memory for bathymetry data: reduce # bty points' ) WRITE( PRTFile, * ) DO iy = 1, NbtyPts( 2 ) READ( BTYFile, * ) Bot( :, iy )%x( 3 ) ! read a row of depths ! IF ( iy < Number_to_Echo .OR. iy == NbtyPts( 2 ) ) THEN ! echo some values ! WRITE( PRTFile, FMT = "(G11.3)" ) Bot( :, iy )%x( 3 ) ! END IF ! IF ( ANY( Bot( :, iy )%x( 3 ) > DepthB ) ) THEN ! CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Bathymetry drops below lowest point in the sound speed profile' ) ! END IF END DO CLOSE( BTYFile ) IF ( ANY( ISNAN( Bot( :, : )%x( 3 ) ) ) ) THEN WRITE( PRTFile, * ) 'Warning in BELLHOP3D - ReadBTY3D : The bathymetry file contains a NaN' END IF DO ix = 1, NbtyPts( 1 ) DO iy = 1, NbtyPts( 2 ) Bot( ix, iy )%x( 1 ) = BotGlobalx( ix ) Bot( ix, iy )%x( 2 ) = BotGlobaly( iy ) END DO END DO DEALLOCATE( BotGlobalx ) DEALLOCATE( BotGlobaly ) CALL ComputeBdryTangentNormal( Bot, 'Bot' ) CASE DEFAULT ! no bathymetry given, use SSP depth for flat bottom btyType = 'R' NbtyPts = [ 2, 2 ] ALLOCATE( Bot( 2, 2 ), Stat = IAllocStat ) IF ( IAllocStat /= 0 ) CALL ERROUT( 'BELLHOP3D:ReadBTY3D', 'Insufficient memory' ) Bot( 1, 1 )%x = [ -big, -big, DepthB ] Bot( 1, 2 )%x = [ -big, big, DepthB ] Bot( 2, 1 )%x = [ big, -big, DepthB ] Bot( 2, 2 )%x = [ big, big, DepthB ] Bot( 1, 1 )%t = [ 1.0, 0.0, 0.0 ] ! tangent to bottom Bot( 1, 1 )%n1 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 1, 1 )%n2 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 1, 2 )%t = [ 1.0, 0.0, 0.0 ] ! tangent to bottom Bot( 1, 2 )%n1 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 1, 2 )%n2 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 2, 1 )%t = [ 1.0, 0.0, 0.0 ] ! tangent to bottom Bot( 2, 1 )%n1 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 2, 1 )%n2 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 2, 2 )%t = [ 1.0, 0.0, 0.0 ] ! tangent to bottom Bot( 2, 2 )%n1 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal Bot( 2, 2 )%n2 = [ 0.0, 0.0, 1.0 ] ! outward-pointing normal END SELECT ! dummy BotSeg info to force GetBotSeg to search for the active segment on first call xBotSeg = [ +big, -big ] yBotSeg = [ +big, -big ] END SUBROUTINE ReadBTY3D