Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
!! Following may need to be removed or changed when shelves are considered in adjacent reflection calculations
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE InitIntSolarDistribution
! SUBROUTINE INFORMATION:
! AUTHOR Anonymous
! DATE WRITTEN July 1977
! MODIFIED Oct 1999 (FW) to handle movable shades
! May 2000 (FW) to handle window frame and dividers
! May 2001 (FW) to handle window blinds
! Jan 2002 (FW) mods for between-glass shade/blind
! May 2006 (RR) to handle exterior window screens
! RE-ENGINEERED Mar98 (RKS)
! PURPOSE OF THIS SUBROUTINE:
! This subroutine initializes the arrays associated with solar heat
! gains for both individual surfaces and for zones.
! METHODOLOGY EMPLOYED:
! If the sun is down, all of the pertinent arrays are zeroed. If the
! sun is up, various calculations are made.
! REFERENCES:
! (I)BLAST legacy routine QSUN
! USE STATEMENTS:
USE General, ONLY: InterpSw, InterpSlatAng
USE HeatBalanceMovableInsulation
USE DaylightingDevices, ONLY: DistributeTDDAbsorbedSolar
USE DataWindowEquivalentLayer
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AbsExt ! Solar absorptance of outermost layer (or movable insulation if present)
REAL(r64) :: AbsInt ! Inside opaque surface solar absorptance
REAL(r64) :: AbsIntSurf ! Inside opaque surface solar absorptance
REAL(r64) :: AbsIntSurfVis ! Inside opaque surface visible absorptance
REAL(r64) :: HMovInsul ! Resistance or "h" value of movable insulation (from EvalOutsideMovableInsulation, not used)
INTEGER :: OtherZoneNum ! DO loop counter for zones
INTEGER :: RoughIndexMovInsul ! Roughness index of movable insulation
INTEGER :: ConstrNum ! Construction number
INTEGER :: SurfNum ! Surface number
INTEGER :: ZoneNum ! Zone number
INTEGER :: ConstrNumSh ! Shaded construction number
INTEGER :: SurfNumAdjZone ! Surface number in adjacent zone for interzone surfaces
INTEGER :: IGlass ! Glass layer counter
INTEGER :: ShadeFlag ! Shading flag
REAL(r64) :: DividerThermAbs ! Window divider thermal absorptance
REAL(r64) :: DividerSolAbs ! Window divider solar absorptance
REAL(r64) :: DividerSolRefl ! Window divider solar reflectance
INTEGER :: MatNumGl ! Glass layer material number
INTEGER :: MatNumSh ! Shade layer material number
REAL(r64) :: TransGl,ReflGl,AbsGl ! Glass layer solar transmittance, reflectance, absorptance
INTEGER :: BlNum ! Blind number
INTEGER :: TotGlassLayers ! Number of glass layers in a window construction
REAL(r64) :: BlAbsDiffBk ! Glass layer back diffuse solar absorptance when blind in place
REAL(r64) :: AbsDiffBkBl ! Blind diffuse back solar absorptance as part of glazing system
REAL(r64) :: EffBlEmiss ! Blind emissivity (thermal absorptance) as part of glazing system
REAL(r64) :: pulseMultipler ! use to create a pulse for the load component report computations
REAL(r64) :: curQL = 0.0d0 ! radiant value prior to adjustment for pulse for load component report
REAL(r64) :: adjQL = 0.0d0 ! radiant value including adjustment for pulse for load component report
INTEGER :: EQLNum ! equivalent layer fenestration index
INTEGER :: Lay ! equivalent layer fenestration layer index
! FLOW:
IF (.NOT. ALLOCATED(QS)) ALLOCATE(QS(NumOfZones))
IF (.NOT. ALLOCATED(QSLights)) ALLOCATE(QSLights(NumOfZones))
QS = 0.d0
QSLights = 0.d0
! COMPUTE TOTAL SHORT-WAVE RADIATION ORIGINATING IN ZONE.
! Note: If sun is not up, QS is only internal gains
DO ZoneNum = 1, NumOfZones
QS(ZoneNum) = QD(ZoneNum) + ZoneIntGain(ZoneNum)%QLTSW
QSLights(ZoneNum) = ZoneIntGain(ZoneNum)%QLTSW
END DO
IF (InterZoneWindow) THEN ! DO INTERZONE DISTRIBUTION.
DO ZoneNum = 1, NumOfZones
IF (RecDifShortFromZ(ZoneNum)) THEN
DO OtherZoneNum = 1, NumOfZones
IF ( (OtherZoneNum /= ZoneNum) .AND.(RecDifShortFromZ(OtherZoneNum)) ) THEN
QS(ZoneNum) = QS(ZoneNum) + FractDifShortZtoZ(OtherZoneNum,ZoneNum)* &
(QD(OtherZoneNum)+ZoneIntGain(OtherZoneNum)%QLTSW)
ZoneDifSolFrIntWinsRep(ZoneNum) = ZoneDifSolFrIntWinsRep(ZoneNum) + &
FractDifShortZtoZ(OtherZoneNum,ZoneNum) * QD(OtherZoneNum)
ZoneDifSolFrIntWinsRepEnergy(ZoneNum) = ZoneDifSolFrIntWinsRep(ZoneNum) * TimeStepZone * SecInHour
END IF
END DO
END IF
END DO
END IF
! Beam and diffuse solar on inside surfaces from interior windows (for reporting)
DO SurfNum = 1,TotSurfaces
IF(.NOT.Surface(SurfNum)%HeatTransSurf) CYCLE
!!!! Following may need to be removed or changed when shelves are considered in adjacent reflection calculations
IF (Surface(SurfNum)%Class == SurfaceClass_Shading) CYCLE
ZoneNum = Surface(SurfNum)%Zone
IntBmIncInsSurfIntensRep(SurfNum) = ZoneBmSolFrIntWinsRep(ZoneNum)/Zone(ZoneNum)%TotalSurfArea
IntBmIncInsSurfAmountRep(SurfNum) = IntBmIncInsSurfIntensRep(SurfNum) * &
(Surface(SurfNum)%Area + SurfaceWindow(SurfNum)%DividerArea)
IntBmIncInsSurfAmountRepEnergy(SurfNum) = IntBmIncInsSurfAmountRep(SurfNum) * TimeStepZone * SecInHour
! IntDifIncInsSurfIntensRep(SurfNum) = ZoneDifSolFrIntWinsRep(ZoneNum)/Zone(ZoneNum)%TotalSurfArea
! IntDifIncInsSurfAmountRep(SurfNum) = IntDifIncInsSurfIntensRep(SurfNum) * &
! (Surface(SurfNum)%Area + SurfaceWindow(SurfNum)%DividerArea)
! IntDifIncInsSurfAmountRepEnergy(SurfNum) = IntDifIncInsSurfAmountRep(SurfNum) * TimeStepZone * SecInHour
END DO
! COMPUTE CONVECTIVE GAINS AND ZONE FLUX DENSITY.
DO ZoneNum = 1, NumOfZones
QS(ZoneNum) = QS(ZoneNum) * FractDifShortZtoZ(ZoneNum,ZoneNum) * VMULT(ZoneNum)
! CR 8695, VMULT not based on visible
QSLights(ZoneNum) = QSLights(ZoneNum) * FractDifShortZtoZ(ZoneNum,ZoneNum) * VMULT(ZoneNum)
END DO
! COMPUTE RADIANT GAINS ON SURFACES
DO SurfNum = 1, TotSurfaces
ZoneNum = Surface(SurfNum)%Zone
IF (.NOT. Surface(SurfNum)%HeatTransSurf .OR. ZoneNum == 0) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) CYCLE ! Skip tubular daylighting device domes
ConstrNum = Surface(SurfNum)%Construction
IF(Construct(ConstrNum)%TransDiff <= 0.0d0) THEN ! Opaque surface
AbsIntSurf = Construct(ConstrNum)%InsideAbsorpSolar
AbsIntSurfVis = Construct(ConstrNum)%InsideAbsorpSolar !to fix CR 8695 change to this = Construct(ConstrNum)%InsideAbsorpVis
HMovInsul = 0.0d0
IF (Surface(SurfNum)%MaterialMovInsulInt.GT.0) &
CALL EvalInsideMovableInsulation(SurfNum,HMovInsul,AbsInt)
IF (HMovInsul > 0.0d0) AbsIntSurf = AbsInt
QRadSWInAbs(SurfNum) = QRadSWInAbs(SurfNum) + QS(ZoneNum)*AbsIntSurf
QRadSWLightsInAbs(SurfNum) = QRadSWLightsInAbs(SurfNum) + QSLights(ZoneNum)*AbsIntSurfVis
ELSE ! Window
IF ( SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(SurfNum)%StormWinConstruction
ConstrNumSh = Surface(SurfNum)%StormWinShadedConstruction
END IF
TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
! These calculations are repeated from InitInternalHeatGains for the Zone Component Loads Report
pulseMultipler = 0.01d0 ! the W/sqft pulse for the zone
IF (.NOT. doLoadComponentPulseNow) THEN
QRadThermInAbs(SurfNum) = QL(ZoneNum) * TMULT(ZoneNum) * ITABSF(SurfNum)
ELSE
curQL = QL(ZoneNum)
! for the loads component report during the special sizing run increase the radiant portion
! a small amount to create a "pulse" of heat that is used for the
adjQL = curQL + Zone(ZoneNum)%FloorArea * pulseMultipler
! ITABSF is the Inside Thermal Absorptance
! TMULT is a mulipliter for each zone
! QRadThermInAbs is the thermal radiation absorbed on inside surfaces
QRadThermInAbs(SurfNum) = adjQL * TMULT(ZoneNum) * ITABSF(SurfNum)
END IF
IF(ShadeFlag <= 0) THEN ! No window shading
DO IGlass = 1,TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
QS(ZoneNum)*Construct(ConstrNum)%AbsDiffBack(IGlass)
END DO
ELSE IF(ShadeFlag == IntShadeOn .OR. ShadeFlag >= 3) THEN
! Interior, exterior or between-glass shade, screen or blind in place
DO IGlass = 1,Construct(ConstrNumSh)%TotGlassLayers
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn .OR. ShadeFlag==ExtScreenOn) &
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
QS(ZoneNum)*Construct(ConstrNumSh)%AbsDiffBack(IGlass)
IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn) THEN
BlAbsDiffBk = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
Construct(ConstrNumSh)%BlAbsDiffBack(IGlass,1:MaxSlatAngs))
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + QS(ZoneNum)*BlAbsDiffBk
END IF
END DO
BlNum = SurfaceWindow(SurfNum)%BlindNumber
IF(ShadeFlag == IntShadeOn) &
SurfaceWindow(SurfNum)%IntLWAbsByShade = &
QL(ZoneNum) * Construct(ConstrNumSh)%ShadeAbsorpThermal * TMULT(ZoneNum)
IF(ShadeFlag == IntBlindOn) THEN
EffBlEmiss = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
SurfaceWindow(SurfNum)%EffShBlindEmiss)
SurfaceWindow(SurfNum)%IntLWAbsByShade = QL(ZoneNum) * EffBlEmiss * TMULT(ZoneNum)
END IF
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn .OR. ShadeFlag==ExtScreenOn) &
SurfaceWindow(SurfNum)%IntSWAbsByShade = QS(ZoneNum)*Construct(ConstrNumSh)%AbsDiffBackShade
IF(ShadeFlag==IntBlindOn .OR. ShadeFlag==ExtBlindOn .OR. ShadeFlag==BGBlindOn) THEN
AbsDiffBkBl = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
Construct(ConstrNumSh)%AbsDiffBackBlind)
SurfaceWindow(SurfNum)%IntSWAbsByShade = QS(ZoneNum)*AbsDiffBkBl
END IF
! Correct for divider shadowing
IF(ShadeFlag == ExtShadeOn.OR.ShadeFlag == ExtBlindOn.OR.ShadeFlag == ExtScreenOn) &
SurfaceWindow(SurfNum)%IntSWAbsByShade = SurfaceWindow(SurfNum)%IntSWAbsByShade * SurfaceWindow(SurfNum)%GlazedFrac
ELSE IF(ShadeFlag == SwitchableGlazing) THEN ! Switchable glazing
DO IGlass = 1,TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
QS(ZoneNum) * InterpSw(SurfaceWindow(SurfNum)%SwitchingFactor, &
Construct(ConstrNum)%AbsDiffBack(IGlass), &
Construct(ConstrNumSh)%AbsDiffBack(IGlass))
END DO
END IF ! End of shading flag check
IF(SurfaceWindow(SurfNum)%FrameArea > 0.0d0) & ! Window has a frame
! Note that FrameQRadInAbs is initially calculated in InitSolarHeatGains
SurfaceWindow(SurfNum)%FrameQRadInAbs = SurfaceWindow(SurfNum)%FrameQRadInAbs + &
( QS(ZoneNum) * SurfaceWindow(SurfNum)%FrameSolAbsorp + &
(QL(ZoneNum)*TMULT(ZoneNum) + QHTRadSysSurf(SurfNum) + QHWBaseboardSurf(SurfNum) + &
QSteamBaseboardSurf(SurfNum) + QElecBaseboardSurf(SurfNum)) * &
SurfaceWindow(SurfNum)%FrameEmis ) * (1.0d0+0.5d0*SurfaceWindow(SurfNum)%ProjCorrFrIn)
IF(SurfaceWindow(SurfNum)%DividerArea > 0.0d0) THEN ! Window has dividers
DividerThermAbs = SurfaceWindow(SurfNum)%DividerEmis
DividerSolAbs = SurfaceWindow(SurfNum)%DividerSolAbsorp
IF(SurfaceWindow(SurfNum)%DividerType == Suspended) THEN ! Suspended divider; account for inside glass
MatNumGl = Construct(ConstrNum)%LayerPoint(Construct(ConstrNum)%TotLayers)
TransGl = Material(MatNumGl)%Trans
ReflGl = Material(MatNumGl)%ReflectSolBeamBack
AbsGl = 1.0d0-TransGl-ReflGl
DividerSolRefl = 1.0d0-DividerSolAbs
DividerSolAbs = AbsGl + TransGl*(DividerSolAbs + DividerSolRefl*AbsGl)/(1.0d0-DividerSolRefl*ReflGl)
DividerThermAbs = Material(MatNumGl)%AbsorpThermalBack
END IF
! Correct for interior shade transmittance
IF(ShadeFlag == IntShadeOn) THEN
MatNumSh = Construct(ConstrNumSh)%LayerPoint(Construct(ConstrNumSh)%TotLayers)
DividerSolAbs = DividerSolAbs * Material(MatNumSh)%Trans
DividerThermAbs = DividerThermAbs * Material(MatNumSh)%TransThermal
ELSE IF(ShadeFlag == IntBlindOn) THEN
DividerSolAbs = DividerSolAbs * InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Blind(BlNum)%SolBackDiffDiffTrans)
DividerThermAbs = DividerThermAbs * InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats, Blind(BlNum)%IRBackTrans)
END IF
! Note that DividerQRadInAbs is initially calculated in InitSolarHeatGains
SurfaceWindow(SurfNum)%DividerQRadInAbs = SurfaceWindow(SurfNum)%DividerQRadInAbs + &
( QS(ZoneNum)*DividerSolAbs + &
(QL(ZoneNum)*TMULT(ZoneNum) + QHTRadSysSurf(SurfNum) + QHWBaseboardSurf(SurfNum) + &
QSteamBaseboardSurf(SurfNum) + QElecBaseboardSurf(SurfNum))*DividerThermAbs) * &
(1.0d0+SurfaceWindow(SurfNum)%ProjCorrDivIn)
END IF
ELSE IF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
!ConstrNumSh = Surface(SurfNum)%ShadedConstruction
ConstrNum = Surface(SurfNum)%Construction
!TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
! These calculations are repeated from InitInternalHeatGains for the Zone Component Loads Report
pulseMultipler = 0.01d0 ! the W/sqft pulse for the zone
IF (.NOT. doLoadComponentPulseNow) THEN
QRadThermInAbs(SurfNum) = QL(ZoneNum) * TMULT(ZoneNum) * ITABSF(SurfNum)
ELSE
curQL = QL(ZoneNum)
! for the loads component report during the special sizing run increase the radiant portion
! a small amount to create a "pulse" of heat that is used for the
adjQL = curQL + Zone(ZoneNum)%FloorArea * pulseMultipler
! ITABSF is the Inside Thermal Absorptance
! TMULT is a mulipliter for each zone
! QRadThermInAbs is the thermal radiation absorbed on inside surfaces
QRadThermInAbs(SurfNum) = adjQL * TMULT(ZoneNum) * ITABSF(SurfNum)
END IF
! Radiations absorbed by the window layers coming from zone side
EQLNum = Construct(ConstrNum)%EQLConsPtr
DO Lay = 1, CFS(EQLNum)%NL
QRadSWwinAbs(SurfNum,Lay) = QRadSWwinAbs(SurfNum,Lay) &
+ QS(ZoneNum) * Construct(ConstrNum)%AbsDiffBackEQL(Lay)
END DO
! Window frame has not been included for equivalent layer model yet
END IF ! end if for IF ( SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
END IF ! End of opaque surface vs. window check
! OUTSIDE OF SURFACE CASES
IF (Surface(SurfNum)%ExtBoundCond > 0) THEN ! Interzone surface
IF (Construct(ConstrNum)%TransDiff > 0.0d0) THEN ! Interzone window
! Short-wave radiation absorbed in panes of corresponding window in adjacent zone
SurfNumAdjZone = Surface(SurfNum)%ExtBoundCond
IF (SurfaceWindow(SurfNumAdjZone)%WindowModelType /= WindowEQLModel) THEN
DO IGlass =1,TotGlassLayers
QRadSWwinAbs(SurfNumAdjZone,IGlass) = QRadSWwinAbs(SurfNumAdjZone,IGlass) + &
QS(ZoneNum) * Construct(Surface(SurfNumAdjZone)%Construction)%AbsDiff(IGlass)
! Note that AbsDiff rather than AbsDiffBack is used in the above since the
! radiation from the current zone is incident on the outside of the adjacent
! zone's window.
END DO
ELSE ! IF (SurfaceWindow(SurfNumAdjZone)%WindowModelType == WindowEQLModel) THEN
ConstrNum = Surface(SurfNumAdjZone)%Construction
EQLNum = Construct(ConstrNum)%EQLConsPtr
DO Lay = 1, CFS(EQLNum)%NL
QRadSWwinAbs(SurfNumAdjZone,Lay) = QRadSWwinAbs(SurfNumAdjZone,Lay) &
+ QS(ZoneNum) * Construct(ConstrNum)%AbsDiffFrontEQL(Lay)
! Note that AbsDiffFrontEQL rather than AbsDiffBackEQL is used in the above
! since the radiation from the current zone is incident on the outside of the
! adjacent zone's window.
END DO
ENDIF
END IF
ELSE IF(Construct(ConstrNum)%TransDiff <= 0.0d0) THEN ! Opaque exterior surface
! Calculate absorbed solar on outside if movable exterior insulation in place
HMovInsul = 0.0d0
IF (Surface(SurfNum)%MaterialMovInsulExt.GT.0) &
CALL EvalOutsideMovableInsulation(SurfNum,HMovInsul,RoughIndexMovInsul,AbsExt)
IF (HMovInsul > 0) THEN ! Movable outside insulation in place
QRadSWOutMvIns(SurfNum) = QRadSWOutAbs(SurfNum)*AbsExt &
/Material(Construct(ConstrNum)%LayerPoint(1))%AbsorpSolar
! For transparent insulation, allow some sunlight to get through the movable insulation.
! The equation below is derived by taking what is transmitted through the layer and applying
! the fraction that is absorbed plus the back reflected portion (first order reflection only)
! to the plane between the transparent insulation and the exterior surface face.
QRadSWOutAbs(SurfNum) = Material(Surface(SurfNum)%MaterialMovInsulExt)%Trans &
*QRadSWOutMvIns(SurfNum) &
*((Material(Construct(ConstrNum)%LayerPoint(1))%AbsorpSolar/AbsExt) &
+(1-Material(Construct(ConstrNum)%LayerPoint(1))%AbsorpSolar))
SWOutAbsTotalReport(SurfNum) = QRadSWOutAbs(SurfNum) * Surface(SurfNum)%Area
SWOutAbsEnergyReport(SurfNum) = SWOutAbsTotalReport(SurfNum) * SecInHour * TimeStepZone
END IF
END IF
END DO
! RJH 08/30/07 - Add InitialDifSolInAbs, InitialDifSolwinAbs, and InitialDifSolAbsByShade
! calced in CalcWinTransDifSolInitialDistribution to QRadSWInAbs, QRadSWwinAbs, and IntSWAbsByShade here
DO SurfNum = 1, TotSurfaces
ZoneNum = Surface(SurfNum)%Zone
IF (.NOT. Surface(SurfNum)%HeatTransSurf .OR. ZoneNum == 0) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) CYCLE ! Skip tubular daylighting device domes
ConstrNum = Surface(SurfNum)%Construction
IF(Construct(ConstrNum)%TransDiff <= 0.0d0) THEN ! Opaque surface
QRadSWInAbs(SurfNum) = QRadSWInAbs(SurfNum) + InitialDifSolInAbs(SurfNum)
ELSE ! Window
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowBSDFModel .AND. &
SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(SurfNum)%StormWinConstruction
ConstrNumSh = Surface(SurfNum)%StormWinShadedConstruction
END IF
TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
IF(ShadeFlag <= 0) THEN ! No window shading
DO IGlass = 1,TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
InitialDifSolwinAbs(SurfNum,IGlass)
END DO
ELSE IF(ShadeFlag == IntShadeOn .OR. ShadeFlag >= 3) THEN
! Interior, exterior or between-glass shade, screen or blind in place
DO IGlass = 1,Construct(ConstrNumSh)%TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + InitialDifSolwinAbs(SurfNum,IGlass)
END DO
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn .OR. ShadeFlag==ExtScreenOn) &
SurfaceWindow(SurfNum)%IntSWAbsByShade = SurfaceWindow(SurfNum)%IntSWAbsByShade &
+ SurfaceWindow(SurfNum)%InitialDifSolAbsByShade
IF(ShadeFlag==IntBlindOn .OR. ShadeFlag==ExtBlindOn .OR. ShadeFlag==BGBlindOn) THEN
SurfaceWindow(SurfNum)%IntSWAbsByShade = SurfaceWindow(SurfNum)%IntSWAbsByShade &
+ SurfaceWindow(SurfNum)%InitialDifSolAbsByShade
END IF
ELSE IF(ShadeFlag == SwitchableGlazing) THEN ! Switchable glazing
DO IGlass = 1,TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
InitialDifSolwinAbs(SurfNum,IGlass)
END DO
END IF ! End of shading flag check
ELSE IF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
DO IGlass = 1,TotGlassLayers
QRadSWwinAbs(SurfNum,IGlass) = QRadSWwinAbs(SurfNum,IGlass) + &
InitialDifSolwinAbs(SurfNum,IGlass)
END DO
ELSE IF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
!ConstrNum = Surface(SurfNum)%Construction
EQLNum = Construct(ConstrNum)%EQLConsPtr
DO Lay = 1, CFS(EQLNum)%NL
QRadSWwinAbs(SurfNum,Lay) = QRadSWwinAbs(SurfNum,Lay) &
+ InitialDifSolwinAbs(SurfNum,Lay)
END DO
ENDIF
END IF ! End of Opaque surface vs. Window check
END DO ! End of SurfNum loop to initialize SW Absorbed values with CalcWinTransDifSolInitialDistribution results
! RJH 09/07/07 - report variables for surface absorbed short wave radiation
DO SurfNum = 1, TotSurfaces
SWwinAbsTotalReport(SurfNum) = 0.0d0
SWInAbsTotalReport(SurfNum) = 0.0d0
InitialDifSolInAbsReport(SurfNum) = 0.0d0
InitialDifSolInTransReport(SurfNum) = 0.0d0
ZoneNum = Surface(SurfNum)%Zone
IF (.NOT. Surface(SurfNum)%HeatTransSurf .OR. ZoneNum == 0) CYCLE ! Skip non-heat transfer surfaces
IF (Surface(SurfNum)%Class == SurfaceClass_TDD_Dome) CYCLE ! Skip tubular daylighting device domes
ConstrNum = Surface(SurfNum)%Construction
IF(Construct(ConstrNum)%TransDiff <= 0.0d0) THEN ! Opaque surface
! Initial Transmitted Diffuse Solar Absorbed on Inside of Surface[W]
InitialDifSolInAbsReport(SurfNum) = InitialDifSolInAbs(SurfNum) * Surface(SurfNum)%Area
! Total Shortwave Radiation Absorbed on Inside of Surface[W]
SWInAbsTotalReport(SurfNum) = QRadSWInAbs(SurfNum) * Surface(SurfNum)%Area
ELSE ! Window
! Initial Transmitted Diffuse Solar Transmitted Through Inside of Surface[W]
InitialDifSolInTransReport(SurfNum) = InitialDifSolInTransReport(SurfNum) &
+ InitialDifSolInTrans(SurfNum) * Surface(SurfNum)%Area
IF (SurfaceWindow(SurfNum)%WindowModelType /= WindowEQLModel) THEN
ConstrNumSh = Surface(SurfNum)%ShadedConstruction
IF(SurfaceWindow(SurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(SurfNum)%StormWinConstruction
ConstrNumSh = Surface(SurfNum)%StormWinShadedConstruction
END IF
IF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
TotGlassLayers = Construct(ConstrNum)%TotSolidLayers
ELSE
TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
END IF
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
IF(ShadeFlag <= 0) THEN ! No window shading
DO IGlass = 1,TotGlassLayers
! Initial Transmitted Diffuse Solar Absorbed on Inside of Surface[W]
InitialDifSolInAbsReport(SurfNum) = InitialDifSolInAbsReport(SurfNum) &
+ InitialDifSolwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Radiation Absorbed on Inside of Surface[W]
SWInAbsTotalReport(SurfNum) = SWInAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Absorbed:All Glass Layers[W]
SWwinAbsTotalReport(SurfNum) = SWwinAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
END DO
ELSE IF(ShadeFlag == IntShadeOn .OR. ShadeFlag >= 3) THEN
! Interior, exterior or between-glass shade, screen or blind in place
DO IGlass = 1,Construct(ConstrNumSh)%TotGlassLayers
! Initial Transmitted Diffuse Solar Absorbed on Inside of Surface[W]
InitialDifSolInAbsReport(SurfNum) = InitialDifSolInAbsReport(SurfNum) &
+ InitialDifSolwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Radiation Absorbed on Inside of Surface[W]
SWInAbsTotalReport(SurfNum) = SWInAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Absorbed:All Glass Layers[W]
SWwinAbsTotalReport(SurfNum) = SWwinAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
END DO
ELSE IF(ShadeFlag == SwitchableGlazing) THEN ! Switchable glazing
DO IGlass = 1,TotGlassLayers
! Initial Transmitted Diffuse Solar Absorbed on Inside of Surface[W]
InitialDifSolInAbsReport(SurfNum) = InitialDifSolInAbsReport(SurfNum) &
+ InitialDifSolwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Radiation Absorbed on Inside of Surface[W]
SWInAbsTotalReport(SurfNum) = SWInAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
! Total Shortwave Absorbed:All Glass Layers[W]
SWwinAbsTotalReport(SurfNum) = SWwinAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,IGlass) * Surface(SurfNum)%Area
END DO
END IF ! End of shading flag check
ELSE !IF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
ConstrNum = Surface(SurfNum)%Construction
EQLNum = Construct(ConstrNum)%EQLConsPtr
DO Lay = 1, CFS(EQLNum)%NL
! Initial Transmitted Diffuse Solar Absorbed on Inside of Surface[W]
InitialDifSolInAbsReport(SurfNum) = InitialDifSolInAbsReport(SurfNum) &
+ InitialDifSolwinAbs(SurfNum,Lay) * Surface(SurfNum)%Area
! Total Shortwave Radiation Absorbed on Inside of Surface[W]
SWInAbsTotalReport(SurfNum) = SWInAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,Lay) * Surface(SurfNum)%Area
! Total Shortwave Absorbed:All solid Layers[W]
SWwinAbsTotalReport(SurfNum) = SWwinAbsTotalReport(SurfNum) &
+ QRadSWwinAbs(SurfNum,Lay) * Surface(SurfNum)%Area
END DO
ENDIF
END IF ! End of Opaque surface vs. Window check
END DO ! End of SurfNum loop to report variables for surface total absorbed short wave radiation
CALL DistributeTDDAbsorbedSolar()
RETURN
END SUBROUTINE InitIntSolarDistribution