SUBROUTINE DayltgInteriorIllum(ZoneNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN July 1997
! MODIFIED March 2000, FCW: interpolate clear-sky daylight factors using
! HourOfDay/WeightNow and NextHour/WeightNextHour. Previously
! only HourOfDay was used
! Jan 2001, FCW: interpolate in slat angle for windows with blinds
! that have movable slats
! Oct 2002, LKL: changed interpolation steps to HourOfDay/WeightNow
! LastHour/WeightPreviousHour
! Aug 2003, FCW: fix bug that prevented ShadingControlType =
! MEETDAYLIGHTILLUMINANCESETPOINT from working
! Mar 2004, FCW: fix bug in calc of illuminance setpoint contribution
! to background luminance: now it is divided by pi to give cd/m2
! Mar 2004, FCW: modify to handle daylighting through interior windows
! June 2009, TH: modified for thermochromic windows
! Jan 2010, TH (CR 7984): added iterations for switchable windows with shading
! control of MeetDaylightIlluminanceSetpoint and glare control is active
! Also corrected bugs (CR 7988) for switchable glazings not related to CR 7984
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Using daylighting factors and exterior illuminance, determine
! the current-hour interior daylight illuminance and glare index
! at each reference point in a space. Deploy window shading window by window
! if glare control is active for window and if the acceptable glare index
! is exceeded at both reference points.
! Called by InitSurfaceHeatBalance.
! METHODOLOGY EMPLOYED:na
! REFERENCES:
! Based on DOE-2.1E subroutine DINTIL.
! USE STATEMENTS:
USE General, ONLY: POLYF, InterpSlatAng
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: ZoneNum ! Zone number
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64),PARAMETER :: tmpSWIterStep = 0.05d0 ! step of switching factor, assuming maximum of 20 switching states
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NREFPT ! Number of daylighting reference points
INTEGER :: ISky ! Sky type index
INTEGER :: ISky1, ISky2 ! Sky type index values for averaging two sky types
REAL(r64) :: SetPnt(2) ! Illuminance setpoint at reference points (lux)
REAL(r64) :: DFSKHR(4,2) ! Sky daylight factor for sky type (first index),
! bare/shaded window (second index)
REAL(r64) :: DFSUHR(2) ! Sun daylight factor for bare/shaded window
REAL(r64) :: BFSKHR(4,2) ! Sky background luminance factor for sky type (first index),
! bare/shaded window (second index)
REAL(r64) :: BFSUHR(2) ! Sun background luminance factor for bare/shaded window
REAL(r64) :: SFSKHR(4,2) ! Sky source luminance factor for sky type (first index),
! bare/shaded window (second index)
REAL(r64) :: SFSUHR(2) ! Sun source luminance factor for bare/shaded window
REAL(r64) :: WDAYIL(2,2) ! Illuminance from window at reference point (first index)
! for shade open/closed (second index)
REAL(r64) :: WBACLU(2,2) ! Background illuminance from window at reference point (first index)
! for shade open/closed (second index)
REAL(r64) :: RDAYIL(2) ! Illuminance from window at reference point after closing shade
REAL(r64) :: RBACLU(2) ! Background illuminance from window at reference point after closing shade
REAL(r64) :: GLRNDX(2) ! Glare index at reference point
REAL(r64) :: GLRNEW(2) ! New glare index at reference point
INTEGER :: IL ! Reference point index
INTEGER :: IWin ! Window index
INTEGER :: IS ! IS=1 for unshaded window, =2 for shaded window
INTEGER :: ISWFLG ! Switchable glazing flag: =1 if one or more windows in a zone
! has switchable glazing that adjusts visible transmittance to just meet
! daylighting setpoint; =0 otherwise.
INTEGER :: IConst ! Window construction pointer
INTEGER :: IConstShaded ! Pointer to shaded window construction
INTEGER :: ICtrl ! Window shading control pointer
REAL(r64) :: DILLSW,DILLUN ! Illuminance a ref point from windows that can be switched,
! and from those that can't (lux)
REAL(r64) :: ASETIL ! Illuminance ratio (lux)
REAL(r64) :: TVIS1 ! Visible transmittance at normal incidence of unswitched glazing
REAL(r64) :: TVIS2 ! Visible transmittance at normal incidence of fully-switched glazing
REAL(r64) :: VTRAT ! Ratio between switched and unswitched visible transmittance at normal incidence
REAL(r64) :: BACL ! Window background (surround) luminance for glare calc (cd/m2)
REAL(r64) :: SkyWeight ! Weighting factor used to average two different sky types
REAL(r64) :: HorIllSky(4) ! Horizontal illuminance for different sky types
REAL(r64) :: HorIllSkyFac ! Ratio between horizontal illuminance from sky horizontal irradiance and
! luminous efficacy and horizontal illuminance from averaged sky
REAL(r64) :: SlatAng ! Blind slat angle (rad)
LOGICAL :: VarSlats ! True if slats are movable, i.e., variable angle
LOGICAL :: GlareFlag ! True if maximum glare is exceeded
INTEGER :: loop ! Loop index
REAL(r64) :: VTRatio ! VT (visible transmittance) ratio = VTNow / VTMaster
REAL(r64) :: VTNow ! VT of the time step actual TC window
REAL(r64) :: VTMaster ! VT of the base/master TC window
! Added variables for glare iterations for switchable glazings
REAL(r64) :: tmpSWSL1 = 0.0d0
REAL(r64) :: tmpSWSL2 = 0.0d0
REAL(r64) :: tmpSWFactor = 0.0d0 ! new switching factor to meet glare criteria
REAL(r64) :: tmpSWFactor0 = 0.0d0 ! original switching factor to meet daylight illuminance
REAL(r64) :: tmpMult = 0.0d0
LOGICAL :: GlareOK = .False.
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmpIllumFromWinAtRefPt
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmpBackLumFromWinAtRefPt
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tmpSourceLumFromWinAtRefPt
LOGICAL, SAVE :: firsttime=.true. ! true first time routine is called
LOGICAL :: blnCycle = .False.
! Three arrays to save original clear and dark (fully switched) states'
! zone/window daylighting properties.
IF (firsttime) THEN
ALLOCATE(tmpIllumFromWinAtRefPt(2,2,MAX(MAXVAL(Zone%NumSubSurfaces),MAXVAL(ZoneDaylight%NumOfDayltgExtWins))))
ALLOCATE(tmpBackLumFromWinAtRefPt(2,2,MAX(MAXVAL(Zone%NumSubSurfaces),MAXVAL(ZoneDaylight%NumOfDayltgExtWins))))
ALLOCATE(tmpSourceLumFromWinAtRefPt(2,2,MAX(MAXVAL(Zone%NumSubSurfaces),MAXVAL(ZoneDaylight%NumOfDayltgExtWins))))
firsttime=.false.
ENDIF
tmpIllumFromWinAtRefPt = 0.0d0
tmpBackLumFromWinAtRefPt = 0.0d0
tmpSourceLumFromWinAtRefPt = 0.0d0
! FLOW:
! Limit the number of control reference points to 2
NREFPT = ZoneDaylight(ZoneNum)%TotalDaylRefPoints
IF (NREFPT > 2) NREFPT = 2
! Initialize reference point illuminance and window background luminance
DO IL = 1,NREFPT
SetPnt(IL) = ZoneDaylight(ZoneNum)%IllumSetPoint(IL)
DaylIllum(IL) = 0.0d0
ZoneDaylight(ZoneNum)%BacLum(IL) = 0.0d0
END DO
IF (SkyClearness > 3.0d0) THEN ! Sky is average of clear and clear turbid
SkyWeight = MIN(1.0d0,(SkyClearness-3.d0)/3.d0)
ISky1 = 1
ISky2 = 2
ELSE IF (SkyClearness > 1.2d0) THEN ! Sky is average of clear turbid and intermediate
SkyWeight = (SkyClearness - 1.2d0)/1.8d0
ISky1 = 2
ISky2 = 3
ELSE ! Sky is average of intermediate and overcast
SkyWeight = MIN(1.0d0, MAX(0.0d0, (SkyClearness-1.d0)/0.2d0, (SkyBrightness-0.05d0)/0.4d0))
ISky1 = 3
ISky2 = 4
END IF
! First loop over exterior windows associated with this zone. The window may be an exterior window in
! the zone or an exterior window in an adjacent zone that shares an interior window with the zone.
! Find contribution of each window to the daylight illum and to the glare numerator at each reference point.
! Use shading flags set in WindowShadingManager.
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
! Added TH 6/29/2009 for thermochromic windows
VTRatio = 1.0d0
IF (NREFPT > 0) THEN
IConst = Surface(IWin)%Construction
IF (Construct(IConst)%TCFlag == 1) THEN
! For thermochromic windows, daylight and glare factors are always calculated
! based on the master construction. They need to be adjusted by the VTRatio, including:
! ZoneDaylight()%DaylIllFacSky, DaylIllFacSun, DaylIllFacSunDisk; DaylBackFacSky,
! DaylBackFacSun, DaylBackFacSunDisk, DaylSourceFacSky, DaylSourceFacSun, DaylSourceFacSunDisk
VTNow = POLYF(1.0d0,Construct(IConst)%TransVisBeamCoef(1))
VTMaster = POLYF(1.0d0,Construct(Construct(IConst)%TCMasterConst)%TransVisBeamCoef(1))
VTRatio = VTNow / VTMaster
ENDIF
ENDIF
! Loop over reference points
DO IL = 1, NREFPT
! Daylight factors for current sun position
DO ISky = 1,4
! ===Bare window===
DFSKHR(ISky,1) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,1,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,1,PreviousHour))
IF (ISky == 1) DFSUHR(1) = VTRatio * (WeightNow * (ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,1,HourOfDay) + &
ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,1,HourOfDay)) + &
WeightPreviousHour * (ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,1,PreviousHour) + &
ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,1,PreviousHour)))
BFSKHR(ISky,1) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,1,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,1,PreviousHour))
IF (ISky == 1) BFSUHR(1) = VTRatio * (WeightNow * (ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,1,HourOfDay) + &
ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,1,HourOfDay)) + &
WeightPreviousHour * (ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,1,PreviousHour) + &
ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,1,PreviousHour)))
SFSKHR(ISky,1) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,1,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,1,PreviousHour))
IF (ISky == 1) SFSUHR(1) = VTRatio * (WeightNow * (ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,1,HourOfDay) + &
ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,1,HourOfDay)) + &
WeightPreviousHour * (ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,1,PreviousHour) + &
ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,1,PreviousHour)))
IF (SurfaceWindow(IWin)%ShadingFlag >= 1 .OR. SurfaceWindow(IWin)%SolarDiffusing) THEN
! ===Shaded window or window with diffusing glass===
IF (.NOT.SurfaceWindow(IWin)%MovableSlats) THEN
! Shade, screen, blind with fixed slats, or diffusing glass
DFSKHR(ISky,2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,2,PreviousHour))
IF (ISky == 1) THEN
DFSUHR(2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) &
DFSUHR(2) = DFSUHR(2) + VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2,PreviousHour))
END IF
BFSKHR(ISky,2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,2,PreviousHour))
IF (ISky == 1) THEN
BFSUHR(2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) &
BFSUHR(2) = BFSUHR(2) + VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2,PreviousHour))
END IF
SFSKHR(ISky,2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,2,PreviousHour))
IF (ISky == 1) THEN
SFSUHR(2) = VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) &
SFSUHR(2) = SFSUHR(2) + VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2,HourOfDay) + &
WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2,PreviousHour))
END IF
ELSE ! Blind with movable slats
VarSlats = SurfaceWindow(IWin)%MovableSlats
SlatAng = SurfaceWindow(IWin)%SlatAngThisTs
DFSKHR(ISky,2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSky(loop,IL,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
DFSUHR(2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSun(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
! We add the contribution from the solar disk if slats do not block beam solar
! TH CR 8010. DaylIllFacSunDisk needs to be interpolated!
!IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) DFSUHR(2) = DFSUHR(2) + &
! VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2,HourOfDay) + &
! WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) DFSUHR(2) = DFSUHR(2) + &
VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
END IF
BFSKHR(ISky,2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSky(loop,IL,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
BFSUHR(2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSun(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
! TH CR 8010. DaylBackFacSunDisk needs to be interpolated!
!IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
! BFSUHR(2) = BFSUHR(2) + &
! VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2,HourOfDay) + &
! WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
BFSUHR(2) = BFSUHR(2) + &
VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylBackFacSunDisk(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
END IF
END IF
SFSKHR(ISky,2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSky(loop,IL,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
SFSUHR(2) = VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSun(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
! TH CR 8010. DaylSourceFacSunDisk needs to be interpolated!
!IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
! SFSUHR(2) = SFSUHR(2) + &
! VTRatio * (WeightNow * ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2,HourOfDay) + &
! WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
SFSUHR(2) = SFSUHR(2) + &
VTRatio * (WeightNow * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
ZoneDaylight(ZoneNum)%DaylSourceFacSunDisk(loop,IL,2:MaxSlatAngs+1,PreviousHour)))
END IF
END IF
END IF ! End of check if window has blind with movable slats
END IF ! End of check if window is shaded or has diffusing glass
END DO ! End of sky type loop, ISky
! Get illuminance at ref point from bare and shaded window by
! multiplying daylight factors by exterior horizontal illuminance
! Adding 0.001 in the following prevents zero HorIllSky in early morning or late evening when sun
! is up in the present time step but GILSK(ISky,HourOfDay) and GILSK(ISky,NextHour) are both zero.
DO ISky = 1,4
! HorIllSky(ISky) = WeightNow * GILSK(ISky,HourOfDay) + WeightNextHour * GILSK(ISky,NextHour) + 0.001
HorIllSky(ISky) = WeightNow * GILSK(ISky,HourOfDay) + WeightPreviousHour * GILSK(ISky,PreviousHour) + 0.001d0
END DO
! HISKF is current time step horizontal illuminance from sky, calculated in DayltgLuminousEfficacy,
! which is called in WeatherManager. HISUNF is current time step horizontal illuminance from sun,
! also calculated in DayltgLuminousEfficacy.
HorIllSkyFac = HISKF/((1-SkyWeight)*HorIllSky(ISky2) + SkyWeight*HorIllSky(ISky1))
DO IS = 1,2
IF (IS == 2.and.SurfaceWindow(IWin)%ShadingFlag<=0.and..NOT.SurfaceWindow(IWin)%SolarDiffusing) EXIT
ZoneDaylight(ZoneNum)%IllumFromWinAtRefpt(IL,IS,loop) = &
DFSUHR(IS)*HISUNF + HorIllSkyFac * (DFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
DFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop) = &
BFSUHR(IS)*HISUNF + HorIllSkyFac * (BFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
BFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,IS,loop) = &
SFSUHR(IS)*HISUNF + HorIllSkyFac * (SFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
SFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,IS,loop) = &
MAX(ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,IS,loop),0.0d0)
! Added TH 1/21/2010 - save the original clear and dark (fully switched) states'
! zone daylighting values, needed for switachable glazings
tmpIllumFromWinAtRefPt(IL,IS,loop) = ZoneDaylight(ZoneNum)%IllumFromWinAtRefpt(IL,IS,loop)
tmpBackLumFromWinAtRefPt(IL,IS,loop) = ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop)
tmpSourceLumFromWinAtRefPt(IL,IS,loop) = ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,IS,loop)
END DO ! IS
END DO ! End of reference point loop, IL
END DO ! End of first loop over exterior windows associated with this zone
! Initialize flag that one or more windows has switchable glazing
! control that adjusts visible transmittance to just meet dayltg setpoint
! (and the window has not already been switched)
ISWFLG = 0
! Second loop over windows. Find total daylight illuminance and background luminance
! for each ref pt from all exterior windows associated with the zone. Use shading flags.
! This illuminance excludes contribution of inter-reflected illuminance produced by solar
! entering the zone through interior windows (which is calculated in DayltgInterReflIllFrIntWins.
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
ICtrl = Surface(IWin)%WindowShadingControlPtr
IF (ICtrl > 0 .AND. ISWFLG == 0) THEN
IF (WindowShadingControl(ICtrl)%ShadingControlType == WSCT_MeetDaylIlumSetp.AND. &
SurfaceWindow(IWin)%ShadingFlag == GlassConditionallyLightened) ISWFLG = 1
END IF
! Determine if illuminance contribution is from bare or shaded window
! For switchable glazings with shading control type of WSCT_MeetDaylIlumSetp,
! the shading flag is initialized at GlassConditionallyLightened (20), and
! the window is initialized at clear state: IS = 1
! For other windows with glare control, the shading flag is initialized at >10, to be determined
IS = 1
IF((SurfaceWindow(IWin)%ShadingFlag >= 1 .AND. SurfaceWindow(IWin)%ShadingFlag <= 9) .OR. &
SurfaceWindow(IWin)%SolarDiffusing) IS = 2
DO IL = 1,NREFPT
DaylIllum(IL) = DaylIllum(IL) + ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,IS,loop)
ZoneDaylight(ZoneNum)%BacLum(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) + &
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop)
END DO
END DO ! End of second window loop over exterior windows associated with this zone
! Optical switching control (e.g. electrochromic glass) to adjust
! window's vis trans downward so daylight level equals or is as
! close as possible to the illuminance setpoint at first reference point.
! Assumes vis trans in the fully switched state is less than that in the
! unswitched state. Assumes some windows in a space may have this control and
! others not.
! If daylight illuminance is above setpoint, allow switching
IF (ISWFLG /= 0 .AND. DaylIllum(1) > SETPNT(1)) THEN
! Third loop over windows. Get illuminance at ref pt 1 from
! windows that can be switched (DILLSW) and those that can't (DILLUN).
! Windows that can be switched are initially in the unswitched state.
DILLSW = 0.0d0
DILLUN = 0.0d0
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
ICtrl = Surface(IWin)%WindowShadingControlPtr
IS = 1
IF((SurfaceWindow(IWin)%ShadingFlag >= 1 .AND. SurfaceWindow(IWin)%ShadingFlag <= 9) .OR. &
SurfaceWindow(IWin)%SolarDiffusing) IS = 2
IF (ICtrl > 0) THEN
IF (SurfaceWindow(IWin)%ShadingFlag == GlassConditionallyLightened .AND. &
WindowShadingControl(ICtrl)%ShadingControlType == WSCT_MeetDaylIlumSetp) THEN
DILLSW = DILLSW + ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(1,IS,loop)
ELSE
DILLUN = DILLUN + ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(1,IS,loop)
END IF
END IF
END DO ! End of third window loop, IWin
! Transmittance multiplier
ASETIL = (SETPNT(1) - DILLUN) / (DILLSW + 0.00001d0)
! ASETIL < 1 means there's enough light, so check for switching
IF (ASETIL < 1.0d0) THEN
! Fourth loop over windows to determine which to switch
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
ICtrl = Surface(IWin)%WindowShadingControlPtr
IF (ICtrl == 0) CYCLE
IF (SurfaceWindow(IWin)%ShadingFlag /= GlassConditionallyLightened .OR. &
WindowShadingControl(ICtrl)%ShadingControlType /= WSCT_MeetDaylIlumSetp) CYCLE
IConst = Surface(IWin)%Construction
IF(SurfaceWindow(IWin)%StormWinFlag == 1) IConst = Surface(IWin)%StormWinConstruction
! Vis trans at normal incidence of unswitched glass
TVIS1 = POLYF(1.0d0,Construct(IConst)%TransVisBeamCoef(1))*SurfaceWindow(IWin)%GlazedFrac
! Vis trans at normal incidence of fully switched glass
IConstShaded = Surface(IWin)%ShadedConstruction
TVIS2 = POLYF(1.0d0,Construct(IConstShaded)%TransVisBeamCoef(1))*SurfaceWindow(IWin)%GlazedFrac
! Reset shading flag to indicate that window is shaded by being partially or fully switched
SurfaceWindow(IWin)%ShadingFlag = SwitchableGlazing
! ASETIL < 0 means illuminance from non-daylight-switchable windows exceeds setpoint,
! so completely switch all daylight-switchable windows to minimize solar gain
IF (ASETIL <= 0.0d0) THEN
SurfaceWindow(IWin)%SwitchingFactor = 1.0d0
SurfaceWindow(IWin)%VisTransSelected = TVIS2
ELSE
! Case where 0 < ASETIL < 1: darken glass in all
! daylight-switchable windows to just meet illuminance setpoint
! From this equation: SETPNT(1) = DILLUN + DILLSW/TVIS1 * VisTransSelected
SurfaceWindow(IWin)%VisTransSelected = MAX(TVIS2, ASETIL * TVIS1) + 0.000001d0
SurfaceWindow(IWin)%SwitchingFactor = (TVIS1 - SurfaceWindow(IWin)%VisTransSelected)/ (TVIS1 - TVIS2 + 0.000001d0)
! bound switching factor between 0 and 1
SurfaceWindow(IWin)%SwitchingFactor = MIN(1.d0, SurfaceWindow(IWin)%SwitchingFactor)
SurfaceWindow(IWin)%SwitchingFactor = MAX(0.D0, SurfaceWindow(IWin)%SwitchingFactor)
END IF
! Adjust daylight quantities based on ratio between switched and unswitched visible transmittance
DO IL = 1,NREFPT
! DaylIllum(IL) and BacLum(IL) were calculated at the clear state: IS = 1,
! and need to adjusted for intermediate switched state at VisTransSelected: IS = 2
IS = 1
VTRAT = SurfaceWindow(IWin)%VisTransSelected/(TVIS1+0.000001d0)
DaylIllum(IL) = DaylIllum(IL) + (VTRAT - 1.0d0) * ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,IS,loop)
ZoneDaylight(ZoneNum)%BacLum(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) + &
(VTRAT - 1.0d0) * ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop)
! Adjust illum, background illum and source luminance for this window in intermediate switched state
! for later use in the DayltgGlare calc because SurfaceWindow(IWin)%ShadingFlag = SwitchableGlazing = 2
IS = 2
VTRAT = SurfaceWindow(IWin)%VisTransSelected/(TVIS2+0.000001d0)
ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,IS,loop) = VTRAT * tmpIllumFromWinAtRefPt(IL,IS,loop)
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop) = VTRAT * tmpBackLumFromWinAtRefPt(IL,IS,loop)
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,IS,loop)= VTRAT * tmpSourceLumFromWinAtRefPt(IL,IS,loop)
END DO ! IL
! If new daylight does not exceed the illuminance setpoint, done, no more checking other switchable glazings
! even though this should not happen because all switchable glazings suppose to be dimmed by a same ratio ASETIL
! In real world, this can be improved by setting priority of each switchable glazing to switch - NFP.
IF (DaylIllum(1) <= SETPNT(1)) THEN
EXIT
ENDIF
END DO ! End of fourth window loop, IWin -- end of switching to control daylight illuminance
END IF ! ASETIL < 1
END IF ! ISWFLG /= 0 .AND. DaylIllum(1) > SETPNT(1)
! Calculate glare index at each reference point assuming the daylight illuminance setpoint is
! met at both reference points, either by daylight or electric lights
DO IL = 1,NREFPT
BACL = MAX(SETPNT(IL) * ZoneDaylight(ZoneNum)%AveVisDiffReflect / Pi, ZoneDaylight(ZoneNum)%BacLum(IL))
! DayltgGlare uses ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,1,loop) for unshaded windows, and
! ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) for shaded windows
CALL DayltgGlare(IL, BACL, GLRNDX(IL), ZoneNum)
END DO
! Check if glare level is less than maximum allowed at each ref pt. If maximum
! is exceeded at either ref pt, attempt to reduce glare to acceptable level by closing
! shading device on windows that have shades that have not already been closed.
GlareFlag = .FALSE.
DO IL = 1,NREFPT
IF (GLRNDX(IL) > ZoneDaylight(ZoneNum)%MaxGlareallowed) THEN
GlareFlag = .TRUE.
EXIT
END IF
END DO
IF (GlareFlag) THEN
! Glare is too high at a ref pt. Loop through windows.
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
! Check if window is eligible for glare control
! TH 1/21/2010. Switchable glazings already in partially switched state
! should be allowed to further dim to control glare
!IF (SurfaceWindow(IWin)%ShadingFlag < 10) CYCLE
IF (SurfaceWindow(IWin)%ShadingFlag < 10 .AND. SurfaceWindow(IWin)%ShadingFlag /= SwitchableGlazing) CYCLE
ICtrl = Surface(IWin)%WindowShadingControlPtr
IF (ICtrl == 0) CYCLE
IF (WindowShadingControl(ICtrl)%GlareControlIsActive) THEN
! Illuminance (WDAYIL) and background luminance (WBACLU) contribution from this
! window without shading (IS=1) and with shading (IS=2) for each ref pt
! For switchable windows, this may be partially switched rather than fully dark
DO IL = 1,NREFPT
DO IS = 1,2
WDAYIL(IL,IS) = ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,IS,loop)
WBACLU(IL,IS) = ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,IS,loop)
END DO
END DO
! Recalculate illuminance and glare with shading on this window.
! For switchable glazings, this is the fully switched (dark) state
DO IL = 1,NREFPT
IF (SurfaceWindow(IWin)%ShadingFlag /= SwitchableGlazing) THEN
! for non switchable glazings or switchable glazings not switched yet (still in clear state)
! SurfaceWindow(IWin)%ShadingFlag = GlassConditionallyLightened
RDAYIL(IL) = DaylIllum(IL) - WDAYIL(IL,1) + WDAYIL(IL,2)
RBACLU(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) - WBACLU(IL,1) + WBACLU(IL,2)
ELSE
! switchable glazings already in partially switched state when calc the RDAYIL(IL) & RBACLU(IL)
RDAYIL(IL) = DaylIllum(IL) - WDAYIL(IL,2) + tmpIllumFromWinAtRefPt(IL,2,loop)
RBACLU(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) - WBACLU(IL,2) + tmpBackLumFromWinAtRefPt(IL,2,loop)
ENDIF
END DO
IF (SurfaceWindow(IWin)%ShadingFlag /= SwitchableGlazing) &
SurfaceWindow(IWin)%ShadingFlag = SurfaceWindow(IWin)%ShadingFlag / 10
!For switchable glazings, it is switched to fully dark state,
! update ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) for use in DayltgGlare
IF (SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
DO IL = 1,NREFPT
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) = tmpSourceLumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,2,loop) = tmpIllumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,2,loop) = tmpBackLumFromWinAtRefPt(IL,2,loop)
END DO
IConst = Surface(IWin)%Construction
! Vis trans at normal incidence of unswitched glass
TVIS1 = POLYF(1.0d0,Construct(IConst)%TransVisBeamCoef(1))*SurfaceWindow(IWin)%GlazedFrac
! Vis trans at normal incidence of fully switched glass
IConstShaded = Surface(IWin)%ShadedConstruction
TVIS2 = POLYF(1.0d0,Construct(IConstShaded)%TransVisBeamCoef(1))*SurfaceWindow(IWin)%GlazedFrac
ENDIF
! Re-calc daylight and glare at shaded state. For switchable glazings, it is the fully dark state.
DO IL = 1,NREFPT
BACL = MAX(SETPNT(IL) * ZoneDaylight(ZoneNum)%AveVisDiffReflect / Pi, RBACLU(IL))
! DayltgGlare uses ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) for shaded state
CALL DayltgGlare(IL, BACL, GLRNEW(IL), ZoneNum)
END DO
blnCycle = .False.
IF (NREFPT == 1 .AND. GLRNEW(1) > GLRNDX(1)) THEN
! One ref pt; go to next window if glare has increased.
blnCycle = .True.
ELSEIF (NREFPT > 1) THEN
! Two ref pts. There are three cases depending on glare values.
IF (GLRNDX(1) > ZoneDaylight(ZoneNum)%MaxGlareallowed .AND. GLRNDX(2) > ZoneDaylight(ZoneNum)%MaxGlareallowed) THEN
!
! (1) Initial glare too high at both ref pts. Deploy shading on
! this window if this decreases glare at both ref pts.
IF (GLRNEW(1) > GLRNDX(1) .OR. GLRNEW(2) > GLRNDX(2)) blnCycle = .True.
ELSE IF (GLRNDX(1) > ZoneDaylight(ZoneNum)%MaxGlareallowed .AND. GLRNDX(2) <= ZoneDaylight(ZoneNum)%MaxGlareallowed) THEN
!
! (2) Initial glare too high only at first ref pt. Deploy shading
! on this window if glare at first ref pt decreases and
! glare at second ref pt stays below max.
IF (GLRNEW(1) > GLRNDX(1) .OR. GLRNEW(2) > ZoneDaylight(ZoneNum)%MaxGlareallowed) blnCycle = .True.
ELSE
!
! (3) Initial glare too high at second ref pt. Deploy shading if glare
! at second ref pt decreases and glare at first ref pt stays below max.
IF (GLRNEW(2) > GLRNDX(2) .OR. GLRNEW(1) > ZoneDaylight(ZoneNum)%MaxGlareallowed) blnCycle = .True.
END IF
END IF
! Shading this window has not improved the glare situation.
! Reset shading flag to no shading condition, go to next window.
IF (blnCycle) THEN
! for switchable glazings, reset properties to clear state or partial switched state?
IF (SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
SurfaceWindow(IWin)%SwitchingFactor = 0.0d0
SurfaceWindow(IWin)%VisTransSelected = TVIS1
! RESET properties for fully dark state
DO IL = 1,NREFPT
ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,2,loop) = tmpIllumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,2,loop) = tmpBackLumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop)= tmpSourceLumFromWinAtRefPt(IL,2,loop)
ENDDO
ENDIF
SurfaceWindow(IWin)%ShadingFlag = ShadeOff
CYCLE
ENDIF
! Shading this window has improved the glare situation.
! Reset background luminance, glare index, and daylight illuminance at each ref pt.
! For switchable glazings, this is fully switched, dark state
DO IL = 1,NREFPT
ZoneDaylight(ZoneNum)%BacLum(IL) = RBACLU(IL)
GLRNDX(IL) = GLRNEW(IL)
DaylIllum(IL) = RDAYIL(IL)
END DO
! TH comments (5/22/2009): seems for EC windows, if the calculated glare exceeds the max setpoint,
! the EC windows will be reset to fully dark state which significantly reduces the available daylight.
! A better way is to dim the EC windows as necessary just to meet the glare index, which will still
! provide more daylight while not exceeding the max glare! The question is then how to set the
! SwitchingFactor to just meet the glare index.
! This was addressed in CR 7984 for E+ 5.0. 1/19/2010
! If switchable glazing, set switching factor to 1: fully switched.
IF (SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
tmpSWFactor0 = SurfaceWindow(IWin)%SwitchingFactor ! save original switching factor
SurfaceWindow(IWin)%SwitchingFactor = 1.0d0
SurfaceWindow(IWin)%VisTransSelected = TVIS2
! restore fully dark values
DO IL = 1,NREFPT
WDAYIL(IL,2) = tmpIllumFromWinAtRefPt(IL,2,loop)
WBACLU(IL,2) = tmpBackLumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,2,loop) = tmpIllumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,2,loop) = tmpBackLumFromWinAtRefPt(IL,2,loop)
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop)= tmpSourceLumFromWinAtRefPt(IL,2,loop)
END DO
ENDIF
! Check if glare now acceptable at each ref pt.
GlareOK = .False.
IF (NREFPT == 1) THEN
IF (GLRNDX(1) <= ZoneDaylight(ZoneNum)%MaxGlareallowed) GlareOK = .True.
ELSEIF (NREFPT > 1) THEN
IF (GLRNDX(1) <= ZoneDaylight(ZoneNum)%MaxGlareallowed .AND. &
GLRNDX(2) <= ZoneDaylight(ZoneNum)%MaxGlareallowed) GlareOK = .True.
ENDIF
IF (GlareOK) THEN
IF (SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing .AND. &
WindowShadingControl(ICtrl)%ShadingControlType == WSCT_MeetDaylIlumSetp) THEN
! Added TH 1/14/2010
! Only for switchable glazings with MeetDaylightIlluminanceSetpoint control
! The glazing is in fully dark state, it might lighten a bit to provide more daylight
! while meeting maximum discomfort glare index
! Iteration to find the right switching factor meeting the glare index
! get fully dark state values
tmpSWSL1 = tmpSourceLumFromWinAtRefPt(1,2,loop)
IF (NREFPT > 1) tmpSWSL2 = tmpSourceLumFromWinAtRefPt(2,2,loop)
! use simple fixed step search in iteraction, can be improved in future
tmpSWFactor = 1.0d0 - tmpSWIterStep
DO WHILE (tmpSWFactor > 0)
! calc new glare at new switching state
DO IL = 1,NREFPT
RDAYIL(IL) = DaylIllum(IL) + (WDAYIL(IL,1) - WDAYIL(IL,2)) * (1.0d0 - tmpSWFactor)
RBACLU(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) + (WBACLU(IL,1) - WBACLU(IL,2)) * (1.0d0 - tmpSWFactor)
BACL = MAX(SETPNT(IL) * ZoneDaylight(ZoneNum)%AveVisDiffReflect / Pi, RBACLU(IL))
! needs to update SourceLumFromWinAtRefPt(IL,2,loop) before re-calc DayltgGlare
tmpMult = (TVIS1 - (TVIS1 - TVIS2) * tmpSWFactor) / TVIS2
IF (IL == 1) THEN
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) = tmpSWSL1 * tmpMult
ELSE
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) = tmpSWSL2 * tmpMult
ENDIF
! Calc new glare
CALL DayltgGlare(IL, BACL, GLRNEW(IL), ZoneNum)
END DO
! Check whether new glare is OK
GlareOK = .False.
IF (NREFPT == 1) THEN
IF (GLRNEW(1) <= ZoneDaylight(ZoneNum)%MaxGlareallowed) GlareOK = .True.
ELSEIF (NREFPT > 1) THEN
IF (GLRNEW(1) <= ZoneDaylight(ZoneNum)%MaxGlareallowed .AND. &
GLRNEW(2) <= ZoneDaylight(ZoneNum)%MaxGlareallowed) GlareOK = .True.
ENDIF
IF (GlareOK) THEN
IF (tmpSWFactor >= tmpSWIterStep) THEN
! Continue to lighten the glazing
tmpSWFactor = tmpSWFactor - tmpSWIterStep
CYCLE
ELSE
! Glare still OK but glazing already in clear state, no more lighten
EXIT
ENDIF
ELSE
! Glare too high, exit and use previous switching state
tmpSWFactor = tmpSWFactor + tmpSWIterStep
EXIT
ENDIF
END DO
! Final re-calculation if needed
IF (.NOT. GlareOK) THEN
! Glare too high, use previous state and re-calc
DO IL = 1,NREFPT
RDAYIL(IL) = DaylIllum(IL) + (WDAYIL(IL,1) - WDAYIL(IL,2)) * (1.0d0 - tmpSWFactor)
RBACLU(IL) = ZoneDaylight(ZoneNum)%BacLum(IL) + (WBACLU(IL,1) - WBACLU(IL,2)) * (1.0d0 - tmpSWFactor)
BACL = MAX(SETPNT(IL) * ZoneDaylight(ZoneNum)%AveVisDiffReflect / Pi, RBACLU(IL))
! needs to update SourceLumFromWinAtRefPt(IL,2,IWin) before re-calc DayltgGlare
tmpMult = (TVIS1 - (TVIS1 - TVIS2) * tmpSWFactor) / TVIS2
IF (IL == 1) THEN
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(1,2,loop) = tmpSWSL1 * tmpMult
ELSE
ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(2,2,loop) = tmpSWSL2 * tmpMult
ENDIF
CALL DayltgGlare(IL, BACL, GLRNEW(IL), ZoneNum)
END DO
ENDIF
!Update final results
DO IL = 1,NREFPT
ZoneDaylight(ZoneNum)%BacLum(IL) = RBACLU(IL)
GLRNDX(IL) = GLRNEW(IL)
DaylIllum(IL) = RDAYIL(IL)
tmpMult = (TVIS1 - (TVIS1 - TVIS2) * tmpSWFactor) / TVIS2
!update report variables
ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,2,loop) = tmpIllumFromWinAtRefPt(IL,2,loop) * tmpMult
ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,2,loop) = tmpBackLumFromWinAtRefPt(IL,2,loop) * tmpMult
END DO
SurfaceWindow(IWin)%SwitchingFactor = tmpSWFactor
SurfaceWindow(IWin)%VisTransSelected = TVIS1 - (TVIS1 - TVIS2) * tmpSWFactor
ELSE
!For un-switchable glazing or switchable glazing but not MeetDaylightIlluminaceSetpoint control,
! it is in shaded state and glare is ok - job is done, exit the window loop - IWin
EXIT
ENDIF
!
! ELSE
! ! glare still high at either ref pt. go to next window
! ! clean up for switchable glazings
! IF (SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
! ! Already in fully dark state
! DO IL = 1,NREFPT
! ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(IL,2,loop) = tmpSourceLumFromWinAtRefPt(IL,2,loop)
! ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(IL,2,loop) = tmpIllumFromWinAtRefPt(IL,2,loop)
! ZoneDaylight(ZoneNum)%BackLumFromWinAtRefPt(IL,2,loop) = tmpBackLumFromWinAtRefPt(IL,2,loop)
! END DO
! ENDIF
ENDIF
END IF ! End of check if window glare control is active
END DO ! End of window loop, IWin
END IF ! GlareFlag
! Loop again over windows and reset remaining shading flags that
! are 10 or higher (i.e., conditionally off) to off
DO IWin = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (Surface(IWin)%Class /= SurfaceClass_Window) CYCLE
IF (Surface(IWin)%ExtBoundCond /= ExternalEnvironment) CYCLE
IF (SurfaceWindow(IWin)%ShadingFlag >= 10) SurfaceWindow(IWin)%ShadingFlag = ShadeOff
END DO
! Variables for reporting
DO IL = 1,NREFPT
ZoneDaylight(ZoneNum)%DaylIllumAtRefPt(IL) = DaylIllum(IL)
ZoneDaylight(ZoneNum)%GlareIndexAtRefPt(IL) = GLRNDX(IL)
!added TH 12/2/2008
IF (GLRNDX(IL) > ZoneDaylight(ZoneNum)%MaxGlareallowed) THEN
ZoneDaylight(ZoneNum)%TimeExceedingGlareIndexSPAtRefPt(IL) = TimeStepZone !fraction of hours
ELSE
ZoneDaylight(ZoneNum)%TimeExceedingGlareIndexSPAtRefPt(IL) = 0.0d0
ENDIF
!added TH 7/6/2009
IF (DaylIllum(IL) > ZoneDaylight(ZoneNum)%IllumSetPoint(IL)) THEN
ZoneDaylight(ZoneNum)%TimeExceedingDaylightIlluminanceSPAtRefPt(IL) = TimeStepZone !fraction of hours
ELSE
ZoneDaylight(ZoneNum)%TimeExceedingDaylightIlluminanceSPAtRefPt(IL) = 0.0d0
ENDIF
END DO
! The following report variables are valid only for daylit zones without interior windows
IF(.NOT.Zone(ZoneNum)%HasInterZoneWindow) THEN
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
IS = 1
IF(SurfaceWindow(IWin)%ShadingFlag > 0 .OR. SurfaceWindow(IWin)%SolarDiffusing) IS = 2
SurfaceWindow(IWin)%IllumFromWinAtRefPt1Rep = ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(1,IS,loop)
SurfaceWindow(IWin)%LumWinFromRefPt1Rep = ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(1,IS,loop)
IF (ZoneDaylight(ZoneNum)%TotalDaylRefPoints > 1) THEN
SurfaceWindow(IWin)%IllumFromWinAtRefPt2Rep = ZoneDaylight(ZoneNum)%IllumFromWinAtRefPt(2,IS,loop)
SurfaceWindow(IWin)%LumWinFromRefPt2Rep = ZoneDaylight(ZoneNum)%SourceLumFromWinAtRefPt(2,IS,loop)
ENDIF
END DO
END IF
RETURN
END SUBROUTINE DayltgInteriorIllum