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 | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | ChillerName | |||
integer, | intent(in) | :: | ChillerType | |||
real(kind=r64), | intent(in) | :: | RefCap | |||
real(kind=r64), | intent(in) | :: | RefCOP | |||
integer, | intent(in) | :: | CondenserType | |||
integer, | intent(in) | :: | CapFTempCurveIndex | |||
integer, | intent(in) | :: | EIRFTempCurveIndex | |||
integer, | intent(in) | :: | EIRFPLRCurveIndex | |||
real(kind=r64), | intent(in) | :: | MinUnLoadRat | |||
real(kind=r64), | intent(in), | optional | :: | EvapVolFlowRate | ||
integer, | intent(in), | optional | :: | CondLoopNum | ||
real(kind=r64), | intent(in), | optional | :: | OpenMotorEff |
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 CalcChillerIPLV(ChillerName, ChillerType, RefCap, RefCOP, CondenserType, CapFTempCurveIndex, &
EIRFTempCurveIndex, EIRFPLRCurveIndex, MinUnLoadRat, EvapVolFlowRate, &
CondLoopNum, OpenMotorEff)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma, FSEC
! DATE WRITTEN January 2012
! Modified na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculates Integrated Part Load Value (IPLV) for EIR and reformulated EIR chillers.
! Writes the result to EIO file.
!
! METHODOLOGY EMPLOYED:
! (1) Obtains the reference cooling capacity, reference COP and performance curves of the chiller
!
! (2) Evaluates the cooling capacity at AHRI test conditions (Per AHRI 551/591,2011 Table 3)
!
! (3) Evaluates the EIR at AHRI test conditions (Per AHRI 551/591,2011 Table 3)
!
! (4) The EER is evaluated from the total cooling capacity and total electric power
! evaluated at the standard rated test conditions. The IPLV is a weighted value of the COP evaluated
! at four different capacities of 100%, 75%, 50% and 25%. The reduced capacity COPs are evaluated
! at different outdoor coil entering temperatures.
!
! REFERENCES:
! (1) AHRI Standard 551/591-2011: Standard for Performance Rating of Water-Chilling Packages using the Vapor
! Compression Cycle. Arlington, VA: Air-Conditioning, Heating,
! and Refrigeration Institute.
! USE STATEMENTS:
USE FluidProperties, ONLY: GetDensityGlycol, GetSpecificHeatGlycol
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE DataPlant, ONLY: PlantLoop,TypeOf_Chiller_ElectricEIR, TypeOf_Chiller_ElectricReformEIR
USE CurveManager, ONLY: CurveValue, GetCurveType, GetCurveName
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
CHARACTER(len=*), INTENT(IN) :: ChillerName ! Name of Chiller for which IPLV is calculated
INTEGER, INTENT(IN) :: ChillerType ! Type of Chiller - EIR or Reformulated EIR
INTEGER, INTENT(IN) :: CondenserType ! Type of Condenser - Air Cooled, Water Cooled or Evap Cooled
INTEGER, INTENT(IN) :: CapFTempCurveIndex ! Index for the total cooling capacity modifier curve
! (function of leaving chilled water temperature and
! entering condenser fluid temperature)
INTEGER, INTENT(IN) :: EIRFTempCurveIndex ! Index for the energy input ratio modifier curve
! (function of leaving chilled water temperature and
! entering condenser fluid temperature)
INTEGER, INTENT(IN) :: EIRFPLRCurveIndex ! Index for the EIR vs part-load ratio curve
REAL(r64), INTENT(IN) :: RefCap ! Reference capacity of chiller [W]
REAL(r64), INTENT(IN) :: RefCOP ! Reference coefficient of performance [W/W]
REAL(r64), INTENT(IN) :: MinUnLoadRat ! Minimum unloading ratio
REAL(r64), INTENT(IN), OPTIONAL :: EvapVolFlowRate ! Reference water volumetric flow rate through the evaporator [m3/s]
REAL(r64), INTENT(IN), OPTIONAL :: OpenMotorEff ! Open chiller motor efficiency [fraction, 0 to 1]
INTEGER, INTENT(IN), OPTIONAL :: CondLoopNum ! condenser water plant loop index number
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: AirCooled = 1
INTEGER, PARAMETER :: WaterCooled = 2
INTEGER, PARAMETER :: EvapCooled = 3
REAL(r64), PARAMETER :: EvapOutletTemp = 6.67d0 ! (44F)
REAL(r64), PARAMETER :: Acc = 0.0001d0 ! Accuracy of result
REAL(r64), PARAMETER :: ConvFromSIToIP = 3.412141633D0 ! Conversion from SI to IP [3.412 Btu/hr-W]
INTEGER, PARAMETER :: NumOfReducedCap = 4 ! Number of reduced capacity test conditions (100%,75%,50%,and 25%)
INTEGER, PARAMETER :: IterMax = 500 ! Maximum number of iterations
REAL(r64), PARAMETER, DIMENSION(4) :: ReducedPLR = (/1.0D0, 0.75d0,0.50d0,0.25d0/) ! Reduced Capacity part-load conditions
REAL(r64), PARAMETER, DIMENSION(4) :: IPLVWeightingFactor = (/0.010D0, 0.42D0, 0.45D0, 0.12D0/) ! EER Weighting factors (IPLV)
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AvailChillerCap = 0.0D0 ! Chiller available capacity at current operating conditions [W]
REAL(r64) :: EnteringWaterTempReduced = 0.0D0 ! Entering Condenser Water Temperature at reduced conditions [C]
REAL(r64) :: EnteringAirDrybulbTempReduced = 0.0D0 ! Outdoor unit entering air dry-bulb temperature
! at reduced capacity [C]
REAL(r64) :: EnteringAirWetbulbTempReduced = 0.0D0 ! Outdoor unit entering air wet-bulb temperature
! at reduced capacity [C]
REAL(r64) :: CondenserInletTemp = 0.0D0 ! Entering Condenser Temperature at reduced conditions [C]
REAL(r64) :: CondenserOutletTemp0 = 0.0D0 ! Lower bound for condenser outlet temperature [C]
REAL(r64) :: CondenserOutletTemp1 = 0.0D0 ! Upper bound for condenser outlet temperature [C]
REAL(r64) :: CondenserOutletTemp = 0.0D0 ! Calculated condenser outlet temperature which corresponds
! to EnteringWaterTempReduced above [C]
REAL(r64) :: Cp = 0.0D0 ! Water specific heat [J/(kg*C)]
REAL(r64) :: Rho = 0.0D0 ! Water density [kg/m3]
REAL(r64) :: IPLV = 0.0D0 ! Integerated Part Load Value in SI [W/W]
REAL(r64) :: EIR = 0.0D0 ! Inverse of COP at reduced capacity test conditions (100%, 75%, 50%, and 25%)
REAL(r64) :: Power = 0.0D0 ! Power at reduced capacity test conditions (100%, 75%, 50%, and 25%)
REAL(r64) :: COPReduced = 0.0D0 ! COP at reduced capacity test conditions (100%, 75%, 50%, and 25%)
REAL(r64) :: LoadFactor = 0.0D0 ! Fractional "on" time for last stage at the desired reduced capacity,
! (dimensionless)
REAL(r64) :: DegradationCoeff = 0.0D0 ! Degradation coeficient, (dimenssionless)
REAL(r64) :: ChillerCapFT = 0.0D0 ! Chiller capacity fraction (evaluated as a function of temperature)
REAL(r64) :: ChillerEIRFT = 0.0D0 ! Chiller electric input ratio (EIR = 1 / COP) as a function of temperature
REAL(r64) :: ChillerEIRFPLR = 0.0D0 ! Chiller EIR as a function of part-load ratio (PLR)
REAL(r64) :: PartLoadRatio = 0.0D0 ! Part load ratio (PLR) at which chiller is operatign at reduced capacity
INTEGER :: RedCapNum ! Integer counter for reduced capacity
INTEGER :: SolFla ! Flag of solver
REAL(r64), DIMENSION(11) :: Par ! Parameter array need for RegulaFalsi routine
! Initialize local variables
AvailChillerCap = 0.0D0
EnteringWaterTempReduced = 0.0D0
EnteringAirDrybulbTempReduced = 0.0D0
EnteringAirWetbulbTempReduced = 0.0D0
CondenserInletTemp = 0.0D0
CondenserOutletTemp0 = 0.0D0
CondenserOutletTemp1 = 0.0D0
CondenserOutletTemp = 0.0D0
Cp = 0.0D0
Rho = 0.0D0
IPLV = 0.0D0
EIR = 0.0D0
Power = 0.0D0
COPReduced = 0.0D0
LoadFactor = 0.0D0
DegradationCoeff = 0.0D0
ChillerCapFT = 0.0D0
ChillerEIRFT = 0.0D0
ChillerEIRFPLR = 0.0D0
PartLoadRatio = 0.0D0
CALL CheckCurveLimitsForIPLV(ChillerName, ChillerType, CondenserType, CapFTempCurveIndex, EIRFTempCurveIndex)
! IPLV calculations:
DO RedCapNum = 1, NumOfReducedCap
IF (CondenserType == WaterCooled) THEN
! get the entering water temperature for the reduced capacity test conditions
IF (ReducedPLR(RedCapNum) > 0.50D0 ) THEN
EnteringWaterTempReduced = 8.0D0 + 22.0D0 * ReducedPLR(RedCapNum)
ELSE
EnteringWaterTempReduced = 19.0D0
ENDIF
CondenserInletTemp = EnteringWaterTempReduced
ELSEIF (CondenserType == AirCooled) THEN
! get the outdoor air dry bulb temperature for the reduced capacity test conditions
IF (ReducedPLR(RedCapNum) > 0.3125D0 ) THEN
EnteringAirDrybulbTempReduced = 3.0D0 + 32.0D0 * ReducedPLR(RedCapNum)
ELSE
EnteringAirDrybulbTempReduced = 13.0D0
ENDIF
CondenserInletTemp = EnteringAirDrybulbTempReduced
ELSE ! EvaporativelyCooled Condenser
! get the outdoor air wet bulb temperature for the reduced capacity test conditions
EnteringAirWetbulbTempReduced = 10.0D0 + 14.0D0 * ReducedPLR(RedCapNum)
CondenserInletTemp = EnteringAirWetbulbTempReduced
ENDIF
SELECT CASE (ChillerType)
CASE (TypeOf_Chiller_ElectricEIR)
! Get capacity curve info with respect to CW setpoint and entering condenser temps
ChillerCapFT = CurveValue(CapFTempCurveIndex, EvapOutletTemp,CondenserInletTemp)
ChillerEIRFT = CurveValue(EIRFTempCurveIndex,EvapOutletTemp,CondenserInletTemp)
IF (ReducedPLR(RedCapNum) .GE. MinUnLoadRat) THEN
ChillerEIRFPLR = CurveValue(EIRFPLRCurveIndex,ReducedPLR(RedCapNum))
PartLoadRatio = ReducedPLR(RedCapNum)
ELSE
ChillerEIRFPLR = CurveValue(EIRFPLRCurveIndex,MinUnLoadRat)
PartLoadRatio = MinUnLoadRat
ENDIF
CASE (TypeOf_Chiller_ElectricReformEIR)
Cp = GetSpecificHeatGlycol(PlantLoop(CondLoopNum)%FluidName, &
EnteringWaterTempReduced, &
PlantLoop(CondLoopNum)%FluidIndex, &
'CalcChillerIPLV')
Rho = GetDensityGlycol(PlantLoop(CondLoopNum)%FluidName, &
EnteringWaterTempReduced, &
PlantLoop(CondLoopNum)%FluidIndex, &
'CalcChillerIPLV')
Par(1) = EnteringWaterTempReduced
Par(2) = EvapOutletTemp
Par(3) = Cp
Par(4) = ReducedPLR(RedCapNum)
Par(5) = EvapVolFlowRate * Rho
Par(6) = CapFTempCurveIndex
Par(7) = EIRFTempCurveIndex
Par(8) = EIRFPLRCurveIndex
Par(9) = RefCap
Par(10) = RefCOP
Par(11) = OpenMotorEff
CondenserOutletTemp0 = EnteringWaterTempReduced + 0.1D0
CondenserOutletTemp1 = EnteringWaterTempReduced + 10.0D0
CALL SolveRegulaFalsi(Acc, IterMax, SolFla, CondenserOutletTemp, ReformEIRChillerCondInletTempResidual, &
CondenserOutletTemp0, CondenserOutletTemp1, Par)
IF (SolFla == -1) THEN
CALL ShowWarningError('Iteration limit exceeded in calculating Reform Chiller IPLV')
CALL ShowContinueError('Reformulated Chiller IPLV calculation failed for '// TRIM(ChillerName))
ELSE IF (SolFla == -2) THEN
CALL ShowWarningError('Bad starting values for calculating Reform Chiller IPLV')
CALL ShowContinueError('Reformulated Chiller IPLV calculation failed for '// TRIM(ChillerName))
ENDIF
ChillerCapFT = CurveValue(CapFTempCurveIndex, EvapOutletTemp,CondenserOutletTemp)
ChillerEIRFT = CurveValue(EIRFTempCurveIndex,EvapOutletTemp, CondenserOutletTemp)
IF (ReducedPLR(RedCapNum) .GE. MinUnLoadRat) THEN
ChillerEIRFPLR = CurveValue(EIRFPLRCurveIndex,CondenserOutletTemp, ReducedPLR(RedCapNum))
PartLoadRatio = ReducedPLR(RedCapNum)
ELSE
ChillerEIRFPLR = CurveValue(EIRFPLRCurveIndex,CondenserOutletTemp, MinUnLoadRat)
PartLoadRatio = MinUnLoadRat
ENDIF
CASE DEFAULT
! should not come here, do nothing
END SELECT
! Available chiller capacity as a function of temperature
IF ( RefCap > 0.0d0 .AND. RefCOP > 0.0d0 .AND. ChillerCapFT > 0.0d0 .AND. ChillerEIRFT > 0.0d0) THEN
AvailChillerCap = RefCap * ChillerCapFT
Power = (AvailChillerCap / RefCOP) * ChillerEIRFPLR * ChillerEIRFT
EIR = Power / (PartLoadRatio * AvailChillerCap)
IF (ReducedPLR(RedCapNum) .GE. MinUnLoadRat) THEN
COPReduced = 1.0d0 / EIR
ELSE
LoadFactor = (ReducedPLR(RedCapNum) * RefCap) / (MinUnLoadRat * AvailChillerCap)
DegradationCoeff = 1.130D0 - 0.130D0 * LoadFactor
COPReduced = 1.0d0 / (DegradationCoeff * EIR)
ENDIF
IPLV = IPLV + IPLVWeightingFactor(RedCapNum) * COPReduced
ELSE
SELECT CASE (ChillerType)
CASE (TypeOf_Chiller_ElectricEIR)
CALL ShowWarningError('Chiller:Electric:EIR = '// &
TRIM(ChillerName)//': '//&
' Integrated Part Load Value (IPLV) cannot be calculated.')
CASE (TypeOf_Chiller_ElectricReformEIR)
CALL ShowWarningError('Chiller:Electric:ReformulatedEIR = '// &
TRIM(ChillerName)//': '//&
' Integrated Part Load Value (IPLV) cannot be calculated.')
END SELECT
IF ( RefCap <= 0.0d0) THEN
CALL ShowContinueError(' Check the chiller autosized or user specified capacity. ' &
//'Autosized or specified chiller capacity = '//TRIM(RoundSigDigits(RefCap,2)))
ENDIF
IF ( RefCOP <= 0.0d0) THEN
CALL ShowContinueError(' Check the chiller reference or rated COP specified. ' &
//'Specified COP = '//TRIM(RoundSigDigits(RefCOP,2)))
ENDIF
IF (ChillerCapFT <= 0.0d0) THEN
CALL ShowContinueError(' Check limits in Cooling Capacity Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(CapFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(CapFTempCurveIndex))//'.')
CALL ShowContinueError(' ..ChillerCapFT value at standard test condition = '//TRIM(RoundSigDigits(ChillerCapFT,2)))
END IF
IF (ChillerEIRFT <= 0.0d0) THEN
CALL ShowContinueError(' Check limits in EIR Function of Temperature Curve, ' &
//'Curve Type = '//TRIM(GetCurveType(EIRFTempCurveIndex)) &
//', Curve Name = '//TRIM(GetCurveName(EIRFTempCurveIndex))//'.')
CALL ShowContinueError(' ..ChillerEIRFT value at standard test condition = '//TRIM(RoundSigDigits(ChillerEIRFT,2)))
END IF
IPLV = 0.0d0
EXIT
ENDIF
END DO
! Writes the IPLV value to the EIO file and standard tabular output tables
CALL ReportChillerIPLV( ChillerName, ChillerType, IPLV,IPLV * ConvFromSIToIP)
RETURN
END SUBROUTINE CalcChillerIPLV