SUBROUTINE CalcInteriorSolarDistribution
! SUBROUTINE INFORMATION:
! AUTHOR Fred Winkelmann
! DATE WRITTEN January 1999
! MODIFIED Nov 1999, FW, for Window5 calculation method
! Oct 2000, FW: add transmitted solar variables for reporting
! Mar 2001, FW: add new calc of solar absorbed by window shades
! May 2001, FW: add calc of solar transmitted and absorbed by window blinds
! Oct 2001, LL: remove interpolation, solar now at time step
! Oct 2001, FW: add solar transmitted through interior windows
! Mar 24, 2001, FW: remove incorrect multiplication of Boverlap by sunlit fraction
! since effect of shadowing is already included in Aoverlap
! Apr 2001, FW: add effects of beam solar reflection from outside and inside reveals
! Jan 2003, FW: add between-glass shades and blinds
! Dec 2003, FW: report beam incident on inside of surface
! Jan 2004, FW: for blinds with horizontal slats, allow different diffuse/diffuse
! transmittance for ground and sky solar
! Apr 2004, FW: allow diffusing glazing
! May 2006, RR: allow external window screen
! Jan 2010, TH: add calculating and reporting of WinBmBmSolar, WinBmDifSolar,
! WinBmBmSolarEnergy, and WinBmDifSolarEnergy
! Jun 2013, SV: scheduled surface gains for walls and windows
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! For a time step, calculates solar radiation absorbed by exterior
! surfaces and interior solar radiation distribution
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE General, ONLY: POLYF, InterpSw, InterpBlind, InterpSlatAng, InterpProfSlatAng, BlindBeamBeamTrans, InterpProfAng
USE DataDaylightingDevices
USE DaylightingDevices, ONLY: FindTDDPipe, TransTDD
USE WindowEquivalentLayer, ONLY: CalcEQLOpticalProperty, CFSDiffAbsTrans
USE DataWindowEquivalentLayer
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum ! Zone number
INTEGER :: SurfNum ! Surface number
INTEGER :: SurfNum2 ! Secondary surface number for tubular daylighting device diffuser (TDD:DIFFUSER)
INTEGER :: PipeNum ! TDD pipe object number
INTEGER :: ShelfNum ! Daylighting shelf object number
INTEGER :: InShelfSurf ! Inside daylighting shelf surface number
INTEGER :: OutShelfSurf ! Outside daylighting shelf surface number
REAL(r64) :: ShelfSolarRad ! Shelf diffuse solar radiation
INTEGER :: BackSurfNum ! Back surface number
INTEGER :: IBack ! Back surface counter
INTEGER :: RevSurfInd !Back surface counter value for reversed surfaces
INTEGER :: KRevSurf !Additional Back surface counter for reversed surfaces
INTEGER :: FloorNum ! Floor surface number
INTEGER :: AdjSurfNum ! Adjacent surface number
INTEGER :: AdjZoneNum ! Adjacent zone number
REAL(r64) :: CosTlt ! Cosine of surface tilt angle
INTEGER :: ConstrNum ! Construction number
INTEGER :: ConstrNumSh ! Shaded construction number
INTEGER :: ConstrNumBack ! Construction number of back surface
INTEGER :: ConstrNumBackSh ! Shaded construction number of back surface
INTEGER :: FlConstrNum ! Construction number of floor surface
INTEGER :: ShadeFlag ! Shading flag for a window
INTEGER :: ShadeFlagBack ! Shading flag for a window that is a back surface
INTEGER :: Lay ! Glass layer number
REAL(r64) :: SwitchFac ! Switching factor for a window
REAL(r64) :: SwitchFacBack ! Switching factor for a window that is a back surface
REAL(r64) :: TransBeamWin ! Beam solar transmittance of a window
REAL(r64) :: TransBeamWinSh ! Beam solar transmittance of a shaded window
REAL(r64) :: AbsBeamWin(MaxSolidWinLayers) ! Glass layer beam solar absorptance of a window
REAL(r64) :: AbsBeamWinSh(MaxSolidWinLayers) ! Glass layer beam solar absorptance of a shaded window
REAL(r64) :: AbsBeamWinEQL(CFSMAXNL+1) ! layers beam solar absorptance of a window
REAL(r64) :: AbsBeamTotWin ! Sum of window glass layer beam solar absorptances
REAL(r64) :: ProfAng ! Window solar profile angle (radians)
REAL(r64) :: ProfAngBack ! Back window solar profile angle (radians)
INTEGER :: BlNum ! Blind number
INTEGER :: ScNum ! Screen number
INTEGER :: BlNumBack ! Back surface blind number
INTEGER :: ScNumBack ! Back surface screen number
REAL(r64) :: TBmBm ! Beam-beam solar transmittance for bare window or window with switchable glazing
REAL(r64) :: TBmDif ! Beam-diffuse solar transmittance for bare window with diffusing glass
REAL(r64) :: TBlBmDif ! Beam-diffuse solar transmittance of blind
REAL(r64) :: TScBmDif ! Beam-diffuse solar transmittance of screen
REAL(r64) :: TBlDifDif ! Diffuse-diffuse solar transmittance of blind
REAL(r64) :: TScDifDif ! Diffuse-diffuse solar transmittance of screen
REAL(r64) :: RhoBlBmDifFr ! Beam-diffuse front reflectance of blind
REAL(r64) :: RhoBlBmDifBk ! Beam-diffuse back reflectance of blind
REAL(r64) :: RScBmDifBk ! Beam-diffuse back reflectance of blind
REAL(r64) :: RhoBlDifDifFr ! Diffuse-diffuse front refectance of blind
REAL(r64) :: RhoBlDifDifBk ! Diffuse-diffuse back refectance of blind
REAL(r64) :: RScDifDifBk ! Diffuse-diffuse back refectance of screen
REAL(r64) :: RGlBmFr ! Beam front reflectance of glass
REAL(r64) :: RGlDifFr ! Diffuse front reflectance of glass
REAL(r64) :: RGlDifBk ! Diffuse back reflectance of glass
REAL(r64) :: TBmBmBl ! Beam-beam transmittance for window with blind
REAL(r64) :: TBmBmSc ! Beam-beam transmittance for window with screen
REAL(r64) :: TBmAllShBlSc ! Beam-beam + beam-diffuse transmittance for window with shade, blind, screen,
! or switchable glazing
REAL(r64) :: TBmAll ! Window beam-to-(beam+diffuse) transmittance
REAL(r64) :: TBm ! Window beam-beam transmittance
REAL(r64) :: DifSolarInc ! Exterior diffuse solar incident on window (W/m2)
REAL(r64) :: SkySolarTrans ! Exterior diffuse sky solar transmitted by TDD (W/m2)
REAL(r64) :: GndSolarTrans ! Exterior diffuse ground solar transmitted by TDD (W/m2)
REAL(r64) :: TDifBare ! Bare diffuse transmittance of exterior window
REAL(r64) :: TGlDif ! Bare diffuse transmittance of back window
REAL(r64) :: TGlBm ! Glazing system front solar beam transmittance
REAL(r64) :: TGlBmBack ! Glazing system back solar beam transmittance
REAL(r64) :: AGlDiffBack ! Glass layer back diffuse solar absorptance
REAL(r64) :: RGlDiffBack ! Glazing system back diffuse solar reflectance
REAL(r64) :: AGlDiffFront ! Glass layer front diffuse solar absorptance
REAL(r64) :: RGlDiffFront ! Glazing system front diffuse solar reflectance
REAL(r64) :: TotReflect !Total directional-hemispherical solar reflectance of a back surface window
REAL(r64) :: RhoBlFront ! Blind solar front beam reflectance
REAL(r64) :: RhoBlBack ! Blind solar back beam-diffuse reflectance
REAL(r64) :: RScBack ! Screen solar back beam-diffuse reflectance
REAL(r64) :: RScDifBack ! Screen solar back diffuse-diffuse reflectance
REAL(r64) :: AbsBlFront ! Blind solar front beam absorptance
REAL(r64) :: AbsScBeam ! Screen solar beam absorptance
REAL(r64) :: AbsBlBack ! Blind solar back beam absorptance
REAL(r64) :: AbsScBack ! Screen solar back beam absorptance
REAL(r64) :: AbsBlDiffFront ! Blind solar front diffuse absorptance
REAL(r64) :: AbsBlDiffBack ! Blind solar back diffuse absorptance
REAL(r64) :: AbsScDiffBack ! Screen solar back diffuse absorptance
REAL(r64) :: ABlBack ! Blind solar back absorptance for interior solar
REAL(r64) :: AScBack ! Screen solar back absorptance for interior solar
REAL(r64) :: TrSh ! Shade material solar transmittance
REAL(r64) :: AbsSh ! Shade material solar absorptance
REAL(r64) :: RhoSh ! Shade material solar reflectance
REAL(r64) :: AShBack ! System shade absorptance for interior beam solar
REAL(r64) :: TBlBmBm ! Blind solar front beam-beam transmittance
REAL(r64) :: TScBmBm ! Screen solar front beam-beam transmittance
REAL(r64) :: TBlBmBmBack ! Blind solar back beam-beam transmittance
REAL(r64) :: TScBmBmBack ! Screen solar back beam-beam transmittance
REAL(r64) :: TBlBmDiff ! Blind solar front beam-diffuse transmittance
REAL(r64) :: TScBmDiff ! Screen solar front beam-diffuse transmittance
REAL(r64) :: TBlBmDiffBack ! Blind solar back beam-diffuse transmittance
REAL(r64) :: TScBmDiffBack ! Screen solar back beam-diffuse transmittance
REAL(r64) :: RhoBlDiffFront ! Blind solar front diffuse reflectance
REAL(r64) :: RhoBlDiffBack ! Blind solar back diffuse reflectance
REAL(r64) :: RScDiffBack ! Screen solar back diffuse reflectance
REAL(r64) :: RGlFront ! Glazing system solar front beam-beam reflectance
REAL(r64) :: RGlBack ! Glazing system solar back beam-beam reflectance
REAL(r64) :: BTOTWinZone ! Transmitted beam solar factor for a window
REAL(r64) :: BTOTZone ! (Solar entering a zone as beam or diffuse radiation, originating as beam solar
! incident on exterior windows)/(Beam normal solar) [W/(W/m2)]
REAL(r64) :: BTOTZoneSSG ! Solar entering a zone in case of scheduled surface gains
REAL(r64) :: AbWin(MaxSolidWinLayers) ! Factor for front beam radiation absorbed in window glass layers
REAL(r64) :: AbWinBack ! Factor for back beam radiation absorbed in window glass layers
REAL(r64) :: AbWinSh(MaxSolidWinLayers) ! Like AbWin, but for shaded window
REAL(r64) :: AbWinEQL(CFSMAXNL+1) ! Factor for front beam radiation absorbed for equivalent layer window model
REAL(r64) :: AdWinEQL(CFSMAXNL+1) ! Factor for front diffuse radiation absorbed for equivalent layer window model
REAL(r64) :: BABSZone ! Beam radiation from exterior windows absorbed in a zone or transmitted through
REAL(r64) :: BABSZoneSSG ! Beam radiation from exterior windows absorbed in a zone (only for scheduled surface gains)
REAL(r64) :: AOverlap ! Back surface area irradiated by beam solar from an exterior window,
! projected onto window plane
REAL(r64) :: BOverlap ! AOverlap multiplied by exterior window beam transmittance
! and cosine of incidence angle
REAL(r64) :: AbsScreen ! Exterior screen beam solar absorptance
REAL(r64) :: AbsShade ! Interior shade or blind beam solar absorptance
REAL(r64) :: AbsShadeDiff ! Interior shade or blind diffuse solar absorptance
REAL(r64) :: DSZoneWin ! Factor for sky diffuse solar gain into a zone from an exterior window
REAL(r64) :: DSZoneWinSh ! Factor for sky diffuse solar gain into a zone from a shaded exterior window
REAL(r64) :: DGZoneWin ! Factor for ground diffuse solar gain into a zone
REAL(r64) :: DGZoneWinSh ! Factor for ground diffuse solar gain into a zone from a shaded exterior window
REAL(r64) :: HMovInsul ! Conductance of movable wall insulation
REAL(r64) :: AbsIntSurf, AbsInt ! Interior solar absorptance of opaque surface
REAL(r64) :: MovInsulSchedVal ! Value of the movable insulation schedule for current time
REAL(r64) :: FracSunLit ! Effective fraction of window that is sunlit;
! takes shadowing effects of frame and divider into account
REAL(r64) :: SunLitFract ! Sunlit fraction w/o shadowing effects of frame and divider
REAL(r64) :: InOutProjSLFracMult ! = SurfaceWindow(SurfNum)%InOutProjSLFracMult(HourOfDay)
REAL(r64) :: CosInc,CosIncBack ! Incidence angle of beam solar radiation on window
REAL(r64) :: SlatAng,SlatAngBack ! Slat angle this time step for window with blind on (deg)
LOGICAL :: VarSlats,VarSlatsBack ! True if variable slat angle
REAL(r64) :: ADiffWin(5) ! Diffuse solar absorptance of glass layers, bare window
REAL(r64) :: ADiffWinSh(5) ! Diffuse solar absorptance of glass layers, window with shading device
REAL(r64) :: DiffTrans ! Glazing diffuse solar transmittance (including shade/blind/switching, if present)
REAL(r64) :: DiffTransGnd ! Ground diffuse solar transmittance for glazing with blind with horiz. slats or complex fen
REAL(r64) :: DiffTransBmGnd !Complex fen: diffuse solar transmittance for ground-reflected beam radiation
REAL(r64) :: DiffTransSky ! Sky diffuse solar transmittance for glazing with blind with horiz. slats or complex fen
REAL(r64) :: NomDiffTrans !
INTEGER :: BaseSurfNum ! Base surface number
REAL(r64) :: t1,t2,t3 ! Bare-glass beam solar transmittance for glass layers 1,2 and 3
REAL(r64) :: t1t2 ! t1*t2
REAL(r64) :: af1,af2,af3 ! Bare-glass beam solar front absorptance for glass layers 1,2 and 3
REAL(r64) :: ab1,ab2,ab3 ! Bare-glass beam solar back absorptance for glass layers 1,2 and 3
REAL(r64) :: rf1,rf2,rf3 ! Bare-glass beam solar front reflectance for glass layers 1,2 and 3
REAL(r64) :: rb1,rb2,rb3 ! Bare-glass beam solar back reflectance for glass layers 1,2 and 3
REAL(r64) :: td1,td2,td3 ! Bare-glass diffuse solar transmittance for glass layers 1,2 and 3
REAL(r64) :: td1td2 ! td1*td2
REAL(r64) :: afd1,afd2,afd3 ! Bare-glass diffuse solar front absorptance for glass layers 1,2 and 3
REAL(r64) :: abd1,abd2,abd3 ! Bare-glass diffuse solar back absorptance for glass layers 1,2 and 3
REAL(r64) :: rfd1,rfd2,rfd3 ! Bare-glass diffuse solar front reflectance for glass layers 1,2 and 3
REAL(r64) :: rbd1,rbd2,rbd3 ! Bare-glass diffuse solar back reflectance for glass layers 1,2 and 3
REAL(r64) :: tfshBB,tbshBB ! Bare-blind front and back beam-beam solar transmittance
REAL(r64) :: tfshBd,tbshBd ! Bare-blind front and back beam-diffuse solar transmittance
REAL(r64) :: tfshd,tbshd ! Bare-blind front and back diffuse-diffuse solar transmittance
REAL(r64) :: afshB,abshB ! Bare-blind front and back beam solar absorptance
REAL(r64) :: afshd,abshd ! Bare-blind front and back diffuse solar absorptance
REAL(r64) :: rfshB,rbshB ! Bare-blind front and back beam solar reflectance
REAL(r64) :: rfshd,rbshd ! Bare-blind front and back diffuse solar reflectance
REAL(r64) :: t1k,t2k,t3k ! Back surface bare-glass beam solar transmittance for glass layers 1,2,3
REAL(r64) :: af2k,af3k ! Back surface bare-glass beam solar front absorptance for glass layers 2 and 3
REAL(r64) :: ab1k,ab2k,ab3k ! Back surface bare-glass beam solar back absorptance for glass layers 1,2 and 3
REAL(r64) :: rb1k,rb2k ! Back surface bare-glass beam solar back reflectance for glass layers 1,2
REAL(r64) :: td1k,td2k ! Back surface bare-glass beam diffuse solar transmittance for glass layers 1,2
REAL(r64) :: afd2k,afd3k ! Back surface bare-glass diffuse solar front absorptance for glass layer 2 and 3
REAL(r64) :: abd1k,abd2k ! Back surface bare-glass diffuse solar back absorptance for glass layer 1 and 2
REAL(r64) :: rfd2k,rfd3k ! Back surface bare-glass diffuse solar front reflectance for glass layer 2 and 3
REAL(r64) :: rbd1k,rbd2k ! Back surface bare-glass diffuse solar back reflectance for glass layer 1 and 2
REAL(r64) :: tfshBBk,tbshBBk ! Back surface bare-blind beam-beam solar front and back transmittance
REAL(r64) :: tfshBdk,tbshBdk ! Back surface bare-blind beam-diffuse solar front and back transmittance
REAL(r64) :: tfshdk,tbshdk ! Back surface bare-blind diffuse-diffuse solar front and back transmittance
REAL(r64) :: rfshBk,rbshBk ! Back surface bare-blind beam solar front, back reflectance
REAL(r64) :: rfshdk,rbshdk ! Back surface bare-blind diffuse solar front, back reflectance
REAL(r64) :: afshBk,abshBk ! Back surface bare-blind beam solar front, back absorptance
REAL(r64) :: afshdk,abshdk ! Back surface bare-blind diffuse solar front, back absorptance
INTEGER :: NGlass ! Number of glass layers in a construction
INTEGER :: NBackGlass ! Number of glass layers in the "back" construction
REAL(r64) :: SkySolarInc ! Incident solar radiation on a window: sky diffuse plus beam
! reflected from obstruction (W/m2)
REAL(r64) :: GndSolarInc ! Incident solar radiation on a window from the ground (W/m2)
REAL(r64) :: SkyGndTrans ! complex fen: transmitted ground-reflected sky radiation (W/m2)
REAL(r64) :: BmGndTrans ! complex fen: transmitted ground-reflected beam radiation (W/m2)
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: ExtBeamAbsByShadFac ! Factor for exterior beam radiation absorbed by shade
! (1/m2) (absorbed radation = beam incident * ExtBeamAbsByShad
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: IntBeamAbsByShadFac ! Like ExtBeamAbsByShadFac, but for interior beam radiation.
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: WinTransBmSolar ! Factor for exterior beam solar transmitted through window,
! or window plus shade, into zone at current time (m2)
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: WinTransDifSolar ! Factor for exterior diffuse solar transmitted through window,
! or window plus shade, into zone at current time (m2)
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: WinTransDifSolarGnd ! Factor for exterior ground diffuse solar transmitted through
! window with horizontally-slatted blind into zone at current time (m2)
REAL(r64), SAVE,ALLOCATABLE, DIMENSION(:) :: WinTransDifSolarSky ! Factor for exterior sky diffuse solar transmitted through
! window with horizontally-slatted blind into zone at current time (m2)
LOGICAL,SAVE :: MustAlloc=.true. ! True when local arrays must be allocated
REAL(r64) :: TBmDenom ! TBmDenominator
REAL(r64) :: TBmBmShBlSc ! Beam-beam transmittance for window with shade, blind, screen, or switchable glazing
REAL(r64) :: TBmDifShBlSc ! Beam-diffuse transmittance for window with shade, blind, screen, or switchable glazing
REAL(r64) :: WinTransBmBmSolar ! Factor for exterior beam to beam solar transmitted through window,
! or window plus shade, into zone at current time (m2)
REAL(r64) :: WinTransBmDifSolar ! Factor for exterior beam to diffuse solar transmitted through window,
! or window plus shade, into zone at current time (m2)
REAL(r64) :: TBmBmEQL ! Beam-beam solar transmittance for equivalent layer model window W/WO shade
REAL(r64) :: TBmDiffEQL ! Beam-diffuse solar transmittance for equivalent layer model window W/WO shade
! Variables for complex fenestration
INTEGER :: CurCplxFenState ! Current state for complex fenestration
INTEGER :: CurBackState ! Current state for back surface if that surface is complex fenestration
INTEGER :: CurTrnDir ! Current back window surface BSDF direction
INTEGER :: CurBackDir ! current hit direction to complex fenestration
INTEGER :: IBm ! Incoming direction of the Sun (for window BSDF)
INTEGER :: IConst ! Current surface construction number (it depends of state too)
INTEGER :: NBkSurf ! Number of back surfaces
INTEGER :: BaseSurf ! Base surface number for current complex window
INTEGER :: BackSurfaceNumber ! Back surface number
REAL(r64), ALLOCATABLE, DIMENSION(:) :: CFBoverlap ! Sum of boverlap for each back surface
REAL(r64), ALLOCATABLE, DIMENSION(:, :) :: CFDirBoverlap ! Directional boverlap (Direction, IBack)
REAL(r64) :: CurLambda ! Current lambda value in BSDF outgoing directions
REAL(r64) :: DirTrans ! Current BSDF directional transmittance
! (for incoming I and outgoing J directions)
REAL(r64) :: bestDot ! complex fenestration hits other complex fenestration, it is important to find
! matching beam directions. Beam leving one window will have certaing number for it's basis
! while same beam reaching back surface will have different beam number. This value is used
! to keep best matching dot product for those directions
REAL(r64) :: curDot ! temporary variable for current dot product
INTEGER :: bestTrn ! Direction corresponding best dot product for master window
INTEGER :: bestBackTrn ! Direction corresponding best dot product for back surface window
INTEGER :: TotSolidLay ! Number of window solid layers
REAL(r64) :: tempVec1(3) ! temporary vector for performing dot_product
REAL(r64) :: tempVec2(3) ! temporary vector for performing dot_product
REAL(r64) :: AbsSolBeamEQL(CFSMAXNL+1,2) ! absorbed exterior beam radiation by layers fraction
REAL(r64) :: AbsSolDiffEQL(CFSMAXNL+1,2) ! absorbed exterior diffuse radiation by layers fraction
INTEGER :: EQLNum ! equivalent layer fenestration index
REAL(r64) :: AbsSolBeamBackEQL(CFSMAXNL+1,2) ! absorbed interior beam radiation by layers fraction from back
REAL(r64) :: AbsSolDiffBackEQL(CFSMAXNL+1,2) ! absorbed exterior diffuse radiation by layers fraction from back
! scheduled surface gains local variables
INTEGER :: FenSolAbsPtr
INTEGER :: SurfSolIncPtr
INTEGER :: iSSG ! scheduled surface gains counter
REAL(r64) :: SolarIntoZone ! Solar radiation into zone to current surface
IF (MustAlloc) THEN
ALLOCATE (DBZoneIntWin(NumOfZones))
ALLOCATE (IntBeamAbsByShadFac(TotSurfaces))
ALLOCATE (ExtBeamAbsByShadFac(TotSurfaces))
ALLOCATE (WinTransBmSolar(TotSurfaces))
ALLOCATE (WinTransDifSolar(TotSurfaces))
ALLOCATE (WinTransDifSolarGnd(TotSurfaces))
ALLOCATE (WinTransDifSolarSky(TotSurfaces))
MustAlloc=.false.
ENDIF
#ifdef EP_Count_Calls
NumIntSolarDist_Calls=NumIntSolarDist_Calls+1
#endif
DSZone = 0.0d0
DGZone = 0.0d0
DBZone = 0.0d0
DBZoneSSG = 0.0d0
DBZoneIntWin = 0.0d0
AISurf = 0.0d0
AOSurf = 0.0d0
ABWin = 0.0d0
ABWinSh= 0.0d0
AWinSurf = 0.0d0
WinTransBmSolar = 0.0d0
WinTransDifSolar = 0.0d0
WinTransDifSolarGnd = 0.0d0
WinTransDifSolarSky = 0.0d0
WinBmSolar = 0.0d0
WinBmBmSolar = 0.0d0
WinBmDifSolar = 0.0d0
WinTransBmBmSolar = 0.0d0
WinTransBmDifSolar = 0.0d0
TBmBm = 0.0d0
TBmDif = 0.0d0
TBmBmEQL = 0.0d0
TBmDiffEQL = 0.0d0
WinDifSolar = 0.0d0
ZoneTransSolar = 0.0d0
ZoneBmSolFrExtWinsRep = 0.0d0
ZoneBmSolFrIntWinsRep = 0.0d0
ZoneDifSolFrExtWinsRep = 0.0d0
ZoneDifSolFrIntWinsRep = 0.0d0
IntBeamAbsByShadFac=0.0d0
ExtBeamAbsByShadFac=0.0d0
SurfaceWindow%BmSolTransThruIntWinRep=0.0d0
!energy
WinBmSolarEnergy = 0.0d0
WinBmBmSolarEnergy=0.0d0
WinBmDifSolarEnergy=0.0d0
WinDifSolarEnergy = 0.0d0
ZoneTransSolarEnergy = 0.0d0
ZoneBmSolFrExtWinsRepEnergy = 0.0d0
ZoneBmSolFrIntWinsRepEnergy = 0.0d0
ZoneDifSolFrExtWinsRepEnergy = 0.0d0
ZoneDifSolFrIntWinsRepEnergy = 0.0d0
SurfaceWindow%BmSolTransThruIntWinRepEnergy=0.0d0
DO ZoneNum = 1, NumOfZones
BTOTZone = 0.0d0
BABSZone = 0.0d0
! Loop over exterior surfaces in this zone
DO SurfNum = Zone(ZoneNum)%SurfaceFirst, Zone(ZoneNum)%SurfaceLast
IF ( ((Surface(SurfNum)%ExtBoundCond /= ExternalEnvironment) .AND. &
(Surface(SurfNum)%ExtBoundCond /= OtherSideCondModeledExt) ) &
.AND. SurfaceWindow(SurfNum)%OriginalClass /= SurfaceClass_TDD_Diffuser) CYCLE
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE
! TH added 3/24/2010 while debugging CR 7872
IF (.NOT. Surface(SurfNum)%ExtSolar) CYCLE
ConstrNum = Surface(SurfNum)%Construction
ConstrNumSh = SurfaceWindow(SurfNum)%ShadedConstruction
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(SurfNum)%StormWinConstruction
ConstrNumSh = Surface(SurfNum)%StormWinShadedConstruction
END IF
BlNum = SurfaceWindow(SurfNum)%BlindNumber
ScNum = SurfaceWindow(SurfNum)%ScreenNumber
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag ! Set in subr. WindowShadingManager
ProfAng = 0.0d0
IF (ShadeFlag /= ExtScreenOn .and. BlNum > 0) CALL ProfileAngle(SurfNum,SOLCOS,Blind(BlNum)%SlatOrientation,ProfAng)
SlatAng = SurfaceWindow(SurfNum)%SlatAngThisTS
VarSlats = SurfaceWindow(SurfNum)%MovableSlats
IF (SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
PipeNum = FindTDDPipe(SurfNum)
SurfNum2 = TDDPipe(PipeNum)%Dome
ELSE
SurfNum2 = SurfNum
END IF
ShelfNum = Surface(SurfNum)%Shelf
IF (ShelfNum > 0) THEN ! Daylighting shelf
InShelfSurf = Shelf(ShelfNum)%InSurf
OutShelfSurf = Shelf(ShelfNum)%OutSurf
ELSE
InShelfSurf = 0
OutShelfSurf = 0
END IF
CosInc = CosIncAng(SurfNum2,HourOfDay,TimeStep)
SunLitFract = SunLitFrac(SurfNum2,HourOfDay,TimeStep)
!-------------------------------------------------------------------------
! EXTERIOR BEAM SOLAR RADIATION ABSORBED ON THE OUTSIDE OF OPAQUE SURFACES
!-------------------------------------------------------------------------
IF(SunLitFract > 0.0d0 .AND. Construct(ConstrNum)%TransDiff <= 0.0d0) THEN
AOSurf(SurfNum) = Construct(ConstrNum)%OutsideAbsorpSolar * CosInc * SunLitFract
! Note: movable insulation, if present, is accounted for in subr. InitIntSolarDistribution,
! where QRadSWOutMvIns is calculated from QRadSWOutAbs and insulation solar absorptance
END IF
!-------------------------------------------------------------------------------------------
! EXTERIOR BEAM AND DIFFUSE SOLAR RADIATION ABSORBED IN THE GLASS LAYERS OF EXTERIOR WINDOWS
!-------------------------------------------------------------------------------------------
IF(Surface(SurfNum)%Class /= SurfaceClass_Window .AND. Surface(SurfNum)%Class /= SurfaceClass_TDD_Dome) CYCLE
! Somewhat of a kludge
IF(Surface(SurfNum)%Class == SurfaceClass_TDD_Dome .OR. SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) &
SunlitFracWithoutReveal(SurfNum,HourOfDay,TimeStep) = SunLitFract ! Frames/dividers not allowed
WinTransBmBmSolar = 0.0d0
WinTransBmDifSolar = 0.0d0
InOutProjSLFracMult = SurfaceWindow(SurfNum)%InOutProjSLFracMult(HourOfDay)
IF(SunlitFracWithoutReveal(SurfNum,HourOfDay,TimeStep) > 0.0d0) THEN
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel .AND. &
SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
! For bare glazing or switchable glazing, the following includes the effects of
! (1) diffuse solar produced by beam solar incident on the outside and inside reveal
! surfaces, and (2) absorption of beam solar by outside and inside reveal surfaces.
! If there is an exterior shade/blind both of these effects are ignored. If there
! is an interior or between-glass shade/blind the effects of beam incident on
! inside reveal surfaces is ignored.
NGlass = Construct(ConstrNum)%TotGlassLayers
DO Lay = 1,NGlass
ABWin(Lay) = POLYF(CosInc,Construct(ConstrNum)%AbsBeamCoef(Lay,1:6)) * &
CosInc * SunLitFract * SurfaceWindow(SurfNum)%OutProjSLFracMult(HourOfDay)
ADiffWin(Lay) = Construct(ConstrNum)%AbsDiff(Lay)
IF(ShadeFlag <= 0 .OR. ShadeFlag >= 10) THEN
! Bare window (ShadeFlag = -1 or 0 or shading device of off)
AWinSurf(SurfNum,Lay) = ABWin(Lay) &
! Add contribution of beam reflected from outside and inside reveal
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * Construct(ConstrNum)%AbsDiff(Lay) &
+ SurfaceWindow(SurfNum)%InsRevealDiffOntoGlazing * Construct(ConstrNum)%AbsDiffBack(Lay)
ELSE
! Shade, screen, blind or switchable glazing on (ShadeFlag > 0)
FracSunLit = SunLitFract*SurfaceWindow(SurfNum)%OutProjSLFracMult(HourOfDay)
IF(ShadeFlag==ExtShadeOn .OR. ShadeFlag==ExtBlindOn .OR. ShadeFlag==ExtScreenOn) FracSunLit = SunLitFract
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==ExtShadeOn.OR.ShadeFlag==BGShadeOn .OR. ShadeFlag==SwitchableGlazing) THEN
! Shade or switchable glazing on
ABWinSh(Lay) = POLYF(CosInc,Construct(ConstrNumSh)%AbsBeamCoef(Lay,1:6)) * CosInc * FracSunLit
ADiffWinSh(Lay) = Construct(ConstrNumSh)%AbsDiff(Lay)
ELSE
! Blind or screen on
IF(Lay == 1 .AND. ShadeFlag/=ExtScreenOn) CALL ProfileAngle(SurfNum,SOLCOS,Blind(BlNum)%SlatOrientation,ProfAng)
IF(ShadeFlag == IntBlindOn) THEN
! Interior blind on
IF(Lay==1) THEN
TGlBm = POLYF(CosInc,Construct(ConstrNum)%TransSolBeamCoef(1:6))
RGlDiffBack = Construct(ConstrNum)%ReflectSolDiffBack
RhoBlFront = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffRefl)
RhoBlDiffFront = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffRefl)
END IF
AGlDiffBack = Construct(ConstrNum)%AbsDiffBack(Lay)
ABWinSh(Lay) = AbWin(Lay) + (TGlBm*AGlDiffBack*RhoBlFront/(1.d0-RhoBlFront*RGlDiffBack))* &
CosInc * FracSunLit
ADiffWinSh(Lay) = ADiffWin(Lay) + Construct(ConstrNum)%TransDiff*AGlDiffBack*RhoBlDiffFront/ &
(1.d0-RhoBlDiffFront*RGlDiffBack)
ELSE IF(ShadeFlag == ExtBlindOn) THEN
! Exterior blind on
IF(Lay==1) THEN
TBlBmBm = BlindBeamBeamTrans(ProfAng,SlatAng,Blind(BlNum)%SlatWidth, &
Blind(BlNum)%SlatSeparation,Blind(BlNum)%SlatThickness)
TBlBmDiff = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffTrans)
RhoBlBack = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamDiffRefl)
RhoBlDiffBack = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffDiffRefl)
RGlFront = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
RGlDiffFront = Construct(ConstrNum)%ReflectSolDiffFront
TBlDifDif = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffTrans)
RGlDifFr = Construct(ConstrNum)%ReflectSolDiffFront
RhoBlDifDifBk = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffDiffRefl)
END IF
AGlDiffFront = Construct(ConstrNum)%AbsDiff(Lay)
ABWinSh(Lay) = TBlBmBm*ABWin(Lay) + ((TBlBmBm*RGlFront*RhoBlBack + TBlBmDiff) * AGlDiffFront / &
(1 - RGlDiffFront*RhoBlDiffBack)) * CosInc * FracSunLit
!ADiffWinSh(Lay) = 0.0 ! Assumes no contribution from reveal reflection when exterior blind in place
! Replaced above line with (FCW, 2/10/03):
ADiffWinSh(Lay) = ADiffWin(Lay) * TBlDifDif/(1.d0-RGlDifFr*RhoBlDifDifBk)
ELSE IF(ShadeFlag == ExtScreenOn) THEN
! Exterior screen on
IF(Lay==1) THEN
TScBmBm = SurfaceScreens(ScNum)%BmBmTrans
TScBmDiff = SurfaceScreens(ScNum)%BmDifTrans
RScBack = SurfaceScreens(ScNum)%ReflectSolBeamFront
RScDifBack = SurfaceScreens(ScNum)%DifReflect
RGlFront = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
RGlDiffFront = Construct(ConstrNum)%ReflectSolDiffFront
TScDifDif = SurfaceScreens(ScNum)%DifDifTrans
RGlDifFr = Construct(ConstrNum)%ReflectSolDiffFront
END IF
AGlDiffFront = Construct(ConstrNum)%AbsDiff(Lay)
! Reduce the bare window absorbed beam by the screen beam transmittance and then account for interreflections
ABWinSh(Lay) = TScBmBm*ABWin(Lay) + (TScBmBm*RGlFront*RScBack + TScBmDiff) * &
Construct(ConstrNum)%AbsDiff(Lay)/(1.d0-RGlDiffFront*RScDifBack) * CosInc * FracSunLit
ADiffWinSh(Lay) = ADiffWin(Lay) * TScDifDif/(1.d0-RGlDifFr*RScDifBack)
ELSE
! Between-glass blind on
! Isolated glass and blind properties at current incidence angle, profile angle and slat angle
IF(Lay==1) THEN
t1 = POLYF(CosInc,Construct(ConstrNum)%tBareSolCoef(1,1:6))
t2 = POLYF(CosInc,Construct(ConstrNum)%tBareSolCoef(2,1:6))
af1 = POLYF(CosInc,Construct(ConstrNum)%afBareSolCoef(1,1:6))
af2 = POLYF(CosInc,Construct(ConstrNum)%afBareSolCoef(2,1:6))
ab1 = POLYF(CosInc,Construct(ConstrNum)%abBareSolCoef(1,1:6))
ab2 = POLYF(CosInc,Construct(ConstrNum)%abBareSolCoef(2,1:6))
rf1 = POLYF(CosInc,Construct(ConstrNum)%rfBareSolCoef(1,1:6))
rf2 = POLYF(CosInc,Construct(ConstrNum)%rfBareSolCoef(2,1:6))
rb1 = POLYF(CosInc,Construct(ConstrNum)%rbBareSolCoef(1,1:6))
rb2 = POLYF(CosInc,Construct(ConstrNum)%rbBareSolCoef(2,1:6))
td1 = Construct(ConstrNum)%tBareSolDiff(1)
td2 = Construct(ConstrNum)%tBareSolDiff(2)
afd1 = Construct(ConstrNum)%afBareSolDiff(1)
afd2 = Construct(ConstrNum)%afBareSolDiff(2)
abd1 = Construct(ConstrNum)%abBareSolDiff(1)
abd2 = Construct(ConstrNum)%abBareSolDiff(2)
rfd1 = Construct(ConstrNum)%rfBareSolDiff(1)
rfd2 = Construct(ConstrNum)%rfBareSolDiff(2)
rbd1 = Construct(ConstrNum)%rbBareSolDiff(1)
rbd2 = Construct(ConstrNum)%rbBareSolDiff(2)
tfshBB = BlindBeamBeamTrans(ProfAng,SlatAng,Blind(BlNum)%SlatWidth, &
Blind(BlNum)%SlatSeparation,Blind(BlNum)%SlatThickness)
tfshBd = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffTrans)
tfshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffTrans)
tbshBB = BlindBeamBeamTrans(ProfAng,PI-SlatAng,Blind(BlNum)%SlatWidth, &
Blind(BlNum)%SlatSeparation,Blind(BlNum)%SlatThickness)
tbshBd = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamDiffTrans)
tbshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffDiffTrans)
afshB = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamAbs)
abshB = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamAbs)
afshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffAbs)
abshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffAbs)
rfshB = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffRefl)
rbshB = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamDiffRefl)
rfshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffRefl)
rbshd = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffDiffRefl)
END IF
IF(Lay==1.AND.NGlass==3) THEN
t1t2 = t1*t2
td1td2 = td1*td2
t3 = POLYF(CosInc,Construct(ConstrNum)%tBareSolCoef(3,1:6))
af3 = POLYF(CosInc,Construct(ConstrNum)%afBareSolCoef(3,1:6))
ab3 = POLYF(CosInc,Construct(ConstrNum)%abBareSolCoef(3,1:6))
rf3 = POLYF(CosInc,Construct(ConstrNum)%rfBareSolCoef(3,1:6))
rb3 = POLYF(CosInc,Construct(ConstrNum)%rbBareSolCoef(3,1:6))
td3 = Construct(ConstrNum)%tBareSolDiff(3)
afd3 = Construct(ConstrNum)%afBareSolDiff(3)
abd3 = Construct(ConstrNum)%abBareSolDiff(3)
rfd3 = Construct(ConstrNum)%rfBareSolDiff(3)
rbd3 = Construct(ConstrNum)%rbBareSolDiff(3)
END IF
IF(NGlass==2) THEN
IF(Lay==1) THEN
ABWinSh(1) = CosInc * FracSunLit * (af1 + t1*tfshBB*rf2*tbshBB*ab1 + &
t1*(rfshB + rfshB*rbd1*rfshd + tfshBB*rf2*tbshBd + tfshBd*rfd2*tbshd)*abd1)
ADiffWinSh(1) = afd1 + td1*(rfshd + rfshd*rbd1*rfshd + tfshd*rfd2*tbshd)*abd1
ELSE IF (Lay==2) THEN
ABWinSh(2) = CosInc * FracSunLit * (t1*rfshB*af2 + &
t1*(rfshB*rf2*rbshd + tfshBd*(1+rfd2*rbshd) + rfshB*rbd1*tfshd)*afd2)
ADiffWinSh(2) = td1*(tfshd*(1+rfd2*rbshd) + rfshd*rbd1*tfshd)*afd2
END IF
END IF ! End of check if NGlass = 2
IF(NGlass==3) THEN
IF(Lay==1) THEN
ABWinSh(1) = CosInc * FracSunLit * (af1 + t1*rf2*ab1 + t1t2*tfshBB*rf3*tbshBB*t2*ab1 + &
t1t2*(rfshB*td2 + rfshB*rbd2*rfshd*td2 + tfshBd*rfd3*tbshd*td2)*abd1)
ADiffWinSh(1) = afd1 + td1*rbd2*abd1 + &
td1td2*(rfshd*(1 + rbd2*rfshd + td2*rbd1*td2*rfshd) + &
tfshd*(rfd3*tbshd + rfd3*rbshd*rfd3*tbshd))*td2*abd1
ELSE IF(Lay==2) THEN
ABWinSh(2) = CosInc * FracSunLit * (t1*af2 + t1t2*(tfshBB*rf3*tbshBB*ab2 + rfshB*td2*rbd1*afd2) + &
t1t2*(rfshB*(1+rbd2*rfshd) + tfshBB*rf3*tbshBd + tfshBd*rfd3*tbshd)*abd2)
ADiffWinSh(2) = td1*afd2 + td1td2*rfshd*td2*rbd1*afd2 + &
td1td2*(rfshd*(1+rbd2*rfshd) + tfshd*rfd3*tbshd)*abd2
ELSE IF(Lay==3) THEN
ABWinSh(3) = CosInc * FracSunLit * (t1t2*tfshBB*af3 + &
t1t2*(tfshBB*rf3*rbshB + tfshBd*(1+rfd3*rbshd) + rfshB*(rbd2*tfshd + td2*rbd1*td2*tfshd))*afd3)
ADiffWinSh(3) = td1td2*(tfshd*(1+rfd3*rbshd) + rfshd*(rbd2*tfshd + td2*rbd1*td2*tfshd))*afd3
END IF
END IF ! End of check if NGlass = 3
END IF ! End of check if blind is interior, exterior or between-glass
END IF ! End of check if a blind is on
IF(ShadeFlag /= SwitchableGlazing) THEN
! Interior or between glass shade or blind on
AWinSurf(SurfNum,Lay) = ABWinSh(Lay)
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==IntBlindOn.OR.ShadeFlag==BGShadeOn.OR.ShadeFlag==BGBlindOn) &
! Add contribution of diffuse from beam on outside reveal
AWinSurf(SurfNum,Lay) = AWinSurf(SurfNum,Lay) + &
ADiffWinSh(Lay) * SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing
ELSE
! Switchable glazing
SwitchFac = SurfaceWindow(SurfNum)%SwitchingFactor
AWinSurf(SurfNum,Lay) = InterpSw(SwitchFac,ABWin(Lay),ABWinSh(Lay))
! Add contribution of diffuse from beam on outside and inside reveal
AWinSurf(SurfNum,Lay) = AWinSurf(SurfNum,Lay) + &
InterpSW(SwitchFac,ADiffWin(Lay),ADiffWinSh(Lay)) &
* SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing + &
InterpSW(SwitchFac,Construct(ConstrNum)%AbsDiffBack(Lay),Construct(ConstrNumSh)%AbsDiffBack(Lay)) &
* SurfaceWindow(SurfNum)%InsRevealDiffOntoGlazing
END IF
END IF ! End of check if window has shading device
END DO ! End of loop over window glass layers
!-----------------------------------------
! EXTERIOR BEAM ABSORBED BY SHADING DEVICE
!-----------------------------------------
! Exterior beam absorbed by INTERIOR SHADE
IF(ShadeFlag == IntShadeOn) THEN
! Note that AbsBeamShadeCoef includes effect of shade/glazing inter-reflection
AbsShade = POLYF(CosInc,Construct(ConstrNumSh)%AbsBeamShadeCoef(1:6))
ExtBeamAbsByShadFac(SurfNum) = ( AbsShade * CosInc * SunLitFract * InOutProjSLFracMult &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * Construct(ConstrNumSh)%AbsDiffShade ) * &
SurfaceWindow(SurfNum)%GlazedFrac
! In the above, GlazedFrac corrects for shadowing of divider onto interior shade
END IF
! Exterior beam absorbed by EXTERIOR SHADE
IF(ShadeFlag == ExtShadeOn) THEN
ExtBeamAbsByShadFac(SurfNum) = &
Construct(ConstrNumSh)%AbsDiffShade * CosInc * SunLitFract
END IF
! Exterior beam absorbed by BETWEEN-GLASS SHADE
IF(ShadeFlag == BGShadeOn) THEN
AbsShade = POLYF(CosInc,Construct(ConstrNumSh)%AbsBeamShadeCoef(1:6))
ExtBeamAbsByShadFac(SurfNum) = AbsShade * CosInc * SunLitFract + &
SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * Construct(ConstrNumSh)%AbsDiffShade
END IF
! Exterior beam absorbed by INTERIOR BLIND
IF(ShadeFlag == IntBlindOn) THEN
TBmBm = POLYF(CosInc,Construct(ConstrNum)%TransSolBeamCoef(1:6))
RGlDiffBack = Construct(ConstrNum)%ReflectSolDiffBack
RhoBlFront = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffRefl)
AbsBlFront = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamAbs)
RhoBlDiffFront = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffRefl)
AbsBlDiffFront = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffAbs)
AbsShade = TBmBm * (AbsBlFront + &
RhoBlFront*RGlDiffBAck*AbsBlDiffFront/(1.d0-RhoBlDiffFront*RGlDiffBack))
AbsShadeDiff = Construct(ConstrNum)%TransDiff * (AbsBlDiffFront + RhoBlDiffFront * &
RGlDiffBAck*AbsBlDiffFront/(1.d0-RhoBlDiffFront*RGlDiffBack))
ExtBeamAbsByShadFac(SurfNum) = ( AbsShade * CosInc * SunLitFract * InOutProjSLFracMult &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * AbsShadeDiff ) * SurfaceWindow(SurfNum)%GlazedFrac
! In the above, GlazedFrac corrects for shadowing of divider onto interior blind
END IF
! Exterior beam absorbed by EXTERIOR BLIND
IF(ShadeFlag == ExtBlindOn) THEN
TBlBmBm = BlindBeamBeamTrans(ProfAng,SlatAng,Blind(BlNum)%SlatWidth,Blind(BlNum)%SlatSeparation, &
Blind(BlNum)%SlatThickness)
RGlFront = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
AbsBlFront = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamAbs)
AbsBlBack = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamAbs)
AbsBlDiffBack = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffAbs)
RGlDiffFront = Construct(ConstrNum)%ReflectSolDiffFront
RhoBlDiffBack = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolBackDiffDiffRefl)
RhoBlBack = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamDiffRefl)
TBlBmDiff = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffTrans)
AbsShade = AbsBlFront + AbsBlBack * RGlFront * TBlBmBm &
+ (AbsBlDiffBack*RGlDiffFront/(1.d0-RhoBlDiffBack*RGlDiffFront)) * &
(RGlFront*TBlBmBm*RhoBlBack + TBlBmDiff)
ExtBeamAbsByShadFac(SurfNum) = AbsShade * CosInc * SunLitFract * InOutProjSLFracMult
END IF
! Exterior beam absorbed by EXTERIOR SCREEN
IF(ShadeFlag == ExtScreenOn) THEN
TScBmBm = SurfaceScreens(SurfaceWindow(SurfNum)%ScreenNumber)%BmBmTrans
! TScBmDiff = SurfaceScreens(SurfaceWindow(SurfNum)%ScreenNumber)%BmDifTrans
RGlFront = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
RGlDiffFront = Construct(ConstrNum)%ReflectSolDiffFront
AbsScBeam = SurfaceScreens(ScNum)%AbsorpSolarBeamFront
AbsScDiffBack = SurfaceScreens(ScNum)%DifScreenAbsorp
RScDifBack = SurfaceScreens(ScNum)%DifReflect
RScBack = SurfaceScreens(ScNum)%ReflectSolBeamFront
AbsScreen = AbsScBeam * (1.0d0 + TScBmBm * RGlFront) + &
(AbsScDiffBack*TScBmBm*RGlFront*RGlDiffFront*RScBack/(1.d0-RScDifBack*RGlDiffFront))
ExtBeamAbsByShadFac(SurfNum) = AbsScreen * CosInc * SunLitFract * InOutProjSLFracMult
END IF
! Exterior beam absorbed by BETWEEN-GLASS BLIND
IF(ShadeFlag == BGBlindOn) THEN
IF(NGlass == 2) THEN
AbsShade = t1*(afshB + tfshBB*rf2*abshB + tfshBd*rfd2*abshd + rfshB*rbd1*afshd)
AbsShadeDiff = td1*(afshd*(1 + rfshd*rbd1) + tfshd*rfd2*abshd)
ELSE IF(NGlass == 3) THEN
AbsShade = t1t2*(afshB*(1 + tfshBB*rf3) + afshd*(tfshBd*rfd3 + rfshB*(rbd2 + td2*rbd1*td2)))
AbsShadeDiff = td1td2*(afshd + tfshd*rfd3*abshd + rfshd*(rfd2 + td2*rbd2*td2)*afshd)
END IF
ExtBeamAbsByShadFac(SurfNum) = AbsShade * CosInc * SunLitFract * InOutProjSLFracMult &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * AbsShadeDiff
END IF ! End of check if between-glass blind
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
FenSolAbsPtr = WindowScheduledSolarAbs(SurfNum, ConstrNum)
! Do not read from schedule file here since this will be called only if direct beam is hitting the window and schedule
! will not be loaded in that case even if diffuse part of solar radiation is entering through the window
IF (FenSolAbsPtr == 0) THEN
! Put in the equivalent layer absorptions
DO Lay = 1,SurfaceWindow(SurfNum)%ComplexFen%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState) &
%NLayers
ABWin(Lay) = SurfaceWindow(SurfNum)%ComplexFen &
%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState)%WinBmFtAbs(Lay,HourOfDay,TimeStep) &
* CosInc * SunLitFract * SurfaceWindow(SurfNum)%OutProjSLFracMult(HourOfDay)
! Add contribution of beam reflected from outside and inside reveal
AWinSurf(SurfNum,Lay) = ABWin(Lay) &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * &
SurfaceWindow(SurfNum)%ComplexFen &
%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState)%WinFtHemAbs(Lay)&
+ SurfaceWindow(SurfNum)%InsRevealDiffOntoGlazing * &
SurfaceWindow(SurfNum)%ComplexFen &
%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState)%WinBkHemAbs(Lay)
END DO
END IF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
! call the ASHWAT fenestration model for optical properties
! determine the beam radiation absorptance and tranmittance of the
! the equivalent layer window model
CALL CalcEQLOpticalProperty(SurfNum, isBEAM, AbsSolBeamEQL)
! recalcuate the diffuse absorptance and transmittance of the
! the equivalent layer window model if there is shade control
EQLNum = Construct(Surface(SurfNum)%Construction)%EQLConsPtr
IF (CFS(EQLNum)%ISControlled) THEN
CALL CalcEQLOpticalProperty(SurfNum, isDIFF, AbsSolDiffEQL)
ELSE
AbsSolDiffEQL(1:CFS(EQLNum)%NL+1,:) = CFSDiffAbsTrans(EQLNum,1:CFS(EQLNum)%NL+1,:)
ENDIF
Construct(ConstrNum)%TransDiff = AbsSolDiffEQL(CFS(EQLNum)%NL+1,1)
DO Lay = 1, CFS(EQLNum)%NL+1
AbWinEQL(Lay) = AbsSolBeamEQL(Lay,1) * CosInc * SunLitFract * InOutProjSLFracMult
IF ( CFS(EQLNum)%L(1)%LTYPE /= ltyGLAZE) THEN
! if the first layer is not glazing (or it is a shade) do not
AWinSurf(SurfNum,Lay) = AbWinEQL(Lay)
ELSE
! the first layer is a glazing, include the outside reveal reflection
! and the inside reveal reflection until indoor shade layer is encountered.
IF (CFS(EQLNum)%L(Lay)%LTYPE == ltyGLAZE) THEN
AWinSurf(SurfNum,Lay) = AbWinEQL(Lay) &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * AbsSolBeamEQL(Lay,1) &
+ SurfaceWindow(SurfNum)%InsRevealDiffOntoGlazing * AbsSolDiffEQL(Lay,2)
ELSE
AWinSurf(SurfNum,Lay) = AbWinEQL(Lay) &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * AbsSolBeamEQL(Lay,1)
ENDIF
ENDIF
END DO
TBmBmEQL = AbsSolBeamEQL(CFS(EQLNum)%NL+1,1)
! Beam-diffuse transmittance
TBmDiffEQL = MAX(0.0d0, AbsSolBeamEQL(CFS(EQLNum)%NL+1,2))
! Beam-beam transmittance: difference between beam-total and beam-diffuse transmittance
TBmBmEQL = MAX(0.0d0, (TBmBmEQL-TBmDiffEQL))
ENDIF
END IF ! End of SunLitFrac check
!-----------------------------------------------------------------
! SKY AND GROUND DIFFUSE SOLAR GAIN INTO ZONE FROM EXTERIOR WINDOW
!-----------------------------------------------------------------
SkySolarInc = SurfaceWindow(SurfNum)%SkySolarInc
GndSolarInc = SurfaceWindow(SurfNum)%GndSolarInc
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel .AND. & ! Regular window
SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
DiffTrans = Construct(ConstrNum)%TransDiff
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWin = (SkySolarInc * DiffTrans * Surface(SurfNum)%Area) / (DifSolarRad)
ELSE
DSZoneWin = (SkySolarInc * DiffTrans * Surface(SurfNum)%Area) / (1.d-8)
ENDIF
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWin = (GndSolarInc * DiffTrans * Surface(SurfNum)%Area) / (GndSolarRad)
ELSE
DGZoneWin = (GndSolarInc * DiffTrans * Surface(SurfNum)%Area) / (1.d-8)
ENDIF
ELSEIF (SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
DiffTrans = TransTDD(PipeNum, CosInc, SolarAniso)
DSZoneWin = AnisoSkyMult(SurfNum2) * DiffTrans * Surface(SurfNum)%Area
DGZoneWin = Surface(SurfNum2)%ViewFactorGround * TDDPipe(PipeNum)%TransSolIso * Surface(SurfNum)%Area
ELSE IF (Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) THEN
DiffTrans = Construct(ConstrNum)%TransDiff
DSZoneWin = 0.0d0 ! Solar not added by TDD:DOME; added to zone via TDD:DIFFUSER
DGZoneWin = 0.0d0 ! Solar not added by TDD:DOME; added to zone via TDD:DIFFUSER
ELSE IF (OutShelfSurf > 0) THEN ! Outside daylighting shelf
DiffTrans = Construct(ConstrNum)%TransDiff
DSZoneWin = AnisoSkyMult(SurfNum) * DiffTrans * Surface(SurfNum)%Area
ShelfSolarRad = (BeamSolarRad * SunlitFrac(OutShelfSurf,HourOfDay,TimeStep) &
* CosIncAng(OutShelfSurf,HourOfDay,TimeStep) + DifSolarRad * AnisoSkyMult(OutShelfSurf)) &
* Shelf(ShelfNum)%OutReflectSol
! Add all reflected solar from the outside shelf to the ground solar
! NOTE: If the shelf blocks part of the view to the ground, the user must reduce the ground view factor!!
! In order to get the effect of the daylighting shelf in here, must take into account the fact that this
! is ultimately multiplied by GndSolarRad to get QD and QDV in InitSolarHeatGains.
!
! DGZoneWin = (GndVF*Trans*Area*GndSolarRad + ShelfVF*Trans*Area*ShelfSolarRad) / GndSolarRad
!
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWin = (Surface(SurfNum)%ViewFactorGround * DiffTrans * Surface(SurfNum)%Area * GndSolarRad &
+ Shelf(ShelfNum)%ViewFactor * DiffTrans * Surface(SurfNum)%Area * ShelfSolarRad) / GndSolarRad
ELSE
DGZoneWin = 0.0d0
ENDIF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN ! complex fenestration
FenSolAbsPtr = WindowScheduledSolarAbs(SurfNum, ConstrNum)
IF (FenSolAbsPtr == 0) THEN
!Sky Diffuse transmitted by Complex Fen
DiffTransSky = SurfaceWindow(SurfNum)%ComplexFen%State( SurfaceWindow(SurfNum)%ComplexFen%CurrentState )%WinSkyTrans
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWin = SkySolarInc * DiffTransSky * Surface(SurfNum)%Area / (DifSolarRad)
ELSE
DSZoneWin = SkySolarInc * DiffTransSky * Surface(SurfNum)%Area / (1.d-8)
END IF
!Ground Diffuse transmitted by Complex Fen
DiffTransGnd = SurfaceWindow(SurfNum)%ComplexFen%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState)%WinSkyGndTrans
DiffTransBmGnd = SurfaceWindow(SurfNum)%ComplexFen%State( SurfaceWindow(SurfNum)%ComplexFen%CurrentState ) &
%WinBmGndTrans(HourOfDay,TimeStep)
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWin = ((SurfaceWindow(SurfNum)%BmGndSolarInc * DiffTransBmGnd &
+SurfaceWindow(SurfNum)%SkyGndSolarInc * DiffTransGnd ) * Surface(SurfNum)%Area) / (GndSolarRad)
ELSE
DGZoneWin = ((SurfaceWindow(SurfNum)%BmGndSolarInc * DiffTransBmGnd &
+SurfaceWindow(SurfNum)%SkyGndSolarInc * DiffTransGnd ) * Surface(SurfNum)%Area) / (1.d-8)
END IF
!Define the effective transmittance for total sky and ground radiation
IF ((SkySolarInc + SurfaceWindow(SurfNum)%BmGndSolarInc + SurfaceWindow(SurfNum)%SkyGndSolarInc ) /= 0.0d0) THEN
DiffTrans = ( SkySolarInc*DiffTransSky +SurfaceWindow(SurfNum)%BmGndSolarInc * DiffTransBmGnd &
+ SurfaceWindow(SurfNum)%SkyGndSolarInc * DiffTransGnd )/ &
(SkySolarInc + SurfaceWindow(SurfNum)%BmGndSolarInc + SurfaceWindow(SurfNum)%SkyGndSolarInc )
ELSE
DiffTrans = 0.0d0
END IF
!Also update the nominal diffuse transmittance
NomDiffTrans = SurfaceWindow(SurfNum)%ComplexFen%State(SurfaceWindow(SurfNum)%ComplexFen%CurrentState )%WinDiffTrans
Construct(Surface(SurfNum)%Construction)%TransDiff = NomDiffTrans
ELSE
DSZoneWin = 0.0d0
DGZoneWin = 0.0d0
DiffTrans = 0.0d0
TBmBm = 0.0d0
TBmDif = 0.0d0
NomDiffTrans = 0.0d0
END IF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
DiffTrans = Construct(ConstrNum)%TransDiff
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWin = (SkySolarInc * DiffTrans * Surface(SurfNum)%Area) / (DifSolarRad)
ELSE
DSZoneWin = (SkySolarInc * DiffTrans * Surface(SurfNum)%Area) / (1.d-8)
ENDIF
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWin = (GndSolarInc * DiffTrans * Surface(SurfNum)%Area) / (GndSolarRad)
ELSE
DGZoneWin = (GndSolarInc * DiffTrans * Surface(SurfNum)%Area) / (1.d-8)
ENDIF
END IF
IF ((SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel).AND.&
(SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel)) THEN
IF(ShadeFlag <= 0 .OR. ShadeFlag >= 10) THEN
! Unshaded window
DSZone(ZoneNum) = DSZone(ZoneNum) + DSZoneWin
DGZone(ZoneNum) = DGZone(ZoneNum) + DGZoneWin
ELSE IF(ShadeFlag /= SwitchableGlazing) THEN
! Shade or blind
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==ExtShadeOn.OR.ShadeFlag==BGShadeOn.OR.ShadeFlag==ExtScreenOn) THEN
! Shade or screen
DiffTrans = Construct(ConstrNumSh)%TransDiff
ELSE
! Blind
DiffTrans = InterpSlatAng(SlatAng,VarSlats,Construct(ConstrNumSh)%BlTransDiff)
! For blinds with horizontal slats, allow different diffuse/diffuse transmittance for
! ground and sky solar
IF(Blind(SurfaceWindow(SurfNum)%BlindNumber)%SlatOrientation == Horizontal) THEN
DiffTransGnd = InterpSlatAng(SlatAng,VarSlats,Construct(ConstrNumSh)%BlTransDiffGnd)
DiffTransSky = InterpSlatAng(SlatAng,VarSlats,Construct(ConstrNumSh)%BlTransDiffSky)
END IF
END IF
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWinSh = SkySolarInc * DiffTrans * Surface(SurfNum)%Area / (DifSolarRad)
ELSE
DSZoneWinSh = SkySolarInc * DiffTrans * Surface(SurfNum)%Area / (1.d-8)
END IF
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWinSh = GndSolarInc * DiffTrans * Surface(SurfNum)%Area / (GndSolarRad)
ELSE
DGZoneWinSh = GndSolarInc * DiffTrans * Surface(SurfNum)%Area / (1.d-8)
END IF
IF(ShadeFlag==IntBlindOn.OR.ShadeFlag==ExtBlindOn.OR.ShadeFlag==BGBlindOn) THEN
IF(Blind(SurfaceWindow(SurfNum)%BlindNumber)%SlatOrientation == Horizontal) THEN
CosTlt = Surface(SurfNum)%CosTilt
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWinSh = SkySolarInc * Surface(SurfNum)%Area * &
(0.5d0*ABS(CosTlt)*DiffTransGnd + (1.d0-0.5d0*ABS(CosTlt))*DiffTransSky) / (DifSolarRad)
ELSE
DSZoneWinSh = SkySolarInc * Surface(SurfNum)%Area * &
(0.5d0*ABS(CosTlt)*DiffTransGnd + (1.d0-0.5d0*ABS(CosTlt))*DiffTransSky) / (1.d-8)
END IF
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWinSh = GndSolarInc * Surface(SurfNum)%Area * &
((1.d0-0.5d0*ABS(CosTlt))*DiffTransGnd + 0.5d0*ABS(CosTlt)*DiffTransSky) / (GndSolarRad)
ELSE
DGZoneWinSh = GndSolarInc * Surface(SurfNum)%Area * &
((1.d0-0.5d0*ABS(CosTlt))*DiffTransGnd + 0.5d0*ABS(CosTlt)*DiffTransSky) / (1.d-8)
END IF
END IF
END IF
DSZone(ZoneNum) = DSZone(ZoneNum) + DSZoneWinSh
DGZone(ZoneNum) = DGZone(ZoneNum) + DGZoneWinSh
ELSE
! Switchable glazing
SwitchFac = SurfaceWindow(SurfNum)%SwitchingFactor
DiffTrans = InterpSW(SwitchFac,Construct(ConstrNum)%TransDiff,Construct(ConstrNumSh)%TransDiff)
IF (DifSolarRad /= 0.0d0) THEN
DSZoneWinSh = SkySolarInc * DiffTrans * Surface(SurfNum)%Area / (DifSolarRad)
ELSE
DSZoneWinSh = SkySolarInc * DiffTrans * Surface(SurfNum)%Area / (1.d-8)
END IF
IF (GndSolarRad /= 0.0d0) THEN
DGZoneWinSh = GndSolarInc * DiffTrans * Surface(SurfNum)%Area / (GndSolarRad)
ELSE
DGZoneWinSh = GndSolarInc * DiffTrans * Surface(SurfNum)%Area / (1.d-8)
END IF
DSZone(ZoneNum) = DSZone(ZoneNum) + InterpSw(SwitchFac,DSZoneWin,DSZoneWinSh)
DGZone(ZoneNum) = DGZone(ZoneNum) + InterpSw(SwitchFac,DGZoneWin,DGZoneWinSh)
END IF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
DSZone(ZoneNum) = DSZone(ZoneNum) + DSZoneWin
DGZone(ZoneNum) = DGZone(ZoneNum) + DGZoneWin
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
! For equivalent layer model the zone total diffuse solar heat gain
! through exterior fenestrations are reported as single value.
DSZoneWin = SkySolarInc * DiffTrans * Surface(SurfNum)%Area / (DifSolarRad + 1.d-8)
DGZoneWin = GndSolarInc * DiffTrans * Surface(SurfNum)%Area / (GndSolarRad + 1.d-8)
DSZone(ZoneNum) = DSZone(ZoneNum) + DSZoneWin
DGZone(ZoneNum) = DGZone(ZoneNum) + DGZoneWin
ENDIF
!-----------------------------------------------------------------
! BEAM SOLAR ON EXTERIOR WINDOW TRANSMITTED AS BEAM AND/OR DIFFUSE
!-----------------------------------------------------------------
TBmBm = 0.0d0
TBmDif = 0.0d0
TBmAllShBlSc = 0.0d0
TBmBmShBlSc = 0.0d0
TBmDifShBlSc = 0.0d0
! Beam-beam transmittance for bare exterior window
IF (SunlitFract > 0.0d0) THEN
IF (SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
TBmDif = TransTDD(PipeNum, CosInc, SolarBeam)
TDDPipe(PipeNum)%TransSolBeam = TBmDif ! Report variable
ELSEIF(SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel .AND. &
SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN ! Regular window
IF(.not.SurfaceWindow(SurfNum)%SolarDiffusing) THEN ! Clear glazing
TBmBm = POLYF(CosInc,Construct(ConstrNum)%TransSolBeamCoef(1:6)) ![-]
ELSE ! Diffusing glazing
TBmDif = POLYF(CosInc,Construct(ConstrNum)%TransSolBeamCoef(1:6)) ![-]
END IF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
! Need to check what effect, if any, defining these here has
TBmBm = SurfaceWindow(SurfNum)%ComplexFen%State( SurfaceWindow(SurfNum)%ComplexFen%CurrentState ) &
%WinDirSpecTrans( HourOfDay,TimeStep )
TBmDif = SurfaceWindow(SurfNum)%ComplexFen%State( SurfaceWindow(SurfNum)%ComplexFen%CurrentState ) &
%WinDirHemiTrans( HourOfDay,TimeStep ) - TBmBm
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
! get ASHWAT fenestration model beam-beam and beam-diffuse properties
TBmBm = TBmBmEQL
TBmDif = TBmDiffEQL
END IF
END IF
! Report variables
SurfaceWindow(SurfNum)%GlTsolBmBm = TBmBm
SurfaceWindow(SurfNum)%GlTsolBmDif = TBmDif
! Diffuse-diffuse transmittance for bare exterior window
IF (SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
TDifBare = TransTDD(PipeNum, CosInc, SolarAniso)
ELSE
IF ( SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
!Complex Fenestration: use hemispherical ave of directional-hemispherical transmittance
!Note: this is not quite the same as the effective transmittance for total of sky and ground radiation
TDifBare = SurfaceWindow(SurfNum)%ComplexFen%State( SurfaceWindow(SurfNum)%ComplexFen%CurrentState )%WinDiffTrans
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
!get ASHWAT fenestration model diffuse-diffuse properties includes shade if present
TDifBare = Construct(ConstrNum)%TransDiff
ELSE ! Regular window
TDifBare = Construct(ConstrNum)%TransDiff
END IF
END IF
SurfaceWindow(SurfNum)%GlTsolDifDif = TDifBare
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
IF(ShadeFlag > 0 .AND. ShadeFlag < 10) THEN
! Shade or screen or blind on, or switchable glazing
! (note in the following that diffusing glass is not allowed in a window with
! shade, blind or switchable glazing)
IF(ShadeFlag /= IntBlindOn .AND. ShadeFlag /= ExtBlindOn .AND. ShadeFlag /= BGBlindOn .AND. ShadeFlag /= ExtScreenOn) THEN
! Shade on or switchable glazing
IF(SunlitFract > 0.0d0) TBmAllShBlSc = POLYF(CosInc,Construct(ConstrNumSh)%TransSolBeamCoef(1:6))
ELSE
! Blind or Screen on
SurfaceWindow(SurfNum)%BlGlSysTsolDifDif = DiffTrans
SurfaceWindow(SurfNum)%ScGlSysTsolDifDif = DiffTrans
IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == BGBlindOn)THEN
SurfaceWindow(SurfNum)%BlTsolDifDif = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffTrans)
ELSE IF(ShadeFlag == ExtScreenOn)THEN
SurfaceWindow(SurfNum)%ScTsolDifDif = SurfaceScreens(ScNum)%DifDifTrans
END IF
IF(SunlitFract > 0.0d0) THEN
IF(ShadeFlag == ExtScreenOn)THEN
! beam transmittance (written in subroutine CalcScreenTransmittance each time step)
TScBmBm = SurfaceScreens(ScNum)%BmBmTrans
SurfaceWindow(SurfNum)%ScTsolBmBm = TScBmBm
ELSE
TBlBmBm = BlindBeamBeamTrans(ProfAng,SlatAng,Blind(BlNum)%SlatWidth,Blind(BlNum)%SlatSeparation, &
Blind(BlNum)%SlatThickness)
SurfaceWindow(SurfNum)%BlTsolBmBm = TBlBmBm
END IF
IF(ShadeFlag==IntBlindOn .OR. ShadeFlag==ExtBlindOn) THEN
! Interior or exterior blind
TBmBmBl = TBmBm * TBlBmBm
ELSE IF(ShadeFlag==ExtScreenOn) THEN
! Exterior screen
TBmBmSc = TBmBm * TScBmBm
ELSE
! Between-glass blind
IF(NGlass==2) THEN
TBmBmBl = t1*tfshBB*t2
ELSE ! NGlass = 3
TBmBmBl = t1*t2*tfshBB*t3
END IF
END IF
IF(ShadeFlag == ExtScreenOn)THEN
! Report variable for Beam-to-Beam transmittance
SurfaceWindow(SurfNum)%ScGlSysTsolBmBm = TBmBmSc
ELSE
SurfaceWindow(SurfNum)%BlGlSysTsolBmBm = TBmBmBl
END IF
IF(ShadeFlag == ExtScreenOn)THEN
TScBmDif = SurfaceScreens(ScNum)%BmDifTrans
! Report variable for Beam-to-Diffuse transmittance (scattered transmittance)
SurfaceWindow(SurfNum)%ScTsolBmDif = TScBmDif
ELSE
TBlBmDif = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffTrans)
SurfaceWindow(SurfNum)%BlTsolBmDif = TBlBmDif
!CR6913 SurfaceWindow(SurfNum)%BlTsolDifDif = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffTrans)
END IF
!added TH 12/9/2009
TBmBmShBlSc = 0.0d0
TBmDifShBlSc = 0.0d0
IF(ShadeFlag == IntBlindOn) THEN
! Interior blind on: beam-beam and diffuse transmittance of exterior beam
TBlDifDif = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffTrans)
RhoBlBmDifFr = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolFrontBeamDiffRefl)
RGlDifBk = Construct(ConstrNum)%ReflectSolDiffBack
RhoBlDifDifFr = InterpSlatAng(SlatAng,VarSlats,Blind(BlNum)%SolFrontDiffDiffRefl)
TBmAllShBlSc = TBmBm*( TBlBmBm + TBlBmDif + &
TBlDifDif*RhoBlBmDifFr*RGlDifBk/(1-RhoBlDifDifFr*RGlDifBk) )
!added TH 12/9/2009
TBmBmShBlSc = TBmBmBl !TBmBm * TBlBmBm
TBmDifShBlSc = TBmAllShBlSc - TBmBmShBlSc
IF (TBmDifShBlSc < 0.0d0) TBmDifShBlSc = 0.0d0
ELSE IF(ShadeFlag == ExtBlindOn) THEN
! Exterior blind on: beam-beam and diffuse transmittance of exterior beam
RhoBlBmDifBk = InterpProfSlatAng(ProfAng,SlatAng,VarSlats,Blind(BlNum)%SolBackBeamDiffRefl)
RGlBmFr = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
TBmAllShBlSc = TBlBmBm * (TBmBm + TDifBare*RGlBmFr*RhoBlBmDifBk/(1-RGlDifFr*RhoBlDifDifBk)) + &
TBlBmDif*TDifBare/(1-RGlDifFr*RhoBlDifDifBk)
!added TH 12/9/2009
TBmBmShBlSc = TBmBmBl !TBmBm * TBlBmBm
TBmDifShBlSc = TBmAllShBlSc - TBmBmShBlSc
ELSE IF(ShadeFlag == ExtScreenOn) THEN
! Exterior screen on: beam-beam and diffuse transmittance of exterior beam
RScBack = SurfaceScreens(ScNum)%ReflectSolBeamFront
RScDifDifBk = SurfaceScreens(ScNum)%DifReflect
RGlBmFr = POLYF(CosInc,Construct(ConstrNum)%ReflSolBeamFrontCoef(1:6))
TBmAllShBlSc = TScBmBm * (TBmBm + RGlBmFr*RScBack*TDifBare/(1-RGlDifFr*RScDifDifBk)) + &
TScBmDif*TDifBare/(1-RGlDifFr*RScDifDifBk)
!added TH 12/9/2009
TBmBmShBlSc = TBmBmSc !
TBmDifShBlSc = TBmAllShBlSc - TBmBmShBlSc
ELSE
! Between-glass blind on: beam-beam and diffuse transmittance of exterior beam
IF(NGlass==2) THEN
TBmAllShBlSc = t1*tfshBB*t2 + t1*(tfshBB*rf2*rbshB + tfshBd*(1.0d0 + rfd2*rbshd) + rfshB*rbd1*rfshd)*td2
ELSE ! NGlass = 3
TBmAllShBlSc = t1t2*tfshBB*t3 + &
t1t2*(tfshBB*rf3*rbshB + tfshBd*(1.0d0 + rfd3*rbshd) + rbshB*(rbd2*tfshd + td2*rbd1*td2*tfshd))*td3
END IF
!added TH 12/9/2009
TBmBmShBlSc = TBmBmBl
TBmDifShBlSc = TBmAllShBlSc - TBmBmShBlSc
END IF
END IF
END IF
END IF ! End of check if ShadeFlag > 0 and ShadeFlag < 10
ENDIF
IF(ShadeFlag == SwitchableGlazing) THEN
! Switchable glazing
SwitchFac = SurfaceWindow(SurfNum)%SwitchingFactor
IF(.not.SurfaceWindow(SurfNum)%SolarDiffusing) THEN
TBmBm = InterpSw(SwitchFac,TBmBm,TBmAllShBlSc)
ELSE
TBmDif = InterpSw(SwitchFac,TBmDif,TBmAllShBlSc)
ENDIF
END IF
! The following WinTransBmSolar and WinTransDifSolar will be combined later to give
! WinTransSolar for reporting
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
WinTransDifSolar(SurfNum) = DiffTrans * Surface(SurfNum)%Area
IF(ShadeFlag==IntBlindOn.OR.ShadeFlag==ExtBlindOn.OR.ShadeFlag==BGBlindOn) THEN
IF(Blind(SurfaceWindow(SurfNum)%BlindNumber)%SlatOrientation==Horizontal) THEN
WinTransDifSolarGnd(SurfNum) = DiffTransGnd * Surface(SurfNum)%Area
WinTransDifSolarSky(SurfNum) = DiffTransSky * Surface(SurfNum)%Area
END IF
END IF
ELSE
! In equivalent layer window model system diffuse transmittance is based on unit
! diffuse radiation flux, and hence doesn't distinguish between sky and
! ground reflected diffuse radiations
WinTransDifSolar(SurfNum) = DiffTrans * Surface(SurfNum)%Area
WinTransDifSolarGnd(SurfNum) = DiffTrans * Surface(SurfNum)%Area
WinTransDifSolarSky(SurfNum) = DiffTrans * Surface(SurfNum)%Area
ENDIF
IF(ShadeFlag < 1 .OR. ShadeFlag == SwitchableGlazing .OR. ShadeFlag >= 10) THEN ! Unshaded or switchable glazing
!Note: with previous defs of TBmBm & TBmDif, these come out right for Complex Fenestration
! WinTransBmSolar uses the directional-hemispherical transmittance
WinTransBmSolar(SurfNum) = (TBmBm + TBmDif) * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult
!added TH 12/9/2009
WinTransBmBmSolar = TBmBm * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult ! m2
WinTransBmDifSolar = TBmDif * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult ! m2
ELSE
WinTransBmSolar(SurfNum) = TBmAllShBlSc * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult
!added TH 12/9/2009
WinTransBmBmSolar = TBmBmShBlSc * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult
WinTransBmDifSolar = TBmDifShBlSc * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult
END IF
! Add diffuse transmitted by window from beam reflected from outside reveal
IF( SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN !Complex Fenestration
FenSolAbsPtr = WindowScheduledSolarAbs(SurfNum, ConstrNum)
IF (FenSolAbsPtr == 0) THEN
WinTransBmSolar(SurfNum) = WinTransBmSolar(SurfNum) + &
SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * NomDiffTrans * Surface(SurfNum)%Area
WinTransBmDifSolar = WinTransBmDifSolar + SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * NomDiffTrans &
* Surface(SurfNum)%Area
ELSE
WinTransBmSolar(SurfNum) = 0.0d0
WinTransBmDifSolar = 0.0d0
END IF
ELSE !Regular window
! this is also valid for equivalent layer window
WinTransBmSolar(SurfNum) = WinTransBmSolar(SurfNum) + &
SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * DiffTrans * Surface(SurfNum)%Area
!added TH 12/9/2009
WinTransBmDifSolar = WinTransBmDifSolar + SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * DiffTrans &
* Surface(SurfNum)%Area
END IF
! Increment factor for total exterior beam solar entering zone through window as beam or diffuse
IF(SunLitFract > 0.0d0 .AND. Surface(SurfNum)%Class /= SurfaceClass_TDD_Dome) THEN
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==ExtShadeOn.OR.ShadeFlag==IntBlindOn.OR.ShadeFlag==ExtBlindOn.OR.&
ShadeFlag==BGShadeOn.OR.ShadeFlag==BGBlindOn.OR.ShadeFlag==ExtScreenOn) THEN
TBmAll = TBmAllShBlSc
ELSE
TBmAll = TBmBm + TBmDif
END IF
FenSolAbsPtr = WindowScheduledSolarAbs(SurfNum, ConstrNum)
! Window is schedule surface gained. Do not make addition to what enters into zone since that information is not
! available
IF (FenSolAbsPtr == 0) THEN
BTOTZone = BTOTZone + TBmAll * SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult ! [m2]
END IF
END IF
! Correct for effect of (1) beam absorbed by inside reveal, (2) diffuse entering zone from beam
! reflected by inside reveal and (3) diffuse transmitted by window from beam reflected from
! outside reveal.
IF(CosInc > 0.0d0) THEN
! old code
! BTOTZone = BTOTZone + (SurfaceWindow(SurfNum)%InsRevealDiffIntoZone &
! - SurfaceWindow(SurfNum)%BmSolAbsdInsReveal &
! + SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * DiffTrans) * Surface(SurfNum)%Area
! CR 7596. TH 5/27/2009
! The BTOTZone is the solar into zone assuming no inside or outside reveals
! The inside reveals receive solar (reflected part + absorbed part) from the window, this amount should be
! deducted from the BTOTZone, then adds the InsRevealDiffIntoZone
IF( SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN !Complex Fenestration
SurfSolIncPtr = SurfaceScheduledSolarInc(BackSurfaceNumber, ConstrNumBack)
! Do not add total into zone from scheduled surface gains. That will be added later
IF (SurfSolIncPtr == 0) THEN
BTOTZone = BTOTZone - SurfaceWindow(SurfNum)%BmSolRefldInsReveal &
- SurfaceWindow(SurfNum)%BmSolAbsdInsReveal &
+ SurfaceWindow(SurfNum)%InsRevealDiffIntoZone &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * NomDiffTrans * Surface(SurfNum)%Area
END IF
ELSE !Regular window
BTOTZone = BTOTZone - SurfaceWindow(SurfNum)%BmSolRefldInsReveal &
- SurfaceWindow(SurfNum)%BmSolAbsdInsReveal &
+ SurfaceWindow(SurfNum)%InsRevealDiffIntoZone &
+ SurfaceWindow(SurfNum)%OutsRevealDiffOntoGlazing * DiffTrans * Surface(SurfNum)%Area
END IF
! Add beam solar absorbed by outside reveal to outside of window's base surface.
! Add beam solar absorbed by inside reveal to inside of window's base surface.
! This ignores 2-D heat transfer effects.
BaseSurfNum = Surface(SurfNum)%BaseSurf
AISurf(BaseSurfNum) = AISurf(BaseSurfNum) + SurfaceWindow(SurfNum)%BmSolAbsdInsReveal/Surface(BaseSurfNum)%Area
AOSurf(BaseSurfNum) = AOSurf(BaseSurfNum) + SurfaceWindow(SurfNum)%BmSolAbsdOutsReveal/Surface(BaseSurfNum)%Area
END IF
IF(SunLitFract > 0.0d0) THEN
!---------------------------------------------------------------------------------
! INTERIOR BEAM FROM EXTERIOR WINDOW THAT IS ABSORBED/TRANSMITTED BY BACK SURFACES
!---------------------------------------------------------------------------------
! If shade is in place or there is a diffusing glass layer there is no interior beam
! from this exterior window since the beam-beam transmittance of shades and diffusing glass
! is assumed to be zero. The beam-beam transmittance of tubular daylighting devices is also
! assumed to be zero.
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn &
.OR. SurfaceWindow(SurfNum)%SolarDiffusing &
.OR. SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser &
.OR. Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) CYCLE
! Find interior beam radiation that is:
! (1) absorbed by opaque back surfaces;
! (2) absorbed by glass layers of back surfaces that are interior or exterior windows;
! (3) absorbed by interior, exterior or between-glass shades or blinds of back surfaces
! that are exterior windows; and
! (4) transmitted through back surfaces that are interior or exterior windows.
! Beam-beam transmittance of exterior window
IF(ShadeFlag==IntBlindOn .OR. ShadeFlag==ExtBlindOn .OR. ShadeFlag==BGBlindOn) THEN
TBm = TBmBmBl ! Interior, exterior or between-glass blind on
ELSE IF(ShadeFlag==ExtScreenOn) THEN
TBm = TBmBmSc ! Exterior screen on
ELSE
TBm = TBmBm ! Bare glass or switchable glazing
! Correction for beam absorbed by inside reveal
TBmDenom=(SunLitFract * CosInc * Surface(SurfNum)%Area * InOutProjSLFracMult)
IF (TBmDenom /= 0.0d0) THEN ! when =0.0, no correction
TBm = TBm - SurfaceWindow(SurfNum)%BmSolAbsdInsReveal / TBmDenom
ENDIF
TBm = MAX(0.0d0,TBm)
END IF
IF(TBm == 0.0d0) CYCLE
IF(InShelfSurf > 0) THEN ! Inside daylighting shelf
! Inside daylighting shelves assume that no beam will pass the end of the shelf.
! Since all beam is absorbed on the shelf, this might cause them to get unrealistically hot at times.
BTOTWinZone = TBm * SunLitFract * Surface(SurfNum)%Area * CosInc * InOutProjSLFracMult ![m2]
! Shelf surface area is divided by 2 because only one side sees beam (Area was multiplied by 2 during init)
AISurf(InShelfSurf) = AISurf(InShelfSurf) + BTOTWinZone / (0.5d0 * Surface(InShelfSurf)%Area) ![-]
BABSZone = BABSZone + BTOTWinZone ![m2]
CYCLE
END IF
IF(SolarDistribution == FullInteriorExterior) THEN ! Full interior solar distribution
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel .AND. &
SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
! Loop over back surfaces irradiated by beam from this exterior window
DO IBack = 1,MaxBkSurf
BackSurfNum = BackSurfaces(SurfNum,IBack,HourOfDay,TimeStep)
IF(BackSurfNum == 0) EXIT ! No more irradiated back surfaces for this exterior window
ConstrNumBack = Surface(BackSurfNum)%Construction
NBackGlass = Construct(ConstrNumBack)%TotGlassLayers
! Irradiated (overlap) area for this back surface, projected onto window plane
! (includes effect of shadowing on exterior window)
Aoverlap = OverlapAreas(SurfNum,IBack,HourOfDay,TimeStep)
Boverlap = TBm * Aoverlap * CosInc ![m2]
IF(Construct(ConstrNumBack)%TransDiff <= 0.0d0) THEN
! Back surface is opaque interior or exterior wall
AbsIntSurf = Construct(ConstrNumBack)%InsideAbsorpSolar
! Check for movable insulation; reproduce code from subr. EvalInsideMovableInsulation;
! Can't call that routine here since cycle prevents SolarShadingGeometry from USEing
! HeatBalanceSurfaceManager, which contains EvalInsideMovableInsulation
HMovInsul = 0.0d0
IF (Surface(BackSurfNum)%MaterialMovInsulInt.GT.0) THEN
MovInsulSchedVal = GetCurrentScheduleValue(Surface(BackSurfNum)%SchedMovInsulExt)
IF (MovInsulSchedVal.LE.0.0d0) THEN ! Movable insulation not present at current time
HMovInsul = 0.0d0
ELSE ! Movable insulation present
HMovInsul = 1.0d0/(MovInsulSchedVal*Material(Surface(BackSurfNum)%MaterialMovInsulInt)%Resistance)
AbsInt = Material(Surface(BackSurfNum)%MaterialMovInsulInt)%AbsorpSolar
END IF
END IF
IF (HMovInsul > 0.0d0) AbsIntSurf = AbsInt ! Movable inside insulation present
AISurf(BackSurfNum) = AISurf(BackSurfNum) + & ![-]
Boverlap * AbsIntSurf / Surface(BackSurfNum)%Area
BABSZone = BABSZone + Boverlap * AbsIntSurf ![m2]
ELSE
! Back surface is an interior or exterior window
! Note that exterior back windows can have a shading device but interior back windows
! are assumed to be bare, i.e., they have no shading device and are non-switchable.
! The layer order for interior windows is "outside" to "inside," where "outside" refers to
! the adjacent zone and "inside" refers to the current zone.
ShadeFlagBack = SurfaceWindow(BackSurfNum)%ShadingFlag
SlatAngBack = SurfaceWindow(BackSurfNum)%SlatAngThisTS
VarSlatsBack = SurfaceWindow(BackSurfNum)%MovableSlats
CosIncBack = ABS(CosIncAng(BackSurfNum,HourOfDay,TimeStep))
!
IF(SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
!Transmitting window is complex fen, change the incident angle to one for ray joining
! transmitting and back window centers
CosIncBack = ABS( ComplexWind(SurfNum)%sdotN(IBack) )
ENDIF
!
ConstrNumBackSh = Surface(BackSurfNum)%ShadedConstruction
IF(SurfaceWindow(BackSurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(BackSurfNum)%StormWinConstruction
ConstrNumSh = Surface(BackSurfNum)%StormWinShadedConstruction
END IF
AbsBeamWin = 0.d0
TransBeamWin = 0.d0
! Interior beam absorptance of glass layers and beam transmittance of back exterior &
! or interior window WITHOUT SHADING this timestep
IF(ShadeFlagBack <= 0) THEN
DO Lay = 1,NBackGlass
AbsBeamWin(Lay) = POLYF(CosIncBack,Construct(ConstrNumBack)%AbsBeamBackCoef(Lay,1:6))
END DO
TransBeamWin = POLYF(CosIncBack,Construct(ConstrNumBack)%TransSolBeamCoef(1:6))
END IF
! Interior beam absorptance of glass layers and beam transmittance
! of back exterior window with SHADE
IF(ShadeFlagBack==IntShadeOn .OR. ShadeFlagBack==ExtShadeOn .OR. ShadeFlagBack==BGShadeOn) THEN
DO Lay = 1,Construct(ConstrNumBackSh)%TotGlassLayers
AbsBeamWin(Lay) = POLYF(CosIncBack,Construct(ConstrNumBackSh)%AbsBeamBackCoef(Lay,1:6))
END DO
TransBeamWin = POLYF(CosIncBack,Construct(ConstrNumBackSh)%TransSolBeamCoef(1:6))
END IF
! Interior beam absorbed by INTERIOR SHADE of back exterior window
IF(ShadeFlagBack == IntShadeOn) THEN
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * Construct(ConstrNumBackSh)%AbsDiffBackShade &
/ (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
BABSZone = BABSZone + Boverlap * Construct(ConstrNumBackSh)%AbsDiffBackShade
END IF
! Interior beam absorbed by EXTERIOR SHADE of back exterior window
IF(ShadeFlagBack == ExtShadeOn) THEN
RGlFront = Construct(ConstrNumBack)%ReflectSolDiffFront
AbsSh = Material(Construct(ConstrNumBackSh)%LayerPoint(1))%AbsorpSolar
RhoSh = 1.d0-AbsSh-Material(Construct(ConstrNumBackSh)%LayerPoint(1))%Trans
AShBack = POLYF(CosIncBack,Construct(ConstrNumBack)%TransSolBeamCoef(1:6)) * &
AbsSh / (1.d0-RGlFront*RhoSh)
BABSZone = BABSZone + Boverlap * AshBack
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * AShBack / &
(Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
END IF
! Interior beam absorbed by BETWEEN-GLASS SHADE of back exterior window
IF(ShadeFlagBack == BGShadeOn) THEN
rbd1k = Construct(ConstrNumBack)%rbBareSolDiff(1)
IF(NBackGlass==2) THEN
t2k = POLYF(CosIncBack,Construct(ConstrNumBack)%tBareSolCoef(2,1:6))
rfd2k = Construct(ConstrNumBack)%rfBareSolDiff(2)
TrSh = Material(Construct(ConstrNumBackSh)%LayerPoint(3))%Trans
RhoSh = Material(Construct(ConstrNumBackSh)%LayerPoint(3))%ReflectShade
AbsSh = MIN(1.0d0,MAX(0.0d0,1-TrSh-RhoSh))
AShBack = t2k*(1 + RhoSh*rfd2k + TrSh*rbd1k)*AbsSh
ELSE ! NBackGlass = 3
t3k = POLYF(CosIncBack,Construct(ConstrNumBack)%tBareSolCoef(3,1:6))
TrSh = Material(Construct(ConstrNumBackSh)%LayerPoint(5))%Trans
RhoSh = Material(Construct(ConstrNumBackSh)%LayerPoint(5))%ReflectShade
AbsSh = MIN(1.0d0,MAX(0.0d0,1-TrSh-RhoSh))
AShBack = t3k*(1 + RhoSh*rfd3k + TrSh*(rbd2k + td2k*rbd1k*td2k))*AbsSh
END IF
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * AShBack / Surface(BackSurfNum)%Area
BABSZone = BABSZone + Boverlap * AShBack
END IF
! Interior beam absorptance of glass layers and beam absorbed in blind
! of back exterior window with BLIND
IF(ShadeFlagBack==IntBlindOn .OR. ShadeFlagBack==ExtBlindOn .OR. ShadeFlagBack==BGBlindOn) THEN
BlNumBack = SurfaceWindow(BackSurfNum)%BlindNumber
CALL ProfileAngle(BackSurfNum,SOLCOS,Blind(BlNumBack)%SlatOrientation,ProfAngBack)
TGlBmBack = POLYF(CosIncBack,Construct(ConstrNumBack)%TransSolBeamCoef(1:6))
TBlBmBmBack = BlindBeamBeamTrans(ProfAngBack,PI-SlatAngBack,Blind(BlNumBack)%SlatWidth, &
Blind(BlNumBack)%SlatSeparation,Blind(BlNumBack)%SlatThickness)
TBlBmDiffBack = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamDiffTrans)
IF(ShadeFlagBack == IntBlindOn) THEN
! Interior beam absorptance of GLASS LAYERS of exterior back window with INTERIOR BLIND
RhoBlFront = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontBeamDiffRefl)
RhoBlDiffFront= InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontDiffDiffRefl)
RGlBack = POLYF(CosIncBack,Construct(ConstrNumBack)%ReflSolBeamBackCoef(1:6))
RGlDiffBack = Construct(ConstrNumBack)%ReflectSolDiffBack
DO Lay =1,NBackGlass
AbWinBack = POLYF(CosIncBack,Construct(ConstrNumBack)%AbsBeamBackCoef(Lay,1:6))
AGlDiffBack = Construct(ConstrNumBack)%AbsDiffBack(Lay)
AbsBeamWin(Lay) = TBlBmBmBack*AbWinBack + &
((TBlBmBmBack*RGlBack*RhoBlFront + TBlBmDiffBack) * AGlDiffBack/ &
(1.d0 - RGlDiffBack*RhoBlDiffFront))
END DO
! Interior beam transmitted by exterior back window with INTERIOR BLIND
TGlDif = Construct(ConstrNumBack)%TransDiff
TransBeamWin = TBlBmBmBack * (TGlBmBack + TGlDif*RGlBack*RhoBlFront/ &
(1.d0-RGlDiffBack*RhoBlDiffFront)) + TBlBmDiffBack*TGlDif/(1-RGlDiffBack*RhoBlDiffFront)
! Interior beam absorbed by BLIND on exterior back window with INTERIOR BLIND
AbsBlFront = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontBeamAbs)
AbsBlBack = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamAbs)
AbsBlDiffFront= InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontDiffAbs)
ABlBack = AbsBlBack + TBlBmBmBack * RGlBack * AbsBlFront &
+ (AbsBlDiffFront*RGlDiffBack/(1-RhoBlDiffFront*RGlDiffBack)) &
* (RGlBack*TBlBmBmBack*RhoBlFront + TBlBmDiffBack)
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * &
ABlBack / (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
BABSZone = BABSZone + Boverlap * ABlBack
ENDIF
IF(ShadeFlagBack == ExtBlindOn) THEN
! Interior beam absorptance of GLASS LAYERS of exterior back window with EXTERIOR BLIND
RGlDiffFront = Construct(ConstrNumBack)%ReflectSolDiffFront
RhoBlBack = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamDiffRefl)
DO Lay = 1,NBackGlass
AbWinBack = POLYF(CosIncBack,Construct(ConstrNumBack)%AbsBeamBackCoef(Lay,1:6))
AGlDiffFront= Construct(ConstrNumBack)%AbsDiff(Lay)
AbsBeamWin(Lay) = AbWinBack + &
(TGlBmBack*AGlDiffFront*RhoBlBack / (1.d0 - RhoBlBack*RGlDiffFront))
END DO
! Interior beam transmitted by exterior back window with EXTERIOR BLIND
TBlDifDif = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffDiffTrans)
RhoBlBmDifBk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamDiffRefl)
RGlDifFr = Construct(ConstrNum)%ReflectSolDiffFront
RhoBlDifDifBk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffDiffRefl)
TransBeamWin = TGlBmBack * ( TBlBmBmBack + TBlBmDiffBack + &
TBlDifDif*RhoBlBmDifBk*RGlDifFr/(1.d0-RhoBlDifDifBk*RGlDifFr) )
! Interior beam absorbed by EXTERIOR BLIND on exterior back window
AbsBlBack = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamAbs)
AbsBlDiffBack = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffAbs)
RhoBlDiffBack = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffDiffRefl)
ABlBack = TGlBmBack*(AbsBlBack + RhoBlBack*RGlDiffFront*AbsBlDiffBack/(1-RhoBlDiffBack*RGlDiffFront))
BABSZone = BABSZone + Boverlap * ABlBack
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * &
ABlBack / (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
END IF ! End of check if exterior blind on back window
IF(ShadeFlagBack == BGBlindOn) THEN
t1k = POLYF(CosIncBack,Construct(ConstrNumBack)%tBareSolCoef(1,1:6))
t2k = POLYF(CosIncBack,Construct(ConstrNumBack)%tBareSolCoef(2,1:6))
af2k = POLYF(CosIncBack,Construct(ConstrNumBack)%afBareSolCoef(2,1:6))
ab1k = POLYF(CosIncBack,Construct(ConstrNumBack)%abBareSolCoef(1,1:6))
ab2k = POLYF(CosIncBack,Construct(ConstrNumBack)%abBareSolCoef(2,1:6))
rb1k = POLYF(CosIncBack,Construct(ConstrNumBack)%rbBareSolCoef(1,1:6))
rb2k = POLYF(CosIncBack,Construct(ConstrNumBack)%rbBareSolCoef(2,1:6))
td1k = Construct(ConstrNumBack)%tBareSolDiff(1)
td2k = Construct(ConstrNumBack)%tBareSolDiff(2)
afd2k = Construct(ConstrNumBack)%afBareSolDiff(2)
abd1k = Construct(ConstrNumBack)%abBareSolDiff(1)
abd2k = Construct(ConstrNumBack)%abBareSolDiff(2)
rfd2k = Construct(ConstrNumBack)%rfBareSolDiff(2)
rbd1k = Construct(ConstrNumBack)%rbBareSolDiff(1)
rbd2k = Construct(ConstrNumBack)%rbBareSolDiff(2)
tfshBBk = BlindBeamBeamTrans(ProfAngBack,SlatAngBack,Blind(BlNumBack)%SlatWidth, &
Blind(BlNumBack)%SlatSeparation,Blind(BlNumBack)%SlatThickness)
tfshBdk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontBeamDiffTrans)
tfshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontDiffDiffTrans)
tbshBBk = BlindBeamBeamTrans(ProfAngBack,PI-SlatAngBack,Blind(BlNumBack)%SlatWidth, &
Blind(BlNumBack)%SlatSeparation,Blind(BlNumBack)%SlatThickness)
tbshBdk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamDiffTrans)
tbshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffDiffTrans)
rfshBk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontBeamDiffRefl)
rbshBk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamDiffRefl)
rfshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontDiffDiffRefl)
rbshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffDiffRefl)
afshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontDiffAbs)
abshdk = InterpSlatAng(SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackDiffAbs)
afshBk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolFrontBeamAbs)
abshBk = InterpProfSlatAng(ProfAngBack,SlatAngBack,VarSlatsBack,Blind(BlNumBack)%SolBackBeamAbs)
IF(NBackGlass==3) THEN
t3k = POLYF(CosIncBack,Construct(ConstrNumBack)%tBareSolCoef(3,1:6))
af3k = POLYF(CosIncBack,Construct(ConstrNumBack)%afBareSolCoef(3,1:6))
ab3k = POLYF(CosIncBack,Construct(ConstrNumBack)%abBareSolCoef(3,1:6))
afd3k = Construct(ConstrNumBack)%afBareSolDiff(3)
rfd3k = Construct(ConstrNumBack)%rfBareSolDiff(3)
END IF
! Interior beam absorptance of GLASS LAYERS of exterior back window with BETWEEN-GLASS BLIND
IF(NBackGlass==2) THEN
AbsBeamWin(2) = ab2k + t2k*tbshBBk*rb1k*tfshBBk*af2k + &
t2k*(tbshBBk*rb1k*tfshBdk + tbshBdk*rbd1k*tfshdk + rbshBk*(1.0d0 + rfd2k*rbshdk))*afd2k
AbsBeamWin(1) = t2k*tbshBBk*ab1k + t2k*(rbshBk*rfd2k*tbshdk + tbshBdk*(1.0d0 + rbd1k*rfshdk))*abd1k
ELSE ! NBackGlass = 3
AbsBeamWin(3) = ab3k + t3k*tbshBBk*(rb2k + t2k*rb1k*t2k)*tfshBBk*af3k + &
t3k*(tbshBdk*rbd2k*tfshdk + tbshBdk*td2k*rbd1k*td2k*tfshdk + rbshBk*(1.0d0 + rfd3k*rbshdk))*afd3k
AbsBeamWin(2) = t3k*tbshBBk*(ab2k + t2k*rb1k*(af2k + t2k*rfshBk*abd2k)) + &
t3k*(tbshBdk + tbshBdk*(rbd2k + td2k*rbd1k*td2k)*rfshdk + rbshBk*rfd3k*tbshdk)*abd2k + &
t3k*tbshBdk*td2k*rbd1k*afd2k
AbsBeamWin(1) = t3k*tbshBBk*(t2k*ab1k + (rb2k + t2k*rb1k*t2k)*rfshBk*td2k*abd1k) + &
t3k*(rbshBk*rfd3k*tbshdk + tbshBdk*(1.0d0 + rbd2k*rfshdk + td2k*rbd2k*td2k*rfshdk))*td2k*abd1k
END IF
! Interior beam transmitted by exterior back window with BETWEEN-GLASS BLIND
IF(NBackGlass==2) THEN
TransBeamWin = t2k*tbshBBk*t1k + &
t2k*(tbshBBk*rb1k*rfshBk + rbshBk*rfd2k*tbshdk + tbshBdk*(1.0d0 + rbd1k*rfshdk))*td1k
ELSE ! NGlass = 3
TransBeamWin = t3k*tbshBBk*t2k*t1k + &
t3k*(tbshBBk*(rb2k*rfshBk + t2k*rb1k*t2k*rfshBk) + rbshBk*rfd3k*tbshdk + &
tbshBdk*(1.0d0+ rbd2k*rfshdk + td2k*rbd1k*td2k*rfshdk))*td2k*td1k
END IF
! Interior beam absorbed by BLIND on exterior back window with BETWEEN-GLASS BLIND
IF(NBackGlass==2) THEN
ABlBack = t2k*(abshBk + tbshBBk*rb1k*afshBk + rbshBk*rfd2k*abshdk + tbshBdk*rbd1k*afshdk)
ELSE ! NBackGlass = 3
ABlBack = t3k*abshBk + t3k*tbshBBk*(rb2k + t2k*rb1k*t2k)*afshBk + t3k*rbshBk*rfd3k*abshdk + &
t3k*tbshBdk*(rbd2k + td2k*rbd1k*td2k)*afshdk
END IF
BABSZone = BABSZone + Boverlap * ABlBack
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * ABlBack/Surface(BackSurfNum)%Area
END IF ! End of check if between-glass blind is on back window
END IF ! End of check if blind is on back window
IF(ShadeFlagBack == ExtScreenOn) THEN
! Interior beam absorptance of GLASS LAYERS of exterior back window with EXTERIOR SCREEN
ScNumBack = SurfaceWindow(BackSurfNum)%ScreenNumber
TGlBmBack = POLYF(CosIncBack,Construct(ConstrNumBack)%TransSolBeamCoef(1:6))
RGlDiffFront = Construct(ConstrNumBack)%ReflectSolDiffFront
TScBmBmBack = SurfaceScreens(ScNumBack)%BmBmTransBack
TScBmDiffBack = SurfaceScreens(ScNumBack)%BmDifTransBack
RScBack = SurfaceScreens(ScNumBack)%ReflectSolBeamFront
RScDifBack = SurfaceScreens(ScNumBack)%DifReflect
DO Lay = 1,NBackGlass
AbWinBack = POLYF(CosIncBack,Construct(ConstrNumBack)%AbsBeamBackCoef(Lay,1:6))
AGlDiffFront= Construct(ConstrNumBack)%AbsDiff(Lay)
AbsBeamWin(Lay) = AbWinBack + (TGlBmBack*AGlDiffFront*RScBack / (1.d0 - RScDifBack*RGlDiffFront))
END DO
! Interior beam transmitted by exterior back window with EXTERIOR SCREEN
TScDifDif = SurfaceScreens(ScNumBack)%DifDifTrans
RScBmDifBk = SurfaceScreens(ScNumBack)%ReflectSolBeamBack
RGlDifFr = Construct(ConstrNum)%ReflectSolDiffFront
RScDifDifBk = SurfaceScreens(ScNumBack)%DifReflect
TransBeamWin = TGlBmBack * ( TScBmBmBack + TScBmDiffBack + &
TScDifDif*RScBmDifBk*RGlDifFr/(1.d0-RScDifDifBk*RGlDifFr) )
! Interior beam absorbed by EXTERIOR SCREEN on exterior back window
AbsScBack = SurfaceScreens(ScNumBack)%AbsorpSolarBeamBack
AbsScDiffBack = SurfaceScreens(ScNumBack)%DifScreenAbsorp
RScDiffBack = SurfaceScreens(ScNumBack)%ReflectSolBeamFront
AScBack = TGlBmBack*(AbsScBack + RScBack*RGlDiffFront*AbsScDiffBack/(1.d0-RScDiffBack*RGlDiffFront))
BABSZone = BABSZone + Boverlap * AScBack
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * &
AScBack / (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
END IF ! End of check if exterior screen on back window
! Interior beam absorptance of glass layers of back exterior window with SWITCHABLE GLAZING
IF(ShadeFlagBack == SwitchableGlazing .AND. Surface(BackSurfNum)%ExtBoundCond == 0) THEN
SwitchFacBack = SurfaceWindow(BackSurfNum)%SwitchingFactor
DO Lay = 1,NBackGlass
AbsBeamWinSh(Lay) = POLYF(CosIncBack,Construct(ConstrNumBackSh)%AbsBeamBackCoef(Lay,1:6))
END DO
DO Lay = 1,NBackGlass
AbsBeamWin(Lay) = InterpSw(SwitchFac,AbsBeamWin(Lay),AbsBeamWinSh(Lay))
END DO
TransBeamWinSh = POLYF(CosIncBack,Construct(ConstrNumBackSh)%TransSolBeamCoef(1:6))
TransBeamWin = InterpSw(SwitchFac,TransBeamWin,TransBeamWinSh)
END IF
! Sum of interior beam absorbed by all glass layers of back window
AbsBeamTotWin = 0.0d0
DO Lay = 1,NBackGlass
AbsBeamTotWin = AbsBeamTotWin + AbsBeamWin(Lay)
AWinSurf(BackSurfNum,Lay) = AWinSurf(BackSurfNum,Lay) + & ![-]
Boverlap * AbsBeamWin(Lay) / (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
END DO
! To BABSZon, add interior beam glass absorption and overall beam transmission for this back window
BABSZone = BABSZone + Boverlap * (AbsBeamTotWin + TransBeamWin)
! Interior beam transmitted to adjacent zone through an interior back window (assumed unshaded);
! this beam radiation is categorized as diffuse radiation in the adjacent zone.
AdjSurfNum = Surface(BackSurfNum)%ExtBoundCond
IF(AdjSurfNum > 0) THEN
AdjZoneNum = Surface(AdjSurfNum)%Zone
DBZoneIntWin(AdjZoneNum) = DBZoneIntWin(AdjZoneNum) + Boverlap * TransBeamWin ![m2]
SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep = SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep + &
Boverlap * TransBeamWin * BeamSolarRad ![W]
SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRepEnergy = SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep &
* TimeStepZone * SecInHour
END IF
END IF ! End of check if back surface is opaque or window
BmIncInsSurfAmountRep(BackSurfNum) = BmIncInsSurfAmountRep(BackSurfNum) + Boverlap
BmIncInsSurfAmountRepEnergy(BackSurfNum) = BmIncInsSurfAmountRep(BackSurfNum) * TimeStepZone * SecInHour
END DO ! End of loop over back surfaces
ELSE IF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
! For complex window calculation goes over outgoing basis directions
! for current state
CurCplxFenState = SurfaceWindow(SurfNum)%ComplexFen%CurrentState
! Get construction number which keeps transmittance properties
IConst = SurfaceWindow(SurfNum)%ComplexFen%State(CurCplxFenState)%Konst
FenSolAbsPtr = WindowScheduledSolarAbs(SurfNum, IConst)
! Solar radiation from this window will be calculated only in case when this window is not scheduled surface gained
IF (FenSolAbsPtr == 0) THEN
! Current incoming direction number (Sun direction)
IBm = ComplexWind(SurfNum)%Geom(CurCplxFenState)%SolBmIndex(HourOfDay, TimeStep)
! Report variables for complex fenestration here
BSDFBeamDirectionRep(SurfNum) = IBm
BSDFBeamThetaRep(SurfNum) = ComplexWind(SurfNum)%Geom(CurCplxFenState)%ThetaBm(HourOfDay, TimeStep)
BSDFBeamPhiRep(SurfNum) = ComplexWind(SurfNum)%Geom(CurCplxFenState)%PhiBm(HourOfDay, TimeStep)
BaseSurf = Surface(SurfNum)%BaseSurf
! Get total number of back surfaces for current window (surface)
! Note that it is organized by base surface
NBkSurf = ShadowComb(BaseSurf)%NumBackSurf
IF (.not.ALLOCATED(CFBoverlap)) THEN
ALLOCATE(CFBoverlap(NBkSurf))
END IF
IF (.not.ALLOCATED(CFDirBoverlap)) THEN
ALLOCATE(CFDirBoverlap(ComplexWind(SurfNum)%Geom(CurCplxFenState)%Trn%NBasis, NBkSurf))
END IF
CFBoverlap = 0.0d0
! delete values from previous timestep
AWinCFOverlap = 0.0d0
! Calculate effects on all back surfaces for each of basis directions. Each of basis directions from the back of the
! window has to be considered as beam and therefore calcualte CFBoverlap for each of them
DO CurTrnDir = 1, ComplexWind(SurfNum)%Geom(CurCplxFenState)%Trn%NBasis
CurLambda = ComplexWind(SurfNum)%Geom(CurCplxFenState)%Trn%Lamda(CurTrnDir)
DirTrans = Construct(IConst)%BSDFInput%SolFrtTrans(CurTrnDir, IBm)
! Now calculate effect of this direction on all back surfaces
DO IBack = 1, NBkSurf
CFDirBoverlap(CurTrnDir, IBack) = ComplexWind(SurfNum)%Geom(CurCplxFenState)% &
Aoverlap(CurTrnDir, IBack) * DirTrans * CurLambda * CosInc
CFBoverlap(IBack) = CFBoverlap(IBack) + CFDirBoverlap(CurTrnDir, IBack)
END DO ! DO IBack = 1,MaxBkSurf
END DO
! Summarizing results
DO IBack = 1, NBkSurf
BackSurfaceNumber = ShadowComb(BaseSurf)%BackSurf(IBack)
ConstrNumBack = Surface(BackSurfaceNumber)%Construction
! Do not perform any calculation if surface is scheduled for incoming solar radiation
SurfSolIncPtr = SurfaceScheduledSolarInc(BackSurfaceNumber, ConstrNumBack)
IF (SurfSolIncPtr == 0) THEN
! Surface hit is another complex fenestration
IF (SurfaceWindow(BackSurfaceNumber)%WindowModelType == WindowBSDFModel) THEN
CurBackState = SurfaceWindow(BackSurfaceNumber)%ComplexFen%CurrentState
! Do not take into account this window if it is scheduled for surface gains
FenSolAbsPtr = WindowScheduledSolarAbs(BackSurfaceNumber, ConstrNumBack)
IF (FenSolAbsPtr == 0) THEN
! Calculate energy loss per each outgoing orientation
DO CurTrnDir = 1, ComplexWind(SurfNum)%Geom(CurCplxFenState)%Trn%NBasis
DO CurBackDir = 1, ComplexWind(BackSurfaceNumber)%Geom(CurBackState)%Trn%NBasis
! Purpose of this part is to find best match for outgoing beam number of window back surface and incoming beam
! number of complex fenestration which this beam will hit on (back surface again)
tempVec1(1) = ComplexWind(SurfNum)%Geom(CurCplxFenState)%sTrn(CurTrnDir)%X
tempVec1(2) = ComplexWind(SurfNum)%Geom(CurCplxFenState)%sTrn(CurTrnDir)%Y
tempVec1(3) = ComplexWind(SurfNum)%Geom(CurCplxFenState)%sTrn(CurTrnDir)%Z
tempVec2(1) = ComplexWind(BackSurfaceNumber)%Geom(CurBackState)%sTrn(CurBackDir)%X
tempVec2(2) = ComplexWind(BackSurfaceNumber)%Geom(CurBackState)%sTrn(CurBackDir)%Y
tempVec2(3) = ComplexWind(BackSurfaceNumber)%Geom(CurBackState)%sTrn(CurBackDir)%Z
curDot = DOT_PRODUCT(tempVec1, tempVec2)
IF (CurBackDir == 1) THEN
bestDot = curDot
bestTrn = CurTrnDir
bestBackTrn = CurBackDir
ELSE
IF (curDot < bestDot) THEN
bestDot = curDot
bestTrn = CurTrnDir
bestBackTrn = CurBackDir
END IF
END IF
END DO
! CurLambda = ComplexWind(BackSurfaceNumber)%Geom(CurBackState)%Trn%Lamda(CurTrnDir)
! Add influence of this exact direction to what stays in the zone. It is important to note that
! this needs to be done for each outgoing direction
BABSZone = BABSZone + CFDirBoverlap(CurTrnDir, IBack) * &
& (1 - SurfaceWindow(BackSurfaceNumber)%ComplexFen%State(CurBackState)%IntegratedBkRefl(bestBackTrn))
! Absorptance from current back direction
TotSolidLay = Construct(ConstrNumBack)%TotSolidLayers
DO Lay = 1, TotSolidLay
!IF (ALLOCATED(Construct(ConstrNumBack)%BSDFInput)) THEN
! CFDirBoverlap is energy transmitted for current basis beam. It is important to note that AWinOverlap array
! needs to contain flux and not absorbed energy because later in the code this will be multiplied with window
! area
AWinCFOverlap(BackSurfaceNumber, Lay) = AWinCFOverlap(BackSurfaceNumber, Lay) + &
& Construct(ConstrNumBack)%BSDFInput%Layer(Lay)%BkAbs(1, bestBackTrn) * CFDirBoverlap(CurTrnDir, IBack) &
& / Surface(BackSurfaceNumber)%Area
!END IF
END DO
! Interior beam transmitted to adjacent zone through an interior back window;
! This beam radiation is categorized as diffuse radiation in the adjacent zone.
! Note that this is done for each outgoing direction of exterior window
AdjSurfNum = Surface(BackSurfaceNumber)%ExtBoundCond
IF(AdjSurfNum > 0) THEN
AdjZoneNum = Surface(AdjSurfNum)%Zone
DBZoneIntWin(AdjZoneNum) = DBZoneIntWin(AdjZoneNum) + CFDirBoverlap(CurTrnDir, IBack) * &
& SurfaceWindow(BackSurfaceNumber)%ComplexFen%State(CurBackState)%IntegratedBkTrans(bestBackTrn)
SurfaceWindow(BackSurfaceNumber)%BmSolTransThruIntWinRep = &
& SurfaceWindow(BackSurfaceNumber)%BmSolTransThruIntWinRep + &
& CFDirBoverlap(CurTrnDir, IBack) * &
& SurfaceWindow(BackSurfaceNumber)%ComplexFen%State(CurBackState)%IntegratedBkTrans(bestBackTrn) * &
& BeamSolarRad ![W]
SurfaceWindow(BackSurfaceNumber)%BmSolTransThruIntWinRepEnergy = &
& SurfaceWindow(BackSurfaceNumber)%BmSolTransThruIntWinRep &
& * TimeStepZone * SecInHour
END IF
END DO
END IF
ELSE
IF (Construct(ConstrNumBack)%TransDiff <= 0.0d0) THEN
! Do not take into account this window if it is scheduled for surface gains
SurfSolIncPtr = SurfaceScheduledSolarInc(BackSurfaceNumber, ConstrNumBack)
IF (SurfSolIncPtr == 0) THEN
AbsIntSurf = Construct(ConstrNumBack)%InsideAbsorpSolar
AISurf(BackSurfaceNumber) = AISurf(BackSurfaceNumber) + CFBoverlap(IBack) * &
AbsIntSurf/Surface(BackSurfaceNumber)%Area
BABSZone = BABSZone + CFBoverlap(IBack) * AbsIntSurf
END IF
ELSE
! Code for mixed windows goes here. It is same as above code for "ordinary" windows.
! Try to do something which will not produce duplicate code.
ENDIF
ENDIF
ENDIF
END DO
IF (ALLOCATED(CFBoverlap)) DEALLOCATE(CFBoverlap)
IF (ALLOCATED(CFDirBoverlap)) DEALLOCATE(CFDirBoverlap)
END IF
ELSE IF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
DO IBack = 1,MaxBkSurf
BackSurfNum = BackSurfaces(SurfNum,IBack,HourOfDay,TimeStep)
IF(BackSurfNum == 0) EXIT ! No more irradiated back surfaces for this exterior window
IF ( SurfaceWindow(IBack)%WindowModelType /= WindowEQLModel) CYCLE ! only EQL back window is allowed
ConstrNumBack = Surface(BackSurfNum)%Construction
NBackGlass = Construct(ConstrNumBack)%TotGlassLayers
! Irradiated (overlap) area for this back surface, projected onto window plane
! (includes effect of shadowing on exterior window)
Aoverlap = OverlapAreas(SurfNum,IBack,HourOfDay,TimeStep)
Boverlap = TBm * Aoverlap * CosInc ![m2]
IF(Construct(ConstrNumBack)%TransDiff <= 0.0d0) THEN
! Back surface is opaque interior or exterior wall
AbsIntSurf = Construct(ConstrNumBack)%InsideAbsorpSolar
! Check for movable insulation; reproduce code from subr. EvalInsideMovableInsulation;
! Can't call that routine here since cycle prevents SolarShadingGeometry from USEing
! HeatBalanceSurfaceManager, which contains EvalInsideMovableInsulation
HMovInsul = 0.0d0
IF (Surface(BackSurfNum)%MaterialMovInsulInt.GT.0) THEN
MovInsulSchedVal = GetCurrentScheduleValue(Surface(BackSurfNum)%SchedMovInsulExt)
IF (MovInsulSchedVal.LE.0.0d0) THEN ! Movable insulation not present at current time
HMovInsul = 0.0d0
ELSE ! Movable insulation present
HMovInsul = 1.0d0/(MovInsulSchedVal*Material(Surface(BackSurfNum)%MaterialMovInsulInt)%Resistance)
AbsInt = Material(Surface(BackSurfNum)%MaterialMovInsulInt)%AbsorpSolar
END IF
END IF
IF (HMovInsul > 0.0d0) AbsIntSurf = AbsInt ! Movable inside insulation present
AISurf(BackSurfNum) = AISurf(BackSurfNum) + & ![-]
Boverlap * AbsIntSurf / Surface(BackSurfNum)%Area
BABSZone = BABSZone + Boverlap * AbsIntSurf ![m2]
ELSE
! Back surface is an interior or exterior window
! Note that exterior back windows with and without shades are treated as defined.
! Equivalent Layer window model has no distinction when treating windows with and
! without shades (interior, inbetween and exterior shades)
CosIncBack = ABS(CosIncAng(BackSurfNum,HourOfDay,TimeStep))
!
! Note in equivalent layer window model if storm window exists it is defined as part of
! window construction, hence it does not require a separate treatment
AbsBeamWinEQL = 0.d0
TransBeamWin = 0.d0
! Interior beam absorptance of glass layers and beam transmittance of back exterior &
! or interior window (treates windows with/without shades as defined) for this timestep
! call the ASHWAT fenestration model for beam radiation here
CALL CalcEQLOpticalProperty(BackSurfNum, isBEAM, AbsSolBeamBackEQL)
EQLNum = Construct(ConstrNumBack)%EQLConsPtr
AbsBeamWinEQL(1:CFS(EQLNum)%NL) = AbsSolBeamBackEQL(1:CFS(EQLNum)%NL,1)
! get the interior beam transmitted through back exterior or interior EQL window
TransBeamWin = AbsSolBeamBackEQL(CFS(EQLNum)%NL+1,1)
! Absorbed by the interior shade layer of back exterior window
IF ( CFS(EQLNum)%L(CFS(EQLNum)%NL)%LTYPE /= ltyGLAZE) THEN
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * AbsSolBeamBackEQL(CFS(EQLNum)%NL,1) &
/ (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
BABSZone = BABSZone + Boverlap * AbsSolBeamBackEQL(CFS(EQLNum)%NL,1)
ENDIF
! Absorbed by the exterior shade layer of back exterior window
IF ( CFS(EQLNum)%L(1)%LTYPE /= ltyGLAZE) THEN
IntBeamAbsByShadFac(BackSurfNum) = Boverlap * AbsSolBeamBackEQL(1,1) &
/ (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
BABSZone = BABSZone + Boverlap * AbsSolBeamBackEQL(1,1)
ENDIF
! determine the number of glass layers
NBackGlass = 0
DO Lay = 1, CFS(EQLNum)%NL
IF ( CFS(EQLNum)%L(Lay)%LTYPE /= ltyGLAZE ) CYCLE
NBackGlass = NBackGlass + 1
END DO
IF (NBackGlass >= 2) THEN
! If the number of glass is greater than 2, in between glass shade can be present
DO Lay = 2, CFS(EQLNum)%NL-1
IF (CFS(EQLNum)%L(CFS(EQLNum)%NL)%LTYPE /= ltyGLAZE) THEN
! if there is in between shade glass determine the shade absorptance
IntBeamAbsByShadFac(BackSurfNum) = IntBeamAbsByShadFac(BackSurfNum) &
+ Boverlap * AbsSolBeamBackEQL(Lay,1) / Surface(BackSurfNum)%Area
BABSZone = BABSZone + Boverlap * AbsSolBeamBackEQL(Lay,1)
END IF
END DO
ENDIF
! Sum of interior beam absorbed by all glass layers of back window
AbsBeamTotWin = 0.0d0
DO Lay = 1, CFS(EQLNum)%NL
AbsBeamTotWin = AbsBeamTotWin + AbsBeamWinEQL(Lay)
AWinSurf(BackSurfNum,Lay) = AWinSurf(BackSurfNum,Lay) + & ![-]
Boverlap * AbsBeamWinEQL(Lay) / (Surface(BackSurfNum)%Area + SurfaceWindow(BackSurfNum)%DividerArea)
END DO
! To BABSZon, add interior beam glass absorption and overall beam transmission for this back window
BABSZone = BABSZone + Boverlap * (AbsBeamTotWin + TransBeamWin)
! Interior beam transmitted to adjacent zone through an interior back window (assumed unshaded);
! this beam radiation is categorized as diffuse radiation in the adjacent zone.
AdjSurfNum = Surface(BackSurfNum)%ExtBoundCond
IF(AdjSurfNum > 0) THEN
AdjZoneNum = Surface(AdjSurfNum)%Zone
DBZoneIntWin(AdjZoneNum) = DBZoneIntWin(AdjZoneNum) + Boverlap * TransBeamWin ![m2]
SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep = SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep + &
Boverlap * TransBeamWin * BeamSolarRad ![W]
SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRepEnergy = SurfaceWindow(BackSurfNum)%BmSolTransThruIntWinRep &
* TimeStepZone * SecInHour
END IF
END IF ! End of check if back surface is opaque or window
BmIncInsSurfAmountRep(BackSurfNum) = BmIncInsSurfAmountRep(BackSurfNum) + Boverlap
BmIncInsSurfAmountRepEnergy(BackSurfNum) = BmIncInsSurfAmountRep(BackSurfNum) * TimeStepZone * SecInHour
END DO ! End of loop over back surfaces
! *****************************
END IF ! IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel) THEN
ELSE ! Simple interior solar distribution. All beam from exterior windows falls on floor;
! some of this is absorbed/transmitted, rest is reflected to other surfaces.
DO FloorNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
! In following, ISABSF is zero except for nominal floor surfaces
IF (.not. Surface(FloorNum)%HeatTransSurf) CYCLE
IF(ISABSF(FloorNum) <= 0.0d0 .OR. FloorNum == SurfNum) CYCLE ! Keep only floor surfaces
FlConstrNum = Surface(FloorNum)%Construction
BTOTWinZone = TBm * SunLitFract * Surface(SurfNum)%Area * CosInc * InOutProjSLFracMult ![m2]
IF(Construct(FlConstrNum)%TransDiff <= 0.0d0) THEN
! Opaque surface
AISurf(FloorNum) = AISurf(FloorNum) + BTOTWinZone*ISABSF(FloorNum)/Surface(FloorNum)%Area ![-]
ELSE
! Window
! Note that diffuse solar absorptance is used here for floor windows even though we're
! dealing with incident beam radiation. This is because, for this simple interior distribution,
! the beam radiation from exterior windows is assumed to be uniformly distributed over the
! floor and so it makes no sense to use directional absorptances. Note also that floor windows
! are assumed to not have blinds or shades in this calculation.
! For the case of the floor window a complex fenestration (strange situation) the correct back
! diffuse layer absorptions have already been put into the construction
IF(SurfaceWindow(FloorNum)%StormWinFlag==1) FlConstrNum = Surface(FloorNum)%StormWinConstruction
AbsBeamTotWin = 0.0d0
DO Lay = 1,Construct(FlConstrNum)%TotGlassLayers
AbsBeamTotWin = AbsBeamTotWin + Construct(FlConstrNum)%AbsDiffBack(Lay)
END DO
! In the following we have to multiply by the AbsDiffBack(Lay)/AbsBeamTotWin ratio to get the
! layer by layer absorbed beam since ISABSF(FloorNum) is proportional to AbsBeamTotWin
! (see ComputeIntSolarAbsorpFactors).
DO Lay = 1,Construct(FlConstrNum)%TotGlassLayers
AWinSurf(FloorNum,Lay) = AWinSurf(FloorNum,Lay) + & ![-]
Construct(FlConstrNum)%AbsDiffBack(Lay)/AbsBeamTotWin * &
BTOTWinZone*ISABSF(FloorNum)/Surface(FloorNum)%Area
END DO
END IF
BABSZone = BABSZone + BTOTWinZone*ISABSF(FloorNum) ![m2]
AdjSurfNum = Surface(FloorNum)%ExtBoundCond
IF(Construct(FlConstrNum)%TransDiff > 0.0d0 .AND. AdjSurfNum > 0) THEN
! Window in an interior floor
AdjZoneNum = Surface(AdjSurfNum)%Zone
! Contribution (assumed diffuse) to adjacent zone of beam radiation passing
! through this window
DBZoneIntWin(AdjZoneNum) = DBZoneIntWin(AdjZoneNum) + &
BTOTWinZone * ISABSF(FloorNum) * Construct(FlConstrNum)%TransDiff / AbsBeamTotWin
BABSZone = BABSZone + &
BTOTWinZone * ISABSF(FloorNum) * Construct(FlConstrNum)%TransDiff / AbsBeamTotWin
END IF
END DO ! End of loop over floor sections
END IF ! End of check on complex vs. simple interior solar distribution
END IF ! End of sunlit fraction > 0 test
END DO ! End of first loop over surfaces in zone
! It is importatnt to do this only one time
!IF (ZoneNum == 1) THEN
BABSZoneSSG = 0.0d0
BTOTZoneSSG = 0.0d0
DO iSSG = 1, TotSurfIncSolSSG
SurfNum = SurfIncSolSSG(iSSG)%SurfPtr
! do calculation only if construction number match.
IF (SurfIncSolSSG(iSSG)%ConstrPtr == Surface(SurfNum)%Construction) THEN
IF (Surface(SurfNum)%Zone == ZoneNum) THEN
AbsIntSurf = Construct(Surface(SurfNum)%Construction)%InsideAbsorpSolar
!SolarIntoZone = GetCurrentScheduleValue(SurfIncSolSSG(iSSG)%SchedPtr) * Surface(SurfNum)%Area
SolarIntoZone = GetCurrentScheduleValue(SurfIncSolSSG(iSSG)%SchedPtr)
AISurf(SurfNum) = SolarIntoZone * AbsIntSurf
BABSZoneSSG = BABSZoneSSG + AISurf(SurfNum) * Surface(SurfNum)%Area
BTOTZoneSSG = BTotZoneSSG + SolarIntoZone * Surface(SurfNum)%Area
END IF
END IF
END DO
DBZoneSSG(ZoneNum) = BTotZoneSSG - BABSZoneSSG
!END IF
DBZone(ZoneNum) = BTOTZone - BABSZone
IF(DBZone(ZoneNum) < 0.0d0) THEN
DBZone(ZoneNum) = 0.0d0
END IF
! Variables for reporting
DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE
IF(SolarDistribution == FullInteriorExterior) THEN
BmIncInsSurfAmountRep(SurfNum) = BeamSolarRad * BmIncInsSurfAmountRep(SurfNum)
BmIncInsSurfAmountRepEnergy(SurfNum) = BmIncInsSurfAmountRep(SurfNum) * TimeStepZone * SecInHour
BmIncInsSurfIntensRep(SurfNum) = BmIncInsSurfAmountRep(SurfNum) / &
(Surface(SurfNum)%Area + SurfaceWindow(SurfNum)%DividerArea)
ELSE ! Simple interior solar distribution. All beam falls on floor.
IF(ISABSF(SurfNum) > 0.0d0 .AND. Surface(SurfNum)%HeatTransSurf) THEN
IF (Zone(ZoneNum)%FloorArea > 0.0d0) THEN
! spread onto all floor surfaces, these may or may not be called "floor"
BmIncInsSurfIntensRep(SurfNum) = BeamSolarRad * BTOTZone/Zone(ZoneNum)%FloorArea
ELSEIF (Zone(ZoneNum)%TotalSurfArea > 0.d0) THEN
! spread onto all interior surfaces
BmIncInsSurfIntensRep(SurfNum) =BeamSolarRad * BTOTZone/Zone(ZoneNum)%TotalSurfArea
ELSE !divide be zero otherwise
BmIncInsSurfIntensRep(SurfNum) = 0.d0
ENDIF
ENDIF
BmIncInsSurfAmountRep(SurfNum) = Surface(SurfNum)%Area * BmIncInsSurfIntensRep(SurfNum)
BmIncInsSurfAmountRepEnergy(SurfNum) = BmIncInsSurfAmountRep(SurfNum) * TimeStepZone * SecInHour
END IF
IF (Surface(SurfNum)%Class == SurfaceClass_Window .OR. Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) THEN
SurfaceWindow(SurfNum)%IntBeamAbsByShade = IntBeamAbsByShadFac(SurfNum)
SurfaceWindow(SurfNum)%ExtBeamAbsByShade = BeamSolarRad * ExtBeamAbsByShadFac(SurfNum)
IF ((Surface(SurfNum)%ExtBoundCond == ExternalEnvironment) .OR. &
(Surface(SurfNum)%ExtBoundCond == OtherSideCondModeledExt) ) THEN
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
BlNum = SurfaceWindow(SurfNum)%BlindNumber
ShelfNum = Surface(SurfNum)%Shelf
IF (ShelfNum > 0) THEN ! Outside daylighting shelf
OutShelfSurf = Shelf(ShelfNum)%OutSurf
ELSE
OutShelfSurf = 0
END IF
! This lookup may be avoid if this 2nd surf loop can be combined with the 1st
IF (SurfaceWindow(SurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
PipeNum = FindTDDPipe(SurfNum)
SurfNum2 = TDDPipe(PipeNum)%Dome
DifSolarInc = DifSolarRad * AnisoSkyMult(SurfNum2) + GndSolarRad * Surface(SurfNum2)%ViewFactorGround
SkySolarTrans = DifSolarRad * TransTDD(PipeNum, CosInc, SolarAniso) * AnisoSkyMult(SurfNum2)
GndSolarTrans = GndSolarRad * TDDPipe(PipeNum)%TransSolIso * Surface(SurfNum2)%ViewFactorGround
WinBmSolar(SurfNum) = BeamSolarRad * WinTransBmSolar(SurfNum)
WinDifSolar(SurfNum) = SkySolarTrans * Surface(SurfNum)%Area + GndSolarTrans * Surface(SurfNum)%Area
WinBmSolarEnergy(SurfNum) = WinBmSolar(SurfNum) * TimeStepZone * SecInHour
WinDifSolarEnergy(SurfNum) = WinDifSolar(SurfNum) * TimeStepZone * SecInHour
WinTransSolar(SurfNum) = WinBmSolar(SurfNum) + WinDifSolar(SurfNum) ![W]
WinTransSolarEnergy(SurfNum) = WinTransSolar(SurfNum) * TimeStepZone * SecInHour
TDDPipe(PipeNum)%TransmittedSolar = WinTransSolar(SurfNum)
!TDDPipe(PipeNum)%TransSolBeam = TBmBm ! Reported above
IF (DifSolarInc > 0) THEN
TDDPipe(PipeNum)%TransSolDiff = (SkySolarTrans + GndSolarTrans) / DifSolarInc
ELSE
TDDPipe(PipeNum)%TransSolDiff = 0.0d0
END IF
ELSE IF (OutShelfSurf > 0) THEN ! Outside daylighting shelf
ShelfSolarRad = (BeamSolarRad * SunlitFrac(OutShelfSurf,HourOfDay,TimeStep) &
* CosIncAng(OutShelfSurf,HourOfDay,TimeStep) + DifSolarRad * AnisoSkyMult(OutShelfSurf)) &
* Shelf(ShelfNum)%OutReflectSol
DifSolarInc = DifSolarRad * AnisoSkyMult(SurfNum) + GndSolarRad * Surface(SurfNum)%ViewFactorGround &
+ ShelfSolarRad * Shelf(ShelfNum)%ViewFactor
WinBmSolar(SurfNum) = BeamSolarRad * WinTransBmSolar(SurfNum)
WinDifSolar(SurfNum) = DifSolarInc * WinTransDifSolar(SurfNum)
WinBmSolarEnergy(SurfNum) = WinBmSolar(SurfNum) * TimeStepZone * SecInHour
WinDifSolarEnergy(SurfNum) = WinDifSolar(SurfNum) * TimeStepZone * SecInHour
WinTransSolar(SurfNum) = WinBmSolar(SurfNum) + WinDifSolar(SurfNum) ![W]
WinTransSolarEnergy(SurfNum) = WinTransSolar(SurfNum) * TimeStepZone * SecInHour
ELSE ! Regular window
SkySolarInc = SurfaceWindow(SurfNum)%SkySolarInc
GndSolarInc = SurfaceWindow(SurfNum)%GndSolarInc
DifSolarInc = SkySolarInc + GndSolarInc
WinBmSolar(SurfNum) = BeamSolarRad * WinTransBmSolar(SurfNum)
!Note: for complex fenestration, WinTransDifSolar has previously been defined using the effective
! transmittance for sky and ground diffuse radiation (including beam radiation reflected from the ground)
! so these calculations should be correct
WinDifSolar(SurfNum) = DifSolarInc * WinTransDifSolar(SurfNum)
WinBmSolarEnergy(SurfNum) = WinBmSolar(SurfNum) * TimeStepZone * SecInHour
WinDifSolarEnergy(SurfNum) = WinDifSolar(SurfNum) * TimeStepZone * SecInHour
IF(ShadeFlag==IntBlindOn.OR.ShadeFlag==ExtBlindOn.OR.ShadeFlag==BGBlindOn) THEN
IF(Blind(SurfaceWindow(SurfNum)%BlindNumber)%SlatOrientation == Horizontal) THEN
WinDifSolar(SurfNum) = SkySolarInc * WinTransDifSolarSky(SurfNum) + &
GndSolarInc * WinTransDifSolarGnd(SurfNum)
WinDifSolarEnergy(SurfNum) = WinDifSolar(SurfNum) * TimeStepZone * SecInHour
END IF
END IF
WinTransSolar(SurfNum) = WinBmSolar(SurfNum) + WinDifSolar(SurfNum) ![W]
WinTransSolarEnergy(SurfNum) = WinTransSolar(SurfNum) * TimeStepZone * SecInHour
END IF
!added TH 12/9/2009, CR 7907 & 7809
WinBmBmSolar(SurfNum) = BeamSolarRad * WinTransBmBmSolar
WinBmDifSolar(SurfNum) = BeamSolarRad * WinTransBmDifSolar
WinBmBmSolarEnergy(SurfNum) = WinBmBmSolar(SurfNum) * TimeStepZone * SecInHour
WinBmDifSolarEnergy(SurfNum) = WinBmDifSolar(SurfNum) * TimeStepZone * SecInHour
WinDirSolTransAtIncAngle(SurfNum) = TBmBm + TBmDif ! For TDD:DIFFUSER this is the TDD transmittance
! Solar not added by TDD:DOME; added to zone via TDD:DIFFUSER
IF (Surface(SurfNum)%Class /= SurfaceClass_TDD_Dome) THEN
ZoneTransSolar(ZoneNum) = ZoneTransSolar(ZoneNum) + WinTransSolar(SurfNum) ![W]
ZoneTransSolarEnergy(ZoneNum) = ZoneTransSolar(ZoneNum) * TimeStepZone * SecInHour ![J]
ZoneBmSolFrExtWinsRep(ZoneNum) = ZoneBmSolFrExtWinsRep(ZoneNum) + WinBmSolar(SurfNum)
ZoneDifSolFrExtWinsRep(ZoneNum) = ZoneDifSolFrExtWinsRep(ZoneNum) + WinDifSolar(SurfNum)
ZoneBmSolFrExtWinsRepEnergy(ZoneNum) = ZoneBmSolFrExtWinsRep(ZoneNum) * TimeStepZone * SecInHour ![J]
ZoneDifSolFrExtWinsRepEnergy(ZoneNum) = ZoneDifSolFrExtWinsRep(ZoneNum) * TimeStepZone * SecInHour ![J]
END IF
END IF
END IF
END DO ! End of second loop over surfaces in zone
END DO ! End of first zone loop
! Add interior window contribution to DBZone
DO ZoneNum = 1,NumOfZones
DBZone(ZoneNum) = DBZone(ZoneNum) + DBZoneIntWin(ZoneNum)
ZoneBmSolFrIntWinsRep(ZoneNum) = DBZoneIntWin(ZoneNum) * BeamSolarRad
ZoneBmSolFrIntWinsRepEnergy(ZoneNum) = ZoneBmSolFrIntWinsRep(ZoneNum) * TimeStepZone * SecInHour ![J]
END DO
! RJH - Calculate initial distribution of diffuse solar transmitted by exterior windows into each zone
! to all interior surfaces in the zone
! Includes subsequent transmittance of diffuse solar to adjacent zones through interior windows
CALL CalcWinTransDifSolInitialDistribution
RETURN
END SUBROUTINE CalcInteriorSolarDistribution