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.
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 CalcZoneMassBalance
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN May 1997
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Perform zone mass balance to get outlet air flow conditions.
! METHODOLOGY EMPLOYED:
! Mass continuity equation.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataLoopNode, ONLY : Node
USE DataAirLoop, ONLY : AirLoopFlow
USE DataRoomAirModel ! UCSD
USE DataHVACGlobals, ONLY : NumPrimaryAirSys, AirLoopsSimOnce
USE DataAirSystems, ONLY : PrimaryAirSystem
USE DataAirflowNetwork, ONLY : AirflowNetworkNumOfExhFan
USE DataGlobals, ONLY: isPulseZoneSizing
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ZoneNum
INTEGER :: NodeNum
INTEGER :: RetNode ! return air node number
INTEGER :: ZoneNode ! zone air node number
INTEGER :: AirLoopNum
REAL(r64) :: TotInletAirMassFlowRate
REAL(r64) :: TotInletAirMassFlowRateMax
REAL(r64) :: TotInletAirMassFlowRateMaxAvail
REAL(r64) :: TotInletAirMassFlowRateMin
REAL(r64) :: TotInletAirMassFlowRateMinAvail
REAL(r64) :: TotExhaustAirMassFlowRate
REAL(r64) :: TotSupplyAirMassFlowRate
DO ZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
TotInletAirMassFlowRate = 0.d0
TotInletAirMassFlowRateMax = 0.d0
TotInletAirMassFlowRateMaxAvail = 0.d0
TotInletAirMassFlowRateMin = 0.d0
TotInletAirMassFlowRateMinAvail = 0.d0
TotExhaustAirMassFlowRate = 0.d0
DO NodeNum = 1, ZoneEquipConfig(ZoneNum)%NumInletNodes
TotInletAirMassFlowRate = TotInletAirMassFlowRate + Node(ZoneEquipConfig(ZoneNum)%InletNode(NodeNum))%MassFlowRate
TotInletAirMassFlowRateMax = TotInletAirMassFlowRateMax + &
Node(ZoneEquipConfig(ZoneNum)%InletNode(NodeNum))%MassFlowRateMax
TotInletAirMassFlowRateMaxAvail = TotInletAirMassFlowRateMaxAvail + &
Node(ZoneEquipConfig(ZoneNum)%InletNode(NodeNum))%MassFlowRateMaxAvail
TotInletAirMassFlowRateMin = TotInletAirMassFlowRateMin + &
Node(ZoneEquipConfig(ZoneNum)%InletNode(NodeNum))%MassFlowRateMin
TotInletAirMassFlowRateMinAvail = TotInletAirMassFlowRateMinAvail + &
Node(ZoneEquipConfig(ZoneNum)%InletNode(NodeNum))%MassFlowRateMinAvail
END DO
DO NodeNum = 1, ZoneEquipConfig(ZoneNum)%NumExhaustNodes
If (AirflowNetworkNumOfExhFan .EQ. 0) &
TotExhaustAirMassFlowRate = TotExhaustAirMassFlowRate &
+ Node(ZoneEquipConfig(ZoneNum)%ExhaustNode(NodeNum))%MassFlowRate
END DO
AirLoopNum = ZoneEquipConfig(ZoneNum)%AirLoopNum
ZoneNode = ZoneEquipConfig(ZoneNum)%ZoneNode
Node(ZoneNode)%MassFlowRate = TotInletAirMassFlowRate
Node(ZoneNode)%MassFlowRateMax = TotInletAirMassFlowRateMax
Node(ZoneNode)%MassFlowRateMaxAvail = TotInletAirMassFlowRateMaxAvail
Node(ZoneNode)%MassFlowRateMin = TotInletAirMassFlowRateMin
Node(ZoneNode)%MassFlowRateMinAvail = TotInletAirMassFlowRateMinAvail
! Update Return Air Node Conditions; If one Exists
RetNode = ZoneEquipConfig(ZoneNum)%ReturnAirNode
If(RetNode > 0) Then
Node(RetNode)%MassFlowRate = &
MAX(Node(ZoneNode)%MassFlowRate - (TotExhaustAirMassFlowRate - ZoneEquipConfig(ZoneNum)%ZoneExhBalanced), 0.0d0)
IF (AirLoopNum > 0) THEN
IF ( .NOT. PrimaryAirSystem(AirLoopNum)%OASysExists) THEN
Node(RetNode)%MassFlowRate = &
MAX(Node(ZoneNode)%MassFlowRate - (TotExhaustAirMassFlowRate - ZoneEquipConfig(ZoneNum)%ZoneExh), 0.0d0)
END IF
END IF
Node(RetNode)%MassFlowRateMax = Node(ZoneNode)%MassFlowRateMax
Node(RetNode)%MassFlowRateMin = Node(ZoneNode)%MassFlowRateMin
Node(RetNode)%MassFlowRateMaxAvail = Node(ZoneNode)%MassFlowRateMaxAvail
Node(RetNode)%MassFlowRateMinAvail = 0.0d0
End If
TotSupplyAirMassFlowRate = TotInletAirMassFlowRate - (TotExhaustAirMassFlowRate - ZoneEquipConfig(ZoneNum)%ZoneExh) &
- ZoneEquipConfig(ZoneNum)%PlenumMassFlow
IF (AirLoopNum > 0) THEN
AirLoopFlow(AirLoopNum)%ZoneExhaust = AirLoopFlow(AirLoopNum)%ZoneExhaust + &
ZoneEquipConfig(ZoneNum)%ZoneExh
AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced = AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced &
+ ZoneEquipConfig(ZoneNum)%ZoneExhBalanced
AirLoopFlow(AirLoopNum)%SupFlow = AirLoopFlow(AirLoopNum)%SupFlow + TotSupplyAirMassFlowRate
AirLoopFlow(AirLoopNum)%RetFlow0 = AirLoopFlow(AirLoopNum)%RetFlow0 + Node(RetNode)%MassFlowRate
AirLoopFlow(AirLoopNum)%RecircFlow = AirLoopFlow(AirLoopNum)%RecircFlow + ZoneEquipConfig(ZoneNum)%PlenumMassFlow
END IF
END DO
! Calculate an air loop return air flow rate
DO AirLoopNum=1,NumPrimaryAirSys
IF ( (AirLoopFlow(AirLoopNum)%ZoneExhaust > &
(AirLoopFlow(AirLoopNum)%SupFlow + AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced) .OR. &
AirLoopFlow(AirLoopNum)%ZoneExhaust > &
(AirLoopFlow(AirLoopNum)%MaxOutAir + AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced)) .AND. &
.NOT. AirLoopFlow(AirLoopNum)%FlowError .AND. AirLoopsSimOnce) THEN
IF (.NOT. isPulseZoneSizing) THEN
CALL ShowWarningError('In AirLoopHVAC ' // TRIM(PrimaryAirSystem(AirLoopNum)%Name) // &
' there is unbalanced exhaust air flow.')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError(' Unless there is balancing infiltration / ventilation air flow, this will result in')
CALL ShowContinueError(' load due to induced outdoor air being neglected in the simulation.')
AirLoopFlow(AirLoopNum)%FlowError = .TRUE.
END IF
END IF
AirLoopFlow(AirLoopNum)%ZoneExhaust = MIN(AirLoopFlow(AirLoopNum)%ZoneExhaust, &
(AirLoopFlow(AirLoopNum)%SupFlow + AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced))
AirLoopFlow(AirLoopNum)%ZoneExhaust = MIN(AirLoopFlow(AirLoopNum)%ZoneExhaust, &
(AirLoopFlow(AirLoopNum)%MaxOutAir + AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced))
AirLoopFlow(AirLoopNum)%RetFlow = AirLoopFlow(AirLoopNum)%SupFlow &
- (AirLoopFlow(AirLoopNum)%ZoneExhaust - AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced) &
+ AirLoopFlow(AirLoopNum)%RecircFlow
END DO
! adjust the zone return air flow rates to match the air loop return air flow rate
DO ZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ZoneNum)%IsControlled) CYCLE
RetNode = ZoneEquipConfig(ZoneNum)%ReturnAirNode
AirLoopNum = ZoneEquipConfig(ZoneNum)%AirLoopNum
IF (AirLoopNum > 0 .AND. RetNode > 0) THEN
IF (PrimaryAirSystem(AirLoopNum)%OASysExists) THEN
IF (AirLoopFlow(AirLoopNum)%RetFlow0 > 0.0d0) THEN
Node(RetNode)%MassFlowRate = Node(RetNode)%MassFlowRate * &
(AirLoopFlow(AirLoopNum)%RetFlow/AirLoopFlow(AirLoopNum)%RetFlow0)
ELSE
Node(RetNode)%MassFlowRate = 0.0d0
END IF
END IF
END IF
! IF (AirLoopNum == 0 .AND. RetNode > 0) THEN
! ! sometimes models for ZoneHVAC have input a return node, but no air loop HVAC.
! ! this block was tried but caused problems such as UA coil sizing issues and water coil controller problems
! ! CR 7967, no air loop HVAC, but there is a return air node that never gets used or set
! Node(RetNode)%MassFlowRate = 0.d0
! ENDIF
END DO
RETURN
END SUBROUTINE CalcZoneMassBalance