ScalePressure Subroutine

public subroutine ScalePressure(Dalpha, c, r, U, NRz, Nr, RunType, freq)

Scale the pressure field

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: Dalpha
real(kind=8), intent(in) :: c
real, intent(in) :: r(Nr)
complex, intent(inout) :: U(NRz,Nr)
integer, intent(in) :: NRz
integer, intent(in) :: Nr
character(len=5), intent(in) :: RunType
real(kind=8), intent(in) :: freq

Calls

proc~~scalepressure~~CallsGraph proc~scalepressure ScalePressure sngl sngl proc~scalepressure->sngl

Called by

proc~~scalepressure~~CalledByGraph proc~scalepressure ScalePressure proc~bellhopcore BellhopCore proc~bellhopcore->proc~scalepressure proc~bellhopcore~2 BellhopCore proc~bellhopcore~2->proc~scalepressure program~bellhop BELLHOP program~bellhop->proc~bellhopcore~2 program~bellhop3d BELLHOP3D program~bellhop3d->proc~bellhopcore

Source Code

  SUBROUTINE ScalePressure( Dalpha, c, r, U, NRz, Nr, RunType, freq )
  !! Scale the pressure field

    REAL,              PARAMETER       :: pi = 3.14159265
    INTEGER,           INTENT( IN    ) :: NRz, Nr
    REAL,              INTENT( IN    ) :: r( Nr )         ! ranges
    REAL     (KIND=8), INTENT( IN    ) :: Dalpha, freq, c ! angular spacing between rays, source frequency, nominal sound speed
    COMPLEX,           INTENT( INOUT ) :: U( NRz, Nr )    ! Pressure field
    CHARACTER (LEN=5), INTENT( IN    ) :: RunType
    REAL     (KIND=8)                  :: const, factor

    ! Compute scale factor for field
    SELECT CASE ( RunType( 2 : 2 ) )
    CASE ( 'C' )   ! Cerveny Gaussian beams in Cartesian coordinates
       const = -Dalpha * SQRT( freq ) / c
    CASE ( 'R' )   ! Cerveny Gaussian beams in Ray-centered coordinates
       const = -Dalpha * SQRT( freq ) / c
    CASE DEFAULT
       const = -1.0
    END SELECT

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

    ! scale and/or incorporate cylindrical spreading
    Ranges: DO ir = 1, Nr
       IF ( RunType( 4 : 4 ) == 'X' ) THEN   ! line source
          factor = -4.0 * SQRT( pi ) * const
       ELSE                                  ! point source
          IF ( r ( ir ) == 0 ) THEN
             factor = 0.0D0                  ! avoid /0 at origin, return pressure = 0
          ELSE
             factor = const / SQRT( ABS( r( ir ) ) )
          END IF
       END IF
       U( :, ir ) = SNGL( factor ) * U( :, ir )
    END DO Ranges

  END SUBROUTINE ScalePressure