ReadRayBearingAngles Subroutine

public subroutine ReadRayBearingAngles(freq, TopOpt, RunType)

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: freq
character(len=6), intent(in) :: TopOpt
character(len=6), intent(in) :: RunType

Calls

proc~~readraybearingangles~~CallsGraph proc~readraybearingangles ReadRayBearingAngles interface~sort Sort proc~readraybearingangles->interface~sort interface~subtab SubTab proc~readraybearingangles->interface~subtab proc~errout ERROUT proc~readraybearingangles->proc~errout proc~sort_cmplx Sort_cmplx interface~sort->proc~sort_cmplx proc~sort_dble Sort_dble interface~sort->proc~sort_dble proc~sort_sngl Sort_sngl interface~sort->proc~sort_sngl proc~subtab_dble SubTab_dble interface~subtab->proc~subtab_dble proc~subtab_sngl SubTab_sngl interface~subtab->proc~subtab_sngl

Called by

proc~~readraybearingangles~~CalledByGraph proc~readraybearingangles ReadRayBearingAngles proc~readenvironment ReadEnvironment proc~readenvironment->proc~readraybearingangles program~bellhop BELLHOP program~bellhop->proc~readenvironment program~bellhop3d BELLHOP3D program~bellhop3d->proc~readenvironment

Source Code

  SUBROUTINE ReadRayBearingAngles( freq, TopOpt, RunType )

    REAL      (KIND=8), INTENT( IN ) :: freq
    CHARACTER (LEN= 6), INTENT( IN ) :: TopOpt, RunType

    IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
       READ( ENVFile, * ) Angles%Nbeta, Angles%iSingle_beta ! option to trace a single beam
    ELSE
       READ( ENVFile, * ) Angles%Nbeta
    END IF

    IF ( Angles%Nbeta == 0 ) THEN   ! automatically estimate Nbeta to use
       IF ( RunType( 1 : 1 ) == 'R' ) THEN
          Angles%Nbeta = 50         ! For a ray trace plot, we don't want too many rays ...
       ELSE
          Angles%Nbeta = MAX( INT( ( ( 0.1 * Pos%rr( Pos%NRr ) ) * freq ) / c0 ), 300 )
       END IF
    END IF

    ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
    IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles'  )

    IF ( Angles%Nbeta > 2 ) Angles%beta( 3 ) = -999.9
    READ( ENVFile, * ) Angles%beta

    CALL SubTab( Angles%beta, Angles%Nbeta )
    CALL Sort(   Angles%beta, Angles%Nbeta )

    ! full 360-degree sweep? remove duplicate beam
    ! LP: Changed from TINY( ), see README.md.
    IF ( Angles%Nbeta > 1 .AND. ABS( MOD( Angles%beta( Angles%Nbeta ) - Angles%beta( 1 ), &
       360.0D0 ) ) < 10.0 * SPACING( 360.0D0 ) ) &
       Angles%Nbeta = Angles%Nbeta - 1

    ! Nx2D CASE: beams must lie on rcvr radials--- replace beta with theta
    IF ( RunType( 6 : 6 ) == '2' .AND. RunType( 1 : 1 ) /= 'R' ) THEN
       WRITE( PRTFile, * )
       WRITE( PRTFile, * ) 'Replacing beam take-off angles, beta, with receiver bearing lines, theta'
       DEALLOCATE( Angles%beta )

       Angles%Nbeta = Pos%Ntheta
       ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
       IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles'  )
       Angles%beta( 1 : Angles%Nbeta ) = Pos%theta( 1 : Pos%Ntheta )   ! Nbeta should = Ntheta
    END IF

    WRITE( PRTFile, * )
    WRITE( PRTFile, * ) '   Number of beams in bearing   = ', Angles%Nbeta
    IF ( Angles%iSingle_beta > 0 ) WRITE( PRTFile, * ) 'Trace only beam number ', Angles%iSingle_beta
    WRITE( PRTFile, * ) '   Beam take-off angles (degrees)'

    IF ( Angles%Nbeta >= 1 ) WRITE( PRTFile, "( 5G14.6 )" ) Angles%beta( 1 : MIN( Angles%Nbeta, Number_to_Echo ) )
    IF ( Angles%Nbeta > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', Angles%beta( Angles%Nbeta )

    IF ( Angles%Nbeta > 1 .AND. Angles%beta( Angles%Nbeta ) == Angles%beta( 1 ) ) &
         CALL ERROUT( 'ReadRayBearingAngles', 'First and last beam take-off angle are identical' )

    IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
       IF ( Angles%iSingle_beta < 1 .OR. Angles%iSingle_beta > Angles%Nbeta ) &
            CALL ERROUT( 'ReadRayBearingAngles', 'Selected beam, iSingle_beta not in [ 1, Angles%Nbeta ]' )
    END IF
    Angles%beta  = DegRad * Angles%beta   ! convert to radians

    Angles%Dbeta = 0.0
    IF ( Angles%Nbeta /= 1 ) Angles%Dbeta = ( Angles%beta( Angles%NBeta ) - Angles%beta( 1 ) ) / ( Angles%Nbeta - 1 )

  END SUBROUTINE ReadRayBearingAngles