SUBROUTINE InitAirLoops(FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR Richard J. Liesen
! DATE WRITTEN April 1998
! MODIFIED Dec 1999 Fred Buhl
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Initializes the primary air system simulation
! METHODOLOGY EMPLOYED:
! (1) For the first simulation in an HVAC timestep, the air system is initialized to
! design air flow rates.
! (2) For subsequent simulations, air flow data is set by the zone equipment inlet
! nodes and the return air node.
! (3) Other air system node data such as temperatures and humidity ratios are only
! initialized at the start of an environment (run period or design day).
! REFERENCES:
! na
! USE STATEMENTS:
Use DataEnvironment, ONLY: StdBaroPress, OutHumRat, StdRhoAir
USE SplitterComponent, ONLY: SplitterCond, NumSplitters
USE InputProcessor, ONLY: FindItemInList, SameString
USE Psychrometrics, ONLY: PsyHFnTdbW,PsyRhoAirFnPbTdbW
USE ZonePlenum, ONLY: ZoneSupPlenCond, NumZoneSupplyPlenums
USE DataConvergParams, ONLY: HVACFlowRateToler, AirLoopConvergence, ZoneInletConvergence
USE DataContaminantBalance, ONLY: Contaminant, OutdoorCO2, OutdoorGC
USE General, ONLY: FindNumberinList
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS
LOGICAL, INTENT (IN) :: FirstHVACIteration ! TRUE if first full HVAC iteration in an HVAC timestep
! SUBROUTINE PARAMETER DEFINITIONS:
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAllSupAirPathNodes ! total number of nodes in a supply air path including duplicates
INTEGER :: NumSupAirPathNodes ! total number of nodes in a supply air path
INTEGER :: NumSupAirPathOutNodes ! total number of outlet nodes in a supply air path
INTEGER :: NumSupAirPathIntNodes ! total number of intermediate nodes in a supply air path
INTEGER :: NodeIndex ! DO loop index for nodes on branch
INTEGER :: SupNodeIndex ! do loop index of a supply air path node
INTEGER :: SupNodeIndex2 ! 2nd do loop index of a supply air path node
INTEGER :: SupAirPathNodeNum ! index of a supply air path node
INTEGER :: SupAirPathOutNodeNum ! index of a supply air path outlet node
INTEGER :: AirLoopNum ! DO loop counter for air systems
INTEGER :: BranchNum ! DO loop counter for branches
INTEGER :: OutBranchNum ! reference number of an outlet branch
INTEGER :: InBranchNum ! reference number of an inlet branch
!unused INTEGER :: InletBranchNum ! Branch reference number of splitter inlet branch
INTEGER :: NodeNum ! a node number
INTEGER :: OutNum ! DO loop index for outlet branches
INTEGER :: InNum ! DO loop index for inlet branches
INTEGER :: CompNum ! DO loop index for branch components
INTEGER :: ZoneSideNodeNum ! a Zone Equipment inlet node number
INTEGER :: BranchNodeIndex ! DO loop index for nodes on a branch
INTEGER :: NodeNumOut ! node number of a branch outlet node
INTEGER :: NodeNumIn ! node number of a splitter inlet node or a branch inlet node
INTEGER :: SplitterOutNum ! DO loop index of splitter outlets
INTEGER :: PlenumOutNum ! DO loop index of supply plenum outlets
REAL(r64) :: MassFlowSaved ! mass flow rate for a node saved from previous call
REAL(r64) :: MassFlowSet ! desired mass flow rate for a node
REAL(r64) :: SumZoneDesFlow=0.0d0 ! sum of the zone design air mass flow rates for zones served by a system
INTEGER :: SupAirPath ! supply air path do loop index
INTEGER :: SupAirPathNum ! specific supply air path index
INTEGER :: SplitterNum ! Zone equip splitter index
INTEGER :: PlenumNum ! supply plenum index
INTEGER :: CtrlZoneNum ! Controlled zone index
INTEGER :: ZoneInNum ! zone inlet index
INTEGER :: NumZonesCool ! number of zones in system supplied with cooling
INTEGER :: NumZonesHeat ! number of zones in system supplied with heating
INTEGER :: ZoneInSysIndex ! index into CoolCtrlZoneNums or HeatCtrlZoneNums
INTEGER :: NumComponentsInSys ! total number of components in the primary air system
INTEGER :: NumComponentsOnBranch ! total number of components in the primary air system
LOGICAL :: FoundSupPathZoneConnect ! true if there is a valid connection between the supply air path
! and a zone terminal unit inlet
INTEGER :: TUInNode=0 ! inlet node number of a terminal unit
REAL(r64),SAVE :: MassFlowSetToler
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: CtrlZoneNumsCool
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: CtrlZoneNumsHeat
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: ZoneInletNodesCool
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: ZoneInletNodesHeat
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: TermInletNodesCool
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: TermInletNodesHeat
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: SupNode
INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: SupNodeType
!Dimension the local subcomponent arrays
!Simulation Flags
LOGICAL,SAVE :: MyEnvrnFlag=.true.
LOGICAL,SAVE :: MyOneTimeFlag = .true.
LOGICAL,SAVE :: MyBranchSizingFlag = .true.
LOGICAL :: ErrorsFound
REAL(r64) :: OAReliefDiff = 0.d0 ! local for massflow change across OA system, kg/s
INTEGER, DIMENSION(:), ALLOCATABLE :: tmpNodeARR
INTEGER :: nodeCount
INTEGER :: nodeLoop
INTEGER :: ZoneNum
ErrorsFound = .FALSE.
AirLoopInit = .TRUE.
! Do the one time initializations
IF (MyOneTimeFlag) THEN
! Figure out what zones are served by each primary air system (air loop) and
! store the results in AirToZoneNodeInfo()%CoolCtrlZoneNums and AirToZoneNodeInfo()%HeatCtrlZoneNums
! Allocate scratch arrays for storing controlled zone numbers for each air loop.
ALLOCATE(CtrlZoneNumsCool(NumOfZones))
ALLOCATE(CtrlZoneNumsHeat(NumOfZones))
ALLOCATE(ZoneInletNodesCool(NumOfZones))
ALLOCATE(ZoneInletNodesHeat(NumOfZones))
ALLOCATE(TermInletNodesCool(NumOfZones))
ALLOCATE(TermInletNodesHeat(NumOfZones))
MassFlowSetToler = HVACFlowRateToler * 0.00001d0
SupplyAirPathLoop: DO SupAirPath=1,NumSupplyAirPaths
NumAllSupAirPathNodes = 0
SupAirPathNodeNum = 0
SupAirPathOutNodeNum = 0
NumSupAirPathOutNodes = 0
NumSupAirPathNodes = 0
NumSupAirPathIntNodes = 0
! each supply air path may have up to one splitter and one plenum. Check for all combinations count
! all nodes (including duplicates)
DO CompNum=1,SupplyAirPath(SupAirPath)%NumOfComponents
IF (SameString(SupplyAirPath(SupAirPath)%ComponentType(CompNum),'AirLoopHVAC:ZoneSplitter')) THEN
SplitterNum=FindItemInList(SupplyAirPath(SupAirPath)%ComponentName(CompNum), &
SplitterCond%SplitterName, NumSplitters)
IF (SplitterNum == 0) THEN
CALL ShowSevereError('AirLoopHVAC:ZoneSplitter not found='//TRIM(SupplyAirPath(SupAirPath)%ComponentName(CompNum)))
CALL ShowContinueError('Occurs in AirLoopHVAC:SupplyPath='//TRIM(SupplyAirPath(SupAirPath)%Name))
ErrorsFound=.true.
ENDIF
SupplyAirPath(SupAirPath)%SplitterIndex(CompNum) = SplitterNum
NumAllSupAirPathNodes = NumAllSupAirPathNodes + SplitterCond(SplitterNum)%NumOutletNodes + 1
ELSE IF (SameString(SupplyAirPath(SupAirPath)%ComponentType(CompNum),'AirLoopHVAC:SupplyPlenum')) THEN
PlenumNum=FindItemInList(SupplyAirPath(SupAirPath)%ComponentName(CompNum), &
ZoneSupPlenCond%ZonePlenumName, NumZoneSupplyPlenums)
IF (PlenumNum == 0) THEN
CALL ShowSevereError('AirLoopHVAC:SupplyPlenum not found='//TRIM(SupplyAirPath(SupAirPath)%ComponentName(CompNum)))
CALL ShowContinueError('Occurs in AirLoopHVAC:SupplyPath='//TRIM(SupplyAirPath(SupAirPath)%Name))
ErrorsFound=.true.
ENDIF
SupplyAirPath(SupAirPath)%PlenumIndex(CompNum) = PlenumNum
NumAllSupAirPathNodes = NumAllSupAirPathNodes + ZoneSupPlenCond(PlenumNum)%NumOutletNodes + 1
END IF
END DO
ALLOCATE(SupNode(NumAllSupAirPathNodes))
ALLOCATE(SupNodeType(NumAllSupAirPathNodes))
! figure out the order of the splitter and plenum in the path, by flagging the first node of the component
! as either a 'pathinlet' or a 'compinlet'
DO CompNum=1,SupplyAirPath(SupAirPath)%NumOfComponents
SplitterNum = SupplyAirPath(SupAirPath)%SplitterIndex(CompNum)
PlenumNum = SupplyAirPath(SupAirPath)%PlenumIndex(CompNum)
IF (SplitterNum > 0) THEN
SupAirPathNodeNum = SupAirPathNodeNum + 1
SupNode(SupAirPathNodeNum) = SplitterCond(SplitterNum)%InletNode
IF (CompNum == 1) THEN
SupNodeType(SupAirPathNodeNum) = PathInlet
ELSE
SupNodeType(SupAirPathNodeNum) = CompInlet
END IF
DO SplitterOutNum=1,SplitterCond(SplitterNum)%NumOutletNodes
SupAirPathNodeNum = SupAirPathNodeNum + 1
SupNode(SupAirPathNodeNum) = SplitterCond(SplitterNum)%OutletNode(SplitterOutNum)
SupNodeType(SupAirPathNodeNum) = 0
END DO
ELSE IF (PlenumNum > 0) THEN
SupAirPathNodeNum = SupAirPathNodeNum + 1
SupNode(SupAirPathNodeNum) = ZoneSupPlenCond(PlenumNum)%InletNode
IF (CompNum == 1) THEN
SupNodeType(SupAirPathNodeNum) = PathInlet
ELSE
SupNodeType(SupAirPathNodeNum) = CompInlet
END IF
DO PlenumOutNum=1,ZoneSupPlenCond(PlenumNum)%NumOutletNodes
SupAirPathNodeNum = SupAirPathNodeNum + 1
SupNode(SupAirPathNodeNum) = ZoneSupPlenCond(PlenumNum)%OutletNode(PlenumOutNum)
SupNodeType(SupAirPathNodeNum) = 0
END DO
END IF
END DO
! find the nodes that connect a splitter and a plenum
DO SupNodeIndex=1,NumAllSupAirPathNodes
IF (SupNodeType(SupNodeIndex) == 0) THEN
DO SupNodeIndex2=SupNodeIndex+1,NumAllSupAirPathNodes
IF ( (SupNode(SupNodeIndex) == SupNode(SupNodeIndex2)) .AND. (SupNodeType(SupNodeIndex2) == CompInlet) ) THEN
SupNodeType(SupNodeIndex) = Intermediate
EXIT
END IF
END DO
END IF
END DO
! the rest of the nodes are outlet nodes and count the duplicated intermediate nodes
DO SupNodeIndex=1,NumAllSupAirPathNodes
IF (SupNodeType(SupNodeIndex) == 0) THEN
NumSupAirPathOutNodes = NumSupAirPathOutNodes + 1
SupNodeType(SupNodeIndex) = Outlet
ELSE IF (SupNodeType(SupNodeIndex) == Intermediate) THEN
NumSupAirPathIntNodes = NumSupAirPathIntNodes + 1
END IF
END DO
! eliminate the duplicates to find the number of nodes in the supply air path
NumSupAirPathNodes = NumAllSupAirPathNodes - NumSupAirPathIntNodes
SupAirPathNodeNum = 0
ALLOCATE(SupplyAirPath(SupAirPath)%OutletNode(NumSupAirPathOutNodes))
ALLOCATE(SupplyAirPath(SupAirPath)%Node(NumSupAirPathNodes))
ALLOCATE(SupplyAirPath(SupAirPath)%NodeType(NumSupAirPathNodes))
SupplyAirPath(SupAirPath)%NumNodes = NumSupAirPathNodes
SupplyAirPath(SupAirPath)%NumOutletNodes = NumSupAirPathOutNodes
! transfer data from the local SupNode array to the SupplyAirPath data structure
DO SupNodeIndex=1,NumAllSupAirPathNodes
IF (SupNodeType(SupNodeIndex) == PathInlet .OR. SupNodeType(SupNodeIndex) == Intermediate &
.OR. SupNodeType(SupNodeIndex) == Outlet) THEN
SupAirPathNodeNum = SupAirPathNodeNum + 1
! map the local node numbers to the HVAC (global) node numbers
SupplyAirPath(SupAirPath)%Node(SupAirPathNodeNum) = SupNode(SupNodeIndex)
SupplyAirPath(SupAirPath)%NodeType(SupAirPathNodeNum) = SupNodeType(SupNodeIndex)
END IF
IF (SupNodeType(SupNodeIndex) == Outlet) THEN
SupAirPathOutNodeNum = SupAirPathOutNodeNum + 1
! map the outlet node number to the HVAC (global) node number
SupplyAirPath(SupAirPath)%OutletNode(SupAirPathOutNodeNum) = SupNode(SupNodeIndex)
END IF
END DO
DEALLOCATE(SupNode)
DEALLOCATE(SupNodeType)
END DO SupplyAirPathLoop
!Now loop over the air loops
PrimaryAirSysLoop: DO AirLoopNum = 1, NumPrimaryAirSys
CtrlZoneNumsCool = 0
CtrlZoneNumsHeat = 0
ZoneInletNodesCool = 0
ZoneInletNodesHeat = 0
NumZonesCool = 0
NumZonesHeat = 0
NumComponentsInSys = 0
! count the number of components in this primary air system
DO BranchNum=1,PrimaryAirSystem(AirLoopNum)%NumBranches
NumComponentsInSys = NumComponentsInSys + PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalComponents
END DO
! set the Simple flag
IF (PrimaryAirSystem(AirLoopNum)%NumBranches == 1 .AND. NumComponentsInSys ==1) THEN
AirLoopControlInfo(AirLoopNum)%Simple = .TRUE.
END IF
! loop over the air loop's output nodes
AirSysOutletsLoop: DO OutNum=1,AirToZoneNodeInfo(AirLoopNum)%NumSupplyNodes
ZoneSideNodeNum = AirToZoneNodeInfo(AirLoopNum)%ZoneEquipSupplyNodeNum(OutNum)
! find the corresponding branch number
OutBranchNum = PrimaryAirSystem(AirLoopNum)%OutletBranchNum(OutNum)
! find the supply air path corresponding to each air loop outlet node
SupAirPathNum = 0
! loop over the air loop's output nodes
SupplyAirPathLoop2: DO SupAirPath=1,NumSupplyAirPaths
IF (ZoneSideNodeNum .EQ. SupplyAirPath(SupAirPath)%InletNodeNum) THEN
SupAirPathNum = SupAirPath
EXIT SupplyAirPathLoop2
END IF
END DO SupplyAirPathLoop2
IF (SupAirPathNum > 0) THEN
NumSupAirPathOutNodes= SupplyAirPath(SupAirPathNum)%NumOutletNodes
ELSE
NumSupAirPathOutNodes = 0
END IF
! Now Loop over the Supply Air Path outlet nodes and find out which zone and which air terminal
! unit on that zone is connected to that supply air path.
SupplyAirPathOutletLoop: DO SupAirPathOutNodeNum=1,NumSupAirPathOutNodes
FoundSupPathZoneConnect = .FALSE.
! loop over all controlled zones.
ControlledZoneLoop: DO CtrlZoneNum=1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZoneNum)%IsControlled) CYCLE
! Loop over the air distribution unit inlets for each controlled zone.
! Look for a match between the zone splitter outlet node and the air distribution unit inlet node.
! When match found save the controlled zone number in CtrlZoneNumsCool or CtrlZoneNumsHeat
ZoneAirDistUnitInletsLoop: DO ZoneInNum=1,ZoneEquipConfig(CtrlZoneNum)%NumInletNodes
NumComponentsOnBranch = PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%TotalComponents
!BEGIN COOLING: Check for a match between the cooling air distribution unit inlet
!and the supply air path outlet
IF (SupplyAirPath(SupAirPathNum)%OutletNode(SupAirPathOutNodeNum) .EQ. &
ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode) THEN
IF (FindNumberinList(CtrlZoneNum,CtrlZoneNumsCool,NumZonesCool) == 0) THEN
NumZonesCool = NumZonesCool + 1
! Set Duct Type for branch for dual duct
IF (NumZonesCool == 1 .AND. OutBranchNum > 1) THEN
PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%DuctType = Cooling
END IF
IF (NumZonesCool == 1) THEN
AirToZoneNodeInfo(AirLoopNum)%SupplyDuctType(OutNum) = Cooling
END IF
CtrlZoneNumsCool(NumZonesCool) = CtrlZoneNum
ZoneInletNodesCool(NumZonesCool) = ZoneEquipConfig(CtrlZoneNum)%InletNode(ZoneInNum)
TermInletNodesCool(NumZonesCool) = ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode
ZoneEquipConfig(CtrlZoneNum)%AirLoopNum = AirLoopNum
ENDIF
FoundSupPathZoneConnect = .TRUE.
!set the supply air path
ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%SupplyAirPathExists = .TRUE.
!Once a match is found between a supply air path outlet node and an air distribution inlet
!node, we go on to the next supply air path outlet. Therefore, *both* the air distribution
!unit loop and the controlled zone loop may be exited.
EXIT ControlledZoneLoop
END IF !end check for cooling air distribution units
!END COOLING: end check for match between supply air path outlet and cooling air
!distribution inlet
! BEGIN HEATING: If we don't get a match, check for a heating match
IF (SupplyAirPath(SupAirPathNum)%OutletNode(SupAirPathOutNodeNum) .EQ. &
ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode) THEN
IF (FindNumberinList(CtrlZoneNum,CtrlZoneNumsHeat,NumZonesHeat) == 0) THEN
NumZonesHeat = NumZonesHeat + 1
! Set Duct Type for branch for dual duct
IF (NumZonesHeat == 1 .AND. OutBranchNum > 1) THEN
PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%DuctType = Heating
END IF
IF (NumZonesHeat == 1) THEN
AirToZoneNodeInfo(AirLoopNum)%SupplyDuctType(OutNum) = Heating
END IF
CtrlZoneNumsHeat(NumZonesHeat) = CtrlZoneNum
ZoneInletNodesHeat(NumZonesHeat) = ZoneEquipConfig(CtrlZoneNum)%InletNode(ZoneInNum)
TermInletNodesHeat(NumZonesHeat) = ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode
IF (ZoneEquipConfig(CtrlZoneNum)%AirLoopNum == 0) ZoneEquipConfig(CtrlZoneNum)%AirLoopNum = AirLoopNum
ENDIF
FoundSupPathZoneConnect = .TRUE.
!Set the supply air path flag
ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%SupplyAirPathExists = .TRUE.
!Once a match is found between a supply air path outlet node and an air distribution inlet
!node, we go on to the next supply air path outlet. Therefore, *both* the air distribution
!unit loop and the controlled zone loop may be exited.
EXIT ControlledZoneLoop
END IF !end check for heatingair distribution units
END DO ZoneAirDistUnitInletsLoop
END DO ControlledZoneLoop
!If the supply air path is not connected to either a heating or a cooling air distribution
!unit...we have a problem!
IF ( .NOT. FoundSupPathZoneConnect) THEN
CALL ShowSevereError('Node ' // TRIM(NodeID(SupplyAirPath(SupAirPathNum)%OutletNode(SupAirPathOutNodeNum))) &
// ' connects to no component')
CALL ShowContinueError('Occurs in Supply Air Path='//TRIM(SupplyAirPath(SupAirPathNum)%Name))
CALL ShowContinueError('Check the connection to a ZoneHVAC:EquipmentConnections object')
CALL ShowContinueError('Check if this component is missing from the Supply Air Path')
ErrorsFound=.true.
END IF
END DO SupplyAirPathOutletLoop
! What if there is no supply air path & the air loop outlet is just hooked directly to
! an air distribution unit of a single zone? In this case look for a match between
! ZoneSideNodeNum and a zone's air distribution unit inlets.
IF (SupAirPathNum.EQ.0) THEN
ControlledZoneLoop2: DO CtrlZoneNum=1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZoneNum)%IsControlled) CYCLE
! Loop over the air distribution unit inlets for each controlled zone.
! Look for a match between the zone equip inlet node and the air distribution unit inlet node.
! When match found save the controlled zone number in CtrlZoneNumsCool or CtrlZoneNumsHeat
ZoneAirDistUnitInletsLoop2: DO ZoneInNum=1,ZoneEquipConfig(CtrlZoneNum)%NumInletNodes
!set supply air path flag
ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%SupplyAirPathExists = .FALSE.
IF (ZoneSideNodeNum .EQ. ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode) THEN
NumZonesCool = NumZonesCool + 1
! Set Duct Type for branch for dual duct
IF (NumZonesCool == 1 .AND. OutBranchNum > 1) THEN
PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%DuctType = Cooling
END IF
CtrlZoneNumsCool(NumZonesCool) = CtrlZoneNum
ZoneInletNodesCool(NumZonesCool) = ZoneEquipConfig(CtrlZoneNum)%InletNode(ZoneInNum)
TermInletNodesCool(NumZonesCool) = ZoneEquipConfig(CtrlZoneNum)%AirDistUnitCool(ZoneInNum)%InNode
IF (ZoneEquipConfig(CtrlZoneNum)%AirLoopNum == 0) ZoneEquipConfig(CtrlZoneNum)%AirLoopNum = AirLoopNum
EXIT ControlledZoneLoop2
ENDIF
IF (ZoneSideNodeNum .EQ. ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode) THEN
NumZonesHeat = NumZonesHeat + 1
! Set Duct Type for branch for dual duct
IF (NumZonesHeat == 1 .AND. OutBranchNum > 1) THEN
PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%DuctType = Heating
END IF
CtrlZoneNumsHeat(NumZonesHeat) = CtrlZoneNum
ZoneInletNodesHeat(NumZonesHeat) = ZoneEquipConfig(CtrlZoneNum)%InletNode(ZoneInNum)
TermInletNodesHeat(NumZonesHeat) = ZoneEquipConfig(CtrlZoneNum)%AirDistUnitHeat(ZoneInNum)%InNode
IF (ZoneEquipConfig(CtrlZoneNum)%AirLoopNum == 0) ZoneEquipConfig(CtrlZoneNum)%AirLoopNum = AirLoopNum
EXIT ControlledZoneLoop2
END IF
END DO ZoneAirDistUnitInletsLoop2
END DO ControlledZoneLoop2
END IF ! End of no supply air path case
END DO AirSysOutletsLoop
! we now know the number of heated and cooled zones served by this primary air system.
! Allocate the subarrays in AirToZoneNodeInfo
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%CoolCtrlZoneNums(NumZonesCool))
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%HeatCtrlZoneNums(NumZonesHeat))
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%CoolZoneInletNodes(NumZonesCool))
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%HeatZoneInletNodes(NumZonesHeat))
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%TermUnitCoolInletNodes(NumZonesCool))
ALLOCATE(AirToZoneNodeInfo(AirLoopNum)%TermUnitHeatInletNodes(NumZonesHeat))
! Move the controlled zone numbers from the scratch arrays into AirToZoneNodeInfo
CooledZonesLoop: DO ZoneInSysIndex=1,NumZonesCool
AirToZoneNodeInfo(AirLoopNum)%CoolCtrlZoneNums(ZoneInSysIndex) = CtrlZoneNumsCool(ZoneInSysIndex)
AirToZoneNodeInfo(AirLoopNum)%CoolZoneInletNodes(ZoneInSysIndex) = ZoneInletNodesCool(ZoneInSysIndex)
AirToZoneNodeInfo(AirLoopNum)%TermUnitCoolInletNodes(ZoneInSysIndex) = TermInletNodesCool(ZoneInSysIndex)
END DO CooledZonesLoop
HeatedZonesLoop: DO ZoneInSysIndex=1,NumZonesHeat
AirToZoneNodeInfo(AirLoopNum)%HeatCtrlZoneNums(ZoneInSysIndex) = CtrlZoneNumsHeat(ZoneInSysIndex)
AirToZoneNodeInfo(AirLoopNum)%HeatZoneInletNodes(ZoneInSysIndex) = ZoneInletNodesHeat(ZoneInSysIndex)
AirToZoneNodeInfo(AirLoopNum)%TermUnitHeatInletNodes(ZoneInSysIndex) = TermInletNodesHeat(ZoneInSysIndex)
END DO HeatedZonesLoop
AirToZoneNodeInfo(AirLoopNum)%NumZonesCooled = NumZonesCool
AirToZoneNodeInfo(AirLoopNum)%NumZonesHeated = NumZonesHeat
IF ( (NumZonesCool+NumZonesHeat) == 0) THEN
CALL ShowSevereError('An outlet node in AirLoopHVAC="' // TRIM(PrimaryAirSystem(AirLoopNum)%Name) // &
'" is not connected to any zone')
CALL ShowContinueError('Could not match ZoneEquipGroup Inlet Node="'//TRIM(NodeID(ZoneSideNodeNum))// &
'" to any Supply Air Path or controlled zone')
ErrorsFound = .TRUE.
END IF
! now fill the return air bypass information needed by the RAB setpoint manager
IF (PrimaryAirSystem(AirLoopNum)%Splitter%Exists .AND. PrimaryAirSystem(AirLoopNum)%Mixer%Exists) THEN
PrimaryAirSystem(AirLoopNum)%RABExists = .TRUE.
DO BranchNum=1,PrimaryAirSystem(AirLoopNum)%NumBranches
! find the RAB branch; its inlet is a splitter outlet and it outlet is a mixer inlet
IF ( (PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumIn == &
PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(1) .OR. &
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumIn == &
PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(2) ) .AND. &
(PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumOut == &
PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(1) .OR. &
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumOut == &
PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(2)) .AND. &
(PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalComponents == 1) .AND. &
(SameString(PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%Comp(1)%TypeOf,'Duct')) ) THEN
! set the RAB splitter outlet node and the RAB mixer inlet node
PrimaryAirSystem(AirLoopNum)%RABSplitOutNode = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumIn
PrimaryAirSystem(AirLoopNum)%RABMixInNode = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNumOut
! set the other nodes
IF (PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(1) == PrimaryAirSystem(AirLoopNum)%RABSplitOutNode) THEN
PrimaryAirSystem(AirLoopNum)%OtherSplitOutNode = PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(2)
ELSE
PrimaryAirSystem(AirLoopNum)%OtherSplitOutNode = PrimaryAirSystem(AirLoopNum)%Splitter%NodeNumOut(1)
END IF
IF (PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(1) == PrimaryAirSystem(AirLoopNum)%RABMixInNode) THEN
PrimaryAirSystem(AirLoopNum)%SupMixInNode = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(2)
ELSE
PrimaryAirSystem(AirLoopNum)%SupMixInNode = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumIn(1)
END IF
! set the duct type
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%DuctType = RAB
END IF
END DO
PrimaryAirSystem(AirLoopNum)%MixOutNode = PrimaryAirSystem(AirLoopNum)%Mixer%NodeNumOut
END IF
END DO PrimaryAirSysLoop
! now register zone inlet nodes as critical demand nodes in the convergence tracking
ALLOCATE(ZoneInletConvergence(NumOfZones))
DO ZoneNum = 1, NumOfZones
IF (ZoneEquipConfig(ZoneNum)%NumInletNodes > 0) THEN
ZoneInletConvergence(ZoneNum)%NumInletNodes = ZoneEquipConfig(ZoneNum)%NumInletNodes
ALLOCATE(ZoneInletConvergence(ZoneNum)%InletNode(ZoneEquipConfig(ZoneNum)%NumInletNodes))
Do nodeLoop =1, ZoneEquipConfig(ZoneNum)%NumInletNodes
ZoneInletConvergence(ZoneNum)%InletNode(nodeLoop)%NodeNum = ZoneEquipConfig(ZoneNum)%InletNode(nodeLoop)
ENDDO
ENDIF
END DO
MyOneTimeFlag = .false.
DEALLOCATE(CtrlZoneNumsCool)
DEALLOCATE(CtrlZoneNumsHeat)
DEALLOCATE(ZoneInletNodesCool)
DEALLOCATE(ZoneInletNodesHeat)
DEALLOCATE(TermInletNodesCool)
DEALLOCATE(TermInletNodesHeat)
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding errors cause termination')
END IF
END IF !one time flag
! Size the air loop branch air flows
IF ( .NOT. SysSizingCalc .AND. MyBranchSizingFlag) THEN
DO AirLoopNum = 1, NumPrimaryAirSys
DO BranchNum=1,PrimaryAirSystem(AirLoopNum)%NumBranches
CALL SizeAirLoopBranches(AirLoopNum,BranchNum)
END DO
END DO
MyBranchSizingFlag = .FALSE.
! calculate the ratio of air loop design flow to the sum of the zone design flows
DO AirLoopNum = 1, NumPrimaryAirSys
SumZoneDesFlow = 0.0d0
DO ZoneInSysIndex=1,AirToZoneNodeInfo(AirLoopNum)%NumZonesCooled
TUInNode = AirToZoneNodeInfo(AirLoopNum)%TermUnitCoolInletNodes(ZoneInSysIndex)
SumZoneDesFlow = SumZoneDesFlow + Node(TUInNode)%MassFlowRateMax
END DO
IF (SumZoneDesFlow > VerySmallMassFlow) THEN
AirLoopFlow(AirLoopNum)%SysToZoneDesFlowRatio = PrimaryAirSystem(AirLoopNum)%DesignVolFlowRate*StdRhoAir/SumZoneDesFlow
ELSE
AirLoopFlow(AirLoopNum)%SysToZoneDesFlowRatio = 1.0d0
END IF
END DO
END IF
! Do the Begin Environment initializations
IF (BeginEnvrnFlag .and. FirstHVACIteration .and. MyEnvrnFlag) THEN
IF (NumPrimaryAirSys > 0) THEN
PriAirSysAvailMgr%AvailStatus = NoAction
PriAirSysAvailMgr%StartTime = 0
PriAirSysAvailMgr%StopTime = 0
END IF
DO AirLoopNum = 1, NumPrimaryAirSys ! Start looping through all of the air loops...
DO BranchNum = 1,PrimaryAirSystem(AirLoopNum)%NumBranches ! loop over all branches in system
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MaxMassFlowRate = StdRhoAir * &
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MaxVolFlowRate
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MinMassFlowRate = StdRhoAir * &
PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MinVolFlowRate
DO NodeIndex = 1,PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalNodes ! loop over alll nodes on branch
NodeNum = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNum(NodeIndex)
! Initialize the nodes to a standard set of initial conditions that will
! change after the first iteration to a system value
Node(NodeNum)%Temp = 20.0d0
Node(NodeNum)%HumRat = OutHumRat
Node(NodeNum)%Enthalpy = PsyHFnTdbW(Node(NodeNum)%Temp,Node(NodeNum)%HumRat)
! set the node mass flow rates to the branch mass flow rate
Node(NodeNum)%MassFlowRate = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MaxMassFlowRate
Node(NodeNum)%MassFlowRateMax = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MaxMassFlowRate
Node(NodeNum)%MassFlowRateMaxAvail = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%MaxMassFlowRate
Node(NodeNum)%MassFlowRateMin = 0.0d0
Node(NodeNum)%MassFlowRateSetPoint = 0.0d0
Node(NodeNum)%MassFlowRateMinAvail = 0.0d0
Node(NodeNum)%Press = StdBaroPress
Node(NodeNum)%Quality = 0.0d0
IF (Contaminant%CO2Simulation) Then
Node(NodeNum)%CO2 = OutdoorCO2
End If
IF (Contaminant%GenericContamSimulation) Then
Node(NodeNum)%GenContam = OutdoorGC
End If
END DO ! end of loop over nodes on each branch
END DO ! end of loop through branches in system
END DO ! end of loop over primary air systems
MyEnvrnFlag=.false.
END IF ! End the environment initializations
IF (.not. BeginEnvrnFlag) THEN
MyEnvrnFlag=.true.
ENDIF
! Do the Begin Day initializations
IF (BeginDayFlag) THEN
END IF
! There are no hourly initializations done in the heat balance
! Do the following initializations (every time step).
DO AirLoopNum = 1, NumPrimaryAirSys
! zero all MassFlowRateSetPoints
DO BranchNum = 1,PrimaryAirSystem(AirLoopNum)%NumBranches ! loop over all branches in system
IF (PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%DuctType == RAB) CYCLE
DO NodeIndex = 1,PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%TotalNodes ! loop over alll nodes on branch
NodeNum = PrimaryAirSystem(AirLoopNum)%Branch(BranchNum)%NodeNum(NodeIndex)
Node(NodeNum)%MassFlowRateSetPoint = 0.0d0
! Reset MassFlowRateMaxAvail at start of each HVAC simulation
IF (FirstHVACIteration) THEN
Node(NodeNum)%MassFlowRateMaxAvail = Node(NodeNum)%MassFlowRateMax
Node(NodeNum)%MassFlowRateMinAvail = Node(NodeNum)%MassFlowRateMin
END IF
END DO
END DO
! set the required flow (from zone equipment) at system outlet nodes
DO OutNum=1,PrimaryAirSystem(AirLoopNum)%NumOutletBranches
OutBranchNum = PrimaryAirSystem(AirLoopNum)%OutletBranchNum(OutNum)
NodeNumOut = PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%NodeNumOut
ZoneSideNodeNum = AirToZoneNodeInfo(AirLoopNum)%ZoneEquipSupplyNodeNum(OutNum)
IF (.NOT. FirstHVACIteration) THEN
MassFlowSet = Node(ZoneSideNodeNum)%MassFlowRate
ELSE ! first time through in each HVAC timestep, use design mass flow rates for required mass flows
MassFlowSet = PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%MaxMassFlowRate
END IF
! Need to make sure that flows are greater than zero
IF (MassFlowSet .GE. 0.0d0) THEN
Node(NodeNumOut)%MassFlowRateSetPoint = MassFlowSet
ELSE IF (MassFlowSet .LT. 0.0d0) THEN
Node(NodeNumOut)%MassFlowRateSetPoint = 0.0d0
END IF
IF (Node(NodeNumOut)%MassFlowRateSetPoint < MassFlowSetToler) THEN
Node(NodeNumOut)%MassFlowRateSetPoint = 0.0d0
END IF
! Pass the required mass flow upstream to the start of each outlet branch
DO BranchNodeIndex=PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%TotalNodes-1,1,-1
NodeNum = PrimaryAirSystem(AirLoopNum)%Branch(OutBranchNum)%NodeNum(BranchNodeIndex)
IF (PrimaryAirSystem(AirLoopNum)%OASysExists .AND. &
(NodeNum == PrimaryAirSystem(AirLoopNum)%OASysInletNodeNum) ) THEN
! need to modify if OA relief and supply not balanced because of exhaust fans
OAReliefDiff = Node(PrimaryAirSystem(AirLoopNum)%OASysOutletNodeNum)%MassFlowRate - Node(NodeNum)%MassFlowRate
If (OAReliefDiff > 0.d0) THEN
Node(NodeNum)%MassFlowRateSetPoint = Node(NodeNumOut)%MassFlowRateSetPoint - OAReliefDiff
ELSE
Node(NodeNum)%MassFlowRateSetPoint = Node(NodeNumOut)%MassFlowRateSetPoint
ENDIF
ELSE
Node(NodeNum)%MassFlowRateSetPoint = Node(NodeNumOut)%MassFlowRateSetPoint
ENDIF
END DO ! end loop over branch nodes
END DO ! end loop over outlet branches
! sum and save the total loop return air mass flow rate
AirLoopFlow(AirLoopNum)%TotReturn = 0.0d0
DO InBranchNum=1,AirToZoneNodeInfo(AirLoopNum)%NumReturnNodes
AirLoopFlow(AirLoopNum)%TotReturn = AirLoopFlow(AirLoopNum)%TotReturn + &
Node(AirToZoneNodeInfo(AirLoopNum)%AirLoopReturnNodeNum(InBranchNum))%MassFlowRate
END DO
! [DC/LBNL] Initialize flag for current air loop
AirLoopControlInfo(AirLoopNum)%NewFlowRateFlag = .FALSE.
! start each HVAC simulation at design air flow rate
IF (FirstHVACIteration) THEN
! At each new HVAC iteration reset air loop converged flag to avoid attempting a warm restart
! in SimAirLoop
AirLoopControlInfo%ConvergedFlag = .FALSE.
DO InNum=1,PrimaryAirSystem(AirLoopNum)%NumInletBranches
InBranchNum = PrimaryAirSystem(AirLoopNum)%InletBranchNum(InNum)
IF (InBranchNum == 0) THEN
CALL ShowFatalError('Missing Inlet Branch on Primary Air System='//TRIM(PrimaryAirSystem(AirLoopNum)%Name))
ENDIF
NodeNumIn = PrimaryAirSystem(AirLoopNum)%Branch(InBranchNum)%NodeNumIn
! [DC/LBNL] Save previous mass flow rate
MassFlowSaved = Node(NodeNumIn)%MassFlowRate
Node(NodeNumIn)%MassFlowRate = PrimaryAirSystem(AirLoopNum)%Branch(InBranchNum)%MaxMassFlowRate
AirLoopFlow(AirLoopNum)%DesSupply = PrimaryAirSystem(AirLoopNum)%Branch(InBranchNum)%MaxMassFlowRate
! [DC/LBNL] Detect if air mass flow rate has changed since last air loop simulation
IF ( Node(NodeNumIn)%MassFlowRate /= MassFlowSaved ) THEN
AirLoopControlInfo(AirLoopNum)%NewFlowRateFlag = .TRUE.
END IF
END DO ! end loop over inlet branches
AirLoopControlInfo(AirLoopNum)%EconoLockout = .FALSE.
END IF
! if a flow rate is specified for the loop use it here
IF (AirLoopControlInfo(AirLoopNum)%LoopFlowRateSet .AND. .NOT. FirstHVACIteration) THEN
DO InNum=1,PrimaryAirSystem(AirLoopNum)%NumInletBranches
InBranchNum = PrimaryAirSystem(AirLoopNum)%InletBranchNum(InNum)
NodeNumIn = PrimaryAirSystem(AirLoopNum)%Branch(InBranchNum)%NodeNumIn
Node(NodeNumIn)%MassFlowRate = AirLoopFlow(AirLoopNum)%DesSupply * AirLoopFlow(AirLoopNum)%ReqSupplyFrac - &
(AirLoopFlow(AirLoopNum)%ZoneExhaust - AirLoopFlow(AirLoopNum)%ZoneExhaustBalanced)
END DO
END IF
END DO ! end loop over primary air systems
RETURN
END SUBROUTINE InitAirLoops