Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. 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 CalcSkySolDiffuseReflFactors
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN October 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates factors for irradiance on exterior heat transfer surfaces due to
! reflection of sky diffuse solar radiation from obstructions and ground.
! METHODOLOGY EMPLOYED: na
! REFERENCES: na
! USE STATEMENTS:
USE DataSystemVariables, ONLY: DetailedSkyDiffuseAlgorithm
USE Vectors
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS: na
! INTERFACE BLOCK SPECIFICATIONS: na
! DERIVED TYPE DEFINITIONS: na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: RecSurfNum =0 ! Receiving surface number
INTEGER :: SurfNum =0 ! Heat transfer surface number corresponding to RecSurfNum
INTEGER :: ObsSurfNum =0 ! Obstruction surface number
INTEGER :: RecPtNum =0 ! Receiving point number
INTEGER :: NumRecPts =0 ! Number of receiving points on a receiving surface
INTEGER :: HitPtSurfNum =0 ! Surface number of hit point: -1 = ground,
! 0 = sky or obstruction with receiving point below ground level,
! >0 = obstruction with receiving point above ground level
INTEGER :: HitPtSurfNumX =0 ! For a shading surface, HitPtSurfNum for original surface,
! HitPitSurfNum + 1 for mirror surface
REAL(r64) :: ReflSkySolObs(MaxRecPts) ! Irradiance at a receiving point for sky diffuse solar
! reflected from obstructions, divided by unobstructed
! sky diffuse horizontal irradiance
REAL(r64) :: ReflSkySolGnd(MaxRecPts) ! Irradiance at a receiving point for sky diffuse solar
! reflected from ground, divided by unobstructed
! sky diffuse horizontal irradiance
INTEGER :: RayNum =0 ! Ray number
REAL(r64) :: HitPtRefl(3) =0.0d0 ! Coordinates of hit point on obstruction or ground (m)
INTEGER :: IHitObs =0 ! > 0 if obstruction is hit; otherwise = 0
REAL(r64) :: HitPtObs(3) =0.0d0 ! Hit point on an obstruction (m)
!unused REAL(r64) :: ObsHitPt(3) =0.0 ! Hit point on obstruction (m)
REAL(r64) :: dOmega =0.0d0 ! Solid angle increment (steradians)
REAL(r64) :: CosIncAngRayToSky =0.0d0 ! Cosine of incidence angle on ground of ray to sky
REAL(r64) :: SkyReflSolRadiance =0.0d0 ! Reflected radiance at hit point divided by unobstructed
! sky diffuse horizontal irradiance
REAL(r64) :: dReflSkySol =0.0d0 ! Contribution to reflection factor at a receiving point
! from sky solar reflected from a hit point
REAL(r64) :: Phi =0.0d0 ! Altitude angle and increment (radians)
REAL(r64) :: DPhi =0.0d0 ! Altitude angle and increment (radians)
REAL(r64) :: SPhi =0.0d0 ! Sine of Phi
REAL(r64) :: CPhi =0.0d0 ! Cosine of Phi
REAL(r64) :: Theta =0.0d0 ! Azimuth angle (radians)
REAL(r64) :: DTheta =0.0d0 ! Azimuth increment (radians)
INTEGER :: IPhi =0 ! Altitude angle index
INTEGER :: ITheta =0 ! Azimuth angle index
REAL(r64) :: URay(3) =0.0d0 ! Unit vector along ray from ground hit point
REAL(r64) :: SurfVertToGndPt(3) =0.0d0 ! Vector from a vertex of possible obstructing surface to ground
! hit point (m)
REAL(r64) :: SurfVert(3) =0.0d0 ! Surface vertex (m)
REAL(r64) :: dReflSkyGnd =0.0d0 ! Factor for ground radiance due to direct sky diffuse reflection
! FLOW:
CALL DisplayString('Calculating Sky Diffuse Exterior Solar Reflection Factors')
ReflSkySolObs=0.0d0
ReflSkySolGnd=0.0d0
DO RecSurfNum = 1,TotSolReflRecSurf
SurfNum = SolReflRecSurf(RecSurfNum)%SurfNum
DO RecPtNum = 1, SolReflRecSurf(RecSurfNum)%NumRecPts
ReflSkySolObs(RecPtNum) = 0.0d0
ReflSkySolGnd(RecPtNum) = 0.0d0
DO RayNum = 1, SolReflRecSurf(RecSurfNum)%NumReflRays
HitPtSurfNum = SolReflRecSurf(RecSurfNum)%HitPtSurfNum(RecPtNum,RayNum)
! Skip rays that do not hit an obstruction or ground.
! (Note that if a downgoing ray does not hit an obstruction it will have HitPtSurfNum = 0
! if the receiving point is below ground level (see subr. InitSolReflRecSurf); this means
! that a below-ground-level receiving point receives no ground-reflected radiation although
! it is allowed to receive obstruction-reflected solar radiation and direct (unreflected)
! beam and sky solar radiation. As far as reflected solar is concerned, the program does
! not handle a sloped ground plane or a horizontal ground plane whose level is different
! from one side of the building to another.)
IF(HitPtSurfNum == 0) CYCLE ! Ray hits sky or obstruction with receiving pt. below ground level
HitPtRefl = SolReflRecSurf(RecSurfNum)%HitPt(1:3,RecPtNum,RayNum)
IF(HitPtSurfNum > 0) THEN
! Ray hits an obstruction
! Skip hit points on daylighting shelves, from which solar reflection is separately calculated
IF(Surface(HitPtSurfNum)%Shelf > 0) CYCLE
! Reflected radiance at hit point divided by unobstructed sky diffuse horizontal irradiance
HitPtSurfNumX = HitPtSurfNum
! Each shading surface has a "mirror" duplicate surface facing in the opposite direction.
! The following gets the correct side of a shading surface in order to get the right value
! of DifShdgRatioIsoSky (the two sides can have different sky shadowing).
IF(Surface(HitPtSurfNum)%ShadowingSurf) THEN
IF(DOT_PRODUCT(SolReflRecSurf(RecSurfNum)%RayVec(1:3,RayNum),Surface(HitPtSurfNum)%OutNormVec)>0.0d0)THEN
IF (HitPtSurfNum + 1 < TotSurfaces) HitPtSurfNumX = HitPtSurfNum + 1
IF(Surface(HitPtSurfNumX)%Shelf > 0) CYCLE
ENDIF
END IF
IF (.not. DetailedSkyDiffuseAlgorithm .or. .not. ShadingTransmittanceVaries .or. &
SolarDistribution == MinimalShadowing) THEN
SkyReflSolRadiance = Surface(HitPtSurfNumX)%ViewFactorSky * DifShdgRatioIsoSky(HitPtSurfNumX) * &
SolReflRecSurf(RecSurfNum)%HitPtSolRefl(RecPtNum,RayNum)
ELSE
SkyReflSolRadiance = Surface(HitPtSurfNumX)%ViewFactorSky * DifShdgRatioIsoSkyHRTS(HitPtSurfNumX,1,1) * &
SolReflRecSurf(RecSurfNum)%HitPtSolRefl(RecPtNum,RayNum)
ENDIF
dReflSkySol = SkyReflSolRadiance * SolReflRecSurf(RecSurfNum)%dOmegaRay(RayNum) * &
SolReflRecSurf(RecSurfNum)%CosIncAngRay(RayNum)/Pi
ReflSkySolObs(RecPtNum) = ReflSkySolObs(RecPtNum) + dReflSkySol
ELSE
! Ray hits ground;
! Find radiance at hit point due to reflection of sky diffuse reaching
! ground directly, i.e., without reflecting from obstructions.
! Send rays upward from hit point and see which ones are unobstructed and so go to sky.
! Divide hemisphere centered at ground hit point into elements of altitude Phi and
! azimuth Theta and create upward-going ray unit vector at each Phi,Theta pair.
! Phi = 0 at the horizon; Phi = Pi/2 at the zenith.
DPhi = PiOvr2 / (AltAngStepsForSolReflCalc/2.d0)
dReflSkyGnd = 0.0d0
! Altitude loop
DO IPhi = 1,(AltAngStepsForSolReflCalc/2)
Phi = (IPhi - 0.5d0) * DPhi
SPhi = SIN(Phi)
CPhi = COS(Phi)
! Third component of ray unit vector in (Theta,Phi) direction
URay(3) = SPhi
DTheta = 2.d0*Pi / (2.d0*AzimAngStepsForSolReflCalc)
dOmega = CPhi * DTheta * DPhi
! Cosine of angle of incidence of ray on ground
CosIncAngRayToSky = SPhi
! Azimuth loop
DO ITheta = 1,2*AzimAngStepsForSolReflCalc
Theta = (ITheta - 0.5d0) * DTheta
URay(1) = CPhi * COS(Theta)
URay(2) = CPhi * SIN(Theta)
! Does this ray hit an obstruction?
IHitObs = 0
DO ObsSurfNum = 1, TotSurfaces
IF(.NOT.Surface(ObsSurfNum)%ShadowSurfPossibleObstruction) CYCLE
! Horizontal roof surfaces cannot be obstructions for rays from ground
IF(Surface(ObsSurfNum)%Tilt < 5.0d0) CYCLE
IF(.NOT.Surface(ObsSurfNum)%ShadowingSurf) THEN
IF(DOT_PRODUCT(URay,Surface(ObsSurfNum)%OutNormVec) >= 0.0d0) CYCLE
! Special test for vertical surfaces with URay dot OutNormVec < 0; excludes
! case where ground hit point is in back of ObsSurfNum
IF(Surface(ObsSurfNum)%Tilt > 89.0d0 .AND. Surface(ObsSurfNum)%Tilt < 91.0d0) THEN
SurfVert = Surface(ObsSurfNum)%Vertex(2)
SurfVertToGndPt = HitPtRefl - SurfVert
IF(DOT_PRODUCT(SurfVertToGndPt,Surface(ObsSurfNum)%OutNormVec) < 0.0d0) CYCLE
END IF
END IF
CALL PierceSurface(ObsSurfNum,HitPtRefl,URay,IHitObs,HitPtObs)
IF(IHitObs > 0) EXIT
END DO
IF(IHitObs > 0) CYCLE ! Obstruction hit
! Sky is hit
dReflSkyGnd = dReflSkyGnd + CosIncAngRayToSky*dOmega/Pi
END DO ! End of azimuth loop
END DO ! End of altitude loop
ReflSkySolGnd(RecPtNum) = ReflSkySolGnd(RecPtNum) + dReflSkyGnd * &
SolReflRecSurf(RecSurfNum)%dOmegaRay(RayNum) * SolReflRecSurf(RecSurfNum)%CosIncAngRay(RayNum)/Pi
END IF ! End of check if ray from receiving point hits obstruction or ground
END DO ! End of loop over rays from receiving point
END DO ! End of loop over receiving points
! Average over receiving points
ReflFacSkySolObs(SurfNum) = 0.0d0
ReflFacSkySolGnd(SurfNum) = 0.0d0
NumRecPts = SolReflRecSurf(RecSurfNum)%NumRecPts
DO RecPtNum = 1, NumRecPts
ReflFacSkySolObs(SurfNum) = ReflFacSkySolObs(SurfNum) + ReflSkySolObs(RecPtNum)
ReflFacSkySolGnd(SurfNum) = ReflFacSkySolGnd(SurfNum) + ReflSkySolGnd(RecPtNum)
END DO
ReflFacSkySolObs(SurfNum) = ReflFacSkySolObs(SurfNum)/NumRecPts
ReflFacSkySolGnd(SurfNum) = ReflFacSkySolGnd(SurfNum)/NumRecPts
! Do not allow ReflFacBmToDiffSolGnd to exceed the surface's unobstructed ground view factor
ReflFacSkySolGnd(SurfNum) = MIN(0.5d0*(1.0d0-Surface(SurfNum)%CosTilt), &
ReflFacSkySolGnd(SurfNum))
! Note: the above factors are dimensionless; they are equal to
! (W/m2 reflected solar incident on SurfNum)/(W/m2 unobstructed horizontal sky diffuse irradiance)
END DO ! End of loop over receiving surfaces
RETURN
END SUBROUTINE CalcSkySolDiffuseReflFactors