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) | :: | ChillNum |
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 SizeElectricChiller(ChillNum)
! SUBROUTINE INFORMATION:
! AUTHOR Fred Buhl
! DATE WRITTEN April 2002
! MODIFIED na
! RE-ENGINEERED B. Griffith, April 2011, allow repeated sizing calls, finish when ready to do so
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing Electric Chiller Components for which capacities and flow rates
! have not been specified in the input.
! METHODOLOGY EMPLOYED:
! Obtains evaporator flow rate from the plant sizing array. Calculates nominal capacity from
! the evaporator flow rate and the chilled water loop design delta T. The condenser flow rate
! is calculated from the nominal capacity, the COP, and the condenser loop design delta T.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE DataPlant, ONLY : PlantLoop, PlantSizesOkayToFinalize
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE OutputReportPredefined
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: ChillNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
!unused1208 INTEGER :: PltSizIndex ! Plant Sizing Do loop index
INTEGER :: PltSizNum ! Plant Sizing index corresponding to CurLoopNum
INTEGER :: PltSizCondNum ! Plant Sizing index for condenser loop
LOGICAL :: ErrorsFound ! If errors detected in input
LOGICAL :: LoopErrorsFound
CHARACTER(len=MaxNameLength) :: equipName
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local fluid specific heat
REAL(r64) :: tmpNomCap ! local nominal capacity cooling power
REAL(r64) :: tmpEvapVolFlowRate ! local evaporator design volume flow rate
REAL(r64) :: tmpCondVolFlowRate ! local condenser design volume flow rate
REAL(r64) :: tmpHeatRecVolFlowRate ! local heat recovery design volume flow rate
PltSizNum = 0
PltSizCondNum = 0
ErrorsFound = .FALSE.
! init local temporary version in case of partial/mixed autosizing
tmpNomCap = ElectricChiller(ChillNum)%Base%NomCap
tmpEvapVolFlowRate = ElectricChiller(ChillNum)%Base%EvapVolFlowRate
tmpCondVolFlowRate = ElectricChiller(ChillNum)%Base%CondVolFlowRate
IF (ElectricChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
IF (ElectricChiller(ChillNum)%Base%CondVolFlowRate == AutoSize) THEN
PltSizCondNum = PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%PlantSizNum
END IF
END IF
PltSizNum = PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%PlantSizNum
IF (ElectricChiller(ChillNum)%Base%NomCap == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
rho = GetDensityGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidIndex,&
'SizeElectricChiller')
Cp = GetSpecificHeatGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(ElectricChiller(ChillNum)%Base%CWLoopNum)%FluidIndex, &
'SizeElectricChiller')
tmpNomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT &
* PlantSizData(PltSizNum)%DesVolFlowRate * ElectricChiller(ChillNum)%Base%SizFac
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%NomCap = tmpNomCap
ELSE
tmpNomCap = 0.d0
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%NomCap = tmpNomCap
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Electric', ElectricChiller(ChillNum)%Base%Name, &
'Nominal Capacity [W]', ElectricChiller(ChillNum)%Base%NomCap)
ELSE
CALL ShowSevereError('Autosizing of Electric Chiller nominal capacity requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Electric Chiller object='//TRIM(ElectricChiller(ChillNum)%Base%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (ElectricChiller(ChillNum)%Base%EvapVolFlowRate == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
tmpEvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * ElectricChiller(ChillNum)%Base%SizFac
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%EvapVolFlowRate = tmpEvapVolFlowRate
ELSE
tmpEvapVolFlowRate = 0.d0
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%EvapVolFlowRate = tmpEvapVolFlowRate
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Electric', ElectricChiller(ChillNum)%Base%Name, &
'Design Chilled Water Flow Rate [m3/s]', &
ElectricChiller(ChillNum)%Base%EvapVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of Electric Chiller evap flow rate requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Electric Chiller object='//TRIM(ElectricChiller(ChillNum)%Base%Name))
ErrorsFound = .TRUE.
END IF
END IF
CALL RegisterPlantCompDesignFlow(ElectricChiller(ChillNum)%Base%EvapInletNodeNum,tmpEvapVolFlowRate)
IF (ElectricChiller(ChillNum)%Base%CondVolFlowRate == AutoSize) THEN
IF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
rho = GetDensityGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
ElectricChiller(ChillNum)%TempDesCondIn, &
PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidIndex,&
'SizeElectricChiller')
Cp = GetSpecificHeatGlycol(PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidName, &
ElectricChiller(ChillNum)%TempDesCondIn, &
PlantLoop(ElectricChiller(ChillNum)%Base%CDLoopNum)%FluidIndex, &
'SizeElectricChiller')
tmpCondVolFlowRate = tmpNomCap * (1.d0 + 1.d0/ElectricChiller(ChillNum)%Base%COP) / &
( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%CondVolFlowRate = tmpCondVolFlowRate
ELSE
tmpCondVolFlowRate = 0.0d0
IF (PlantSizesOkayToFinalize) ElectricChiller(ChillNum)%Base%CondVolFlowRate = 0.d0
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Electric', ElectricChiller(ChillNum)%Base%Name, &
'Design Condenser Water Flow Rate [m3/s]', &
ElectricChiller(ChillNum)%Base%CondVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of Electric Chiller condenser flow rate requires a condenser')
CALL ShowContinueError('loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Electric Chiller object='//TRIM(ElectricChiller(ChillNum)%Base%Name))
ErrorsFound = .TRUE.
END IF
END IF
! save the design condenser water volumetric flow rate for use by the condenser water loop sizing algorithms
IF (ElectricChiller(ChillNum)%Base%CondenserType == WaterCooled) THEN
CALL RegisterPlantCompDesignFlow(ElectricChiller(ChillNum)%Base%CondInletNodeNum,tmpCondVolFlowRate)
ENDIF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
IF (ElectricChiller(ChillNum)%HeatRecActive) THEN
tmpHeatRecVolFlowRate = ElectricChiller(ChillNum)%DesignHeatRecVolFlowRate
IF ( ElectricChiller(ChillNum)%DesignHeatRecVolFlowRate == Autosize) THEN
tmpHeatRecVolFlowRate = tmpCondVolFlowRate * ElectricChiller(ChillNum)%HeatRecCapacityFraction
IF (PlantSizesOkayToFinalize) THEN
ElectricChiller(ChillNum)%DesignHeatRecVolFlowRate = tmpHeatRecVolFlowRate
CALL ReportSizingOutput('Chiller:Electric', ElectricChiller(ChillNum)%Base%Name, &
'Design Heat Recovery Fluid Flow Rate [m3/s]', &
ElectricChiller(ChillNum)%DesignHeatRecVolFlowRate)
ENDIF
ENDIF
! save the reference heat recovery fluid volumetric flow rate
CALL RegisterPlantCompDesignFlow(ElectricChiller(ChillNum)%HeatRecInletNodeNum,tmpHeatRecVolFlowRate)
ENDIF
IF (PlantSizesOkayToFinalize) Then
!create predefined report
equipName = ElectricChiller(ChillNum)%Base%Name
CALL PreDefTableEntry(pdchMechType,equipName,'Chiller:Electric')
CALL PreDefTableEntry(pdchMechNomEff,equipName,ElectricChiller(ChillNum)%Base%COP)
CALL PreDefTableEntry(pdchMechNomCap,equipName,ElectricChiller(ChillNum)%Base%NomCap)
ENDIF
RETURN
END SUBROUTINE SizeElectricChiller