ScalePressure3D Subroutine

public subroutine ScalePressure3D(Dalpha, Dbeta, c, epsilon, P, Ntheta, Nrz, Nr, RunType, freq)

Scale the pressure field

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: Dalpha
real(kind=8), intent(in) :: Dbeta
real(kind=8), intent(in) :: c
complex(kind=8), intent(in) :: epsilon(2)
complex, intent(inout) :: P(Ntheta,Nrz,Nr)
integer, intent(in) :: Ntheta
integer, intent(in) :: Nrz
integer, intent(in) :: Nr
character(len=5), intent(in) :: RunType
real(kind=8), intent(in) :: freq

Called by

proc~~scalepressure3d~~CalledByGraph proc~scalepressure3d ScalePressure3D proc~bellhopcore BellhopCore proc~bellhopcore->proc~scalepressure3d program~bellhop3d BELLHOP3D program~bellhop3d->proc~bellhopcore

Source Code

  SUBROUTINE ScalePressure3D( Dalpha, Dbeta, c, epsilon, P, Ntheta, Nrz, Nr, RunType, freq )
    !! Scale the pressure field

    INTEGER,            INTENT( IN    ) :: Ntheta, Nrz, Nr
    REAL    ( KIND=8 ), INTENT( IN    ) :: Dalpha, Dbeta        ! angular spacing between rays
    REAL    ( KIND=8 ), INTENT( IN    ) :: freq, c              ! source frequency, nominal sound speed
    COMPLEX,            INTENT( INOUT ) :: P( Ntheta, Nrz, Nr ) ! Pressure field
    COMPLEX ( KIND=8 ), INTENT( IN    ) :: epsilon( 2 )
    CHARACTER (LEN=5 ), INTENT( IN    ) :: RunType
    COMPLEX ( KIND=8 )                  :: const
!!!! this routine should be eliminated

    ! Compute scale factor for field
    SELECT CASE ( RunType( 2 : 2 ) )
    CASE ( 'C' )   ! Cerveny Gaussian beams in Cartesian coordinates
       ! epsilon is normally imaginary here, so const is complex
       const = SQRT( epsilon( 1 ) * epsilon( 2 ) ) * freq * Dbeta * Dalpha / ( SQRT( c ) ) **3  ! put this factor into the beam instead?
       P( :, :, : ) = CMPLX( const, KIND=4 ) * P( :, :, : )
    CASE DEFAULT
       const = 1.0
    END SELECT

    IF ( RunType( 1 : 1 ) /= 'C' ) P = SQRT( REAL( P ) ) ! For incoherent run, convert intensity to pressure

  END SUBROUTINE ScalePressure3D