ReadPat Subroutine

public subroutine ReadPat(FileRoot, PRTFile)

Reads a source beam pattern file (.sbp) based on FileRoot``. Reports status messages to the print/log file connected toPRTFile``.

Arguments

Type IntentOptional Attributes Name
character(len=80), intent(in) :: FileRoot

Source beampattern filename without .sbp extension
integer, intent(in) :: PRTFile

I/O Unit for print file

Calls

proc~~readpat~~CallsGraph proc~readpat ReadPat interface~monotonic monotonic proc~readpat->interface~monotonic proc~errout ERROUT proc~readpat->proc~errout proc~monotonic_dble monotonic_dble interface~monotonic->proc~monotonic_dble proc~monotonic_sngl monotonic_sngl interface~monotonic->proc~monotonic_sngl

Called by

proc~~readpat~~CalledByGraph proc~readpat ReadPat program~bellhop BELLHOP program~bellhop->proc~readpat program~bellhop3d BELLHOP3D program~bellhop3d->proc~readpat

Source Code

  SUBROUTINE ReadPat( FileRoot, PRTFile )
    !!    Reads a source beam pattern file (`.sbp`) based on `FileRoot``.
    !!    Reports status messages to the print/log file connected to `PRTFile``.

    IMPLICIT NONE

    ! Arguments
    CHARACTER (LEN=80), INTENT( IN ) :: FileRoot
        !! Source beampattern filename *without* `.sbp` extension
    INTEGER,            INTENT( IN ) :: PRTFile
        !! I/O Unit for print file

    ! Local variables
    INTEGER :: I, IAllocStat, IOStat

    IF ( SBPFlag == '*' ) THEN
       WRITE( PRTFile, * )
       WRITE( PRTFile, * ) '______________________________'
       WRITE( PRTFile, * ) 'Using source beam pattern file'

       OPEN( UNIT = SBPFile,   FILE = TRIM( FileRoot ) // '.sbp', STATUS = 'OLD', IOSTAT = IOStat, ACTION = 'READ' )
       IF ( IOstat /= 0 ) THEN
          WRITE( PRTFile, * ) 'SBPFile = ', TRIM( FileRoot ) // '.sbp'
          CALL ERROUT( 'BELLHOP-ReadPat', 'Unable to open source beampattern file' )
       END IF

       READ(  SBPFile, * ) NSBPPts
       WRITE( PRTFile, * ) 'Number of source beam pattern points', NSBPPts

       ALLOCATE( SrcBmPat( NSBPPts, 2 ), Stat = IAllocStat )
       IF ( IAllocStat /= 0 ) &
            CALL ERROUT( 'BELLHOP-ReadPat', 'Insufficient memory for source beam pattern data: reduce # SBP points' )

       WRITE( PRTFile, * )
       WRITE( PRTFile, * ) ' Angle (degrees)  Power (dB)'

       DO I = 1, NSBPPts
          READ(  SBPFile, * ) SrcBmPat( I, : )
          WRITE( PRTFile, FMT = "( 2G11.3 )" ) SrcBmPat( I, : )
       END DO

    ELSE   ! no pattern given, use omni source pattern
       NSBPPts = 2
       ALLOCATE( SrcBmPat( 2, 2 ), Stat = IAllocStat )
       IF ( IAllocStat /= 0 ) CALL ERROUT( 'BELLHOP-ReadPat', 'Insufficient memory'  )
       SrcBmPat( 1, : ) = [ -180.0, 0.0 ]
       SrcBmPat( 2, : ) = [  180.0, 0.0 ]
    ENDIF

    IF ( .NOT. monotonic( SrcBmPat( :, 1 ) , NSBPPts ) ) &
       CALL ERROUT( 'beampattern : ReadPat', 'Source beam-pattern angles are not monotonic' )

    SrcBmPat( :, 2 ) = 10 ** ( SrcBmPat( :, 2 ) / 20 )  ! convert dB to linear scale

  END SUBROUTINE ReadPat