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(in) | :: | TempDepCoef | |||
real(kind=r64), | intent(in) | :: | TempIndCoef | |||
real(kind=r64), | intent(out) | :: | SumIntGains | |||
real(kind=r64), | intent(out) | :: | SumHADTsurfs | |||
real(kind=r64), | intent(out) | :: | SumMCpDTzones | |||
real(kind=r64), | intent(out) | :: | SumMCpDtInfil | |||
real(kind=r64), | intent(out) | :: | SumMCpDTsystem | |||
real(kind=r64), | intent(out) | :: | SumNonAirSystem | |||
real(kind=r64), | intent(out) | :: | CzdTdt | |||
real(kind=r64), | intent(out) | :: | imBalance |
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 CalcZoneComponentLoadSums(ZoneNum, TempDepCoef, TempIndCoef, SumIntGains, SumHADTsurfs, SumMCpDTzones, &
SumMCpDtInfil, SumMCpDTsystem, SumNonAirSystem, CzdTdt , imBalance )
! SUBROUTINE INFORMATION:
! AUTHOR Brent Griffith
! DATE WRITTEN Feb 2008
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine calculates the various sums that go into the zone heat balance
! equation for reporting (and diagnostic) purposes only.
! It was derived from CalcZoneSums but differs in that that routine
! breaks up the component's dependence on zone air temp in order to *solve* for zone air temp,
! but here we *use* the result for zone air temp and calculate the terms of the heat balance
! Go back and calculate each of the 6 terms in Equation 5 and fill report variables.
! notes on these raw terms for zone air heat balance model :
! these are state variables at the end of the last system timestep.
! they are not necessarily proper averages for what happend over entire zone time step
! these are not mulitplied by zone multipliers.
! The values are all Watts.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! Equation 5 in Engineering Reference.
!
! 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 General, ONLY: RoundSigDigits
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(IN) :: TempDepCoef ! Dependent coefficient
REAL(r64), INTENT(IN) :: TempIndCoef ! Independent coefficient
REAL(r64), INTENT(OUT) :: SumIntGains ! Zone sum of convective internal gains
REAL(r64), INTENT(OUT) :: SumHADTsurfs ! Zone sum of Hc*Area*(Tsurf - Tz)
REAL(r64), INTENT(OUT) :: SumMCpDTzones ! zone sum of MassFlowRate*cp*(TremotZone - Tz) transfer air from other zone, Mixing
REAL(r64), INTENT(OUT) :: SumMCpDtInfil ! Zone sum of MassFlowRate*Cp*(Tout - Tz) transfer from outside, ventil, earth tube
REAL(r64), INTENT(OUT) :: SumMCpDTsystem ! Zone sum of air system MassFlowRate*Cp*(Tsup - Tz)
REAL(r64), INTENT(OUT) :: SumNonAirSystem ! Zone sum of non air system convective heat gains
REAL(r64), INTENT(OUT) :: CzdTdt ! Zone air energy storage term.
REAL(r64), INTENT(OUT) :: imBalance ! put all terms in eq. 5 on RHS , should be zero
! 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) :: RhoAir
REAL(r64) :: CpAir ! Specific heat of air
INTEGER :: SurfNum ! Surface number
!unused REAL(r64) :: HA ! Hc*Area
REAL(r64) :: Area ! Effective surface area
REAL(r64) :: RefAirTemp ! Reference air temperature for surface convection calculations
!unused LOGICAL :: FirstTimeFlag
!unused INTEGER :: Tref ! Used to check if reference air temp for all surfaces in the zone are the same
!unused REAL(r64) :: ZoneMult
INTEGER :: ADUListIndex
INTEGER :: ADUNum
INTEGER :: ADUInNode
INTEGER :: ADUOutNode
REAL(r64) :: SumSysMCp
REAL(r64) :: SumSysMCpT
REAL(r64) :: Threshold
REAL(r64) :: SumRetAirGains
SumIntGains = 0.0D0 ! Zone sum of convective internal gains
SumHADTsurfs = 0.0D0 ! Zone sum of Hc*Area*(Tsurf - Tz)
SumMCpDTzones = 0.0D0 ! zone sum of MassFlowRate*cp*(TremotZone - Tz) transfer air from other zone, Mixing
SumMCpDtInfil = 0.0D0 ! Zone sum of MassFlowRate*Cp*(Tout - Tz)
SumMCpDTsystem = 0.0D0 ! Zone sum of air system MassFlowRate*Cp*(Tsup - Tz)
SumNonAirSystem= 0.0D0 !
CzdTdt = 0.0D0 !
imBalance = 0.0D0
SumSysMCp = 0.0d0
SumSysMCpT = 0.0d0
! Sum all convective internal gains: SumIntGain
Call SumAllInternalConvectionGains(ZoneNum, SumIntGains)
! 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, SumRetAirGains)
SumIntGains = SumIntGains + SumRetAirGains
END IF
! sum non-system air flow transfers between zones
SumMCpDTzones = MCPTM(ZoneNum) - MCPM(ZoneNum)* MAT(ZoneNum) ! but maybe it should be ZTAV(ZoneNum)
! Sum non-system air flow, i.e. infiltration, simple ventilation, earth tube
! reuse SumMCp, SumMCpT from CalcZoneSum but use MAT (or maybe ZTAV?) to complete
SumMCpDtInfil = (MCPTI(ZoneNum) - MCPI(ZoneNum)* MAT(ZoneNum)) & ! infiltration
+ (MCPTV(ZoneNum) - MCPV(ZoneNum)* MAT(ZoneNum)) & ! Ventilation (simple)
+ (MCPTE(ZoneNum) - MCPE(ZoneNum)* MAT(ZoneNum)) & ! Earth tube.
+ (MCPTC(ZoneNum) - MCPC(ZoneNum)* MAT(ZoneNum)) & ! Cooltower
+ (MDotCPOA(ZoneNum)*Zone(ZoneNum)%OutDryBulbTemp - MDotCPOA(ZoneNum)* MAT(ZoneNum)) ! combined OA flow
! Sum all multizone air flow calculated from AirflowNetwork by assuming no simple air infiltration model (if used)
IF (SimulateAirflowNetwork == AirflowNetworkControlMultizone .OR. SimulateAirflowNetwork == AirflowNetworkControlMultiADS .OR. &
(SimulateAirflowNetwork == AirflowNetworkControlSimpleADS .AND. AirflowNetworkFanActivated)) THEN
! Multizone airflow calculated in AirflowNetwork
SumMCpDtInfil = AirflowNetworkExchangeData(ZoneNum)%SumMCpT - AirflowNetworkExchangeData(ZoneNum)%SumMCp * MAT(ZoneNum)
SumMCpDTzones = AirflowNetworkExchangeData(ZoneNum)%SumMMCpT - AirflowNetworkExchangeData(ZoneNum)%SumMMCp * MAT(ZoneNum)
END IF
! Sum all system air flow: reusing how SumSysMCp, SumSysMCpT are calculated in CalcZoneSums
! Check to see if this is a controlled zone
! CR 7384 continuation needed below. eliminate do loop for speed and clarity
ControlledZoneAirFlag = .FALSE.
DO ZoneEquipConfigNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ZoneEquipConfigNum)%IsControlled) CYCLE
IF (ZoneEquipConfig(ZoneEquipConfigNum)%ActualZoneNum /= ZoneNum) CYCLE
ControlledZoneAirFlag = .TRUE.
EXIT
END DO ! ZoneEquipConfigNum
! Check to see if this is a plenum zone
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
NodeTemp = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%Temp
MassFlowRate = Node(ZoneEquipConfig(ZoneEquipConfigNum)%InletNode(NodeNum))%MassFlowRate
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumMCpDTsystem = SumMCpDTsystem + MassFlowRate * CpAir * (NodeTemp - MAT(ZoneNum))
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)
SumMCpDTsystem = SumMCpDTsystem + MassFlowRate * CpAir * (NodeTemp - MAT(ZoneNum))
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)
SumMCpDTsystem = SumMCpDTsystem + MassFlowRate * CpAir * (NodeTemp - MAT(ZoneNum))
END IF
IF (AirDistUnit(ADUNum)%DownStreamLeak) THEN
ADUOutNode = AirDistUnit(ADUNum)%OutletNodeNum
NodeTemp = Node(ADUOutNode)%Temp
MassFlowRate = AirDistUnit(ADUNum)%MassFlowRateDnStrLk
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), NodeTemp)
SumMCpDTsystem = SumMCpDTsystem + MassFlowRate * CpAir * (NodeTemp - MAT(ZoneNum))
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)
SumMCpDTsystem = SumMCpDTsystem + MassFlowRate * CpAir * (NodeTemp - MAT(ZoneNum))
END IF
! non air system response.
SumNonAirSystem = NonAirSystemResponse(ZoneNum) + SumConvHTRadSys(ZoneNum)
! 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
Area = Surface(SurfNum)%Area ! For windows, this is the glazing area
! determine reference air temperature for this surface's convective heat transfer model
SELECT CASE (Surface(SurfNum)%TAirRef)
CASE (ZoneMeanAirTemp)
! The zone air is the reference temperature
RefAirTemp = MAT(ZoneNum)
CASE (AdjacentAirTemp)
RefAirTemp = TempEffBulkAir(SurfNum)
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.
DO NodeNum = 1, ZoneEquipConfig(ZoneEquipConfigNum)%NumInletNodes
! Get node conditions
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
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
CASE DEFAULT
! currently set to mean air temp but should add error warning here
RefAirTemp = MAT(ZoneNum)
END SELECT
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.
SumIntGains = SumIntGains + SurfaceWindow(SurfNum)%DividerConduction
END IF
! Other convection term is applicable to equivalent layer window (ASHWAT) model
IF (Construct(Surface(SurfNum)%Construction)%WindowTypeEQL) &
SumIntGains = SumIntGains + 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) &
SumIntGains = SumIntGains + SurfaceWindow(SurfNum)%ConvHeatFlowNatural
! Convective heat gain from airflow window
IF (SurfaceWindow(SurfNum)%AirFlowThisTS > 0.0d0) THEN
SumIntGains = SumIntGains + SurfaceWindow(SurfNum)%ConvHeatGainToZoneAir
IF (Zone(ZoneNum)%NoHeatToReturnAir) THEN
SumIntGains = SumIntGains + SurfaceWindow(SurfNum)%RetHeatGainToZoneAir
END IF
ENDIF
! Add to the surface convection sums
IF (SurfaceWindow(SurfNum)%FrameArea > 0.0d0) THEN
! Window frame contribution
SumHADTsurfs = SumHADTsurfs + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%FrameArea * &
(1.0d0 + SurfaceWindow(SurfNum)%ProjCorrFrIn) &
* (SurfaceWindow(SurfNum)%FrameTempSurfIn - RefAirTemp)
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)
SumHADTsurfs = SumHADTsurfs + HConvIn(SurfNum) * SurfaceWindow(SurfNum)%DividerArea * &
(1.0d0 + 2.0d0 * SurfaceWindow(SurfNum)%ProjCorrDivIn) &
* (SurfaceWindow(SurfNum)%DividerTempSurfIn - RefAirTemp)
END IF
END IF ! End of check if window
SumHADTsurfs = SumHADTsurfs + HConvIn(SurfNum) * Area * ( TempSurfInTmp(SurfNum) - RefAirTemp)
END DO ! SurfNum
! now calculate air energy storage source term.
! capacitance is volume * density * heat capacity
CpAir = PsyCpAirFnWTdb(ZoneAirHumRat(ZoneNum), MAT(ZoneNum))
RhoAir = PsyRhoAirFnPbTdbW(OutBaroPress,MAT(ZoneNum),ZoneAirHumRat(ZoneNum))
SELECT CASE (ZoneAirSolutionAlgo)
CASE (Use3rdOrder)
CzdTdt = RhoAir * CpAir * Zone(ZoneNum)%Volume*ZoneVolCapMultpSens &
* ( MAT(ZoneNum) - ZTM1(ZoneNum)) &
/ (TimeStepSys*SecInHour)
! Exact solution
CASE (UseAnalyticalSolution)
CzdTdt = TempIndCoef-TempDepCoef*MAT(ZoneNum)
CASE (UseEulerMethod)
CzdTdt = AIRRAT(ZoneNum)*(MAT(ZoneNum) - ZoneT1(ZoneNum))
END SELECT
IF (DisplayZoneAirHeatBalanceOffBalance) THEN
imBalance = SumIntGains + SumHADTsurfs + SumMCpDTzones + SumMCpDtInfil + SumMCpDTsystem + SumNonAirSystem - CzdTdt
! throw warning if seriously out of balance (this may need to be removed if too noisy... )
! formulate dynamic threshold value based on 20% of quadrature sum of components
Threshold = 0.2D0 * SQRT(SumIntGains**2 + SumHADTsurfs**2 + SumMCpDTzones**2 + SumMCpDtInfil**2 &
+ SumMCpDTsystem**2 + SumNonAirSystem**2 + CzdTdt**2)
IF ((ABS(ImBalance) > Threshold) .AND. (.NOT. WarmUpFlag) &
.AND. (.NOT. DoingSizing) ) THEN ! air balance is out by more than threshold
IF (Zone(ZoneNum)%AirHBimBalanceErrIndex == 0) THEN
Call ShowWarningMessage('Zone Air Heat Balance is out of balance for zone named ' &
//trim(Zone(ZoneNum)%Name))
Call ShowContinueError('Zone Air Heat Balance Deviation Rate is more than ' &
// Trim(RoundSigDigits(Threshold,1)) //' {W}')
If (TurnFansOn) then
Call ShowContinueError('Night cycle fan operation may be causing above error')
ENDIF
Call ShowContinueErrorTimeStamp(' Occurance info: ')
ENDIF
Call ShowRecurringWarningErrorAtEnd('Zone Air Heat Balance is out of balance ... zone named ' // &
trim(Zone(ZoneNum)%Name) , Zone(ZoneNum)%AirHBimBalanceErrIndex, &
ReportMinOf=ABS(ImBalance)-Threshold,ReportMaxOf=ABS(ImBalance)-Threshold,ReportMinUnits='{W}',ReportMaxUnits='{W}')
ENDIF
ENDIF
RETURN
END SUBROUTINE CalcZoneComponentLoadSums