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 GetPIUs
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN August 2000
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for powered induction unit terminal boxes and stores it
! in PIU data structures
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE NodeInputManager, ONLY: GetOnlySingleNode
USE FluidProperties, ONLY: FindRefrigerant
USE DataZoneEquipment, ONLY: ZoneEquipConfig
USE BranchNodeConnections, ONLY: SetUpCompSets, TestCompSet
USE DataDefineEquip, ONLY: AirDistUnit, NumAirDistUnits
USE DataIPShortCuts
USE DataPlant, ONLY: TypeOf_CoilWaterSimpleHeating, TypeOf_CoilSteamAirHeating
USE WaterCoils, ONLY: GetCoilWaterInletNode
USE SteamCoils, ONLY: GetCoilSteamInletNode
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 :: PIUIndex ! loop index
INTEGER :: PIUNum ! current fan coil number
INTEGER :: NumAlphas ! Number of Alpha input fields for each GetObjectItem call
INTEGER :: NumNumbers ! Number of Numeric input fields for each GetObjectItem call
INTEGER :: IOStatus ! Used in GetObjectItem
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: CtrlZone ! controlled zome do loop index
INTEGER :: SupAirIn ! controlled zone supply air inlet index
LOGICAL :: AirNodeFound
INTEGER :: ADUNum
CHARACTER(len=*), PARAMETER :: RoutineName='GetPIUs: ' ! include trailing blank space
LOGICAL :: SteamMessageNeeded
! FLOW
! find the number of each type of fan coil unit
SteamMessageNeeded=.true.
NumSeriesPIUs = GetNumObjectsFound('AirTerminal:SingleDuct:SeriesPIU:Reheat')
NumParallelPIUs = GetNumObjectsFound('AirTerminal:SingleDuct:ParallelPIU:Reheat')
NumPIUs = NumSeriesPIUs + NumParallelPIUs
! allocate the data structures
ALLOCATE(PIU(NumPIUs))
ALLOCATE(CheckEquipName(NumPIUs))
CheckEquipName=.true.
! loop over Series PIUs; get and load the input data
DO PIUIndex = 1,NumSeriesPIUs
cCurrentModuleObject = 'AirTerminal:SingleDuct:SeriesPIU:Reheat'
CALL GetObjectItem(cCurrentModuleObject,PIUIndex,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
PIUNum = PIUIndex
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),PIU%Name,PIUNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PIU(PIUNum)%Name = cAlphaArgs(1)
PIU(PIUNum)%UnitType = TRIM(cCurrentModuleObject)
PIU(PIUNum)%UnitType_Num = SingleDuct_SeriesPIU_Reheat
PIU(PIUNum)%Sched = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
PIU(PIUNum)%SchedPtr = ScheduleAlwaysOn
ELSE
PIU(PIUNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2)) ! convert schedule name to pointer
IF (PIU(PIUNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
PIU(PIUNum)%MaxTotAirVolFlow = rNumericArgs(1)
PIU(PIUNum)%MaxPriAirVolFlow = rNumericArgs(2)
PIU(PIUNum)%MinPriAirFlowFrac = rNumericArgs(3)
PIU(PIUNum)%HCoilType = cAlphaArgs(9) ! type (key) of heating coil
IF (SameString(cAlphaArgs(9),'COIL:HEATING:WATER')) THEN
PIU(PIUNum)%HCoilType_Num = HCoilType_SimpleHeating
PIU(PIUNum)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:GAS')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_Gas
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:STEAM')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_SteamAirHeating
PIU(PIUNum)%HCoil_PlantTypeNum=TypeOf_CoilSteamAirHeating
PIU(PIUNum)%HCoil_FluidIndex=FindRefrigerant('Steam')
IF (PIU(PIUNum)%HCoil_FluidIndex == 0) THEN
CALL ShowSevereError(RoutineName//'Steam Properties for '//TRIM(cAlphaArgs(1))// &
' not found.')
IF (SteamMessageNeeded) CALL ShowContinueError('Steam Fluid Properties should have been included in the input file.')
ErrorsFound=.true.
SteamMessageNeeded=.false.
ENDIF
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:ELECTRIC')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_Electric
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(9))//' = '//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(PIU(PIUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
PIU(PIUNum)%PriAirInNode = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,PIU(PIUNum)%UnitType,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFieldNames(3))
PIU(PIUNum)%SecAirInNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,PIU(PIUNum)%UnitType,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFieldNames(4))
PIU(PIUNum)%OutAirNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,PIU(PIUNum)%UnitType,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent,cAlphaFieldNames(5))
PIU(PIUNum)%HCoilInAirNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,PIU(PIUNum)%UnitType,cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsParent,cAlphaFieldNames(6))
! The reheat coil control node is necessary for hot water reheat, but not necessary for
! electric or gas reheat.
IF (PIU(PIUNum)%HCoilType_Num .EQ. HCoilType_Gas .OR. PIU(PIUNum)%HCoilType_Num .EQ. HCoilType_Electric) THEN
IF(.NOT. lAlphaFieldBlanks(11)) THEN
CALL ShowWarningError('In '//TRIM(cCurrentModuleObject)//' = ' // TRIM(PIU(PIUNum)%Name) &
// ' the '//TRIM(cAlphaFieldNames(11))//' is not needed and will be ignored.')
CALL ShowContinueError(' It is used for hot water reheat coils only.')
END IF
ELSE
IF(lAlphaFieldBlanks(11)) THEN
CALL ShowSevereError('In '//TRIM(cCurrentModuleObject)//' = ' // TRIM(PIU(PIUNum)%Name) &
// ' the '//TRIM(cAlphaFieldNames(11))//' is undefined.')
ErrorsFound=.TRUE.
END IF
PIU(PIUNum)%HotControlNode = &
GetOnlySingleNode(cAlphaArgs(11),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent,cAlphaFieldNames(11))
END IF
PIU(PIUNum)%MixerName = cAlphaArgs(7) ! name of zone mixer object
PIU(PIUNum)%FanName = cAlphaArgs(8) ! name of fan object
PIU(PIUNum)%HCoil = cAlphaArgs(10) ! name of heating coil object
CALL ValidateComponent(PIU(PIUNum)%HCoilType,PIU(PIUNum)%HCoil,IsNotOK,TRIM(cCurrentModuleObject)//' - Heating Coil')
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(cCurrentModuleObject)//' = '//TRIM(PIU(PIUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
PIU(PIUNum)%MaxVolHotWaterFlow = rNumericArgs(4)
PIU(PIUNum)%MinVolHotWaterFlow = rNumericArgs(5)
PIU(PIUNum)%HotControlOffset = rNumericArgs(6)
! Set default convergence tolerance
IF (PIU(PIUNum)%HotControlOffset .LE. 0.0d0) THEN
PIU(PIUNum)%HotControlOffset = 0.001d0
END IF
! Add fan to component sets array
CALL SetUpCompSets(PIU(PIUNum)%UnitType, PIU(PIUNum)%Name, &
'UNDEFINED',cAlphaArgs(8),'UNDEFINED',cAlphaArgs(6))
! Add reheat coil to component sets array
CALL SetUpCompSets(PIU(PIUNum)%UnitType, PIU(PIUNum)%Name, &
cAlphaArgs(9),cAlphaArgs(10),cAlphaArgs(6),cAlphaArgs(5))
! Register component set data
CALL TestCompSet(PIU(PIUNum)%UnitType,PIU(PIUNum)%Name, &
NodeID(PIU(PIUNum)%PriAirInNode),NodeID(PIU(PIUNum)%OutAirNode),'Air Nodes')
! Fill the Zone Equipment data with the supply air inlet node number of this unit.
AirNodeFound=.false.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (PIU(PIUNum)%OutAirNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(SupAirIn)) THEN
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = PIU(PIUNum)%PriAirInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = PIU(PIUNum)%OutAirNode
AirNodeFound=.TRUE.
EXIT
END IF
END DO
END DO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('The outlet air node from the '//TRIM(cCurrentModuleObject)//' Unit = '//TRIM(PIU(PIUNum)%Name))
CALL ShowContinueError('did not have a matching Zone Equipment Inlet Node, Node = '//TRIM(cAlphaArgs(5)))
ErrorsFound=.TRUE.
ENDIF
END DO
DO PIUIndex = 1,NumParallelPIUs
cCurrentModuleObject = 'AirTerminal:SingleDuct:ParallelPIU:Reheat'
CALL GetObjectItem(cCurrentModuleObject,PIUIndex,cAlphaArgs,NumAlphas,rNumericArgs,NumNumbers,IOStatus, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
PIUNum = PIUIndex + NumSeriesPIUs
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1),PIU%Name,PIUNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PIU(PIUNum)%Name = cAlphaArgs(1)
PIU(PIUNum)%UnitType = TRIM(cCurrentModuleObject)
PIU(PIUNum)%UnitType_Num = SingleDuct_ParallelPIU_Reheat
PIU(PIUNum)%Sched = cAlphaArgs(2)
IF (lAlphaFieldBlanks(2)) THEN
PIU(PIUNum)%SchedPtr = ScheduleAlwaysOn
ELSE
PIU(PIUNum)%SchedPtr = GetScheduleIndex(cAlphaArgs(2)) ! convert schedule name to pointer
IF (PIU(PIUNum)%SchedPtr .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': invalid '//TRIM(cAlphaFieldNames(2))// &
' entered ='//TRIM(cAlphaArgs(2))// &
' for '//TRIM(cAlphaFieldNames(1))//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.TRUE.
END IF
END IF
PIU(PIUNum)%MaxPriAirVolFlow = rNumericArgs(1)
PIU(PIUNum)%MaxSecAirVolFlow = rNumericArgs(2)
PIU(PIUNum)%MinPriAirFlowFrac = rNumericArgs(3)
PIU(PIUNum)%FanOnFlowFrac = rNumericArgs(4)
PIU(PIUNum)%HCoilType = cAlphaArgs(9) ! type (key) of heating coil
IF (SameString(cAlphaArgs(9),'COIL:HEATING:WATER')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_SimpleHeating
PIU(PIUNum)%HCoil_PlantTypeNum = TypeOf_CoilWaterSimpleHeating
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:GAS')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_Gas
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:STEAM')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_SteamAirHeating
PIU(PIUNum)%HCoil_PlantTypeNum=TypeOf_CoilSteamAirHeating
PIU(PIUNum)%HCoil_FluidIndex=FindRefrigerant('Steam')
IF (PIU(PIUNum)%HCoil_FluidIndex == 0) THEN
CALL ShowSevereError(RoutineName//'Steam Properties for '//TRIM(cAlphaArgs(1))// &
' not found.')
IF (SteamMessageNeeded) CALL ShowContinueError('Steam Fluid Properties should have been included in the input file.')
ErrorsFound=.true.
SteamMessageNeeded=.false.
ENDIF
ELSEIF (SameString(cAlphaArgs(9),'COIL:HEATING:ELECTRIC')) THEN
PIU(PIUNum)%HCoilType_Num=HCoilType_Electric
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(9))//' = '//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Occurs in '//TRIM(cCurrentModuleObject)//' = '//TRIM(PIU(PIUNum)%Name))
ErrorsFound=.TRUE.
ENDIF
PIU(PIUNum)%PriAirInNode = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFieldNames(3))
PIU(PIUNum)%SecAirInNode = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsParent,cAlphaFieldNames(4))
PIU(PIUNum)%OutAirNode = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsParent,cAlphaFieldNames(5))
PIU(PIUNum)%HCoilInAirNode = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Internal,1,ObjectIsParent,cAlphaFieldNames(6))
! The reheat coil control node is necessary for hot water reheat, but not necessary for
! electric or gas reheat.
! IF (PIU(PIUNum)%HCoilType_Num .EQ. HCoilType_Gas .OR. PIU(PIUNum)%HCoilType_Num .EQ. HCoilType_Electric) THEN
! IF(cAlphaArgs(11) /= '') THEN
! CALL ShowWarningError('In '//TRIM(cCurrentModuleObject)//' = ' // TRIM(PIU(PIUNum)%Name) &
! // ' the '//TRIM(cAlphaFieldNames(11))//' is not needed and will be ignored.')
! CALL ShowContinueError(' It is used for hot water reheat coils only.')
! END IF
! ELSE
! IF(cAlphaArgs(11) == '') THEN
! CALL ShowSevereError('In '//TRIM(cCurrentModuleObject)//' = ' // TRIM(PIU(PIUNum)%Name) &
! // ' the '//TRIM(cAlphaFieldNames(11))//' is undefined.')
! ErrorsFound=.true.
! END IF
! PIU(PIUNum)%HotControlNode = &
! GetOnlySingleNode(cAlphaArgs(11),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
! NodeType_Water,NodeConnectionType_Actuator,1,ObjectIsParent)
! END IF
IF (PIU(PIUNum)%HCoilType_Num == HCoilType_SimpleHeating) THEN
PIU(PIUNum)%HotControlNode = GetCoilWaterInletNode(cAlphaArgs(9),cAlphaArgs(10),ErrorsFound)
ENDIF
IF (PIU(PIUNum)%HCoilType_Num == HCoilType_SteamAirHeating) THEN
PIU(PIUNum)%HotControlNode = GetCoilSteamInletNode(cAlphaArgs(9),cAlphaArgs(10),ErrorsFound)
ENDIF
PIU(PIUNum)%MixerName = cAlphaArgs(7) ! name of zone mixer object
PIU(PIUNum)%FanName = cAlphaArgs(8) ! name of fan object
PIU(PIUNum)%HCoil = cAlphaArgs(10) ! name of heating coil object
CALL ValidateComponent(PIU(PIUNum)%HCoilType,PIU(PIUNum)%HCoil,IsNotOK,TRIM(cCurrentModuleObject)//' - Heating Coil')
IF (IsNotOK) THEN
CALL ShowContinueError('In '//TRIM(cCurrentModuleObject)//' = '//TRIM(PIU(PIUNum)%Name))
ErrorsFound=.true.
ENDIF
PIU(PIUNum)%MaxVolHotWaterFlow = rNumericArgs(5)
PIU(PIUNum)%MinVolHotWaterFlow = rNumericArgs(6)
PIU(PIUNum)%HotControlOffset = rNumericArgs(7)
! Set default convergence tolerance
IF (PIU(PIUNum)%HotControlOffset .LE. 0.0d0) THEN
PIU(PIUNum)%HotControlOffset = 0.001d0
END IF
! Add fan to component sets array
CALL SetUpCompSets(PIU(PIUNum)%UnitType, PIU(PIUNum)%Name, &
'UNDEFINED',cAlphaArgs(8),cAlphaArgs(4),'UNDEFINED')
! Add reheat coil to component sets array
CALL SetUpCompSets(PIU(PIUNum)%UnitType, PIU(PIUNum)%Name, &
cAlphaArgs(9),cAlphaArgs(10),cAlphaArgs(6),cAlphaArgs(5))
! Register component set data
CALL TestCompSet(PIU(PIUNum)%UnitType,PIU(PIUNum)%Name, &
NodeID(PIU(PIUNum)%PriAirInNode),NodeID(PIU(PIUNum)%OutAirNode),'Air Nodes')
! Fill the Zone Equipment data with the supply air inlet node number of this unit.
AirNodeFound=.false.
DO CtrlZone = 1,NumOfZones
IF (.not. ZoneEquipConfig(CtrlZone)%IsControlled) CYCLE
DO SupAirIn = 1,ZoneEquipConfig(CtrlZone)%NumInletNodes
IF (PIU(PIUNum)%OutAirNode .EQ. ZoneEquipConfig(CtrlZone)%InletNode(SupAirIn)) THEN
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%InNode = PIU(PIUNum)%PriAirInNode
ZoneEquipConfig(CtrlZone)%AirDistUnitCool(SupAirIn)%OutNode = PIU(PIUNum)%OutAirNode
AirNodeFound=.true.
END IF
END DO
END DO
IF (.not. AirNodeFound) THEN
CALL ShowSevereError('The outlet air node from the '//TRIM(cCurrentModuleObject)//' Unit = '//TRIM(PIU(PIUNum)%Name))
CALL ShowContinueError('did not have a matching Zone Equipment Inlet Node, Node = '//TRIM(cAlphaArgs(5)))
ErrorsFound=.true.
ENDIF
END DO
DO PIUNum=1,NumPIUs
DO ADUNum = 1,NumAirDistUnits
IF (PIU(PIUNum)%OutAirNode == AirDistUnit(ADUNum)%OutletNodeNum) THEN
! AirDistUnit(ADUNum)%InletNodeNum = PIU(PIUNum)%InletNodeNum
PIU(PIUNum)%ADUNum = ADUNum
END IF
END DO
! one assumes if there isn't one assigned, it's an error?
IF (PIU(PIUNum)%ADUNum == 0) THEN
CALL ShowSevereError(RoutineName//'No matching Air Distribution Unit, for PIU = ['// &
TRIM(PIU(PIUNum)%UnitType)//','//TRIM(PIU(PIUNum)%Name)//'].')
CALL ShowContinueError('...should have outlet node = '//TRIM(NodeID(PIU(PIUNum)%OutAirNode)))
! ErrorsFound=.true.
ENDIF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting input. Preceding conditions cause termination.')
END IF
Do PIUNum=1,NumPIUs
! Setup Report variables for the Fan Coils
CALL SetupOutputVariable('Zone Air Terminal Heating Rate [W]',PIU(PIUNum)%HeatingRate,'System','Average',&
PIU(PIUNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Heating Energy [J]',PIU(PIUNum)%HeatingEnergy,'System','Sum',&
PIU(PIUNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Sensible Cooling Rate [W]',PIU(PIUNum)%SensCoolRate,'System','Average',&
PIU(PIUNum)%Name)
CALL SetupOutputVariable('Zone Air Terminal Sensible Cooling Energy [J]',PIU(PIUNum)%SensCoolEnergy,'System','Sum',&
PIU(PIUNum)%Name)
END DO
RETURN
END SUBROUTINE GetPIUs