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 SizeIndirectAbsorpChiller(ChillNum)
! SUBROUTINE INFORMATION:
! AUTHOR R. Raustad (FSEC)
! DATE WRITTEN May 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing Indirect Absorption 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, MyPlantSizingIndex
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE CurveManager, ONLY : CurveValue
USE OutputReportPredefined
USE FluidProperties
! USE BranchInputManager, ONLY: MyPlantSizingIndex
USE ReportSizingManager, ONLY: ReportSizingOutput
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:
INTEGER :: PltSizIndex ! Plant Sizing Do loop index
INTEGER :: PltSizNum ! Plant Sizing index corresponding to CurLoopNum
INTEGER :: PltSizCondNum ! Plant Sizing index for condenser loop
INTEGER :: PltSizSteamNum ! Plant Sizing index for steam heating loop
INTEGER :: PltSizHeatingNum ! Plant Sizing index for how water heating loop
REAL(r64) :: SteamInputRatNom ! nominal energy input ratio (steam or hot water)
REAL(r64) :: SteamDensity ! density of generator steam (when connected to a steam loop)
REAL(r64) :: EnthSteamOutDry ! dry enthalpy of steam (quality = 1)
REAL(r64) :: EnthSteamOutWet ! wet enthalpy of steam (quality = 0)
REAL(r64) :: HfgSteam ! latent heat of steam at constant pressure
REAL(r64) :: SteamDeltaT ! amount of sub-cooling of steam condensate
REAL(r64) :: SteamMassFlowRate ! steam mass flow rate through generator
REAL(r64) :: CpWater ! specific heat of generator fluid (when connected to a hot water loop)
REAL(r64) :: RhoWater ! density of water (kg/m3)
REAL(r64) :: GeneratorOutletTemp ! outlet temperature of generator
LOGICAL :: ErrorsFound ! If errors detected in input
LOGICAL :: LoopErrorsFound !
CHARACTER(len=MaxNameLength) :: equipName
REAL(r64) :: rho ! local fluid density
REAL(r64) :: Cp ! local specific heat
REAL(r64) :: tmpNomCap ! local nominal capacity cooling power
REAL(r64) :: tmpNomPumpPower ! local nominal pump power
REAL(r64) :: tmpEvapVolFlowRate ! local evaporator design volume flow rate
REAL(r64) :: tmpCondVolFlowRate ! local condenser design volume flow rate
REAL(r64) :: tmpGeneratorVolFlowRate ! local generator design volume flow rate
INTEGER :: DummWaterIndex = 1
PltSizNum = 0
PltSizCondNum = 0
PltSizHeatingNum = 0
PltSizSteamNum = 0
ErrorsFound = .FALSE.
! init local temporary version in case of partial/mixed autosizing
tmpNomCap = IndirectAbsorber(ChillNum)%NomCap
tmpNomPumpPower = IndirectAbsorber(ChillNum)%NomPumpPower
tmpEvapVolFlowRate = IndirectAbsorber(ChillNum)%EvapVolFlowRate
tmpCondVolFlowRate = IndirectAbsorber(ChillNum)%CondVolFlowRate
tmpGeneratorVolFlowRate = IndirectAbsorber(ChillNum)%GeneratorVolFlowRate
IF(IndirectAbsorber(ChillNum)%GeneratorInputCurvePtr .GT. 0)THEN
SteamInputRatNom = CurveValue(IndirectAbsorber(ChillNum)%GeneratorInputCurvePtr,1.0d0)
ELSE
SteamInputRatNom = 1.0d0
END IF
! find the appropriate Plant Sizing object
IF (CurLoopNum > 0) THEN
PltSizNum = PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%PlantSizNum
END IF
IF (IndirectAbsorber(ChillNum)%CondVolFlowRate == AutoSize) THEN
PltSizCondNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
IndirectAbsorber(ChillNum)%CondInletNodeNum, &
IndirectAbsorber(ChillNum)%CondOutletNodeNum, LoopErrorsFound)
END IF
IF (IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam) THEN
IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 .AND. IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum > 0) THEN
PltSizSteamNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, LoopErrorsFound)
ELSE
DO PltSizIndex=1,NumPltSizInput
IF(PlantSizData(PltSizIndex)%LoopType == SteamLoop)THEN
PltSizSteamNum = PltSizIndex
END IF
END DO
END IF
ELSE
IF (IndirectAbsorber(ChillNum)%GeneratorInletNodeNum > 0 .AND. IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum > 0) THEN
PltSizHeatingNum = MyPlantSizingIndex('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
IndirectAbsorber(ChillNum)%GeneratorOutletNodeNum, LoopErrorsFound)
ELSE
DO PltSizIndex=1,NumPltSizInput
IF(PlantSizData(PltSizIndex)%LoopType == HeatingLoop)THEN
PltSizHeatingNum = PltSizIndex
END IF
END DO
END IF
END IF
IF (IndirectAbsorber(ChillNum)%NomCap == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
Cp = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CWLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%NomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT &
* PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
ELSE
tmpNomCap = Cp * rho * PlantSizData(PltSizNum)%DeltaT &
* PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
ENDIF
ELSE
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%NomCap = 0.d0
ELSE
tmpNomCap = 0.d0
ENDIF
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Nominal Capacity [W]', IndirectAbsorber(ChillNum)%NomCap)
ELSE
CALL ShowSevereError('Autosizing of Absorption Chiller nominal capacity requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (IndirectAbsorber(ChillNum)%NomPumpPower == AutoSize) THEN
IF (PlantSizesOkayToFinalize) THEN
! the DOE-2 EIR for single stage absorption chiller
IndirectAbsorber(ChillNum)%NomPumpPower = 0.0045d0 * IndirectAbsorber(ChillNum)%NomCap
CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Nominal Pumping Power [W]', IndirectAbsorber(ChillNum)%NomPumpPower)
ELSE
tmpNomPumpPower = 0.0045d0 * tmpNomCap
ENDIF
END IF
IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate == AutoSize) THEN
IF (PltSizNum > 0) THEN
IF (PlantSizData(PltSizNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%EvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
ELSE
tmpEvapVolFlowRate = PlantSizData(PltSizNum)%DesVolFlowRate * IndirectAbsorber(ChillNum)%SizFac
ENDIF
ELSE
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%EvapVolFlowRate = 0.d0
ELSE
tmpEvapVolFlowRate = 0.d0
ENDIF
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Design Chilled Water Flow Rate [m3/s]', &
IndirectAbsorber(ChillNum)%EvapVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of Absorption Chiller evap flow rate requires a loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
IF (PlantSizesOkayToFinalize) THEN
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%EvapInletNodeNum,IndirectAbsorber(ChillNum)%EvapVolFlowRate)
ELSE
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%EvapInletNodeNum,tmpEvapVolFlowRate)
ENDIF
IF (IndirectAbsorber(ChillNum)%CondVolFlowRate == AutoSize) THEN
IF (PltSizCondNum > 0) THEN
IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate >= SmallWaterVolFlow) THEN
! QCondenser = QEvaporator + QGenerator + PumpingPower
Cp = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%CDLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%CondVolFlowRate = IndirectAbsorber(ChillNum)%NomCap * &
(1.0d0 + SteamInputRatNom + IndirectAbsorber(ChillNum)%NomPumpPower/IndirectAbsorber(ChillNum)%NomCap) / &
( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
ELSE
tmpCondVolFlowRate = tmpNomCap * &
(1.0d0 + SteamInputRatNom + tmpNomPumpPower/tmpNomCap) / &
( PlantSizData(PltSizCondNum)%DeltaT * Cp * rho )
ENDIF
ELSE
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%CondVolFlowRate = 0.0d0
ELSE
tmpCondVolFlowRate = 0.d0
ENDIF
END IF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Design Condenser Water Flow Rate [m3/s]', &
IndirectAbsorber(ChillNum)%CondVolFlowRate)
ELSE
CALL ShowSevereError('Autosizing of Absorption Chiller condenser flow rate requires a condenser')
CALL ShowContinueError('loop Sizing:Plant object')
CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%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 (PlantSizesOkayToFinalize) Then
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%CondInletNodeNum,IndirectAbsorber(ChillNum)%CondVolFlowRate)
ELSE
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%CondInletNodeNum,tmpCondVolFlowRate)
ENDIF
IF (IndirectAbsorber(ChillNum)%GeneratorVolFlowRate == AutoSize) THEN
IF (PltSizSteamNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Steam .OR. &
PltSizHeatingNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water) THEN
IF (IndirectAbsorber(ChillNum)%EvapVolFlowRate >= SmallWaterVolFlow) THEN
IF(IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
CpWater = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
PlantSizData(PltSizHeatingNum)%ExitTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
SteamDeltaT = MAX(0.5d0,PlantSizData(PltSizHeatingNum)%DeltaT)
RhoWater = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
(PlantSizData(PltSizHeatingNum)%ExitTemp - SteamDeltaT), &
PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
IF (PlantSizesOkayToFinalize) Then
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = (IndirectAbsorber(ChillNum)%NomCap * SteamInputRatNom)/ &
(CpWater * SteamDeltaT * RhoWater)
CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Design Generator Fluid Flow Rate [m3/s]', &
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
ELSE
tmpGeneratorVolFlowRate = (tmpNomCap * SteamInputRatNom)/ &
(CpWater * SteamDeltaT * RhoWater)
ENDIF
ELSE
SteamDensity = GetSatDensityRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,1.0d0, &
IndirectAbsorber(ChillNum)%SteamFluidIndex, &
'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
SteamDeltaT = PlantSizData(PltSizSteamNum)%DeltaT
GeneratorOutletTemp = PlantSizData(PltSizSteamNum)%ExitTemp - SteamDeltaT
EnthSteamOutDry = GetSatEnthalpyRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,1.0d0, &
IndirectAbsorber(ChillNum)%SteamFluidIndex, &
'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
EnthSteamOutWet = GetSatEnthalpyRefrig('STEAM',PlantSizData(PltSizSteamNum)%ExitTemp,0.0d0, &
IndirectAbsorber(ChillNum)%SteamFluidIndex, &
'SIZE Chiller:Absorption:Indirect'//TRIM(IndirectAbsorber(ChillNum)%Name))
CpWater = GetSpecificHeatGlycol('WATER', GeneratorOutletTemp, DummWaterIndex, 'SizeIndirectAbsorpChiller')
HfgSteam = EnthSteamOutDry - EnthSteamOutWet
IF (PlantSizesOkayToFinalize) THEN
! calculate the mass flow rate through the generator
SteamMassFlowRate = (IndirectAbsorber(ChillNum)%NomCap * SteamInputRatNom) / &
( (HfgSteam) + (SteamDeltaT * CpWater) )
! calculate the steam volumetric flow rate
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = SteamMassFlowRate / SteamDensity
CALL ReportSizingOutput('Chiller:Absorption:Indirect', IndirectAbsorber(ChillNum)%Name, &
'Design Generator Fluid Flow Rate [m3/s]', &
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
ELSE
SteamMassFlowRate = (tmpNomCap * SteamInputRatNom) / &
( (HfgSteam) + (SteamDeltaT * CpWater) )
! calculate the steam volumetric flow rate
tmpGeneratorVolFlowRate = SteamMassFlowRate / SteamDensity
ENDIF
END IF
ELSE
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate = 0.0d0
ELSE
tmpGeneratorVolFlowRate = 0.d0
ENDIF
END IF
ELSE
CALL ShowSevereError('Autosizing of Absorption Chiller generator flow rate requires a loop Sizing:Plant object.')
CALL ShowContinueError(' For steam loops, use a steam Sizing:Plant object.')
CALL ShowContinueError(' For hot water loops, use a heating Sizing:Plant object.')
CALL ShowContinueError('Occurs in Chiller:Absorption:Indirect object='//TRIM(IndirectAbsorber(ChillNum)%Name))
ErrorsFound = .TRUE.
END IF
END IF
! save the design steam or hot water volumetric flow rate for use by the steam or hot water loop sizing algorithms
IF (PlantSizesOkayToFinalize) THEN
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum, &
IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
ELSE
CALL RegisterPlantCompDesignFlow(IndirectAbsorber(ChillNum)%GeneratorInletNodeNum,tmpGeneratorVolFlowRate)
ENDIF
IF(IndirectAbsorber(ChillNum)%GeneratorDeltaTemp == AutoSize)THEN
IF(PltSizHeatingNum > 0 .AND. IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water) THEN
IndirectAbsorber(ChillNum)%GeneratorDeltaTemp = MAX(0.5d0,PlantSizData(PltSizHeatingNum)%DeltaT)
ELSE IF(IndirectAbsorber(ChillNum)%GenHeatSourceType == NodeType_Water)THEN
rho = GetDensityGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
CpWater = GetSpecificHeatGlycol(PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidName, &
PlantSizData(PltSizHeatingNum)%ExitTemp, &
PlantLoop(IndirectAbsorber(ChillNum)%GenLoopNum)%FluidIndex, &
'SizeIndirectAbsorpChiller')
IF (PlantSizesOkayToFinalize) THEN
IndirectAbsorber(ChillNum)%GeneratorDeltaTemp = (SteamInputRatNom * IndirectAbsorber(ChillNum)%NomCap)/ &
(CpWater * rho * IndirectAbsorber(ChillNum)%GeneratorVolFlowRate)
ENDIF
END IF
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Preceding sizing errors cause program termination')
END IF
IF (PlantSizesOkayToFinalize) THEN
!create predefined report
equipName = IndirectAbsorber(ChillNum)%Name
CALL PreDefTableEntry(pdchMechType,equipName,'Chiller:Absorption:Indirect')
CALL PreDefTableEntry(pdchMechNomEff,equipName,'n/a')
CALL PreDefTableEntry(pdchMechNomCap,equipName,IndirectAbsorber(ChillNum)%NomCap)
ENDIF
RETURN
END SUBROUTINE SizeIndirectAbsorpChiller