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) | :: | ZoneNum | |||
real(kind=r64), | intent(out) | :: | SumIntGain | |||
real(kind=r64), | intent(out) | :: | SumHA | |||
real(kind=r64), | intent(out) | :: | SumHATsurf | |||
real(kind=r64), | intent(out) | :: | SumHATref | |||
real(kind=r64), | intent(out) | :: | SumMCp | |||
real(kind=r64), | intent(out) | :: | SumMCpT | |||
real(kind=r64), | intent(out) | :: | SumSysMCp | |||
real(kind=r64), | intent(out) | :: | SumSysMCpT |
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 CalcZoneSums(ZoneNum, SumIntGain, SumHA, SumHATsurf, SumHATref, SumMCp, SumMCpT, SumSysMCp, SumSysMCpT)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN July 2003
! MODIFIED Aug 2003, FCW: add SumHA contributions from window frame and divider
! Aug 2003, CC: change how the reference temperatures are used
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the various sums that go into the zone heat balance
! equation. This replaces the SUMC, SUMHA, and SUMHAT calculations that were
! previously done in various places throughout the program.
! The SumHAT portion of the code is reproduced in RadiantSystemHighTemp and
! RadiantSystemLowTemp and should be updated accordingly.
!
! A reference temperature (Tref) is specified for use with the ceiling diffuser
! convection correlation. A bogus value of Tref = -999.9 defaults to using
! the zone air (i.e. outlet) temperature for the reference temperature.
! If Tref is applied to all surfaces, SumHA = 0, and SumHATref /= 0.
! If Tref is not used at all, SumHATref = 0, and SumHA /= 0.
!
! For future implementations, Tref can be easily converted into an array to
! allow a different reference temperature to be specified for each surface.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSurfaces
USE DataHeatBalance
USE DataHeatBalSurface
USE DataLoopNode, ONLY: Node
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE ZonePlenum, ONLY: ZoneRetPlenCond, ZoneSupPlenCond, NumZoneReturnPlenums, NumZoneSupplyPlenums
USE DataDefineEquip, ONLY: AirDistUnit, NumAirDistUnits
USE InternalHeatGains, ONLY: SumAllInternalConvectionGains, SumAllReturnAirConvectionGains
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ZoneNum ! Zone number
REAL(r64), INTENT(OUT) :: SumIntGain ! Zone sum of convective internal gains
REAL(r64), INTENT(OUT) :: SumHA ! Zone sum of Hc*Area
REAL(r64), INTENT(OUT) :: SumHATsurf ! Zone sum of Hc*Area*Tsurf
REAL(r64), INTENT(OUT) :: SumHATref ! Zone sum of Hc*Area*Tref, for ceiling diffuser convection correlation
REAL(r64), INTENT(OUT) :: SumMCp ! Zone sum of MassFlowRate*Cp
REAL(r64), INTENT(OUT) :: SumMCpT ! Zone sum of MassFlowRate*Cp*T
REAL(r64), INTENT(OUT) :: SumSysMCp ! Zone sum of air system MassFlowRate*Cp
REAL(r64), INTENT(OUT) :: SumSysMCpT ! Zone sum of air system MassFlowRate*Cp*T
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NodeNum ! System node number
REAL(r64) :: NodeTemp ! System node temperature
REAL(r64) :: MassFlowRate ! System node mass flow rate
INTEGER :: ZoneEquipConfigNum
LOGICAL :: ControlledZoneAirFlag
INTEGER :: ZoneRetPlenumNum
INTEGER :: ZoneSupPlenumNum
LOGICAL :: ZoneRetPlenumAirFlag
LOGICAL :: ZoneSupPlenumAirFlag
REAL(r64) :: CpAir ! Specific heat of air
INTEGER :: SurfNum ! Surface number
REAL(r64) :: HA ! Hc*Area
REAL(r64) :: Area ! Effective surface area
REAL(r64) :: RefAirTemp ! Reference air temperature for surface convection calculations
REAL(r64) :: ZoneMult
INTEGER :: ADUListIndex
INTEGER :: ADUNum
INTEGER :: ADUInNode
INTEGER :: ADUOutNode
REAL(r64) :: RetAirGain
! FLOW:
SumIntGain = 0.0d0
SumHA = 0.0d0
SumHATsurf = 0.0d0
SumHATref = 0.0d0
SumMCp = 0.0d0
SumMCpT = 0.0d0
SumSysMCp = 0.0d0
SumSysMCpT = 0.0d0
! Sum all convective internal gains: SumIntGain
CALL SumAllInternalConvectionGains(ZoneNum, SumIntGain)
SumIntGain = SumIntGain + SumConvHTRadSys(ZoneNum)
! Add heat to return air if zonal system (no return air) or cycling system (return air frequently very
! low or zero)
IF (Zone(ZoneNum)%NoHeatToReturnAir) THEN
CALL SumAllReturnAirConvectionGains(ZoneNum, RetAirGain)
SumIntGain = SumIntGain + RetAirGain
END IF
! Sum all non-system air flow, i.e. infiltration, simple ventilation, mixing, earth tube: SumMCp, SumMCpT
SumMCp = MCPI(ZoneNum) + MCPV(ZoneNum) + MCPM(ZoneNum) + MCPE(ZoneNum) + MCPC(ZoneNum) + MdotCPOA(ZoneNum)
SumMCpT = MCPTI(ZoneNum) + MCPTV(ZoneNum) + MCPTM(ZoneNum) + MCPTE(ZoneNum) + MCPTC(ZoneNum) + &
MdotCPOA(ZoneNum)*Zone(ZoneNum)%OutDryBulbTemp
! Sum all multizone air flow calculated from AirflowNetwork by assuming no simple air infiltration model
if (SimulateAirflowNetwork == AirflowNetworkControlMultizone .OR. SimulateAirflowNetwork == AirflowNetworkControlMultiADS .OR. &
(SimulateAirflowNetwork == AirflowNetworkControlSimpleADS .AND. AirflowNetworkFanActivated)) then
! Multizone airflow calculated in AirflowNetwork
SumMCp = AirflowNetworkExchangeData(ZoneNum)%SumMCp+AirflowNetworkExchangeData(ZoneNum)%SumMMCp
SumMCpT = AirflowNetworkExchangeData(ZoneNum)%SumMCpT+AirflowNetworkExchangeData(ZoneNum)%SumMMCpT
end if
! Sum all system air flow: SumSysMCp, SumSysMCpT
! Check to see if this is a controlled zone
ControlledZoneAirFlag = .FALSE.
! If (Zone(ZoneNum)%IsControlled) Then ! more CR 7384
! ControlledZoneAirFlag = .TRUE. ! more CR 7384
! ZoneEquipConfigNum = ZoneNum ! more CR 7384
! endif
! BG feb 2008 repeating this do loop every time seems crazy, store ControlledZoneAirFlag in Zone structure?
DO ZoneEquipConfigNum = 1, NumOfZones
IF (.not. Zone(ZoneEquipConfigNum)%IsControlled) CYCLE
IF (ZoneEquipConfig(ZoneEquipConfigNum)%ActualZoneNum /= ZoneNum) CYCLE
ControlledZoneAirFlag = .TRUE.
EXIT !sloppy way of finding ZoneEquipConfigNum for later use.
END DO ! ZoneEquipConfigNum
! Check to see if this is a plenum zone
! BG feb 2008 repeating this do loop every time seems crazy, store ControlledZoneAirFlag in Zone structure?
ZoneRetPlenumAirFlag = .FALSE.
DO ZoneRetPlenumNum = 1, NumZoneReturnPlenums
IF (ZoneRetPlenCond(ZoneRetPlenumNum)%ActualZoneNum /= ZoneNum) CYCLE
ZoneRetPlenumAirFlag = .TRUE.
EXIT
END DO ! ZoneRetPlenumNum
ZoneSupPlenumAirFlag = .FALSE.
DO ZoneSupPlenumNum = 1, NumZoneSupplyPlenums
IF (ZoneSupPlenCond(ZoneSupPlenumNum)%ActualZoneNum /= ZoneNum) CYCLE
ZoneSupPlenumAirFlag = .TRUE.
EXIT
END DO ! ZoneSupPlenumNum
! Plenum and controlled zones have a different set of inlet nodes which must be calculated.
IF (ControlledZoneAirFlag) THEN
DO NodeNum = 1, ZoneEquipConfig(ZoneEquipConfigNum)%NumInletNodes
! Get node conditions
! this next block is of interest to irratic system loads... maybe nodes are not accurate at time of call?
! how can we tell? predict step must be lagged ? correct step, systems have run.
NodeTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO ! NodeNum
ELSE IF (ZoneRetPlenumAirFlag) THEN
DO NodeNum = 1, ZoneRetPlenCond(ZoneRetPlenumNum)%NumInletNodes
! Get node conditions
NodeTemp = Node(ZoneRetPlenCond(ZoneRetPlenumNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneRetPlenCond(ZoneRetPlenumNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END DO ! NodeNum
! add in the leaks
DO ADUListIndex=1,ZoneRetPlenCond(ZoneRetPlenumNum)%NumADUs
ADUNum = ZoneRetPlenCond(ZoneRetPlenumNum)%ADUIndex(ADUListIndex)
IF (AirDistUnit(ADUNum)%UpStreamLeak) THEN
ADUInNode = AirDistUnit(ADUNum)%InletNodeNum
NodeTemp = Node(ADUInNode)%Temp
MassFlowRate = AirDistUnit(ADUNum)%MassFlowRateUpStrLk
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END IF
IF (AirDistUnit(ADUNum)%DownStreamLeak) THEN
ADUOutNode = AirDistUnit(ADUNum)%OutletNodeNum
NodeTemp = Node(ADUOutNode)%Temp
MassFlowRate = AirDistUnit(ADUNum)%MassFlowRateDnStrLk
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END IF
END DO
ELSE IF (ZoneSupPlenumAirFlag) THEN
! Get node conditions
NodeTemp = Node(ZoneSupPlenCond(ZoneSupPlenumNum)%InletNode)%Temp
MassFlowRate = Node(ZoneSupPlenCond(ZoneSupPlenumNum)%InletNode)%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumSysMCp = SumSysMCp + MassFlowRate * CpAir
SumSysMCpT = SumSysMCpT + MassFlowRate * CpAir * NodeTemp
END IF
ZoneMult = Zone(ZoneNum)%Multiplier * Zone(ZoneNum)%ListMultiplier
SumSysMCp = SumSysMCp / ZoneMult
SumSysMCpT = SumSysMCpT / ZoneMult
! Sum all surface convection: SumHA, SumHATsurf, SumHATref (and additional contributions to SumIntGain)
DO SurfNum = Zone(ZoneNum)%SurfaceFirst,Zone(ZoneNum)%SurfaceLast
IF (.NOT. Surface(SurfNum)%HeatTransSurf) CYCLE ! Skip non-heat transfer surfaces
HA = 0.0d0
Area = Surface(SurfNum)%Area ! For windows, this is the glazing area
IF (Surface(SurfNum)%Class == SurfaceClass_Window) THEN
! Add to the convective internal gains
IF (SurfaceWindow(SurfNum)%ShadingFlag == IntShadeOn .OR. SurfaceWindow(SurfNum)%ShadingFlag == IntBlindOn) THEN
! The shade area covers the area of the glazing plus the area of the dividers.
Area = Area + SurfaceWindow(SurfNum)%DividerArea
! If interior shade or blind is present it is assumed that both the convective and IR radiative gain
! from the inside surface of the divider goes directly into the zone air -- i.e., the IR radiative
! interaction between divider and shade or blind is ignored due to the difficulty of calculating this interaction
! at the same time that the interaction between glass and shade is calculated.
SumIntGain = SumIntGain + SurfaceWindow(SurfNum)%DividerConduction
END IF
! Other convection term is applicable to equivalent layer window (ASHWAT) model
IF (Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) &
SumIntGain = SumIntGain + SurfaceWindow(SurfNum)%OtherConvHeatGain
! Convective heat gain from natural convection in gap between glass and interior shade or blind
IF (SurfaceWindow(SurfNum)%ShadingFlag == IntShadeOn &
.OR. SurfaceWindow(SurfNum)%ShadingFlag == IntBlindOn) &
SumIntGain = SumIntGain + SurfaceWindow(SurfNum)%ConvHeatFlowNatural
! Convective heat gain from airflow window
IF (SurfaceWindow(SurfNum)%AirFlowThisTS > 0.0d0) THEN
SumIntGain = SumIntGain + SurfaceWindow(SurfNum)%ConvHeatGainToZoneAir
IF (Zone(ZoneNum)%NoHeatToReturnAir) THEN
SumIntGain = SumIntGain + SurfaceWindow(SurfNum)%RetHeatGainToZoneAir
WinHeatGain(SurfNum) = WinHeatGain(SurfNum) + SurfaceWindow(SurfNum)%RetHeatGainToZoneAir
IF(WinHeatGain(SurfNum) >= 0.0d0) THEN
WinHeatGainRep(SurfNum) = WinHeatGain(SurfNum)
WinHeatGainRepEnergy(SurfNum) = WinHeatGainRep(SurfNum) * TimeStepZone * SecInHour
ELSE
WinHeatLossRep(SurfNum) = -WinHeatGain(SurfNum)
WinHeatLossRepEnergy(SurfNum) = WinHeatLossRep(SurfNum) * TimeStepZone * SecInHour
END IF
END IF
END IF
! Add to the surface convection sums
IF (SurfaceWindow(SurfNum)%FrameArea > 0.0d0) THEN
! Window frame contribution
SumHATsurf = SumHATsurf + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%FrameArea &
* (1.0d0 + SurfaceWindow(SurfNum)%ProjCorrFrIn) * SurfaceWindow(SurfNum)%FrameTempSurfIn
HA = HA + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%FrameArea * (1.0d0 + SurfaceWindow(SurfNum)%ProjCorrFrIn)
END IF
IF (SurfaceWindow(SurfNum)%DividerArea > 0.0d0 .AND. SurfaceWindow(SurfNum)%ShadingFlag /= IntShadeOn &
.AND. SurfaceWindow(SurfNum)%ShadingFlag /= IntBlindOn) THEN
! Window divider contribution (only from shade or blind for window with divider and interior shade or blind)
SumHATsurf = SumHATsurf + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%DividerArea &
* (1.0d0 + 2.0d0 * SurfaceWindow(SurfNum)%ProjCorrDivIn) * SurfaceWindow(SurfNum)%DividerTempSurfIn
HA = HA + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%DividerArea * (1.0d0 + 2.0d0 * SurfaceWindow(SurfNum)%ProjCorrDivIn)
END IF
END IF ! End of check if window
HA = HA + HConvIn(SurfNum) * Area
SumHATsurf = SumHATsurf + HConvIn(SurfNum) * Area * TempSurfInTmp(SurfNum)
! determine reference air temperature for this surface
SELECT CASE (Surface(SurfNum)%TAirRef)
CASE (ZoneMeanAirTemp)
! The zone air is the reference temperature (which is to be solved for in CorrectZoneAirTemp).
RefAirTemp = MAT(ZoneNum)
SumHA = SumHA + HA
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNum)
SumHATref = SumHATref + HA * RefAirTemp
CASE (ZoneSupplyAirTemp)
! check whether this zone is a controlled zone or not
IF (.NOT.ControlledZoneAirFlag) 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 temperature as a weighted average of the inlet temperatures.
IF (SumSysMCp > 0.0d0) THEN
RefAirTemp = SumSysMCpT/SumSysMCp
ELSE
! no system flow (yet) so just use last value for inlet node temp, this can happen early in the environment
RefAirTemp = NodeTemp
ENDIF
SumHATref = SumHATref + HA * RefAirTemp
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNum)
SumHA = SumHA + HA
END SELECT
END DO ! SurfNum
RETURN
END SUBROUTINE CalcZoneSums