OpenOutputFiles Subroutine

public subroutine OpenOutputFiles(FileRoot, ThreeD)

Uses

  • proc~~openoutputfiles~~UsesGraph proc~openoutputfiles OpenOutputFiles module~anglemod anglemod proc~openoutputfiles->module~anglemod module~bdrymod bdrymod proc~openoutputfiles->module~bdrymod module~rwshdfile RWSHDFile proc~openoutputfiles->module~rwshdfile module~sourcereceiverpositions SourceReceiverPositions proc~openoutputfiles->module~sourcereceiverpositions module~anglemod->module~sourcereceiverpositions module~fatalerror FatalError module~anglemod->module~fatalerror module~mathconstants MathConstants module~anglemod->module~mathconstants module~sortmod SortMod module~anglemod->module~sortmod module~subtabulate SubTabulate module~anglemod->module~subtabulate module~bdrymod->module~fatalerror module~monotonicmod monotonicMod module~bdrymod->module~monotonicmod module~rwshdfile->module~sourcereceiverpositions module~rwshdfile->module~fatalerror module~sourcereceiverpositions->module~fatalerror module~sourcereceiverpositions->module~monotonicmod module~sourcereceiverpositions->module~sortmod module~sourcereceiverpositions->module~subtabulate

Opens output files based on run type

Arguments

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

Calls

proc~~openoutputfiles~~CallsGraph proc~openoutputfiles OpenOutputFiles proc~writeheader WriteHeader proc~openoutputfiles->proc~writeheader sngl sngl proc~openoutputfiles->sngl

Called by

proc~~openoutputfiles~~CalledByGraph proc~openoutputfiles OpenOutputFiles program~bellhop BELLHOP program~bellhop->proc~openoutputfiles program~bellhop3d BELLHOP3D program~bellhop3d->proc~openoutputfiles

Source Code

  SUBROUTINE OpenOutputFiles( FileRoot, ThreeD )
    !! Opens output files based on run type

    ! Write appropriate header information

    USE SourceReceiverPositions
    USE angleMod
    USE bdryMod
    USE RWSHDFile

    LOGICAL,            INTENT( IN ) :: ThreeD
    CHARACTER (LEN=80), INTENT( IN ) :: FileRoot
    REAL               :: atten
    CHARACTER (LEN=10) :: PlotType

    SELECT CASE ( Beam%RunType( 1 : 1 ) )
    CASE ( 'R', 'E' )   ! Ray trace or Eigenrays
       OPEN ( FILE = TRIM( FileRoot ) // '.ray', UNIT = RAYFile, FORM = 'FORMATTED' )
       WRITE( RAYFile, * ) '''', Title( 1 : 50 ), ''''
       WRITE( RAYFile, * ) freq
       WRITE( RAYFile, * ) Pos%NSx, Pos%NSy, Pos%NSz
       WRITE( RAYFile, * ) Angles%Nalpha, Angles%Nbeta
       WRITE( RAYFile, * ) Bdry%Top%HS%Depth
       WRITE( RAYFile, * ) Bdry%Bot%HS%Depth

       IF ( ThreeD ) THEN
          WRITE( RAYFile, * ) '''xyz'''
       ELSE
          WRITE( RAYFile, * ) '''rz'''
       END IF

    CASE ( 'A' )        ! arrival file in ascii format
       OPEN ( FILE = TRIM( FileRoot ) // '.arr', UNIT = ARRFile, FORM = 'FORMATTED' )

       IF ( ThreeD ) THEN
          WRITE( ARRFile, * ) '''3D'''
       ELSE
          WRITE( ARRFile, * ) '''2D'''
       END IF

       WRITE( ARRFile, * ) freq

       ! write source locations

       IF ( ThreeD ) THEN
          WRITE( ARRFile, * ) Pos%NSx,    Pos%Sx(    1 : Pos%NSx )
          WRITE( ARRFile, * ) Pos%NSy,    Pos%Sy(    1 : Pos%NSy )
          WRITE( ARRFile, * ) Pos%NSz,    Pos%Sz(    1 : Pos%NSz )
       ELSE
          WRITE( ARRFile, * ) Pos%NSz,    Pos%Sz(    1 : Pos%NSz )
       END IF

       ! write receiver locations

       WRITE( ARRFile, *    ) Pos%NRz,    Pos%Rz(    1 : Pos%NRz )
       WRITE( ARRFile, *    ) Pos%NRr,    Pos%Rr(    1 : Pos%NRr )
       IF ( ThreeD ) THEN
          WRITE( ARRFile, * ) Pos%Ntheta, Pos%theta( 1 : Pos%Ntheta )
       END IF

    CASE ( 'a' )        ! arrival file in binary format
       OPEN ( FILE = TRIM( FileRoot ) // '.arr', UNIT = ARRFile, FORM = 'UNFORMATTED' )

       IF ( ThreeD ) THEN
          WRITE( ARRFile ) '''3D'''
       ELSE
          WRITE( ARRFile ) '''2D'''
       END IF

       WRITE( ARRFile    ) SNGL( freq )

       ! write source locations

       IF ( ThreeD ) THEN
          WRITE( ARRFile    ) Pos%NSx,    Pos%Sx(    1 : Pos%NSx )
          WRITE( ARRFile    ) Pos%NSy,    Pos%Sy(    1 : Pos%NSy )
          WRITE( ARRFile    ) Pos%NSz,    Pos%Sz(    1 : Pos%NSz )
       ELSE
          WRITE( ARRFile    ) Pos%NSz,    Pos%Sz(    1 : Pos%NSz )
       END IF

       ! write receiver locations

       WRITE( ARRFile       ) Pos%NRz,    Pos%Rz(    1 : Pos%NRz )
       WRITE( ARRFile       ) Pos%NRr,    Pos%Rr(    1 : Pos%NRr )
       IF ( ThreeD ) THEN
          WRITE( ARRFile    ) Pos%Ntheta, Pos%theta( 1 : Pos%Ntheta )
       END IF

    CASE DEFAULT
       atten = 0.0

       ! following to set PlotType has already been done in READIN if that was used for input
       SELECT CASE ( Beam%RunType( 5 : 5 ) )
       CASE ( 'R' )
          PlotType = 'rectilin  '
       CASE ( 'I' )
          PlotType = 'irregular '
       CASE DEFAULT
          PlotType = 'rectilin  '
       END SELECT

       CALL WriteHeader( TRIM( FileRoot ) // '.shd', Title, REAL( freq ), atten, PlotType )
    END SELECT

  END SUBROUTINE OpenOutputFiles