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) | :: | WrapperNum |
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 SizeWrapper(WrapperNum)
! SUBROUTINE INFORMATION:
! AUTHOR Yunzhi Huang, PNNL
! DATE WRITTEN Feb 2013
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing all the components under each 'CentralHeatPumpSystem' object,
! 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 reference capacity from
! the evaporator (or load side) flow rate and the chilled water loop design delta T. The condenser
! flow (or sourse side) rate is calculated from the reference capacity, the COP, and the condenser
! loop design delta T.
! REFERENCES:
! na
! USE STATEMENTS:
USE DataSizing
USE DataPlant, ONLY: PlantSizesOkayToFinalize
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE DataHVACGlobals, ONLY: SmallWaterVolFlow
USE DataGlobals, ONLY: InitConvTemp
USE OutputReportPredefined
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: WrapperNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
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 !
LOGICAL :: errFlag ! error flag for node connection
CHARACTER(len=MaxNameLength) :: equipName
REAL(r64) :: rho
REAL(r64) :: Cp
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) :: tmpLoadVolFlowRate ! local load design volume flow rate
REAL(r64) :: tmpSourceVolFlowRate ! local source design volume flow rate
INTEGER :: NumChillerHeater ! Number of Chiller heater pointer
INTEGER :: CHWInletNodeNum ! Chilled water inlet node index number
INTEGER :: CHWOutletNodeNum ! Chilled water outlet node index number
INTEGER :: GLHEInletNodeNum ! Geo-field water inlet node index number
INTEGER :: GLHEOutletNodeNum ! Geo-field water outlet node index number
INTEGER :: HWInletNodeNum ! Hot water inlet node index number
INTEGER :: HWOutletNodeNum ! Hot water outlet node index number
INTEGER :: EvapInletNode ! Chiller heater evaporator side inlet node index number
INTEGER :: EvapOutletNode ! Chiller heater evaporator side outlet node index number
INTEGER :: CondInletNode ! Chiller heater condenser side inlet node index number
INTEGER :: CondOutletNode ! Chiller heater condenser side outlet node index number
INTEGER :: LoadSideInletNode ! Heat pump load side inlet node index number
INTEGER :: LoadSideOutletNode ! Heat pump load side outlet node index number
INTEGER :: SourceSideInletNode ! Heat pump source side inlet node index number
INTEGER :: SourceSideOutletNode ! Heat pump source side outlet node index number
INTEGER :: DummyInletNode ! Dummy inlet node index number
INTEGER :: DummyOutletNode ! Dummy outlet node index number
REAL(r64) :: TotalEvapVolFlowRate
REAL(r64) :: TotalCondVolFlowRate
REAL(r64) :: TotalHotWaterVolFlowRate
! get all the nodes' indices
CHWInletNodeNum = Wrapper(WrapperNum)%CHWInletNodeNum
CHWOutletNodeNum = Wrapper(WrapperNum)%CHWOutletNodeNum
GLHEInletNodeNum = Wrapper(WrapperNum)%GLHEInletNodeNum
GLHEOutletNodeNum = Wrapper(WrapperNum)%GLHEOutletNodeNum
HWInletNodeNum = Wrapper(WrapperNum)%HWInletNodeNum
HWOutletNodeNum = Wrapper(WrapperNum)%HWOutletNodeNum
! auto-size the chiller heater components
IF (Wrapper(WrapperNum)%ControlMode == SmartMixing) THEN
DO NumChillerHeater = 1 , Wrapper(WrapperNum)%ChillerHeaterNums
PltSizNum = 0
PltSizCondNum = 0
ErrorsFound = .FALSE.
! find the appropriate Plant Sizing object
PltSizNum = PlantLoop(Wrapper(WrapperNum)%CWLoopNum)%PlantSizNum
IF (Wrapper(WrapperNum)%Chillerheater(NumChillerHeater)%CondVolFlowRate == AutoSize) THEN
PltSizCondNum = PlantLoop(Wrapper(WrapperNum)%GLHELoopNum)%PlantSizNum
END IF
tmpNomCap = Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling
tmpEvapVolFlowRate = Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%EvapVolFlowRate
tmpCondVolFlowRate = Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%CondVolFlowRate
! auto-size the Evaporator Flow Rate
IF (Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%EvapVolFlowRate == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
tmpEvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%SizFac
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpEvapVolFlowRate = tmpEvapVolFlowRate
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%EvapVolFlowRate = &
tmpEvapVolFlowRate
ELSE
tmpEvapVolFlowRate = 0.d0
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpEvapVolFlowRate = tmpEvapVolFlowRate
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%EvapVolFlowRate = &
tmpEvapVolFlowRate
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('ChillerHeaterPerformance:Electric:EIR', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name, &
'Reference Chilled Water Flow Rate [m3/s]', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%EvapVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of CGSHP Chiller Heater evap flow rate requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in CGSHP Chiller Heater Performance object='// &
TRIM(Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name))
ErrorsFound = .TRUE.
END IF
END IF
! auto-size the Reference Cooling Capacity
! each individual chiller heater module is sized to be capable of supporting the total load on the wrapper
IF (Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(Wrapper(WrapperNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Wrapper(WrapperNum)%CWLoopNum)%FluidIndex, &
'SizeCGSHPChillerHeater')
rho = GetDensityGlycol(PlantLoop(Wrapper(WrapperNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Wrapper(WrapperNum)%CWLoopNum)%FluidIndex,&
'SizeCGSHPChillerHeater')
tmpNomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT * tmpEvapVolFlowRate
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling = tmpNomCap
ELSE
tmpNomCap = 0.d0
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling = tmpNomCap
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('ChillerHeaterPerformance:Electric:EIR', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name, &
'Reference Capacity [W]', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling)
ELSE
CALL ShowSevereError('SizeExhaustAbsorber: ChillerHeaterPerformance:Electric:EIR="'// &
trim(Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name)//'", autosize error.')
CALL ShowContinueError('Autosizing of CGSHP Chiller Heater reference capacity requires')
CALL ShowContinueError('a cooling loop Sizing:Plant object.')
ErrorsFound = .TRUE.
END IF
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapClgHtg = &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling * &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%ClgHtgToCoolingCapRatio
END IF
! auto-size the condenser volume flow rate
! each individule chiller heater module is sized to be capable of supporting the total load on the wrapper
IF (Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%CondVolFlowRate == AutoSize) THEN
IF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
rho = GetDensityGlycol(PlantLoop(Wrapper(WrapperNum)%GLHELoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(Wrapper(WrapperNum)%GLHELoopNum)%FluidIndex,&
'SizeCGSHPChillerHeater')
Cp = GetSpecificHeatGlycol(PlantLoop(Wrapper(WrapperNum)%GLHELoopNum)%FluidName, &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%TempRefCondIn, &
PlantLoop(Wrapper(WrapperNum)%GLHELoopNum)%FluidIndex, &
'SizeCGSHPChillerHeater')
tmpCondVolFlowRate = tmpNomCap * &
(1.0d0 + (1.0d0/Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCOPCooling) * &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%OpenMotorEff) / &
( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpCondVolFlowRate = tmpCondVolFlowRate
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%CondVolFlowRate = &
tmpCondVolFlowRate
ELSE
tmpCondVolFlowRate = 0.d0
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpCondVolFlowRate = tmpCondVolFlowRate
IF (PlantSizesOkayToFinalize) Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%CondVolFlowRate = &
tmpCondVolFlowRate
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('ChillerHeaterPerformance:Electric:EIR', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name, &
'Reference Condenser Water Flow Rate [m3/s]', &
Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%CondVolFlowRate)
ELSE
CALL ShowSevereError('SizeExhaustAbsorber: ChillerHeaterPerformance:Electric:EIR="'// &
trim(Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name)//'", autosize error.')
CALL ShowContinueError('Autosizing of CGSHP Chiller Heater condenser flow rate requires')
CALL ShowContinueError('a condenser loop Sizing:Plant object.')
ErrorsFound = .TRUE.
END IF
END IF
IF (PlantSizesOkayToFinalize) THEN
!create predefined report
equipName = Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%Name
CALL PreDefTableEntry(pdchMechType,equipName,'ChillerHeaterPerformance:Electric:EIR')
CALL PreDefTableEntry(pdchMechNomEff,equipName,Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCOPCooling)
CALL PreDefTableEntry(pdchMechNomCap,equipName,Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%RefCapCooling)
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
END DO
! sum individual volume flows and register wrapper inlets
TotalEvapVolFlowRate = 0.d0
TotalCondVolFlowRate = 0.d0
TotalHotWaterVolFlowRate = 0.d0
DO NumChillerHeater = 1 , Wrapper(WrapperNum)%ChillerHeaterNums
TotalEvapVolFlowRate = TotalEvapVolFlowRate + Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpEvapVolFlowRate
TotalCondVolFlowRate = TotalCondVolFlowRate + Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%tmpCondVolFlowRate
TotalHotWaterVolFlowRate = TotalHotWaterVolFlowRate &
+ Wrapper(WrapperNum)%ChillerHeater(NumChillerHeater)%DesignHotWaterVolFlowRate
ENDDO
CALL RegisterPlantCompDesignFlow(Wrapper(WrapperNum)%CHWInletNodeNum,TotalEvapVolFlowRate)
CALL RegisterPlantCompDesignFlow(Wrapper(WrapperNum)%HWInletNodeNum,TotalHotWaterVolFlowRate)
! save the reference condenser water volumetric flow rate for use by the condenser water loop sizing algorithms
CALL RegisterPlantCompDesignFlow(Wrapper(WrapperNum)%GLHEInletNodeNum,TotalCondVolFlowRate)
RETURN
END IF
END SUBROUTINE SizeWrapper