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 SizePump(PumpNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN December 2001
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing Pump Components for which flow rates have not been
! specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains flow rates from the plant sizing array.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing, ONLY: AutoSize, PlantSizData
USE DataPlant, ONLY: PlantLoop
USE General, ONLY: RoundSigDigits
USE ReportSizingManager, ONLY: ReportSizingOutput
USE FluidProperties, ONLY: GetSatDensityRefrig, GetDensityGlycol
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
CHARACTER(len=*), PARAMETER :: RoutineName = 'PlantPumps::InitSimVars '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PlantSizNum ! index of Plant Sizing array
LOGICAL :: ErrorsFound
REAL(r64) :: TotalEffic ! pump total efficiency
INTEGER :: Side ! half loop index
INTEGER :: BranchNum ! index of branch
INTEGER :: CompNum ! index of component on branch
REAL(r64) :: PumpSizFac ! pump sizing factor
REAL(r64) :: SteamDensity
REAL(r64) :: TempWaterDensity
INTEGER :: DummyWaterIndex = 1
REAL(r64) :: DesVolFlowRatePerBranch ! local temporary for split of branch pumps
! Calculate density at InitConvTemp once here, to remove RhoH2O calls littered throughout
IF (PumpEquip(PumpNum)%LoopNum > 0) THEN
TempWaterDensity = GetDensityGlycol(PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(PumpEquip(PumpNum)%LoopNum)%FluidIndex, RoutineName)
ELSE
TempWaterDensity = GetDensityGlycol('WATER', InitConvTemp, DummyWaterIndex, RoutineName)
ENDIF
! note: we assume pump impeller efficiency is 78% for autosizing
TotalEffic = 0.78d0 * PumpEquip(PumpNum)%MotorEffic
PlantSizNum = 0
PumpSizFac = 1.0d0
ErrorsFound = .FALSE.
! CurLoopNum > 0 only for Plant Loops; condenser loops not sized yet
IF (PumpEquip(PumpNum)%LoopNum > 0) THEN
PlantSizNum = PlantLoop(PumpEquip(PumpNum)%LoopNum)%PlantSizNum
! ELSE IF (CurCondLoopNum > 0) THEN
! PlantSizNum = CondSupplySide(CurCondLoopNum)%PlantSizNum
END IF
! look for pump sizing factor on branch
IF (PumpEquip(PumpNum)%LoopNum > 0) THEN
SideLoop: DO Side=1,2
DO BranchNum = 1,PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%TotalBranches
DO CompNum = 1, PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%Branch(BranchNum)%TotalComponents
IF (PumpEquip(PumpNum)%InletNodeNum == &
PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%Branch(BranchNum)%Comp(CompNum)%NodeNumIn .AND. &
PumpEquip(PumpNum)%OutletNodeNum == &
PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%Branch(BranchNum)%Comp(CompNum)%NodeNumOut) THEN
IF (PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%Branch(BranchNum)%PumpSizFac > 0.0d0) THEN
PumpSizFac = PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%Branch(BranchNum)%PumpSizFac
ELSE
PumpSizFac = 1.0d0
END IF
EXIT SideLoop
END IF
END DO
END DO
END DO SideLoop
END IF
IF (PumpEquip(PumpNum)%NomVolFlowRate == AutoSize) THEN
IF (PlantSizNum > 0) THEN
IF (PlantSizData(PlantSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
IF (.NOT. PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%BranchPumpsExist) THEN
! size pump to full flow of plant loop
IF(PumpEquip(PumpNum)%PumpType == Pump_Cond)THEN
TempWaterDensity = GetDensityGlycol('WATER', InitConvTemp, DummyWaterIndex, RoutineName)
SteamDensity=GetSatDensityRefrig('STEAM',StartTemp,1.0d0,PumpEquip(PumpNum)%FluidIndex,'SizePumps')
PumpEquip(PumpNum)%NomSteamVolFlowRate= PlantSizData(PlantSizNum)%DesVolFlowRate * PumpSizFac
PumpEquip(PumpNum)%NomVolFlowRate = PumpEquip(PumpNum)%NomSteamVolFlowRate*SteamDensity/TempWaterDensity
ELSE
PumpEquip(PumpNum)%NomVolFlowRate = PlantSizData(PlantSizNum)%DesVolFlowRate * PumpSizFac
END IF
ELSE
! Distribute sizes evenly across all branch pumps
DesVolFlowRatePerBranch = PlantSizData(PlantSizNum)%DesVolFlowRate &
/ PlantLoop(PumpEquip(PumpNum)%LoopNum)%LoopSide(Side)%TotalPumps
IF(PumpEquip(PumpNum)%PumpType == Pump_Cond)THEN
TempWaterDensity = GetDensityGlycol('WATER', InitConvTemp, DummyWaterIndex, RoutineName)
SteamDensity=GetSatDensityRefrig('STEAM',StartTemp,1.0d0,PumpEquip(PumpNum)%FluidIndex,'SizePumps')
PumpEquip(PumpNum)%NomSteamVolFlowRate= DesVolFlowRatePerBranch * PumpSizFac
PumpEquip(PumpNum)%NomVolFlowRate = PumpEquip(PumpNum)%NomSteamVolFlowRate*SteamDensity/TempWaterDensity
ELSE
PumpEquip(PumpNum)%NomVolFlowRate = DesVolFlowRatePerBranch * PumpSizFac
ENDIF
ENDIF
ELSE
PumpEquip(PumpNum)%NomVolFlowRate = 0.0d0
CALL ShowWarningError('SizePump: Calculated Pump Nominal Volume Flow Rate=['// &
TRIM(RoundSigDigits(PlantSizData(PlantSizNum)%DesVolFlowRate, 2))//'] is too small. Set to 0.0')
CALL ShowContinueError('..occurs for Pump='//TRIM(PumpEquip(PumpNum)%Name))
END IF
CALL ReportSizingOutput(cPumpTypes(PumpEquip(PumpNum)%PumpType), PumpEquip(PumpNum)%Name, &
'Rated Flow Rate [m3/s]', PumpEquip(PumpNum)%NomVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of plant loop pump flow rate requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in plant pump object='//TRIM(PumpEquip(PumpNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
! Note that autocalculation of power is based on nominal volume flow, regardless of whether the flow was
! auto sized or manually sized. Thus, this must go after the flow sizing block above.
IF (PumpEquip(PumpNum)%NomPowerUse == AutoSize) THEN
IF (PumpEquip(PumpNum)%NomVolFlowRate >= SmallWaterVolFlow) THEN
PumpEquip(PumpNum)%NomPowerUse = (PumpEquip(PumpNum)%NomPumpHead * PumpEquip(PumpNum)%NomVolFlowRate) / &
TotalEffic
ELSE
PumpEquip(PumpNum)%NomPowerUse = 0.0d0
END IF
CALL ReportSizingOutput(cPumpTypes(PumpEquip(PumpNum)%PumpType), PumpEquip(PumpNum)%Name, &
'Rated Power Consumption [W]', PumpEquip(PumpNum)%NomPowerUse)
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
RETURN
END SUBROUTINE SizePump