ApplyContribution Subroutine

public subroutine ApplyContribution(alpha, beta, U)

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: alpha

ray take-off angle
real(kind=8), intent(in) :: beta

ray take-off angle
complex, intent(inout) :: U

Calls

proc~~applycontribution~~CallsGraph proc~applycontribution ApplyContribution proc~addarr3d AddArr3D proc~applycontribution->proc~addarr3d proc~writeray3d WriteRay3D proc~applycontribution->proc~writeray3d sngl sngl proc~applycontribution->sngl proc~addarr3d->sngl

Called by

proc~~applycontribution~~CalledByGraph proc~applycontribution ApplyContribution proc~influence3dgeogaussiancart Influence3DGeoGaussianCart proc~influence3dgeogaussiancart->proc~applycontribution proc~influence3dgeogaussianraycen Influence3DGeoGaussianRayCen proc~influence3dgeogaussianraycen->proc~applycontribution proc~influence3dgeohatcart Influence3DGeoHatCart proc~influence3dgeohatcart->proc~applycontribution proc~influence3dgeohatraycen Influence3DGeoHatRayCen proc~influence3dgeohatraycen->proc~applycontribution proc~bellhopcore BellhopCore proc~bellhopcore->proc~influence3dgeogaussiancart proc~bellhopcore->proc~influence3dgeogaussianraycen proc~bellhopcore->proc~influence3dgeohatcart proc~bellhopcore->proc~influence3dgeohatraycen program~bellhop3d BELLHOP3D program~bellhop3d->proc~bellhopcore

Source Code

  SUBROUTINE ApplyContribution( alpha, beta, U )

    REAL ( KIND=8 ), INTENT( IN    ) :: alpha, beta
      !! ray take-off angle
    COMPLEX,         INTENT( INOUT ) :: U
    REAL ( KIND=8 )                  :: rayt2( 3 )
    ! LP: Don't want to clobber rayt!

    SELECT CASE( Beam%RunType( 1 : 1 ) )
    CASE ( 'E' )      ! eigenrays
       CALL WriteRay3D( alpha, beta, is )   ! produces no output if NR=1
    CASE ( 'A', 'a' ) ! arrivals
       rayt2 = ray3D( is )%x - ray3D( is - 1 )%x ! ray tangent !!! does this always need to be done???
       RcvrDeclAngle = RadDeg * ATAN2( rayt2( 3 ), NORM2( rayt2( 1 : 2 ) ) )
       RcvrAzimAngle = RadDeg * ATAN2( rayt2( 2 ), rayt2( 1 ) )

       CALL AddArr3D( omega, itheta, iz, ir, Amp, phaseInt, delay, &
            SrcDeclAngle, SrcAzimAngle, RcvrDeclAngle, RcvrAzimAngle, &
            ray3D( is )%NumTopBnc, ray3D( is )%NumBotBnc )
    CASE ( 'C'  )     ! coherent TL
       U = U + CMPLX( Amp * EXP( -i * ( omega * delay - phaseInt ) ) )
    CASE DEFAULT      ! incoherent/semi-coherent TL
       SELECT CASE( Beam%Type( 1 : 1 ) )
       CASE ( 'B', 'b' )   ! Gaussian beam
          U = U + SNGL( 2. * pi * ( const * EXP( AIMAG( omega * delay ) ) ) ** 2 * W )
       CASE DEFAULT
          U = U + SNGL(           ( const * EXP( AIMAG( omega * delay ) ) ) ** 2 * W )
       END SELECT
    END SELECT

  END SUBROUTINE ApplyContribution