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 GetZonePlenumInput
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN November 2000
! MODIFIED August 2003, FCW: For each zone with a return air plenum put the ZoneRetPlenCond
! number for the return air plenum in the ZoneEquipConfig array for the zone
! for later access to the zone's return air plenum conditions.
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is the main routine to call other input routines and Get routines
! METHODOLOGY EMPLOYED:
! Uses the status flags to trigger events.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,VerifyName,FindItemInList,GetObjectDefMaxArgs
USE NodeInputManager, ONLY: GetOnlySingleNode, GetNodeNums, InitUniqueNodeCheck, CheckUniqueNodes, EndUniqueNodeCheck
USE DataHeatBalance, ONLY: Zone
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE DataIPShortCuts
USE PoweredInductionUnits, ONLY: PIUInducesPlenumAir
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 :: ZonePlenumNum ! The ZonePlenum that you are currently loading input into
INTEGER :: ZonePlenumLoop
INTEGER :: ZoneEquipConfigLoop
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: NumArgs
INTEGER :: NumNodes
INTEGER, ALLOCATABLE, DIMENSION(:) :: NodeNums
INTEGER :: MaxNums
INTEGER :: MaxAlphas
INTEGER :: NodeNum
INTEGER :: IOSTAT
REAL(r64), ALLOCATABLE, DIMENSION(:) :: NumArray ! Numeric input items for object
CHARACTER(len=MaxNameLength) :: CurrentModuleObject ! for ease in getting objects
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: AlphArray ! Alpha input items for object
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cAlphaFields ! Alpha field names
CHARACTER(len=MaxNameLength), ALLOCATABLE, DIMENSION(:) :: cNumericFields ! Numeric field names
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lAlphaBlanks ! Logical array, alpha field input BLANK = .true.
LOGICAL, ALLOCATABLE, DIMENSION(:) :: lNumericBlanks ! Logical array, numeric field input BLANK = .true.
LOGICAL :: ErrorsFound=.FALSE.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: NodeListError ! Flag for node list error
LOGICAL :: UniqueNodeError
CHARACTER(len=*), PARAMETER :: RoutineName='GetZonePlenumInput: ' ! include trailing blank space
CHARACTER(len=MaxNameLength) :: InducedNodeListName
! Flow
CALL GetObjectDefMaxArgs('AirLoopHVAC:ReturnPlenum',NumArgs,NumAlphas,NumNums)
MaxNums=NumNums
MaxAlphas=NumAlphas
CALL GetObjectDefMaxArgs('AirLoopHVAC:SupplyPlenum',NumArgs,NumAlphas,NumNums)
MaxNums=MAX(NumNums,MaxNums)
MaxAlphas=MAX(NumAlphas,MaxAlphas)
ALLOCATE(AlphArray(MaxAlphas))
AlphArray=' '
ALLOCATE(cAlphaFields(MaxAlphas))
cAlphaFields=' '
ALLOCATE(cNumericFields(MaxNums))
cNumericFields=' '
ALLOCATE(NumArray(MaxNums))
NumArray=0.0d0
ALLOCATE(lAlphaBlanks(MaxAlphas))
lAlphaBlanks=.TRUE.
ALLOCATE(lNumericBlanks(MaxNums))
lNumericBlanks=.TRUE.
CALL GetObjectDefMaxArgs('NodeList',NumArgs,NumAlphas,NumNums)
ALLOCATE(NodeNums(NumArgs))
NodeNums=0
InducedNodeListName = ' '
NumZoneReturnPlenums = GetNumObjectsFound('AirLoopHVAC:ReturnPlenum')
NumZoneSupplyPlenums = GetNumObjectsFound('AirLoopHVAC:SupplyPlenum')
NumZonePlenums = NumZoneReturnPlenums + NumZoneSupplyPlenums
IF (NumZoneReturnPlenums.GT.0) ALLOCATE(ZoneRetPlenCond(NumZoneReturnPlenums))
IF (NumZoneSupplyPlenums.GT.0) ALLOCATE(ZoneSupPlenCond(NumZoneSupplyPlenums))
ALLOCATE(CheckRetEquipName(NumZoneReturnPlenums))
CheckRetEquipName=.true.
ALLOCATE(CheckSupEquipName(NumZoneSupplyPlenums))
CheckSupEquipName=.true.
ZonePlenumNum = 0
CALL InitUniqueNodeCheck('AirLoopHVAC:ReturnPlenum')
DO ZonePlenumLoop = 1, NumZoneReturnPlenums
ZonePlenumNum = ZonePlenumNum + 1
CurrentModuleObject='AirLoopHVAC:ReturnPlenum'
CALL GetObjectItem(CurrentModuleObject,ZonePlenumNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(AlphArray(1),ZoneRetPlenCond%ZonePlenumName,ZonePlenumNum-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
ZoneRetPlenCond(ZonePlenumNum)%ZonePlenumName = AlphArray(1)
! Check if this zone is also used in another return plenum
IOSTAT=FindItemInList(AlphArray(2),ZoneRetPlenCond%ZoneName,ZonePlenumNum-1)
IF (IOSTAT /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cAlphaFields(2))//' "'//TRIM(AlphArray(2))// &
'" is used more than once as a '//TRIM(CurrentModuleObject)//'.')
CALL ShowContinueError('..Only one '//TRIM(CurrentModuleObject)//' object may be connected to a given zone.')
CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
ZoneRetPlenCond(ZonePlenumNum)%ZoneName = AlphArray(2)
! put the X-Ref to the zone heat balance data structure
ZoneRetPlenCond(ZonePlenumNum)%ActualZoneNum = FindItemInList(AlphArray(2),Zone%Name,NumOfZones)
IF (ZoneRetPlenCond(ZonePlenumNum)%ActualZoneNum == 0) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1))// &
', '//TRIM(cAlphaFields(2))//' = '//TRIM(AlphArray(2))//' not found.')
ErrorsFound=.TRUE.
CYCLE
ENDIF
! Check if this zone is used as a controlled zone
ZoneEquipConfigLoop=FindItemInList(AlphArray(2),ZoneEquipConfig%ZoneName,NumOfZones)
IF (ZoneEquipConfigLoop /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cAlphaFields(2))//' "'//TRIM(AlphArray(2))//'" is a controlled zone.'// &
' It cannot be used as a '//TRIM(CurrentModuleObject))
CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
ZoneRetPlenCond(ZonePlenumNum)%ZoneNodeName = AlphArray(3)
ZoneRetPlenCond(ZonePlenumNum)%ZoneNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_ZoneNode,1,ObjectIsNotParent)
!Insert the Plenum Zone Number into the Zone Heat Balance data structure for later reference
Zone(ZoneRetPlenCond(ZonePlenumNum)%ActualZoneNum)%SystemZoneNodeNumber = ZoneRetPlenCond(ZonePlenumNum)%ZoneNodeNum
ZoneRetPlenCond(ZonePlenumNum)%OutletNode = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
InducedNodeListName = AlphArray(5)
NodeListError=.false.
CALL GetNodeNums(InducedNodeListName,NumNodes,NodeNums,NodeListError,NodeType_Air,'AirLoopHVAC:ReturnPlenum', &
ZoneRetPlenCond(ZonePlenumNum)%ZonePlenumName,NodeConnectionType_InducedAir,1,ObjectIsNotParent, &
InputFieldName=cAlphaFields(5))
IF (.not. NodeListError) THEN
ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes = NumNodes
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedNode(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRate(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRateMaxAvail(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRateMinAvail(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedTemp(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedHumRat(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedEnthalpy(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InducedPressure(ZoneRetPlenCond(ZonePlenumNum)%NumInducedNodes))
ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRate = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRateMaxAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedMassFlowRateMinAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedTemp = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedHumRat = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedEnthalpy = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InducedPressure = 0.0d0
DO NodeNum = 1, NumNodes
ZoneRetPlenCond(ZonePlenumNum)%InducedNode(NodeNum) = NodeNums(NodeNum)
UniqueNodeError=.false.
CALL CheckUniqueNodes('Return Plenum Induced Air Nodes','NodeNumber',UniqueNodeError,CheckNumber=NodeNums(NodeNum))
IF (UniqueNodeError) THEN
CALL ShowContinueError('Occurs for ReturnPlenum = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
CALL PIUInducesPlenumAir(ZoneRetPlenCond(ZonePlenumNum)%InducedNode(NodeNum))
END DO
ELSE
CALL ShowContinueError('Invalid Induced Air Outlet Node or NodeList name in AirLoopHVAC:ReturnPlenum object = '// &
TRIM(ZoneRetPlenCond(ZonePlenumNum)%ZonePlenumName))
ErrorsFound=.true.
ENDIF
ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes = NumAlphas - 5
ZoneRetPlenCond%InitFlag = .TRUE.
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletNode(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRate(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRateMaxAvail(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRateMinAvail(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletTemp(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletHumRat(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletEnthalpy(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%InletPressure(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ALLOCATE(ZoneRetPlenCond(ZonePlenumNum)%ZoneEqNum(ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes))
ZoneRetPlenCond(ZonePlenumNum)%InletNode = 0
ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRate = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRateMaxAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletMassFlowRateMinAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletTemp = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletHumRat = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletEnthalpy = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%InletPressure = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletMassFlowRate = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletMassFlowRateMaxAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletMassFlowRateMinAvail = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletTemp = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletHumRat = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletEnthalpy = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%OutletPressure = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%ZoneTemp = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%ZoneHumRat = 0.0d0
ZoneRetPlenCond(ZonePlenumNum)%ZoneEnthalpy = 0.0d0
DO NodeNum = 1, ZoneRetPlenCond(ZonePlenumNum)%NumInletNodes
ZoneRetPlenCond(ZonePlenumNum)%InletNode(NodeNum) = &
GetOnlySingleNode(AlphArray(5+NodeNum),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
END DO
END DO ! end AirLoopHVAC:ReturnPlenum Loop
CALL EndUniqueNodeCheck('AirLoopHVAC:ReturnPlenum')
ZonePlenumNum = 0
DO ZonePlenumLoop = 1, NumZoneSupplyPlenums
ZonePlenumNum = ZonePlenumNum + 1
CurrentModuleObject='AirLoopHVAC:SupplyPlenum'
CALL GetObjectItem(CurrentModuleObject,ZonePlenumNum,AlphArray,NumAlphas,NumArray,NumNums,IOSTAT, &
NumBlank=lNumericBlanks,AlphaBlank=lAlphaBlanks, &
AlphaFieldNames=cAlphaFields,NumericFieldNames=cNumericFields)
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(AlphArray(1),ZoneSupPlenCond%ZonePlenumName,ZonePlenumNum-1,IsNotOK,IsBlank, &
TRIM(CurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
ZoneSupPlenCond(ZonePlenumNum)%ZonePlenumName = AlphArray(1)
! Check if this zone is also used in another plenum
IOSTAT=FindItemInList(AlphArray(2),ZoneSupPlenCond%ZoneName,ZonePlenumNum-1)
IF (IOSTAT /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cAlphaFields(2))//' "'//TRIM(AlphArray(2))// &
'" is used more than once as a '//TRIM(CurrentModuleObject)//'.')
CALL ShowContinueError('..Only one '//TRIM(CurrentModuleObject)//' object may be connected to a given zone.')
CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
IF (NumZoneReturnPlenums > 0) THEN ! Check if this zone is also used in another plenum
IOSTAT=FindItemInList(AlphArray(2),ZoneRetPlenCond%ZoneName,NumZoneReturnPlenums)
IF (IOSTAT /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cAlphaFields(2))//' "'//TRIM(AlphArray(2))// &
'" is used more than once as a '//TRIM(CurrentModuleObject)//' or AirLoopHVAC:ReturnPlenum.')
CALL ShowContinueError('..Only one '//TRIM(CurrentModuleObject)//' or AirLoopHVAC:ReturnPlenum object'// &
' may be connected to a given zone.')
CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
ENDIF
ZoneSupPlenCond(ZonePlenumNum)%ZoneName = AlphArray(2)
! put the X-Ref to the zone heat balance data structure
ZoneSupPlenCond(ZonePlenumNum)%ActualZoneNum = FindItemInList(AlphArray(2),Zone%Name,NumOfZones)
IF (ZoneSupPlenCond(ZonePlenumNum)%ActualZoneNum == 0) THEN
CALL ShowSevereError('For '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1))// &
', '//TRIM(cAlphaFields(2))//' = '//TRIM(AlphArray(2))//' not found.')
ErrorsFound=.TRUE.
CYCLE
ENDIF
! Check if this zone is used as a controlled zone
IF (ANY(ZoneEquipConfig%IsControlled)) THEN
ZoneEquipConfigLoop=FindItemInList(AlphArray(2),ZoneEquipConfig%ZoneName,NumOfZones)
IF (ZoneEquipConfigLoop /= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cAlphaFields(2))//' "'//TRIM(AlphArray(2))//'" is a controlled zone.'// &
' It cannot be used as a '//TRIM(CurrentModuleObject)//' or AirLoopHVAC:ReturnPlenum.')
CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
ENDIF
! Check if this is also used as a return plenum
! *** This next IF loop looks wrong. Sent e-mail to Peter/Brent 8/14/08 for clarification ****
! IF (NumZoneReturnPlenums > 0) THEN
! IOSTAT=FindItemInList(AlphArray(1),ZoneRetPlenCond%ZoneName,NumZoneReturnPlenums)
! IF (IOSTAT /= 0) THEN
! CALL ShowSevereError(RoutineName//'Plenum "'//TRIM(AlphArray(2))// &
! '" is a controlled zone. It cannot be used as a '// &
! 'SUPPLY PLENUM or RETURN PLENUM.')
! CALL ShowContinueError('..occurs in '//TRIM(CurrentModuleObject)//' = '//TRIM(AlphArray(1)))
! ErrorsFound=.true.
! ENDIF
! ENDIF
ZoneSupPlenCond(ZonePlenumNum)%ZoneNodeName = AlphArray(3)
ZoneSupPlenCond(ZonePlenumNum)%ZoneNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_ZoneNode,1,ObjectIsNotParent)
!Insert the Plenum Zone Number into the Zone Heat Balance data structure for later reference
Zone(ZoneSupPlenCond(ZonePlenumNum)%ActualZoneNum)%SystemZoneNodeNumber = ZoneSupPlenCond(ZonePlenumNum)%ZoneNodeNum
ZoneSupPlenCond(ZonePlenumNum)%InletNode = &
GetOnlySingleNode(AlphArray(4),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes = NumAlphas - 4
ZoneSupPlenCond%InitFlag = .TRUE.
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletNode(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRate(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRateMaxAvail(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRateMinAvail(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletTemp(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletHumRat(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletEnthalpy(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ALLOCATE(ZoneSupPlenCond(ZonePlenumNum)%OutletPressure(ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes))
ZoneSupPlenCond(ZonePlenumNum)%OutletNode = 0
ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRate = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRateMaxAvail = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletMassFlowRateMinAvail = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletTemp = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletHumRat = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletEnthalpy = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%OutletPressure = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletMassFlowRate = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletMassFlowRateMaxAvail = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletMassFlowRateMinAvail = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletTemp = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletHumRat = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletEnthalpy = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%InletPressure = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%ZoneTemp = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%ZoneHumRat = 0.0d0
ZoneSupPlenCond(ZonePlenumNum)%ZoneEnthalpy = 0.0d0
DO NodeNum = 1, ZoneSupPlenCond(ZonePlenumNum)%NumOutletNodes
ZoneSupPlenCond(ZonePlenumNum)%OutletNode(NodeNum) = &
GetOnlySingleNode(AlphArray(4+NodeNum),ErrorsFound,TRIM(CurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
END DO
END DO ! end AirLoopHVAC:SupplyPlenum Loop
DEALLOCATE(AlphArray)
DEALLOCATE(NumArray)
DEALLOCATE(cAlphaFields)
DEALLOCATE(cNumericFields)
DEALLOCATE(lAlphaBlanks)
DEALLOCATE(lNumericBlanks)
DEALLOCATE(NodeNums)
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in input. Preceding condition(s) cause termination.')
ENDIF
RETURN
END SUBROUTINE GetZonePlenumInput