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.
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 WindowShadingManager
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN December 1998
! MODIFIED November 1999 (FW)
! Aug 2001 (FW): change shading control names, change approach
! to scheduling and glare control, add movable
! insulation controls (mainly for heating reduction)
! Dec 2001 (FW): add slat angle control for blinds
! Aug 2002 (FW): add four new control types:
! OnIfHighOutsideAirTempAndHighSolarOnWindow
! OnIfHighOutsideAirTempAndHighHorizontalSolar
! OnIfHighZoneAirTempAndHighSolarOnWindow
! OnIfHighZoneAirTempAndHighHorizontalSolar
! Dec 2002 (FW): add between-glass shade/blind
! Mar 2003 (FW): allow GlareControlIsActive = .true. only for daylit zones
! Apr 2003 (FW): use SNLoadCoolRate or SNLoadHeatRate only if not first time step
! (fixes problem when used first time thru and not allocated)
! May 2006 (RR): add exterior window screen
! May 2009 (BG): add EMS actuator override for shade flag and slat angle
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For windows with shading, selects the shaded construction
! that is used in the heat balance calculation, and sets
! the window shading flag, which is:
! -1: if window has no shading device
! 0: if shading device is off
! 1: if interior shade is on
! 2: if glazing is switched to darker state
! 3: if exterior shade is on
! 6: if interior blind is on
! 7: if exterior blind is on
! 8: if between-glass shade is on
! 9: if between-glass blind is on
! 10: window has interior shade that is off but may be triggered on later
! to control daylight glare
! 20: window has switchable glazing that is unswitched but may be switched later
! to control daylight glare or daylight illuminance
! 30: window has exterior shade that is off but may be triggered on later
! to control daylaight glare or daylight illuminance
! 60: window has interior blind that is off but may be triggered on later
! to control daylaight glare or daylight illuminance
! 70: window has exterior blind that is off but may be triggered on later
! to control daylaight glare or daylight illuminance
! 80: window has between-glass shade that is off but may be triggered on later
! to control daylaight glare or daylight illuminance
! 90: window has between-glass blind that is off but may be triggered on later
! to control daylaight glare or daylight illuminance
! A "shading device" may be an exterior, interior or between-glass shade or blind,
! or the lower-transmitting (dark) state of switchable glazing (e.g., electrochromic).
! In all cases, the unshaded condition is represented
! by the construction given by window's Surface()%Construction and
! the shaded condition is represented by the construction given by
! the window's Surface()%ShadedConstruction
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHeatBalFanSys, ONLY: MAT
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataDaylighting, ONLY: ZoneDaylight
USE General, ONLY: POLYF
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ISurf ! Surface counter
INTEGER :: IZone ! Zone counter
INTEGER :: IShadingCtrl ! Pointer to a window's shading control
REAL(r64) :: BeamSolarOnWindow ! Direct solar intensity on window (W/m2)
REAL(r64) :: SolarOnWindow ! Direct plus diffuse solar intensity on window (W/m2)
REAL(r64) :: SkySolarOnWindow ! Sky diffuse solar intensity on window (W/m2)
INTEGER :: SchedulePtr ! Schedule pointer
REAL(r64) :: HorizSolar ! Horizontal direct plus diffuse solar intensity
REAL(r64) :: SetPoint ! Control setpoint
REAL(r64) :: SetPoint2 ! Second control setpoint
INTEGER :: ShType ! 1 = interior shade is on,
! 2 = glass is switched to dark state,
! 3 = exterior shade is on,
! 4 = exterior screen is on,
! 6 = interior blind is on,
! 7 = exterior blind is on,
! 8 = between-glass shade is on,
! 9 = between-glass blind is on.
! CHARACTER(len=32) :: ShadingType ! Type of shading (interior shade, interior blind, etc.)
INTEGER :: ShadingType ! Type of shading (interior shade, interior blind, etc.)
LOGICAL :: SchedAllowsControl ! True if control schedule is not specified or is
! specified and schedule value = 1
LOGICAL :: GlareControlIsActive ! True if glare control is active
INTEGER :: BlNum ! Blind number
REAL(r64) :: InputSlatAngle ! Slat angle of associated Material:WindowBlind (rad)
REAL(r64) :: ProfAng ! Solar profile angle (rad)
REAL(r64) :: SlatAng ! Slat angle this time step (rad)
REAL(r64) :: PermeabilityA,PermeabilityB ! Intermediate variables in blind permeability calc
REAL(r64) :: ThetaBase ! Intermediate slat angle variable (rad)
REAL(r64) :: ThetaBlock1, ThetaBlock2 ! Slat angles that just block beam solar (rad)
REAL(r64),SAVE :: ThetaBig,ThetaSmall ! Larger and smaller value of ThetaBlock1 and ThetaBlock2, resp.
REAL(r64),SAVE :: ThetaMin,ThetaMax ! Minimum and maximum allowed slat angle, resp. (rad)
INTEGER :: IConst ! Construction
DO ISurf = 1,TotSurfaces
SurfaceWindow(ISurf)%ExtIntShadePrevTS = SurfaceWindow(ISurf)%ShadingFlag
SurfaceWindow(ISurf)%ShadingFlag = NoShade
SurfaceWindow(ISurf)%FracTimeShadingDeviceOn = 0.0d0
IF(Surface(ISurf)%Class /= SurfaceClass_Window) CYCLE
IF(Surface(ISurf)%ExtBoundCond /= ExternalEnvironment) CYCLE
IF(Surface(ISurf)%WindowShadingControlPtr == 0) CYCLE
! Initialize switching factor (applicable only to switchable glazing) to unswitched
SurfaceWindow(ISurf)%SwitchingFactor = 0.0d0
IConst = Surface(ISurf)%Construction
! Vis trans at normal incidence of unswitched glass. Counting the GlazedFrac
IF (IConst > 0) SurfaceWindow(ISurf)%VisTransSelected = POLYF(1.0d0,Construct(IConst)%TransVisBeamCoef(1)) &
* SurfaceWindow(ISurf)%GlazedFrac
! Window has shading control
IShadingCtrl = Surface(ISurf)%WindowShadingControlPtr
ShadingType = WindowShadingControl(IShadingCtrl)%ShadingType
SurfaceWindow(ISurf)%ShadingFlag = ShadeOff ! Initialize shading flag to off
IZone = Surface(ISurf)%Zone
! Setpoint for shading
SetPoint = WindowShadingControl(IShadingCtrl)%SetPoint
SetPoint2 = WindowShadingControl(IShadingCtrl)%SetPoint2
! ShType = NoShade ! =-1 (see DataHeatBalance)
! ShType = ShadeOff ! =0
IF(ShadingType == WSC_ST_InteriorShade) ShType = IntShadeOn ! =1
IF(ShadingType == WSC_ST_SwitchableGlazing) ShType = SwitchableGlazing ! =2
IF(ShadingType == WSC_ST_ExteriorShade) ShType = ExtShadeOn ! =3
IF(ShadingType == WSC_ST_ExteriorScreen) ShType = ExtScreenOn ! =4
IF(ShadingType == WSC_ST_InteriorBlind) ShType = IntBlindOn ! =6
IF(ShadingType == WSC_ST_ExteriorBlind) ShType = ExtBlindOn ! =7
IF(ShadingType == WSC_ST_BetweenGlassShade) ShType = BGShadeOn ! =8
IF(ShadingType == WSC_ST_BetweenGlassBlind) ShType = BGBlindOn ! =9
SchedAllowsControl = .TRUE.
SchedulePtr = WindowShadingControl(IShadingCtrl)%Schedule
IF(SchedulePtr /= 0) THEN
IF(WindowShadingControl(IShadingCtrl)%ShadingControlIsScheduled .AND. &
GetCurrentScheduleValue(SchedulePtr) <= 0.0d0) SchedAllowsControl = .FALSE.
END IF
GlareControlIsActive = (ZoneDaylight(IZone)%TotalDaylRefPoints > 0 .AND. SunIsUp .AND. &
WindowShadingControl(IShadingCtrl)%GlareControlIsActive)
SolarOnWindow = 0.0d0
BeamSolarOnWindow = 0.0d0
HorizSolar = 0.0d0
IF(SunIsUp) THEN
SkySolarOnWindow = AnisoSkyMult(ISurf)*DifSolarRad
BeamSolarOnWindow = BeamSolarRad * CosIncAng(ISurf,HourOfDay,TimeStep)*SunLitFrac(ISurf,HourOfDay,TimeStep)
SolarOnWindow = BeamSolarOnWindow + SkySolarOnWindow + GndSolarRad*Surface(ISurf)%ViewFactorGround
HorizSolar = BeamSolarRad*SOLCOS(3) + DifSolarRad
END IF
! Determine whether to deploy shading depending on type of control
SELECT CASE (WindowShadingControl(IShadingCtrl)%ShadingControlType)
CASE(WSCT_AlwaysOn) ! 'ALWAYSON'
SurfaceWindow(ISurf)%ShadingFlag = ShType
CASE(WSCT_AlwaysOff) ! 'ALWAYSOFF'
SurfaceWindow(ISurf)%ShadingFlag = ShadeOff
CASE(WSCT_OnIfScheduled) ! 'ONIFSCHEDULEALLOWS'
IF(SchedAllowsControl) SurfaceWindow(ISurf)%ShadingFlag = ShType
CASE(WSCT_HiSolar) ! 'ONIFHIGHSOLARONWINDOW' ! Direct plus diffuse solar intensity on window
IF(SunIsUp) THEN
IF(SolarOnWindow > SetPoint.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_HiHorzSolar) ! 'ONIFHIGHHORIZONTALSOLAR' ! Direct plus diffuse exterior horizontal solar intensity
IF(SunIsUp) THEN
IF(HorizSolar > SetPoint.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_HiOutAirTemp) ! 'OnIfHighOutdoorAirTemperature'
IF(Surface(ISurf)%OutDryBulbTemp > SetPoint.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
CASE(WSCT_HiZoneAirTemp) ! 'OnIfHighZoneAirTemperature' ! Previous time step zone air temperature
IF(MAT(IZone) > SetPoint.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
CASE(WSCT_OnHiOutTemp_HiSolarWindow) ! 'OnIfHighOutdoorAirTempAndHighSolarOnWindow' ! Outside air temp and solar on window
IF(SunIsUp) THEN
IF(Surface(ISurf)%OutDryBulbTemp > SetPoint.AND.SolarOnWindow > Setpoint2.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_OnHiOutTemp_HiHorzSolar) ! 'OnIfHighOutdoorAirTempAndHighHorizontalSolar' ! Outside air temp and horizontal solar
IF(SunIsUp) THEN
IF(Surface(ISurf)%OutDryBulbTemp > SetPoint.AND.HorizSolar > Setpoint2.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_OnHiZoneTemp_HiSolarWindow) ! 'ONIFHIGHZONEAIRTEMPANDHIGHSOLARONWINDOW' ! Zone air temp and solar on window
IF(SunIsUp) THEN
IF(MAT(IZone) > SetPoint.AND.SolarOnWindow > Setpoint2.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_OnHiZoneTemp_HiHorzSolar) ! 'ONIFHIGHZONEAIRTEMPANDHIGHHORIZONTALSOLAR' ! Zone air temp and horizontal solar
IF(SunIsUp) THEN
IF(MAT(IZone) > SetPoint.AND.HorizSolar > Setpoint2.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_HiZoneCooling) ! 'ONIFHIGHZONECOOLING' ! Previous time step zone sensible cooling rate [W]
! In the following, the check on BeginSimFlag is needed since SNLoadCoolRate (and SNLoadHeatRate,
! used in other CASEs) are not allocated at this point for the first time step of the simulation.
IF(.NOT.BeginSimFlag) THEN
IF(SNLoadCoolRate(IZone) > SetPoint.AND.SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_HiGlare) ! 'ONIFHIGHGLARE' ! Daylight glare index at first reference point in the zone.
! This type of shading control is done in DayltgInteriorIllum. Glare control is not affected
! by control schedule.
IF(SunIsUp) SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
CASE(WSCT_MeetDaylIlumSetp) ! 'MEETDAYLIGHTILLUMINANCESETPOINT') ! Daylight illuminance test is done in DayltgInteriorIllum
! Only switchable glazing does daylight illuminance control
IF(SunIsUp.AND.SchedAllowsControl) SurfaceWindow(ISurf)%ShadingFlag = GlassConditionallyLightened
CASE(WSCT_OnNightLoOutTemp_OffDay) ! 'OnNightIfLowOutdoorTempAndOffDay'
IF(.NOT.SunIsUp .AND. Surface(ISurf)%OutDryBulbTemp < SetPoint .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
CASE(WSCT_OnNightLoInTemp_OffDay) ! 'OnNightIfLowInsideTempAndOffDay')
IF(.NOT.SunIsUp .AND. MAT(IZone) < SetPoint .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
CASE(WSCT_OnNightIfHeating_OffDay) ! 'OnNightIfHeatingAndOffDay'
IF(.NOT.BeginSimFlag) THEN
IF(.NOT.SunIsUp .AND. SNLoadHeatRate(IZone) > SetPoint .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_OnNightLoOutTemp_OnDayCooling) ! 'OnNightIfLowOutdoorTempAndOnDayIfCooling'
IF(.NOT.BeginSimFlag) THEN
IF(.NOT.SunIsUp) THEN ! Night
IF(Surface(ISurf)%OutDryBulbTemp < SetPoint .AND. SchedAllowsControl) SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE ! Day
IF(SNLoadCoolRate(IZone) > 0.0d0 .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
END IF
CASE(WSCT_OnNightIfHeating_OnDayCooling) ! 'OnNightIfHeatingAndOnDayIfCooling'
IF(.NOT.BeginSimFlag) THEN
IF(.NOT.SunIsUp) THEN ! Night
IF(SNLoadHeatRate(IZone) > SetPoint .AND. SchedAllowsControl) SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE ! Day
IF(SNLoadCoolRate(IZone) > 0.0d0 .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
END IF
CASE(WSCT_OffNight_OnDay_HiSolarWindow) ! 'OffNightAndOnDayIfCoolingAndHighSolarOnWindow'
IF(.NOT.BeginSimFlag) THEN
IF(SunIsUp .AND. SNLoadCoolRate(IZone) > 0.0d0 .AND. SchedAllowsControl) THEN
IF(SolarOnWindow > SetPoint) SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
CASE(WSCT_OnNight_OnDay_HiSolarWindow) ! 'OnNightAndOnDayIfCoolingAndHighSolarOnWindow'
IF(.NOT.BeginSimFlag) THEN
IF(SunIsUp .AND. SNLoadCoolRate(IZone) > 0.0d0 .AND. SchedAllowsControl) THEN
IF(SolarOnWindow > SetPoint) SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(.NOT.SunIsUp .AND. SchedAllowsControl) THEN
SurfaceWindow(ISurf)%ShadingFlag = ShType
ELSE IF(GlareControlIsActive) THEN
SurfaceWindow(ISurf)%ShadingFlag = 10*ShType
END IF
END IF
END SELECT
! Set switching factor to fully switched if ShadingFlag = 2
IF(SurfaceWindow(ISurf)%ShadingFlag == SwitchableGlazing) THEN
SurfaceWindow(ISurf)%SwitchingFactor = 1.0d0
! Added TH 1/20/2010
! Vis trans at normal incidence of fully switched glass
IConst = Surface(ISurf)%ShadedConstruction
SurfaceWindow(ISurf)%VisTransSelected = POLYF(1.0d0,Construct(IConst)%TransVisBeamCoef(1)) &
* SurfaceWindow(ISurf)%GlazedFrac
ENDIF
! Slat angle control for blinds
SurfaceWindow(ISurf)%SlatAngThisTS = 0.0d0
SurfaceWindow(ISurf)%SlatAngThisTSDeg = 0.0d0
SurfaceWindow(ISurf)%SlatsBlockBeam = .FALSE.
IF(SurfaceWindow(ISurf)%ShadingFlag==IntBlindOn.OR.SurfaceWindow(ISurf)%ShadingFlag==10*IntBlindOn.OR. &
SurfaceWindow(ISurf)%ShadingFlag==ExtBlindOn.OR.SurfaceWindow(ISurf)%ShadingFlag==10*ExtBlindOn.OR. &
SurfaceWindow(ISurf)%ShadingFlag==BGBlindOn.OR.SurfaceWindow(ISurf)%ShadingFlag==10*BGBlindOn) THEN
! Blind in place or may be in place due to glare control
BlNum = SurfaceWindow(ISurf)%BlindNumber
IF(BlNum > 0) THEN
InputSlatAngle = Blind(BlNum)%SlatAngle * DegToRadians
IF(Blind(BlNum)%SlatWidth > Blind(BlNum)%SlatSeparation .AND. BeamSolarOnWindow > 0.0d0) THEN
CALL ProfileAngle(ISurf,SOLCOS,Blind(BlNum)%SlatOrientation,ProfAng)
ThetaBase = ACOS(COS(ProfAng) * Blind(BlNum)%SlatSeparation/Blind(BlNum)%SlatWidth)
! There are two solutions for the slat angle that just blocks beam radiation
ThetaBlock1 = ProfAng + ThetaBase
ThetaBlock2 = ProfAng + PI - ThetaBase
ThetaSmall = MIN(ThetaBlock1,ThetaBlock2)
ThetaBig = MAX(ThetaBlock1,ThetaBlock2)
ThetaMin = Blind(BlNum)%MinSlatAngle*DegToRadians
ThetaMax = Blind(BlNum)%MaxSlatAngle*DegToRadians
END IF
! TH 5/20/2010, CR 8064: Slat Width <= Slat Separation
IF(Blind(BlNum)%SlatWidth <= Blind(BlNum)%SlatSeparation .AND. BeamSolarOnWindow > 0.0d0) THEN
IF (WindowShadingControl(IShadingCtrl)%SlatAngleControlForBlinds == WSC_SAC_BlockBeamSolar) THEN
CALL ProfileAngle(ISurf,SOLCOS,Blind(BlNum)%SlatOrientation,ProfAng)
IF (ABS(COS(ProfAng)*Blind(BlNum)%SlatSeparation/Blind(BlNum)%SlatWidth) <= 1.0D0) THEN
! set to block 100% of beam solar, not necessarily to block maximum solar (beam + diffuse)
ThetaBase = ACOS(COS(ProfAng)*Blind(BlNum)%SlatSeparation/Blind(BlNum)%SlatWidth)
SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
ELSE
! cannot block 100% of beam solar, turn slats to be perpendicular to sun beam to block maximal beam solar
ThetaBase = 0.0d0
ENDIF
! There are two solutions for the slat angle that just blocks beam radiation
ThetaBlock1 = ProfAng + ThetaBase
ThetaBlock2 = ProfAng - ThetaBase + PI
ThetaSmall = MIN(ThetaBlock1,ThetaBlock2)
ThetaBig = MAX(ThetaBlock1,ThetaBlock2)
ThetaMin = Blind(BlNum)%MinSlatAngle*DegToRadians
ThetaMax = Blind(BlNum)%MaxSlatAngle*DegToRadians
ENDIF
END IF
SELECT CASE(WindowShadingControl(IShadingCtrl)%SlatAngleControlForBlinds)
CASE(WSC_SAC_FixedSlatAngle) ! 'FIXEDSLATANGLE'
SurfaceWindow(ISurf)%SlatAngThisTS = InputSlatAngle
IF((SurfaceWindow(ISurf)%SlatAngThisTS <= ThetaSmall .OR. SurfaceWindow(ISurf)%SlatAngThisTS >= ThetaBig) &
.AND. (Blind(BlNum)%SlatWidth > Blind(BlNum)%SlatSeparation) .AND. &
(BeamSolarOnWindow > 0.0d0)) SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
CASE(WSC_SAC_ScheduledSlatAngle) ! 'SCHEDULEDSLATANGLE'
SurfaceWindow(ISurf)%SlatAngThisTS = GetCurrentScheduleValue(WindowShadingControl(IShadingCtrl)%SlatAngleSchedule)
SurfaceWindow(ISurf)%SlatAngThisTS = MAX(Blind(BlNum)%MinSlatAngle, &
MIN(SurfaceWindow(ISurf)%SlatAngThisTS,Blind(BlNum)%MaxSlatAngle))*DegToRadians
IF((SurfaceWindow(ISurf)%SlatAngThisTS <= ThetaSmall .OR. SurfaceWindow(ISurf)%SlatAngThisTS >= ThetaBig) &
.AND. (Blind(BlNum)%SlatWidth > Blind(BlNum)%SlatSeparation) .AND. &
(BeamSolarOnWindow > 0.0d0)) SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
CASE(WSC_SAC_BlockBeamSolar) ! 'BLOCKBEAMSOLAR'
IF(BeamSolarOnWindow > 0.0d0) THEN
IF(Blind(BlNum)%SlatSeparation >= Blind(BlNum)%SlatWidth) THEN
! TH 5/20/2010. CR 8064.
! The following line of code assumes slats are always vertical/closed to minimize solar penetration
! The slat angle can however change if the only goal is to block maximum amount of direct beam solar
!SurfaceWindow(ISurf)%SlatAngThisTS = 0.0 ! Allows beam penetration but minimizes it
IF(ThetaSmall >= ThetaMin .AND. ThetaSmall <= ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaSmall
ELSE IF(ThetaBig >= ThetaMin .AND. ThetaBig <= ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaBig
ELSE IF(ThetaSmall < ThetaMin .AND. ThetaBig < ThetaMin) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMin
ELSE IF(ThetaSmall > ThetaMax .AND. ThetaBig > ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMax
ELSE ! ThetaBig > ThetaMax and ThetaSmall < ThetaMin (no-block condition)
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMin
END IF
ELSE ! Usual case -- slat width greater than slat separation
IF(ThetaSmall >= ThetaMin .AND. ThetaSmall <= ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaSmall
SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
ELSE IF(ThetaBig >= ThetaMin .AND. ThetaBig <= ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaBig
SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
ELSE IF(ThetaSmall < ThetaMin .AND. ThetaBig < ThetaMin) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMin
SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
ELSE IF(ThetaSmall > ThetaMax .AND. ThetaBig > ThetaMax) THEN
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMax
SurfaceWindow(ISurf)%SlatsBlockBeam = .TRUE.
ELSE ! ThetaBig > ThetaMax and ThetaSmall < ThetaMin (no-block condition)
SurfaceWindow(ISurf)%SlatAngThisTS = ThetaMin
END IF
END IF
ELSE
SurfaceWindow(ISurf)%SlatAngThisTS = InputSlatAngle
END IF
END SELECT
SurfaceWindow(ISurf)%SlatAngThisTSDeg = SurfaceWindow(ISurf)%SlatAngThisTS / DegToRadians
IF (SurfaceWindow(ISurf)%SlatAngThisTSDegEMSon) THEN
SurfaceWindow(ISurf)%SlatAngThisTSDeg = SurfaceWindow(ISurf)%SlatAngThisTSDegEMSValue
SurfaceWindow(ISurf)%SlatAngThisTS = DegToRadians * SurfaceWindow(ISurf)%SlatAngThisTSDeg
ENDIF
! Air flow permeability for calculation of convective air flow between blind and glass
SlatAng = SurfaceWindow(ISurf)%SlatAngThisTS
PermeabilityA = SIN(SlatAng) - Blind(BlNum)%SlatThickness/Blind(BlNum)%SlatSeparation
PermeabilityB = 1.0-(ABS(Blind(BlNum)%SlatWidth*COS(SlatAng)) + Blind(BlNum)%SlatThickness*SIN(SlatAng))/ &
Blind(BlNum)%SlatSeparation
SurfaceWindow(ISurf)%BlindAirFlowPermeability = MIN(1.0d0,MAX(0.0d0,PermeabilityA,PermeabilityB))
END IF
END IF ! End of check if interior or exterior blind in place
! CALL CalcScreenTransmittance to intialized all screens prior to HB calc's
IF(SurfaceWindow(ISurf)%ShadingFlag == ExtScreenOn .AND. SunIsUp)THEN
CALL CalcScreenTransmittance(ISurf)
END IF
! EMS Actuator Point: override setting if ems flag on
IF (SurfaceWindow(ISurf)%ShadingFlagEMSOn) THEN
SurfaceWindow(ISurf)%ShadingFlag = SurfaceWindow(ISurf)%ShadingFlagEMSValue
ENDIF
END DO !End of surface loop
Return
END SUBROUTINE WindowShadingManager