SUBROUTINE CalcWinTransDifSolInitialDistribution
! SUBROUTINE INFORMATION:
! AUTHOR Rob Hitchcock
! DATE WRITTEN July 2007
! MODIFIED N/A
! RE-ENGINEERED N/A
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the initial distribution
! of diffuse solar transmitted through exterior windows
! to individual heat transfer surfaces in each zone.
! METHODOLOGY EMPLOYED:
! Apportions diffuse solar transmitted through each exterior window
! that is then absorbed, reflected, and/or transmitted
! by other heat transfer surfaces in the zone.
! Calculations use:
! 1. WinDifSolar calculated in SUBROUTINE CalcInteriorSolarDistribution,
! 2. view factors between each exterior window and
! other heat transfer surfaces in a zone
! calculated in SUBROUTINE CalcApproximateViewFactors, and
! 3. surface absorptances, reflectances, and transmittances
! determined here using revised code from SUBROUTINE InitIntSolarDistribution
! REFERENCES:
! USE STATEMENTS:
USE General, ONLY: InterpSw, InterpSlatAng
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataViewFactorInformation
USE DataHeatBalSurface, ONLY: InitialDifSolInAbs, InitialDifSolInTrans
USE DataHeatBalance, ONLY: InitialDifSolwinAbs, InitialZoneDifSolReflW
USE WindowEquivalentLayer, ONLY: CalcEQLOpticalProperty
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:
INTEGER :: ZoneNum ! DO loop counter for zones
INTEGER :: AdjZoneNum ! Index for adjacent zones
INTEGER :: AdjSurfNum ! Index for adjacent surfaces
INTEGER :: DifTransSurfNum ! Diffuse Solar Transmitting Surface number
INTEGER :: HeatTransSurfNum ! Heat Transfer Surface number
INTEGER :: ConstrNum ! Construction number
INTEGER :: AdjConstrNum ! Construction number of other side surface
INTEGER :: ConstrNumSh ! Shaded construction number
INTEGER :: IGlass ! Glass layer counter
INTEGER :: TotGlassLayers ! Number of glass layers in a window construction
INTEGER :: ShadeFlag ! Shading flag
REAL(r64) :: AbsInt ! Tmp var for Inside surface short-wave absorptance
REAL(r64) :: MovInsulSchedVal ! Value of the movable insulation schedule for current time
REAL(r64) :: HMovInsul ! Conductance of movable insulation
REAL(r64) :: InsideDifAbsorptance ! Inside diffuse solar absorptance of a surface
REAL(r64) :: InsideDifReflectance ! Inside diffuse solar reflectance of a surface
INTEGER :: BlNum ! Blind number
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) :: 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
REAL(r64) :: ViewFactor ! temp var for view factor
REAL(r64) :: ViewFactorTotal ! debug var for view factor total
REAL(r64) :: WinDifSolarTrans ! debug var for WinDifSolar() [W]
REAL(r64) :: WinDifSolarDistTotl ! debug var for window total distributed diffuse solar [W]
REAL(r64) :: WinDifSolarDistAbsorbedTotl ! debug var for individual exterior window total distributed
! diffuse solar absorbed [W]
REAL(r64) :: WinDifSolarDistReflectedTotl ! debug var for individual exterior window total distributed
! diffuse solar reflected [W]
REAL(r64) :: WinDifSolarDistTransmittedTotl ! debug var for individual exterior window total distributed
! diffuse solar transmitted [W]
REAL(r64) :: WinDifSolLayAbsW ! temp var for diffuse solar absorbed by individual glass layer [W]
REAL(r64) :: ZoneDifSolarTrans ! debug var for WinDifSolar() [W]
REAL(r64) :: ZoneDifSolarDistTotl ! debug var for zone total distributed diffuse solar [W]
REAL(r64) :: ZoneDifSolarDistAbsorbedTotl ! debug var for zone total distributed diffuse solar absorbed [W]
REAL(r64) :: ZoneDifSolarDistReflectedTotl ! debug var for zone total distributed diffuse solar reflected [W]
REAL(r64) :: ZoneDifSolarDistTransmittedTotl ! debug var for zone total distributed diffuse solar transmitted [W]
REAL(r64) :: DifSolarAbsW ! temp var for diffuse solar absorbed by surface [W]
REAL(r64) :: DifSolarAbs ! temp var for diffuse solar absorbed by surface [W/m2]
REAL(r64) :: DifSolarReflW ! temp var for diffuse solar reflected by surface [W]
REAL(r64) :: DifSolarTransW ! temp var for diffuse solar transmitted through interior window surface [W]
REAL(r64) :: ShBlDifSolarAbsW ! temp var for diffuse solar absorbed by shade/blind [W]
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
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
INTEGER :: EQLNum ! equivalent layer fenestration index
INTEGER :: Lay ! equivalent layer fenestration layer index
INTEGER :: FirstZoneSurf ! conversion index for ViewFactor
INTEGER :: LastZoneSurf ! debug
! Init accumulators for absorbed diffuse solar for all surfaces for later heat balance calcs
InitialDifSolInAbs = 0.0d0
InitialDifSolwinAbs = 0.0d0
! Init accumulator for total reflected diffuse solar within each zone for interreflection calcs
InitialZoneDifSolReflW = 0.0d0
! Init accumulator for transmitted diffuse solar for all surfaces for reporting
InitialDifSolInTrans = 0.0d0
! Loop over all zones doing initial distribution of diffuse solar to interior heat transfer surfaces
DO ZoneNum = 1, NumOfZones
! Init Zone accumulators for debugging
ZoneDifSolarTrans = 0.0d0
ZoneDifSolarDistAbsorbedTotl = 0.0d0
ZoneDifSolarDistReflectedTotl = 0.0d0
ZoneDifSolarDistTransmittedTotl = 0.0d0
! Loop over all diffuse solar transmitting surfaces (i.e., exterior windows and TDDs) in the current zone
FirstZoneSurf = Zone(ZoneNum)%SurfaceFirst
LastZoneSurf = Zone(ZoneNum)%SurfaceLast
DO DifTransSurfNum = Zone(ZoneNum)%SurfaceFirst, Zone(ZoneNum)%SurfaceLast
! Skip surfaces that are not exterior, except for TDD_Diffusers
IF (((Surface(DifTransSurfNum)%ExtBoundCond /= ExternalEnvironment) .AND. &
(Surface(DifTransSurfNum)%ExtBoundCond /= OtherSideCondModeledExt) ) &
.AND. SurfaceWindow(DifTransSurfNum)%OriginalClass /= SurfaceClass_TDD_Diffuser) CYCLE
! Do I need to do anything special for TDDs?
IF (SurfaceWindow(DifTransSurfNum)%OriginalClass == SurfaceClass_TDD_Diffuser) THEN
END IF
! Skip surfaces that are not exterior windows or TDD diffusers
IF(Surface(DifTransSurfNum)%Class /= SurfaceClass_Window .AND. &
SurfaceWindow(DifTransSurfNum)%OriginalClass /= SurfaceClass_TDD_Diffuser) CYCLE
!----------------------------------------------------------------------------------------------------------
! DISTRIBUTE TRANSMITTED DIFFUSE SOLAR THROUGH EXTERIOR WINDOWS AND TDDS TO INTERIOR HEAT TRANSFER SURFACES
!----------------------------------------------------------------------------------------------------------
! Init transmitted solar debug vars
ViewFactorTotal = 0.0d0
WinDifSolarTrans = WinDifSolar(DifTransSurfNum)
ZoneDifSolarTrans = ZoneDifSolarTrans + WinDifSolar(DifTransSurfNum)
! Init Exterior Window accumulators for debugging
WinDifSolarDistAbsorbedTotl = 0.0d0
WinDifSolarDistReflectedTotl = 0.0d0
WinDifSolarDistTransmittedTotl = 0.0d0
! Loop over all heat transfer surfaces in the current zone that might receive diffuse solar
DO HeatTransSurfNum = Zone(ZoneNum)%SurfaceFirst, Zone(ZoneNum)%SurfaceLast
! Skip surfaces that are not heat transfer surfaces
IF (.NOT.Surface(HeatTransSurfNum)%HeatTransSurf) CYCLE
! Skip tubular daylighting device domes
IF (Surface(HeatTransSurfNum)%Class == SurfaceClass_TDD_Dome) CYCLE
! View factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
ViewFactor = ZoneInfo(ZoneNum)%F(DifTransSurfNum-FirstZoneSurf+1, HeatTransSurfNum-FirstZoneSurf+1)
! debug ViewFactorTotal
ViewFactorTotal = ViewFactorTotal + ViewFactor ! debug
! Skip receiving surfaces with 0.0 view factor
IF (ViewFactor <= 0.0d0) CYCLE
! Calculate diffuse solar from current exterior window absorbed and reflected by current heat transfer surface
! And calculate transmitted diffuse solar to adjacent zones through interior windows
ConstrNum=Surface(HeatTransSurfNum)%Construction
IF (Construct(ConstrNum)%TransDiff <= 0.0d0) THEN ! Interior Opaque Surface
! Determine the inside (back) diffuse solar absorptance
! and reflectance of the current heat transfer surface
InsideDifAbsorptance = Construct(ConstrNum)%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(HeatTransSurfNum)%MaterialMovInsulInt.GT.0) THEN
MovInsulSchedVal = GetCurrentScheduleValue(Surface(HeatTransSurfNum)%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(HeatTransSurfNum)%MaterialMovInsulInt)%Resistance)
AbsInt = Material(Surface(HeatTransSurfNum)%MaterialMovInsulInt)%AbsorpSolar
END IF
END IF
IF (HMovInsul > 0.0d0) InsideDifAbsorptance = AbsInt ! Movable inside insulation present
! Inside (back) diffuse solar reflectance is assumed to be 1 - absorptance
InsideDifReflectance = 1.0d0 - InsideDifAbsorptance
! Absorbed diffuse solar [W] = current window transmitted diffuse solar [W]
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
! * current surface inside solar absorptance
DifSolarAbsW = WinDifSolar(DifTransSurfNum) & ! [W]
* ViewFactor &
* InsideDifAbsorptance
! Absorbed diffuse solar [W/m2] = Absorbed diffuse solar [W]
! / current surface net area
DifSolarAbs = DifSolarAbsW &
/ Surface(HeatTransSurfNum)%Area
! Accumulate absorbed diffuse solar [W/m2] on this surface for heat balance calcs
InitialDifSolInAbs(HeatTransSurfNum) = InitialDifSolInAbs(HeatTransSurfNum) &
+ DifSolarAbs
! Reflected diffuse solar [W] = current window transmitted diffuse solar
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
! * current window inside solar reflectance
DifSolarReflW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
* InsideDifReflectance
! Accumulate total reflected distributed diffuse solar for each zone for subsequent interreflection calcs
InitialZoneDifSolReflW(ZoneNum) = InitialZoneDifSolReflW(ZoneNum) &
+ DifSolarReflW ! [W]
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
! For opaque surfaces all incident diffuse is either absorbed or reflected
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + DifSolarAbsW ! debug [W]
WinDifSolarDistReflectedTotl = WinDifSolarDistReflectedTotl + DifSolarReflW ! debug [W]
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + DifSolarAbsW ! debug [W]
ZoneDifSolarDistReflectedTotl = ZoneDifSolarDistReflectedTotl + DifSolarReflW ! debug [W]
ELSE ! Exterior or Interior Window
ConstrNumSh = Surface(HeatTransSurfNum)%ShadedConstruction
IF(SurfaceWindow(HeatTransSurfNum)%StormWinFlag==1) THEN
ConstrNum = Surface(HeatTransSurfNum)%StormWinConstruction
ConstrNumSh = Surface(HeatTransSurfNum)%StormWinShadedConstruction
END IF
TotGlassLayers = Construct(ConstrNum)%TotGlassLayers
ShadeFlag = SurfaceWindow(HeatTransSurfNum)%ShadingFlag
IF (SurfaceWindow(HeatTransSurfNum)%WindowModelType /= WindowEQLModel) THEN
IF(ShadeFlag <= 0) THEN ! No window shading
! Init accumulator for transmittance calc below
DifSolarAbsW = 0.0d0
! Calc diffuse solar absorbed by all window glass layers
! Note: I am assuming here that individual glass layer absorptances have been corrected
! to account for layer by layer transmittance and reflection effects.
DO IGlass = 1, TotGlassLayers
! Calc diffuse solar absorbed from the inside by each window glass layer [W]
AbsInt = Construct(ConstrNum)%AbsDiffBack(IGlass)
WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * Construct(ConstrNum)%AbsDiffBack(IGlass)
! Accumulate distributed diffuse solar absorbed [W] by overall window for transmittance calc below
DifSolarAbsW = DifSolarAbsW + WinDifSolLayAbsW
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
! Accumulate diffuse solar absorbed from the inside by each window glass layer [W/m2] for heat balance calcs
InitialDifSolwinAbs(HeatTransSurfNum,IGlass) = InitialDifSolwinAbs(HeatTransSurfNum,IGlass) &
+ (WinDifSolLayAbsW &
/ Surface(HeatTransSurfNum)%Area)
END DO
! Calc diffuse solar reflected back to zone
! I don't really care if this is a window or opaque surface since I am just
! accumulating all reflected diffuse solar in a zone bucket for "interreflected" distribution
! Reflected diffuse solar [W] = current window transmitted diffuse solar
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
! * current window inside solar reflectance
InsideDifReflectance = Construct(ConstrNum)%ReflectSolDiffBack
DifSolarReflW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
* Construct(ConstrNum)%ReflectSolDiffBack
! Accumulate total reflected distributed diffuse solar for each zone for subsequent interreflection calcs
InitialZoneDifSolReflW(ZoneNum) = InitialZoneDifSolReflW(ZoneNum) &
+ DifSolarReflW ! [W]
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistReflectedTotl = WinDifSolarDistReflectedTotl + DifSolarReflW ! debug
ZoneDifSolarDistReflectedTotl = ZoneDifSolarDistReflectedTotl + DifSolarReflW ! debug
!------------------------------------------------------------------------------
! DISTRIBUTE TRANSMITTED DIFFUSE SOLAR THROUGH INTERIOR WINDOW TO ADJACENT ZONE
!------------------------------------------------------------------------------
! If this receiving window surface (HeatTransSurfNum) is an interior window,
! calc distributed solar transmitted to adjacent zone [W]
! NOTE: This calc is here because interior windows are currently assumed to have no shading
! Get the adjacent surface number for this receiving window surface
AdjSurfNum = Surface(HeatTransSurfNum)%ExtBoundCond
! If the adjacent surface number is > 0, this is an interior window
IF(AdjSurfNum > 0) THEN ! this is an interior window surface
! Calc diffuse solar from current exterior window
! transmitted through this interior window to adjacent zone [W]
! Transmitted diffuse solar [W] = current exterior window transmitted diffuse solar
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
! - diffuse absorbed by this interior window
! - diffuse reflected by this interior window
DifSolarTransW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
- DifSolarAbsW &
- DifSolarReflW
! HERE 8/15/07 Note Construct(AdjConstrNum)%TransDiff could be used here since the "front" transmittance for an interior window
! in the adjacent zone is the correct direction as long as I use the Construct() of the Surface in the adjacent zone.
! However, the above calculation better conserves energy, although possibly at the expense of less accurate
! transmittance calcs.
! Preliminary tests showed fairly good agreement between the two DifSolarTransW calculation methods,
! but for consistency I stuck with the above.
AdjConstrNum=Surface(AdjSurfNum)%Construction
! DifSolarTransW = WinDifSolar(DifTransSurfNum) &
! * ViewFactor &
! * Construct(AdjConstrNum)%TransDiff
! Get the adjacent zone index
AdjZoneNum = Surface(AdjSurfNum)%Zone
! Call routine to distribute diffuse solar transmitted through this interior window into adjacent zone
CALL CalcInteriorWinTransDifSolInitialDistribution(AdjZoneNum, AdjSurfNum, DifSolarTransW)
ELSE ! this is an exterior window surface
! Calc transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
! This is not very effective since it assigns whatever distributed diffuse solar has not been
! absorbed or reflected to transmitted.
DifSolarTransW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
- DifSolarAbsW &
- DifSolarReflW
END IF ! this is an interior window surface
! Accumulate transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistTransmittedTotl = WinDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
ZoneDifSolarDistTransmittedTotl = ZoneDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
! Accumulate transmitted diffuse solar for reporting
InitialDifSolInTrans(HeatTransSurfNum) = InitialDifSolInTrans(HeatTransSurfNum) &
+ (DifSolarTransW &
/ Surface(HeatTransSurfNum)%Area)
ELSE IF(ShadeFlag == IntShadeOn .OR. ShadeFlag >= 3) THEN
! Interior, exterior or between-glass shade, screen or blind in place
! Init accumulator for transmittance calc below
DifSolarAbsW = 0.0d0
WinDifSolLayAbsW = 0.0d0
! First calc diffuse solar absorbed by each glass layer in this window with shade/blind in place
DO IGlass = 1,Construct(ConstrNumSh)%TotGlassLayers
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn .OR. ShadeFlag==ExtScreenOn) THEN
! Calc diffuse solar absorbed in each window glass layer and shade
WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * Construct(ConstrNumSh)%AbsDiffBack(IGlass)
END IF
IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == BGBlindOn) THEN
BlAbsDiffBk = InterpSlatAng(SurfaceWindow(HeatTransSurfNum)%SlatAngThisTS, &
SurfaceWindow(HeatTransSurfNum)%MovableSlats, &
Construct(ConstrNumSh)%BlAbsDiffBack(IGlass,1:MaxSlatAngs))
! Calc diffuse solar absorbed in each window glass layer and shade
WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * BlAbsDiffBk
END IF
! Accumulate distributed diffuse solar absorbed [W] by overall window for transmittance calc below
DifSolarAbsW = DifSolarAbsW + WinDifSolLayAbsW
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
! Accumulate diffuse solar absorbed from the inside by each window glass layer [W/m2] for heat balance calcs
InitialDifSolwinAbs(HeatTransSurfNum,IGlass) = InitialDifSolwinAbs(HeatTransSurfNum,IGlass) &
+ (WinDifSolLayAbsW &
/ Surface(HeatTransSurfNum)%Area)
END DO
! Next calc diffuse solar reflected back to zone from window with shade or blind on
! Diffuse back solar reflectance, bare glass or shade on
InsideDifReflectance = Construct(ConstrNum)%ReflectSolDiffBack
IF(ShadeFlag == IntBlindOn .OR. ShadeFlag == ExtBlindOn) THEN
! Diffuse back solar reflectance, blind present, vs. slat angle
InsideDifReflectance = InterpSlatAng(SurfaceWindow(HeatTransSurfNum)%SlatAngThisTS, &
SurfaceWindow(HeatTransSurfNum)%MovableSlats, &
Construct(ConstrNum)%BlReflectSolDiffBack)
END IF
DifSolarReflW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
* InsideDifReflectance
! Accumulate total reflected distributed diffuse solar for each zone for subsequent interreflection calcs
InitialZoneDifSolReflW(ZoneNum) = InitialZoneDifSolReflW(ZoneNum) &
+ DifSolarReflW ! [W]
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistReflectedTotl = WinDifSolarDistReflectedTotl + DifSolarReflW ! debug
ZoneDifSolarDistReflectedTotl = ZoneDifSolarDistReflectedTotl + DifSolarReflW ! debug
! Now calc diffuse solar absorbed by shade/blind itself
BlNum = SurfaceWindow(HeatTransSurfNum)%BlindNumber
IF(ShadeFlag==IntShadeOn .OR. ShadeFlag==ExtShadeOn .OR. ShadeFlag==BGShadeOn .OR. ShadeFlag==ExtScreenOn) THEN
! Calc diffuse solar absorbed by shade or screen [W]
ShBlDifSolarAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * Construct(ConstrNumSh)%AbsDiffBackShade
END IF
IF(ShadeFlag==IntBlindOn .OR. ShadeFlag==ExtBlindOn .OR. ShadeFlag==BGBlindOn) THEN
! Calc diffuse solar absorbed by blind [W]
AbsDiffBkBl = InterpSlatAng(SurfaceWindow(HeatTransSurfNum)%SlatAngThisTS, &
SurfaceWindow(HeatTransSurfNum)%MovableSlats, &
Construct(ConstrNumSh)%AbsDiffBackBlind)
ShBlDifSolarAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * AbsDiffBkBl
END IF
! Correct for divider shadowing
IF(ShadeFlag == ExtShadeOn.OR.ShadeFlag == ExtBlindOn.OR.ShadeFlag == ExtScreenOn) &
ShBlDifSolarAbsW = ShBlDifSolarAbsW * SurfaceWindow(HeatTransSurfNum)%GlazedFrac
! Accumulate diffuse solar absorbed by shade or screen [W/m2] for heat balance calcs
SurfaceWindow(HeatTransSurfNum)%InitialDifSolAbsByShade = SurfaceWindow(HeatTransSurfNum)%InitialDifSolAbsByShade &
+ (ShBlDifSolarAbsW / Surface(HeatTransSurfNum)%Area)
! Accumulate distributed diffuse solar absorbed [W] by overall window for transmittance calc below
DifSolarAbsW = DifSolarAbsW + ShBlDifSolarAbsW
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + ShBlDifSolarAbsW ! debug
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + ShBlDifSolarAbsW ! debug
! Accumulate transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
! This is not very effective since it assigns whatever distributed diffuse solar has not been
! absorbed or reflected to transmitted.
DifSolarTransW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
- DifSolarAbsW &
- DifSolarReflW
WinDifSolarDistTransmittedTotl = WinDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
ZoneDifSolarDistTransmittedTotl = ZoneDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
! Accumulate transmitted diffuse solar for reporting
InitialDifSolInTrans(HeatTransSurfNum) = InitialDifSolInTrans(HeatTransSurfNum) &
+ (DifSolarTransW &
/ Surface(HeatTransSurfNum)%Area)
ELSE IF(ShadeFlag == SwitchableGlazing) THEN ! Switchable glazing
! Init accumulator for transmittance calc below
DifSolarAbsW = 0.0d0
DO IGlass = 1,TotGlassLayers
! Calc diffuse solar absorbed in each window glass layer
WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor &
* InterpSw(SurfaceWindow(HeatTransSurfNum)%SwitchingFactor, &
Construct(ConstrNum)%AbsDiffBack(IGlass), &
Construct(ConstrNumSh)%AbsDiffBack(IGlass))
! Accumulate distributed diffuse solar absorbed [W] by overall window for transmittance calc below
DifSolarAbsW = DifSolarAbsW + WinDifSolLayAbsW
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
! Accumulate diffuse solar absorbed from the inside by each window glass layer [W/m2] for heat balance calcs
InitialDifSolwinAbs(HeatTransSurfNum,IGlass) = InitialDifSolwinAbs(HeatTransSurfNum,IGlass) &
+ (WinDifSolLayAbsW &
/ Surface(HeatTransSurfNum)%Area)
END DO
! Calc diffuse solar reflected back to zone
DifSolarReflW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
* InterpSw(SurfaceWindow(HeatTransSurfNum)%SwitchingFactor, &
Construct(ConstrNum)%ReflectSolDiffBack, &
Construct(ConstrNumSh)%ReflectSolDiffBack)
! Accumulate total reflected distributed diffuse solar for each zone for subsequent interreflection calcs
InitialZoneDifSolReflW(ZoneNum) = InitialZoneDifSolReflW(ZoneNum) &
+ DifSolarReflW ! [W]
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistReflectedTotl = WinDifSolarDistReflectedTotl + DifSolarReflW ! debug
ZoneDifSolarDistReflectedTotl = ZoneDifSolarDistReflectedTotl + DifSolarReflW ! debug
! Accumulate transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
! This is not very effective since it assigns whatever distributed diffuse solar has not been
! absorbed or reflected to transmitted.
DifSolarTransW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
- DifSolarAbsW &
- DifSolarReflW
WinDifSolarDistTransmittedTotl = WinDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
ZoneDifSolarDistTransmittedTotl = ZoneDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
! Accumulate transmitted diffuse solar for reporting
InitialDifSolInTrans(HeatTransSurfNum) = InitialDifSolInTrans(HeatTransSurfNum) &
+ (DifSolarTransW &
/ Surface(HeatTransSurfNum)%Area)
END IF ! End of shading flag check
ELSE
! SurfaceWindow(HeatTransSurfNum)%WindowModelType == WindowEQLModel
! ConstrNum=Surface(HeatTransSurfNum)%Construction
! call the ASHWAT fenestration model for diffuse radiation here
CALL CalcEQLOpticalProperty(HeatTransSurfNum, isDIFF, AbsSolDiffBackEQL)
EQLNum = Construct(ConstrNum)%EQLConsPtr
DO Lay = 1, CFS(EQLNum)%NL
! Calc diffuse solar absorbed from the inside by each layer of EQL model [W]
!WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * Construct(ConstrNum)%AbsDiffBack(Lay)
WinDifSolLayAbsW = WinDifSolar(DifTransSurfNum)* ViewFactor * AbsSolDiffBackEQL(Lay,2)
! Accumulate distributed diffuse solar absorbed [W] by overall window for transmittance calc below
DifSolarAbsW = DifSolarAbsW + WinDifSolLayAbsW
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistAbsorbedTotl = WinDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
ZoneDifSolarDistAbsorbedTotl = ZoneDifSolarDistAbsorbedTotl + WinDifSolLayAbsW ! debug
! Accumulate diffuse solar absorbed from the inside by each window layer [W/m2] for heat balance calcs
InitialDifSolwinAbs(HeatTransSurfNum,Lay) = InitialDifSolwinAbs(HeatTransSurfNum,Lay) &
+ (WinDifSolLayAbsW &
/ Surface(HeatTransSurfNum)%Area)
! ASHWAT equivalent layer model may require not the individual layer absorption but the flux
! InitialDifSolwinEQL(HeatTransSurfNum) = WinDifSolar(DifTransSurfNum)* ViewFactor
END DO
! Calc diffuse solar reflected back to zone
! I don't really care if this is a window or opaque surface since I am just
! accumulating all reflected diffuse solar in a zone bucket for "interreflected" distribution
! Reflected diffuse solar [W] = current window transmitted diffuse solar
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
! * current window inside solar reflectance
InsideDifReflectance = Construct(ConstrNum)%ReflectSolDiffBack
DifSolarReflW = WinDifSolar(DifTransSurfNum) &
* ViewFactor &
* Construct(ConstrNum)%ReflectSolDiffBack
! Accumulate total reflected distributed diffuse solar for each zone for subsequent interreflection calcs
InitialZoneDifSolReflW(ZoneNum) = InitialZoneDifSolReflW(ZoneNum) &
+ DifSolarReflW ! [W]
! Accumulate Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistReflectedTotl = WinDifSolarDistReflectedTotl + DifSolarReflW ! debug
ZoneDifSolarDistReflectedTotl = ZoneDifSolarDistReflectedTotl + DifSolarReflW ! debug
!------------------------------------------------------------------------------
! DISTRIBUTE TRANSMITTED DIFFUSE SOLAR THROUGH INTERIOR WINDOW TO ADJACENT ZONE
!------------------------------------------------------------------------------
! If this receiving window surface (HeatTransSurfNum) is an interior window,
! calc distributed solar transmitted to adjacent zone [W]
! NOTE: This calc is here because interior windows are currently assumed to have no shading
! Get the adjacent surface number for this receiving window surface
AdjSurfNum = Surface(HeatTransSurfNum)%ExtBoundCond
! If the adjacent surface number is > 0, this is an interior window
IF(AdjSurfNum > 0) THEN ! this is an interior window surface
! Calc diffuse solar from current exterior window
! transmitted through this interior window to adjacent zone [W]
! Transmitted diffuse solar [W] = current exterior window transmitted diffuse solar
! * view factor from current (sending) window DifTransSurfNum to current (receiving) surface HeatTransSurfNum
DifSolarTransW = AbsSolDiffBackEQL(CFS(EQLNum)%NL+1,2) * ViewFactor
AdjConstrNum=Surface(AdjSurfNum)%Construction
! Get the adjacent zone index
AdjZoneNum = Surface(AdjSurfNum)%Zone
! Call routine to distribute diffuse solar transmitted through this interior window into adjacent zone
CALL CalcInteriorWinTransDifSolInitialDistribution(AdjZoneNum, AdjSurfNum, DifSolarTransW)
ELSE ! this is an exterior window surface
! Calc transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
! This is not very effective since it assigns whatever distributed diffuse solar has not been
! absorbed or reflected to transmitted.
DifSolarTransW = AbsSolDiffBackEQL(CFS(EQLNum)%NL+1,2) * ViewFactor
END IF ! this is an interior window surface
! Accumulate transmitted Window and Zone total distributed diffuse solar to check for conservation of energy
WinDifSolarDistTransmittedTotl = WinDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
ZoneDifSolarDistTransmittedTotl = ZoneDifSolarDistTransmittedTotl + DifSolarTransW ! debug [W]
! Accumulate transmitted diffuse solar for reporting
InitialDifSolInTrans(HeatTransSurfNum) = InitialDifSolInTrans(HeatTransSurfNum) &
+ (DifSolarTransW &
/ Surface(HeatTransSurfNum)%Area)
END IF !IF (SurfaceWindow(HeatTransSurfNum)%WindowModelType /= WindowEQLModel) THEN
! HERE 8/14/07 Ignore absorptance and reflectance of Frames and Dividers for now.
! I would need revised view factors that included these surface types.
! By ignoring them here, the diffuse solar is accounted for on the other surfaces
! IF(SurfaceWindow(HeatTransSurfNum)%FrameArea > 0.0) THEN ! Window has a frame
! Note that FrameQRadInAbs is initially calculated in InitSolarHeatGains
! END IF
! IF(SurfaceWindow(HeatTransSurfNum)%DividerArea > 0.0) THEN ! Window has dividers
! DividerSolAbs = SurfaceWindow(HeatTransSurfNum)%DividerSolAbsorp
! IF(SurfaceWindow(HeatTransSurfNum)%DividerType == Suspended) THEN ! Suspended divider; account for inside glass
! MatNumGl = Construct(ConstrNum)%LayerPoint(Construct(ConstrNum)%TotLayers)
! TransGl = Material(MatNumGl)%Trans
! ReflGl = Material(MatNumGl)%ReflectSolDiffBack
! AbsGl = 1.-TransGl-ReflGl
! DividerSolRefl = 1.-DividerSolAbs
! DividerSolAbs = AbsGl + TransGl*(DividerSolAbs + DividerSolRefl*AbsGl)/(1.-DividerSolRefl*ReflGl)
! END IF
! Correct for interior shade transmittance
! IF(ShadeFlag == IntShadeOn) THEN
! MatNumSh = Construct(ConstrNumSh)%LayerPoint(Construct(ConstrNumSh)%TotLayers)
! DividerSolAbs = DividerSolAbs * Material(MatNumSh)%Trans
! ELSE IF(ShadeFlag == IntBlindOn) THEN
! DividerSolAbs = DividerSolAbs * InterpSlatAng(SurfaceWindow(HeatTransSurfNum)%SlatAngThisTS, &
! SurfaceWindow(HeatTransSurfNum)%MovableSlats,Blind(BlNum)%SolBackDiffDiffTrans)
! END IF
! Note that DividerQRadInAbs is initially calculated in InitSolarHeatGains
! END IF ! Window has dividers
END IF ! opaque or window heat transfer surface
END DO ! HeatTransSurfNum = Zone(ZoneNum)%SurfaceFirst, Zone(ZoneNum)%SurfaceLast
! Check debug var for view factors here
! ViewFactorTotal
! Check debug vars for individual transmitting surfaces here
WinDifSolarDistTotl = WinDifSolarDistAbsorbedTotl + WinDifSolarDistReflectedTotl + WinDifSolarDistTransmittedTotl
! WinDifSolarTrans
END DO ! DifTransSurfNum = Zone(ZoneNum)%SurfaceFirst, Zone(ZoneNum)%SurfaceLast
! Check debug vars for zone totals here
ZoneDifSolarDistTotl = ZoneDifSolarDistAbsorbedTotl + ZoneDifSolarDistReflectedTotl + ZoneDifSolarDistTransmittedTotl
! ZoneDifSolarTrans
! ZoneDifSolarDistAbsorbedTotl
! ZoneDifSolarDistReflectedTotl
! ZoneDifSolarDistTransmittedTotl
! CALL DisplayString('Diffuse Solar Distribution Zone Totals')
END DO ! ZoneNum = 1, NumOfZones
RETURN
END SUBROUTINE CalcWinTransDifSolInitialDistribution