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 | ||
---|---|---|---|---|---|---|
logical | :: | FirstHVACIteration | ||||
logical | :: | SimAir |
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 SimZoneEquipment(FirstHVACIteration, SimAir)
! SUBROUTINE INFORMATION:
! AUTHOR Russ Taylor
! DATE WRITTEN May 1997
! MODIFIED Raustad/Shirey, FSEC, June 2003
! MODIFIED Gu, FSEC, Jan. 2004, Don Shirey, Aug 2009 (LatOutputProvided)
! July 2012, Chandan Sharma - FSEC: Added zone sys avail managers
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is responsible for determining
! how much of each type of energy every zone requires.
! In effect, this subroutine defines and simulates all
! the system types and in the case of hybrid systems
! which use more than one type of energy must determine
! how to apportion the load. An example of a hybrid system
! is a water loop heat pump with supplemental air. In
! this case, a zone will require water from the loop and
! cooled or heated air from the air system. A simpler
! example would be a VAV system with baseboard heaters
! METHODOLOGY EMPLOYED:
! 1. Determine zone load - this is zone temperature dependent
! 2. Determine balance point - the temperature at which the
! zone load is balanced by the system output. The way the
! balance point is determined will be different depending on
! the type of system being simulated.
! 3. Calculate zone energy requirements
! REFERENCES:
! na
! USE STATEMENTS:
USE DataHVACGlobals
USE DataHeatBalFanSys, ONLY: NonAirSystemResponse, SysDepZoneLoads
USE ReturnAirPathManager, ONLY: SimReturnAirPath
USE ZoneAirLoopEquipmentManager, ONLY: ManageZoneAirLoopEquipment
USE PurchasedAirManager, ONLY: SimPurchasedAir
USE DirectAirManager, ONLY: SimDirectAir
USE HWBaseboardRadiator, ONLY: SimHWBaseboard
USE SteamBaseboardRadiator, ONLY: SimSteamBaseboard
USE BaseboardRadiator, ONLY: SimBaseboard
USE BaseboardElectric, ONLY: SimElectricBaseboard
USE SplitterComponent, ONLY: SimAirLoopSplitter
USE FanCoilUnits, ONLY: SimFanCoilUnit
USE Fans, ONLY: SimulateFanComponents
USE WindowAC, ONLY: SimWindowAC
USE PackagedTerminalHeatPump, ONLY: SimPackagedTerminalUnit
USE ZoneDehumidifier, ONLY: SimZoneDehumidifier
USE UnitVentilator, ONLY : SimUnitVentilator
USE UnitHeater, ONLY : SimUnitHeater
USE HeatRecovery, ONLY : SimHeatRecovery
USE OutdoorAirUnit, ONLY : SimOutdoorAirUnit
USE HVACStandAloneERV, ONLY: SimStandAloneERV
USE LowTempRadiantSystem, ONLY : SimLowTempRadiantSystem
USE HighTempRadiantSystem, ONLY : SimHighTempRadiantSystem
USE VentilatedSlab, ONLY : SimVentilatedSlab
USE ZonePlenum, ONLY : SimAirZonePlenum
USE DataAirflowNetwork, ONLY: SimulateAirflowNetwork,AirflowNetworkFanActivated,AirflowNetworkControlMultizone
USE WaterThermalTanks, ONLY: SimHeatPumpWaterHeater
USE DataAirSystems, ONLY : PrimaryAirSystem
USE DataAirLoop, ONLY : AirLoopControlInfo
USE ElectricBaseboardRadiator, ONLY: SimElecBaseboard
USE HVACVariableRefrigerantFlow, ONLY: SimulateVRF
USE RefrigeratedCase, ONLY: SimAirChillerSet
USE UserDefinedComponents, ONLY: SimZoneAirUserDefined
USE SystemAvailabilityManager, ONLY: GetZoneEqAvailabilityManager
USE DataGlobals, ONLY: isPulseZoneSizing
USE EvaporativeCoolers, ONLY: SimZoneEvaporativeCoolerUnit
USE HVACUnitarySystem, ONLY: SimUnitarySystem
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
LOGICAL FirstHVACIteration
LOGICAL SimAir
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: ActualZoneNum
INTEGER :: ControlledZoneNum
INTEGER :: EquipTypeNum
INTEGER :: SupplyAirPathNum
INTEGER :: CompNum
INTEGER :: EquipPtr
INTEGER :: AirLoopNum
INTEGER :: ZoneEquipTypeNum
INTEGER :: ZoneCompNum
LOGICAL :: SupPathInletChanged = .FALSE.
LOGICAL,SAVE :: FirstCall ! indicates first call to supply air path components
LOGICAL,SAVE :: MyOneTimeFlag = .TRUE.
LOGICAL :: ErrorFlag
LOGICAL :: ValidSAMComp = .FALSE.
REAL(r64) :: SysOutputProvided ! sensible output delivered by zone equipment (W)
REAL(r64) :: LatOutputProvided ! latent output delivered by zone equipment (kg/s)
REAL(r64) :: AirSysOutput
REAL(r64) :: NonAirSysOutput
LOGICAL :: ZoneHasAirLoopHVACTerminal = .FALSE. ! true if zone has an air loop terminal
LOGICAL :: ZoneHasAirLoopHVACDirectAir = .FALSE. ! true if zone has an uncontrolled air loop terminal
LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: DirectAirAndAirTerminalWarningIssued ! only warn once for each zone with problems
! Determine flow rate and temperature of supply air based on type of damper
FirstCall = .TRUE.
ErrorFlag = .FALSE.
DO SupplyAirPathNum = 1, NumSupplyAirPaths
DO CompNum = 1, SupplyAirPath(SupplyAirPathNum)%NumOfComponents
SELECT CASE (SupplyAirPath(SupplyAirPathNum)%ComponentType_Num(CompNum))
CASE (ZoneSplitter_Type) ! 'AirLoopHVAC:ZoneSplitter'
if (.NOT. (AirflowNetworkFanActivated .AND. SimulateAirflowNetwork > AirflowNetworkControlMultizone)) then
CALL SimAirLoopSplitter(SupplyAirPath(SupplyAirPathNum)%ComponentName(CompNum), &
FirstHVACIteration, FirstCall, SupPathInletChanged, &
CompIndex=SupplyAirPath(SupplyAirPathNum)%ComponentIndex(CompNum))
endif
CASE (ZoneSupplyPlenum_Type) ! 'AirLoopHVAC:SupplyPlenum'
CALL SimAirZonePlenum(SupplyAirPath(SupplyAirPathNum)%ComponentName(CompNum),ZoneSupplyPlenum_Type, &
SupplyAirPath(SupplyAirPathNum)%ComponentIndex(CompNum), &
FirstHVACIteration=FirstHVACIteration, FirstCall=FirstCall, &
PlenumInletChanged=SupPathInletChanged)
CASE DEFAULT
CALL ShowSevereError('Error found in Supply Air Path='//TRIM(SupplyAirPath(SupplyAirPathNum)%Name))
CALL ShowContinueError('Invalid Supply Air Path Component='// &
TRIM(SupplyAirPath(SupplyAirPathNum)%ComponentType(CompNum)))
CALL ShowFatalError('Preceding condition causes termination.')
END SELECT
END DO
END DO
IF (FirstCall .AND. .NOT. ALLOCATED(DirectAirAndAirTerminalWarningIssued)) THEN
ALLOCATE(DirectAirAndAirTerminalWarningIssued(NumOfZones) )
DirectAirAndAirTerminalWarningIssued = .FALSE.
ENDIF
FirstCall = .FALSE.
! Loop over all the primary air loop; simulate their components (equipment)
! and controllers
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
ActualZoneNum=ZoneEquipConfig(ControlledZoneNum)%ActualZoneNum
NonAirSystemResponse(ActualZoneNum) = 0.d0
SysDepZoneLoads(ActualZoneNum) = 0.d0
ZoneEquipConfig(ControlledZoneNum)%ZoneExh = 0.d0
ZoneEquipConfig(ControlledZoneNum)%ZoneExhBalanced = 0.d0
ZoneEquipConfig(ControlledZoneNum)%PlenumMassFlow = 0.d0
ZoneHasAirLoopHVACTerminal = .FALSE.
ZoneHasAirLoopHVACDirectAir = .FALSE.
CurZoneEqNum = ControlledZoneNum
CALL InitSystemOutputRequired(ActualZoneNum, SysOutputProvided, LatOutputProvided)
CALL SetZoneEquipSimOrder(ControlledZoneNum, ActualZoneNum)
! Air loop system availability manager status only applies to PIU and exhaust fans
! Reset fan SAM operation flags for zone fans.
TurnFansOn = .FALSE.
TurnFansOff = .FALSE.
DO EquipTypeNum = 1, ZoneEquipList(ControlledZoneNum)%NumOfEquipTypes
UnbalExhMassFlow = 0.d0
BalancedExhMassFlow = 0.d0
PlenumInducedMassFlow = 0.0d0
EquipPtr=PrioritySimOrder(EquipTypeNum)%EquipPtr
SysOutputProvided = 0.d0
LatOutputProvided = 0.d0
ZoneEquipTypeNum = PrioritySimOrder(EquipTypeNum)%EquipType_Num
ZoneCompNum = ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr)
ValidSAMComp = .FALSE.
IF (ZoneEquipTypeNum .LE. NumValidSysAvailZoneComponents) ValidSAMComp = .TRUE.
IF (ZoneCompNum .GT. 0 .AND. ValidSAMComp) THEN
CALL GetZoneEqAvailabilityManager(ZoneEquipTypeNum, ZoneCompNum, ErrorFlag)
IF(ZoneComp(ZoneEquipTypeNum)%ZoneCompAvailMgrs(ZoneCompNum)%AvailStatus .EQ. CycleOn) THEN
ZoneCompTurnFansOn = .TRUE.
ZoneCompTurnFansOff = .FALSE.
ELSEIF(ZoneComp(ZoneEquipTypeNum)%ZoneCompAvailMgrs(ZoneCompNum)%AvailStatus .EQ. ForceOff) THEN
ZoneCompTurnFansOn = .FALSE.
ZoneCompTurnFansOff = .TRUE.
ELSE
ZoneCompTurnFansOn = TurnFansOn
ZoneCompTurnFansOff = TurnFansOff
ENDIF
ELSE
ZoneCompTurnFansOn = TurnFansOn
ZoneCompTurnFansOff = TurnFansOff
ENDIF
SELECT CASE (ZoneEquipTypeNum)
CASE(AirDistUnit_Num) ! 'ZoneHVAC:AirDistributionUnit'
! Air loop system availability manager status only applies to PIU and exhaust fans
! Check to see if System Availability Managers are asking for fans to cycle on or shut off
! and set fan on/off flags accordingly.
IF (ZoneEquipAvail(ControlledZoneNum).EQ.CycleOn .OR. &
ZoneEquipAvail(ControlledZoneNum).EQ.CycleOnZoneFansOnly) THEN
TurnFansOn = .TRUE.
END IF
IF (ZoneEquipAvail(ControlledZoneNum).EQ.ForceOff) THEN
TurnFansOff = .TRUE.
END IF
CALL ManageZoneAirLoopEquipment(PrioritySimOrder(EquipTypeNum)%EquipName, &
FirstHVACIteration, AirSysOutput, NonAirSysOutput, &
LatOutputProvided, ActualZoneNum, ControlledZoneNum, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr) )
! reset status flags for other zone equipment
TurnFansOn = .FALSE.
TurnFansOff = .FALSE.
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + NonAirSysOutput
SysOutputProvided = NonAirSysOutput + AirSysOutput
ZoneHasAirLoopHVACTerminal = .TRUE.
CASE(DirectAir_Num) ! 'AirTerminal:SingleDuct:Uncontrolled'
CALL SimDirectAir(PrioritySimOrder(EquipTypeNum)%EquipName, &
ControlledZoneNum, FirstHVACIteration, &
SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
ZoneHasAirLoopHVACDirectAir = .TRUE.
CASE(VRFTerminalUnit_Num) ! 'ZoneHVAC:TerminalUnit:VariableRefrigerantFlow'
CALL SimulateVRF(PrioritySimOrder(EquipTypeNum)%EquipName, &
ControlledZoneNum, FirstHVACIteration, &
SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (WindowAC_Num) ! 'ZoneHVAC:WindowAirConditioner'
CALL SimWindowAC(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (PkgTermHPAirToAir_Num, PkgTermACAirToAir_Num, PkgTermHPWaterToAir_Num) ! 'ZoneHVAC:PackagedTerminalHeatPump'
! 'ZoneHVAC:PackagedTerminalAirConditioner'
! 'ZoneHVAC:WaterToAirHeatPump'
CALL SimPackagedTerminalUnit(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipTypeNum, ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (ZoneUnitarySystem_Num) ! 'AirloopHVAC:UnitarySystem'
CALL SimUnitarySystem(PrioritySimOrder(EquipTypeNum)%EquipName, FirstHVACIteration, &
ActualZoneNum, ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr),ZoneEquipment=.TRUE.)
CASE (ZoneDXDehumidifier_Num) ! 'ZoneHVAC:Dehumidifier:DX'
CALL SimZoneDehumidifier(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
SysDepZoneLoads(ActualZoneNum) = SysDepZoneLoads(ActualZoneNum) + SysOutputProvided
SysOutputProvided = 0.0d0 ! Reset to 0.0 since this equipment is controlled based on zone humidity level (not
! temperature) SysOutputProvided amount was already sent above to
! next Predict-Correct series of calcs via SysDepZoneLoads
CASE (FanCoil4Pipe_Num) ! 'ZoneHVAC:FourPipeFanCoil'
CALL SimFanCoilUnit(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, ControlledZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (UnitVentilator_Num) ! 'ZoneHVAC:UnitVentilator'
CALL SimUnitVentilator(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (UnitHeater_Num) ! 'ZoneHVAC:UnitHeater'
CALL SimUnitHeater(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE(PurchasedAir_Num) ! 'ZoneHVAC:IdealLoadsAirSystem'
CALL SimPurchasedAir(PrioritySimOrder(EquipTypeNum)%EquipName, &
SysOutputProvided, LatOutputProvided, FirstHVACIteration, &
ControlledZoneNum, ActualZoneNum, ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE(BBWater_Num) ! 'ZoneHVAC:Baseboard:RadiantConvective:Water'
CALL SimHWBaseboard(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
ControlledZoneNum, FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(BBSteam_Num) ! 'ZoneHVAC:Baseboard:RadiantConvective:Steam'
CALL SimSteamBaseboard(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
ControlledZoneNum, FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(BBWaterConvective_Num) ! 'ZoneHVAC:Baseboard:Convective:Water'
CALL SimBaseboard(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
ControlledZoneNum, FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(BBElectricConvective_Num) ! 'ZoneHVAC:Baseboard:Convective:Electric'
CALL SimElectricBaseBoard(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
ControlledZoneNum, SysOutputProvided, ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(HiTempRadiant_Num) ! 'ZoneHVAC:HighTemperatureRadiant'
CALL SimHighTempRadiantSystem(PrioritySimOrder(EquipTypeNum)%EquipName, &
FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
LatOutputProvided = 0.0d0 ! This baseboard currently sends its latent heat gain directly to predictor/corrector
! via SumLatentHTRadSys... so setting LatOutputProvided = 0.0
CASE (LoTempRadiant_Num) ! 'ZoneHVAC:LowTemperatureRadiant:VariableFlow', 'ZoneHVAC:LowTemperatureRadiant:ConstantFlow'
! 'ZoneHVAC:LowTemperatureRadiant:Electric'
CALL SimLowTempRadiantSystem(PrioritySimOrder(EquipTypeNum)%EquipName, &
FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(ZoneExhaustFan_Num) ! 'Fan:ZoneExhaust'
! Air loop system availability manager status only applies to PIU and exhaust fans
! Check to see if System Availability Managers are asking for fans to cycle on or shut off
! and set fan on/off flags accordingly.
IF (ZoneEquipAvail(ControlledZoneNum).EQ.CycleOn .OR. &
ZoneEquipAvail(ControlledZoneNum).EQ.CycleOnZoneFansOnly) THEN
TurnFansOn = .TRUE.
END IF
IF (ZoneEquipAvail(ControlledZoneNum).EQ.ForceOff) THEN
TurnFansOff = .TRUE.
END IF
CALL SimulateFanComponents(PrioritySimOrder(EquipTypeNum)%EquipName, &
FirstHVACIteration,ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
! reset status flags for other zone equipment
TurnFansOn = .FALSE.
TurnFansOff = .FALSE.
CASE (HeatXchngr_Num) ! 'HeatExchanger:AirToAir:FlatPlate'
CALL SimHeatRecovery(PrioritySimOrder(EquipTypeNum)%EquipName,FirstHVACIteration, &
ZoneEquipList(ControlledZoneNum)%EquipIndex(EquipPtr), ContFanCycCoil)
CASE (ERVStandAlone_Num) ! 'ZoneHVAC:EnergyRecoveryVentilator'
CALL SimStandAloneERV(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(ControlledZoneNum)%EquipIndex(EquipPtr))
CASE (HPWaterHeater_Num) ! 'WaterHeater:HeatPump'
CALL SimHeatPumpWaterHeater(PrioritySimOrder(EquipTypeNum)%EquipName, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(ControlledZoneNum)%EquipIndex(EquipPtr))
CASE (VentilatedSlab_Num) ! 'ZoneHVAC:VentilatedSlab'
CALL SimVentilatedSlab(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (OutdoorAirUnit_Num) ! 'ZoneHVAC:OutdoorAirUnit'
CALL SimOutdoorAirUnit(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE(BBElectric_Num) ! 'ZoneHVAC:Baseboard:RadiantConvective:Electric'
CALL SimElecBaseBoard(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
ControlledZoneNum, FirstHVACIteration, SysOutputProvided, &
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
LatOutputProvided = 0.0d0 ! This baseboard does not add/remove any latent heat
CASE(RefrigerationAirChillerSet_Num) ! 'ZoneHVAC:RefrigerationChillerSet'
CALL SimAirChillerSet(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
FirstHVACIteration, SysOutputProvided, LatOutputProvided,&
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
NonAirSystemResponse(ActualZoneNum) = NonAirSystemResponse(ActualZoneNum) + SysOutputProvided
CASE (UserDefinedZoneHVACForcedAir_Num)
CALL SimZoneAirUserDefined(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
SysOutputProvided, LatOutputProvided,&
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE (ZoneEvaporativeCoolerUnit_Num)
CALL SimZoneEvaporativeCoolerUnit(PrioritySimOrder(EquipTypeNum)%EquipName, ActualZoneNum, &
SysOutputProvided, LatOutputProvided,&
ZoneEquipList(CurZoneEqNum)%EquipIndex(EquipPtr))
CASE DEFAULT
END SELECT
ZoneEquipConfig(ControlledZoneNum)%ZoneExh = ZoneEquipConfig(ControlledZoneNum)%ZoneExh + UnbalExhMassFlow
ZoneEquipConfig(ControlledZoneNum)%ZoneExhBalanced = ZoneEquipConfig(ControlledZoneNum)%ZoneExhBalanced &
+ BalancedExhMassFlow
ZoneEquipConfig(ControlledZoneNum)%PlenumMassFlow = ZoneEquipConfig(ControlledZoneNum)%PlenumMassFlow + &
PlenumInducedMassFlow
CALL UpdateSystemOutputRequired(ActualZoneNum, SysOutputProvided, LatOutputProvided, EquipPriorityNum = EquipTypeNum)
IF (ZoneHasAirLoopHVACTerminal .AND. ZoneHasAirLoopHVACDirectAir) THEN
! zone has both AirTerminal:SingleDuct:Uncontrolled and another kind of Air terminal unit which is not supported
IF ( .NOT. DirectAirAndAirTerminalWarningIssued(ActualZoneNum)) THEN
CALL ShowSevereError('In zone "' // TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName) // &
'" there are too many air terminals served by AirLoopHVAC systems.')
CALL ShowContinueError('A single zone cannot have both an AirTerminal:SingleDuct:Uncontrolled ' &
// 'and also a second AirTerminal:* object.')
DirectAirAndAirTerminalWarningIssued(ActualZoneNum) = .TRUE.
ErrorFlag = .TRUE.
ENDIF
ENDIF
END DO ! zone loop
AirLoopNum = ZoneEquipConfig(ControlledZoneNum)%AirLoopNum
IF (AirLoopInit) THEN
IF (AirLoopNum > 0) THEN
IF ( .NOT. PrimaryAirSystem(AirLoopNum)%OASysExists) THEN
IF (ZoneEquipConfig(ControlledZoneNum)%ZoneExh > 0.0d0 .AND. .NOT. ZoneEquipConfig(ControlledZoneNum)%FlowError .AND. &
AirLoopsSimOnce) THEN
IF (.NOT. isPulseZoneSizing) THEN
CALL ShowWarningError('In zone ' // TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName) // &
' 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.')
ZoneEquipConfig(ControlledZoneNum)%FlowError = .TRUE.
END IF
END IF
! ZoneEquipConfig(ControlledZoneNum)%ZoneExh = 0.0
END IF
ELSE
IF (ZoneEquipConfig(ControlledZoneNum)%ZoneExh > 0.0d0 .AND. .NOT. ZoneEquipConfig(ControlledZoneNum)%FlowError .AND. &
AirLoopsSimOnce) THEN
IF (.NOT. isPulseZoneSizing) THEN
CALL ShowWarningError('In zone ' // TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName) // &
' 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.')
ZoneEquipConfig(ControlledZoneNum)%FlowError = .TRUE.
END IF
END IF
! ZoneEquipConfig(ControlledZoneNum)%ZoneExh = 0.0
END IF
END IF
END DO ! End of controlled zone loop
CurZoneEqNum = 0
!This is the call to the Supply Air Path after the components are simulated to update
! the path inlets
! Process supply air path components in reverse order
DO SupplyAirPathNum = 1, NumSupplyAirPaths
SupPathInletChanged = .FALSE.
DO CompNum = SupplyAirPath(SupplyAirPathNum)%NumOfComponents, 1, -1
SELECT CASE (SupplyAirPath(SupplyAirPathNum)%ComponentType_Num(CompNum))
CASE (ZoneSplitter_Type) ! 'AirLoopHVAC:ZoneSplitter'
if (.NOT. (AirflowNetworkFanActivated .AND. SimulateAirflowNetwork > AirflowNetworkControlMultizone)) then
CALL SimAirLoopSplitter(SupplyAirPath(SupplyAirPathNum)%ComponentName(CompNum), &
FirstHVACIteration, FirstCall, SupPathInletChanged, &
CompIndex=SupplyAirPath(SupplyAirPathNum)%ComponentIndex(CompNum))
endif
CASE (ZoneSupplyPlenum_Type) ! 'AirLoopHVAC:SupplyPlenum'
CALL SimAirZonePlenum(SupplyAirPath(SupplyAirPathNum)%ComponentName(CompNum),ZoneSupplyPlenum_Type, &
SupplyAirPath(SupplyAirPathNum)%ComponentIndex(CompNum), &
FirstHVACIteration=FirstHVACIteration, FirstCall=FirstCall, &
PlenumInletChanged=SupPathInletChanged)
CASE DEFAULT
CALL ShowSevereError('Error found in Supply Air Path='//TRIM(SupplyAirPath(SupplyAirPathNum)%Name))
CALL ShowContinueError('Invalid Supply Air Path Component='// &
TRIM(SupplyAirPath(SupplyAirPathNum)%ComponentType(CompNum)))
CALL ShowFatalError('Preceding condition causes termination.')
END SELECT
END DO
IF (SupPathInletChanged) THEN
! If the supply air path inlet conditions have been changed, the Air Loop must be resimulated
SimAir = .TRUE.
END IF
END DO ! end of the Supply Air Path DO Loop
CALL CalcZoneMassBalance
CALL CalcZoneLeavingConditions
CALL SimReturnAirPath
IF (MyOneTimeFlag) THEN
DO ControlledZoneNum = 1, NumOfZones
IF (.not. ZoneEquipConfig(ControlledZoneNum)%IsControlled) CYCLE
IF (ZoneEquipConfig(ControlledZoneNum)%SupLeakToRetPlen .AND. &
ZoneEquipConfig(ControlledZoneNum)%ReturnZonePlenumCondNum == 0) THEN
CALL ShowSevereError('No return plenum for simple duct leakage model for Zone ' // &
TRIM(ZoneEquipConfig(ControlledZoneNum)%ZoneName))
CALL ShowContinueError(' The simple duct leakage model requires plenum return for all zone with leaks')
ErrorFlag = .TRUE.
END IF
END DO
IF (ErrorFlag) THEN
CALL ShowFatalError('Preceding condition causes termination')
END IF
MyOneTimeFlag = .FALSE.
END IF
RETURN
END SUBROUTINE SimZoneEquipment