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) | :: | SysNum |
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 CalculateCompressors(SysNum)
! SUBROUTINE INFORMATION:
! AUTHOR Therese Stovall, ORNL, Assisted by Hugh Henderson
! DATE WRITTEN Spring 2008
! MODIFIED Brian Fricke, ORNL, March 2012, added two-stage compression
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Find the Compressor power, energy, capacity, and efficiency for a particular detailed
! refrigeration system. Routine is capable of modeling single-stage and two-stage
! compression refrigeration systems.
! METHODOLOGY EMPLOYED:
! USe ARI compressor performance curves, the evaporating temperature and condensing temperature
! REFERENCES:
! "Impact of ASHRAE Standard 62-1989 on Florida Supermarkets",
! Florida Solar Energy Center, FSEC-CR-910-96, Final Report, Oct. 1996
! ARI Standard 540, 2004, Standard for Performance Rating of Positive Displacement Refrigerant
! Comprssors and Compressor Units, Air-Conditionig & Refrigeration Institute,Arlington VA
! USE STATEMENTS:
USE CurveManager, ONLY : CurveValue
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, future allow input?
! May want to allow input to reflect larger pipes selected to reduce delta P and increase compressor efficiency.
!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)
! 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 :: CondID ! Condenser index for this refrigeration system
REAL(r64) :: AccumLoad ! Load due to previously unmet compressor loads
REAL(r64) :: CaseEnthalpyChangeRated ! Enthalpy change in cases at compressor rated cond, J/kg
REAL(r64) :: CapacityCorrection ! Capacity at existing subcool/superheat over cap at rated conditions
REAL(r64) :: CpSatVapCondense ! Specific heat of vapor at cond temp J/kg-C
REAL(r64) :: DensityRated ! Density of inlet gas at rated superheat, m3/kg
REAL(r64) :: DensityActual ! Density of superheated gas at compressor inlet, m3/kg
REAL(r64) :: HCompinRated ! Enthalpy entering compressor at rated superheat, J/kg
REAL(r64) :: HCaseInRated ! Enthalpy entering cases at rated subcooling, J/kg
REAL(r64) :: HSatVapCondense ! Enthalpy of saturated vapor at T condense, J/kg
REAL(r64) :: HsatVaporforTevapneeded ! Enthalpy saturated vapor at temperature needed at evaporator
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) :: MassCorrection ! Mass flow at existing subcool/superheat over cap at rated conditions
REAL(r64) :: NeededCapacity ! Sum of case loads and mech subcooler loads on suction group
REAL(r64) :: Psuction ! Suction Pressure
REAL(r64) :: Pcond ! Condensing pressure
REAL(r64) :: Pevap ! Evaporating pressure
REAL(r64) :: TCompOutEstimate ! Estimated temperature out of the compressor, used to flag whether heat reclaim is reasonable, C
REAL(r64) :: TempInRated ! Temperature entering compressor at rated superheat, C
REAL(r64) :: TotalEnthalpyChangeActual ! Actual enthalpy change in cases and cold side of LSHX, J/kg
REAL(r64) :: TsatforPsuct ! Tsat for Psuction, C
REAL(r64) :: TsatforPdisch ! Tsat for Pdischarge, c
INTEGER :: StageIndex ! Compression stage index
INTEGER :: NumComps ! Number of low-stage or high-stage compressors in system
REAL(r64) :: HHiStageCompIn ! Enthalpy at inlet of high-stage compressor (J/kg)
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
CondID = System(SysNum)%CondenserNum(1)
AccumLoad = MAX(0.d0,(System(SysNum)%UnmetEnergy/LocalTimeStep/SecInHour))
!Before dispatching compressors, zero sum of compressor outputs and zero each compressor
System(SysNum)%TotCompCapacity = 0.d0
System(SysNum)%RefMassFlowComps = 0.d0
System(SysNum)%TotCompPower = 0.d0
IF(System(SysNum)%NumStages==2) THEN
System(SysNum)%TotHiStageCompCapacity = 0.d0
System(SysNum)%RefMassFlowHiStageComps = 0.d0
System(SysNum)%TotHiStageCompPower = 0.d0
END IF
DO CompIndex=1,System(SysNum)%NumCompressors
CompID=System(SysNum)%Compressornum(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
IF(System(SysNum)%NumStages==2) THEN
DO CompIndex=1,System(SysNum)%NumHiStageCompressors
CompID=System(SysNum)%HiStageCompressorNum(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
END IF
! Determine properties at case inlet and compressor inlet
stageloop: DO StageIndex=1,2
IF (StageIndex==2 .AND. System(SysNum)%NumStages==1) THEN
EXIT stageloop ! don't need to do two-stage calculations for a single-stage system
END IF
IF (StageIndex==1) THEN ! Do single-stage or low-stage calculations
IF (System(SysNum)%NumStages==1) THEN ! Single-stage system
NeededCapacity = System(SysNum)%TotalSystemLoad + AccumLoad + &
System(SysNum)%PipeHeatLoad + System(SysNum)%LSHXTrans !because compressor capacity rated from txv to comp inlet
TsatforPdisch = System(Sysnum)%TCondense + DelTDischPipes !need (Psat of (Tcond + delT corresponding to delP disch Pipes))
TsatforPsuct = System(Sysnum)%TEvapNeeded - DelTSuctPipes !need (Psat of (Tevap - delT corresponding to del P suct Pipes))
HsatVaporforTevapneeded = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(Sysnum)%TEvapNeeded, &
1.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%HSatLiqCond = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,0.0d0,&
System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%CpSatLiqCond = GetSatSpecificHeatRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,&
0.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
!HCaseIn is a function of the condenser rated subcooling, not the compressor rated subcooling
!TCompIn needs to include case superheat as well as Temp change from lshx subcoolers
!Calculate both here unless set previously by subcooler subroutine
!HCaseOut corresponds to (tevapneeded + case superheat)
!future - visit how parameter 'casesuperheat' applies when using walk-ins or transfer loads
IF(System(SysNum)%NumSubcoolers == 0) THEN ! No subcooler on this system
System(SysNum)%HCaseIn = System(SysNum)%HSatLiqCond - System(SysNum)%CpSatLiqCond* &
Condenser(System(SysNum)%CondenserNum(1))%RatedSubcool
System(SysNum)%TCompIn = System(SysNum)%TEvapNeeded + CaseSuperheat !+
System(SysNum)%TLiqInActual = System(Sysnum)%TCondense-Condenser(System(Sysnum)%CondenserNum(1))%RatedSubcool
System(SysNum)%HCompIn = System(SysNum)%HCaseOut
ELSE !subcooler subroutine has been called to calc TCompIn and HCaseIn
System(SysNum)%HCompIn = System(SysNum)%HCaseOut + System(SysNum)%CpSatVapEvap * &
(System(SysNum)%TCompIn-(System(Sysnum)%TEvapNeeded+CaseSuperheat))
END IF ! whether or not subcooler routine used
Psuction = GetSatPressureRefrig(System(SysNum)%RefrigerantName,TsatforPsuct, &
System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors')
NumComps = System(SysNum)%NumCompressors
ELSE ! Low-stage side of two-stage system
Pcond = GetSatPressureRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense, &
System(SysNum)%RefIndex, 'RefrigeratedCase:CalculateCompressors')
Pevap = GetSatPressureRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TEvapNeeded, &
System(SysNum)%RefIndex, 'RefrigeratedCase:CalculateCompressors')
System(SysNum)%PIntercooler = SQRT(Pcond*Pevap)
System(SysNum)%TIntercooler = GetSatTemperatureRefrig(System(SysNum)%RefrigerantName,System(SysNum)%PIntercooler, &
System(SysNum)%RefIndex, 'RefrigeratedCase:CalculateCompressors')
NeededCapacity = System(SysNum)%TotalSystemLoad + AccumLoad + &
System(SysNum)%PipeHeatLoad + System(SysNum)%LSHXTrans !because compressor capacity rated from txv to comp inlet
TsatforPdisch = System(SysNum)%TIntercooler + DelTDischPipes !need (Psat of (Tinter + delT corresponding to delP disch Pipes))
TsatforPsuct = System(Sysnum)%TEvapNeeded - DelTSuctPipes !need (Psat of (Tevap - delT corresponding to del P suct Pipes))
HsatVaporforTevapneeded = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(Sysnum)%TEvapNeeded, &
1.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%HSatLiqCond = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,0.0d0,&
System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%CpSatLiqCond = GetSatSpecificHeatRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,&
0.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
!HCaseIn is a function of the condenser rated subcooling, not the compressor rated subcooling
!TCompIn needs to include case superheat as well as Temp change from lshx subcoolers
!Calculate both here unless set previously by subcooler subroutine
!HCaseOut corresponds to (tevapneeded + case superheat)
IF(System(SysNum)%NumSubcoolers == 0) THEN ! No subcooler on this system
IF(System(SysNum)%IntercoolerType==1) THEN ! Flash Intercooler
System(SysNum)%HCaseIn = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TIntercooler,0.0d0,&
System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%TLiqInActual = System(Sysnum)%TIntercooler
ELSE IF(System(SysNum)%IntercoolerType==2) THEN ! Shell-and-Coil Intercooler
System(SysNum)%TLiqInActual = System(SysNum)%TCondense - Condenser(System(Sysnum)%CondenserNum(1))%RatedSubcool- &
System(SysNum)%IntercoolerEffectiveness*(System(SysNum)%TCondense - &
Condenser(System(Sysnum)%CondenserNum(1))%RatedSubcool - System(SysNum)%TIntercooler)
System(SysNum)%HCaseIn = System(SysNum)%HSatLiqCond - System(SysNum)%CpSatLiqCond*(System(SysNum)%TCondense - &
System(SysNum)%TLiqInActual)
END IF ! IntercoolerType
System(SysNum)%TCompIn = System(SysNum)%TEvapNeeded + CaseSuperheat !+
System(SysNum)%HCompIn = System(SysNum)%HCaseOut
ELSE !subcooler subroutine has been called to calc TCompIn and HCaseIn
System(SysNum)%HCompIn = System(SysNum)%HCaseOut + System(SysNum)%CpSatVapEvap * &
(System(SysNum)%TCompIn-(System(Sysnum)%TEvapNeeded+CaseSuperheat))
END IF ! whether or not subcooler routine used
Psuction = GetSatPressureRefrig(System(SysNum)%RefrigerantName,TsatforPsuct, &
System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors')
NumComps = System(SysNum)%NumCompressors
END IF ! NumStages
ELSE ! Two-stage system, high-stage side
NeededCapacity = System(SysNum)%TotalSystemLoad + AccumLoad + &
System(SysNum)%PipeHeatLoad + System(SysNum)%LSHXTrans + System(SysNum)%TotCompPower
TsatforPdisch = System(Sysnum)%TCondense + DelTDischPipes
TsatforPsuct = System(SysNum)%TIntercooler
HsatVaporforTevapneeded = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(Sysnum)%TIntercooler, &
1.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%HSatLiqCond = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,0.0d0,&
System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%CpSatLiqCond = GetSatSpecificHeatRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCondense,&
0.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalculateCompressors')
System(SysNum)%HCaseIn = System(SysNum)%HSatLiqCond - System(SysNum)%CpSatLiqCond* &
Condenser(System(SysNum)%CondenserNum(1))%RatedSubcool
System(SysNum)%TCompIn = System(SysNum)%TIntercooler
! System(SysNum)%TLiqInActual = System(Sysnum)%TCondense-Condenser(System(Sysnum)%CondenserNum(1))%RatedSubcool
System(SysNum)%HCompIn = HsatVaporforTevapneeded
Psuction = GetSatPressureRefrig(System(SysNum)%RefrigerantName,TsatforPsuct, &
System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors')
NumComps = System(SysNum)%NumHiStageCompressors
END IF ! StageIndex
!dispatch compressors to meet load, note they were listed in compressor list in dispatch order
DO CompIndex=1,NumComps
IF (StageIndex==1) THEN
CompID=System(SysNum)%CompressorNum(CompIndex)
ELSE
CompID=System(SysNum)%HiStageCompressorNum(CompIndex)
END IF ! StageIndex
!need to use indiv compressor's rated subcool and superheat to adjust capacity to actual conditions
SELECT CASE (Compressor(CompID)%SubcoolRatingType)
CASE (RatedSubcooling)
IF(System(SysNum)%NumStages==1) THEN ! Single-stage system
HCaseInRated = System(SysNum)%HSatLiqCond - &
System(SysNum)%CpSatLiqCond*Compressor(CompID)%RatedSubcool
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==1) THEN ! Two-stage system, low-stage side
HCaseInRated = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TIntercooler, &
0.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors') - &
System(SysNum)%CpSatLiqCond*Compressor(CompID)%RatedSubcool
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==2) THEN ! Two-stage system, high-stage side
HCaseInRated = System(SysNum)%HSatLiqCond - &
System(SysNum)%CpSatLiqCond*Compressor(CompID)%RatedSubcool
END IF ! NumStages
CASE (RatedLiquidTemperature) !have rated liquid temperature stored in "RatedSubcool"
IF(System(SysNum)%NumStages==1) THEN ! Single-stage system
HCaseInRated = System(SysNum)%HSatLiqCond - &
System(SysNum)%CpSatLiqCond*(System(Sysnum)%TCondense-Compressor(CompID)%RatedSubcool)
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==1) THEN ! Two-stage system, low-stage side
HCaseInRated = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TIntercooler, &
0.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors') - &
System(SysNum)%CpSatLiqCond*(System(Sysnum)%TIntercooler-Compressor(CompID)%RatedSubcool)
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==2) THEN ! Two-stage system, high-stage side
HCaseInRated = System(SysNum)%HSatLiqCond - &
System(SysNum)%CpSatLiqCond*(System(Sysnum)%TCondense-Compressor(CompID)%RatedSubcool)
END IF ! NumStages
END SELECT ! Compressor SubcoolRatingType
SELECT CASE(Compressor(CompID)%SuperheatRatingType)
CASE (RatedSuperheat)
IF(System(SysNum)%NumStages==1) THEN ! Single-stage system
HCompInRated = HsatVaporforTevapneeded + System(SysNum)%CpSatVapEvap*Compressor(CompID)%RatedSuperheat
TempInRated = System(Sysnum)%TEvapNeeded + Compressor(CompID)%RatedSuperheat
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==1) THEN ! Two-stage system, low-stage side
HCompInRated = HsatVaporforTevapneeded + System(SysNum)%CpSatVapEvap*Compressor(CompID)%RatedSuperheat
TempInRated = System(Sysnum)%TEvapNeeded + Compressor(CompID)%RatedSuperheat
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==2) THEN ! Two-stage system, high-stage side
HCompInRated = GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TIntercooler, &
1.0d0,System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors') + &
System(SysNum)%CpSatVapEvap*Compressor(CompID)%RatedSuperheat
TempInRated = System(SysNum)%TIntercooler + Compressor(CompID)%RatedSuperheat
END IF ! NumStages
CASE (RatedReturnGasTemperature) !have rated compressor inlet temperature stored in "RatedSuperheat"
IF(System(SysNum)%NumStages==1) THEN ! Single-stage system
TempInRated = Compressor(CompID)%RatedSuperheat
HCompInRated = HsatVaporforTevapneeded + &
System(SysNum)%CpSatVapEvap*(TempInRated-System(Sysnum)%TEvapNeeded)
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==1) THEN ! Two-stage system, low-stage side
TempInRated = Compressor(CompID)%RatedSuperheat
HCompInRated = HsatVaporforTevapneeded + &
System(SysNum)%CpSatVapEvap*(TempInRated-System(Sysnum)%TEvapNeeded)
ELSE IF(System(SysNum)%NumStages==2 .AND. StageIndex==2) THEN ! Two-stage system, high-stage side
TempInRated = Compressor(CompID)%RatedSuperheat
HCompInRated = HsatVaporforTevapneeded + &
System(SysNum)%CpSatVapEvap*(TempInRated-System(Sysnum)%TIntercooler)
END IF ! NumStages
END SELECT ! Compressor SuperheatRatingType
DensityActual=GetSupHeatDensityRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TCompIn,&
PSuction,System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors')
TotalEnthalpyChangeActual=System(SysNum)%HCompIn-System(SysNum)%HCaseIn
CaseEnthalpyChangeRated=HCompInRated-HCaseInRated
DensityRated=GetSupHeatDensityRefrig(System(SysNum)%RefrigerantName,TempInRated,&
PSuction,System(SysNum)%RefIndex,'RefrigeratedCase:CalcCompressors')
! Adjust capacity and mass flow to reflect the specific volume change due to superheating and
! the increase in capacity due to extra subcooling
MassCorrection = DensityActual/DensityRated
CapacityCorrection = MassCorrection*TotalEnthalpyChangeActual/CaseEnthalpyChangeRated
Compressor(CompID)%Power = CurveValue(Compressor(CompID)%ElecPowerCurvePtr,TsatforPsuct,TsatforPdisch)
Compressor(CompID)%Capacity = CapacityCorrection*CurveValue(Compressor(CompID)%CapacityCurvePtr,TsatforPsuct,TsatforPdisch)
Compressor(CompID)%MassFlow = Compressor(CompID)%Capacity/TotalEnthalpyChangeActual
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 (StageIndex==1) THEN ! Single-stage or low-stage compressors
IF ((System(SysNum)%TotCompCapacity + Compressor(CompID)%Capacity) >= NeededCapacity) THEN
LFLastComp=(NeededCapacity-System(SysNum)%TotCompCapacity)/Compressor(CompID)%Capacity
Compressor(CompID)%Power = LFLastComp*Compressor(CompID)%Power
Compressor(CompID)%MassFlow = LFLastComp*Compressor(CompID)%MassFlow
Compressor(CompID)%Capacity = LFLastComp*Compressor(CompID)%Capacity
System(SysNum)%TotCompCapacity = System(SysNum)%TotCompCapacity + Compressor(CompID)%Capacity
System(SysNum)%RefMassFlowComps = System(SysNum)%RefMassFlowComps + Compressor(CompID)%MassFlow
System(SysNum)%TotCompPower = System(SysNum)%TotCompPower + Compressor(CompID)%Power
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = LFLastComp
EXIT !numcomps do
ELSE !>= needed capacity
System(SysNum)%TotCompCapacity = System(SysNum)%TotCompCapacity + Compressor(CompID)%Capacity
System(SysNum)%RefMassFlowComps = System(SysNum)%RefMassFlowComps + Compressor(CompID)%MassFlow
System(SysNum)%TotCompPower = System(SysNum)%TotCompPower + Compressor(CompID)%Power
END IF !>= needed capacity
ELSE ! high-stage compressors (for two-stage systems only)
IF ((System(SysNum)%TotHiStageCompCapacity + Compressor(CompID)%Capacity) >= &
NeededCapacity) THEN
LFLastComp=(NeededCapacity-System(SysNum)%TotHiStageCompCapacity)/&
Compressor(CompID)%Capacity
Compressor(CompID)%Power = LFLastComp*Compressor(CompID)%Power
Compressor(CompID)%MassFlow = LFLastComp*Compressor(CompID)%MassFlow
Compressor(CompID)%Capacity = LFLastComp*Compressor(CompID)%Capacity
System(SysNum)%TotHiStageCompCapacity = System(SysNum)%TotHiStageCompCapacity + Compressor(CompID)%Capacity
System(SysNum)%RefMassFlowHiStageComps = System(SysNum)%RefMassFlowHiStageComps + &
Compressor(CompID)%MassFlow
System(SysNum)%TotHiStageCompPower = System(SysNum)%TotHiStageCompPower + Compressor(CompID)%Power
System(SysNum)%FlowRatioIntercooler = System(SysNum)%RefMassFlowComps/ &
System(SysNum)%RefMassFlowHiStageComps
Compressor(CompID)%ElecConsumption = Compressor(CompID)%Power * LocalTimeStep * SecInHour
Compressor(CompID)%CoolingEnergy = Compressor(CompID)%Capacity * LocalTimeStep * SecInHour
Compressor(CompID)%LoadFactor = LFLastComp
EXIT !numcomps do
ELSE !>= needed capacity
System(SysNum)%TotHiStageCompCapacity = System(SysNum)%TotHiStageCompCapacity + Compressor(CompID)%Capacity
System(SysNum)%RefMassFlowHiStageComps = System(SysNum)%RefMassFlowHiStageComps + Compressor(CompID)%MassFlow
System(SysNum)%TotHiStageCompPower = System(SysNum)%TotHiStageCompPower + Compressor(CompID)%Power
END IF !>= needed capacity
END IF ! StageIndex
END DO ! NumComps
END DO stageloop ! StageIndex
!Calculate enthalpy at compressor discharge
IF (System(SysNum)%NumStages==1) THEN ! Single-stage or low-stage compressors
System(SysNum)%HCompOut=System(SysNum)%HCompIn + &
System(SysNum)%TotCompPower/System(SysNum)%RefMassFlowComps
!error found 9/19/2011, was System(SysNum)%TotCompPower*LocalTimeStep*SecInHour/System(SysNum)%RefMassFlowComps
ELSE ! High-stage compressors (only for two-stage systems)
HHiStageCompIn=GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(SysNum)%TIntercooler,1.0d0,&
System(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
System(SysNum)%HCompOut=HHiStageCompIn + System(SysNum)%TotHiStageCompPower/System(SysNum)%RefMassFlowHiStageComps
END IF
!Calculate superheat energy available for desuperheaters
HSatVapCondense=GetSatEnthalpyRefrig(System(SysNum)%RefrigerantName,System(Sysnum)%TCondense, &
1.0d0,System(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
CpSatVapCondense=GetSatSpecificHeatRefrig(System(SysNum)%RefrigerantName,System(Sysnum)%TCondense, &
1.0d0,System(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
IF (System(SysNum)%NumStages==1) THEN ! Single-stage systems
HeatReclaimRefrigCondenser(CondID)%AvailCapacity = System(SysNum)%RefMassFlowComps * &
(System(SysNum)%HCompOut - HSatVapCondense)
ELSE ! Two-stage systems
HeatReclaimRefrigCondenser(CondID)%AvailCapacity = System(SysNum)%RefMassFlowHiStageComps * &
(System(SysNum)%HCompOut - HSatVapCondense)
END IF ! NumStages
!No function available to get Tout as f(Pout, Hout), so use estimate based on constant cp in superheat range...
! Use average of Tcondense and Tout of condenser as check for whether heat reclaim is reasonable.
TCompOutEstimate = System(Sysnum)%TCondense + (System(SysNum)%HCompOut - HSatVapCondense)/CpSatVapCondense
HeatReclaimRefrigCondenser(CondID)%AvailTemperature = (TsatforPdisch + TCompOutEstimate)/2.d0
System(SysNum)%AverageCompressorCOP = System(SysNum)%TotCompCapacity/ &
(System(SysNum)%TotCompPower+System(SysNum)%TotHiStageCompPower)
System(SysNum)%TotCompElecConsump = System(SysNum)%TotCompPower * LocalTimeStep * SecInHour
IF(System(SysNum)%NumStages==2)THEN
System(SysNum)%TotHiStageCompElecConsump = System(SysNum)%TotHiStageCompPower * LocalTimeStep * SecInHour
System(SysNum)%TotCompElecConsumpTwoStage = System(SysNum)%TotCompElecConsump + System(SysNum)%TotHiStageCompElecConsump
END IF
System(SysNum)%TotCompCoolingEnergy = System(SysNum)%TotCompCapacity * LocalTimeStep * SecInHour
System(SysNum)%TotHiStageCompCoolingEnergy = System(SysNum)%TotHiStageCompCapacity * LocalTimeStep * SecInHour
RETURN
END SUBROUTINE CalculateCompressors