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.
SUBROUTINE ReportMaxVentilationLoads
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher (with minor assistance from RKS)
! DATE WRITTEN July 2004
! MODIFIED Dec. 2006, BG. reengineered to add zone forced air units to vent rates and loads
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! calculate and report zone ventilation loads
! METHODOLOGY EMPLOYED:
! calculate energy contribution of outside air through mixing box and pro-rate to
! zones according to zone mass flow rates.
! REFERENCES:
! na
! USE STATEMENTS:
USE Psychrometrics, ONLY: PsyHFnTdbW, PsyRhoAirFnPbTdbW
USE DataZoneEnergyDemands
USE DataGlobalConstants
USE DataHeatBalance, ONLY: Zone, ZnAirRpt, ZonePreDefRep
USE DataHeatBalFanSys, ONLY: MAT, ZoneAirHumRatAvg
USE DataEnvironment, ONLY: StdBaroPress, StdRhoAir, OutAirDensity, OutBaroPress
USE WindowAC, Only : GetWindowACOutAirNode, GetWindowACMixedAirNode, &
GetWindowACZoneInletAirNode, GetWindowACReturnAirNode
USE PackagedTerminalHeatPump, Only : GetPTUnitOutAirNode, GetPTUnitMixedAirNode, &
GetPTUnitZoneInletAirNode, GetPTUnitReturnAirNode
USE FanCoilUnits, Only : GetFanCoilOutAirNode, GetFanCoilMixedAirNode, &
GetFanCoilZoneInletAirNode, GetFanCoilReturnAirNode
USE UnitVentilator , Only : GetUnitVentilatorOutAirNode, GetUnitVentilatorMixedAirNode, &
GetUnitVentilatorZoneInletAirNode, GetUnitVentilatorReturnAirNode
USE PurchasedAirManager, Only : GetPurchasedAirOutAirMassFlow, GetPurchasedAirZoneInletAirNode, &
GetPurchasedAirMixedAirTemp, GetPurchasedAirMixedAirHumRat, GetPurchasedAirReturnAirNode
USE HVACStandAloneERV , Only : GetStandAloneERVOutAirNode, GetStandAloneERVReturnAirNode, &
GetStandAloneERVZoneInletAirNode
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: SmallLoad = 0.1d0 !(W)
REAL(r64), PARAMETER :: KJperJ = 0.001d0 !kilojoules per joules
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CtrlZoneNum !ZONE counter
INTEGER :: ZoneInNum !counter for zone air distribution inlets
INTEGER :: ReturnAirNode !node number for return node on primary air loop
INTEGER :: MixedAirNode !mixed air node number (right after the mixing box) on primary air loop
INTEGER :: AirLoopNum
INTEGER :: AirDistCoolInletNodeNum
INTEGER :: AirDistHeatInletNodeNum
REAL(r64) :: AirSysEnthReturnAir !enthalpy of the return air (mixing box inlet node, return side)
REAL(r64) :: AirSysEnthMixedAir !enthalpy of the mixed air (mixing box outlet node, mixed air side)
REAL(r64) :: AirSysZoneVentLoad !ventilation load attributed to a particular zone from primary air system
REAL(r64) :: ADUCoolFlowrate
REAL(r64) :: ADUHeatFlowrate
REAL(r64) :: AirSysTotalMixFlowRate !Mixed air flow
REAL(r64) :: AirSysOutAirFlow ! outside air flow rate for zone from primary air system
REAL(r64) :: ZFAUEnthReturnAir !Zone forced Air unit enthalpy of the return air
REAL(r64) :: ZFAUTempMixedAir !Zone forced Air unit dry-bulb temperature of the mixed air
REAL(r64) :: ZFAUHumRatMixedAir !Zone forced Air unit humidity ratio of the mixed air
REAL(r64) :: ZFAUEnthMixedAir !Zone forced Air unit enthalpy of the mixed air
REAL(r64) :: ZFAUFlowRate
REAL(r64) :: ZFAUZoneVentLoad !ventilation load attributed to a particular zone from zone forced air units
REAL(r64) :: ZFAUOutAirFlow !outside air flow rate for zone from zone forced air units.
INTEGER :: ZoneInletAirNode
REAL(r64) :: ZoneVentLoad !ventilation load attributed to a particular zone
REAL(r64) :: ZoneLoad !ventilation load attributed to a particular zone
REAL(r64) :: OutAirFlow !Total outside air flow
REAL(r64) :: ZoneFlowFrac !fraction of mixed air flowing to a zone
REAL(r64) :: ZoneVolume !Volume of zone
REAL(r64) :: currentZoneAirDensity ! current zone air density (outside barometric pressure)
INTEGER :: ActualZoneNum
INTEGER :: OutAirNode
INTEGER :: thisZoneEquipNum ! loop counter
! CALL GetComponentEnergyUse
IF (.not. VentReportStructureCreated) RETURN
IF (.not. VentLoadsReportEnabled) RETURN
!following inits are array assignments across all controlled zones.
ZoneOAMassFlow = 0.0d0
ZoneOAMass = 0.0d0
ZoneOAVolFlowStdRho = 0.0d0
ZoneOAVolStdRho = 0.0d0
ZoneOAVolFlowCrntRho = 0.0d0
ZoneOAVolCrntRho = 0.0d0
ZoneMechACH = 0.0d0
MaxCoolingLoadMetByVent = 0.0d0
MaxCoolingLoadAddedByVent = 0.0d0
MaxOvercoolingByVent = 0.0d0
MaxHeatingLoadMetByVent = 0.0d0
MaxHeatingLoadAddedByVent = 0.0d0
MaxOverheatingByVent = 0.0d0
MaxNoLoadHeatingByVent = 0.0d0
MaxNoLoadCoolingByVent = 0.0d0
DO CtrlZoneNum=1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZoneNum)%IsControlled) CYCLE
! first clear out working variables from previous zone.
AirDistCoolInletNodeNum = 0
AirDistHeatInletNodeNum = 0
ADUCoolFlowrate = 0.0d0
ADUHeatFlowrate = 0.0d0
AirSysTotalMixFlowRate = 0.0d0
AirSysZoneVentLoad = 0.0d0
AirSysOutAirFlow = 0.0d0
ZFAUFlowRate = 0.0d0
ZFAUZoneVentLoad = 0.0d0
ZFAUOutAirFlow = 0.0d0
OutAirFlow = 0.0d0
ZoneFlowFrac = 0.0d0
ZoneVolume = 0.0d0
!retrieve the zone load for each zone
ActualZoneNum = ZoneEquipConfig(CtrlZoneNum)%ActualZoneNum
ZoneLoad = ZoneSysEnergyDemand(ActualZoneNum)%TotalOutputRequired
ZoneVolume = Zone(ActualZoneNum)%Volume * Zone(ActualZoneNum)%Multiplier * Zone(ActualZoneNum)%ListMultiplier !CR 7170
!if system operating in deadband reset zone load
IF (DeadbandOrSetback(ActualZoneNum)) ZoneLoad = 0.0d0
IF (DeadbandOrSetback(ActualZoneNum))THEN
DBFlag = 1
ELSE
DBFlag = 0
ENDIF
! IF(AirLoopNum == 0 ) CYCLE !orig line (BG 12-8-06 changed, zone forced air equipment seems to get excluded here...)
! first deal with any (and all) Zone Forced Air Units that might have outside air.
DO thisZoneEquipNum = 1, ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%NumOfEquipTypes
SELECT CASE (ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum))
! case statement to cover all possible zone forced air units that could have outside air
CASE (WindowAC_Num) ! Window Air Conditioner
OutAirNode = &
GetWindowACOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (OutAirNode > 0) ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
ZoneInletAirNode = &
GetWindowACZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
MixedAirNode = &
GetWindowACMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ReturnAirNode = &
GetWindowACReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
CASE (PkgTermHPAirToAir_Num, PkgTermACAirToAir_Num, PkgTermHPWaterToAir_Num)
OutAirNode = GetPTUnitOutAirNode(ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
If (OutAirNode > 0) ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
ZoneInletAirNode = &
GetPTUnitZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) , &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum))
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
MixedAirNode = &
GetPTUnitMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
ReturnAirNode = &
GetPTUnitReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum), &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipType_Num(thisZoneEquipNum) )
If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
CASE (FanCoil4Pipe_Num)
OutAirNode = &
GetFanCoilOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (OutAirNode > 0) ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
ZoneInletAirNode = &
GetFanCoilZoneInletAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
MixedAirNode = &
GetFanCoilMixedAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ReturnAirNode = &
GetFanCoilReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
CASE (UnitVentilator_Num)
OutAirNode = &
GetUnitVentilatorOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (OutAirNode > 0) ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
ZoneInletAirNode = &
GetUnitVentilatorZoneInletAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
MixedAirNode = &
GetUnitVentilatorMixedAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ReturnAirNode = &
GetUnitVentilatorReturnAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
CASE (PurchasedAir_Num)
ZFAUOutAirFlow = ZFAUOutAirFlow + &
GetPurchasedAirOutAirMassFlow( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ZoneInletAirNode = &
GetPurchasedAirZoneInletAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
ZFAUTempMixedAir = &
GetPurchasedAirMixedAirTemp( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ZFAUHumRatMixedAir = &
GetPurchasedAirMixedAirHumRat( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
ReturnAirNode = &
GetPurchasedAirReturnAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If ((ZFAUFlowRate > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(ZFAUTempMixedAir, ZFAUHumRatMixedAir)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
CASE (ERVStandAlone_Num)
OutAirNode = &
GetStandAloneERVOutAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (OutAirNode > 0) ZFAUOutAirFlow = ZFAUOutAirFlow + Node(OutAirNode)%MassFlowRate
ZoneInletAirNode = &
GetStandAloneERVZoneInletAirNode( &
ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If (ZoneInletAirNode > 0) ZFAUFlowRate = MAX(Node(ZoneInletAirNode)%MassFlowRate,0.0d0)
MixedAirNode = ZoneInletAirNode
ReturnAirNode = &
GetStandAloneERVReturnAirNode( ZoneEquipList(ZoneEquipConfig(CtrlZoneNum)%EquipListIndex)%EquipIndex(thisZoneEquipNum) )
If ((MixedAirNode > 0) .AND. (ReturnAirNode > 0)) then
ZFAUEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
ZFAUEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
ZFAUZoneVentLoad = ZFAUZoneVentLoad + &
(ZFAUFlowRate)*(ZFAUEnthMixedAir-ZFAUEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ELSE
ZFAUZoneVentLoad = ZFAUZoneVentLoad + 0.0d0
ENDIF
END SELECT
ENDDO
! retrieve air loop indexes
AirLoopNum = ZoneEquipConfig(CtrlZoneNum)%AirLoopNum
If (AirLoopNum /= 0 ) then ! deal with primary air system
!loop over the zone supply air path inlet nodes
DO ZoneInNum=1,ZoneEquipConfig(CtrlZoneNum)%NumInletNodes
AirDistCoolInletNodeNum = MAX(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode,0)
AirDistHeatInletNodeNum = MAX(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode,0)
! Set for cooling or heating path
IF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum == 0)THEN
ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
+ MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
ELSEIF(AirDistHeatInletNodeNum > 0 .AND. AirDistCoolInletNodeNum == 0)THEN
ADUHeatFlowrate = ADUHeatFlowrate & ! CR7244 need to accumulate flow across multiple inlets
+ MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
ELSEIF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum > 0 .AND. &
AirDistCoolInletNodeNum /= AirDistHeatInletNodeNum) THEN
! dual ducts! CR7244 need to accumulate flow across multiple inlets (don't count same inlet twice)
ADUHeatFlowrate = ADUHeatFlowrate & ! CR7244 need to accumulate flow across multiple inlets
+ MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
+ MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
ELSEIF(AirDistCoolInletNodeNum > 0 .AND. AirDistHeatInletNodeNum > 0) THEN
! dual ducts! CR7244 need to accumulate flow across multiple inlets (don't count same inlet twice)
ADUCoolFlowrate = ADUCoolFlowrate & ! CR7244 need to accumulate flow across multiple inlets
+ MAX(Node(ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode)%MassFlowRate,0.0d0)
ELSE
! do nothing (already inits)
END IF
END DO
!Find the mixed air node and return air node of the system that supplies the zone
MixedAirNode = PrimaryAirSystem(AirLoopNum)%OASysOutletNodeNum
ReturnAirNode = PrimaryAirSystem(AirLoopNum)%OASysInletNodeNum
IF(MixedAirNode == 0 .OR. ReturnAirNode == 0) then
AirSysZoneVentLoad = 0.0d0
AirSysOutAirFlow = 0.0d0
ELSE
!Calculate return and mixed air ethalpies
AirSysEnthReturnAir = PsyHFnTdbW(Node(ReturnAirNode)%Temp, Node(ReturnAirNode)%HumRat)
AirSysEnthMixedAir = PsyHFnTdbW(Node(MixedAirNode)%Temp, Node(MixedAirNode)%HumRat)
IF(PrimaryAirSystem(AirLoopNum)%OASysExists) THEN
OutAirNode = PrimaryAirSystem(AirLoopNum)%OAMixOAInNodeNum
AirSysOutAirFlow = Node(OutAirNode)%MassFlowRate
ELSE
AirSysOutAirFlow = 0.0d0
END IF
AirSysTotalMixFlowRate = Node(MixedAirNode)%MassFlowRate
IF(AirSysTotalMixFlowRate .NE. 0.0d0) THEN
ZoneFlowFrac = (ADUCoolFlowrate+ADUHeatFlowrate)/AirSysTotalMixFlowRate
AirSysOutAirFlow = ZoneFlowFrac * AirSysOutAirFlow
ELSE
ZoneFlowfrac = 0.0d0
AirSysOutAirFlow = 0.0d0
END IF
!Calculate the zone ventilation load for this supply air path (i.e. zone inlet)
AirSysZoneVentLoad = &
(ADUCoolFlowrate+ADUHeatFlowrate)*(AirSysEnthMixedAir-AirSysEnthReturnAir)* TimeStepSys * SecInHour !*KJperJ
ENDIF
END IF ! primary air system present
!now combine OA flow from zone forced air units with primary air system
OutAirFlow = AirSysOutAirFlow + ZFAUOutAirFlow
! assign report variables
ZoneOAMassFlow(CtrlZoneNum) = OutAirFlow
ZoneOAMass(CtrlZoneNum) = ZoneOAMassFlow(CtrlZoneNum)* TimeStepSys* SecInHour
! determine volumetric values from mass flow using standard density (adjusted for elevation)
ZoneOAVolFlowStdRho(CtrlZoneNum) = ZoneOAMassFlow(CtrlZoneNum) / StdRhoAir
ZoneOAVolStdRho(CtrlZoneNum) = ZoneOAVolFlowStdRho(CtrlZoneNum) * TimeStepSys* SecInHour
! determine volumetric values from mass flow using current air density for zone (adjusted for elevation)
currentZoneAirDensity = PsyRhoAirFnPbTdbW(OutBaroPress, MAT(ActualZoneNum), ZoneAirHumRatAvg(ActualZoneNum))
IF (currentZoneAirDensity > 0.0D0) ZoneOAVolFlowCrntRho(CtrlZoneNum) = ZoneOAMassFlow(CtrlZoneNum) / currentZoneAirDensity
ZoneOAVolCrntRho(CtrlZoneNum) = ZoneOAVolFlowCrntRho(CtrlZoneNum) * TimeStepSys* SecInHour
if (ZoneVolume > 0.0d0) ZoneMechACH(CtrlZoneNum) = (ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys)/ZoneVolume
!store data for predefined tabular report on outside air
IF (ZonePreDefRep(ActualZoneNum)%isOccupied) THEN
!accumulate the occupied time
ZonePreDefRep(ActualZoneNum)%TotTimeOcc = ZonePreDefRep(ActualZoneNum)%TotTimeOcc + TimeStepSys
!mechnical ventilation
ZonePreDefRep(ActualZoneNum)%MechVentVolTotal = ZonePreDefRep(ActualZoneNum)%MechVentVolTotal + &
ZoneOAVolCrntRho(CtrlZoneNum)
IF ((ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys) .LT. ZonePreDefRep(ActualZoneNum)%MechVentVolMin) THEN
ZonePreDefRep(ActualZoneNum)%MechVentVolMin = ZoneOAVolCrntRho(CtrlZoneNum) / TimeStepSys
END IF
!infiltration
ZonePreDefRep(ActualZoneNum)%InfilVolTotal = ZonePreDefRep(ActualZoneNum)%InfilVolTotal + &
ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity
IF (ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity .LT. ZonePreDefRep(ActualZoneNum)%InfilVolMin) THEN
ZonePreDefRep(ActualZoneNum)%InfilVolMin = ZnAirRpt(ActualZoneNum)%InfilVolumeCurDensity
END IF
!'simple' mechanical ventilation
ZonePreDefRep(ActualZoneNum)%SimpVentVolTotal = ZonePreDefRep(ActualZoneNum)%SimpVentVolTotal + &
ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity
IF (ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity .LT. ZonePreDefRep(ActualZoneNum)%SimpVentVolMin) THEN
ZonePreDefRep(ActualZoneNum)%SimpVentVolMin = ZnAirRpt(ActualZoneNum)%VentilVolumeCurDensity
END IF
END IF
!now combine Vent load from zone forced air units with primary air system
ZoneVentLoad = AirSysZoneVentLoad + ZFAUZoneVentLoad
!cycle if ZoneVentLoad is small
IF(ABS(ZoneVentLoad) < SmallLoad) CYCLE ! orig. had RETURN here, BG changed to CYCLE for next controlled zone in do loop.
!Ventilation Heating
IF (ZoneVentLoad > SmallLoad)THEN
!Zone cooling load
IF(ZoneLoad < -SmallLoad)THEN
MaxCoolingLoadAddedByVent(CtrlZoneNum) = MaxCoolingLoadAddedByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
!Zone heating load
ELSEIF(ZoneLoad > SmallLoad)THEN
IF(ZoneVentLoad > ZoneLoad)THEN
MaxHeatingLoadMetByVent(CtrlZoneNum) = MaxHeatingLoadMetByVent(CtrlZoneNum) + ABS(ZoneLoad)
MaxOverheatingByVent(CtrlZoneNum) = MaxOverheatingByVent(CtrlZoneNum) + &
(ZoneVentLoad - ZoneLoad )
ELSE
MaxHeatingLoadMetByVent(CtrlZoneNum) = MaxHeatingLoadMetByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
ENDIF
!No Zone Load
ELSE
MaxNoLoadHeatingByVent(CtrlZoneNum) = MaxNoLoadHeatingByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
ENDIF
!Ventilation Cooling
ELSEIF (ZoneVentLoad < -SmallLoad)THEN
!Zone cooling load
IF(ZoneLoad < -SmallLoad)THEN
IF(ZoneVentLoad < ZoneLoad)THEN
MaxCoolingLoadMetByVent(CtrlZoneNum) = MaxCoolingLoadMetByVent(CtrlZoneNum) + ABS(ZoneLoad)
MaxOvercoolingByVent(CtrlZoneNum) = MaxOvercoolingByVent(CtrlZoneNum) + &
ABS(ZoneVentLoad - ZoneLoad )
ELSE
MaxCoolingLoadMetByVent(CtrlZoneNum) = MaxCoolingLoadMetByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
ENDIF
!Zone heating load
ELSEIF(ZoneLoad > SmallLoad)THEN
MaxHeatingLoadAddedByVent(CtrlZoneNum) = MaxHeatingLoadAddedByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
!No Zone Load
ELSE
MaxNoLoadCoolingByVent(CtrlZoneNum) = MaxNoLoadCoolingByVent(CtrlZoneNum) + ABS(ZoneVentLoad)
ENDIF
!Ventilation No Load
ELSE
ENDIF
END DO ! loop over controlled zones
RETURN
END Subroutine ReportMaxVentilationLoads