AddArr3D Subroutine

public subroutine AddArr3D(omega, itheta, id, ir, Amp, Phase, delay, SrcDeclAngle, SrcAzimAngle, RcvrDeclAngle, RcvrAzimAngle, NumTopBnc, NumBotBnc)

Adds the amplitude and delay for an ARRival into a matrix of same.

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: omega
integer, intent(in) :: itheta
integer, intent(in) :: id
integer, intent(in) :: ir
real(kind=8), intent(in) :: Amp
real(kind=8), intent(in) :: Phase
complex(kind=8), intent(in) :: delay
real(kind=8), intent(in) :: SrcDeclAngle
real(kind=8), intent(in) :: SrcAzimAngle
real(kind=8), intent(in) :: RcvrDeclAngle
real(kind=8), intent(in) :: RcvrAzimAngle
integer, intent(in) :: NumTopBnc
integer, intent(in) :: NumBotBnc

Calls

proc~~addarr3d~~CallsGraph proc~addarr3d AddArr3D sngl sngl proc~addarr3d->sngl

Called by

proc~~addarr3d~~CalledByGraph proc~addarr3d AddArr3D proc~applycontribution ApplyContribution proc~applycontribution->proc~addarr3d 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 AddArr3D( omega, itheta, id, ir, Amp, Phase, delay, SrcDeclAngle, &
       SrcAzimAngle, RcvrDeclAngle, RcvrAzimAngle, NumTopBnc, NumBotBnc )
!! Adds the amplitude and delay for an ARRival into a matrix of same.

    ! Extra logic included to keep only the strongest arrivals.

    INTEGER,              INTENT( IN ) :: itheta, id, ir
    INTEGER,              INTENT( IN ) :: NumTopBnc, NumBotBnc
    REAL    ( KIND = 8 ), INTENT( IN ) :: omega, Amp, Phase, SrcDeclAngle, SrcAzimAngle, RcvrDeclAngle, RcvrAzimAngle

    COMPLEX ( KIND = 8 ), INTENT( IN ) :: delay
    LOGICAL                            :: NewRay
    INTEGER                            :: iArr( 1 ), Nt
    REAL                               :: AmpTot, w1, w2

    Nt     = NArr3D( itheta, id, ir )    ! # of arrivals
    NewRay = .TRUE.

    ! Is this the second bracketing ray of a pair?
    ! If so, we want to combine the arrivals to conserve space.
    ! (test this by seeing if the arrival time is close to the previous one)
    ! (also need that the phase is about the same to make sure surface and direct paths are not joined)
    ! LP: BUG: This only checks the last arrival, whereas the first step of the
    ! pair could have been placed in previous slots. See readme.

    IF ( Nt >= 1 ) THEN
       IF ( omega * ABS( delay - Arr3D( itheta,  id, ir, Nt )%delay ) < PhaseTol .AND. &
           ABS( Arr3D( itheta,  id, ir, Nt )%phase - Phase )       < PhaseTol ) NewRay = .FALSE.
    END IF

    IF ( NewRay ) THEN
       IF ( Nt >= MaxNArr ) THEN       ! space available to add an arrival?
          iArr = MINLOC( Arr3D( itheta,  id, ir, : )%A )                       ! no: replace weakest arrival
          IF ( Amp > Arr3D( itheta,  id, ir, iArr( 1 ) )%A ) THEN
             Arr3D( itheta,  id, ir, iArr( 1 ) )%A             = SNGL( Amp )       ! amplitude
             Arr3D( itheta,  id, ir, iArr( 1 ) )%Phase         = SNGL( Phase )     ! phase
             Arr3D( itheta,  id, ir, iArr( 1 ) )%delay         = CMPLX( delay )    ! delay time
             Arr3D( itheta,  id, ir, iArr( 1 ) )%SrcDeclAngle  = SNGL( SrcDeclAngle  ) ! angle
             Arr3D( itheta,  id, ir, iArr( 1 ) )%SrcAzimAngle  = SNGL( SrcAzimAngle  ) ! angle
             Arr3D( itheta,  id, ir, iArr( 1 ) )%RcvrDeclAngle = SNGL( RcvrDeclAngle ) ! angle
             Arr3D( itheta,  id, ir, iArr( 1 ) )%RcvrAzimAngle = SNGL( RcvrAzimAngle ) ! angle
             Arr3D( itheta,  id, ir, iArr( 1 ) )%NTopBnc       = NumTopBnc         ! Number of top     bounces
             Arr3D( itheta,  id, ir, iArr( 1 ) )%NBotBnc       = NumBotBnc         !   "       bottom
          ENDIF
       ELSE
          NArr3D( itheta,  id, ir         )               = Nt + 1              ! # of arrivals
          Arr3D( itheta,   id, ir, Nt + 1 )%A             = SNGL( Amp )         ! amplitude
          Arr3D( itheta,   id, ir, Nt + 1 )%Phase         = SNGL( Phase )       ! phase
          Arr3D( itheta,   id, ir, Nt + 1 )%delay         = CMPLX( delay )      ! delay time
          Arr3D( itheta,   id, ir, Nt + 1 )%SrcDeclAngle  = SNGL( SrcDeclAngle  )   ! angle
          Arr3D( itheta,   id, ir, Nt + 1 )%SrcAzimAngle  = SNGL( SrcAzimAngle  )   ! angle
          Arr3D( itheta,   id, ir, Nt + 1 )%RcvrDeclAngle = SNGL( RcvrDeclAngle )   ! angle
          Arr3D( itheta,   id, ir, Nt + 1 )%RcvrAzimAngle = SNGL( RcvrAzimAngle )   ! angle
          Arr3D( itheta,   id, ir, Nt + 1 )%NTopBnc       = NumTopBnc           ! Number of top     bounces
          Arr3D( itheta,   id, ir, Nt + 1 )%NBotBnc       = NumBotBnc           !   "       bottom
       ENDIF
    ELSE      ! not a new ray
       !PhaseArr(   id, ir, Nt ) = PhaseArr( id, ir, Nt )
       ! calculate weightings of old ray information vs. new, based on amplitude of the arrival
       AmpTot = Arr3D( itheta, id, ir, Nt )%A + SNGL( Amp )
       w1     = Arr3D( itheta, id, ir, Nt )%A / AmpTot
       w2     = REAL( Amp ) / AmpTot

       Arr3D( itheta, id, ir, Nt )%delay         = w1 * Arr3D( itheta, id, ir, Nt )%delay     + w2 * CMPLX( delay ) ! weighted sum
       Arr3D( itheta, id, ir, Nt )%A             = AmpTot
       Arr3D( itheta, id, ir, Nt )%SrcDeclAngle  = w1 * Arr3D( itheta, id, ir, Nt )%SrcDeclAngle  + w2 * SNGL( SrcDeclAngle )
       Arr3D( itheta, id, ir, Nt )%SrcAzimAngle  = w1 * Arr3D( itheta, id, ir, Nt )%SrcAzimAngle  + w2 * SNGL( SrcAzimAngle )
       Arr3D( itheta, id, ir, Nt )%RcvrDeclAngle = w1 * Arr3D( itheta, id, ir, Nt )%RcvrDeclAngle + w2 * SNGL( RcvrDeclAngle )
       Arr3D( itheta, id, ir, Nt )%RcvrAzimAngle = w1 * Arr3D( itheta, id, ir, Nt )%RcvrAzimAngle + w2 * SNGL( RcvrAzimAngle )
    ENDIF

    RETURN
  END SUBROUTINE AddArr3D