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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | PumpNum | |||
real(kind=r64), | intent(in) | :: | FlowRequest | |||
logical, | intent(inout) | :: | PumpRunning |
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 CalcPumps(PumpNum, FlowRequest, PumpRunning)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Sept. 1998
! MODIFIED July 2001, Rick Strand
! RE-ENGINEERED Sept 2010, Edwin Lee
! PURPOSE OF THIS SUBROUTINE:
! This subroutines simulates a pump following
! the methodology oulined in ASHRAE's secondary toolkit.
! METHODOLOGY EMPLOYED:
! Calculates power and updates other pump things.
! REFERENCES:
! HVAC 2 Toolkit: A Toolkit for Secondary HVAC System
! Energy Calculations, ASHRAE, 1993, pp2-10 to 2-15
! USE STATEMENTS:
USE PlantUtilities, ONLY: SetComponentFlowRate
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE DataPlant, ONLY: PlantLoop
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
USE General, ONLY: RoundSigDigits
USE ScheduleManager, ONLY: GetCurrentScheduleValue
USE DataConvergParams, ONLY: PlantFlowRateToler
USE DataBranchAirLoopPlant, ONLY: ControlType_SeriesActive
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: PumpNum
REAL(r64), INTENT(IN) :: FlowRequest
LOGICAL, INTENT(IN OUT) :: PumpRunning
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: RotSpeed_Tol = 0.01d0
CHARACTER(len=*), PARAMETER :: RoutineName = 'PlantPumps:CalcPumps: '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode
INTEGER :: OutletNode
REAL(r64) :: LoopDensity
! INTEGER :: DummyWaterIndex = 1
REAL(r64) :: VolFlowRate
REAL(r64) :: PartLoadRatio
REAL(r64) :: FracFullLoadPower
REAL(r64) :: FullLoadVolFlowRate
REAL(r64) :: PartLoadVolFlowRate
REAL(r64) :: FullLoadPower
REAL(r64) :: FullLoadPowerRatio
REAL(r64) :: TotalEffic
INTEGER :: PumpType
REAL(r64) :: RotSpeed_Min
REAL(r64) :: RotSpeed_Max
REAL(r64) :: PumpActualRPMValueOne
REAL(r64) :: PumpActualRPMValueTwo
INTEGER :: NumBranchesOnThisLoopSide
InletNode = PumpEquip(PumpNum)%InletNodeNum
OutletNode = PumpEquip(PumpNum)%OutletNodeNum
PumpType = PumpEquip(PumpNum)%PumpType
!****************************!
!** SETTING PUMP FLOW RATE **!
!****************************!
! So the loop solver always passes in the full loop side flow request to each pump called
! The pump will try to use this value according to its inlet conditions via the SetComponentFlowRate routine.
! If the loop solver is doing branch pumps, then individual parallel branch inlet nodes would have been previously
! constrained, so even though we pass in a full flow request, each pump will "pull down" to the min/max avail.
! Also, on flowlock == locked, we will just use the inlet node flow rate
! The flow resolver can take care of argument resolution beyond that.
! For a typical situation, the flow request should be within the values of min/max avail, so the pump will get this flow rate.
IF (FlowRequest > MassFlowTolerance) THEN
PumpMassFlowRate = FlowRequest
ELSE
PumpMassFlowRate = 0.0d0
END IF
! For variable speed branch pumps, with other components
! on the branch, we are not going to assign a request.
! Other components on this branch will request flow for this branch
! ! If this is a variable speed pump
IF ((PumpEquip(PumpNum)%PumpType == Pump_VarSpeed) .OR. &
(PumpEquip(PumpNum)%PumpType == PumpBank_VarSpeed) .OR. &
(PumpEquip(PumpNum)%PumpType == Pump_Cond)) THEN
IF (PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(PumpEquip(PumpNum)%LoopSideNum)% &
Branch(PumpEquip(PumpNum)%BranchNum)%Comp(PumpEquip(PumpNum)%CompNum)%FlowCtrl == ControlType_SeriesActive) THEN
PumpMassFlowRate = 0.0d0
ENDIF
END IF
! bound flow request by pump max limit, the Flow Request is total loop flow and if this is a branch pump that is not appropriate
PumpMassFlowRate = MIN(PumpEquip(PumpNum)%MassFlowRateMax, PumpMassFlowRate)
PumpMassFlowRate = MAX(PumpEquip(PumpNum)%MassFlowRateMin, PumpMassFlowRate)
CALL SetComponentFlowRate( &
PumpMassFlowRate, &
InletNode, &
OutletNode, &
PumpEquip(PumpNum)%LoopNum, &
PumpEquip(PumpNum)%LoopSideNum, &
PumpEquip(PumpNum)%BranchNum, &
PumpEquip(PumpNum)%CompNum &
)
!Get RPM value for reporting as output
!RPM is calculated using pump affinity laws for rotation speed
IF (PlantLoop(PumpEquip(PumpNum)%LoopNum)%UsePressureForPumpCalcs .AND. PumpEquip(PumpNum)%HasVFD) THEN
RotSpeed_Min = GetCurrentScheduleValue(PumpEquip(PumpNum)%VFD%MinRPMSchedIndex)
RotSpeed_Max = GetCurrentScheduleValue(PumpEquip(PumpNum)%VFD%MaxRPMSchedIndex)
IF (PumpEquip(PumpNum)%PumpMassFlowRateMaxRPM < MassFlowTolerance &
.OR. PumpEquip(PumpNum)%PumpMassFlowRateMinRPM < MassFlowTolerance) THEN
PumpEquip(PumpNum)%VFD%PumpActualRPM = 0.0d0
ELSE
PumpActualRPMValueOne = (PumpMassFlowRate/PumpEquip(PumpNum)%PumpMassFlowRateMaxRPM) * RotSpeed_Max
PumpActualRPMValueTwo = (PumpMassFlowRate/PumpEquip(PumpNum)%PumpMassFlowRateMinRPM) * RotSpeed_Min
PumpEquip(PumpNum)%VFD%PumpActualRPM = (PumpActualRPMValueOne + PumpActualRPMValueTwo) / 2
END IF
END IF
!****************************!
!** DETERMINE IF PUMP IS ON *!
!****************************!
! Since we don't allow series pumping, if there is ANY flow rate for this pump, THIS PUMP is driving the flow! Therefore...
PumpRunning = (PumpMassFlowRate .GT. MassFlowTolerance)
!****************************!
!** UPDATE PUMP BANK USAGE **!
!****************************!
SELECT CASE (PumpEquip(PumpNum)%PumpType)
CASE (PumpBank_VarSpeed, PumpBank_ConSpeed)
! previously, pumps did whatever they wanted
! because of this a constant speed pump bank could adjust the flow rate as-desired
! even if it was not allowed
! since pumps now must behave nicely like all other components, the calculation of number
! of running pumps in a pump bank is the same for both bank types
! the pumps are loaded sequentially, and the last pump can have full or non-full part load
! status...this is just how it works now. The pump cannot *bump* up the flow on the loop
! to make sure the last running pump is fully loaded anymore for constant speed pumps...sorry
IF (PumpMassFlowRate >= PumpEquip(PumpNum)%MassFlowRateMax) THEN
!running full on
NumPumpsRunning = PumpEquip(PumpNum)%NumPumpsInBank
ELSE
!running at some sort of part load
NumPumpsRunning = CEILING((PumpMassFlowRate / (PumpEquip(PumpNum)%MassFlowRateMax) * PumpEquip(PumpNum)%NumPumpsInBank) )
NumPumpsRunning = MIN(NumPumpsRunning, PumpEquip(PumpNum)%NumPumpsInBank)
END IF
END SELECT
!****************************!
!***** EXIT IF NO FLOW ******!
!****************************!
IF (PumpMassFlowRate <= MassFlowTolerance) THEN
Node(OutletNode)%Temp = Node(InletNode)%Temp
Node(OutletNode)%Press = Node(InletNode)%Press
Node(OutletNode)%Quality = Node(InletNode)%Quality
RETURN
END IF
! density used for volumetric flow calculations
LoopDensity = GetDensityGlycol(PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidName, &
Node(InletNode)%Temp, &
PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidIndex, &
RoutineName)
!****************************!
!***** CALCULATE POWER (1) **!
!****************************!
IF(PumpType == Pump_ConSpeed .OR. PumpType == Pump_VarSpeed .OR. PumpType == Pump_Cond) THEN
VolFlowRate = PumpMassFlowRate / LoopDensity
PartLoadRatio = MIN(1.0d0,(VolFlowRate / PumpEquip(PumpNum)%NomVolFlowRate))
FracFullLoadPower = PumpEquip(PumpNum)%PartLoadCoef(1) &
+ PumpEquip(PumpNum)%PartLoadCoef(2) * PartLoadRatio &
+ PumpEquip(PumpNum)%PartLoadCoef(3) * PartLoadRatio**2 &
+ PumpEquip(PumpNum)%PartLoadCoef(4) * PartLoadRatio**3
Power = FracFullLoadPower * PumpEquip(PumpNum)%NomPowerUse
ELSE IF(PumpType == PumpBank_ConSpeed .OR. PumpType == PumpBank_VarSpeed) THEN
! now just assume the last one is (or is not) running at part load
! if it is actually at full load, the calculations work out to PLR = 1
! for the last pump, so all is OK
NumPumpsFullLoad = NumPumpsRunning - 1
FullLoadVolFlowRate = PumpEquip(PumpNum)%NomVolFlowRate/PumpEquip(PumpNum)%NumPumpsInBank
PartLoadVolFlowrate = PumpMassFlowRate/LoopDensity - FullLoadVolFlowRate * NumPumpsFullLoad
FullLoadPower = PumpEquip(PumpNum)%NomPowerUse/PumpEquip(PumpNum)%NumPumpsInBank
FullLoadPowerRatio = PumpEquip(PumpNum)%PartLoadCoef(1) &
+PumpEquip(PumpNum)%PartLoadCoef(2) &
+PumpEquip(PumpNum)%PartLoadCoef(3) &
+PumpEquip(PumpNum)%PartLoadCoef(4)
PartLoadRatio = MIN(1.0d0,(PartLoadVolFlowrate / FullLoadVolFlowRate))
FracFullLoadPower = PumpEquip(PumpNum)%PartLoadCoef(1) &
+ PumpEquip(PumpNum)%PartLoadCoef(2) * PartLoadRatio &
+ PumpEquip(PumpNum)%PartLoadCoef(3) * PartLoadRatio**2 &
+ PumpEquip(PumpNum)%PartLoadCoef(4) * PartLoadRatio**3
Power = (FullLoadPowerRatio * NumPumpsFullLoad + FracFullLoadPower) * FullLoadPower
END IF
!****************************!
!***** CALCULATE POWER (2) **!
!****************************!
IF (Power < 0.0d0) THEN
IF (PumpEquip(PumpNum)%PowerErrIndex1 == 0) THEN
CALL ShowWarningMessage(RoutineName//' Calculated Pump Power < 0, Type='// &
trim(cPumpTypes(PumpType))//', Name="'//trim(PumpEquip(PumpNum)%Name)//'".')
CALL ShowContinueErrorTimeStamp(' ')
CALL ShowContinueError('...PartLoadRatio=['//trim(RoundSigDigits(PartLoadRatio,4))//'], '// &
'Fraction Full Load Power='//trim(RoundSigDigits(FracFullLoadPower,4))//']')
CALL ShowContinueError('...Power is set to 0 for continuing the simulation.')
CALL ShowContinueError('...Pump coefficients should be checked for producing this negative value.')
ENDIF
Power=0.0d0
CALL ShowRecurringWarningErrorAtEnd(RoutineName//' Calculated Pump Power < 0, '// &
trim(cPumpTypes(PumpType))//', Name="'//trim(PumpEquip(PumpNum)%Name)//'", PLR=', &
PumpEquip(PumpNum)%PowerErrIndex1,ReportMinOf=PartLoadRatio,ReportMaxOf=PartLoadRatio)
CALL ShowRecurringContinueErrorAtEnd('...Fraction Full Load Power=', &
PumpEquip(PumpNum)%PowerErrIndex2,ReportMinOf=FracFullLoadPower,ReportMaxOf=FracFullLoadPower)
ENDIF
!****************************!
!***** CALCULATE POWER (3) **!
!****************************!
!Now if we are doing pressure-based simulation, then we have a means to calculate power exactly based on current
! simulation conditions (flow rate and pressure drop) along with knowledge about pump impeller and motor efficiencies
!Thus we will override the power that was calculated based on nominal values with the corrected pressure-based power
IF (PumpEquip(PumpNum)%LoopNum .GT. 0) THEN
IF (PlantLoop(PumpEquip(PumpNum)%LoopNum)%UsePressureForPumpCalcs) THEN
TotalEffic = PumpEquip(PumpNum)%PumpEffic * PumpEquip(PumpNum)%MotorEffic
!Efficiency errors are caught previously, but it doesn't hurt to add another catch before dividing by zero!!!
IF (TotalEffic == 0.0d0) THEN
CALL ShowSevereError(RoutineName//' Plant pressure simulation encountered a pump with zero efficiency: '// &
PumpEquip(PumpNum)%Name)
CALL ShowContinueError('Check efficiency inputs for this pump component.')
CALL ShowFatalError('Errors in plant calculation would result in divide-by-zero cause program termination.')
END IF
Power = VolFlowRate * PlantLoop(PumpEquip(PumpNum)%LoopNum)%PressureDrop / TotalEffic
END IF
END IF
! if user has specified a pressure value, then use it, same as for pressure-based simulation
IF (PumpEquip(PumpNum)%EMSPressureOverrideOn) THEN
TotalEffic = PumpEquip(PumpNum)%PumpEffic * PumpEquip(PumpNum)%MotorEffic
!Efficiency errors are caught previously, but it doesn't hurt to add another catch before dividing by zero!!!
IF (TotalEffic == 0.0d0) THEN
CALL ShowSevereError(RoutineName//' Plant pump simulation encountered a pump with zero efficiency: '// &
PumpEquip(PumpNum)%Name)
CALL ShowContinueError('Check efficiency inputs for this pump component.')
CALL ShowFatalError('Errors in plant calculation would result in divide-by-zero cause program termination.')
END IF
Power = VolFlowRate * PumpEquip(PumpNum)%EMSPressureOverrideValue / TotalEffic
ENDIF
!****************************!
!***** CALCULATE POWER (4) **!
!****************************!
! This adds the pump heat based on User input for the pump
! We assume that all of the heat ends up in the fluid eventually since this is a closed loop
ShaftPower = Power * PumpEquip(PumpNum)%MotorEffic
PumpHeattoFluid = ShaftPower + (Power - ShaftPower)*PumpEquip(PumpNum)%FracMotorLossToFluid
!****************************!
!***** UPDATE INFORMATION ***!
!****************************!
! Update data structure variables
PumpEquip(PumpNum)%Power = Power
! Update outlet node conditions
Node(OutletNode)%Temp = Node(InletNode)%Temp
Node(OutletNode)%Press = Node(InletNode)%Press
Node(OutletNode)%Quality = Node(InletNode)%Quality
RETURN
END SUBROUTINE CalcPumps