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.
Initialize this gas cooler for this time step
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 CalcGasCooler(SysNum)
! SUBROUTINE INFORMATION:
! AUTHOR Brian A. Fricke, ORNL
! DATE WRITTEN Fall 2011
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Find the gas cooler outlet temperature, the optimum gas cooler pressure, heat rejection,
! fan power, and fan energy for a detailed transcritical CO2 refrigeration system.
! METHODOLOGY EMPLOYED:
! For a specified gas cooler outlet temperature in transcritical operation, there is an optimal gas cooler
! pressure which produces the highest COP. A curve-fit equation similar to that presented by Ge and Tassou
! (2011) and Sawalha (2008) is used to determine the optimum gas cooler pressure for a given gas cooler
! outlet temperature. In subcritical operation, the condensing temperature and pressure are allowed to
! float with ambient conditions, above the minimum condensing temperature.
! REFERENCES:
! 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 DataEnvironment, ONLY : OutDryBulbTemp
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SysNum
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: GasCoolerCreditWarnIndex ! Warning counter
INTEGER :: GasCoolerID ! Gas cooler number
INTEGER :: Sysloop ! Counter over number of systems attached to this gas cooler
INTEGER :: SystemID ! System number rejecting heat to this gas cooler
REAL(r64) :: ActualFanPower ! Fan power after adjustments for partially loaded gas cooler [W]
REAL(r64) :: AirVolRatio ! Ratio of air volume needed to remove load relative to design load
REAL(r64) :: CapFac ! Capacity factor
REAL(r64) :: FanMinAirFlowRatio ! Minimum fan air flow ratio
REAL(r64) :: FanPowerRatio ! Calculated fan power ratio
REAL(r64) :: LocalTimeStep ! Set equal to either TimeStepSys or TimeStepZone
REAL(r64) :: OutDbTemp ! Outdoor dry bulb temperature at gas cooler air inlet node [C]
REAL(r64) :: RatedFanPower ! Rated fan power for this gas cooler [W]
REAL(r64) :: TotalCondDefCredfromSysID ! Gas cooler defrost credit for single system [W]
REAL(r64) :: TotalCondDefrostCredit ! Total gas cooler credit from hot gas/brine defrost for cases etc. served
! directly by all systems served by this gas cooler [W]
REAL(r64) :: TotalGasCoolerHeat ! Total gas cooler heat from system [W]
REAL(r64) :: TotalLoadFromSysID ! Total heat rejection load from a single detailed system [W]
REAL(r64) :: TotalLoadFromSystems ! Total heat rejection load from all systems served by this condenser [W]
REAL(r64) :: TotalLoadFromThisSystem ! Total heat rejection load from the detailed system identified in subroutine call [W]
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
!!Initialize this gas cooler for this time step
TotalGasCoolerHeat = 0.0d0
AirVolRatio = 1.0d0
ActualFanPower = 0.0d0
TotalCondDefrostCredit = 0.0d0
TotalLoadFromSystems = 0.0d0
GasCoolerID = TransSystem(SysNum)%GasCoolerNum(1)
RatedFanPower = GasCooler(GasCoolerID)%RatedFanPower
FanMinAirFlowRatio = GasCooler(GasCoolerID)%FanMinAirFlowRatio
GasCoolerCreditWarnIndex = GasCooler(GasCoolerID)%GasCoolerCreditWarnIndex
DO Sysloop = 1,GasCooler(GasCoolerID)%NumSysAttach
SystemID = GasCooler(GasCoolerID)%SysNum(Sysloop)
TotalCondDefCredfromSysID = TransSystem(SystemID)%TotalCondDefrostCredit
TotalCondDefrostCredit = TotalCondDefrostCredit + TotalCondDefCredfromSysID
TotalLoadFromSysID = TransSystem(SystemID)%TotalSystemLoadLT + TransSystem(SystemID)%TotalSystemLoadMT + &
TransSystem(SystemID)%TotCompPowerLP + TransSystem(SystemID)%TotCompPowerHP + &
TransSystem(SystemID)%PipeHeatLoadLT + TransSystem(SystemID)%PipeHeatLoadMT
TotalLoadFromSystems = TotalLoadFromSystems + TotalLoadFromSysID
IF(SystemID == SysNum)TotalLoadFromThisSystem = TotalLoadFromSysID
END DO ! Sysloop over every system connected to this gas cooler
! Calculate Total Heat rejection needed.
GasCooler(GasCoolerID)%InternalHeatRecoveredLoad = TotalCondDefrostCredit
GasCooler(GasCoolerID)%TotalHeatRecoveredLoad = TotalCondDefrostCredit
TotalGasCoolerHeat = TotalLoadFromSystems - TotalCondDefrostCredit
IF (TotalGasCoolerHeat < 0.0d0) THEN
TotalGasCoolerHeat = 0.0d0
IF( .not. warmupflag) &
CALL ShowRecurringWarningErrorAtEnd('Refrigeration:TranscriticalSystem: '//TRIM(TransSystem(SysNum)%Name)//&
':heat reclaimed (defrost,other purposes) is greater than current gas cooler load. '//&
'ASHRAE rule of thumb: <= 25% of the load on a system '//&
'should be in defrost at the same time. '//&
'Consider diversifying defrost schedules.',&
GasCoolerCreditWarnIndex)
END IF !total gas cooler heat < 0
!The rated capacity of air-cooled gas cooler was adjusted for elevation in get input step
CapFac = TotalGasCoolerHeat/GasCooler(GasCoolerID)%RatedCapacity
! See whether gas cooler is at ground level or if other air conditions (ie node) have been specified.
! Note that air-cooled gas coolers can draw air from, and reject heat to, a conditioned zone.
IF (GasCooler(GasCoolerID)%InletAirNodeNum /= 0) THEN
OutDbTemp = Node(GasCooler(GasCoolerID)%InletAirNodeNum)%Temp
ELSE
OutDbTemp=OutDryBulbTemp
ENDIF
!
! Determine gas cooler outlet temperature and pressure
! Transcritical: Gas cooler outlet temperature based on ambient temperature and approach temperature.
! Determine optimum gas cooler pressure to maximize COP.
! Subcritical: Allow condensing temperature and pressure to float between minimum condensing temperature and
! transition temperature.
IF (OutDbTemp > GasCooler(GasCoolerID)%TransitionTemperature) THEN ! Gas cooler in transcritical operation
GasCooler(GasCoolerID)%TGasCoolerOut = OutDbTemp + GasCooler(GasCoolerID)%GasCoolerApproachT
GasCooler(GasCoolerID)%PGasCoolerOut = 1.0d5*(2.3083d0*OutDryBulbTemp+11.9d0)
IF (GasCooler(GasCoolerID)%PGasCoolerOut < 7.5d6) THEN ! Ensure gas cooler pressure is at least 7.5 MPa for transcritical operation
GasCooler(GasCoolerID)%PGasCoolerOut = 7.5d6
END IF
GasCooler(GasCoolerID)%HGasCoolerOut = GetSupHeatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%TGasCoolerOut,GasCooler(GasCoolerID)%PGasCoolerOut, &
TransSystem(SysNum)%RefIndex,'RefrigeratedCase:CalcGasCooler')
GasCooler(GasCoolerID)%TransOpFlag = .TRUE.
ELSE ! Gas cooler in subcritical operation
GasCooler(GasCoolerID)%TGasCoolerOut = OutDbTemp + GasCooler(GasCoolerID)%SubcriticalTempDiff
IF (GasCooler(GasCoolerID)%TGasCoolerOut > 30.978d0) THEN ! Gas temperature should be less than critical temperature
GasCooler(GasCoolerID)%PGasCoolerOut = 7.2d6 ! Fix the pressure to be subcritical
GasCooler(GasCoolerID)%TGasCoolerOut = GetSatTemperatureRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%PGasCoolerOut,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalcGasCooler')
ELSE IF (GasCooler(GasCoolerID)%TGasCoolerOut > GasCooler(GasCoolerID)%MinCondTemp) THEN ! Allow condensing temperature to float above the minimum
GasCooler(GasCoolerID)%PGasCoolerOut = GetSatPressureRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%TGasCoolerOut,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalcGasCooler')
ELSE ! Don't allow condensing temperature to drop below minimum
GasCooler(GasCoolerID)%TGasCoolerOut = GasCooler(GasCoolerID)%MinCondTemp
GasCooler(GasCoolerID)%PGasCoolerOut = GetSatPressureRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%TGasCoolerOut,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalcGasCooler')
END IF
GasCooler(GasCoolerID)%HGasCoolerOut = GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%TGasCoolerOut,0.0d0,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalcGasCooler')
GasCooler(GasCoolerID)%TransOpFlag = .FALSE.
END IF ! (OutDbTemp > TransitionTemperature)
IF (GasCooler(GasCoolerID)%TGasCoolerOut < 30.978d0) THEN
GasCooler(GasCoolerID)%CpGasCoolerOut = GetSatSpecificHeatRefrig(TransSystem(SysNum)%RefrigerantName, &
GasCooler(GasCoolerID)%TGasCoolerOut,0.0d0,TransSystem(SysNum)%RefIndex, &
'RefrigeratedCase:CalcGasCooler')
ELSE
GasCooler(GasCoolerID)%CpGasCoolerOut = 0.0d0
END IF
! Gas cooler fan energy calculations
AirVolRatio=MAX(FanMinAirFlowRatio,CapFac**CondAirVolExponentDry) !Fans limited by minimum air flow ratio
SELECT CASE (GasCooler(GasCoolerID)%FanSpeedControlType)
CASE(FanVariableSpeed) !fan power law, adjusted for reality, applies
FanPowerRatio=AirVolRatio**2.5d0
ActualFanPower=FanPowerRatio*RatedFanPower
CASE(FanConstantSpeed)
ActualFanPower=AirVolRatio*EXP(1.d0-AirVolRatio)*RatedFanPower
CASE(FanConstantSpeedLinear)
ActualFanPower=AirVolRatio*RatedFanPower
CASE(FanTwoSpeed)
!low speed setting of 1/2 fan speed can give up to 60% of capacity.
!1/2 speed corresonds to ~1/8 power consumption (FanHalfSpeedRatio = 1/(2**2.5) = 0.1768)
!dampers are used to control flow within those two ranges as in FanConstantSpeed
ActualFanPower=AirVolRatio*EXP(1.d0-AirVolRatio)*RatedFanPower
IF(CapFac < CapFac60Percent) &
ActualFanPower=((AirVolRatio+0.4d0)*(FanHalfSpeedRatio))*EXP(1.d0-AirVolRatio)*RatedFanPower
END SELECT ! fan speed control type
GasCooler(GasCoolerID)%ActualFanPower = ActualFanPower
GasCooler(GasCoolerID)%FanElecEnergy = ActualFanPower * LocalTimeStep * SecInHour
GasCooler(GasCoolerID)%GasCoolerLoad = TotalGasCoolerHeat
GasCooler(GasCoolerID)%GasCoolerEnergy = TotalGasCoolerHeat * LocalTimeStep * SecInHour
GasCooler(GasCoolerID)%GasCoolerCreditWarnIndex = GasCoolerCreditWarnIndex
GasCooler(GasCoolerID)%InternalEnergyRecovered = GasCooler(GasCoolerID)%InternalHeatRecoveredLoad * LocalTimeStep * SecInHour
GasCooler(GasCoolerID)%TotalHeatRecoveredEnergy = GasCooler(GasCoolerID)%TotalHeatRecoveredLoad * LocalTimeStep * SecInHour
TransSystem(SysNum)%NetHeatRejectLoad = TotalGasCoolerHeat*TotalLoadFromThisSystem/TotalLoadFromSystems
TransSystem(SysNum)%NetHeatRejectEnergy = TransSystem(SysNum)%NetHeatRejectLoad * LocalTimeStep * SecInHour
RETURN
END SUBROUTINE CalcGasCooler