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 |
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 InitializePumps(PumpNum)
! SUBROUTINE INFORMATION:
! AUTHOR: Edwin Lee
! DATE WRITTEN: August 2010
! MODIFIED Based on the INIT section of InitSimVars, credits here:
! Author:
! Oct 1998 Dan Fisher
! Modifications:
! Jul 2001 Richard Liesen
! July 2001, Rick Strand (implemented new pump controls)
! May 2009, Brent Griffith (added EMS override capability)
! Nov 2010, Brent Griffith (call InitComponentNodes, generalize fluid props)
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine does one-time and begin-envrn inits for the pump
! USE STATEMENTS:
USE General, ONLY: RoundSigDigits
USE DataPlant, ONLY: ScanPlantLoopsForObject, PlantLoop, LoopFlowStatus_NeedyAndTurnsLoopOn
USE FluidProperties, ONLY: GetSatDensityRefrig, GetDensityGlycol
USE PlantUtilities, ONLY: InitComponentNodes
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: PumpNum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: StartTemp = 100.0d0 ! Standard Temperature across code to calculated Steam density
REAL(r64), PARAMETER :: ZeroPowerTol = 0.0000001d0
CHARACTER(len=*), PARAMETER :: RoutineName = 'PlantPumps::InitializePumps '
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InletNode !pump inlet node number
INTEGER :: OutletNode !pump outlet node number
REAL(r64) :: TotalEffic
REAL(r64) :: SteamDensity ! Density of working fluid
INTEGER :: DummyWaterIndex = 1
REAL(r64) :: TempWaterDensity
LOGICAL :: errFlag
REAL(r64) :: mdotMax ! local fluid mass flow rate maximum
REAL(r64) :: mdotMin ! local fluid mass flow rate minimum
INTEGER :: plloopnum
INTEGER :: lsnum
INTEGER :: brnum
INTEGER :: cpnum
! Set some variables for convenience
InletNode = PumpEquip(PumpNum)%InletNodeNum
OutletNode = PumpEquip(PumpNum)%OutletNodeNum
! One time inits
IF (PumpEquip(PumpNum)%PumpOneTimeFlag) THEN
errFlag=.false.
CALL ScanPlantLoopsForObject( &
PumpEquip(PumpNum)%Name, &
PumpEquip(PumpNum)%TypeOf_Num, &
PumpEquip(PumpNum)%LoopNum, &
PumpEquip(PumpNum)%LoopSideNum, &
PumpEquip(PumpNum)%BranchNum, &
PumpEquip(PumpNum)%CompNum, &
errFlag=errFlag)
plloopnum=PumpEquip(PumpNum)%LoopNum
lsnum=PumpEquip(PumpNum)%LoopSideNum
brnum=PumpEquip(PumpNum)%BranchNum
cpnum=PumpEquip(PumpNum)%CompNum
IF (plloopnum > 0 .and. lsnum > 0 .and. brnum > 0 .and. cpnum > 0) THEN
IF (PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumIn /= InletNode .or. &
PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumOut /= OutletNode) THEN
CALL ShowSevereError('InitializePumps: '//trim(cPumpTypes(PumpEquip(PumpNum)%PumpType))//'="'// &
trim(PumpEquip(PumpNum)%Name)//'", non-matching nodes.')
CALL ShowContinueError('...in Branch="'//trim(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Name)// &
'", Component referenced with:')
CALL ShowContinueError('...Inlet Node="'// &
trim(NodeID(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumIn)))
CALL ShowContinueError('...Outlet Node="'// &
trim(NodeID(PlantLoop(plloopnum)%LoopSide(lsnum)%Branch(brnum)%Comp(cpnum)%NodeNumOut)))
CALL ShowContinueError('...Pump Inlet Node="'//trim(NodeID(InletNode)))
CALL ShowContinueError('...Pump Outlet Node="'//trim(NodeID(OutletNode)))
errflag=.true.
ENDIF
ELSE ! CR9292
CALL ShowSevereError('InitializePumps: '//trim(cPumpTypes(PumpEquip(PumpNum)%PumpType))//'="'// &
trim(PumpEquip(PumpNum)%Name)//'", component missing.')
errflag=.true. ! should have received warning/severe earlier, will reiterate
ENDIF
IF (errFlag) THEN
CALL ShowFatalError('InitializePumps: Program terminated due to previous condition(s).')
ENDIF
PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(PumpEquip(PumpNum)%LoopSideNum)&
%Branch(PumpEquip(PumpNum)%BranchNum)%Comp(PumpEquip(PumpNum)%CompNum)%CompNum = PumpNum
CALL SizePump(PumpNum)
CALL PumpDataForTable(PumpNum)
! calculate the efficiency for each pump
! by calculating the efficiency for each pump being simulated. The calculation
! is based on the PMPSIM code in the ASHRAE Secondary Toolkit
IF (PumpEquip(PumpNum)%NomPowerUse > ZeroPowerTol .AND. PumpEquip(PumpNum)%MotorEffic > ZeroPowerTol)THEN
TotalEffic = PumpEquip(PumpNum)%NomVolFlowRate * PumpEquip(PumpNum)%NomPumpHead &
/ PumpEquip(PumpNum)%NomPowerUse
PumpEquip(PumpNum)%PumpEffic = TotalEffic / PumpEquip(PumpNum)%MotorEffic
IF (PumpEquip(PumpNum)%PumpEffic < .50d0)THEN
CALL ShowWarningError('Check input. Calculated Pump Efficiency='// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%PumpEffic*100.0d0 ,2))// &
'% which is less than 50%, for pump='//TRIM(PumpEquip(PumpNum)%Name))
CALL ShowContinueError('Calculated Pump_Efficiency % =Total_Efficiency % ['//TRIM(RoundSigDigits(TotalEffic*100.,1))// &
'] / Motor_Efficiency % ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%MotorEffic*100.,1))//']')
CALL ShowContinueError('Total_Efficiency % =(Rated_Volume_Flow_Rate ['// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomVolFlowRate,1))// &
'] * Rated_Pump_Head ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPumpHead,1))// &
'] / Rated_Power_Use ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPowerUse,1))//']) * 100.')
Else IF ((PumpEquip(PumpNum)%PumpEffic > 0.95d0) .and. (PumpEquip(PumpNum)%PumpEffic <= 1.0d0))THEN
CALL ShowWarningError('Check input. Calculated Pump Efficiency='// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%PumpEffic*100.0d0 ,2))// &
'% is approaching 100%, for pump='//TRIM(PumpEquip(PumpNum)%Name))
CALL ShowContinueError('Calculated Pump_Efficiency % =Total_Efficiency % ['//TRIM(RoundSigDigits(TotalEffic*100.,1))// &
'] / Motor_Efficiency % ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%MotorEffic*100.,1))//']')
CALL ShowContinueError('Total_Efficiency % =(Rated_Volume_Flow_Rate ['// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomVolFlowRate,1))// &
'] * Rated_Pump_Head ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPumpHead,1))// &
'] / Rated_Power_Use ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPowerUse,1))//']) * 100.')
Else IF (PumpEquip(PumpNum)%PumpEffic > 1.0d0)THEN
CALL ShowSevereError('Check input. Calculated Pump Efficiency='// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%PumpEffic*100.0d0 ,3))// &
'% which is bigger than 100%, for pump='//TRIM(PumpEquip(PumpNum)%Name))
CALL ShowContinueError('Calculated Pump_Efficiency % =Total_Efficiency % ['//TRIM(RoundSigDigits(TotalEffic*100.,1))// &
'] / Motor_Efficiency % ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%MotorEffic*100.,1))//']')
CALL ShowContinueError('Total_Efficiency % =(Rated_Volume_Flow_Rate ['// &
TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomVolFlowRate,1))// &
'] * Rated_Pump_Head ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPumpHead,1))// &
'] / Rated_Power_Use ['//TRIM(RoundSigDigits(PumpEquip(PumpNum)%NomPowerUse,1))//']) * 100.')
CALL ShowFatalError('Errors found in Pump input')
END IF
ELSE
CALL ShowWarningError('Check input. Pump nominal power or motor efficiency is set to 0, for pump='// &
TRIM(PumpEquip(PumpNum)%Name))
END IF
IF (PumpEquip(PumpNum)%NomVolFlowRate <= SmallWaterVolFlow)THEN
CALL ShowWarningError('Check input. Pump nominal flow rate is set or calculated = 0, for pump='// &
TRIM(PumpEquip(PumpNum)%Name))
End IF
IF (PumpEquip(PumpNum)%PumpControl == Continuous) THEN
! reset flow priority appropriately (default was for Intermittent)
PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(PumpEquip(PumpNum)%LoopSideNum)% &
Branch(PumpEquip(PumpNum)%BranchNum)%Comp(PumpEquip(PumpNum)%CompNum)%FlowPriority = LoopFlowStatus_NeedyAndTurnsLoopOn
ENDIF
PumpEquip(PumpNum)%PumpOneTimeFlag = .FALSE.
END IF
! Begin environment inits
!DSU? Still need to clean this up and update condensate pump stuff -
! BG cleaned to call initComponentnodes, not sure what else may be needed if anything
IF (PumpEquip(PumpNum)%PumpInitFlag .and. BeginEnvrnFlag) THEN
IF (PumpEquip(PumpNum)%PumpType == Pump_Cond) THEN
TempWaterDensity = GetDensityGlycol('WATER', InitConvTemp, DummyWaterIndex, RoutineName)
SteamDensity=GetSatDensityRefrig('STEAM',StartTemp,1.0d0,PumpEquip(PumpNum)%FluidIndex,RoutineName)
PumpEquip(PumpNum)%NomVolFlowRate= (PumpEquip(PumpNum)%NomSteamVolFlowRate*SteamDensity)/TempWaterDensity
!set the maximum flow rate on the outlet node
mdotMax = PumpEquip(PumpNum)%NomSteamVolFlowRate * SteamDensity
!mdotMin = PumpEquip(PumpNum)%MinVolFlowRate * SteamDensity
!On a pump the 'hardware min' (MassFlowRateMin) must be defined as zero and not
!confused with the desired pump operating scheme or the user specified
!'minimum flow rate'. The user specified 'minimum flow rate' determines the minumum
!flow rate under normal operating conditions. For cases when 'MaxAvail' on the pump
!inlet node actually less than the 'minimum flow rate' specified by the user, than a
!loop shutdown must be triggered.
mdotMin = 0.0d0
CALL InitComponentNodes(mdotMin, mdotMax, InletNode, OutletNode, &
PumpEquip(PumpNum)%LoopNum , &
PumpEquip(PumpNum)%LoopSideNum, &
PumpEquip(PumpNum)%BranchNum, &
PumpEquip(PumpNum)%CompNum )
PumpEquip(PumpNum)%MassFlowRateMax = mdotMax
PumpEquip(PumpNum)%MassFlowRateMin = PumpEquip(PumpNum)%MinVolFlowRate * SteamDensity
Else
TempWaterDensity = GetDensityGlycol(PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidIndex, RoutineName)
mdotMax = PumpEquip(PumpNum)%NomVolFlowRate * TempWaterDensity
!mdotMin = PumpEquip(PumpNum)%MinVolFlowRate * TempWaterDensity
!see note above
mdotMin = 0.0d0
CALL InitComponentNodes(mdotMin, mdotMax, InletNode, OutletNode, &
PumpEquip(PumpNum)%LoopNum , &
PumpEquip(PumpNum)%LoopSideNum, &
PumpEquip(PumpNum)%BranchNum, &
PumpEquip(PumpNum)%CompNum )
PumpEquip(PumpNum)%MassFlowRateMax = mdotMax
PumpEquip(PumpNum)%MassFlowRateMin = PumpEquip(PumpNum)%MinVolFlowRate * TempWaterDensity
End If
!zero out report variables
PumpEquip(PumpNum)%Energy = 0.d0
PumpEquip(PumpNum)%Power = 0.d0
PumpEquipReport(PumpNum)%ShaftPower = 0.d0
PumpEquipReport(PumpNum)%PumpHeattoFluid = 0.d0
PumpEquipReport(PumpNum)%PumpHeattoFluidEnergy = 0.d0
PumpEquipReport(PumpNum)%OutletTemp = 0.d0
PumpEquipReport(PumpNum)%PumpMassFlowRate = 0.d0
PumpEquipReport(PumpNum)%NumPumpsOperating = 0
PumpEquipReport(PumpNum)%ZoneTotalGainRate = 0.d0
PumpEquipReport(PumpNum)%ZoneTotalGainEnergy = 0.d0
PumpEquipReport(PumpNum)%ZoneConvGainRate = 0.d0
PumpEquipReport(PumpNum)%ZoneRadGainRate = 0.d0
PumpEquip(PumpNum)%PumpInitFlag = .FALSE.
END IF
! Reset the local environment flag for the next environment
IF (.NOT. BeginEnvrnFlag) PumpEquip(PumpNum)%PumpInitFlag = .TRUE.
! zero out module level working variables
PumpMassFlowRate = 0.d0
PumpHeattoFluid = 0.d0
Power = 0.d0
ShaftPower = 0.d0
RETURN
END SUBROUTINE InitializePumps