ApplyContribution Subroutine

public subroutine ApplyContribution(U)

Applies beam contribution to pressure field

Arguments

Type IntentOptional Attributes Name
complex, intent(inout) :: U

Calls

proc~~applycontribution~2~~CallsGraph proc~applycontribution~2 ApplyContribution proc~addarr AddArr proc~applycontribution~2->proc~addarr proc~writeray2d WriteRay2D proc~applycontribution~2->proc~writeray2d proc~writeray3d WriteRay3D proc~applycontribution~2->proc~writeray3d sngl sngl proc~applycontribution~2->sngl proc~addarr->sngl

Called by

proc~~applycontribution~2~~CalledByGraph proc~applycontribution~2 ApplyContribution proc~influencegeogaussiancart InfluenceGeoGaussianCart proc~influencegeogaussiancart->proc~applycontribution~2 proc~influencegeohatcart InfluenceGeoHatCart proc~influencegeohatcart->proc~applycontribution~2 proc~influencegeohatraycen InfluenceGeoHatRayCen proc~influencegeohatraycen->proc~applycontribution~2 proc~influencesgb InfluenceSGB proc~influencesgb->proc~applycontribution~2 proc~bellhopcore BellhopCore proc~bellhopcore->proc~influencegeogaussiancart proc~bellhopcore->proc~influencegeohatcart proc~bellhopcore->proc~influencegeohatraycen proc~bellhopcore->proc~influencesgb proc~bellhopcore~2 BellhopCore proc~bellhopcore~2->proc~influencegeogaussiancart proc~bellhopcore~2->proc~influencegeohatcart proc~bellhopcore~2->proc~influencegeohatraycen proc~bellhopcore~2->proc~influencesgb program~bellhop BELLHOP program~bellhop->proc~bellhopcore~2 program~bellhop3d BELLHOP3D program~bellhop3d->proc~bellhopcore

Source Code

  SUBROUTINE ApplyContribution( U )
  !! Applies beam contribution to pressure field

    COMPLEX, INTENT( INOUT ) :: U
    COMPLEX ( KIND=4 ) :: dfield

    SELECT CASE( Beam%RunType( 1 : 1 ) )
    CASE ( 'E' )                ! eigenrays
       IF ( Title( 1 :  9 ) == 'BELLHOP- ' ) THEN   ! BELLHOP run
          CALL WriteRay2D( SrcDeclAngle, iS )
       ELSE                                         ! BELLHOP3D run
          CALL WriteRay3D( DegRad * SrcDeclAngle, DegRad * SrcAzimAngle, is )   ! produces no output if NR=1
       END IF
    CASE ( 'A', 'a' )           ! arrivals
       CALL AddArr( omega, iz, ir, Amp, phaseInt, delay, SrcDeclAngle, &
                  & RcvrDeclAngle, ray2D( iS )%NumTopBnc, ray2D( iS )%NumBotBnc )
    CASE ( 'C' )                ! coherent TL
       dfield = CMPLX( Amp * EXP( -i * ( omega * delay - phaseInt ) ) )
       ! WRITE( PRTFile, * ) 'ApplyContribution dfield', dfield
       U = U + dfield
                     ! omega * n * n / ( 2 * ray2d( iS )%c**2 * delay ) ) ) )   ! curvature correction
    CASE DEFAULT                ! incoherent/semicoherent TL
       IF ( Beam%Type( 1 : 1 ) == 'B' ) THEN   ! Gaussian beam
          U = U + SNGL( SQRT( 2. * pi ) * ( const * EXP( AIMAG( omega * delay ) ) ) ** 2 * W )
       ELSE
          U = U + SNGL(                   ( const * EXP( AIMAG( omega * delay ) ) ) ** 2 * W )
       END IF
    END SELECT

  END SUBROUTINE ApplyContribution