Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=r64), | intent(in) | :: | RecPt(3) | |||
real(kind=r64), | intent(in) | :: | RayVec(3) | |||
integer, | intent(out) | :: | NearestHitSurfNum | |||
real(kind=r64), | intent(out) | :: | NearestHitPt(3) |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE DayltgClosestObstruction(RecPt,RayVec,NearestHitSurfNum,NearestHitPt)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN November 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Determines surface number and hit point of closest exterior obstruction hit
! by a ray from a window. If no obstruction is hit, NearestHitSurfNum = 0.
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS: na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: RecPt(3) ! Point on window from which ray emanates (m)
REAL(r64), INTENT(IN) :: RayVec(3) ! Unit vector along ray pointing away from window (m)
INTEGER, INTENT(OUT) :: NearestHitSurfNum ! Surface number of nearest obstruction that is hit by ray;
! = 0 if no obstruction is hit.
REAL(r64), INTENT(OUT) :: NearestHitPt(3) ! Ray's hit point on nearest obstruction (m)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
REAL(r64) :: HitPt(3) ! Hit point on an obstruction (m)
INTEGER :: IHit ! > 0 if obstruction is hit, 0 otherwise
INTEGER :: ObsSurfNum ! Obstruction surface number
INTEGER :: TotObstructionsHit ! Number of obstructions hit by a ray
REAL(r64) :: HitDistance ! Distance from receiving point to hit point for a ray (m)
REAL(r64) :: NearestHitDistance ! Distance from receiving point to nearest hit point for a ray (m)
INTEGER :: ObsSurfNumToSkip ! Surface number of obstruction to be ignored
! FLOW:
TotObstructionsHit = 0
NearestHitSurfNum = 0
NearestHitDistance = 1.d+8
NearestHitPt = 0.0d0
ObsSurfNumToSkip = 0
DO ObsSurfNum = 1,TotSurfaces
IF(.NOT.Surface(ObsSurfNum)%ShadowSurfPossibleObstruction) CYCLE
! If a window was hit previously (see below), ObsSurfNumToSkip was set to the window's base surface in order
! to remove that surface from consideration as a hit surface for this ray
IF(ObsSurfNum == ObsSurfNumToSkip) CYCLE
! Determine if this ray hits ObsSurfNum (in which case IHit > 0) and, if so, get the
! distance from the receiving point to the hit
CALL DayltgPierceSurface(ObsSurfNum,RecPt,RayVec,IHit,HitPt)
IF(IHit > 0) THEN
! If obstruction is a window and its base surface is the nearest obstruction hit so far,
! set NearestHitSurfNum to this window. Note that in this case NearestHitDistance has already
! been calculated, so does not have to be recalculated.
IF(Surface(ObsSurfNum)%Class == SurfaceClass_Window .AND. Surface(ObsSurfNum)%BaseSurf == NearestHitSurfNum) THEN
NearestHitSurfNum = ObsSurfNum
ELSE
TotObstructionsHit = TotObstructionsHit + 1
! Distance from receiving point to hit point
HitDistance = SQRT(DOT_PRODUCT(HitPt-RecPt,HitPt-RecPt))
! Reset NearestHitSurfNum and NearestHitDistance if this hit point is closer than previous closest
IF(HitDistance < NearestHitDistance) THEN
NearestHitDistance = HitDistance
NearestHitSurfNum = ObsSurfNum
NearestHitPt = HitPt
END IF
END IF
END IF ! End of check if obstruction was hit
END DO ! End of loop over possible obstructions for this ray
RETURN
END SUBROUTINE DayltgClosestObstruction