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.
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 InitRefrigeration
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN Oct/Nov 2004
! MODIFIED Hudson, ORNL July 2007, Stovall, ORNL, 2008
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Initialize (zero) global variables before simulating compressor racks and refrigerated cases
!
! Several variables in this module are accumulative. For example, unmet compressor loads are carried over
! to the next time step. Ice loads are accumulated until melted by a defrost. Because this module can be
! called multiple times during any single time step, these summations need to be saved ONLY on the last time
! through any given time step.
! It is necessary to decrease the condenser load by the amount of heat used elsewhere
! via desuperheating water heaters and heating coils.
! Because the refrigeration system is solved before the HVAC time step loops, the
! refrigeration system must use the values lagged from the previous time step. In
! terms of energy, this should balance out and is preferable to not making the correction,
! in which case the condenser cooling water/air/fan energy are charged with energy
! loads that have been accounted elsewhere. For consistency, the lagged value must be used,
! even if the Zone time step is repeated. Therefore, the lagged variables are saved
! here for use during successive iterations of same zone/load time step.
! METHODOLOGY EMPLOYED:
! Global variables for Case Credit are located in DataHeatBalance. To Zone variables are used in the Air Heat
! Balance in ZoneTempPredictorCorrector to calculate the zone load. To HVAC variables are used in
! ZoneEquipmentManager to add the portion of case credits attributed to the HVAC system to the zone return air node.
! Because we can't know apriori whether or not the time step will be repeated, we save the most recent
! addition/subtraction to/from each accumulating variable. If the time step is repeated,
! this most recent addition/subtraction is reversed before the rest of the refrigeration simulation begins.
! REFERENCES:
! na
! USE STATEMENTS:
USE DATAHVACGlobals, ONLY : SysTimeElapsed
USE DataGlobals, ONLY : AnyEnergyManagementSystemInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL, SAVE :: MyBeginEnvrnFlag = .TRUE.
INTEGER :: SystemID = 0
INTEGER :: CaseID = 0
INTEGER :: WalkInID = 0
INTEGER :: CoilID = 0
INTEGER :: ICond = 0
INTEGER :: IRack = 0
INTEGER :: SecondID = 0
!Used to adjust accumulative variables when time step is repeated
REAL(r64) :: MyCurrentTime = 0.0d0 ! Used to determine whether the zone time step is a repetition
REAL(r64),SAVE :: MyCurrentTimeSaved = 0.0d0 ! Used to determine whether the zone time step is a repetition
REAL(r64),SAVE :: MyStepStartTime = 0.0d0 ! Used to determine whether the system time step is a repetition
REAL(r64),SAVE :: MyStepStartTimeSaved = 0.0d0 ! Used to determine whether the system time step is a repetition
REAL(r64) :: TimeStepFraction = 0.0d0 ! Used to calculate my current time
! Zero display case, air-coil, and walk-in cooler credits (summed by zone)
! to 0 each zone or sys time step
! These 'casecredit' variables are also used to transfer energy from zone-located
! compressor-rack condenser heat rejection, heat absorption by distribution piping,
! suction piping, and receiver shells to zone
IF (NumOfZones > 0 ) THEN
IF(UseSysTimeStep) THEN
CoilSysCredit%SenCreditToZoneRate = 0.0d0
CoilSysCredit%ReportSenCoolingToZoneRate = 0.0d0
CoilSysCredit%SenCreditToZoneEnergy = 0.0d0
CoilSysCredit%ReportSenCoolingToZoneEnergy = 0.0d0
CoilSysCredit%LatCreditToZoneRate = 0.0d0
CoilSysCredit%ReportLatCreditToZoneRate = 0.0d0
CoilSysCredit%LatCreditToZoneEnergy = 0.0d0
CoilSysCredit%ReportLatCreditToZoneEnergy = 0.0d0
CoilSysCredit%LatKgPerS_ToZoneRate = 0.0d0
CoilSysCredit%ReportH20RemovedKgPerS_FromZoneRate = 0.0d0
CoilSysCredit%ReportTotCoolingToZoneRate = 0.0d0
CoilSysCredit%ReportTotCoolingToZoneEnergy = 0.0d0
END IF !usesystimestep = .true.
!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%SenCaseCreditToZone = 0.0d0
RefrigCaseCredit%LatCaseCreditToZone = 0.0d0
RefrigCaseCredit%SenCaseCreditToHVAC = 0.0d0
RefrigCaseCredit%LatCaseCreditToHVAC = 0.0d0
CaseWIZoneReport%SenCaseCreditToZoneEnergy = 0.0d0
CaseWIZoneReport%LatCoolingToZoneRate = 0.0d0
CaseWIZoneReport%LatCoolingToZoneRate = 0.0d0
CaseWIZoneReport%LatCoolingToZoneEnergy = 0.0d0
CaseWIZoneReport%SenCoolingToZoneRate = 0.0d0
CaseWIZoneReport%SenCoolingToZoneEnergy = 0.0d0
CaseWIZoneReport%HeatingToZoneRate = 0.0d0
CaseWIZoneReport%HeatingToZoneEnergy = 0.0d0
CaseWIZoneReport%TotCoolingToZoneRate = 0.0d0
CaseWIZoneReport%TotCoolingToZoneEnergy = 0.0d0
CaseWIZoneReport%TotHtXferToZoneRate = 0.0d0
CaseWIZoneReport%TotHtXferToZoneEnergy = 0.0d0
ENDIF
ENDIF
IF (NumSimulationCases > 0) THEN
!RefrigCase ALLOCATED to NumSimulationCases
RefrigCase%TotalCoolingLoad = 0.0d0
RefrigCase%TotalCoolingEnergy = 0.0d0
RefrigCase%SensCoolingEnergyRate = 0.0d0
RefrigCase%SensCoolingEnergy = 0.0d0
RefrigCase%LatCoolingEnergyRate = 0.0d0
RefrigCase%LatCoolingEnergy = 0.0d0
RefrigCase%SensZoneCreditRate = 0.d0
RefrigCase%SensZoneCreditCoolRate = 0.0d0
RefrigCase%SensZoneCreditCool = 0.0d0
RefrigCase%SensZoneCreditHeatRate = 0.0d0
RefrigCase%SensZoneCreditHeat = 0.0d0
RefrigCase%LatZoneCreditRate = 0.0d0
RefrigCase%LatZoneCredit = 0.0d0
RefrigCase%SensHVACCreditRate = 0.0d0
RefrigCase%SensHVACCreditCoolRate = 0.0d0
RefrigCase%SensHVACCreditCool = 0.0d0
RefrigCase%SensHVACCreditHeatRate = 0.0d0
RefrigCase%SensHVACCreditHeat = 0.0d0
RefrigCase%LatHVACCreditRate = 0.0d0
RefrigCase%LatHVACCredit = 0.0d0
RefrigCase%ElecFanPower = 0.0d0
RefrigCase%ElecFanConsumption = 0.0d0
RefrigCase%ElecAntiSweatPower = 0.0d0
RefrigCase%ElecAntiSweatConsumption = 0.0d0
RefrigCase%ElecLightingPower = 0.0d0
RefrigCase%ElecLightingConsumption = 0.0d0
RefrigCase%ElecDefrostPower = 0.0d0
RefrigCase%ElecDefrostConsumption = 0.0d0
RefrigCase%DefEnergyCurveValue = 0.0d0
RefrigCase%LatEnergyCurveValue = 0.0d0
RefrigCase%HotDefrostCondCredit = 0.0d0
ENDIF ! NumSimulationCases
IF (NumSimulationWalkIns > 0) THEN
!WalkIn ALLOCATED to NumSimulationWalkIns
WalkIn%HotDefrostCondCredit = 0.0d0
WalkIn%TotalCoolingLoad = 0.0d0
WalkIn%TotalCoolingEnergy = 0.0d0
WalkIn%TotSensCoolingEnergyRate = 0.0d0
WalkIn%TotSensCoolingEnergy = 0.0d0
WalkIn%TotLatCoolingEnergyRate = 0.0d0
WalkIn%TotLatCoolingEnergy = 0.0d0
WalkIn%ElecFanPower = 0.0d0
WalkIn%ElecFanConsumption = 0.0d0
WalkIn%ElecHeaterPower = 0.0d0
WalkIn%ElecHeaterConsumption = 0.0d0
WalkIn%ElecLightingPower = 0.0d0
WalkIn%ElecLightingConsumption = 0.0d0
WalkIn%TotalElecPower = 0.0d0
WalkIn%TotalElecConsumption = 0.0d0
WalkIn%ElecDefrostPower = 0.0d0
WalkIn%ElecDefrostConsumption = 0.0d0
ENDIF
IF (HaveChillers) THEN
!HaveChillers is TRUE when NumSimulationRefrigAirChillers > 0
!WarehouseCoil ALLOCATED to NumSimulationRefrigAirChillers
WarehouseCoil%HotDefrostCondCredit = 0.0d0
WarehouseCoil%TotalCoolingLoad = 0.0d0
WarehouseCoil%TotalCoolingEnergy = 0.0d0
WarehouseCoil%SensCoolingEnergyRate = 0.0d0
WarehouseCoil%SensCoolingEnergy = 0.0d0
WarehouseCoil%SensCreditRate = 0.0d0
WarehouseCoil%LatKgPerS_ToZone = 0.0d0
WarehouseCoil%SensHeatRatio = 0.0d0
WarehouseCoil%LatCreditEnergy = 0.0d0
WarehouseCoil%LatCreditRate = 0.0d0
WarehouseCoil%ElecFanPower = 0.0d0
WarehouseCoil%ElecFanConsumption = 0.0d0
WarehouseCoil%ElecHeaterPower = 0.0d0
WarehouseCoil%ElecHeaterConsumption = 0.0d0
WarehouseCoil%TotalElecPower = 0.0d0
WarehouseCoil%TotalElecConsumption = 0.0d0
WarehouseCoil%ElecDefrostPower = 0.0d0
WarehouseCoil%ElecDefrostConsumption = 0.0d0
WarehouseCoil%ReportTotalCoolCreditRate = 0.0d0
WarehouseCoil%ReportTotalCoolCreditEnergy = 0.0d0
WarehouseCoil%ReportSensCoolCreditRate = 0.d0
WarehouseCoil%ReportHeatingCreditRate = 0.d0
WarehouseCoil%ReportSensCoolCreditEnergy = 0.d0
WarehouseCoil%ReportHeatingCreditEnergy = 0.d0
ENDIF
IF (HaveRefrigRacks) THEN
!HaveRefrigRacks TRUE when NumRefrigeratedRacks > 0
!RefrigRack ALLOCATED to NumRefrigeratedRacks
RefrigRack%SensHVACCreditHeatRate = 0.0d0
RefrigRack%SensHVACCreditHeat = 0.0d0
RefrigRack%SensZoneCreditHeatRate = 0.0d0
RefrigRack%SensZoneCreditHeat = 0.0d0
RefrigRack%CondLoad = 0.0d0
RefrigRack%CondEnergy = 0.0d0
RefrigRack%MassFlowRate = 0.0d0
HeatReclaimRefrigeratedRack%AvailCapacity = 0.0d0
RefrigRack%RackElecConsumption = 0.d0
RefrigRack%CondenserFanConsumption = 0.d0
RefrigRack%EvapPumpConsumption = 0.d0
RefrigRack%RackCompressorPower = 0.d0
RefrigRack%ActualCondenserFanPower = 0.d0
RefrigRack%ActualEvapPumpPower = 0.d0
!Note don't reset basin heat to zero when no load because heater would remain on
!RefrigRack%BasinHeaterPower = 0.d0
!RefrigRack%BasinHeaterConsumption = 0.d0
ENDIF
IF (NumRefrigCondensers > 0) THEN
!Condenser ALLOCATED to NumRefrigCondensers
Condenser%CondLoad = 0.0d0
Condenser%CondEnergy = 0.0d0
Condenser%MassFlowRate = 0.0d0
Condenser%ActualFanPower = 0.0d0
Condenser%FanElecEnergy = 0.0d0
Condenser%EvapWaterConsumpRate = 0.0d0
Condenser%EvapWaterConsumption = 0.0d0
Condenser%ActualEvapPumpPower = 0.0d0
Condenser%EvapPumpConsumption = 0.0d0
Condenser%ExternalHeatRecoveredLoad= 0.0d0
Condenser%ExternalEnergyRecovered = 0.0d0
Condenser%InternalHeatRecoveredLoad= 0.0d0
Condenser%InternalEnergyRecovered = 0.0d0
Condenser%TotalHeatRecoveredLoad = 0.0d0
Condenser%TotalHeatRecoveredEnergy = 0.0d0
! Condenser%LowTempWarn = 0
!N don't reset basin heat to zero when no load because heater would remain on
HeatReclaimRefrigCondenser%AvailCapacity = 0.0d0
HeatReclaimRefrigCondenser%AvailTemperature = 0.0d0
ENDIF
IF (NumSimulationGasCooler > 0) THEN
!GasCooler ALLOCATED to NumSimulationGasCooler
GasCooler%GasCoolerLoad = 0.0d0
GasCooler%GasCoolerEnergy = 0.0d0
GasCooler%ActualFanPower = 0.0d0
GasCooler%FanElecEnergy = 0.0d0
GasCooler%InternalHeatRecoveredLoad = 0.0d0
GasCooler%InternalEnergyRecovered = 0.0d0
GasCooler%TotalHeatRecoveredLoad = 0.0d0
GasCooler%TotalHeatRecoveredEnergy = 0.0d0
ENDIF
IF (NumSimulationCompressors > 0) THEN
!Compressor ALLOCATED to NumSimulationCompressors
Compressor%ElecConsumption = 0.d0
Compressor%Power = 0.d0
ENDIF
IF (HaveDetailedRefrig) THEN
!HaveDetailedRefrig is TRUE when NumRefrigSystems > 0
!System is ALLOCATED to NumRefrigSystems
System%TotalCoolingLoad = 0.0d0
System%TotalCondDefrostCredit = 0.0d0
System%SumSecondaryLoopLoad = 0.0d0
System%SumMechSCBenefit = 0.0d0
System%NetHeatRejectLoad = 0.0d0
System%NetHeatRejectEnergy = 0.0d0
System%AverageCompressorCOP = 0.0d0
System%TotCompCapacity = 0.0d0
System%TotHiStageCompCapacity = 0.0d0
System%TotCompElecConsump = 0.0d0
System%TotHiStageCompElecConsump = 0.0d0
System%TotCompElecConsumpTwoStage = 0.0d0
System%TotCompPower = 0.0d0
System%TotHiStageCompPower = 0.0d0
System%TotCompCoolingEnergy = 0.0d0
System%TotHiStageCompCoolingEnergy = 0.0d0
ENDIF
IF (HaveDetailedTransRefrig) THEN
!HaveDetailedTransRefrig is TRUE when NumTransRefrigSystems > 0
!TransSystem is ALLOCATED to NumTransRefrigSystems
TransSystem%TotalCoolingLoadMT = 0.0d0
TransSystem%TotalCoolingLoadLT = 0.0d0
TransSystem%TotalCondDefrostCredit = 0.0d0
TransSystem%NetHeatRejectLoad = 0.0d0
TransSystem%NetHeatRejectEnergy = 0.0d0
TransSystem%AverageCompressorCOP = 0.0d0
TransSystem%TotCompCapacityHP = 0.0d0
TransSystem%TotCompCapacityLP = 0.0d0
TransSystem%TotCompElecConsump = 0.0d0
TransSystem%TotCompPowerHP = 0.0d0
TransSystem%TotCompPowerLP = 0.0d0
TransSystem%TotCompCoolingEnergy = 0.0d0
ENDIF
IF (NumSimulationSecondarySystems > 0) THEN
!Secondary is ALLOCATED to NumSimulationSecondarySystems
Secondary%TotalCoolingLoad = 0.0d0
Secondary%PumpPowerTotal = 0.0d0
Secondary%PumpElecEnergyTotal = 0.d0
Secondary%ReceiverZoneHeatGain = 0.d0
Secondary%DistPipeZoneHeatGain = 0.d0
ENDIF
!Accumulative and carry-over variables are not zeroed at start of each time step, only at begining of environment
IF(BeginEnvrnFlag .AND. MyBeginEnvrnFlag)THEN
IF (NumSimulationCases > 0) THEN
RefrigCase%DefrostEnergy = 0.0d0
RefrigCase%StockingEnergy = 0.0d0
RefrigCase%WarmEnvEnergy = 0.0d0
RefrigCase%KgFrost = 0.0d0
RefrigCase%StoredEnergy = 0.0d0
ENDIF
IF (NumRefrigSystems > 0) THEN
System%UnmetEnergy = 0.0d0
ENDIF
IF (NumSimulationWalkIns > 0) THEN
WalkIn%KgFrost = 0.0d0
WalkIn%StoredEnergy =0.0d0
DO WalkInID = 1, NumsimulationWalkIns
WalkIn(WalkInID)%IceTemp = WalkIn(WalkInID)%TEvapDesign
END DO
ENDIF
IF (NumSimulationRefrigAirChillers > 0) THEN
WarehouseCoil%KgFrost = 0.0d0
WarehouseCoil%KgFrostSaved = 0.0d0
DO CoilID = 1, NumSimulationRefrigAirChillers
WarehouseCoil(CoilID)%IceTemp = WarehouseCoil(CoilID)%TEvapDesign
WarehouseCoil(CoilID)%IceTempSaved = WarehouseCoil(CoilID)%TEvapDesign
END DO
ENDIF
IF (NumSimulationSecondarySystems > 0) THEN
Secondary%UnMetEnergy = 0.0d0
END IF
IF (NumRefrigeratedRacks > 0) THEN
HeatReclaimRefrigeratedRack%UsedHVACCoil = 0.0d0
HeatReclaimRefrigeratedRack%UsedWaterHeater = 0.0d0
RefrigRack%LaggedUsedWaterHeater = 0.d0
RefrigRack%LaggedUsedHVACCoil = 0.d0
ENDIF
IF (NumRefrigCondensers > 0) THEN
HeatReclaimRefrigCondenser%UsedHVACCoil = 0.0d0
HeatReclaimRefrigCondenser%UsedWaterHeater = 0.0d0
Condenser%LaggedUsedWaterHeater = 0.d0
Condenser%LaggedUsedHVACCoil = 0.d0
ENDIF
DO SystemID=1,NumRefrigSystems
IF (ALLOCATED(System(SystemID)%MechSCLoad))System(SystemID)%MechSCLoad = 0.0d0
System(SystemID)%LSHXTrans = 0.0d0
System(SystemID)%LSHXTransEnergy = 0.0d0
END DO
IF (NumOfTimeStepInHour > 0.0d0) TimeStepFraction=1.0d0/REAL(NumOfTimeStepInHour,r64)
MyBeginEnvrnFlag = .FALSE.
END IF !(BeginEnvrnFlag .AND. MyBeginEnvrnFlag)
IF(.NOT. BeginEnvrnFlag)MyBeginEnvrnFlag = .TRUE.
!Avoid multiplying accumulation if go through zone/load time step more than once.
IF(.NOT. WarmUpFlag)THEN !because no accumulation is done during warm up
!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
MyCurrentTime=(HourOfDay-1)+Timestep*TimeStepFraction
IF(ABS(MyCurrentTime - MyCurrentTimeSaved) < MySmallNumber) THEN
! If the time step is repeated, need to return to correct values at start of time step
IF (NumSimulationCases > 0) THEN
DO CaseID = 1, NumSimulationCases
RefrigCase(CaseID)%DefrostEnergy = RefrigCase(CaseID)%DefrostEnergySaved
RefrigCase(CaseID)%StockingEnergy = RefrigCase(CaseID)%StockingEnergySaved
RefrigCase(CaseID)%WarmEnvEnergy = RefrigCase(CaseID)%WarmEnvEnergySaved
RefrigCase(CaseID)%KgFrost = RefrigCase(CaseID)%KgFrostSaved
RefrigCase(CaseID)%StoredEnergy = RefrigCase(CaseID)%StoredEnergySaved
END DO !caseid
ENDIF !numsimulationcases
IF (NumSimulationWalkIns > 0) THEN
DO WalkInID = 1, NumsimulationWalkIns
WalkIn(WalkInID)%KgFrost = WalkIn(WalkInID)%KgFrostSaved
WalkIn(WalkInID)%StoredEnergy = WalkIn(WalkInID)%StoredEnergySaved
WalkIn(WalkinID)%IceTemp = WalkIn(WalkInID)%IceTempSaved
END DO
ENDIF
IF (NumRefrigSystems > 0) THEN
DO SystemID = 1,NumRefrigSystems
IF(System(SystemID)%CoilFlag)CYCLE
System(SystemID)%UnmetEnergy = System(SystemID)%UnmetEnergySaved
END DO
ENDIF
IF (NumTransRefrigSystems > 0) THEN
DO SystemID = 1,NumTransRefrigSystems
TransSystem(SystemID)%UnmetEnergyMT = TransSystem(SystemID)%UnmetEnergySavedMT
TransSystem(SystemID)%UnmetEnergyLT = TransSystem(SystemID)%UnmetEnergySavedLT
END DO
ENDIF
IF (NumSimulationSecondarySystems > 0) THEN
DO SecondID = 1,NumSimulationSecondarySystems
IF(Secondary(SecondID)%CoilFlag)CYCLE
Secondary(SecondID)%UnMetEnergy = Secondary(SecondID)%UnMetEnergySaved
END DO
END IF
ELSE
! First time through this Zone time step, so set saved values to those in place at start of this time step
MyCurrentTimeSaved=MyCurrentTime
IF (NumSimulationCases > 0) THEN
DO CaseID = 1, NumSimulationCases
RefrigCase(CaseID)%DefrostEnergySaved = RefrigCase(CaseID)%DefrostEnergy
RefrigCase(CaseID)%StockingEnergySaved = RefrigCase(CaseID)%StockingEnergy
RefrigCase(CaseID)%WarmEnvEnergySaved = RefrigCase(CaseID)%WarmEnvEnergy
RefrigCase(CaseID)%KgFrostSaved = RefrigCase(CaseID)%KgFrost
RefrigCase(CaseID)%StoredEnergySaved = RefrigCase(CaseID)%StoredEnergy
END DO !caseid
ENDIF !numsimulationcases
IF (NumSimulationWalkIns > 0) THEN
DO WalkInID = 1, NumsimulationWalkIns
WalkIn(WalkInID)%KgFrostSaved = WalkIn(WalkInID)%KgFrost
WalkIn(WalkInID)%StoredEnergySaved = WalkIn(WalkInID)%StoredEnergy
WalkIn(WalkInID)%IceTempSaved = WalkIn(WalkinID)%IceTemp
END DO
ENDIF
IF (NumRefrigSystems > 0) THEN
DO SystemID = 1,NumRefrigSystems
IF(System(SystemID)%CoilFlag)CYCLE
System(SystemID)%UnmetEnergySaved = System(SystemID)%UnmetEnergy
END DO
ENDIF
IF (NumTransRefrigSystems > 0) THEN
DO SystemID = 1,NumTransRefrigSystems
TransSystem(SystemID)%UnmetEnergySavedMT = TransSystem(SystemID)%UnmetEnergyMT
TransSystem(SystemID)%UnmetEnergySavedLT = TransSystem(SystemID)%UnmetEnergyLT
END DO
ENDIF
IF (NumSimulationSecondarySystems > 0) THEN
DO SecondID = 1,NumSimulationSecondarySystems
IF(Secondary(SecondID)%CoilFlag)CYCLE
Secondary(SecondID)%UnMetEnergySaved = Secondary(SecondID)%UnMetEnergy
END DO
END IF
!Following lagged variables set for consistency to value calculated prev time through HVAC time step loops
IF(ALLOCATED(HeatReclaimRefrigeratedRack)) THEN
DO IRack = 1,NumRefrigeratedRacks
RefrigRack(IRack)%LaggedUsedHVACCoil = HeatReclaimRefrigeratedRack(IRack)%UsedHVACCoil
RefrigRack(IRack)%LaggedUsedWaterHeater = HeatReclaimRefrigeratedRack(IRack)%UsedWaterHeater
END DO
ENDIF
IF (ALLOCATED(HeatReclaimRefrigCondenser)) THEN
DO ICond = 1,NumRefrigCondensers
Condenser(ICond)%LaggedUsedHVACCoil = HeatReclaimRefrigCondenser(ICond)%UsedHVACCoil
Condenser(ICond)%LaggedUsedWaterHeater = HeatReclaimRefrigCondenser(ICond)%UsedWaterHeater
END DO
END IF
END IF !repeating same time step
ELSE ! using UseSysTimeStep as a flag for a chiller system
MyStepStartTime = CurrentTime - TimeStepZone + SysTimeElapsed
IF(ABS(MyStepStartTime - MyStepStartTimeSaved) < MySmallNumber) THEN
! If the time step is repeated, need to return to correct values at start of time step
IF (NumSimulationRefrigAirChillers > 0) THEN
DO CoilID = 1, NumSimulationRefrigAirChillers
WarehouseCoil(CoilID)%KgFrost = WarehouseCoil(CoilID)%KgFrostSaved
WarehouseCoil(CoilID)%IceTemp = WarehouseCoil(CoilID)%IceTempSaved
END DO
ENDIF
ELSE ! First time through this system time step or hvac loop,
! so set saved values to those in place at start of this time step
MyStepStartTimeSaved = MyStepStartTime
IF (NumSimulationRefrigAirChillers > 0) THEN
DO CoilID = 1, NumSimulationRefrigAirChillers
WarehouseCoil(CoilID)%KgFrostSaved = WarehouseCoil(CoilID)%KgFrost
WarehouseCoil(CoilID)%IceTempSaved = WarehouseCoil(CoilID)%IceTemp
END DO
ENDIF
!Following lagged variables set for consistency to value calculated prev time through HVAC time step loops
IF(ALLOCATED(HeatReclaimRefrigeratedRack)) THEN
DO IRack = 1,NumRefrigeratedRacks
RefrigRack(IRack)%LaggedUsedHVACCoil = HeatReclaimRefrigeratedRack(IRack)%UsedHVACCoil
RefrigRack(IRack)%LaggedUsedWaterHeater = HeatReclaimRefrigeratedRack(IRack)%UsedWaterHeater
END DO
ENDIF
IF (ALLOCATED(HeatReclaimRefrigCondenser)) THEN
DO ICond = 1,NumRefrigCondensers
Condenser(ICond)%LaggedUsedHVACCoil = HeatReclaimRefrigCondenser(ICond)%UsedHVACCoil
Condenser(ICond)%LaggedUsedWaterHeater = HeatReclaimRefrigCondenser(ICond)%UsedWaterHeater
END DO
END IF
END IF ! if first time
END IF !(.NOT. UseSysTimeStep)
END IF !warm up flag
IF (AnyEnergyManagementSystemInModel) THEN
IF (NumRefrigSystems > 0) THEN
DO SystemID = 1,NumRefrigSystems
IF (System(SystemID)%EMSOverrideOnTCondenseMin) THEN
System(SystemID)%TCondenseMin = System(SystemID)%EMSOverrideValueTCondenseMin
ELSE
System(SystemID)%TCondenseMin = System(SystemID)%TCondenseMinInput
ENDIF
END DO
ENDIF
ENDIF
RETURN
END SUBROUTINE InitRefrigeration