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 CalcDayltgCoefficients
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN July 1997
! MODIFIED FW, Jan 2002: add variable slat angle blinds
! FW, Mar 2002: add triangular windows
! FW, Oct 2002: remove warning on window discretization relative to
! reference point distance to window plane
! FW, Jan 2003: add between-glass shades and blinds
! FW, Apr 2003: initialize shading type to 'NOSHADE' in window loop
! PE, May 2003: add light pipes (tubular daylighting devices)
! FW, Jul 2003: account for possible non-zero transmittance of
! shading surfaces (previously all shading surfaces were
! assumed to be opaque)
! PE, Aug 2003: add daylighting shelves
! FW, Sep 2003: write the bare-window overcast sky daylight factors to the eio file
! FW, Nov 2003: add exterior beam and sky solar diffuse reflection from obstructions;
! add beam solar and sky solar reflection from ground with obstructions.
! FW, Nov 2003: change expression for NDIVX, NDIVY (no. of window elements in X,Y) to
! round up to nearest integer rather than down
! FW, Nov 2003: add specular reflection of beam solar from obstructions
! RJH, Jan 2004: add alternative daylighting analysis using DElight
! All modifications demarked with RJH (Rob Hitchcock)
! FW, Feb 2004: add daylighting through interior windows
! FW, Apr 2004: add light well efficiency that multiplies glazing transmittance
! FW, Apr 2004: add diffusing glazing
! RJH, Jul 2004: add error handling for warnings/errors returned from DElight
! LKL, Oct 2004: Separate "map" and "ref" point calculations -- move some input routines to
! separate routines.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates daylighting factors for later use in the time-step loop.
! METHODOLOGY EMPLOYED:
! For each combination of exterior window and reference point in a zone,
! calculates daylighting factors (interior illuminance / exterior illuminance)
! and glare factors for clear and overcast skies and for windows with and
! without shading devices. These factors are calculated for each hourly
! sun position for design days and for selected days throughout the year.
! If a target zone has one or more interior windows, also calculates daylighting
! factors for the target zone that are associated with exterior windows in adjacent
! zones that share interior windows with the target zone.
! The daylight illuminance at a reference point from a window is determined
! by dividing the window into rectangular elements and calculating the illuminance
! reaching the reference point directly from each element. The illumination
! from an element can come from the sky or ground if the window is unshaded, or from
! a shading device illuminated by solar radiation. Also considered are the
! illuminance contribution from interreflection among the zone's interior surfaces
! and sunlight striking the reference point.
! In calculating sky-related interior illuminance and luminance quantities,
! the sky luminance for the different sky types are determined from distributions
! in which the zenith luminance is normalized to 1.0 cd/m2. Similarly, sun-related
! illuminance and luminance quantities are based on beam normal solar illuminance
! normalized to 1.0 lux.
!
! The daylight and glare factors calculated in this subroutine are used in DayltgInteriorIllum
! to get the daylight illuminance and glare at each time step.
! Based on this information and user-input lighting setpoint and type of lighting
! control system, DayltgElecLightingControl then determines how much the overhead eletric lighting
! can be reduced.
! REFERENCES:
! Based on DOE-2.1E subroutine DCOF.
! USE STATEMENTS:
USE General, ONLY: POLYF, InterpProfAng, BlindBeamBeamTrans, RoundSigDigits
USE DaylightingDevices, ONLY: FindTDDPipe, TransTDD
USE SolarReflectionManager, ONLY: SolReflRecSurf
USE DataSystemVariables, ONLY: DetailedSolarTimestepIntegration
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: fmtA='(A)'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum ! Zone number
INTEGER :: IHR ! Hour of day counter
INTEGER :: IWin ! Window counter
INTEGER :: Loop ! DO loop indices
LOGICAL, SAVE :: FirstTime = .TRUE.
LOGICAL, SAVE :: FirstTimeDaylFacCalc = .TRUE.
REAL(r64) :: DaylFac1 ! sky daylight factor at ref pt 1
REAL(r64) :: DaylFac2 ! sky daylight factor at ref pt 2
! added for output all daylight factors
INTEGER, EXTERNAL :: GetNewUnitNumber ! External function to "get" a unit number
INTEGER :: write_stat
REAL(r64) :: DFClrSky1,DFClrTbSky1,DFIntSky1,DFOcSky1,DFClrSky2,DFClrTbSky2,DFIntSky2,DFOcSky2
REAL(r64) :: SlatAngle
INTEGER :: ISA, ICtrl
INTEGER :: ISlatAngle
LOGICAL, SAVE :: CreateDFSReportFile = .TRUE.
LOGICAL, SAVE :: doSkyReporting = .TRUE.
! FLOW:
IF (FirstTime) THEN
CALL GetDaylightingParametersInput
CALL CheckTDDsAndLightShelvesInDaylitZones
FirstTime = .FALSE.
IF (ALLOCATED(CheckTDDZone)) DEALLOCATE(CheckTDDZone)
END IF ! End of check if FirstTime
! Find the total number of exterior windows associated with all Daylighting:Detailed zones.
! An exterior window is associated with such a zone if (1) it is an exterior window in the zone, or
! (2) it is an exterior window in an adjacent zone that shares an interior window with the zone.
! Note that exterior windows in category (2) may be counted more than once if an adjacent zone
! is adjacent to more than one daylit zone with which the adjacent zone shares interior windows.
! If there are no interior windows in a building, than TotWindowsWithDayl is just the total number of
! exterior windows in Daylighting:Detailed zones. Note that it is possible for a
! Daylighting:Detailed zone to have zero exterior windows of its own, but it may have an interior
! through which daylight passes from adjacent zones with exterior windows.
IF (BeginSimFlag) THEN
TotWindowsWithDayl = 0
DO ZoneNum = 1,NumOfZones
TotWindowsWithDayl = TotWindowsWithDayl + ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
END DO
END IF
IF (TotWindowsWithDayl == 0) RETURN
!-----------------------------------------!
! Detailed daylighting factor calculation !
!-----------------------------------------!
IF (.NOT. DetailedSolarTimestepIntegration .and. .not. KickoffSizing .and. .not. KickoffSimulation) THEN
IF (WarmUpFlag) THEN
CALL DisplayString('Calculating Detailed Daylighting Factors, Start Date='//CurMnDy)
ELSE
CALL DisplayString('Updating Detailed Daylighting Factors, Start Date='//CurMnDy)
END IF
ENDIF
IF(BeginSimFlag) THEN
! Find minimum solid angle subtended by an interior window in Daylighting:Detailed zones.
! Used in calculating daylighting through interior windows.
CALL CalcMinIntWinSolidAngs
ALLOCATE(TDDTransVisBeam(NumOfTDDPipes,24))
ALLOCATE(TDDFluxInc(NumOfTDDPipes,4,24))
ALLOCATE(TDDFluxTrans(NumOfTDDPipes,4,24))
! Warning if detailed daylighting has been requested for a zone with no associated exterior windows.
DO ZoneNum = 1,NumOfZones
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 0 .AND. ZoneDaylight(ZoneNum)%NumOfDayltgExtWins == 0) THEN
CALL ShowWarningError('Detailed daylighting will not be done for zone='//TRIM(Zone(ZoneNum)%Name))
CALL ShowContinueError('because it has no associated exterior windows.')
END IF
END DO
! Find area and reflectance quantities used in calculating inter-reflected illuminance.
DO ZoneNum = 1,NumOfZones
!TH 9/10/2009. Need to calculate for zones without daylighting controls (TotalDaylRefPoints = 0)
! but with adjacent zones having daylighting controls.
IF((ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 0 .AND. ZoneDaylight(ZoneNum)%NumOfDayltgExtWins > 0) &
.OR. ZoneDaylight(ZoneNum)%AdjZoneHasDayltgCtrl) THEN
CALL DayltgAveInteriorReflectance(ZoneNum)
ENDIF
END DO
END IF
! Zero daylighting factor arrays
IF (.NOT. DetailedSolarTimestepIntegration) THEN
TDDTransVisBeam = 0.d0
TDDFluxInc = 0.d0
TDDFluxTrans = 0.d0
ELSE
TDDTransVisBeam(1:NumOfTDDPipes, HourOfDay) = 0.d0
TDDFluxInc(1:NumOfTDDPipes, 1:4, HourOfDay) = 0.d0
TDDFluxTrans(1:NumOfTDDPipes, 1:4, HourOfDay) = 0.d0
ENDIF
IF (.NOT. DetailedSolarTimestepIntegration) THEN
IF (BeginDayFlag) THEN
! Calculate hourly sun angles, clear sky zenith luminance, and exterior horizontal illuminance
PHSUN=0.d0
SPHSUN=0.d0
CPHSUN=0.d0
THSUN=0.d0
PHSUNHR=0.d0
SPHSUNHR=0.d0
CPHSUNHR=0.d0
THSUNHR=0.d0
GILSK=0.d0
GILSU=0.d0
DO IHR = 1,24
IF (SUNCOSHR(3,IHR) < SunIsUpValue) CYCLE ! Skip if sun is below horizon
PHSUN = PIOVR2 - ACOS(SUNCOSHR(3,IHR))
PHSUNHR(IHR) = PHSUN
SPHSUNHR(IHR) = SIN(PHSUN)
CPHSUNHR(IHR) = COS(PHSUN)
THSUNHR(IHR) = ATAN2(SUNCOSHR(2,IHR),SUNCOSHR(1,IHR))
! Get exterior horizontal illuminance from sky and sun
THSUN=THSUNHR(IHR)
SPHSUN = SPHSUNHR(IHR)
CPHSUN = CPHSUNHR(IHR)
CALL DayltgExtHorizIllum(GILSK(1,IHR),GILSU(IHR))
END DO
ENDIF
ELSE !timestep integrated calculations
PHSUN=0.d0
SPHSUN=0.d0
CPHSUN=0.d0
THSUN=0.d0
PHSUNHR(HourOfDay) = 0.d0
SPHSUNHR(HourOfDay) = 0.d0
CPHSUNHR(HourOfDay) = 0.d0
THSUNHR(HourOfDay) = 0.d0
GILSK(1:4,HourOfDay) = 0.d0
GILSU(HourOfDay) = 0.d0
IF (.NOT. (SUNCOSHR(3,HourOfDay) < SunIsUpValue)) THEN ! Skip if sun is below horizon
PHSUN = PIOVR2 - ACOS(SUNCOSHR(3,HourOfDay))
PHSUNHR(HourOfDay) = PHSUN
SPHSUNHR(HourOfDay) = SIN(PHSUN)
CPHSUNHR(HourOfDay) = COS(PHSUN)
THSUNHR(HourOfDay) = ATAN2(SUNCOSHR(2,HourOfDay),SUNCOSHR(1,HourOfDay))
! Get exterior horizontal illuminance from sky and sun
THSUN=THSUNHR(HourOfDay)
SPHSUN = SPHSUNHR(HourOfDay)
CPHSUN = CPHSUNHR(HourOfDay)
CALL DayltgExtHorizIllum(GILSK(1,HourOfDay),GILSU(HourOfDay))
ENDIF
ENDIF
! -----------
! ---------- ZONE LOOP ----------
! -----------
DO ZoneNum = 1,NumOfZones
! Skip zones that are not Daylighting:Detailed zones.
! TotalDaylRefPoints = 0 means zone has (1) no daylighting or
! (3) Daylighting:DElight
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints == 0) CYCLE
! Skip zones with no exterior windows in the zone or in adjacent zone with which an interior window is shared
IF(ZoneDaylight(ZoneNum)%NumOfDayltgExtWins == 0) CYCLE
CALL CalcDayltgCoeffsRefMapPoints(ZoneNum)
END DO ! End of zone loop, ZoneNum
IF (doSkyReporting) THEN
IF (.not. KickOffSizing .and. .not. KickOffSimulation) THEN
IF(FirstTimeDaylFacCalc .AND. TotWindowsWithDayl > 0) THEN
! Write the bare-window four sky daylight factors at noon time to the eio file; this is done only
! for first time that daylight factors are calculated and so is insensitive to possible variation
! due to change in ground reflectance from month to month, or change in storm window status.
Write(OutputFileInits,700)
700 Format( &
'! <Sky Daylight Factors>, MonthAndDay, Zone Name, Window Name, Daylight Fac: Ref Pt #1, Daylight Fac: Ref Pt #2')
DO ZoneNum = 1, NumOfZones
IF(ZoneDaylight(ZoneNum)%NumOfDayltgExtWins == 0) CYCLE
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
! For this report, do not include ext wins in zone adjacent to ZoneNum since the inter-reflected
! component will not be calculated for these windows until the time-step loop.
IF(Surface(IWin)%Zone == ZoneNum) THEN
! clear sky
DaylFac1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,1,1,12)
DaylFac2 = 0.0d0
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) DaylFac2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,1,1,12)
Write(OutputFileInits,fmtA) ' Clear Sky Daylight Factors,'// &
trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//','// &
trim(RoundSigDigits(DaylFac1,4))//','//trim(RoundSigDigits(DaylFac2,4))
! clear Turbid sky
DaylFac1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,2,1,12)
DaylFac2 = 0.0d0
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) DaylFac2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,2,1,12)
Write(OutputFileInits,fmtA) ' Clear Turbid Sky Daylight Factors,'// &
trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//','// &
trim(RoundSigDigits(DaylFac1,4))//','//trim(RoundSigDigits(DaylFac2,4))
! Intermediate sky
DaylFac1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,3,1,12)
DaylFac2 = 0.0d0
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) DaylFac2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,3,1,12)
Write(OutputFileInits,fmtA) ' Intermediate Sky Daylight Factors,'// &
trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//','// &
trim(RoundSigDigits(DaylFac1,4))//','//trim(RoundSigDigits(DaylFac2,4))
! Overcast sky
DaylFac1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,4,1,12)
DaylFac2 = 0.0d0
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) DaylFac2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,4,1,12)
Write(OutputFileInits,fmtA) ' Overcast Sky Daylight Factors,'// &
trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//','// &
trim(RoundSigDigits(DaylFac1,4))//','//trim(RoundSigDigits(DaylFac2,4))
END IF
END DO
END DO
FirstTimeDaylFacCalc = .FALSE.
doSkyReporting=.false.
END IF
END IF
END IF
! TH 7/2010 report all daylight factors for the two reference points of daylight zones ...
! Skip if no daylight windows
IF(TotWindowsWithDayl == 0) RETURN
! Skip if no request of reporting
IF((.NOT. DFSReportSizingDays) .AND. (.NOT. DFSReportAllShadowCalculationDays)) RETURN
! Skip duplicate calls
IF (KickOffSizing) RETURN
IF (DoingSizing) RETURN
IF (KickOffSimulation) RETURN
IF (DFSReportSizingDays) THEN
IF (DoWeathSim .AND. DoDesDaySim) THEN
IF (KindOfSim == ksRunPeriodWeather) RETURN
ENDIF
ENDIF
IF (DFSReportAllShadowCalculationDays) THEN
IF (KindOfSim /= ksRunPeriodWeather) RETURN
ENDIF
! open a new file eplusout.dfs for saving the daylight factors
IF (CreateDFSReportFile) THEN
OutputFileDFS = GetNewUnitNumber()
OPEN(OutputFileDFS,FILE='eplusout.dfs', Action='write',iostat=write_stat)
IF (write_stat /= 0) THEN
CALL ShowFatalError('CalcDayltgCoefficients: Could not open file "eplusout.dfs" for output (write).')
ELSE
Write(OutputFileDFS,fmtA) 'This file contains daylight factors for all exterior windows of daylight zones.'
Write(OutputFileDFS,fmtA) 'If only one reference point the last 4 columns in the data will be zero.'
Write(OutputFileDFS,fmtA) 'MonthAndDay,Zone Name,Window Name,Window State'
Write(OutputFileDFS,fmtA) 'Hour,Daylight Factor for Clear Sky at Reference point 1,'// &
'Daylight Factor for Clear Turbid Sky at Reference point 1,Daylight Factor for Intermediate Sky at Reference point 1,'// &
'Daylight Factor for Overcast Sky at Reference point 1,Daylight Factor for Clear Sky at Reference point 2,'// &
'Daylight Factor for Clear Turbid Sky at Reference point 2,Daylight Factor for Intermediate Sky at Reference point 2,'// &
'Daylight Factor for Overcast Sky at Reference point 2'
ENDIF
CreateDFSReportFile = .false.
ENDIF
DO ZoneNum = 1, NumOfZones
IF(ZoneDaylight(ZoneNum)%NumOfDayltgExtWins == 0) CYCLE
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
ICtrl = Surface(IWin)%WindowShadingControlPtr
! For this report, do not include ext wins in zone adjacent to ZoneNum since the inter-reflected
! component will not be calculated for these windows until the time-step loop.
IF(Surface(IWin)%Zone == ZoneNum) THEN
IF (SurfaceWindow(IWin)%MovableSlats) THEN
! variable slat angle - MaxSlatangle sets
ISA = MaxSlatAngs + 1
ELSEIF (ICtrl > 0) THEN
! window shade or blind with fixed slat angle
ISA = 2
ELSE
! base window
ISA = 1
ENDIF
! loop over each slat angle
DO ISlatAngle = 1, ISA
IF (ISlatAngle == 1) THEN
! base window without shades, screens, or blinds
Write(OutputFileDFS,fmtA) trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//',Base Window'
ELSEIF (ISlatAngle == 2 .AND. ISA == 2) THEN
! window shade or blind with fixed slat angle
Write(OutputFileDFS,fmtA) trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//', '
ELSE
! blind with variable slat angle
SlatAngle = 180.d0/real((MaxSlatAngs - 1),r64) * real((ISlatAngle - 2),r64)
Write(OutputFileDFS,fmtA) trim(CurMnDy)//','//TRIM(Zone(ZoneNum)%Name)//','//TRIM(Surface(IWin)%Name)//','// &
trim(RoundSigDigits(SlatAngle,1))
ENDIF
DO IHR = 1, 24
! daylight reference point 1
DFClrSky1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,1,ISlatAngle,IHR) ! clear sky
DFClrTbSky1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,2,ISlatAngle,IHR) ! clear Turbid sky
DFIntSky1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,3,ISlatAngle,IHR) ! Intermediate sky
DFOcSky1 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,1,4,ISlatAngle,IHR) ! Overcast sky
! daylight reference point 2
IF(ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) THEN
DFClrSky2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,1,ISlatAngle,IHR)
DFClrTbSky2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,2,ISlatAngle,IHR)
DFIntSky2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,3,ISlatAngle,IHR)
DFOcSky2 = ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,2,4,ISlatAngle,IHR)
ELSE
DFClrSky2 = 0.0d0
DFClrTbSky2 = 0.0d0
DFIntSky2 = 0.0d0
DFOcSky2 = 0.0d0
ENDIF
! write daylight factors - 4 sky types for each daylight ref point
Write(OutputFileDFS,fmtA) trim(RoundSigDigits(IHR))//','// &
trim(RoundSigDigits(DFClrSky1,5))//','//trim(RoundSigDigits(DFClrTbSky1,5))//','// &
trim(RoundSigDigits(DFIntSky1,5))//','//trim(RoundSigDigits(DFOcSky1,5))//','// &
trim(RoundSigDigits(DFClrSky2,5))//','//trim(RoundSigDigits(DFClrTbSky2,5))//','// &
trim(RoundSigDigits(DFIntSky2,5))//','//trim(RoundSigDigits(DFOcSky2,5))
END DO ! hour loop
END DO
END IF
END DO ! exterior windows in zone loop
END DO ! zone loop
RETURN
END SUBROUTINE CalcDayltgCoefficients