ScaleBeam Subroutine

public subroutine ScaleBeam(alpha, Dalpha, Dbeta)

Scaling for geometric beams

Arguments

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

Called by

proc~~scalebeam~~CalledByGraph proc~scalebeam ScaleBeam proc~influence3dgeogaussiancart Influence3DGeoGaussianCart proc~influence3dgeogaussiancart->proc~scalebeam proc~influence3dgeogaussianraycen Influence3DGeoGaussianRayCen proc~influence3dgeogaussianraycen->proc~scalebeam proc~influence3dgeohatcart Influence3DGeoHatCart proc~influence3dgeohatcart->proc~scalebeam proc~influence3dgeohatraycen Influence3DGeoHatRayCen proc~influence3dgeohatraycen->proc~scalebeam 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 ScaleBeam( alpha, Dalpha, Dbeta )
    !! Scaling for geometric beams

    REAL ( KIND = 8 ), INTENT( IN ) :: alpha, Dalpha, Dbeta

    ray3D( 1 : Beam%Nsteps )%Amp = Ratio1 * ray3D( 1 : Beam%Nsteps )%c * ray3D( 1 : Beam%Nsteps )%Amp   ! pre-apply some scaling

    ray3D( 1 : Beam%Nsteps )%DetQ = ray3D( 1 : Beam%Nsteps )%q_tilde( 1 ) * ray3D( 1 : Beam%Nsteps )%q_hat(   2 ) - &
                                    ray3D( 1 : Beam%Nsteps )%q_tilde( 2 ) * ray3D( 1 : Beam%Nsteps )%q_hat(   1 )

    ray3D( 1 : Beam%Nsteps )%q_tilde( 1 ) =                       Dalpha * ray3D( 1 : Beam%Nsteps )%q_tilde( 1 ) / ray3D( 1 )%c
    ray3D( 1 : Beam%Nsteps )%q_tilde( 2 ) =                       Dalpha * ray3D( 1 : Beam%Nsteps )%q_tilde( 2 ) / ray3D( 1 )%c
    ray3D( 1 : Beam%Nsteps )%q_hat(   1 ) = ABS( COS( alpha ) ) * Dbeta  * ray3D( 1 : Beam%Nsteps )%q_hat(   1 ) / ray3D( 1 )%c
    ray3D( 1 : Beam%Nsteps )%q_hat(   2 ) = ABS( COS( alpha ) ) * Dbeta  * ray3D( 1 : Beam%Nsteps )%q_hat(   2 ) / ray3D( 1 )%c

  END SUBROUTINE ScaleBeam