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 SimulateDetailedTransRefrigSystems
! SUBROUTINE INFORMATION:
! AUTHOR Brian A. Fricke, ORNL
! DATE WRITTEN Fall 2011
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is called to simulate detailed transcritical CO2 refrigeration systems
! METHODOLOGY EMPLOYED:
! Each refrigeration system is modeled by first simulating the attached refrigerated cases and
! walk-ins. The sum of the total heat transfer for all attached cases and walk-ins determines
! the load on the compressors. Iterations are used here to account for sharing of gas coolers
! between independent refrigeration systems.
! REFERENCES:
! na
! USE STATEMENTS:
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: SysNum ! Index to the detailed transcritical refrigeration system being modeled
LOGICAL :: FirstSCLoop =.TRUE. ! Flag first time through multi-system loop used when mech subcoolers present
INTEGER :: StartMechSubcoolLoop = 3 ! if no mechanical subcoolers transfer energy between system, don't loop
INTEGER :: LoopNum = 0 ! Index to overall repeat necessary for mechanical subcoolers
INTEGER :: CaseID = 0 ! Absolute reference to case
INTEGER :: CaseIndex = 0 ! Index to case
INTEGER :: CondInletAirZoneNum= 0 ! Index used to assign zone credits
INTEGER :: SuctionPipeActualZoneNum = 0 ! Index to zone exchanging heat with suction pipes
INTEGER :: WalkInID = 0 ! Absolute reference to WalkIn
INTEGER :: WalkInIndex = 0 ! Index to WalkIn
REAL(r64) :: LocalTimeStep = 0.0d0 ! Set equal to either TimeStepSys or TimeStepZone
REAL(r64) :: CurrentLoads = 0.0d0 ! current loads on compressor, exclusive of unmet loads from prev time steps
REAL(r64) :: SuctionPipeZoneTemp ! Temperature for zone identified as environment for suction pipe heat gains, C
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
! Do transcritical CO2 refrigeration system loop outside of iterative solution to initialize time step and
! calculate case and and walk-ins (that won't change during balance of refrigeration system iterations)
! and prepare initial estimates for the iterative system solution
! TransCritSysFlag = .TRUE.
DO SysNum = 1, NumTransRefrigSystems
!Only do those systems appropriate for this analysis, supermarket type on load time step
IF(TransSystem(SysNum)%NumCasesMT > 0) THEN
DO CaseIndex=1,TransSystem(SysNum)%NumCasesMT
CaseID=TransSystem(Sysnum)%CasenumMT(CaseIndex)
CALL CalculateCase(CaseID)
! TEvapDesignMT calc in Get Input to meet lowest evap temp of any MT load on the system.
! TEvapNeededMT is fixed at this design value.
TransSystem(Sysnum)%TEvapNeededMT=TransSystem(SysNum)%TEvapDesignMT
! increment TotalCoolingLoad for Compressors/gas cooler on each system and defrost gas cooler credits for heat recovery
TransSystem(SysNum)%TotalCoolingLoadMT = TransSystem(SysNum)%TotalCoolingLoadMT + RefrigCase(CaseID)%TotalCoolingLoad
TransSystem(SysNum)%TotalCondDefrostCredit=TransSystem(SysNum)%TotalCondDefrostCredit + &
RefrigCase(CaseID)%HotDefrostCondCredit
END DO !NumCasesMT
END IF !Num of MT cases > 0
IF(TransSystem(SysNum)%NumCasesLT > 0) THEN
DO CaseIndex=1,TransSystem(SysNum)%NumCasesLT
CaseID=TransSystem(Sysnum)%CasenumLT(CaseIndex)
CALL CalculateCase(CaseID)
! TEvapDesignLT calc in Get Input to meet lowest evap temp of any LT load on the system.
! TEvapNeededLT is fixed at this design value.
TransSystem(Sysnum)%TEvapNeededLT=TransSystem(SysNum)%TEvapDesignLT
! increment TotalCoolingLoad for Compressors/gas cooler on each system and defrost gas cooler credits for heat recovery
TransSystem(SysNum)%TotalCoolingLoadLT = TransSystem(SysNum)%TotalCoolingLoadLT + RefrigCase(CaseID)%TotalCoolingLoad
TransSystem(SysNum)%TotalCondDefrostCredit=TransSystem(SysNum)%TotalCondDefrostCredit + &
RefrigCase(CaseID)%HotDefrostCondCredit
END DO !NumCasesLT
END IF !Num of LT cases > 0
IF(TransSystem(SysNum)%NumWalkInsMT > 0) THEN
DO WalkInIndex=1,TransSystem(SysNum)%NumWalkInsMT
WalkInID=TransSystem(Sysnum)%WalkInNumMT(WalkInIndex)
CALL CalculateWalkIn(WalkInID)
! TEvapDesignMT calc in Get Input to meet lowest evap temp of any MT load on the system.
! TEvapNeededMT is fixed at this design value.
TransSystem(Sysnum)%TEvapNeededMT=TransSystem(SysNum)%TEvapDesignMT
! increment TotalCoolingLoad for Compressors/gas cooler on each system
TransSystem(SysNum)%TotalCoolingLoadMT = TransSystem(SysNum)%TotalCoolingLoadMT + WalkIn(WalkInID)%TotalCoolingLoad
TransSystem(SysNum)%TotalCondDefrostCredit=TransSystem(SysNum)%TotalCondDefrostCredit + &
WalkIn(WalkInID)%HotDefrostCondCredit
END DO !NumWalkInsMT systems
END IF !TransSystem(SysNum)%NumWalkInsMT > 0
IF(TransSystem(SysNum)%NumWalkInsLT > 0) THEN
DO WalkInIndex=1,TransSystem(SysNum)%NumWalkInsLT
WalkInID=TransSystem(Sysnum)%WalkInNumLT(WalkInIndex)
CALL CalculateWalkIn(WalkInID)
! TEvapDesignLT calc in Get Input to meet lowest evap temp of any LT load on the system.
! TEvapNeeded is fixed at this design value.
TransSystem(Sysnum)%TEvapNeededLT=TransSystem(SysNum)%TEvapDesignLT
! increment TotalCoolingLoad for Compressors/gas cooler on each system
TransSystem(SysNum)%TotalCoolingLoadLT = TransSystem(SysNum)%TotalCoolingLoadLT + WalkIn(WalkInID)%TotalCoolingLoad
TransSystem(SysNum)%TotalCondDefrostCredit=TransSystem(SysNum)%TotalCondDefrostCredit + &
WalkIn(WalkInID)%HotDefrostCondCredit
END DO !NumWalkInsLT systems
END IF !TransSystem(SysNum)%NumWalkInsLT > 0
!add suction pipe heat gains (W) if input by user
!Suction pipe heat gains aren't included in the reported total system load, but are heat gains that must be met in
! gas cooler and compressor loads.
TransSystem(SysNum)%PipeHeatLoadMT = 0.d0
IF(TransSystem(SysNum)%SumUASuctionPipingMT > mysmallnumber) THEN
SuctionPipeZoneTemp = Node(TransSystem(SysNum)%SuctionPipeZoneNodeNumMT)%Temp
TransSystem(SysNum)%PipeHeatLoadMT = TransSystem(SysNum)%SumUASuctionPipingMT * &
(SuctionPipeZoneTemp - TransSystem(Sysnum)%TEvapNeededMT)
! pipe heat load is a positive number (ie. heat absorbed by pipe, so needs to be subtracted
! from refrigcasecredit (- for cooling zone, + for heating zone)
SuctionPipeActualZoneNum = TransSystem(SysNum)%SuctionPipeActualZoneNumMT
!Can arrive here when load call to refrigeration looks for cases/walkin systems and usetimestep is .false.
IF((.NOT. UseSysTimeStep).AND.((NumSimulationCases > 0).OR.( NumSimulationWalkIns > 0)))THEN
RefrigCaseCredit(SuctionPipeActualZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(SuctionPipeActualZoneNum)%SenCaseCreditToZone - TransSystem(SysNum)%PipeHeatLoadMT
END IF !UseSysTimeStep
END IF
TransSystem(SysNum)%PipeHeatLoadLT = 0.d0
IF(TransSystem(SysNum)%SumUASuctionPipingLT > mysmallnumber) THEN
SuctionPipeZoneTemp = Node(TransSystem(SysNum)%SuctionPipeZoneNodeNumLT)%Temp
TransSystem(SysNum)%PipeHeatLoadLT = TransSystem(SysNum)%SumUASuctionPipingLT * &
(SuctionPipeZoneTemp - TransSystem(Sysnum)%TEvapNeededLT)
! pipe heat load is a positive number (ie. heat absorbed by pipe, so needs to be subtracted
! from refrigcasecredit (- for cooling zone, + for heating zone)
SuctionPipeActualZoneNum = TransSystem(SysNum)%SuctionPipeActualZoneNumLT
!Can arrive here when load call to refrigeration looks for cases/walkin systems and usetimestep is .false.
IF((.NOT. UseSysTimeStep).AND.((NumSimulationCases > 0).OR.( NumSimulationWalkIns > 0)))THEN
RefrigCaseCredit(SuctionPipeActualZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(SuctionPipeActualZoneNum)%SenCaseCreditToZone - TransSystem(SysNum)%PipeHeatLoadLT
END IF !UseSysTimeStep
END IF
END DO ! SysNum
! Need to know if shared gas coolers are present. If so, energy
! transfer between detailed transcritical refrigeration systems
! requires additional iteration at this level.
StartMechSubcoolLoop=3
If (NumSimulationSharedGasCoolers > 0) StartMechSubcoolLoop=1
FirstSCLoop=.TRUE.
Do Loopnum= StartMechSubcoolLoop,3
DO SysNum = 1, NumTransRefrigSystems
!Only do those systems appropriate for this analysis, supermarket type on load time step or coil type on sys time step
!only calc detailed system if have load
TransSystem(SysNum)%TotalSystemLoadMT = TransSystem(SysNum)%TotalCoolingLoadMT
IF (TransSystem(SysNum)%TransSysType == 2) THEN
TransSystem(SysNum)%TotalSystemLoadLT = TransSystem(SysNum)%TotalCoolingLoadLT
END IF
TransSystem(SysNum)%TotalSystemLoad = TransSystem(SysNum)%TotalSystemLoadLT + TransSystem(SysNum)%TotalSystemLoadMT
IF (TransSystem(SysNum)%TotalSystemLoad > 0.d0) THEN
IF (TransSystem(SysNum)%TransSysType == 2) THEN
TransSystem(SysNum)%CpSatVapEvapLT = &
GetSatSpecificHeatRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TEvapNeededLT,&
1.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
TransSystem(SysNum)%HCaseOutLT = &
GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TEvapNeededLT, &
1.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems') + &
TransSystem(SysNum)%CpSatVapEvapLT*TransCaseSuperheat
END IF
TransSystem(SysNum)%CpSatVapEvapMT = &
GetSatSpecificHeatRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TEvapNeededMT,&
1.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
TransSystem(SysNum)%HCaseOutMT = &
GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(Sysnum)%TEvapNeededMT, &
1.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems') + &
TransSystem(SysNum)%CpSatVapEvapMT*TransCaseSuperheat
!Produce first time step estimates.
!Assume no subcoolers and neglect flow through bypass.
TransSystem(SysNum)%TReceiver = GetSatTemperatureRefrig(TransSystem(SysNum)%RefrigerantName, &
TransSystem(SysNum)%PReceiver,TransSystem(SysNum)%RefIndex, &
'SimulateDetailedRefrigerationSystems')
TransSystem(SysNum)%HSatLiqReceiver = &
GetSatEnthalpyRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TReceiver, &
0.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
TransSystem(SysNum)%CpSatLiqReceiver = &
GetSatSpecificHeatRefrig(TransSystem(SysNum)%RefrigerantName,TransSystem(SysNum)%TReceiver,&
0.0d0,TransSystem(SysNum)%RefIndex,'SimulateDetailedRefrigerationSystems')
TransSystem(SysNum)%HCaseInMT = TransSystem(SysNum)%HSatLiqReceiver
TransSystem(SysNum)%HCaseInLT = TransSystem(SysNum)%HSatLiqReceiver
TransSystem(SysNum)%RefMassFlowtoLTLoads=0.0d0
TransSystem(SysNum)%RefMassFlowCompsLP=0.0d0
TransSystem(SysNum)%DelHSubcoolerDis = 0.0d0
TransSystem(SysNum)%DelHSubcoolerSuc = 0.0d0
IF (TransSystem(SysNum)%TransSysType == 2) THEN
TransSystem(SysNum)%RefMassFlowtoLTLoads=TransSystem(SysNum)%TotalSystemLoadLT/ &
(TransSystem(SysNum)%HCaseOutLT-TransSystem(SysNum)%HCaseInLT)
TransSystem(SysNum)%RefMassFlowCompsLP=TransSystem(SysNum)%RefMassFlowtoLTLoads
END IF ! (TransSystem(SysNum)%TransSysType == 2)
TransSystem(SysNum)%RefMassFlowtoMTLoads=TransSystem(SysNum)%TotalSystemLoadMT/ &
(TransSystem(SysNum)%HCaseOutMT-TransSystem(SysNum)%HCaseInMT)
TransSystem(SysNum)%RefMassFlowCompsHP=TransSystem(SysNum)%RefMassFlowtoLTLoads+TransSystem(SysNum)%RefMassFlowtoMTLoads
CALL CalcDetailedTransSystem(SysNum)
! TransCritSysFlag = .FALSE.
END IF !TransSystem(SysNum)%TotalSystemLoad > 0
END DO !Sysnum over NumRefrigSystems
FirstSCLoop=.FALSE.
END DO !Loopnum, three times for buildings with multiple detailed systems connected with shared gas coolers
! Unmet load is done outside iterative loop
DO SysNum = 1, NumTransRefrigSystems
!Only do those systems appropriate for this analysis, supermarket type on load time step or coil type on sys time step
IF((.NOT. UseSysTimeStep) .AND. (.NOT. WarmUpFlag)) THEN
CurrentLoads = TransSystem(SysNum)%TotalSystemLoad
! Meeting current and possibly some portion of the previously unmet energy
! perhaps future interest in reporting percent of installed capacity used(or number of compressors) ?
! If the system compressors were unable to meet the current loads, save energy to be met in succeeding time step
! Note the unmet energy is turned into a rate and applied to the system load at the start of calccompressor
TransSystem(SysNum)%UnmetEnergy=TransSystem(SysNum)%UnmetEnergy + (CurrentLoads - TransSystem(SysNum)%TotCompCapacity)* &
TimeStepZone*SecInHour!
IF (TransSystem(SysNum)%UnmetEnergy > MyLargeNumber) THEN
TransSystem(SysNum)%UnmetEnergy = MyLargeNumber
IF (ShowUnmetEnergyWarningTrans(SysNum)) Then
CALL ShowWarningError('Refrigeration:TranscriticalSystem: '//TRIM(TransSystem(SysNum)%Name))
CALL ShowContinueError(' The specified compressors for this system are unable to meet ')
CALL ShowContinueError(' the sum of the refrigerated case loads and subcooler loads (if any) for this sytem.')
ShowUnmetEnergyWarningTrans(SysNum) = .FALSE.
END IF !show warning
END IF ! > mylarge number
!Zone-located air-cooled gas cooler reject heat also has to be outside iterative loop
IF (TransSystem(SysNum)%SystemRejectHeatToZone) THEN
CondInletAirZoneNum = GasCooler(TransSystem(SysNum)%GasCoolerNum(1))%InletAirZoneNum
!Can arrive here when load call to refrigeration looks for cases/walkin systems and usetimestep is .false.
IF((.NOT. UseSysTimeStep).AND.((NumSimulationCases > 0).OR.( NumSimulationWalkIns > 0)))THEN
RefrigCaseCredit(CondInletAirZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(CondInletAirZoneNum)%SenCaseCreditToZone + &
TransSystem(SysNum)%NetHeatRejectLoad !Adding heat is positive
END IF !UseSystimestep
END IF !Reject heat to zone
! Report variables
TransSystem(SysNum)%PipeHeatEnergy = (TransSystem(SysNum)%PipeHeatLoadMT + TransSystem(SysNum)%PipeHeatLoadLT) &
* LocalTimeStep * SecInHour
TransSystem(SysNum)%TotalCoolingEnergy = (TransSystem(SysNum)%TotalCoolingLoadMT + TransSystem(SysNum)%TotalCoolingLoadMT) &
* LocalTimeStep * SecInHour
END IF !(.NOT. UseSysTimeStep).AND. (.not. warmupflag)
END DO ! Sysnum = 1,NumTransRefrigSystems
! Update for sending to zone equipment manager. (note report variables are summed elsewhere)
CALL SumZoneImpacts
RETURN
END SUBROUTINE SimulateDetailedTransRefrigSystems