SUBROUTINE CalculateTransCompressors(SysNum)
! SUBROUTINE INFORMATION:
! AUTHOR Brian A. Fricke, ORNL
! DATE WRITTEN Fall 2011
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Find the compressor power, energy, capacity, and efficiency for a detailed transcritical CO2
! refrigeration system.
! METHODOLOGY EMPLOYED:
! Use AHRI compressor performance curves for subcritical compressor operation, AHRI-style compressor
! performance curves for transcritical compressor operation, the evaporating temperature of the
! medium- and low-temperature loads, and the gas cooler outlet conditions (temperature, pressure
! and enthalpy).
! REFERENCES:
! ANSI/AHRI. 2004. Standard 540, Standard for Performance Rating of Positive Displacement Refrigerant
! Comprssors and Compressor Units. Arlington, VA: Air-Conditioning, Heating, and Refrigeration
! Institute.
! Ge, Y.T., and S.A. Tassou. 2011. Performance evaluation and optimal design of supermarket refrigeration
! systems with supermarket model "SuperSim", Part I: Model description and validation. International
! Journal of Refrigeration 34: 527-539.
! Ge, Y.T., and S.A. Tassou. 2011. Performance evaluation and optimal design of supermarket refrigeration
! systems with supermarket model "SuperSim", Part II: Model applications. International Journal of
! Refrigeration 34: 540-549.
! Sawalha, S. 2008. Theoretical evaluation of trans-critical CO2 systems in supermarket refrigeration,
! Part I: Modeling, simulation and optimization of two system solutions. International Journal of
! Refrigeration 31: 516-524.
! Sawalha, S. 2008. Theoretical evaluation of trans-critical CO2 systems in supermarket refrigeration,
! Part II: System modifications and comparisons of different solutions. International Journal of
! Refrigeration 31: 525-534.
! USE STATEMENTS:
USE CurveManager, ONLY : CurveValue
!unused USE DataEnvironment, ONLY : OutDryBulbTemp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SysNum
! SUBROUTINE PARAMETER DEFINITIONS:
! Following constants approp for R22, R134a, R404a, R507, R410a, R407c.
! For the same pressure drop, CO2 has a corresponding temperature penalty 5 to 10 times smaller than
! ammonia and R-134a (ASHRAE Handbook of Refrigeration, 2010, p. 3.7). Ignore pressure drop for CO2 calculations.
! NOTE, these DelT...Pipes reflect the decrease in Pressure in the pipes, NOT thermal transfer through the pipe walls.
!REAL(r64), PARAMETER ::DelTSuctPipes = 1.0d0 ! Tsat drop corresponding to P drop in suction pipes, ASHRAE 2006 p 2.4 (C)
!REAL(r64), PARAMETER ::DelTDischPipes = 0.5d0 ! Tsat drop corresponding to P drop in discharge pipes, ASHRAE 2006 p 2.5 (C)
REAL(r64), PARAMETER ::ErrorTol = 0.001d0 ! Iterative solution tolerance
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CompIndex ! Compressor index within system
INTEGER :: CompID ! Compressor index within all compressors
INTEGER :: GasCoolerID ! Gas cooler index for this refrigeration system
INTEGER :: Iter ! Iteration counter
REAL(r64) :: AccumLoadMT = 0.0d0 ! Load due to previously unmet medium temperature compressor loads (transcritical system)
REAL(r64) :: AccumLoadLT = 0.0d0 ! Load due to previously unmet low temperature compressor loads (transcritical system)
REAL(r64) :: CapacityCorrectionLT ! Capacity at existing subcool/superheat over cap at rated conditions for LT loads
REAL(r64) :: CapacityCorrectionMT ! Capacity at existing subcool/superheat over cap at rated conditions for MT loads
REAL(r64) :: CaseEnthalpyChangeRatedMT ! Enthalpy change in medium temperature cases at compressor rated cond, J/kg
REAL(r64) :: CaseEnthalpyChangeRatedLT ! Enthalpy change in low temperature cases at compressor rated cond, J/kg
REAL(r64) :: DensityActualLT ! Density of superheated gas at LP compressor inlet, m3/kg
REAL(r64) :: DensityActualMT ! Density of superheated gas at HP compressor inlet, m3/kg
REAL(r64) :: DensityRatedHP ! Density of high pressure compressor inlet gas at rated superheat, m3/kg
REAL(r64) :: DensityRatedLP ! Density of low pressure compressor inlet gas at rated superheat, m3/kg
REAL(r64) :: HCaseInRatedLT ! Enthalpy entering low temperature cases at rated subcooling, J/kg
REAL(r64) :: HCaseInRatedMT ! Enthalpy entering medium temperature cases at rated subcooling, J/kg
REAL(r64) :: HCaseOutLTMT = 0.0d0 ! Combined enthalpy from the outlets of the LP compressor and MT loads, J/kg
REAL(r64) :: HCompInRatedHP ! Enthalpy entering high pressure compressor at rated superheat, J/kg
REAL(r64) :: HCompInRatedLP ! Enthalpy entering low pressure compressor at rated superheat, J/kg
REAL(r64) :: HGCOutlet ! Enthalpy at gas cooler outlet, J/kg
REAL(R64) :: HIdeal ! Ideal enthalpy at subcooler (for 100% effectiveness)
REAL(r64) :: Hnew ! Calucalted enthalpy, J/kg
REAL(r64) :: HReceiverBypass = 0.0d0 ! Enthalpy at the receiver bypass, J/kg
REAL(r64) :: HsatLiqforTevapNeededMT ! Enthalpy of saturated liquid at MT evaporator, J/kg
REAL(r64) :: HsatVaporforTevapneededMT ! Enthlapy of saturated vapor at MT evaporator (transcritical cycle), J/kg
REAL(r64) :: HsatVaporforTevapneededLT ! Enthlapy of saturated vapor at LT evaporator (transcritical cycle), J/kg
REAL(r64) :: LFLastComp ! Load factor for last compressor dispatched
REAL(r64) :: LocalTimeStep = 0.0d0 ! TimeStepZone for case/walkin systems, TimeStepSys for coil systems
REAL(r64) :: MassCorrectionLT ! Mass flow at existing subcool/superheat over cap at rated conditions for LT loads
REAL(r64) :: MassCorrectionMT ! Mass flow at existing subcool/superheat over cap at rated conditions for MT loads
REAL(r64) :: NeededCapacityLT ! Sum of LT case loads and mech subcooler loads (transcritical cycle), W
REAL(r64) :: NeededCapacityMT ! Sum of MT case loads and mech subcooler loads (transcritical cycle), W
REAL(r64) :: PsuctionLT ! Suction pressure in low temperature cases, Pa
REAL(r64) :: PsuctionMT ! Suction pressure in medium temperature cases, Pa
REAL(r64) :: PGCOutlet ! Gas cooler outlet pressure, Pa
REAL(r64) :: QualityReceiver ! Refrigerant quality in the receiver
REAL(r64) :: SubCoolEffect ! Heat exchanger effectiveness of the subcooler
REAL(r64) :: TempInRatedHP ! Temperature entering high pressure compressor at rated superheat, C
REAL(r64) :: TempInRatedLP ! Temperature entering low pressure compressor at rated superheat, C
REAL(r64) :: TsatforPdisLT ! Low temperature saturated discharge temperature (transcritical cycle), C
REAL(r64) :: TsatforPdisMT ! Medium temperature saturated discharge temperature (transcritical cycle), C
REAL(r64) :: TsatforPsucLT ! Low temperature saturated suction temperature (transcritical cycle), C
REAL(r64) :: TsatforPsucMT ! Medium temperature saturated suction temperature (transcritical cycle), C
REAL(r64) :: TSubCoolerColdIn ! Suction gas temperature at the inlet of the subcooler, C
REAL(r64) :: TotalEnthalpyChangeActualLT ! Actual enthalpy change in LT cases, J/kg
REAL(r64) :: TotalEnthalpyChangeActualMT ! Actual enthalpy change in MT cases, J/kg
REAL(r64) :: TotalRefMassFlow ! Total mass flow through high pressure side of system, kg/s
REAL(r64) :: Xu ! Initial upper guess for iterative search
REAL(r64) :: Xl ! Initial lower guess for iterative search
REAL(r64) :: Xnew ! New guess for iterative search
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
GasCoolerID = TransSystem(SysNum)%GasCoolerNum(1)
! Determine refrigerating capacity needed
AccumLoadLT = 0.0d0
NeededCapacityLT = 0.0d0
IF (TransSystem(SysNum)%TransSysType == 2) THEN
AccumLoadLT = MAX(0.0d0,(TransSystem(SysNum)%UnmetEnergyLT/LocalTimeStep/SecInHour))
NeededCapacityLT = TransSystem(SysNum)%TotalSystemLoadLT + AccumLoadLT + TransSystem(SysNum)%PipeHeatLoadLT
END IF ! (TransSystem(SysNum)%TransSysType == 2)
AccumLoadMT = MAX(0.0d0,(TransSystem(SysNum)%UnmetEnergyMT/LocalTimeStep/SecInHour))
NeededCapacityMT = TransSystem(SysNum)%TotalSystemLoadMT + AccumLoadMT + TransSystem(SysNum)%PipeHeatLoadMT
! Determine refrigerant properties at receiver
TransSystem(SysNum)%CpSatLiqReceiver = &
GetSatSpecificHeatRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TReceiver,&
0.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
HReceiverByPass = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TReceiver, &
1.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
! Determine refrigerant properties at low temperature (LT) loads (if present)
! Dispatch low pressure (LP) compressors as necessary
IF (TransSystem(SysNum)%TransSysType == 2) THEN ! LT side of TwoStage transcritical system
TransSystem(SysNum)%HCaseInLT = TransSystem(SysNum)%HSatLiqReceiver
! TCompInLP and HCompInLP include case superheat plus effect of suction line heat gain
TransSystem(SysNum)%TCompInLP = TransSystem(SysNum)%TEvapNeededLT + TransCaseSuperheat + TransSystem(SysNum)%PipeHeatLoadLT &
/(TransSystem(SysNum)%CpSatVapEvapLT*TransSystem(SysNum)%RefMassFlowtoLTLoads)
TransSystem(SysNum)%HCompInLP = TransSystem(SysNum)%HCaseOutLT + TransSystem(SysNum)%PipeHeatLoadLT &
/TransSystem(SysNum)%RefMassFlowtoLTLoads
TsatforPsucLT = TransSystem(SysNum)%TEvapNeededLT
TsatforPdisLT = TransSystem(SysNum)%TEvapNeededMT
HsatVaporforTevapneededLT = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TEvapNeededLT, &
1.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
HsatLiqforTevapNeededMT = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TEvapNeededMT, &
0.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
PsuctionLT = GetSatPressureRefrig(TransSystem(SysNum)%RefrigerantName,TsatforPsucLT, &
TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
DensityActualLT = GetSupHeatDensityRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TCompInLP, &
PsuctionLT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
TotalEnthalpyChangeActualLT=TransSystem(SysNum)%HCompInLP-TransSystem(SysNum)%HCaseInLT
!Dispatch low pressure (LP) compressors
!Before dispatching LP compressors, zero sum of compressor outputs and zero each compressor
TransSystem(SysNum)%TotCompCapacityLP = 0.d0
TransSystem(SysNum)%RefMassFlowCompsLP = 0.d0
TransSystem(SysNum)%TotCompPowerLP = 0.d0
DO CompIndex=1,TransSystem(SysNum)%NumCompressorsLP
CompID=TransSystem(SysNum)%CompressornumLP(CompIndex)
Compressor(CompID)%Power = 0.d0
Compressor(CompID)%MassFlow = 0.d0
Compressor(CompID)%Capacity = 0.d0
Compressor(CompID)%ElecConsumption = 0.d0
Compressor(CompID)%CoolingEnergy = 0.d0
Compressor(CompID)%LoadFactor = 0.d0
END DO
DO CompIndex=1,TransSystem(SysNum)%NumCompressorsLP
CompID=TransSystem(SysNum)%CompressornumLP(CompIndex)
!need to use indiv compressor's rated subcool and superheat to adjust capacity to actual conditions
SELECT CASE (Compressor(CompID)%SubcoolRatingType)
CASE (RatedSubcooling)
HCaseInRatedLT = HsatLiqforTevapNeededMT - &
TransSystem(SysNum)%CpSatLiqReceiver*Compressor(CompID)%RatedSubcool
CASE (RatedLiquidTemperature) !have rated liquid temperature stored in "RatedSubcool"
HCaseInRatedLT = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Compressor(CompID)%RatedSubcool, &
0.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
END SELECT
SELECT CASE(Compressor(CompID)%SuperheatRatingType)
CASE (RatedSuperheat)
HCompInRatedLP = HsatVaporforTevapneededLT + TransSystem(SysNum)%CpSatVapEvapLT*Compressor(CompID)%RatedSuperheat
TempInRatedLP = TransSystem(Sysnum)%TEvapNeededLT + Compressor(CompID)%RatedSuperheat
CASE (RatedReturnGasTemperature) !have rated compressor inlet temperature stored in "RatedSuperheat"
TempInRatedLP = Compressor(CompID)%RatedSuperheat
HCompInRatedLP = GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Compressor(CompID)%RatedSuperheat, &
PsuctionLT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
END SELECT
CaseEnthalpyChangeRatedLT=HCompInRatedLP-HCaseInRatedLT
DensityRatedLP = GetSupHeatDensityRefrig(TransSystem(SysNum)%RefrigerantName,TempInRatedLP,&
PSuctionLT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
! Adjust capacity and mass flow to reflect the specific volume change due to superheating and
! the increase in capacity due to extra subcooling
MassCorrectionLT = DensityActualLT/DensityRatedLP
CapacityCorrectionLT = MassCorrectionLT*TotalEnthalpyChangeActualLT/CaseEnthalpyChangeRatedLT
Compressor(CompID)%Power = CurveValue(Compressor(CompID)%ElecPowerCurvePtr,TsatforPsucLT,TsatforPdisLT)
Compressor(CompID)%Capacity = CapacityCorrectionLT* &
CurveValue(Compressor(CompID)%CapacityCurvePtr,TsatforPsucLT,TsatforPdisLT)
Compressor(CompID)%MassFlow = Compressor(CompID)%Capacity/TotalEnthalpyChangeActualLT
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = 1.d0
IF ((TransSystem(SysNum)%TotCompCapacityLP + Compressor(CompID)%Capacity) >= NeededCapacityLT) THEN
LFLastComp = (NeededCapacityLT-TransSystem(SysNum)%TotCompCapacityLP)/Compressor(CompID)%Capacity
Compressor(CompID)%Power = LFLastComp*Compressor(CompID)%Power
Compressor(CompID)%MassFlow = LFLastComp*Compressor(CompID)%MassFlow
Compressor(CompID)%Capacity = LFLastComp*Compressor(CompID)%Capacity
TransSystem(SysNum)%TotCompCapacityLP = TransSystem(SysNum)%TotCompCapacityLP + Compressor(CompID)%Capacity
TransSystem(SysNum)%RefMassFlowCompsLP = TransSystem(SysNum)%RefMassFlowCompsLP + Compressor(CompID)%MassFlow
TransSystem(SysNum)%TotCompPowerLP = TransSystem(SysNum)%TotCompPowerLP + Compressor(CompID)%Power
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = LFLastComp
EXIT
ELSE
TransSystem(SysNum)%TotCompCapacityLP = TransSystem(SysNum)%TotCompCapacityLP + Compressor(CompID)%Capacity
TransSystem(SysNum)%RefMassFlowCompsLP = TransSystem(SysNum)%RefMassFlowCompsLP + Compressor(CompID)%MassFlow
TransSystem(SysNum)%TotCompPowerLP = TransSystem(SysNum)%TotCompPowerLP + Compressor(CompID)%Power
END IF
END DO ! NumCompressorsLP
TransSystem(SysNum)%HCompOutLP = TransSystem(SysNum)%HCompInLP + &
TransSystem(SysNum)%TotCompPowerLP/TransSystem(SysNum)%RefMassFlowCompsLP
END IF ! (TransSystem(SysNum)%TransSysType == 2)
! Determine refrigerant properties at medium temperature (MT) loads
! Dispatch high pressure (HP) compressors as necessary
TsatforPsucMT = TransSystem(SysNum)%TEvapNeededMT
IF (GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TransOpFlag) THEN ! Transcritical system is operating in transcritical region
HGCOutlet = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut
ELSE ! Transcritical system is operating in subcritical region
TsatforPdisMT = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TGasCoolerOut
END IF
PsuctionMT = GetSatPressureRefrig(TransSystem(SysNum)%RefrigerantName,TsatforPsucMT, &
TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
PGCOutlet = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%PGasCoolerOut
HsatVaporforTevapneededMT = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TEvapNeededMT, &
1.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculatetransCompressors')
TransSystem(SysNum)%HCaseInMT = TransSystem(SysNum)%HSatLiqReceiver
! Enthalpy of refrigerant after leaving medium temperature loads and low pressure compressors
HCaseOutLTMT = (TransSystem(SysNum)%RefMassFlowtoLTLoads*TransSystem(SysNum)%HCompOutLP + &
TransSystem(SysNum)%RefMassFlowtoMTLoads*TransSystem(SysNum)%HCaseOutMT + TransSystem(SysNum)%PipeHeatLoadMT)/ &
(TransSystem(SysNum)%RefMassFlowtoLTLoads + TransSystem(SysNum)%RefMassFlowtoMTLoads)
! Total refrigerant flow rate is total flow from LT and MT loads divided by (1-x) where x is the quality of the
! refrigerant entering the receiver. The receiver bypass flow rate is (x)*(Total Flow).
! Iterate to find the quality of the refrigerant entering the receiver.
Xu=1.0d0 ! upper bound on quality
Xl=0.0d0 ! lower bound on quality
IF ((GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut + TransSystem(SysNum)%DelHSubCoolerDis) > &
TransSystem(SysNum)%HSatLiqReceiver) THEN
DO Iter=1,15 ! Maximum of 15 iterations to find receiver quality
QualityReceiver=(Xu+Xl)/2.0d0
Hnew = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TReceiver,QualityReceiver, &
TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
! estimated QualityReceiver is too high
IF (Hnew > (GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut + TransSystem(SysNum)%DelHSubCoolerDis)) THEN
Xu=QualityReceiver
ELSE ! estimated QualityReceiver is too low
Xl=QualityReceiver
END IF
IF ( ABS((Hnew-(GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut+ &
TransSystem(SysNum)%DelHSubCoolerDis))/Hnew) < ErrorTol ) EXIT
END DO
TotalRefMassFlow = (TransSystem(SysNum)%RefMassFlowtoLTLoads + TransSystem(SysNum)%RefMassFlowtoMTLoads)/ &
(1.0d0-QualityReceiver)
TransSystem(SysNum)%RefMassFlowReceiverByPass = QualityReceiver*TotalRefMassFlow
ELSE
TransSystem(SysNum)%RefMassFlowReceiverBypass = 0.0d0
TotalRefMassFlow = (TransSystem(SysNum)%RefMassFlowtoLTLoads + TransSystem(SysNum)%RefMassFlowtoMTLoads)
END IF ! %HGasCoolerOut > TransSystem(SysNum)%HSatLiqReceiver)
TransSystem(SysNum)%HCompInHP = (HCaseOutLTMT*(TransSystem(SysNum)%RefMassFlowtoLTLoads + &
TransSystem(SysNum)%RefMassFlowtoMTLoads) + &
HReceiverByPass*TransSystem(SysNum)%RefMassFlowReceiverBypass)/ &
(TransSystem(SysNum)%RefMassFlowtoLTLoads + TransSystem(SysNum)%RefMassFlowtoMTLoads + &
TransSystem(SysNum)%RefMassFlowReceiverBypass)
! Iterate to find the suction temperature entering subcooler
Xl = GetSatTemperatureRefrig(TransSystem(SysNum)%RefrigerantName,PsuctionMT,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalculateTransCompressors')
Xu = Xl + 50.0d0
DO Iter=1,15 ! Maximum of 15 iterations
Xnew=(Xu+Xl)/2.0d0
Hnew=GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Xnew,PsuctionMT,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalculateTransCompressors')
IF (Hnew > TransSystem(SysNum)%HCompInHP) THEN ! xnew is too high
Xu=Xnew
ELSE ! xnew is too low
Xl=Xnew
END IF
IF ( ABS((Hnew-TransSystem(SysNum)%HCompInHP)/Hnew) < ErrorTol ) EXIT
END DO
TSubCoolerColdIn = Xnew
! Modify receiver inlet enthlapy and HP compressor inlet enthalpy to account for subcooler
HIdeal = GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TGasCoolerOut, &
PsuctionMT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
! Only use subcooler if suction gas inlet temperature less than gas cooler outlet temperature
IF(TSubCoolerColdIn < GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TGasCoolerOut) THEN
SubCoolEffect = TransSystem(SysNum)%SCEffectiveness
ELSE
SubCoolEffect = 0.0d0
END IF ! (TSubCoolerColdIn < GasCooler(SysNum)%TGasCoolerOut)
TransSystem(SysNum)%DelHSubcoolerSuc = SubCoolEffect*(HIdeal - TransSystem(SysNum)%HCompInHP)
TransSystem(SysNum)%HCompInHP = TransSystem(SysNum)%HCompInHP + TransSystem(SysNum)%DelHSubcoolerSuc
TransSystem(SysNum)%DelHSubcoolerDis = -TransSystem(SysNum)%DelHSubcoolerSuc
! Iterate to find the temperature at the inlet of the high pressure (HP) compressors
Xl = GetSatTemperatureRefrig(TransSystem(SysNum)%RefrigerantName,PsuctionMT,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalculateTransCompressors')
Xu = Xl + 50.0d0
DO Iter=1,15 ! Maximum of 15 iterations
Xnew=(Xu+Xl)/2.0d0
Hnew=GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Xnew,PsuctionMT,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalculateTransCompressors')
IF (Hnew > TransSystem(SysNum)%HCompInHP) THEN ! xnew is too high
Xu=Xnew
ELSE ! xnew is too low
Xl=Xnew
END IF
IF ( ABS((Hnew-TransSystem(SysNum)%HCompInHP)/Hnew) < ErrorTol ) EXIT
END DO
TransSystem(SysNum)%TCompInHP = Xnew
! For capacity correction of HP compressors, consider subcooler, receiver, MT loads, LT loads and LP compressors
! to constitute the "load". The actual and rated conditions at the exit of the gas cooler and the inlet of the
! HP compressors are used for capacity correction calculations.
DensityActualMT = GetSupHeatDensityRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TCompInHP, &
PsuctionMT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
TotalEnthalpyChangeActualMT=TransSystem(SysNum)%HCompInHP-GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut
!Dispatch HP compressors
!Before dispatching HP compressors, zero sum of compressor outputs and zero each compressor
TransSystem(SysNum)%TotCompCapacityHP = 0.d0
TransSystem(SysNum)%RefMassFlowCompsHP = 0.d0
TransSystem(SysNum)%TotCompPowerHP = 0.d0
DO CompIndex=1,TransSystem(SysNum)%NumCompressorsHP
CompID=TransSystem(SysNum)%CompressornumHP(CompIndex)
Compressor(CompID)%Power = 0.d0
Compressor(CompID)%MassFlow = 0.d0
Compressor(CompID)%Capacity = 0.d0
Compressor(CompID)%ElecConsumption = 0.d0
Compressor(CompID)%CoolingEnergy = 0.d0
Compressor(CompID)%LoadFactor = 0.d0
END DO
! Dispatch High Pressure compressors to meet load, note they were listed in compressor list in dispatch order
DO CompIndex=1,TransSystem(SysNum)%NumCompressorsHP
CompID=TransSystem(SysNum)%CompressornumHP(CompIndex)
! Need to use indiv compressor's rated subcool and superheat to adjust capacity to actual conditions
! Transcritical operation requires rated superheat
! Subcritical operation requires rated subcool and rated superheat
SELECT CASE (Compressor(CompID)%SubcoolRatingType)
CASE (RatedSubcooling)
IF (.NOT.GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TransOpFlag) THEN ! Subcritical operation
HCaseInRatedMT = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut - &
GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%CpGasCoolerOut*Compressor(CompID)%RatedSubcool
ELSE ! Transcritical operation
HCaseInRatedMT = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut
END IF ! (.NOT.GasCooler(SysNum)%TransOpFlag)
CASE (RatedLiquidTemperature) !have rated liquid temperature stored in "RatedSubcool"
IF (.NOT.GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TransOpFlag) THEN ! Subcritical operation
HCaseInRatedMT = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Compressor(CompID)%RatedSubcool, &
0.0d0,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
ELSE ! Transcritical operation
HCaseInRatedMT = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%HGasCoolerOut
END IF ! (.NOT.GasCooler(SysNum)%TransOpFlag)
END SELECT
SELECT CASE(Compressor(CompID)%SuperheatRatingType)
CASE (RatedSuperheat)
HCompInRatedHP = HsatVaporforTevapneededMT + TransSystem(SysNum)%CpSatVapEvapMT*Compressor(CompID)%RatedSuperheat
TempInRatedHP = TransSystem(Sysnum)%TEvapNeededMT + Compressor(CompID)%RatedSuperheat
CASE (RatedReturnGasTemperature) !have rated compressor inlet temperature stored in "RatedSuperheat"
TempInRatedHP = Compressor(CompID)%RatedSuperheat
HCompInRatedHP = GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,Compressor(CompID)%RatedSuperheat, &
PsuctionMT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
END SELECT
CaseEnthalpyChangeRatedMT=HCompInRatedHP-HCaseInRatedMT
DensityRatedHP = GetSupHeatDensityRefrig(TransSystem(SysNum)%RefrigerantName,TempInRatedHP,&
PSuctionMT,TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalculateTransCompressors')
! Adjust capacity and mass flow to reflect the specific volume change due to superheating and
! the increase in capacity due to extra subcooling
MassCorrectionMT = DensityActualMT/DensityRatedHP
CapacityCorrectionMT = MassCorrectionMT*TotalEnthalpyChangeActualMT/CaseEnthalpyChangeRatedMT
IF (GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%TransOpFlag) THEN ! System is operating in transcritical region
Compressor(CompID)%Power = CurveValue(Compressor(CompID)%TransElecPowerCurvePtr,TsatforPsucMT,PGCOutlet)
Compressor(CompID)%Capacity = CapacityCorrectionMT*CurveValue(Compressor(CompID)%TransCapacityCurvePtr, &
TsatforPsucMT,HGCOutlet)
ELSE ! System is operating in subcritical region
Compressor(CompID)%Power = CurveValue(Compressor(CompID)%ElecPowerCurvePtr,TsatforPsucMT,TsatforPdisMT)
Compressor(CompID)%Capacity = CapacityCorrectionMT*CurveValue(Compressor(CompID)%CapacityCurvePtr,TsatforPsucMT,TsatforPdisMT)
END IF ! (GasCooler(SysNum)%TransOpFlag)
! Mass flow through HP compressors is HP compressor refrigerating capacity divided by MT load, LT load and LP compressor power
Compressor(CompID)%MassFlow = TotalRefMassFlow*Compressor(CompID)%Capacity/ &
(NeededCapacityMT + NeededCapacityLT + TransSystem(SysNum)%TotCompPowerLP)
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = 1.d0
! calculate load factor for last compressor addded
! assumes either cycling or part load eff = full load eff for last compressor
IF ((TransSystem(SysNum)%TotCompCapacityHP + Compressor(CompID)%Capacity) >= &
(NeededCapacityMT + NeededCapacityLT + TransSystem(SysNum)%TotCompPowerLP)) THEN
LFLastComp = ((NeededCapacityMT+NeededCapacityLT+TransSystem(SysNum)%TotCompPowerLP) - &
TransSystem(SysNum)%TotCompCapacityHP)/Compressor(CompID)%Capacity
Compressor(CompID)%Power = LFLastComp*Compressor(CompID)%Power
Compressor(CompID)%MassFlow = LFLastComp*Compressor(CompID)%MassFlow
Compressor(CompID)%Capacity = LFLastComp*Compressor(CompID)%Capacity
TransSystem(SysNum)%TotCompCapacityHP = TransSystem(SysNum)%TotCompCapacityHP + Compressor(CompID)%Capacity
TransSystem(SysNum)%RefMassFlowCompsHP = TransSystem(SysNum)%RefMassFlowCompsHP + Compressor(CompID)%MassFlow
TransSystem(SysNum)%TotCompPowerHP = TransSystem(SysNum)%TotCompPowerHP + Compressor(CompID)%Power
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = LFLastComp
EXIT
ELSE
TransSystem(SysNum)%TotCompCapacityHP = TransSystem(SysNum)%TotCompCapacityHP + Compressor(CompID)%Capacity
TransSystem(SysNum)%RefMassFlowCompsHP = TransSystem(SysNum)%RefMassFlowCompsHP + Compressor(CompID)%MassFlow
TransSystem(SysNum)%TotCompPowerHP = TransSystem(SysNum)%TotCompPowerHP + Compressor(CompID)%Power
END IF
END DO ! NumCompressorsHP
TransSystem(SysNum)%HCompOutHP = TransSystem(SysNum)%HCompInHP + &
TransSystem(SysNum)%TotCompPowerHP/TransSystem(SysNum)%RefMassFlowCompsHP
TransSystem(SysNum)%RefMassFlowComps = TransSystem(SysNum)%RefMassFlowCompsLP + TransSystem(SysNum)%RefMassFlowCompsHP
TransSystem(SysNum)%TotCompCapacity = TransSystem(SysNum)%TotCompCapacityHP + TransSystem(SysNum)%TotCompCapacityLP
TransSystem(SysNum)%AverageCompressorCOP = (TransSystem(SysNum)%TotCompCapacityHP-TransSystem(SysNum)%TotCompPowerLP) &
/(TransSystem(SysNum)%TotCompPowerLP+TransSystem(SysNum)%TotCompPowerHP)
TransSystem(SysNum)%TotCompElecConsump = (TransSystem(SysNum)%TotCompPowerLP+TransSystem(SysNum)%TotCompPowerHP) &
* LocalTimeStep * SecInHour
TransSystem(SysNum)%TotCompCoolingEnergy = (TransSystem(SysNum)%TotCompCapacityLP+TransSystem(SysNum)%TotCompCapacityHP) &
* LocalTimeStep * SecInHour
RETURN
END SUBROUTINE CalculateTransCompressors