Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer | :: | ZoneNum |
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 DayltgInterReflIllFrIntWins(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN Mar. 2004
! MODIFIED:na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates the inter-reflected illuminance in a daylit zone from beam
! and diffuse daylight entering the zone through interior windows. This illuminance
! is determined by the split-flux method and is assumed to be uniform, i.e., the same
! at all reference points.
! METHODOLOGY EMPLOYED:na
! REFERENCES:na
! USE STATEMENTS:
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ZoneNum ! Zone number
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: IWin ! Window number
INTEGER :: ConstrNum ! Window construction number
INTEGER :: AdjZoneNum ! Adjacent zone number
REAL(r64) :: QDifTrans ! Luminous flux transmitted through an int win from adjacent zone (lumens)
REAL(r64) :: QDifTransUp ! Upgoing part of QDifTrans (lumens)
REAL(r64) :: QDifTransDn ! Downgoing part of QDifTrans (lumens)
REAL(r64) :: DifInterReflIllThisWin ! Inter-reflected illuminance due to QDifTrans (lux)
REAL(r64) :: BmInterReflIll ! Inter-reflected illuminance due to beam solar entering ZoneNum
! through its interior windows (lux)
! FLOW:
ZoneDaylight(ZoneNum)%InterReflIllFrIntWins = 0.0d0
DO IWin = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF(Surface(IWin)%Class == SurfaceClass_Window .AND. Surface(IWin)%ExtBoundCond >= 1) THEN
! This is an interior window in ZoneNum
ConstrNum = Surface(IWin)%Construction
AdjZoneNum = Surface(Surface(IWin)%ExtBoundCond)%Zone
QDifTrans = QSDifSol(AdjZoneNum) * Construct(ConstrNum)%TransDiffVis * Surface(IWin)%Area * PDIFLW
QDifTransUp = QDifTrans * SurfaceWindow(IWin)%FractionUpgoing
QDifTransDn = QDifTrans * (1.d0 - SurfaceWindow(IWin)%FractionUpgoing)
IF (ZoneDaylight(ZoneNum)%TotInsSurfArea * (1.d0-ZoneDaylight(ZoneNum)%AveVisDiffReflect) /= 0.0d0) THEN
DifInterReflIllThisWin = &
(QDifTransDn * SurfaceWindow(IWin)%RhoFloorWall + QDifTransUp * SurfaceWindow(IWin)%RhoCeilingWall)/ &
(ZoneDaylight(ZoneNum)%TotInsSurfArea * (1.d0-ZoneDaylight(ZoneNum)%AveVisDiffReflect))
ELSE
DifInterReflIllThisWin = 0.0d0
ENDIF
ZoneDaylight(ZoneNum)%InterReflIllFrIntWins = ZoneDaylight(ZoneNum)%InterReflIllFrIntWins + &
DifInterReflIllThisWin
END IF
END DO
! Add inter-reflected illuminance from beam solar entering ZoneNum through interior windows
! TH, CR 7873, 9/17/2009
BmInterReflIll = 0.0d0
IF (ZoneDaylight(ZoneNum)%TotInsSurfArea > 0) THEN
BmInterReflIll = (DBZoneIntWin(ZoneNum) * BeamSolarRad * PDIRLW * ZoneDaylight(ZoneNum)%FloorVisRefl)/ &
(ZoneDaylight(ZoneNum)%TotInsSurfArea * (1.d0-ZoneDaylight(ZoneNum)%AveVisDiffReflect))
ENDIF
ZoneDaylight(ZoneNum)%InterReflIllFrIntWins = ZoneDaylight(ZoneNum)%InterReflIllFrIntWins + BmInterReflIll
RETURN
END SUBROUTINE DayltgInterReflIllFrIntWins