Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | IHr | |||
real(kind=r64), | intent(in) | :: | Ray(3) | |||
integer, | intent(in) | :: | ReflSurfNum | |||
real(kind=r64), | intent(in) | :: | ReflHitPt(3) | |||
real(kind=r64), | intent(out) | :: | LumAtReflHitPtFrSun |
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 DayltgSurfaceLumFromSun(IHr,Ray,ReflSurfNum,ReflHitPt,LumAtReflHitPtFrSun)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN November 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates exterior surface luminance due to beam solar diffuse reflection.
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS: na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: IHr ! Hour number
REAL(r64), INTENT(IN) :: Ray(3) ! Ray from window to reflecting surface (m)
INTEGER, INTENT(IN) :: ReflSurfNum ! Number of surface for which luminance is being calculated
REAL(r64), INTENT(IN) :: ReflHitPt(3) ! Point on ReflSurfNum for luminance calculation (m)
REAL(r64), INTENT(OUT) :: LumAtReflHitPtFrSun ! Luminance at ReflHitPt from beam solar reflection for unit
! beam normal illuminance (cd/m2)
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: ReflNorm(3) ! Unit normal to reflecting surface (m)
INTEGER :: ObsSurfNum ! Obstruction surface number
INTEGER :: IHitObs ! > 0 if obstruction is hit
REAL(r64) :: ObsHitPt(3) ! Hit point on obstruction (m)
REAL(r64) :: CosIncAngAtHitPt ! Cosine of angle of incidence of sun at HitPt
REAL(r64) :: DiffVisRefl ! Diffuse visible reflectance of ReflSurfNum
! FLOW:
LumAtReflHitPtFrSun = 0.0d0
! Skip daylighting shelves since reflection from these is separately calculated
IF(Surface(ReflSurfNum)%Shelf > 0) RETURN
! Normal to reflecting surface in hemisphere containing window element
ReflNorm = Surface(ReflSurfNum)%OutNormVec
IF(Surface(ReflSurfNum)%ShadowingSurf) THEN
IF(DOT_PRODUCT(ReflNorm,Ray) > 0.0d0) ReflNorm = -ReflNorm
END IF
! Cosine of angle of incidence of sun at HitPt if sun were to reach HitPt
CosIncAngAtHitPt = DOT_PRODUCT(ReflNorm,SunCosHr(1:3,IHr))
! Require that the sun be in front of this surface relative to window element
IF(CosIncAngAtHitPt <= 0.0d0) RETURN ! Sun is in back of reflecting surface
! Sun reaches ReflHitPt if vector from ReflHitPt to sun is unobstructed
IHitObs = 0
DO ObsSurfNum = 1,TotSurfaces
IF(.NOT.Surface(ObsSurfNum)%ShadowSurfPossibleObstruction) CYCLE
! Exclude as a possible obstructor ReflSurfNum and its base surface (if it has one)
IF(ObsSurfNum == ReflSurfNum .OR. ObsSurfNum == Surface(ReflSurfNum)%BaseSurf) CYCLE
CALL DayltgPierceSurface(ObsSurfNum,ReflHitPt,SunCosHr(1:3,IHr),IHitObs,ObsHitPt)
IF(IHitObs > 0) EXIT
END DO
IF(IHitObs > 0) RETURN ! Obstruction was hit, blocking sun
! Obstruction was not hit; sun reaches ReflHitPt.
! Calculate luminance at ReflHitPt due to beam solar reflection (for unit beam normal illuminance)
IF(Surface(ReflSurfNum)%ShadowingSurf) THEN
DiffVisRefl = Surface(ReflSurfNum)%ShadowSurfDiffuseVisRefl
! Note that if the shadowing surface has a non-zero glazing fraction (e.g., neighboring bldg) that the above is
! (1 - glazing fraction) * (vis refl of opaque part of shadowing surface); specular reflection is
! excluded in this value of DiffVisRefl.
ELSE ! Exterior building surface
IF(.NOT.Construct(Surface(ReflSurfNum)%Construction)%TypeIsWindow) THEN
DiffVisRefl = 1.0d0 - Construct(Surface(ReflSurfNum)%Construction)%OutsideAbsorpSolar
ELSE
! Window; assume bare so no beam-to-diffuse reflection
DiffVisRefl = 0.0d0
END IF
END IF
LumAtReflHitPtFrSun = CosIncAngAtHitPt * DiffVisRefl / Pi
RETURN
END SUBROUTINE DayltgSurfaceLumFromSun