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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | SurfNum | |||
real(kind=r64), | intent(in) | :: | HcOut | |||
real(kind=r64), | intent(inout) | :: | SurfInsideTemp | |||
real(kind=r64), | intent(inout) | :: | SurfOutsideTemp | |||
real(kind=r64), | intent(inout) | :: | SurfOutsideEmiss | |||
integer, | intent(in) | :: | CalcCondition |
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 EQLWindowSurfaceHeatBalance(SurfNum,HcOut, SurfInsideTemp, SurfOutsideTemp, &
SurfOutsideEmiss, CalcCondition)
!
! SUBROUTINE INFORMATION:
! AUTHOR Bereket Nigusse
! DATE WRITTEN May 2013
! MODIFIED na
!
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! performs surface heat balance and returns in the inside and outside surface
! temperatures
! METHODOLOGY EMPLOYED:
! uses the solar-thermal routine developed for ASHRAE RP-1311 (ASHWAT Model).
!
!
! REFERENCES:
! na
!
! USE STATEMENTS:
USE DataZoneEquipment, ONLY : ZoneEquipConfig
USE DataLoopNode, ONLY : Node
USE Psychrometrics, ONLY : PsyCpAirFnWTdb,PsyTdpFnWPb
USE General, ONLY : InterpSlatAng , InterpSw
USE InputProcessor, ONLY : SameString
USE DataHeatBalSurface, ONLY : HcExtSurf
USE DataGlobals, ONLY : StefanBoltzmann
USE DataEnvironment, ONLY : SunIsUpValue, SkyTempKelvin, IsRain, SunIsUp
USE DataHeatBalFanSys
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SurfNum ! Surface number
INTEGER, INTENT(IN) :: CalcCondition ! Calucation condition (summer, winter or no condition)
REAL(r64), INTENT(IN) :: HcOut ! outside convection coeficient at this timestep, W/m2K
REAL(r64), INTENT(INOUT) :: SurfInsideTemp ! Inside window surface temperature (innermost face) [C]
REAL(r64), INTENT(INOUT) :: SurfOutsideTemp ! Outside surface temperature (C)
REAL(r64), INTENT(INOUT) :: SurfOutsideEmiss !
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: TOL = 0.0001d0 ! convergence tolerance
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NL ! Number of layers
REAL(r64) :: TIN, TMrtK, TRMIN, TOUT, TRMOUT, UCG, SHGC, QRLW, QIGLW, QRLWX, QCONV, TSX
REAL(r64) :: QOCF( CFSMAXNL), QOCFRoom
REAL(r64) :: JB(0:CFSMAXNL), JF(1:CFSMAXNL+1), T( CFSMAXNL), Q(0:CFSMAXNL), H(0:CFSMAXNL+1)
REAL(r64) :: QAllSWwinAbs(1:CFSMAXNL+1)
LOGICAL :: ASHWAT_ThermalR ! net long wave radiation flux on the inside face of window
INTEGER :: EQLNum ! equivalent layer window index
INTEGER :: ZoneNum ! Zone number corresponding to SurfNum
INTEGER :: ConstrNum ! Construction number
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
INTEGER :: tmpGasType
INTEGER :: SurfNumAdj ! An interzone surface's number in the adjacent zone
INTEGER :: ZoneNumAdj ! An interzone surface's adjacent zone number
REAL(r64) :: LWAbsIn ! effective long wave absorptance/emissivity back side
REAL(r64) :: LWAbsOut ! effective long wave absorptance/emissivity front side
REAL(r64) :: QLWAbsIn ! Inside surface long wave absorbed flux, W/m2
REAL(r64) :: outir
REAL(r64) :: RMIR
REAL(r64) :: EBOUT
REAL(r64) :: QXConv ! extra convective gain from this surface
REAL(r64) :: TaIn ! zone air temperature
REAL(r64) :: tsky ! sky temperature
REAL(r64) :: HcIn ! inside convection coeficient at this timestep, W/m2K
REAL(r64) :: ConvHeatFlowNatural ! Convective heat flow from gap between glass and interior shade or blind (W)
REAL(r64) :: ConvHeatFlowForced ! Convective heat flow from forced airflow gap (W)
REAL(r64) :: NetIRHeatGainWindow ! net radiation gain from the window surface to the zone (W)
REAL(r64) :: ConvHeatGainWindow ! net convection heat gain from inside surface of window to zone air (W)
INTEGER :: InSideLayerType ! interior shade type
! Flow
If (CalcCondition /= noCondition) RETURN
ConstrNum = Surface(SurfNum)%Construction
QXConv = 0.0d0
ConvHeatFlowNatural = 0.0d0
EQLNum = Construct(ConstrNum)%EQLConsPtr
HcIn = HConvIn(SurfNum) ! windows inside surface convective film conductance
If (CalcCondition == noCondition) Then
ZoneNum = Surface(SurfNum)%Zone
SurfNumAdj = Surface(SurfNum)%ExtBoundCond
! determine reference air temperature for this surface
SELECT CASE (Surface(SurfNum)%TAirRef)
CASE (ZoneMeanAirTemp)
RefAirTemp = MAT(ZoneNum)
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNum)
CASE (ZoneSupplyAirTemp)
ZoneEquipConfigNum = ZoneNum
! check whether this zone is a controlled zone or not
IF (.NOT. Zone(ZoneNum)%IsControlled) THEN
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,'EQLWindowSurfaceHeatBalance')
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO
! a weighted average of the inlet temperatures.
RefAirTemp = SumSysMCpT/SumSysMCp
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNum)
END SELECT
TaIn = RefAirTemp
TIN = TaIn + KelvinConv ! Inside air temperature, K
! now get "outside" air temperature
IF(SurfNumAdj > 0) THEN
! this is interzone window. the outside condition is determined from the adjacent zone
! condition
ZoneNumAdj = Surface(SurfNumAdj)%Zone
! determine reference air temperature for this surface
SELECT CASE (Surface(SurfNumAdj)%TAirRef)
CASE (ZoneMeanAirTemp)
RefAirTemp = MAT(ZoneNumAdj)
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNumAdj)
CASE (ZoneSupplyAirTemp)
! determine ZoneEquipConfigNum for this zone
ZoneEquipConfigNum = ZoneNum
! check whether this zone is a controlled zone or not
IF (.NOT. Zone(ZoneNum)%IsControlled) THEN
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, 'EQLWindowSurfaceHeatBalance')
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO
! a weighted average of the inlet temperatures.
RefAirTemp = SumSysMCpT/SumSysMCp
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNumAdj)
END SELECT
Tout = RefAirTemp + KelvinConv ! outside air temperature
tsky = MRT(ZoneNumAdj) + KelvinConv ! TODO this misses IR from sources such as high temp radiant and baseboards
! 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) + QRadThermInAbs(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 + KelvinConv
ELSE ! Dry
Tout = Surface(SurfNum)%OutDryBulbTemp + KelvinConv
END IF
ELSE ! Window not exposed to wind
Tout = Surface(SurfNum)%OutDryBulbTemp + KelvinConv
END IF
tsky = SkyTempKelvin
Ebout = StefanBoltzmann * Tout**4
! ASHWAT model may be slightly different
outir = Surface(SurfNum)%ViewFactorSkyIR * (AirSkyRadSplit(SurfNum)*StefanBoltzmann*tsky**4 &
+ (1.-AirSkyRadSplit(SurfNum))*Ebout) + Surface(SurfNum)%ViewFactorGroundIR * Ebout
END IF
End If
! Outdoor conditions
TRMOUT = ( outir / StefanBoltzmann)**0.25d0 ! it is in Kelvin scale
! indoor conditions
LWAbsIn = EffectiveEPSLB(CFS(EQLNum)) ! windows inside face effective thermal emissivity
LWAbsOut = EffectiveEPSLF(CFS(EQLNum)) ! windows outside face effective thermal emissivity
SurfOutsideEmiss = LWAbsOut
! Indoor mean radiant temperature.
! IR incident on window from zone surfaces and high-temp radiant sources
rmir = SurfaceWindow(SurfNum)%IRfromParentZone + QHTRadSysSurf(SurfNum) + QHWBaseboardSurf(SurfNum) &
+ QSteamBaseboardSurf(SurfNum) + QElecBaseboardSurf(SurfNum) + QRadThermInAbs(SurfNum)
trmin = ( rmir / StefanBoltzmann)**0.25d0 ! TODO check model equation.
NL = CFS(EQLNum)%NL
QAllSWwinAbs(1:NL+1) = QRadSWwinAbs(SurfNum,1:NL+1)
! Solve energy balance(s) for temperature at each node/layer and
! heat flux, including components, between each pair of nodes/layers
ASHWAT_ThermalR = ASHWAT_Thermal( CFS(EQLNum), TIN, TOUT, HcIn, HcOut, TRMOUT, TRMIN, 0.0d0, &
QAllSWwinAbs(1:NL+1), TOL, QOCF, QOCFRoom, T, Q, JF, JB, H, UCG, SHGC)
! long wave radiant power to room not including reflected
QRLWX = JB( NL) - (1.0d0 - LWAbsIn) * JF( NL+1)
! nominal surface temp = effective radiant temperature
SurfInsideTemp = TRadC( QRLWX, LWAbsIn)
! Convective to room
QCONV = H( NL) * (T( NL) - TIN)
! Other convective = total conv - standard model prediction
QXConv = QCONV - HcIn * (SurfInsideTemp - TaIn)
! Save the extra convection term. This term is added to the zone air heat
! balance equation
SurfaceWindow(SurfNum)%OtherConvHeatGain = Surface(SurfNum)%Area * QXConv
SurfOutsideTemp = T(1) - KelvinConv
! Various reporting calculations
InSideLayerType = CFS(EQLNum)%L(NL)%LTYPE
IF ( InSideLayerType == ltyGLAZE ) THEN
ConvHeatFlowNatural = 0.0d0
ELSE
ConvHeatFlowNatural = Surface(SurfNum)%Area * QOCFRoom
ENDIF
SurfaceWindow(SurfNum)%EffInsSurfTemp = SurfInsideTemp
NetIRHeatGainWindow = Surface(SurfNum)%Area * LWAbsIn * (StefanBoltzmann * (SurfInsideTemp + KelvinConv)**4 - rmir)
ConvHeatGainWindow = Surface(SurfNum)%Area * HcIn * (SurfInsideTemp - TaIn)
! Window heat gain (or loss) is calculated here
WinHeatGain(SurfNum) = WinTransSolar(SurfNum) + ConvHeatGainWindow &
+ NetIRHeatGainWindow + ConvHeatFlowNatural
SurfaceWindow(SurfNum)%ConvHeatFlowNatural = ConvHeatFlowNatural
! store for component reporting
WinGainConvGlazShadGapToZoneRep(SurfNum) = ConvHeatFlowNatural
WinGainConvShadeToZoneRep(SurfNum) = ConvHeatGainWindow
WinGainIRGlazToZoneRep(SurfNum) = NetIRHeatGainWindow
WinGainIRShadeToZoneRep(SurfNum) = NetIRHeatGainWindow
IF ( InSideLayerType == ltyGLAZE ) THEN
! no interior sade
WinGainIRShadeToZoneRep(SurfNum) = 0.0d0
ELSE
! Interior shade exists
WinGainIRGlazToZoneRep(SurfNum) = 0.0d0
ENDIF
! Advanced report variable (DisplayAdvancedReportVariables)
OtherConvGainInsideFaceToZoneRep(SurfNum) = SurfaceWindow(SurfNum)%OtherConvHeatGain
RETURN
END SUBROUTINE EQLWindowSurfaceHeatBalance