SUBROUTINE GetPumpInput()
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1998
! MODIFIED: July 2001, Rick Strand (addition of pump controls)
! May 2009, Brent Griffith (added EMS calls)
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the pump simulation.
! PUMP:VARIABLE SPEED,
! This pump model is described in the ASHRAE secondary HVAC toolkit.
! REFERENCES:
! HVAC 2 Toolkit: A Toolkit for Secondary HVAC System
! Energy Calculations, ASHRAE, 1993, pp2-10 to 2-15
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, FindItemInList
USE DataIPShortCuts, ONLY: lAlphaFieldBlanks, cAlphaFieldNames, cNumericFieldNames, lNumericFieldBlanks, &
cCurrentModuleObject, cAlphaArgs, rNumericArgs
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE FluidProperties, ONLY: GetSatDensityRefrig, GetDensityGlycol
USE DataSizing, ONLY: Autosize
USE DataInterfaces
USE CurveManager, ONLY: GetCurveType, GetCurveIndex, GetCurveMinMaxValues
USE DataPlant, ONLY: TypeOf_PumpVariableSpeed, TypeOf_PumpConstantSpeed, TypeOf_PumpCondensate, &
TypeOf_PumpBankVariableSpeed, TypeOf_PumpBankConstantSpeed
USE ScheduleManager, ONLY: GetScheduleIndex,CheckScheduleValueMinMax
USE DataHeatBalance, ONLY: IntGainTypeOf_Pump_VarSpeed, IntGainTypeOf_Pump_ConSpeed, &
IntGainTypeOf_Pump_Cond, IntGainTypeOf_PumpBank_VarSpeed, &
IntGainTypeOf_PumpBank_ConSpeed, Zone
USE DataGlobals, ONLY: NumOfZones
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: StartTemp = 100.0d0 ! Standard Temperature across code to calculated Steam density
CHARACTER(len=*), PARAMETER :: RoutineName = 'GetPumpInput: '
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PumpNum
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL :: ErrorsFound
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
INTEGER :: TempCurveIndex
CHARACTER(len=32) :: TempCurveType
INTEGER :: NumVarSpeedPumps
INTEGER :: NumConstSpeedPumps
INTEGER :: NumCondensatePumps
INTEGER :: NumVarPump
INTEGER :: NumConstPump
INTEGER :: NumCondPump
INTEGER :: NumPumpBankSimpleVar
INTEGER :: NumPumpBankSimpleConst
INTEGER :: NumVarPumpBankSimple
INTEGER :: NumConstPumpBankSimple
REAL(r64) :: SteamDensity
REAL(r64) :: TempWaterDensity
INTEGER :: DummyWaterIndex =1
ErrorsFound = .FALSE.
!GET NUMBER OF ALL EQUIPMENT TYPES
NumVarSpeedPumps = GetNumObjectsFound(cPump_VarSpeed)
NumConstSpeedPumps = GetNumObjectsFound(cPump_ConSpeed)
NumCondensatePumps = GetNumObjectsFound(cPump_Cond)
NumPumpBankSimpleVar = GetNumObjectsFound(cPumpBank_VarSpeed)
NumPumpBankSimpleConst= GetNumObjectsFound(cPumpBank_ConSpeed)
NumPumps = NumVarSpeedPumps + NumConstSpeedPumps + NumCondensatePumps + NumPumpBankSimpleVar + NumPumpBankSimpleConst
IF(NumPumps<=0)THEN
CALL ShowWarningError('No Pumping Equipment Found')
RETURN
END IF
ALLOCATE (PumpEquip(NumPumps))
ALLOCATE (PumpEquipReport(NumPumps))
!LOAD ARRAYS WITH VARIABLE SPEED CURVE FIT PUMP DATA
cCurrentModuleObject = cPump_VarSpeed
DO NumVarPump = 1 , NumVarSpeedPumps
PumpNum = NumVarPump
CALL GetObjectItem(cCurrentModuleObject,NumVarPump,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PumpEquip%Name,PumpNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PumpEquip(PumpNum)%Name = cAlphaArgs(1)
PumpEquip(PumpNum)%PumpType = Pump_VarSpeed !'Pump:VariableSpeed'
PumpEquip(PumpNum)%TypeOf_Num = TypeOf_PumpVariableSpeed
PumpEquip(PumpNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PumpEquip(PumpNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Water Nodes')
! PumpEquip(PumpNum)%PumpControlType = cAlphaArgs(4)
IF (SameString(cAlphaArgs(4),'Continuous')) THEN
PumpEquip(PumpNum)%PumpControl = Continuous
ELSE IF (SameString(cAlphaArgs(4),'Intermittent')) THEN
PumpEquip(PumpNum)%PumpControl = Intermittent
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(4)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(4))//']. '// &
trim(cAlphaFieldNames(4))//' has been set to Continuous for this pump.')
PumpEquip(PumpNum)%PumpControl = Continuous
END IF
! Input the optional schedule for the pump
PumpEquip(PumpNum)%PumpSchedule = cAlphaArgs(5)
PumpEquip(PumpNum)%PumpScheduleIndex =GetScheduleIndex(cAlphaArgs(5))
IF (.NOT. lAlphaFieldBlanks(5) .AND. .NOT. PumpEquip(PumpNum)%PumpScheduleIndex > 0) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(5)))
CALL ShowContinueError('Schedule named =['//trim(cAlphaArgs(5))//']. '// &
' was not found and will not be used.')
ENDIF
PumpEquip(PumpNum)%NomVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%NomPumpHead = rNumericArgs(2)
PumpEquip(PumpNum)%NomPowerUse = rNumericArgs(3)
PumpEquip(PumpNum)%MotorEffic = rNumericArgs(4)
PumpEquip(PumpNum)%FracMotorLossToFluid= rNumericArgs(5)
PumpEquip(PumpNum)%PartLoadCoef(1) = rNumericArgs(6)
PumpEquip(PumpNum)%PartLoadCoef(2) = rNumericArgs(7)
PumpEquip(PumpNum)%PartLoadCoef(3) = rNumericArgs(8)
PumpEquip(PumpNum)%PartLoadCoef(4) = rNumericArgs(9)
PumpEquip(PumpNum)%MinVolFlowRate = rNumericArgs(10)
!Probably the following two lines will be used if the team agrees on changing the F10 value from min flow rate to
!minimum flow as a fraction of nominal flow.
! PumpEquip(PumpNum)%MinVolFlowRateFrac = rNumericArgs(10)
! PumpEquip(PumpNum)%MinVolFlowRate = PumpEquip(PumpNum)%NomVolFlowRate * PumpEquip(PumpNum)%MinVolFlowRateFrac
! Input pressure related data such as pressure curve and impeller size/rotational speed
PumpEquip(PumpNum)%PressureCurve_Name = cAlphaArgs(6)
IF (TRIM(PumpEquip(PumpNum)%PressureCurve_Name) .EQ. '') THEN
PumpEquip(PumpNum)%PressureCurve_Index = -1
ELSE
TempCurveIndex = GetCurveIndex(PumpEquip(PumpNum)%PressureCurve_Name)
IF (TempCurveIndex .EQ. 0) THEN
PumpEquip(PumpNum)%PressureCurve_Index = -1
ELSE
TempCurveType = GetCurveType(TempCurveIndex)
SELECT CASE (TRIM(TempCurveType))
CASE ('LINEAR','QUADRATIC','CUBIC','QUARTIC')
PumpEquip(PumpNum)%PressureCurve_Index = TempCurveIndex
CALL GetCurveMinMaxvalues(TempCurveIndex, PumpEquip(PumpNum)%MinPhiValue, PumpEquip(PumpNum)%MaxPhiValue)
CASE DEFAULT
ErrorsFound = .TRUE.
END SELECT
END IF
END IF
!read in the rest of the pump pressure characteristics
PumpEquip(PumpNum)%ImpellerDiameter = rNumericArgs(11)
! Input VFD related data
IF (lAlphaFieldBlanks(7)) THEN
PumpEquip(PumpNum)%HasVFD=.False.
ELSE
PumpEquip(PumpNum)%HasVFD=.True.
IF (trim(cAlphaArgs(7)) .EQ. 'MANUALCONTROL') THEN
PumpEquip(PumpNum)%VFD%VFDControlType = VFDManual
PumpEquip(PumpNum)%VFD%ManualRPMSchedName = cAlphaArgs(8)
PumpEquip(PumpNum)%VFD%ManualRPMSchedIndex = GetScheduleIndex(cAlphaArgs(8))
IF (PumpEquip(PumpNum)%VFD%ManualRPMSchedIndex <= 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)//'", '// &
'At least one scheduled VFD schedule input was invalid.')
CALL ShowContinueError('Verify that all of the pressure and rpm schedules referenced '// &
'in the input fields actually exist.')
ErrorsFound = .TRUE.
ELSEIF ( .not. CheckScheduleValueMinMax(PumpEquip(PumpNum)%VFD%ManualRPMSchedIndex, '>', 0.0d0) .OR. &
.not. CheckScheduleValueMinMax(PumpEquip(PumpNum)%VFD%ManualRPMSchedIndex, '>', 0.0d0) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)//'", '// &
'A pump rpm schedule had zero value. Ensure all entries in the schedule are greater than zero.')
ErrorsFound = .TRUE.
END IF
ELSE IF (trim(cAlphaArgs(7)) .EQ. 'PRESSURESETPOINTCONTROL') THEN
PumpEquip(PumpNum)%VFD%VFDControlType = VFDAutomatic
PumpEquip(PumpNum)%VFD%LowerPsetSchedName = cAlphaArgs(9)
PumpEquip(PumpNum)%VFD%LowerPsetSchedIndex= GetScheduleIndex(cAlphaArgs(9))
PumpEquip(PumpNum)%VFD%UpperPsetSchedName = cAlphaArgs(10)
PumpEquip(PumpNum)%VFD%UpperPsetSchedIndex= GetScheduleIndex(cAlphaArgs(10))
PumpEquip(PumpNum)%VFD%MinRPMSchedName = cAlphaArgs(11)
PumpEquip(PumpNum)%VFD%MinRPMSchedIndex = GetScheduleIndex(cAlphaArgs(11))
PumpEquip(PumpNum)%VFD%MaxRPMSchedName = cAlphaArgs(12)
PumpEquip(PumpNum)%VFD%MaxRPMSchedIndex = GetScheduleIndex(cAlphaArgs(12))
IF (ANY((/PumpEquip(PumpNum)%VFD%LowerPsetSchedIndex, PumpEquip(PumpNum)%VFD%UpperPsetSchedIndex, &
PumpEquip(PumpNum)%VFD%MinRPMSchedIndex, PumpEquip(PumpNum)%VFD%MaxRPMSchedIndex/) <= 0)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)//'", '// &
'At least one scheduled VFD schedule input was invalid.')
CALL ShowContinueError('Verify that all of the pressure and rpm schedules referenced '// &
'in the input fields actually exist.')
ErrorsFound = .TRUE.
ELSEIF ( .not. CheckScheduleValueMinMax(PumpEquip(PumpNum)%VFD%MinRPMSchedIndex, '>', 0.0d0) .OR. &
.not. CheckScheduleValueMinMax(PumpEquip(PumpNum)%VFD%MaxRPMSchedIndex, '>', 0.0d0) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)//'", '// &
'A pump rpm schedule had zero value. Ensure all entries in the schedule are greater than zero.')
ErrorsFound = .TRUE.
END IF
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)//'", '// &
'VFD Control type entered is invalid. Use one of the key choice entries.')
ErrorsFound = .TRUE.
END IF
END IF
IF (.NOT. lAlphaFieldBlanks(13)) THEN ! zone named for pump skin losses
PumpEquip(PumpNum)%ZoneNum=FindItemInList(cAlphaArgs(13),Zone%Name,NumOfZones)
IF (PumpEquip(PumpNum)%ZoneNum > 0) THEN
PumpEquip(PumpNum)%HeatLossesToZone = .TRUE.
IF (.NOT. lNumericFieldBlanks(12) ) THEN
PumpEquip(PumpNum)%SkinLossRadFraction = rNumericArgs(12)
ENDIF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(13))//'="'//trim(cAlphaArgs(13))//'" not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
! Is this really necessary for each pump GetInput loop?
PumpEquip(PumpNum)%Energy = 0.0d0
PumpEquip(PumpNum)%Power = 0.0d0
END DO
cCurrentModuleObject = TRIM(cPump_ConSpeed)
DO NumConstPump = 1, NumConstSpeedPumps
PumpNum = NumVarSpeedPumps + NumConstPump
CALL GetObjectItem(cCurrentModuleObject,NumConstPump,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PumpEquip%Name,PumpNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PumpEquip(PumpNum)%Name = cAlphaArgs(1)
PumpEquip(PumpNum)%PumpType = Pump_ConSpeed !'Pump:ConstantSpeed'
PumpEquip(PumpNum)%TypeOf_Num = TypeOf_PumpConstantSpeed
PumpEquip(PumpNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PumpEquip(PumpNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Water Nodes')
PumpEquip(PumpNum)%NomVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%NomPumpHead = rNumericArgs(2)
PumpEquip(PumpNum)%NomPowerUse = rNumericArgs(3)
PumpEquip(PumpNum)%MotorEffic = rNumericArgs(4)
PumpEquip(PumpNum)%FracMotorLossToFluid= rNumericArgs(5)
PumpEquip(PumpNum)%PartLoadCoef(1) = 1.0d0
PumpEquip(PumpNum)%PartLoadCoef(2) = 0.0d0
PumpEquip(PumpNum)%PartLoadCoef(3) = 0.0d0
PumpEquip(PumpNum)%PartLoadCoef(4) = 0.0d0
!DSU In a constant volume pump we previously set the minimum to the nominal capacity
!DSU Now we model the pump as constant speed and set flow by riding the pump curve.
!DSU PumpEquip(PumpNum)%MinVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%MinVolFlowRate = 0.0d0
PumpEquip(PumpNum)%Energy = 0.0d0
PumpEquip(PumpNum)%Power = 0.0d0
! PumpEquip(PumpNum)%PumpControlType = cAlphaArgs(4)
IF (SameString(cAlphaArgs(4),'Continuous')) THEN
PumpEquip(PumpNum)%PumpControl = Continuous
ELSE IF (SameString(cAlphaArgs(4),'Intermittent')) THEN
PumpEquip(PumpNum)%PumpControl = Intermittent
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(4)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(4))//']. '// &
trim(cAlphaFieldNames(4))//' has been set to Continuous for this pump.')
PumpEquip(PumpNum)%PumpControl = Continuous
END IF
! Input the optional schedule for the pump
PumpEquip(PumpNum)%PumpSchedule = cAlphaArgs(5)
PumpEquip(PumpNum)%PumpScheduleIndex =GetScheduleIndex(cAlphaArgs(5))
IF (.NOT. lAlphaFieldBlanks(5) .AND. .NOT. PumpEquip(PumpNum)%PumpScheduleIndex > 0) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(5)))
CALL ShowContinueError('Schedule named =['//trim(cAlphaArgs(5))//']. '// &
' was not found and will not be used.')
ENDIF
! Input pressure related data such as pressure curve and impeller size/rotational speed
PumpEquip(PumpNum)%PressureCurve_Name = cAlphaArgs(6)
IF (TRIM(PumpEquip(PumpNum)%PressureCurve_Name) .EQ. '') THEN
PumpEquip(PumpNum)%PressureCurve_Index = -1
ELSE
TempCurveIndex = GetCurveIndex(PumpEquip(PumpNum)%PressureCurve_Name)
IF (TempCurveIndex .EQ. 0) THEN
PumpEquip(PumpNum)%PressureCurve_Index = -1
ELSE
TempCurveType = GetCurveType(TempCurveIndex)
SELECT CASE (TRIM(TempCurveType))
CASE ('LINEAR','QUADRATIC','CUBIC','QUARTIC')
PumpEquip(PumpNum)%PressureCurve_Index = TempCurveIndex
CALL GetCurveMinMaxvalues(TempCurveIndex, PumpEquip(PumpNum)%MinPhiValue, PumpEquip(PumpNum)%MaxPhiValue)
CASE DEFAULT
ErrorsFound = .TRUE.
END SELECT
END IF
END IF
!read in the rest of the pump pressure characteristics
PumpEquip(PumpNum)%ImpellerDiameter = rNumericArgs(6)
PumpEquip(PumpNum)%RotSpeed_RPM = rNumericArgs(7) ! retrieve the input rotational speed, in revs/min
PumpEquip(PumPNum)%RotSpeed = PumpEquip(PumpNum)%RotSpeed_RPM/60.0d0 !convert input[rpm] to calculation units[rps]
IF (.NOT. lAlphaFieldBlanks(7)) THEN ! zone named for pump skin losses
PumpEquip(PumpNum)%ZoneNum=FindItemInList(cAlphaArgs(7),Zone%Name,NumOfZones)
IF (PumpEquip(PumpNum)%ZoneNum > 0) THEN
PumpEquip(PumpNum)%HeatLossesToZone = .TRUE.
IF (.NOT. lNumericFieldBlanks(8) ) THEN
PumpEquip(PumpNum)%SkinLossRadFraction = rNumericArgs(8)
ENDIF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
END DO
! pumps for steam system pumping condensate
cCurrentModuleObject = cPump_Cond
DO NumCondPump = 1 , NumCondensatePumps
PumpNum = NumCondPump + NumVarSpeedPumps + NumConstSpeedPumps
CALL GetObjectItem(cCurrentModuleObject ,NumCondPump,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PumpEquip%Name,PumpNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PumpEquip(PumpNum)%Name = cAlphaArgs(1)
PumpEquip(PumpNum)%PumpType = Pump_Cond !'Pump:VariableSpeed:Condensate'
PumpEquip(PumpNum)%TypeOf_Num = TypeOf_PumpCondensate
PumpEquip(PumpNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject) ,cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PumpEquip(PumpNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject) ,cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject) ,cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Water Nodes')
! PumpEquip(PumpNum)%PumpControlType == 'Intermittent'
PumpEquip(PumpNum)%PumpControl = Intermittent
! Input the optional schedule for the pump
PumpEquip(PumpNum)%PumpSchedule = cAlphaArgs(4)
PumpEquip(PumpNum)%PumpScheduleIndex =GetScheduleIndex(cAlphaArgs(4))
IF (.NOT. lAlphaFieldBlanks(4) .AND. .NOT. PumpEquip(PumpNum)%PumpScheduleIndex > 0) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(4)))
CALL ShowContinueError('Schedule named =['//trim(cAlphaArgs(4))//']. '// &
' was not found and will not be used.')
ENDIF
PumpEquip(PumpNum)%NomSteamVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%NomPumpHead = rNumericArgs(2)
PumpEquip(PumpNum)%NomPowerUse = rNumericArgs(3)
PumpEquip(PumpNum)%MotorEffic = rNumericArgs(4)
PumpEquip(PumpNum)%FracMotorLossToFluid= rNumericArgs(5)
PumpEquip(PumpNum)%PartLoadCoef(1) = rNumericArgs(6)
PumpEquip(PumpNum)%PartLoadCoef(2) = rNumericArgs(7)
PumpEquip(PumpNum)%PartLoadCoef(3) = rNumericArgs(8)
PumpEquip(PumpNum)%PartLoadCoef(4) = rNumericArgs(9)
IF (.NOT. lAlphaFieldBlanks(5)) THEN ! zone named for pump skin losses
PumpEquip(PumpNum)%ZoneNum=FindItemInList(cAlphaArgs(5),Zone%Name,NumOfZones)
IF (PumpEquip(PumpNum)%ZoneNum > 0) THEN
PumpEquip(PumpNum)%HeatLossesToZone = .TRUE.
IF (.NOT. lNumericFieldBlanks(10) ) THEN
PumpEquip(PumpNum)%SkinLossRadFraction = rNumericArgs(10)
ENDIF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(5))//'="'//trim(cAlphaArgs(5))//'" not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
PumpEquip(PumpNum)%MinVolFlowRate = 0.0d0
PumpEquip(PumpNum)%Energy = 0.0d0
PumpEquip(PumpNum)%Power = 0.0d0
IF (PumpEquip(PumpNum)%NomSteamVolFlowRate == Autosize)THEN
PumpEquip(PumpNum)%NomVolFlowRate=Autosize
ELSE
! Calc Condensate Pump Water Volume Flow Rate
SteamDensity=GetSatDensityRefrig('STEAM',StartTemp,1.0d0,PumpEquip(PumpNum)%FluidIndex,'GetPumpInput')
TempWaterDensity = GetDensityGlycol('WATER', InitConvTemp, DummyWaterIndex, RoutineName)
PumpEquip(PumpNum)%NomVolFlowRate= (PumpEquip(PumpNum)%NomSteamVolFlowRate*SteamDensity)/TempWaterDensity
ENDIF
END DO
!LOAD Variable Speed Pump Bank ARRAYS WITH VARIABLE SPEED CURVE FIT PUMP DATA
cCurrentModuleObject = cPumpBank_VarSpeed
DO NumVarPumpBankSimple = 1 , NumPumpBankSimpleVar
PumpNum = NumVarPumpBankSimple + NumVarSpeedPumps + NumConstSpeedPumps + NumCondensatePumps
CALL GetObjectItem(cCurrentModuleObject,NumVarPumpBankSimple,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PumpEquip%Name,PumpNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PumpEquip(PumpNum)%Name = cAlphaArgs(1)
PumpEquip(PumpNum)%PumpType = PumpBank_VarSpeed !'HeaderedPumps:VariableSpeed'
PumpEquip(PumpNum)%TypeOf_Num = TypeOf_PumpBankVariableSpeed
PumpEquip(PumpNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PumpEquip(PumpNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Water Nodes')
! PumpEquip(PumpNum)%PumpBankFlowSeqControl = cAlphaArgs(4)
IF (SameString(cAlphaArgs(4),'Optimal')) THEN
PumpEquip(PumpNum)%SequencingScheme = OptimalScheme
ELSE IF (SameString(cAlphaArgs(4),'Sequential')) THEN
PumpEquip(PumpNum)%SequencingScheme = SequentialScheme
ELSE IF (SameString(cAlphaArgs(4),'SupplyEquipmentAssigned')) THEN
PumpEquip(PumpNum)%SequencingScheme = UserDefined
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(4)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(4))//']. '// &
trim(cAlphaFieldNames(4))//' has been set to Sequential for this pump.')
PumpEquip(PumpNum)%SequencingScheme = SequentialScheme
END IF
! PumpEquip(PumpNum)%PumpControlType = cAlphaArgs(5)
IF (SameString(cAlphaArgs(5),'Continuous')) THEN
PumpEquip(PumpNum)%PumpControl = Continuous
ELSE IF (SameString(cAlphaArgs(5),'Intermittent')) THEN
PumpEquip(PumpNum)%PumpControl = Intermittent
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(5)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(5))//']. '// &
trim(cAlphaFieldNames(5))//' has been set to Continuous for this pump.')
PumpEquip(PumpNum)%PumpControl = Continuous
END IF
! Input the optional schedule for the pump
PumpEquip(PumpNum)%PumpSchedule = cAlphaArgs(6)
PumpEquip(PumpNum)%PumpScheduleIndex =GetScheduleIndex(cAlphaArgs(6))
IF (.NOT. lAlphaFieldBlanks(6) .AND. .NOT. PumpEquip(PumpNum)%PumpScheduleIndex > 0) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(6)))
CALL ShowContinueError('Schedule named =['//trim(cAlphaArgs(6))//']. '// &
' was not found and will not be used.')
ENDIF
PumpEquip(PumpNum)%NomVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%NumPumpsInBank = rNumericArgs(2)
PumpEquip(PumpNum)%NomPumpHead = rNumericArgs(3)
PumpEquip(PumpNum)%NomPowerUse = rNumericArgs(4)
PumpEquip(PumpNum)%MotorEffic = rNumericArgs(5)
PumpEquip(PumpNum)%FracMotorLossToFluid= rNumericArgs(6)
PumpEquip(PumpNum)%PartLoadCoef(1) = rNumericArgs(7)
PumpEquip(PumpNum)%PartLoadCoef(2) = rNumericArgs(8)
PumpEquip(PumpNum)%PartLoadCoef(3) = rNumericArgs(9)
PumpEquip(PumpNum)%PartLoadCoef(4) = rNumericArgs(10)
PumpEquip(PumpNum)%MinVolFlowRateFrac = rNumericArgs(11)
PumpEquip(PumpNum)%MinVolFlowRate = PumpEquip(PumpNum)%NomVolFlowRate * PumpEquip(PumpNum)%MinVolFlowRateFrac
IF (.NOT. lAlphaFieldBlanks(7)) THEN ! zone named for pump skin losses
PumpEquip(PumpNum)%ZoneNum=FindItemInList(cAlphaArgs(7),Zone%Name,NumOfZones)
IF (PumpEquip(PumpNum)%ZoneNum > 0) THEN
PumpEquip(PumpNum)%HeatLossesToZone = .TRUE.
IF (.NOT. lNumericFieldBlanks(12) ) THEN
PumpEquip(PumpNum)%SkinLossRadFraction = rNumericArgs(12)
ENDIF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
PumpEquip(PumpNum)%Energy = 0.0d0
PumpEquip(PumpNum)%Power = 0.0d0
END DO
cCurrentModuleObject = TRIM(cPumpBank_ConSpeed)
DO NumConstPumpBankSimple = 1 , NumPumpBankSimpleConst
PumpNum = NumConstPumpBankSimple + NumVarSpeedPumps + NumConstSpeedPumps + NumCondensatePumps + NumPumpBankSimpleVar
CALL GetObjectItem(cCurrentModuleObject,NumConstPumpBankSimple,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),PumpEquip%Name,PumpNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
PumpEquip(PumpNum)%Name = cAlphaArgs(1)
PumpEquip(PumpNum)%PumpType = PumpBank_ConSpeed !'HeaderedPumps:ConstantSpeed'
PumpEquip(PumpNum)%TypeOf_Num = TypeOf_PumpBankConstantSpeed
PumpEquip(PumpNum)%InletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
PumpEquip(PumpNum)%OutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Water Nodes')
! PumpEquip(PumpNum)%PumpBankFlowSeqControl = cAlphaArgs(4)
IF (SameString(cAlphaArgs(4),'Optimal')) THEN
PumpEquip(PumpNum)%SequencingScheme = OptimalScheme
ELSE IF (SameString(cAlphaArgs(4),'Sequential')) THEN
PumpEquip(PumpNum)%SequencingScheme = SequentialScheme
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(4)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(4))//']. '// &
trim(cAlphaFieldNames(4))//' has been set to Sequential for this pump.')
PumpEquip(PumpNum)%SequencingScheme = SequentialScheme
! PumpEquip(PumpNum)%PumpBankFlowSeqControl = 'Optimal'
END IF
! PumpEquip(PumpNum)%PumpControlType = cAlphaArgs(5)
IF (SameString(cAlphaArgs(5),'Continuous')) THEN
PumpEquip(PumpNum)%PumpControl = Continuous
ELSE IF (SameString(cAlphaArgs(5),'Intermittent')) THEN
PumpEquip(PumpNum)%PumpControl = Intermittent
ELSE
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(5)))
CALL ShowContinueError('Entered Value=['//trim(cAlphaArgs(5))//']. '// &
trim(cAlphaFieldNames(5))//' has been set to Continuous for this pump.')
PumpEquip(PumpNum)%PumpControl = Continuous
END IF
! Input the optional schedule for the pump
PumpEquip(PumpNum)%PumpSchedule = cAlphaArgs(6)
PumpEquip(PumpNum)%PumpScheduleIndex =GetScheduleIndex(cAlphaArgs(6))
IF (.NOT. lAlphaFieldBlanks(6) .AND. .NOT. PumpEquip(PumpNum)%PumpScheduleIndex > 0) THEN
CALL ShowWarningError(RoutineName//trim(cCurrentModuleObject)//'="'//TRIM(PumpEquip(PumpNum)%Name)// &
'", Invalid '//trim(cAlphaFieldNames(6)))
CALL ShowContinueError('Schedule named =['//trim(cAlphaArgs(6))//']. '// &
' was not found and will not be used.')
ENDIF
PumpEquip(PumpNum)%NomVolFlowRate = rNumericArgs(1)
PumpEquip(PumpNum)%NumPumpsInBank = rNumericArgs(2)
PumpEquip(PumpNum)%NomPumpHead = rNumericArgs(3)
PumpEquip(PumpNum)%NomPowerUse = rNumericArgs(4)
PumpEquip(PumpNum)%MotorEffic = rNumericArgs(5)
PumpEquip(PumpNum)%FracMotorLossToFluid= rNumericArgs(6)
PumpEquip(PumpNum)%PartLoadCoef(1) = 1.0d0
PumpEquip(PumpNum)%PartLoadCoef(2) = 0.0d0
PumpEquip(PumpNum)%PartLoadCoef(3) = 0.0d0
PumpEquip(PumpNum)%PartLoadCoef(4) = 0.0d0
! PumpEquip(PumpNum)%MinVolFlowRateFrac = rNumericArgs(11)
! PumpEquip(PumpNum)%MinVolFlowRate = PumpEquip(PumpNum)%NomVolFlowRate * PumpEquip(PumpNum)%MinVolFlowRateFrac
!DSU? need a value set for %MinVolFlowRate ?? zero? NomVolFlowRate?
IF (.NOT. lAlphaFieldBlanks(7)) THEN ! zone named for pump skin losses
PumpEquip(PumpNum)%ZoneNum=FindItemInList(cAlphaArgs(7),Zone%Name,NumOfZones)
IF (PumpEquip(PumpNum)%ZoneNum > 0) THEN
PumpEquip(PumpNum)%HeatLossesToZone = .TRUE.
IF (.NOT. lNumericFieldBlanks(7) ) THEN
PumpEquip(PumpNum)%SkinLossRadFraction = rNumericArgs(7)
ENDIF
ELSE
CALL ShowSevereError(trim(cCurrentModuleObject)//'="'//trim(cAlphaArgs(1))//'" invalid '// &
trim(cAlphaFieldNames(7))//'="'//trim(cAlphaArgs(7))//'" not found.')
ErrorsFound = .TRUE.
ENDIF
ENDIF
PumpEquip(PumpNum)%MinVolFlowRate = 0.0d0
PumpEquip(PumpNum)%Energy = 0.0d0
PumpEquip(PumpNum)%Power = 0.0d0
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting Pump input')
ENDIF
DO PumpNum = 1 , NumPumps !CurrentModuleObject='Pumps'
If(PumpEquip(PumpNum)%PumpType == Pump_VarSpeed .OR. &
PumpEquip(PumpNum)%PumpType == Pump_ConSpeed .OR. &
PumpEquip(PumpNum)%PumpType == Pump_Cond) THEN
CALL SetupOutputVariable('Pump Electric Energy [J]',PumpEquip(PumpNum)%Energy, &
'System','Sum',PumpEquip(PumpNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Pumps',GroupKey='Plant')
CALL SetupOutputVariable('Pump Electric Power [W]',PumpEquip(PumpNum)%Power, &
'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Shaft Power [W]', &
PumpEquipReport(PumpNum)%ShaftPower,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Fluid Heat Gain Rate [W]', &
PumpEquipReport(PumpNum)%PumpHeattoFluid,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Fluid Heat Gain Energy [J]', &
PumpEquipReport(PumpNum)%PumpHeattoFluidEnergy,'System','Sum',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Outlet Temperature [C]', &
PumpEquipReport(PumpNum)%OutletTemp,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Mass Flow Rate [kg/s]', &
PumpEquipReport(PumpNum)%PumpMassFlowRate,'System','Average',PumpEquip(PumpNum)%Name)
End If
If(PumpEquip(PumpNum)%PumpType == PumpBank_VarSpeed .OR. & ! CurrentModuleObject='HeaderedPumps'
PumpEquip(PumpNum)%PumpType == PumpBank_ConSpeed) THEN
CALL SetupOutputVariable('Pump Electric Energy [J]',PumpEquip(PumpNum)%Energy, &
'System','Sum',PumpEquip(PumpNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='Pumps',GroupKey='Plant')
CALL SetupOutputVariable('Pump Electric Power [W]',PumpEquip(PumpNum)%Power, &
'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Shaft Power [W]', &
PumpEquipReport(PumpNum)%ShaftPower,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Fluid Heat Gain Rate [W]', &
PumpEquipReport(PumpNum)%PumpHeattoFluid,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Fluid Heat Gain Energy [J]', &
PumpEquipReport(PumpNum)%PumpHeattoFluidEnergy,'System','Sum',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Outlet Temperature [C]', &
PumpEquipReport(PumpNum)%OutletTemp,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Mass Flow Rate [kg/s]', &
PumpEquipReport(PumpNum)%PumpMassFlowRate,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Operating Pumps Count []', &
PumpEquipReport(PumpNum)%NumPumpsOperating,'System','Average',PumpEquip(PumpNum)%Name)
End If
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Pump Maximum Mass Flow Rate', PumpEquip(PumpNum)%Name, '[kg/s]', &
PumpEquip(PumpNum)%MassFlowRateMax )
CALL SetupEMSActuator('Pump', PumpEquip(PumpNum)%Name, 'Pump Mass Flow Rate' , '[kg/s]', &
PumpEquip(PumpNum)%EMSMassFlowOverrideOn, PumpEquip(PumpNum)%EMSMassFlowValue )
CALL SetupEMSActuator('Pump', PumpEquip(PumpNum)%Name, 'Pump Pressure Rise', '[Pa]', &
PumpEquip(PumpNum)%EMSPressureOverrideOn, PumpEquip(PumpNum)%EMSPressureOverrideValue )
ENDIF
IF (PumpEquip(PumpNum)%HeatLossesToZone) THEN
! setup skin loss output vars
CALL SetupOutputVariable('Pump Zone Total Heating Rate [W]', &
PumpEquipReport(PumpNum)%ZoneTotalGainRate,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Zone Total Heating Energy [J]', &
PumpEquipReport(PumpNum)%ZoneTotalGainEnergy,'System','Sum',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Zone Convective Heating Rate [W]', &
PumpEquipReport(PumpNum)%ZoneConvGainRate,'System','Average',PumpEquip(PumpNum)%Name)
CALL SetupOutputVariable('Pump Zone Radiative Heating Rate [W]', &
PumpEquipReport(PumpNum)%ZoneRadGainRate,'System','Average',PumpEquip(PumpNum)%Name)
! setup internal gains
SELECT CASE (PumpEquip(PumpNum)%PumpType)
CASE (Pump_VarSpeed)
CALL SetupZoneInternalGain(PumpEquip(PumpNum)%ZoneNum, &
'Pump:VariableSpeed', &
PumpEquip(PumpNum)%Name, &
IntGainTypeOf_Pump_VarSpeed, &
ConvectionGainRate = PumpEquipReport(PumpNum)%ZoneConvGainRate,&
ThermalRadiationGainRate = PumpEquipReport(PumpNum)%ZoneRadGainRate)
CASE (Pump_ConSpeed)
CALL SetupZoneInternalGain(PumpEquip(PumpNum)%ZoneNum, &
'Pump:ConstantSpeed', &
PumpEquip(PumpNum)%Name, &
IntGainTypeOf_Pump_ConSpeed, &
ConvectionGainRate = PumpEquipReport(PumpNum)%ZoneConvGainRate,&
ThermalRadiationGainRate = PumpEquipReport(PumpNum)%ZoneRadGainRate)
CASE (Pump_Cond)
CALL SetupZoneInternalGain(PumpEquip(PumpNum)%ZoneNum, &
'Pump:VariableSpeed:Condensate', &
PumpEquip(PumpNum)%Name, &
IntGainTypeOf_Pump_Cond, &
ConvectionGainRate = PumpEquipReport(PumpNum)%ZoneConvGainRate,&
ThermalRadiationGainRate = PumpEquipReport(PumpNum)%ZoneRadGainRate)
CASE (PumpBank_VarSpeed)
CALL SetupZoneInternalGain(PumpEquip(PumpNum)%ZoneNum, &
'HeaderedPumps:VariableSpeed', &
PumpEquip(PumpNum)%Name, &
IntGainTypeOf_PumpBank_VarSpeed, &
ConvectionGainRate = PumpEquipReport(PumpNum)%ZoneConvGainRate,&
ThermalRadiationGainRate = PumpEquipReport(PumpNum)%ZoneRadGainRate)
CASE (PumpBank_ConSpeed)
CALL SetupZoneInternalGain(PumpEquip(PumpNum)%ZoneNum, &
'HeaderedPumps:ConstantSpeed', &
PumpEquip(PumpNum)%Name, &
IntGainTypeOf_PumpBank_ConSpeed, &
ConvectionGainRate = PumpEquipReport(PumpNum)%ZoneConvGainRate,&
ThermalRadiationGainRate = PumpEquipReport(PumpNum)%ZoneRadGainRate)
END SELECT
ENDIF
END DO
RETURN
END SUBROUTINE GetPumpInput