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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | PipeNum | |||
real(kind=r64), | intent(in) | :: | COSI |
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.
REAL(r64) FUNCTION CalcTDDTransSolAniso(PipeNum, COSI)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN July 2003
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the transmittance of the anisotropic sky.
! METHODOLOGY EMPLOYED:
! Similar to the Trans = FluxTrans/FluxInc integrations above, the anisotropic sky can be decomposed
! and have a different transmittance applied to each component.
!
! FluxInc = IsoSkyRad + CircumSolarRad + HorizonRad
! FluxTrans = T1*IsoSkyRad + T2*CircumSolarRad + T3*HorizonRad
!
! It turns out that FluxTrans/FluxInc is equivalent to AnisoSkyTDDMult/AnisoSkyMult.
! AnisoSkyMult has been conveniently calculated already in AnisoSkyViewFactors in SolarShading.f90.
!
! AnisoSkyMult = MultIsoSky*DifShdgRatioIsoSky + MultCircumSolar*SunLitFrac + MultHorizonZenith*DifShdgRatioHoriz
!
! In this routine a similar AnisoSkyTDDMult is calculated that applies the appropriate transmittance to each
! of the components above. The result is Trans = AnisoSkyTDDMult/AnisoSkyMult.
!
! Shading and orientation are already taken care of by DifShdgRatioIsoSky and DifShdgRatioHoriz.
! REFERENCES:
! See AnisoSkyViewFactors in SolarShading.f90.
! USE STATEMENTS: na
USE DataGlobals, ONLY: HourOfDay, TimeStep
USE DataHeatBalance, ONLY: SunlitFrac, AnisoSkyMult, DifShdgRatioIsoSky, DifShdgRatioHoriz, &
MultIsoSky, MultCircumSolar, MultHorizonZenith, curDifShdgRatioIsoSky, DifShdgRatioHorizHRTS
USE DataSystemVariables, ONLY: DetailedSkyDiffuseAlgorithm
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! FUNCTION ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: PipeNum ! TDD pipe object number
REAL(r64), INTENT(IN) :: COSI ! Cosine of the incident angle
! FUNCTION LOCAL VARIABLE DECLARATIONS:
INTEGER :: DomeSurf ! TDD:DOME surface number
REAL(r64) :: IsoSkyRad ! Isotropic sky radiation component
REAL(r64) :: CircumSolarRad ! Circumsolar sky radiation component
REAL(r64) :: HorizonRad ! Horizon sky radiation component
REAL(r64) :: AnisoSkyTDDMult ! Anisotropic sky multiplier for TDD
! FLOW:
DomeSurf = TDDPipe(PipeNum)%Dome
IF (.not. DetailedSkyDiffuseAlgorithm .or. .not. ShadingTransmittanceVaries .or. &
SolarDistribution == MinimalShadowing) THEN
IsoSkyRad = MultIsoSky(DomeSurf) * DifShdgRatioIsoSky(DomeSurf)
HorizonRad = MultHorizonZenith(DomeSurf) * DifShdgRatioHoriz(DomeSurf)
ELSE
IsoSkyRad = MultIsoSky(DomeSurf) * curDifShdgRatioIsoSky(DomeSurf)
HorizonRad = MultHorizonZenith(DomeSurf) * DifShdgRatioHorizHRTS(DomeSurf,HourOfDay,TimeStep)
ENDIF
CircumSolarRad = MultCircumSolar(DomeSurf) * SunlitFrac(DomeSurf,HourOfDay,TimeStep)
AnisoSkyTDDMult = &
TDDPipe(PipeNum)%TransSolIso * IsoSkyRad &
+ TransTDD(PipeNum, COSI, SolarBeam) * CircumSolarRad &
+ TDDPipe(PipeNum)%TransSolHorizon * HorizonRad
IF (AnisoSkyMult(DomeSurf) > 0.0d0) THEN
CalcTDDTransSolAniso = AnisoSkyTDDMult / AnisoSkyMult(DomeSurf)
ELSE
CalcTDDTransSolAniso = 0.0d0
ENDIF
RETURN
END FUNCTION CalcTDDTransSolAniso