Distances3D Subroutine

subroutine Distances3D(rayx, Topx, Botx, Topn, Botn, DistTop, DistBot)

Computes distances from ray to boundaries

$ write( , * ) $ write( , * ) 'Distances3D', DistBot $ write( , * ) 'rayx', rayx $ write( , * ) 'Botx', Botx $ write( , * ) 'dBot', dBot $ write( , * ) 'Normal', Botn $ write( *, * )

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(in) :: rayx(3)
real(kind=8), intent(in) :: Topx(3)
real(kind=8), intent(in) :: Botx(3)
real(kind=8), intent(in) :: Topn(3)
real(kind=8), intent(in) :: Botn(3)
real(kind=8), intent(out) :: DistTop
real(kind=8), intent(out) :: DistBot

Called by

proc~~distances3d~~CalledByGraph proc~distances3d Distances3D proc~traceray2d TraceRay2D proc~traceray2d->proc~distances3d proc~traceray3d TraceRay3D proc~traceray3d->proc~distances3d proc~bellhopcore BellhopCore proc~bellhopcore->proc~traceray2d proc~bellhopcore->proc~traceray3d program~bellhop3d BELLHOP3D program~bellhop3d->proc~bellhopcore

Source Code

SUBROUTINE Distances3D( rayx, Topx, Botx, Topn, Botn, DistTop, DistBot )
!! Computes distances from ray to boundaries

  ! Formula differs from JKPS because code uses outward pointing normals
  ! Note that Topx, Botx, just need to be any node on the diagonal that divides each square into triangles
  ! In bdry3DMod, the node is selected as the one at the lowest x, y, index and that defines the triangles

  REAL (KIND=8), INTENT( IN  ) :: rayx( 3 )             ! ray coordinate
  REAL (KIND=8), INTENT( IN  ) :: Topx( 3 ), Botx( 3 )  ! top, bottom boundary coordinate for node
  REAL (KIND=8), INTENT( IN  ) :: Topn( 3 ), Botn( 3 )  ! top, bottom boundary normal
  REAL (KIND=8), INTENT( OUT ) :: DistTop, DistBot      ! distance from the ray to top, bottom boundaries
  REAL (KIND=8)                :: dTop( 3 ), dBot( 3 )

  dTop    = rayx - Topx  ! vector pointing from top    to ray
  dBot    = rayx - Botx  ! vector pointing from bottom to ray
  DistTop = -DOT_PRODUCT( Topn, dTop )
  DistBot = -DOT_PRODUCT( Botn, dBot )

!!$  write( *, * )
!!$  write( *, * ) 'Distances3D', DistBot
!!$  write( *, * ) 'rayx', rayx
!!$  write( *, * ) 'Botx', Botx
!!$  write( *, * ) 'dBot', dBot
!!$  write( *, * ) 'Normal', Botn
!!$  write( *, * )
END SUBROUTINE Distances3D