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.
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 SkyDifSolarShading
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN May 1999
! MODIFIED Sep 2000, FCW: add IR view factor calc
! Sep 2002, FCW: correct error in expression for ground IR view factor.
! Affects only non-vertical surfaces that are shadowed. For these surfaces
! error caused underestimate of IR from ground and shadowing surfaces.
! Dec 2002; LKL: Sky Radiance Distribution now only anisotropic
! Nov 2003: FCW: modify to do sky solar shading of shadowing surfaces
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates factors that account for shading of sky diffuse
! solar radiation by shadowing surfaces such as overhangs and detached
! shades.
! Called by PerformSolarCalculations
!
! For each exterior heat transfer surface calculates the following
! ratio (called DifShdgRatioIsoSky in this subroutine):
!
! R1 = (Diffuse solar from sky dome on surface, with shading)/
! (Diffuse solar from sky dome on surface, without shading)
!
! To calculate the incident diffuse radiation on a surface the sky
! hemisphere is divided into source elements ("patches"). Each patch
! is assumed to have the same radiance, i.e. the sky radiance is isotropic.
! The irradiance from each patch on a surface is calculated. Then these
! irradiances are summed to get the net irradiance on a surface, which
! the denominator of R1.
!
! To get the numerator of R1 the same summation is done, but for each surface
! and each patch the Shadow subroutine is called to determine how much
! radiation from a patch is blocked by shading surfaces.
!
! Also calculated is the following ratio (called DifShdgRatioHoriz in this routine):
!
! R2 = (Diffuse solar from sky horizon band on surface, with shading)/
! (Diffuse solar from sky horizon band on surface, without shading)
!
! For this ratio only a band of sky just above the horizon is considered.
!
! R1 and R2 are used in SUBROUTINE AnisoSkyViewFactors, which determines the
! sky diffuse solar irradiance on each exterior heat transfer surface each
! time step. In that routine the sky radiance distribution is a superposition
! of an isotropic distribution,
! a horizon brightening distribution and a circumsolar brightening distribution,
! where the proportion of each distribution depends
! on cloud cover, sun position and other factors. R1 multiplies the irradiance
! due to the isotropic component and R2 multiplies the irradiance due to the
! horizon brightening component.
!
! Calculates sky and ground IR view factors assuming sky IR is isotropic and
! shadowing surfaces are opaque to IR.
!
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSystemVariables, ONLY: DetailedSkyDiffuseAlgorithm
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER,PARAMETER :: NPhi = 6 ! Number of altitude angle steps for sky integration
INTEGER,PARAMETER :: NTheta = 24 ! Number of azimuth angle steps for sky integration
REAL(r64),PARAMETER :: Eps = 1.d-10 ! Small number
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SurfNum ! Surface counter
INTEGER :: IPhi ! Altitude step counter
INTEGER :: ITheta ! Azimuth step counter
REAL(r64) :: DPhi ! Altitude step size
REAL(r64) :: DTheta ! Azimuth step size
REAL(r64) :: DThetaDPhi ! Product of DTheta and DPhi
REAL(r64) :: PhiMin ! Minimum altitude
REAL(r64) :: Phi ! Altitude angle
REAL(r64) :: Theta ! Azimuth angle
REAL(r64) :: CosPhi ! Cosine of Phi
REAL(r64) :: Fac1WoShdg ! Intermediate calculation factor, without shading
REAL(r64) :: FracIlluminated ! Fraction of surface area illuminated by a sky patch
REAL(r64) :: Fac1WithShdg ! Intermediate calculation factor, with shading
REAL(r64) :: SurfArea ! Surface area (m2)
LOGICAL :: ShadowingSurf ! True if surface is a shadowing surface
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: WithShdgIsoSky ! Diffuse solar irradiance from isotropic
! ! sky on surface, with shading
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: WoShdgIsoSky ! Diffuse solar from isotropic
! ! sky on surface, without shading
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: WithShdgHoriz ! Diffuse solar irradiance from horizon portion of
! ! sky on surface, with shading
!REAL(r64), ALLOCATABLE, DIMENSION(:) :: WoShdgHoriz ! Diffuse solar irradiance from horizon portion of
! ! sky on surface, without shading
!INTEGER iHour,iTS
! FLOW:
! Initialize Surfaces Arrays
SAREA = 0.0d0
ALLOCATE (WithShdgIsoSky(TotSurfaces))
WithShdgIsoSky=0.0d0
ALLOCATE (WoShdgIsoSky(TotSurfaces))
WoShdgIsoSky=0.0d0
ALLOCATE (WithShdgHoriz(TotSurfaces))
WithShdgHoriz=0.0d0
ALLOCATE (WoShdgHoriz(TotSurfaces))
WoShdgHoriz=0.0d0
ALLOCATE (DifShdgRatioIsoSky(TotSurfaces))
ALLOCATE (DifShdgRatioHoriz(TotSurfaces))
! initialized as no shading
DifShdgRatioIsoSky = 1.0d0
DifShdgRatioHoriz = 1.0d0
IF (DetailedSkyDiffuseAlgorithm .and. ShadingTransmittanceVaries .and. &
SolarDistribution /= MinimalShadowing) THEN
ALLOCATE (curDifShdgRatioIsoSky(TotSurfaces))
curDifShdgRatioIsoSky = 1.0d0
ENDIF
! only for detailed.
IF (DetailedSkyDiffuseAlgorithm .and. ShadingTransmittanceVaries .and. &
SolarDistribution /= MinimalShadowing) THEN
ALLOCATE (DifShdgRatioIsoSkyHRTS(TotSurfaces,24,NumOfTimeStepInHour))
DifShdgRatioIsoSkyHRTS=1.0d0
ALLOCATE (DifShdgRatioHorizHRTS(TotSurfaces,24,NumOfTimeStepInHour))
DifShdgRatioHorizHRTS=1.0d0
ENDIF
do surfnum=1,totsurfaces
IF (.not. Surface(surfnum)%ExtSolar) cycle
! CurrentModuleObject='Surfaces'
IF (DetailedSkyDiffuseAlgorithm .and. ShadingTransmittanceVaries .and. &
SolarDistribution /= MinimalShadowing) THEN
CALL SetupOutputVariable('Debug Surface Solar Shading Model DifShdgRatioIsoSky []',curDifShdgRatioIsoSky(Surfnum), &
'Zone','Average',Surface(surfnum)%Name)
ELSE
CALL SetupOutputVariable('Debug Surface Solar Shading Model DifShdgRatioIsoSky []',DifShdgRatioIsoSky(Surfnum), &
'Zone','Average',Surface(surfnum)%Name)
ENDIF
CALL SetupOutputVariable('Debug Surface Solar Shading Model DifShdgRatioHoriz []',DifShdgRatioHoriz(Surfnum), &
'Zone','Average',Surface(surfnum)%Name)
CALL SetupOutputVariable('Debug Surface Solar Shading Model WithShdgIsoSky []',WithShdgIsoSky(surfnum), &
'Zone','Average',Surface(surfnum)%Name)
CALL SetupOutputVariable('Debug Surface Solar Shading Model WoShdgIsoSky []',WoShdgIsoSky(surfnum), &
'Zone','Average',Surface(surfnum)%Name)
enddo
DPhi = PiOvr2/NPhi ! 15 deg for NPhi = 6
DTheta = 2.d0*Pi/NTheta ! 15 deg for NTheta = 24
DThetaDPhi = DTheta*DPhi
PhiMin = 0.5d0*DPhi ! 7.5 deg for DPhi = 15 deg
DO IPhi = 1,NPhi ! Loop over patch altitude values
Phi = PhiMin + (IPhi-1)*DPhi ! 7.5,22.5,37.5,52.5,67.5,82.5 for NPhi = 6
SUNCOS(3) = SIN(Phi)
CosPhi = COS(Phi)
DO ITheta = 1,NTheta ! Loop over patch azimuth values
Theta = (ITheta-1)*DTheta ! 0,15,30,....,330,345 for NTheta = 24
SUNCOS(1) = CosPhi*COS(Theta)
SUNCOS(2) = CosPhi*SIN(Theta)
DO SurfNum = 1,TotSurfaces ! Cosine of angle of incidence on surface of solar
! radiation from patch
ShadowingSurf = Surface(SurfNum)%ShadowingSurf
IF (.NOT. ShadowingSurf .AND. .NOT. Surface(SurfNum)%HeatTransSurf) CYCLE
CTHETA(SurfNum) = SUNCOS(1)*Surface(SurfNum)%OutNormVec(1) &
+ SUNCOS(2)*Surface(SurfNum)%OutNormVec(2) &
+ SUNCOS(3)*Surface(SurfNum)%OutNormVec(3)
END DO
CALL SHADOW(0,0)
DO SurfNum = 1,TotSurfaces
ShadowingSurf = Surface(SurfNum)%ShadowingSurf
IF(.NOT.ShadowingSurf .AND. (.NOT.Surface(SurfNum)%HeatTransSurf .OR. &
.NOT.Surface(SurfNum)%ExtSolar .OR. &
(Surface(SurfNum)%ExtBoundCond /= ExternalEnvironment .AND. &
Surface(SurfNum)%ExtBoundCond /= OtherSideCondModeledExt ))) CYCLE
IF(CTHETA(SurfNum) < 0.0d0) CYCLE
Fac1WoShdg = CosPhi * DThetaDPhi * CTHETA(SurfNum)
SurfArea = Surface(SurfNum)%NetAreaShadowCalc
IF (SurfArea > Eps) THEN
FracIlluminated = SAREA(SurfNum)/SurfArea
ELSE
FracIlluminated = SAREA(SurfNum)/(SurfArea+Eps)
ENDIF
Fac1WithShdg = Fac1WoShdg * FracIlluminated
WithShdgIsoSky(SurfNum) = WithShdgIsoSky(SurfNum) + Fac1WithShdg
WoShdgIsoSky(SurfNum) = WoShdgIsoSky(SurfNum) + Fac1WoShdg
! Horizon region
IF(IPhi == 1) THEN
WithShdgHoriz(SurfNum) = WithShdgHoriz(SurfNum) + Fac1WithShdg
WoShdgHoriz(SurfNum) = WoShdgHoriz(SurfNum) + Fac1WoShdg
END IF
END DO ! End of surface loop
END DO ! End of Theta loop
END DO ! End of Phi loop
DO SurfNum = 1,TotSurfaces
ShadowingSurf = Surface(SurfNum)%ShadowingSurf
IF(.NOT.ShadowingSurf .AND. &
(.NOT.Surface(SurfNum)%HeatTransSurf .OR. .NOT.Surface(SurfNum)%ExtSolar .OR. &
(Surface(SurfNum)%ExtBoundCond /= ExternalEnvironment .AND. &
Surface(SurfNum)%ExtBoundCond /= OtherSideCondModeledExt) )) CYCLE
IF (ABS(WoShdgIsoSky(SurfNum)) > Eps) THEN
DifShdgRatioIsoSky(SurfNum) = (WithShdgIsoSky(SurfNum))/(WoShdgIsoSky(SurfNum))
ELSE
DifShdgRatioIsoSky(SurfNum) = (WithShdgIsoSky(SurfNum))/(WoShdgIsoSky(SurfNum)+Eps)
ENDIF
IF (ABS(WoShdgHoriz(SurfNum)) > Eps) THEN
DifShdgRatioHoriz(SurfNum) = (WithShdgHoriz(SurfNum))/(WoShdgHoriz(SurfNum))
ELSE
DifShdgRatioHoriz(SurfNum) = (WithShdgHoriz(SurfNum))/(WoShdgHoriz(SurfNum)+Eps)
ENDIF
END DO
! Get IR view factors. An exterior surface can receive IR radiation from
! sky, ground or shadowing surfaces. Assume shadowing surfaces have same
! temperature as outside air (and therefore same temperature as ground),
! so that the view factor to these shadowing surfaces can be included in
! the ground view factor. Sky IR is assumed to be isotropic and shadowing
! surfaces are assumed to be opaque to IR so they totally "shade" IR from
! sky or ground.
DO SurfNum = 1,TotSurfaces
IF (.not. DetailedSkyDiffuseAlgorithm .or. .not. ShadingTransmittanceVaries .or. &
SolarDistribution == MinimalShadowing) THEN
Surface(SurfNum)%ViewFactorSkyIR = Surface(SurfNum)%ViewFactorSkyIR * DifShdgRatioIsoSky(SurfNum)
ELSE
Surface(SurfNum)%ViewFactorSkyIR = Surface(SurfNum)%ViewFactorSkyIR * DifShdgRatioIsoSkyHRTS(SurfNum,1,1)
ENDIF
Surface(SurfNum)%ViewFactorGroundIR = 1.0d0 - Surface(SurfNum)%ViewFactorSkyIR
END DO
! DEALLOCATE (WithShdgIsoSky)
! DEALLOCATE (WoShdgIsoSky)
! DEALLOCATE (WithShdgHoriz)
! DEALLOCATE (WoShdgHoriz)
IF (DetailedSkyDiffuseAlgorithm .and. ShadingTransmittanceVaries .and. &
SolarDistribution /= MinimalShadowing) THEN
DO SurfNum = 1,TotSurfaces
DifShdgRatioIsoSkyHRTS(SurfNum,1:24,1:NumOfTimeStepInHour)=DifShdgRatioIsoSky(SurfNum)
DifShdgRatioHorizHRTS(SurfNum,1:24,1:NumOfTimeStepInHour)=DifShdgRatioHoriz(SurfNum)
ENDDO
ENDIF
RETURN
END SUBROUTINE SkyDifSolarShading