ReadRunType Subroutine

public subroutine ReadRunType(RunType, PlotType)

Uses

  • proc~~readruntype~~UsesGraph proc~readruntype ReadRunType module~sourcereceiverpositions SourceReceiverPositions proc~readruntype->module~sourcereceiverpositions module~fatalerror FatalError module~sourcereceiverpositions->module~fatalerror module~monotonicmod monotonicMod module~sourcereceiverpositions->module~monotonicmod module~sortmod SortMod module~sourcereceiverpositions->module~sortmod module~subtabulate SubTabulate module~sourcereceiverpositions->module~subtabulate

Reads and validates the run type parameters

Arguments

Type IntentOptional Attributes Name
character(len=7), intent(out) :: RunType
character(len=10), intent(out) :: PlotType

Calls

proc~~readruntype~~CallsGraph proc~readruntype ReadRunType proc~errout ERROUT proc~readruntype->proc~errout

Called by

proc~~readruntype~~CalledByGraph proc~readruntype ReadRunType proc~readenvironment ReadEnvironment proc~readenvironment->proc~readruntype program~bellhop BELLHOP program~bellhop->proc~readenvironment program~bellhop3d BELLHOP3D program~bellhop3d->proc~readenvironment

Source Code

  SUBROUTINE ReadRunType( RunType, PlotType )
    !! Reads and validates the run type parameters

    ! Read the RunType variable and echo with explanatory information to the print file

    USE SourceReceiverPositions

    CHARACTER (LEN= 7), INTENT( OUT ) :: RunType
    CHARACTER (LEN=10), INTENT( OUT ) :: PlotType

    READ(  ENVFile, * ) RunType
    WRITE( PRTFile, * )

    SELECT CASE ( RunType( 1 : 1 ) )
    CASE ( 'R' )
       WRITE( PRTFile, * ) 'Ray trace run'
    CASE ( 'E' )
       WRITE( PRTFile, * ) 'Eigenray trace run'
    CASE ( 'I' )
       WRITE( PRTFile, * ) 'Incoherent TL calculation'
    CASE ( 'S' )
       WRITE( PRTFile, * ) 'Semi-coherent TL calculation'
    CASE ( 'C' )
       WRITE( PRTFile, * ) 'Coherent TL calculation'
    CASE ( 'A' )
       WRITE( PRTFile, * ) 'Arrivals calculation, ASCII  file output'
    CASE ( 'a' )
       WRITE( PRTFile, * ) 'Arrivals calculation, binary file output'
    CASE DEFAULT
       CALL ERROUT( 'READIN', 'Unknown RunType selected' )
    END SELECT

    SELECT CASE ( RunType( 2 : 2 ) )
    CASE ( 'C' )
       WRITE( PRTFile, * ) 'Cartesian beams'
    CASE ( 'R' )
       WRITE( PRTFile, * ) 'Ray centered beams'
    CASE ( 'S' )
       WRITE( PRTFile, * ) 'Simple gaussian beams'
    CASE ( 'b' )
       WRITE( PRTFile, * ) 'Geometric gaussian beams in ray-centered coordinates'
    CASE ( 'B' )
       WRITE( PRTFile, * ) 'Geometric gaussian beams in Cartesian coordinates'
    CASE ( 'g' )
       WRITE( PRTFile, * ) 'Geometric hat beams in ray-centered coordinates'
    CASE DEFAULT
       RunType( 2 : 2 ) = 'G'
       WRITE( PRTFile, * ) 'Geometric hat beams in Cartesian coordinates'
    END SELECT

    SELECT CASE ( RunType( 4 : 4 ) )
    CASE ( 'R' )
       WRITE( PRTFile, * ) 'Point source (cylindrical coordinates)'
    CASE ( 'X' )
       WRITE( PRTFile, * ) 'Line source (Cartesian coordinates)'
    CASE DEFAULT
       RunType( 4 : 4 ) = 'R'
       WRITE( PRTFile, * ) 'Point source (cylindrical coordinates)'
    END SELECT

    SELECT CASE ( RunType( 5 : 5 ) )
    CASE ( 'R' )
       WRITE( PRTFile, * ) 'Rectilinear receiver grid: Receivers at ( Rr( ir ), Rz( ir ) ) )'
       PlotType = 'rectilin  '
    CASE ( 'I' )
       WRITE( PRTFile, * ) 'Irregular grid: Receivers at Rr( : ) x Rz( : )'
       IF ( Pos%NRz /= Pos%NRr ) CALL ERROUT( 'READIN', 'Irregular grid option selected with NRz not equal to Nr' )
       PlotType = 'irregular '
    CASE DEFAULT
       WRITE( PRTFile, * ) 'Rectilinear receiver grid: Receivers at Rr( : ) x Rz( : )'
       RunType( 5 : 5 ) = 'R'
       PlotType = 'rectilin  '
    END SELECT

    SELECT CASE ( RunType( 6 : 6 ) )
    CASE ( '2' )
       WRITE( PRTFile, * ) 'N x 2D calculation (neglects horizontal refraction)'
    CASE ( '3' )
       WRITE( PRTFile, * ) '3D calculation'
    CASE DEFAULT
       RunType( 6 : 6 ) = '2'
    END SELECT

  END SUBROUTINE ReadRunType