StepToBdry2D Subroutine

public subroutine StepToBdry2D(x0, x2, urayt, h, topRefl, botRefl, iSegz0, iSegr0, Topx, Topn, Botx, Botn)

Uses

  • proc~~steptobdry2d~~UsesGraph proc~steptobdry2d StepToBdry2D module~bdrymod bdrymod proc~steptobdry2d->module~bdrymod module~fatalerror FatalError module~bdrymod->module~fatalerror module~monotonicmod monotonicMod module~bdrymod->module~monotonicmod

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: x0(2)
real(kind=8), intent(inout) :: x2(2)
real(kind=8), intent(in) :: urayt(2)
real(kind=8), intent(inout) :: h
logical, intent(out) :: topRefl
logical, intent(out) :: botRefl
integer, intent(in) :: iSegz0
integer, intent(in) :: iSegr0
real(kind=8), intent(in) :: Topx(2)
real(kind=8), intent(in) :: Topn(2)
real(kind=8), intent(in) :: Botx(2)
real(kind=8), intent(in) :: Botn(2)

Called by

proc~~steptobdry2d~~CalledByGraph proc~steptobdry2d StepToBdry2D proc~step2d Step2D proc~step2d->proc~steptobdry2d proc~traceray2d~2 TraceRay2D proc~traceray2d~2->proc~step2d proc~bellhopcore~2 BellhopCore proc~bellhopcore~2->proc~traceray2d~2 program~bellhop BELLHOP program~bellhop->proc~bellhopcore~2

Source Code

  SUBROUTINE StepToBdry2D( x0, x2, urayt, h, topRefl, botRefl, &
       iSegz0, iSegr0, Topx, Topn, Botx, Botn )
    USE BdryMod
    REAL (KIND=8), INTENT( IN    ) :: x0( 2 ), urayt( 2 )
    REAL (KIND=8), INTENT( INOUT ) :: x2( 2 ), h
    INTEGER,       INTENT( IN    ) :: iSegz0, iSegr0                             ! SSP layer the ray is in
    REAL (KIND=8), INTENT( IN    ) :: Topx( 2 ), Topn( 2 ), Botx( 2 ), Botn( 2 ) ! Top, bottom coordinate and normal
    LOGICAL,       INTENT( OUT   ) :: topRefl, botRefl
    REAL (KIND=8)                  :: d( 2 ), d0( 2 ), rSeg( 2 )

    ! Original step due to maximum step size
    h = Beam%deltas
    x2 = x0 + h * urayt

    ! interface crossing in depth
    IF ( ABS( urayt( 2 ) ) > EPSILON( h ) ) THEN
       IF      ( SSP%z( iSegz0     ) > x2( 2 ) ) THEN
          h  = ( SSP%z( iSegz0     ) - x0( 2 ) ) / urayt( 2 )
          x2( 1 ) = x0( 1 ) + h * urayt( 1 )
          x2( 2 ) = SSP%z( iSegz0 )
          IF ( STEP_DEBUGGING ) THEN
             WRITE( PRTFile, * ) 'StepToBdry2D lower depth h to', h, x2
          END IF
       ELSE IF ( SSP%z( iSegz0 + 1 ) < x2( 2 ) ) THEN
          h  = ( SSP%z( iSegz0 + 1 ) - x0( 2 ) ) / urayt( 2 )
          x2( 1 ) = x0( 1 ) + h * urayt( 1 )
          x2( 2 ) = SSP%z( iSegz0 + 1 )
          IF ( STEP_DEBUGGING ) THEN
             WRITE( PRTFile, * ) 'StepToBdry2D upper depth h to', h, x2
          END IF
       END IF
    END IF

    ! ray mask using a box centered at ( 0, 0 )
    IF ( ABS( x2( 1 ) ) > Beam%Box%r ) THEN
       h = ( Beam%Box%r - ABS( x0( 1 ) ) ) / ABS( urayt( 1 ) )
       x2( 2 ) = x0( 2 ) + h * urayt( 2 )
       x2( 1 ) = SIGN( Beam%Box%r, x0( 1 ) )
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D beam box crossing R h to', h, x2
       END IF
    END IF
    IF ( ABS( x2( 2 ) ) > Beam%Box%z ) THEN
       h = ( Beam%Box%z - ABS( x0( 2 ) ) ) / ABS( urayt( 2 ) )
       x2( 1 ) = x0( 1 ) + h * urayt( 1 )
       x2( 2 ) = SIGN( Beam%Box%z, x0( 2 ) )
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D beam box crossing Z h to', h, x2
       END IF
    END IF

    ! top crossing
    d = x2 - Topx             ! vector from top to ray
    ! LP: Originally, this value had to be > a small positive number, meaning the
    ! new step really had to be outside the boundary, not just to the boundary.
    ! Also, this is not missing a normalization factor, Topn is normalized so
    ! this is actually the distance above the top in meters.
    IF ( DOT_PRODUCT( Topn, d ) > -INFINITESIMAL_STEP_SIZE ) THEN
       d0 = x0 - Topx         ! vector from top node to ray origin
       h = -DOT_PRODUCT( d0, Topn ) / DOT_PRODUCT( urayt, Topn )
       x2 = x0 + h * urayt
       ! Snap to exact top depth value if it's flat
       IF ( ABS( Topn( 1 ) ) < EPSILON( Topn( 1 ) ) ) THEN
          x2( 2 ) = Topx( 2 )
       END IF
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D top crossing h to', h, x2
       END IF
       topRefl = .TRUE.
    ELSE
       topRefl = .FALSE.
    END IF

    ! bottom crossing
    d = x2 - Botx              ! vector from bottom to ray
    ! See comment above for top case.
    IF ( DOT_PRODUCT( Botn, d ) > -INFINITESIMAL_STEP_SIZE ) THEN
       d0  = x0 - Botx         ! vector from bottom node to ray origin
       h = -DOT_PRODUCT( d0, Botn ) / DOT_PRODUCT( urayt, Botn )
       x2 = x0 + h * urayt
       ! Snap to exact bottom depth value if it's flat
       IF ( ABS( Botn( 1 ) ) < EPSILON( Botn( 1 ) ) ) THEN
          x2( 2 ) = Botx( 2 )
       END IF
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D bottom crossing h to', h, x2
       END IF
       botRefl = .TRUE.
       ! Should not ever be able to cross both, but in case it does, make sure
       ! only the crossing we exactly landed on is active
       topRefl = .FALSE.
    ELSE
       botRefl = .FALSE.
    END IF

    ! top or bottom segment crossing in range
    rSeg( 1 ) = MAX( rTopSeg( 1 ), rBotSeg( 1 ) ) ! LP: lower range bound (not an x value)
    rSeg( 2 ) = MIN( rTopSeg( 2 ), rBotSeg( 2 ) ) ! LP: upper range bound (not a y value)

    IF ( SSP%Type == 'Q' ) THEN
       rSeg( 1 ) = MAX( rSeg( 1 ), SSP%Seg%r( iSegr0     ) )
       rSeg( 2 ) = MIN( rSeg( 2 ), SSP%Seg%r( iSegr0 + 1 ) )
    END IF

    IF ( ABS( urayt( 1 ) )  > EPSILON( h ) ) THEN
       IF      ( x2( 1 ) < rSeg( 1 ) ) THEN
          h = -( x0( 1 ) - rSeg( 1 ) ) / urayt( 1 )
          x2( 1 ) = rSeg( 1 )
          x2( 2 ) = x0( 2 ) + h * urayt( 2 )
          IF ( STEP_DEBUGGING ) THEN
             WRITE( PRTFile, * ) 'StepToBdry2D lower range h to', h, x2
          END IF
          topRefl = .FALSE.
          botRefl = .FALSE.
       ELSE IF ( x2( 1 ) > rSeg( 2 ) ) THEN
          h = -( x0( 1 ) - rSeg( 2 ) ) / urayt( 1 )
          x2( 1 ) = rSeg( 2 )
          x2( 2 ) = x0( 2 ) + h * urayt( 2 )
          IF ( STEP_DEBUGGING ) THEN
             WRITE( PRTFile, * ) 'StepToBdry2D upper range h to', h, x2
          END IF
          topRefl = .FALSE.
          botRefl = .FALSE.
       END IF
    END IF

    IF ( h < INFINITESIMAL_STEP_SIZE * Beam%deltas ) THEN   ! is it taking an infinitesimal step?
       h = INFINITESIMAL_STEP_SIZE * Beam%deltas            ! make sure we make some motion
       x2 = x0 + h * urayt
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D small step forced h to', h, x2
       END IF
       ! Recheck reflection conditions
       d = x2 - Topx             ! vector from top to ray
       IF ( DOT_PRODUCT( Topn, d ) > EPSILON( h ) ) THEN
          topRefl = .TRUE.
       ELSE
          topRefl = .FALSE.
       END IF
       d = x2 - Botx              ! vector from bottom to ray
       IF ( DOT_PRODUCT( Botn, d ) > EPSILON( h ) ) THEN
          botRefl = .TRUE.
          topRefl = .FALSE.
       ELSE
          botRefl = .FALSE.
       END IF
    ELSE
       IF ( STEP_DEBUGGING ) THEN
          WRITE( PRTFile, * ) 'StepToBdry2D normal h to', h, x2
       END IF
    END IF

  END SUBROUTINE StepToBdry2D