WriteRay2D Subroutine

public subroutine WriteRay2D(alpha0, Nsteps1)

The 2D version is for ray traces in (r,z) coordinates

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: alpha0
integer, intent(in) :: Nsteps1

Called by

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

Source Code

  SUBROUTINE WriteRay2D( alpha0, Nsteps1 )
    !! The 2D version is for ray traces in (r,z) coordinates

    INTEGER,       INTENT( IN ) :: Nsteps1
    REAL (KIND=8), INTENT( IN ) :: alpha0   ! take-off angle of this ray

    ! compression
    ! LP: This is silly for two reasons:
    ! 1) MaxN (maximum number of steps for a ray) is 100000, but MaxNRayPoints
    !    is 500000. Therefore iSkip will always be 1, and the whole vector will
    !    always be written.
    ! 2) Even if these constants were changed, the formula for iSkip is not
    !    ideal: iSkip will only become 2 once the number of steps in the ray is
    !    more than 2x MaxNRayPoints. If it's less than this, it'll just be
    !    truncated, which is arguably worse than skipping every other step.

    N2    = 1
    iSkip = MAX( Nsteps1 / MaxNRayPoints, 1 )

    Stepping: DO is = 2, Nsteps1
       ! ensure that we always write ray points near bdry reflections (works only for flat bdry)
       IF ( MIN( Bdry%Bot%HS%Depth - ray2D( is )%x( 2 ),  ray2D( is )%x( 2 ) - Bdry%Top%HS%Depth ) < 0.2 .OR. &
            MOD( is, iSkip ) == 0 .OR. is == Nsteps1 ) THEN
          N2 = N2 + 1
          ray2D( N2 )%x = ray2D( is )%x
       END IF
    END DO Stepping

    ! write to ray file

    WRITE( RAYFile, * ) alpha0
    WRITE( RAYFile, * ) N2, ray2D( Nsteps1 )%NumTopBnc, ray2D( Nsteps1 )%NumBotBnc

    DO is = 1, N2
       WRITE( RAYFile, * ) ray2D( is )%x
    END DO

  END SUBROUTINE WriteRay2D