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