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 | :: | 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 DayltgInteriorMapIllum(ZoneNum)
! *****super modified version of DayltgInteriorIllum by Peter Graham Ellis
! *****removes all control code, just calculates illum and glare with previously determined control settings
! *****this should be packaged into a subroutine called from 2 places
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN July 1997
! MODIFIED March 2000, FW: interpolate clear-sky daylight factors using
! HourOfDay/WeightNow and NextHour/WeightNextHour. Previously
! only HourOfDay was used
! Jan 2001, FW: interpolate in slat angle for windows with blinds
! that have movable slats
! Dec 2003, FW: fix bug--even though between-glass shade/blind is on
! daylight illum at ref pt was calculated as though it was off
! June 2009, TH: modified for thermochromic windows
! March 2010, TH: fix bug (CR 8057) for electrochromic windows
! 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.
! 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:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NREFPT ! Number of daylighting map reference points
!INTEGER :: REFPT1 ! 1st reference point
INTEGER :: ISky ! Sky type index
INTEGER :: ISky1, ISky2 ! Sky type index values for averaging two sky types
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
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 :: ICtrl ! Window shading control pointer
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
INTEGER :: loop ! Window loop index
REAL(r64) :: GTOT
REAL(r64) :: GTOT1
REAL(r64) :: GTOT2
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:) :: DaylIllum
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:) :: BACLUM
REAL(r64), SAVE, ALLOCATABLE, DIMENSION(:) :: GLRNDX
LOGICAL, SAVE :: FirstTimeFlag=.true.
INTEGER :: ILB
INTEGER :: IConst
REAL(r64) :: VTRatio
REAL(r64) :: VTNow
REAL(r64) :: VTMaster
REAL(r64) :: VTDark = 0.0d0 ! Visible transmittance (VT) of electrochromic (EC) windows in fully dark state
REAL(r64) :: VTMULT = 1.0d0 ! VT multiplier for EC windows
INTEGER :: IConstShaded = 0 ! The shaded window construction for switchable windows
INTEGER :: MapNum
INTEGER :: ILM
IF (FirstTimeFlag) THEN
ALLOCATE(DaylIllum(MaxMapRefPoints))
ALLOCATE(BACLUM(MaxMapRefPoints))
ALLOCATE(GLRNDX(MaxMapRefPoints))
FirstTimeFlag=.false.
ENDIF
IF (WarmUpFlag) RETURN
! Initialize reference point illuminance and window background luminance
DO ILM=1,ZoneDaylight(ZoneNum)%MapCount
MapNum=ZoneDaylight(ZoneNum)%ZoneToMap(ILM)
! IllumMapCalc(MapNum)%DaylIllumAtMapPt = 0.0
! IllumMapCalc(MapNum)%GlareIndexAtMapPt = 0.0
NREFPT = IllumMapCalc(MapNum)%TotalMapRefPoints
DaylIllum = 0.0d0
BACLUM = 0.0d0
GLRNDX=0.0d0
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 windows in this space.
! 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 ILB = 1,NREFPT
! Daylight factors for current sun position
DO ISky = 1,4
! ===Bare window===
DFSKHR(ISky,1) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,1,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,1,PreviousHour))
IF (ISky == 1) THEN
DFSUHR(1) = VTRatio * ( WeightNow * ( IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,1,HourOfDay) + &
IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,1,HourOfDay) ) + &
WeightPreviousHour * ( IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,1,PreviousHour) + &
IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,1,PreviousHour) ) )
ENDIF
BFSKHR(ISky,1) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,1,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,1,PreviousHour))
IF (ISky == 1) THEN
BFSUHR(1) = VTRatio * (WeightNow * ( IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,1,HourOfDay) + &
IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,1,HourOfDay) ) +&
WeightPreviousHour * ( IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,1,PreviousHour) + &
IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,1,PreviousHour) ) )
ENDIF
SFSKHR(ISky,1) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,1,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,1,PreviousHour))
IF (ISky == 1) THEN
SFSUHR(1) = VTRatio * (WeightNow * ( IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,1,HourOfDay) + &
IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,1,HourOfDay) ) + &
WeightPreviousHour * ( IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,1,PreviousHour) + &
IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,1,PreviousHour) ) )
ENDIF
IF (SurfaceWindow(IWin)%ShadingFlag >= 1 .OR. SurfaceWindow(IWin)%SolarDiffusing) THEN
! ===Shaded window===
IF (.NOT.SurfaceWindow(IWin)%MovableSlats) THEN
! Shade, screen, blind with fixed slats, or diffusing glass
DFSKHR(ISky,2) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,2,PreviousHour) )
IF (ISky == 1) THEN
DFSUHR(2) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,2,PreviousHour))
IF(.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
DFSUHR(2) = DFSUHR(2) + VTRatio * &
(WeightNow * IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,2,PreviousHour))
ENDIF
END IF
BFSKHR(ISky,2) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,2,PreviousHour))
IF (ISky == 1) THEN
BFSUHR(2) = VTRatio * (WeightNow * IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
BFSUHR(2) = BFSUHR(2) + VTRatio * &
(WeightNow * IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,2,PreviousHour))
ENDIF
END IF
SFSKHR(ISky,2) = VTRatio * &
(WeightNow * IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,2,PreviousHour))
IF (ISky == 1) THEN
SFSUHR(2) = VTRatio * &
(WeightNow * IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,2,PreviousHour))
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
SFSUHR(2) = SFSUHR(2) + VTRatio * &
(WeightNow * IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,2,HourOfDay) + &
WeightPreviousHour * IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,2,PreviousHour))
ENDIF
END IF
ELSE ! Blind with movable slats
VarSlats = SurfaceWindow(IWin)%MovableSlats
SlatAng = SurfaceWindow(IWin)%SlatAngThisTs
DFSKHR(ISky,2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
DFSUHR(2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSun(loop,ILB,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,ILB,2,HourOfDay) + &
! WeightPreviousHour * ZoneDaylight(ZoneNum)%DaylIllFacSunDisk(loop,ILB,2,PreviousHour))
IF(.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
DFSUHR(2) = DFSUHR(2) + VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylIllFacSunDisk(loop,ILB,2:MaxSlatAngs+1,PreviousHour)))
ENDIF
END IF
BFSKHR(ISky,2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
BFSUHR(2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSun(loop,ILB,2:MaxSlatAngs+1,PreviousHour)))
! TH CR 8010, DaylBackFacSunDisk needs to be interpolated
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
BFSUHR(2) = BFSUHR(2) + VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylBackFacSunDisk(loop,ILB,2:MaxSlatAngs+1,PreviousHour)))
ENDIF
END IF
SFSKHR(ISky,2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSky(loop,ILB,ISky,2:MaxSlatAngs+1,PreviousHour)))
IF (ISky == 1) THEN
SFSUHR(2) = VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSun(loop,ILB,2:MaxSlatAngs+1,PreviousHour)))
! TH CR 8010, DaylSourceFacSunDisk needs to be interpolated
IF (.NOT.SurfaceWindow(IWin)%SlatsBlockBeam) THEN
SFSUHR(2) = SFSUHR(2) + VTRatio * &
(WeightNow * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,2:MaxSlatAngs+1,HourOfDay)) + &
WeightPreviousHour * InterpSlatAng(SlatAng,VarSlats, &
IllumMapCalc(MapNum)%DaylSourceFacSunDisk(loop,ILB,2:MaxSlatAngs+1,PreviousHour)))
ENDIF
END IF
END IF ! End of check if window has blind with movable slats
ENDIF ! End of check if window is shaded or has diffusing glass
END DO
! 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) + 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.d0-SkyWeight)*HorIllSky(ISky2) + SkyWeight*HorIllSky(ISky1))
DO IS = 1,2
IF(IS == 2.AND.SurfaceWindow(IWin)%ShadingFlag<=0.AND..not.SurfaceWindow(IWin)%SolarDiffusing) EXIT
IllumMapCalc(MapNum)%IllumFromWinAtMapPt(ILB,IS,loop) = &
DFSUHR(IS)*HISUNF + HorIllSkyFac * (DFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
DFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
IllumMapCalc(MapNum)%BackLumFromWinAtMapPt(ILB,IS,loop) = &
BFSUHR(IS)*HISUNF + HorIllSkyFac * (BFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
BFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
IllumMapCalc(MapNum)%SourceLumFromWinAtMapPt(ILB,IS,loop) = &
SFSUHR(IS)*HISUNF + HorIllSkyFac * (SFSKHR(ISky1,IS)*SkyWeight*HorIllSky(ISky1) + &
SFSKHR(ISky2,IS)*(1.0d0-SkyWeight)*HorIllSky(ISky2))
IllumMapCalc(MapNum)%SourceLumFromWinAtMapPt(ILB,IS,loop) = &
MAX(IllumMapCalc(MapNum)%SourceLumFromWinAtMapPt(ILB,IS,loop),0.0d0)
ENDDO
ENDDO ! End of reference point loop
ENDDO ! End of first loop over windows
! Second loop over windows. Find total daylight illuminance
! and background luminance for each ref pt from all windows in
! the space. Use shading flags.
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
IS = 1
IF ((SurfaceWindow(IWin)%ShadingFlag >= 1 .AND. SurfaceWindow(IWin)%ShadingFlag <= 9) .OR. &
SurfaceWindow(IWin)%SolarDiffusing) IS = 2
! CR 8057. 3/17/2010.
! Switchable windows may be in partially switched state rather than fully dark state
VTMULT = 1.0d0
ICtrl = Surface(IWin)%WindowShadingControlPtr
IF(ICtrl > 0) THEN
IF (WindowShadingControl(ICtrl)%ShadingControlType == WSCT_MeetDaylIlumSetp .AND. &
SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
! switchable windows in partial or fully switched state,
! get its intermediate VT calculated in DayltgInteriorIllum
IConstShaded = Surface(IWin)%ShadedConstruction
IF (IConstShaded > 0) VTDark = POLYF(1.0d0,Construct(IConstShaded)%TransVisBeamCoef(1))* &
SurfaceWindow(IWin)%GlazedFrac
IF (VTDark > 0) VTMULT = SurfaceWindow(IWin)%VisTransSelected / VTDark
ENDIF
ENDIF
DO IL = 1,NREFPT
! Determine if illuminance contribution is from bare or shaded window
DaylIllum(IL) = DaylIllum(IL) + VTMULT * IllumMapCalc(MapNum)%IllumFromWinAtMapPt(IL,IS,loop)
BACLUM(IL) = BACLUM(IL) + VTMULT * IllumMapCalc(MapNum)%BackLumFromWinAtMapPt(IL,IS,loop)
END DO
END DO ! End of second window loop
! Calculate glare index at each reference point
DO IL = 1,NREFPT
! Following code taken directly from DayltgGlare ... duplicate calculation
! Initialize glare constant
GTOT = 0.0d0
! Loop over exterior windows associated with zone
DO loop = 1,ZoneDaylight(ZoneNum)%NumOfDayltgExtWins
IWin = ZoneDaylight(ZoneNum)%DayltgExtWinSurfNums(loop)
IS = 1
IF((SurfaceWindow(IWin)%ShadingFlag >= 1 .AND. SurfaceWindow(IWin)%ShadingFlag <= 9) .OR. &
SurfaceWindow(IWin)%SolarDiffusing) IS = 2
! CR 8057. 3/17/2010
VTMULT = 1.0d0
ICtrl = Surface(IWin)%WindowShadingControlPtr
IF(ICtrl > 0) THEN
IF (WindowShadingControl(ICtrl)%ShadingControlType == WSCT_MeetDaylIlumSetp .AND. &
SurfaceWindow(IWin)%ShadingFlag == SwitchableGlazing) THEN
! switchable windows in partial or fully switched state,
! get its intermediate VT calculated in DayltgInteriorIllum
IConstShaded = Surface(IWin)%ShadedConstruction
IF (IConstShaded > 0) VTDark = POLYF(1.0d0,Construct(IConstShaded)%TransVisBeamCoef(1))* &
SurfaceWindow(IWin)%GlazedFrac
IF (VTDark > 0) VTMULT = SurfaceWindow(IWin)%VisTransSelected / VTDark
ENDIF
ENDIF
! Conversion from ft-L to cd/m2, with cd/m2 = 0.2936 ft-L, gives the 0.4794 factor
! below, which is (0.2936)**0.6
GTOT1 = 0.4794d0*((VTMULT * IllumMapCalc(MapNum)%SourceLumFromWinAtMapPt(IL,IS,loop))**1.6d0) * &
IllumMapCalc(MapNum)%SolidAngAtMapPtWtd(IL,loop)**0.8d0
GTOT2 = BACLUM(IL) + 0.07d0 * (IllumMapCalc(MapNum)%SolidAngAtMapPt(IL,loop)**0.5d0) * &
VTMULT * IllumMapCalc(MapNum)%SourceLumFromWinAtMapPt(IL,IS,loop)
GTOT = GTOT + GTOT1 / (GTOT2 + 0.000001d0)
END DO
! Glare index (adding 0.000001 prevents LOG10 (0))
GLRNDX(IL) = 10.0d0*LOG10(GTOT+0.000001d0)
! Set glare index to zero for GTOT < 1
GLRNDX(IL) = MAX(0.0d0, GLRNDX(IL))
ENDDO
! Variables for reporting
DO IL = 1,NREFPT
IllumMapCalc(MapNum)%DaylIllumAtMapPt(IL) = MAX(DaylIllum(IL),0.0d0)
IllumMapCalc(MapNum)%GlareIndexAtMapPt(IL) = GLRNDX(IL)
ENDDO
ENDDO
RETURN
END SUBROUTINE DayltgInteriorMapIllum