SUBROUTINE CalcWindowHeatBalance (SurfNum,HextConvCoeff,SurfInsideTemp,SurfOutsideTemp)
! SUBROUTINE INFORMATION:
! AUTHOR F. Winkelmann
! DATE WRITTEN November 1999
! MODIFIED FW, July 2000 (call better solution method)
! FW, June 2001 (handle window blinds)
! FW, Dec 2002 (add between-glass shades and blinds)
! FW, Mar 2003 (extend condensation flag to airflow windows)
! CC, Jul 2003 (set the reference temperatures for inside surface heat balance
! depending on convection algorithms and/or air models used)
! FW, Sep 2003 (increment ZoneWinHeatGain only for exterior windows)
! RR, May 2006 (add exterior window screen)
! TH, Dec 2008 (add thermochromic windows)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Sets up information needed to calculate the window thermal behavior.
! Calls SolveForWindowTemperatures, which calculates the inside and outside
! face temperature of each glass layer by solving the heat balance
! equations on each face. Also calls CalcWinFrameAndDividerTemps,
! which calculates the outside and inside face temperatures of the
! window frame and divider if either of these are present.
! The resulting inside face temperature of the inner glass pane and the
! inside surface temperatures of frame and divider are used in the zone
! heat balance calculation. The inside face temperature of an interior shade
! or blind, if present, and the natural convection air flow between the
! shade/blind and inside glass face also appear in the zone heat balance calculation.
!
! The logical variable NRSolution is currently set to false, which means
! that the Newton-Raphson solution method for the glass layer heat balance
! is not used (because it sometimes didn't converge for 3- and 4-pane
! constructions with one or more low-emissivity layers). Instead, a more
! robust solution method is used that successively solves linearized heat
! balance equations until convergence is reached (see SolveForWindowTemperatures).
!
! CalcWindowHeatBalance is called by CalcHeatBalanceInsideSurface once each
! time step for each window.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
USE DataBSDFWindow
USE General, ONLY: InterpSlatAng ! Function for slat angle interpolation
USE DataZoneEquipment, ONLY : ZoneEquipConfig
USE DataLoopNode, ONLY : Node
USE Psychrometrics, ONLY:PsyCpAirFnWTdb,PsyTdpFnWPb
USE DataHeatBalSurface , ONLY : QConvOutReport,QdotConvOutRep,QdotConvOutRepPerArea,&
QRadOutReport, QdotRadOutRep, QdotRadOutRepPerArea
!unused0909 USE DataEnvironment, ONLY: CurMnDyHr
USE InputProcessor, ONLY: SameString
USE WindowComplexManager, ONLY: CalcComplexWindowThermal
USE WindowEquivalentLayer, ONLY: EQLWindowSurfaceHeatBalance
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum ! Surface number
REAL(r64), INTENT(IN) :: HextConvCoeff ! Outside air film conductance coefficient
REAL(r64), INTENT(INOUT) :: SurfInsideTemp ! Inside window surface temperature
REAL(r64), INTENT(INOUT) :: SurfOutsideTemp ! Outside surface temperature (C)
! (temperature of innermost face) [C]
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum ! Zone number corresponding to SurfNum
INTEGER :: BlNum ! Window blind number
INTEGER :: SurfNumAdj ! An interzone surface's number in the adjacent zone
INTEGER :: ZoneNumAdj ! An interzone surface's adjacent zone number
INTEGER :: ConstrNum ! Construction number
!!unused INTEGER :: ConstrNumSh ! Shaded construction number
INTEGER :: IConst ! Construction number
INTEGER :: TotLay ! Total number of layers in a construction
! (sum of solid layers and gap layers)
INTEGER :: TotGlassLay ! Total number of glass layers in a construction
INTEGER :: Lay ! Layer number
INTEGER :: LayPtr ! Material number for a layer
INTEGER :: IGlass ! glass layer number (1,2,3,...)
INTEGER :: IGap ! Gap layer number (1,2,...)
INTEGER :: IMix ! Gas number in a mixture of gases
INTEGER :: ICoeff ! Gas property index (1,2,3)
INTEGER :: ShadeFlag ! Flag indicating whether shade or blind is on, and shade/blind position
INTEGER :: k ! Layer counter
!REAL(r64) :: tsky ! Sky temperature [K]
INTEGER :: ShadeLayPtr ! Material number corresponding to a shade layer
REAL(r64) :: dth1,dth2,dth3,dth4 ! Temperature difference across glass layers [K]
REAL(r64) :: EffShBlEmiss ! Effective interior shade or blind emissivity
REAL(r64) :: EffGlEmiss ! Effective inside glass emissivity when interior shade or blind
REAL(r64) :: RoomHumRat ! Room air humidity ratio
REAL(r64) :: RoomDewPoint ! Room air dewpoint temperature (C)
REAL(r64) :: InsideGlassTemp ! Temperature of room side of innermost glass layer (C)
REAL(r64) :: Tleft, Tright ! For airflow windows, temperature of the glass faces adjacent
! to the airflow gap (C)
INTEGER :: ZoneEquipConfigNum
INTEGER :: NodeNum
REAL(r64) :: SumSysMCp ! Zone sum of air system MassFlowRate*Cp
REAL(r64) :: SumSysMCpT ! Zone sum of air system MassFlowRate*Cp*T
REAL(r64) :: MassFlowRate
REAL(r64) :: NodeTemp
REAL(r64) :: CpAir
REAL(r64) :: RefAirTemp ! reference air temperatures
! New variables for thermochromic windows calc
REAL(r64) :: locTCSpecTemp ! The temperature corresponding to the specified optical properties of the TC layer
REAL(r64) :: locTCLayerTemp ! TC layer temperature at each time step. C
LOGICAL :: locTCFlag =.False. ! True if this surface is a TC window
REAL(r64) :: deltaTemp(100) = 0.0d0
INTEGER :: i
INTEGER :: iMinDT(1) = 0
INTEGER :: IDConst(100) = 0
REAL(r64) :: dT0 = 0.0d0
REAL(r64) :: dT1 = 0.0d0
REAL(r64) :: SurfOutsideEmiss ! temporary for result of outside surface emissivity
REAL(r64) :: Tsout ! temporary for result of outside surface temp in Kelvin
!integer :: CurrentThermalAlgorithm
integer :: CurrentThermalModelNumber
integer :: temp
!CurrentThermalAlgorithm = -1
IF (KickoffSizing .or. KickOffSimulation) RETURN
IF (SurfaceWindow(SurfNum)%WindowModelType == WindowBSDFModel) THEN
temp = 0
!Simon: Complex fenestration state works only with tarcog
CALL CalcComplexWindowThermal(SurfNum,temp,HextConvCoeff,SurfInsideTemp,SurfOutsideTemp,SurfOutsideEmiss,noCondition)
ConstrNum = Surface(SurfNum)%Construction
TotGlassLay = Construct(ConstrNum)%TotGlassLayers
ngllayer = Construct(ConstrNum)%TotSolidLayers ! Simon: This is necessary to keep for frame calculations
! Simon: need to transfer surface temperatures because of frames calculation
DO i = 1, 2*Construct(ConstrNum)%TotSolidLayers
thetas(i) = SurfaceWindow(SurfNum)%ThetaFace(i)
END DO
hcout = HextConvCoeff
! This is code repeating and it is necessary to calculate report variables. Do not know
! how to solve this in more elegant way :(
IF(Surface(SurfNum)%ExtWind) THEN ! Window is exposed to wind (and possibly rain)
IF(IsRain) THEN ! Raining: since wind exposed, outside window surface gets wet
tout = Surface(SurfNum)%OutWetBulbTemp + TKelvin
ELSE ! Dry
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
ELSE ! Window not exposed to wind
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
ELSEIF (SurfaceWindow(SurfNum)%WindowModelType == WindowEQLModel) THEN
CALL EQLWindowSurfaceHeatBalance( SurfNum, HextConvCoeff,SurfInsideTemp,SurfOutsideTemp,SurfOutsideEmiss,noCondition)
hcout = HextConvCoeff
! Required for report variables calculations.
IF(Surface(SurfNum)%ExtWind) THEN ! Window is exposed to wind (and possibly rain)
IF(IsRain) THEN ! Raining: since wind exposed, outside window surface gets wet
tout = Surface(SurfNum)%OutWetBulbTemp + TKelvin
ELSE ! Dry
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
ELSE ! Window not exposed to wind
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
ELSE ! regular window, not BSDF, not EQL Window
ConstrNum = Surface(SurfNum)%Construction
IF(SurfaceWindow(SurfNum)%StormWinFlag > 0) ConstrNum = Surface(SurfNum)%StormWinConstruction
! Added for thermochromic windows
locTCFlag = (Construct(ConstrNum)%TCFlag == 1)
IF (locTCFlag) THEN
locTCSpecTemp = Material(Construct(ConstrNum)%TCLayer)%SpecTemp
SurfaceWindow(SurfNum)%SpecTemp = locTCSpecTemp
! Check to see whether needs to switch to a new TC window construction
locTCLayerTemp = SurfaceWindow(SurfNum)%TCLayerTemp
dT0 = ABS(locTCLayerTemp-locTCSpecTemp)
IF (dT0 >= 1) THEN
! Find the TC construction that is closed to the TCLayerTemp
i = 0
deltaTemp = 0.0d0
IDConst = 0
DO k=1, TotConstructs
IF (Construct(k)%TCMasterConst == Construct(ConstrNum)%TCMasterConst) THEN
dT1 = ABS(locTCLayerTemp - Material(Construct(k)%TCLayer)%SpecTemp)
IF (dT1 < dT0) THEN
i = i + 1
deltaTemp(i) = dT1
IDConst(i) = k
ENDIF
ENDIF
ENDDO
IF (i >= 1) THEN
! Find the closest item
iMinDT = MINLOC(deltaTemp, MASK = deltaTemp.GT.0.0d0)
! Use the new TC window construction
ConstrNum = IDConst(iMinDT(1))
Surface(SurfNum)%Construction = ConstrNum
SurfaceWindow(SurfNum)%SpecTemp = Material(Construct(ConstrNum)%TCLayer)%SpecTemp
ENDIF
ENDIF
ENDIF
! end new TC code
ZoneNum = Surface(SurfNum)%Zone
TotLay = Construct(ConstrNum)%TotLayers
TotGlassLay = Construct(ConstrNum)%TotGlassLayers
ngllayer = TotGlassLay
nglface = 2*ngllayer
ShadeFlag = SurfaceWindow(SurfNum)%ShadingFlag
tilt = Surface(SurfNum)%Tilt
tiltr = tilt * DegToRadians
SurfNumAdj = Surface(SurfNum)%ExtBoundCond
hcin = HConvIn(SurfNum) ! Room-side surface convective film conductance
! determine reference air temperature for this surface
SELECT CASE (Surface(SurfNum)%TAirRef)
CASE (ZoneMeanAirTemp)
RefAirTemp = MAT(ZoneNum)
TempEffBulkAir(SurfNum) = RefAirTemp
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNum)
CASE (ZoneSupplyAirTemp)
! determine ZoneEquipConfigNum for this zone
! ControlledZoneAirFlag = .FALSE.
ZoneEquipConfigNum = ZoneNum
! DO ZoneEquipConfigNum = 1, NumOfControlledZones
! IF (ZoneEquipConfig(ZoneEquipConfigNum)%ActualZoneNum /= ZoneNum) CYCLE
! ControlledZoneAirFlag = .TRUE.
! EXIT
! END DO ! ZoneEquipConfigNum
! check whether this zone is a controlled zone or not
IF (.NOT. Zone(ZoneNum)%IsControlled) THEN
CALL ShowFatalError('Zones must be controlled for Ceiling-Diffuser Convection model. No system serves zone '// &
TRIM(Zone(ZoneNum)%Name))
RETURN
END IF
! determine supply air conditions
SumSysMCp = 0.0d0
SumSysMCpT = 0.0d0
DO NodeNum = 1, ZoneEquipConfig(ZoneEquipConfigNum)%NumInletNodes
NodeTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp,'CalcWindowHeatBalance')
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO
! a weighted average of the inlet temperatures.
IF (SumSysMCp > 0.0d0) THEN
RefAirTemp = SumSysMCpT/SumSysMCp
ELSE
RefAirTemp = NodeTemp
ENDIF
TempEffBulkAir(SurfNum) = RefAirTemp
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNum)
TempEffBulkAir(SurfNum) = RefAirTemp
END SELECT
Tin = RefAirTemp + TKelvin ! Inside air temperature
! Reset hcin if necessary since too small a value sometimes causes non-convergence
! of window layer heat balance solution.
IF (Surface(SurfNum)%IntConvCoeff == 0) THEN !
IF(hcin <= LowHConvLimit) then ! may be redundent now, check is also in HeatBalanceConvectionCoeffs.f90
! hcin = 3.076d0 !BG this is rather high value and abrupt change. changed to set to lower limit
hcin = LowHConvLimit
HConvIn(SurfNum) = hcin ! store for accurate reporting.
ENDIF
ENDIF
! IR incident on window from zone surfaces and high-temp radiant sources
rmir = SurfaceWindow(SurfNum)%IRfromParentZone + QHTRadSysSurf(SurfNum) + QHWBaseboardSurf(SurfNum) + &
QSteamBaseboardSurf(SurfNum) + QElecBaseboardSurf(SurfNum)
! Short-wave radiation (from interior and exterior solar and zone lights)
! absorbed at each face. Assumes equal split between faces of short-wave absorbed in glass layer.
DO IGlass = 1,TotGlassLay
AbsRadGlassFace(2*IGlass-1) = QRadSWwinAbs(SurfNum,IGlass)/2.d0
AbsRadGlassFace(2*IGlass) = QRadSWwinAbs(SurfNum,IGlass)/2.d0
END DO
! IR from zone internal gains (lights, equipment and people) absorbed on zone-side face
! (assumes inside glass layer is opaque to IR, so no contribution to other layers)
AbsRadGlassFace(2*TotGlassLay) = AbsRadGlassFace(2*TotGlassLay) + QRadThermInAbs(SurfNum)
! Fill the layer properties needed for the thermal calculation.
! For switchable glazing it is assumed that thermal properties, such
! as surface emissivity, are the same for the unswitched and switched state,
! so the thermal properties of the unswitched state are used.
! For windows with a blind or shade it is assumed
! that the blind or shade does not affect the thermal properties of the glazing,
! so the thermal properties of the construction without the blind or shade are used.
! The layer and face numbering are as follows (for the triple glazing case):
! Glass layers are 1,2 and 3, where 1 is the outside (outside environment facing)
! layer and 3 is the inside (room-facing) layer;
! Faces (also called surfaces) are 1,2,3,4,5 and 6, where face 1 is the
! outside (front) face of glass layer 1, face 2 is the inside (back)
! face of glass layer 1, face 3 is the outer face of glass layer 2, face 4 is the
! inner face of glass layer 2, etc.
! Gap layers are 1 and 2, where gap layer 1 is between glass layers 1 and 2
! and gap layer 2 is between glass layers 2 and 3.
! If an exterior, interior or between-glass blind or shade is in place, 7 and 8
! are the blind/shade faces, from outside to inside. If an exterior or interior
! blind/shade is in place, gap layer 3 is between the blind/shade and adjacent
! glass layer and is assumed to be air.
! Between-glass blind/shade is modeled only for double and triple glazing.
! For double glazing, gap 1 is between glass 1 and blind/shade and gap 2 is between
! blind/shade and glass 2.
! For triple glazing, the blind/shade is assumed to be between the inner two glass
! layers, i.e., between glass layers 2 and 3. In this case gap 1 is between glass 1
! and glass 2, gap 2 is between glass 2 and blind/shade, and gap 3 is between
! blind/shade and glass 3.
IConst = ConstrNum
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==ExtShadeOn.OR.ShadeFlag==IntBlindOn.OR.ShadeFlag==ExtBlindOn &
.OR.ShadeFlag==BGShadeOn.OR.ShadeFlag==BGBlindOn.OR.ShadeFlag==ExtScreenOn) THEN
IConst = Surface(SurfNum)%ShadedConstruction
IF(Surfacewindow(SurfNum)%StormWinFlag > 0) IConst = Surface(SurfNum)%StormWinShadedConstruction
END IF
TotLay = Construct(IConst)%TotLayers
IGlass = 0
IGap = 0
! Fill window layer properties needed for window layer heat balance calculation
DO Lay = 1,TotLay
LayPtr = Construct(IConst)%LayerPoint(Lay)
IF(( Material(LayPtr)%Group == WindowGlass) .OR. (Material(LayPtr)%Group == WindowSimpleGlazing) ) THEN
IGlass = IGlass + 1
thick(IGlass) = Material(LayPtr)%Thickness
scon(IGlass) = Material(LayPtr)%Conductivity/Material(LayPtr)%Thickness
emis(2*IGlass-1) = Material(LayPtr)%AbsorpThermalFront
emis(2*IGlass) = Material(LayPtr)%AbsorpThermalBack
tir(2*IGlass-1) = Material(LayPtr)%TransThermal
tir(2*IGlass) = Material(LayPtr)%TransThermal
END IF
IF(Material(LayPtr)%Group == Shade .OR. Material(LayPtr)%Group == WindowBlind .OR. Material(LayPtr)%Group == Screen) THEN
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == IntBlindOn) &
ShadeLayPtr = Construct(IConst)%LayerPoint(Construct(IConst)%TotLayers)
IF(ShadeFlag == ExtShadeOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == ExtScreenOn) &
ShadeLayPtr = Construct(IConst)%LayerPoint(1)
IF(ShadeFlag == BGShadeOn .OR. ShadeFlag == BGBlindOn) THEN
ShadeLayPtr = Construct(IConst)%LayerPoint(3)
IF(TotGlassLay == 3) ShadeLayPtr = Construct(IConst)%LayerPoint(5)
END IF
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == ExtShadeOn .OR. ShadeFlag == BGShadeOn .OR. ShadeFlag == ExtScreenOn) THEN
! Shade or screen on
IF (AnyEnergyManagementSystemInModel) THEN ! check to make sure the user hasn't messed up the shade control values
IF (Material(ShadeLayPtr)%Group == WindowBlind) THEN
CALL ShowSevereError('CalcWindowHeatBalance: ShadeFlag indicates Shade but Blind="'// &
trim(Material(ShadeLayPtr)%Name)//'" is being used.')
CALL ShowContinueError('This is most likely a fault of the EMS values for shading control.')
CALL ShowFatalError('Preceding condition terminates program.')
ENDIF
ENDIF
thick(TotGlassLay+1) = Material(ShadeLayPtr)%Thickness
scon(TotGlassLay+1) = Material(ShadeLayPtr)%Conductivity/Material(ShadeLayPtr)%Thickness
IF(ShadeFlag == ExtScreenOn) THEN
emis(nglface+1) = Material(ShadeLayPtr)%AbsorpThermalFront
tir(nglface+1) = SurfaceScreens(Material(ShadeLayPtr)%ScreenDataPtr)%DifDifTrans
tir(nglface+2) = SurfaceScreens(Material(ShadeLayPtr)%ScreenDataPtr)%DifDifTrans
ELSE
emis(nglface+1) = Material(ShadeLayPtr)%AbsorpThermal
tir(nglface+1) = Material(ShadeLayPtr)%TransThermal
tir(nglface+2) = Material(ShadeLayPtr)%TransThermal
END IF
emis(nglface+2) = Material(ShadeLayPtr)%AbsorpThermal
ELSE
IF (AnyEnergyManagementSystemInModel) THEN ! check to make sure the user hasn't messed up the shade control values
IF (Material(ShadeLayPtr)%Group == Shade .or. Material(ShadeLayPtr)%Group == Screen) THEN
CALL ShowSevereError('CalcWindowHeatBalance: ShadeFlag indicates Blind but Shade/Screen="'// &
trim(Material(ShadeLayPtr)%Name)//'" is being used.')
CALL ShowContinueError('This is most likely a fault of the EMS values for shading control.')
CALL ShowFatalError('Preceding condition terminates program.')
ENDIF
ENDIF
! Blind on
BlNum = SurfaceWindow(SurfNum)%BlindNumber
thick(TotGlassLay+1) = Blind(BlNum)%SlatThickness
scon(TotGlassLay+1) = Blind(BlNum)%SlatConductivity/Blind(BlNum)%SlatThickness
emis(nglface+1) = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Blind(BlNum)%IRFrontEmiss)
emis(nglface+2) = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Blind(BlNum)%IRBackEmiss)
tir(nglface+1) = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Blind(BlNum)%IRFrontTrans)
tir(nglface+2) = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS, &
SurfaceWindow(SurfNum)%MovableSlats,Blind(BlNum)%IRBackTrans)
END IF
END IF
IF(Material(LayPtr)%Group == WindowGas .or. Material(LayPtr)%Group == WindowGasMixture) THEN
IGap = IGap + 1
gap(IGap) = Material(LayPtr)%Thickness
gnmix(IGap) = Material(LayPtr)%NumberOfGasesInMixture
DO IMix = 1,gnmix(IGap)
gwght(IGap,IMix) = Material(LayPtr)%GasWght(IMix)
gfract(IGap,IMix) = Material(LayPtr)%GasFract(IMix)
DO ICoeff = 1,3
gcon(IGap,IMix,ICoeff) = Material(LayPtr)%GasCon(IMix,ICoeff)
gvis(IGap,IMix,ICoeff) = Material(LayPtr)%GasVis(IMix,ICoeff)
gcp(IGap,IMix,ICoeff) = Material(LayPtr)%GasCp(IMix,ICoeff)
END DO
END DO
END IF
END DO ! End of loop over glass, gap and blind/shade layers in a window construction
IF(ShadeFlag==IntShadeOn.OR.ShadeFlag==ExtShadeOn.OR.ShadeFlag==IntBlindOn &
.OR.ShadeFlag==ExtBlindOn.OR.ShadeFlag==ExtScreenOn) THEN
! Interior or exterior blind, shade or screen is on.
! Fill gap between blind/shade and adjacent glass with air properties.
IGap = IGap + 1
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == ExtShadeOn .OR. ShadeFlag == ExtScreenOn) THEN ! Interior or exterior shade
gap(IGap) = Material(ShadeLayPtr)%WinShadeToGlassDist
ELSE ! Interior or exterior blind
gap(IGap) = Blind(SurfaceWindow(SurfNum)%BlindNumber)%BlindToGlassDist
END IF
gnmix(IGap) = 1
gwght(IGap,1) = GasWght(1)
DO ICoeff = 1,3
gcon(IGap,1,ICoeff) = GasCoeffsCon(1,ICoeff)
gvis(IGap,1,ICoeff) = GasCoeffsVis(1,ICoeff)
gcp(IGap,1,ICoeff) = GasCoeffsCp (1,ICoeff)
END DO
END IF
! Exterior convection coefficient, exterior air temperature and IR radiance
! of exterior surround. Depend on whether window is interzone (in an interzone
! wall or exterior (in an exterior wall).
hcout=HExtConvCoeff ! Exterior convection coefficient is passed in from outer routine
!tsky = SkyTemp + TKelvin
IF(SurfNumAdj > 0) THEN ! Interzone window
ZoneNumAdj = Surface(SurfNumAdj)%Zone
! determine reference air temperature for this surface
SELECT CASE (Surface(SurfNumAdj)%TAirRef)
CASE (ZoneMeanAirTemp)
RefAirTemp = MAT(ZoneNumAdj)
TempEffBulkAir(SurfNumAdj) = RefAirTemp
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNumAdj)
CASE (ZoneSupplyAirTemp)
! determine ZoneEquipConfigNum for this zone
ZoneEquipConfigNum = ZoneNumAdj
! check whether this zone is a controlled zone or not
IF (.NOT. Zone(ZoneNumAdj)%IsControlled) THEN
CALL ShowFatalError('Zones must be controlled for Ceiling-Diffuser Convection model. No system serves zone '// &
TRIM(Zone(ZoneNum)%Name))
RETURN
END IF
! determine supply air conditions
SumSysMCp = 0.0d0
SumSysMCpT = 0.0d0
DO NodeNum = 1, ZoneEquipConfig(ZoneEquipConfigNum)%NumInletNodes
NodeTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNumAdj), NodeTemp, 'CalcWindowHeatBalance')
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO
IF (SumSysMCp > 0.0d0) THEN
! a weighted average of the inlet temperatures.
RefAirTemp = SumSysMCpT/SumSysMCp
ELSE
RefAirTemp = NodeTemp
ENDIF
TempEffBulkAir(SurfNumAdj) = RefAirTemp
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNumAdj)
TempEffBulkAir(SurfNumAdj) = RefAirTemp
END SELECT
Tout = RefAirTemp + TKelvin ! outside air temperature
! Add long-wave radiation from adjacent zone absorbed by glass layer closest to the adjacent zone.
AbsRadGlassFace(1) = AbsRadGlassFace(1) + QRadThermInAbs(SurfNumAdj)
! The IR radiance of this window's "exterior" surround is the IR radiance
! from surfaces and high-temp radiant sources in the adjacent zone
outir = SurfaceWindow(SurfNumAdj)%IRfromParentZone + QHTRadSysSurf(SurfNumAdj) + QHWBaseboardSurf(SurfNumAdj) + &
QSteamBaseboardSurf(SurfNumAdj) + QElecBaseboardSurf(SurfNumAdj)
ELSE ! Exterior window (ExtBoundCond = 0)
IF(Surface(SurfNum)%ExtWind) THEN ! Window is exposed to wind (and possibly rain)
IF(IsRain) THEN ! Raining: since wind exposed, outside window surface gets wet
tout = Surface(SurfNum)%OutWetBulbTemp + TKelvin
ELSE ! Dry
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
ELSE ! Window not exposed to wind
tout = Surface(SurfNum)%OutDryBulbTemp + TKelvin
END IF
Ebout = sigma * tout**4
outir = Surface(SurfNum)%ViewFactorSkyIR * &
(AirSkyRadSplit(SurfNum)*sigma*SkyTempKelvin**4 + (1.d0-AirSkyRadSplit(SurfNum))*Ebout) + &
Surface(SurfNum)%ViewFactorGroundIR * Ebout
END IF
! Factors used in window layer temperature solution
IF(ngllayer >= 2) THEN
A23P = -emis(3)/(1.0d0-(1.0d0-emis(2))*(1.0d0-emis(3)))
A32P = emis(2)/(1.0d0-(1.0d0-emis(2))*(1.0d0-emis(3)))
A23 = emis(2)*sigma*A23P
END IF
IF(ngllayer >= 3) THEN
A45P = -emis(5)/(1.0d0-(1.0d0-emis(4))*(1.0d0-emis(5)))
A54P = emis(4)/(1.0d0-(1.0d0-emis(4))*(1.0d0-emis(5)))
A45 = emis(4)*sigma*A45P
END IF
IF(ngllayer == 4) THEN
A67P = -emis(7)/(1.0d0-(1.0d0-emis(6))*(1.0d0-emis(7)))
A76P = emis(6)/(1.0d0-(1.0d0-emis(6))*(1.0d0-emis(7)))
A67 = emis(6)*sigma*A67P
END IF
thetas = 0.0d0
thetasPrev = 0.0d0
fvec = 0.0d0
fjac = 0.0d0
! Calculate window face temperatures
CALL SolveForWindowTemperatures(SurfNum)
! Temperature difference across glass layers (for debugging)
dth1 = thetas(2)-thetas(1)
dth2 = thetas(4)-thetas(3)
dth3 = thetas(6)-thetas(5)
dth4 = thetas(8)-thetas(7)
IF(ShadeFlag == IntShadeOn .OR. ShadeFlag == IntBlindOn) THEN
SurfInsideTemp = thetas(2*ngllayer+2) - TKelvin
EffShBlEmiss = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
SurfaceWindow(SurfNum)%EffShBlindEmiss)
EffGlEmiss = InterpSlatAng(SurfaceWindow(SurfNum)%SlatAngThisTS,SurfaceWindow(SurfNum)%MovableSlats, &
SurfaceWindow(SurfNum)%EffGlassEmiss)
SurfaceWindow(SurfNum)%EffInsSurfTemp = (EffShBlEmiss * SurfInsideTemp + EffGlEmiss * (thetas(2*ngllayer)-TKelvin)) / &
(EffShBlEmiss + EffGlEmiss)
ELSE
SurfInsideTemp = thetas(2*ngllayer) - TKelvin
END IF
IF(ShadeFlag == ExtShadeOn .OR. ShadeFlag == ExtBlindOn .OR. ShadeFlag == ExtScreenOn) THEN
SurfOutsideTemp = thetas(2*ngllayer+1) - TKelvin ! this index looks suspicious (CR 8202)
!SurfOutsideEmiss = emis(1) ! this index should be coordinated with previous line
SurfOutsideEmiss = emis(2*ngllayer+1) ! fix for CR 8202
ELSE
SurfOutsideEmiss = emis(1)
SurfOutsideTemp = thetas(1) - TKelvin
END IF
! Save temperatures for use next time step
DO k = 1,nglfacep
SurfaceWindow(SurfNum)%ThetaFace(k) = thetas(k)
END DO
! Added TH 12/23/2008 for thermochromic windows to save the current TC layer temperature
IF (locTCFlag) THEN
SurfaceWindow(SurfNum)%TCLayerTemp = (thetas(2*Construct(ConstrNum)%TCGlassID-1)+ &
thetas(2*Construct(ConstrNum)%TCGlassID))/2 - TKelvin ! degree C
ENDIF
END IF !regular window, not BSDF, not EQL
! Set condensation flag to 1 if condensation expected to occur on the innermost glass face,
! or, for airflow windows, on either or the two glass faces in the airflow gap
IF (.NOT. Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) THEN
InsideGlassTemp = thetas(2*ngllayer)-TKelvin
RoomHumRat = ZoneAirHumRat(Surface(SurfNum)%Zone)
RoomDewpoint = PsyTdpFnWPb(RoomHumRat,OutBaroPress)
InsideGlassCondensationFlag(SurfNum) = 0
IF(InsideGlassTemp < RoomDewPoint) InsideGlassCondensationFlag(SurfNum) = 1
! If airflow window, is there condensation on either glass face of the airflow gap?
IF(SurfaceWindow(SurfNum)%AirflowThisTS > 0.0d0) THEN
Tleft = thetas(2*ngllayer-2)-TKelvin
Tright = thetas(2*ngllayer-1)-TKelvin
IF(SurfaceWindow(SurfNum)%AirflowSource == AirFlowWindow_Source_IndoorAir) THEN
IF(Tleft < RoomDewpoint .OR. Tright < RoomDewpoint) InsideGlassCondensationFlag(SurfNum) = 1
ELSE IF(SurfaceWindow(SurfNum)%AirflowSource == AirFlowWindow_Source_OutdoorAir) THEN
IF(Tleft < OutDewpointTemp .OR. Tright < OutDewpointTemp) InsideGlassCondensationFlag(SurfNum) = 1
END IF
END IF
! Do frame and divider calculation
IF(SurfaceWindow(SurfNum)%FrameArea > 0.0d0 .OR. SurfaceWindow(SurfNum)%DividerArea > 0.0d0) &
CALL CalcWinFrameAndDividerTemps(SurfNum,tout,tin,hcout,hcin,outir,ConstrNum)
IF(SurfaceWindow(SurfNum)%FrameArea > 0.0d0) THEN
InsideFrameCondensationFlag(SurfNum) = 0
IF(SurfaceWindow(SurfNum)%FrameTempSurfIn < RoomDewPoint) InsideFrameCondensationFlag(SurfNum) = 1
END IF
IF(SurfaceWindow(SurfNum)%DividerArea > 0.0d0) THEN
InsideDividerCondensationFlag(SurfNum) = 0
IF(SurfaceWindow(SurfNum)%DividerTempSurfIn < RoomDewPoint) InsideDividerCondensationFlag(SurfNum) = 1
END IF
ENDIF
!update exterior environment surface heat loss reporting
Tsout = SurfOutsideTemp + TKelvin
QdotConvOutRep(SurfNum) = - Surface(SurfNum)%Area * hcout *(Tsout - Tout)
QdotConvOutRepPerArea(SurfNum) = - hcout *(Tsout - Tout)
QConvOutReport(SurfNum) = QdotConvOutRep(SurfNum)* SecInHour * TimeStepZone
QdotRadOutRep(SurfNum) = - Surface(SurfNum)%Area * SurfOutsideEmiss * &
((1.0d0-AirSkyRadSplit(SurfNum))* Surface(SurfNum)%ViewFactorSkyIR + &
Surface(SurfNum)%ViewFactorGroundIR) &
* sigma * (Tsout**4 - tout**4) &
- Surface(SurfNum)%Area *SurfOutsideEmiss *AirSkyRadSplit(SurfNum)* &
Surface(SurfNum)%ViewFactorSkyIR &
* sigma * (Tsout**4 - SkyTempKelvin**4)
QdotRadOutRepPerArea(SurfNum) =- SurfOutsideEmiss * &
((1.0d0-AirSkyRadSplit(SurfNum))*Surface(SurfNum)%ViewFactorSkyIR + &
Surface(SurfNum)%ViewFactorGroundIR) &
* sigma * (Tsout**4 - tout**4) &
- SurfOutsideEmiss *AirSkyRadSplit(SurfNum) * Surface(SurfNum)%ViewFactorSkyIR &
* sigma * (Tsout**4 - SkyTempKelvin**4)
QRadOutReport(SurfNum) = QdotRadOutRep(SurfNum) * SecInHour * TimeStepZone
RETURN
END SUBROUTINE CalcWindowHeatBalance