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) | :: | RackNum |
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 CalcRackSystem(RackNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad, FSEC
! DATE WRITTEN Oct/Nov 2004
! MODIFIED Shirey, FSEC Dec 2004; Hudson, ORNL Feb 2007, July 2007
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Calculate compressor rack load, power, energy consumption, and condenser fan/pump power and consumption
! METHODOLOGY EMPLOYED:
! Loop through cases attached to each rack and determine total load on compressor rack
! REFERENCES:
! "Impact of ASHRAE Standard 62-1989 on Florida Supermarkets",
! Florida Solar Energy Center, FSEC-CR-910-96, Final Report, Oct. 1996
! USE STATEMENTS:
USE CurveManager, ONLY : CurveValue
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW,RhoH2O,PsyWFnTdbTwbPb,PsyTwbFnTdbWPb
USE DataEnvironment, ONLY: OutBaroPress,OutHumRat,OutDryBulbTemp
USE DataHVACGlobals, ONLY: TimeStepSys
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: RackNum
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: CaseID ! Index to absolute case ID
INTEGER :: CaseNum ! Index to refrigerated case attached to rack
!INTEGER :: SecondID ! Index to absolute secondary loop ID
!INTEGER :: SecondIndex ! Index to secondary loop attached to rack
INTEGER :: WalkInID ! Index to absolute walk-in ID
INTEGER :: WalkInIndex ! Index to walk-in attached to rack
INTEGER :: NumCases ! Total number of refrigerated cases attached to rack
REAL(r64) :: COPFTempOutput ! Curve value for COPFTemp curve object
REAL(r64) :: CondenserFrac ! Fraction of condenser power as a function of outdoor temperature
REAL(r64) :: TotalHeatRejectedToZone ! Total compressor and condenser fan heat rejected to zone (based on CaseRAFactor)
INTEGER :: HeatRejectZoneNum ! Index to zone where heat is rejected
INTEGER :: HeatRejectZoneNodeNum ! Index to zone where heat is rejected
REAL(r64) :: OutWbTemp ! Outdoor wet bulb temp at condenser air inlet node [C]
REAL(r64) :: OutDbTemp ! Outdoor dry bulb temp at condenser air inlet node [C]
REAL(r64) :: EffectTemp ! Effective outdoor temp when using evap condenser cooling [C]
REAL(r64) :: HumRatIn ! Humidity ratio of inlet air to condenser [kg/kg]
REAL(r64) :: HumRatOut ! Humidity ratio of outlet air from condenser (assumed saturated) [kg/kg]
REAL(r64) :: BPress ! Barometric pressure at condenser air inlet node [Pa]
LOGICAL :: EvapAvail ! Control for evap condenser availability
REAL(r64) :: LocalTimeStep = 0.0d0 !TimeStepZone for case/walkin systems, TimeStepSys for coil systems
INTEGER :: CoilSetIndex = 0 ! Index to set of coils in a single zone
INTEGER :: CoilSetID = 0 ! Index to set of coils in a single zone (shared inlet and outlet nodes)
INTEGER :: CoilIndex = 0 ! Index to a single air chiller/coil
INTEGER :: CoilID = 0 ! Index to a single air chiller/coil
NumCases = RefrigRack(RackNum)%NumCases
TotalRackDeliveredCapacity = 0.0d0
CompressorCOPactual = 0.0d0
TotalCompressorPower = 0.0d0
TotalCondenserFanPower = 0.0d0
TotalCondenserPumpPower = 0.0d0
TotalBasinHeatPower = 0.0d0
TotalCondenserHeat = 0.0d0
TotalHeatRejectedToZone = 0.0d0
TotalEvapWaterUseRate = 0.0d0
RackSenCreditToZone = 0.0d0
RackSenCreditToHVAC = 0.0d0
CondenserFrac = 0.0d0
EvapAvail = .TRUE.
HeatRejectZoneNum = 0
HeatRejectZoneNodeNum = 0
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
!Loads for chiller sets are set in call to zone equipment element "SimAirChillerSet"
! (all chiller coils within a set are located in the same zone)
! (note non-zone, such as refrigeration, and zone equip, such as airchillersets, called at diff times)
! Loads are then defined for each chiller coil within the set in "CalculateAirChillerSet"
! In that subroutine, dispatch coils within each set in order specified for each zone
! Below will assign loads to refrigeration system or secondary loop
!Note that this routine will go through all refrigeration systems, but loads for multiple systems
! with interactions will not be known for the intitial calls with first HVAC time step. They will,
! however, be repeated when the last chiller set is called from ZoneEquipmentManager
! that's why important where init goes, don't want to zero out data should keep
IF(UseSysTimeStep) THEN
DO CoilSetIndex=1,NumRefrigChillerSets
CoilSetID = CoilSetIndex
CALL CalculateAirChillerSets(CoilSetID)
END DO
END IF
IF(RefrigRack(RackNum)%NumCoils > 0) THEN
DO CoilIndex=1,RefrigRack(RackNum)%NumCoils
CoilID=RefrigRack(RackNum)%CoilNum(CoilIndex)
! already CALLed CalculateCoil(CoilID) in CoilSet specified order
! increment TotalCoolingLoad for Compressors/condenser on each system
TotalRackDeliveredCapacity = TotalRackDeliveredCapacity + WarehouseCoil(CoilID)%TotalCoolingLoad
! System(SysNum)%TotalCondDefrostCredit=System(SysNum)%TotalCondDefrostCredit + WarehouseCoil(CoilID)%HotDefrostCondCredit
END DO !NumCoils systems
END IF !System(SysNum)%NumCoils > 0
IF (NumCases > 0) THEN
DO CaseNum = 1, NumCases
CaseID = RefrigRack(RackNum)%CaseNum(CaseNum)
CALL CalculateCase(CaseID)
! add evaporator load for all cases connected to rack
TotalRackDeliveredCapacity = TotalRackDeliveredCapacity + RefrigCase(CaseID)%TotalCoolingLoad
! sensible and latent case credits already calculated in "CalculateCase"
! Now need to calculate amount of condenser heat rejection that should be applied to zone
! (used when HeatRejectionLocation = LocationZone)
! if walk-ins are served by rack, user must specify heat rejection zone and 100% of heat
! rejection goes to that zone - that is, no heat rejection goes to the HVAC return air
IF (RefrigRack(RackNum)%HeatRejectionLocation == LocationZone) THEN
IF (RefrigRack(RackNum)%NumWalkIns == 0)THEN
TotalHeatRejectedToZone = TotalHeatRejectedToZone + &
RefrigCase(CaseID)%TotalCoolingLoad * (1.0d0 - CaseRAFactor)
! CaseRAFactor is a module variable calculated in CalculateCase
! find zone number of first case on rack (all cases are in the same zone
! if HeatRejectionLocation = LocationZone and no walk-ins)
HeatRejectZoneNum = RefrigCase(RefrigRack(RackNum)%CaseNum(1))%ActualZoneNum
HeatRejectZoneNodeNum = RefrigCase(RefrigRack(RackNum)%CaseNum(1))%ZoneNodeNum
ELSE ! have walk ins so no reduction in condenser heat rejection for caseRA factor
TotalHeatRejectedToZone = TotalHeatRejectedToZone + RefrigCase(CaseID)%TotalCoolingLoad
END IF ! no walk ins
END IF
END DO !NumCases
END IF !Numcases on rack > 0
IF(RefrigRack(RackNum)%NumWalkIns > 0) THEN
DO WalkInIndex=1,RefrigRack(RackNum)%NumWalkIns
WalkInID=RefrigRack(RackNum)%WalkInNum(WalkInIndex)
CALL CalculateWalkIn(WalkInID)
TotalRackDeliveredCapacity = TotalRackDeliveredCapacity + WalkIn(WalkInID)%TotalCoolingLoad
IF (RefrigRack(RackNum)%HeatRejectionLocation == LocationZone) THEN
TotalHeatRejectedToZone = TotalHeatRejectedToZone + WalkIn(WalkInID)%TotalCoolingLoad
HeatRejectZoneNum = RefrigRack(RackNum)%HeatRejectionZoneNum
HeatRejectZoneNodeNum = RefrigRack(RackNum)%HeatRejectionZoneNodeNum
END IF !reject heat to zone
END DO !WalkInIndex
END IF !NumWalkIns>0
IF(RefrigRack(RackNum)%HeatRejectionLocation == LocationZone) THEN
COPFTempOutput = CurveValue(RefrigRack(RackNum)%COPFTempPtr,Node(HeatRejectZoneNodeNum)%Temp)
EvapAvail = .FALSE.
ELSE
IF (RefrigRack(RackNum)%OutsideAirNodeNum /= 0) THEN
OutDbTemp = Node(RefrigRack(RackNum)%OutsideAirNodeNum)%Temp
BPress = Node(RefrigRack(RackNum)%OutsideAirNodeNum)%Press
ELSE
OutDbTemp=OutDryBulbTemp
BPress=OutBaroPress
ENDIF
EffectTemp = OutDbTemp
! IF schedule exists, evap condenser can be scheduled OFF
! Check schedule to determine evap condenser availability
IF(RefrigRack(RackNum)%EvapSchedPtr > 0 .AND. &
GetCurrentScheduleValue(RefrigRack(RackNum)%EvapSchedPtr)== 0) EvapAvail = .FALSE.
! Evaporative condensers will have their water flow shut off in cold months to avoid
! 'spectacular' icing problems. Ideally, the user will use the evaporative schedule input
! to set such a schedule. However, sometimes, users will use a single input deck to model
! one building in multiple climates, and may not think to put in such a schedule in the colder
! climates. To accomodate such applications, the variable EvapCutOutTdb is used as an extra
! check.
IF(OutDbTemp < EvapCutOutTdb)EvapAvail = .FALSE.
IF (RefrigRack(RackNum)%CondenserType==RefrigCondenserTypeEvap .AND. EvapAvail) THEN
! determine temps for evap cooling
IF (RefrigRack(RackNum)%OutsideAirNodeNum /= 0) THEN
HumRatIn = Node(RefrigRack(RackNum)%OutsideAirNodeNum)%HumRat
ELSE
HumRatIn = OutHumRat
ENDIF !outsideairnode
OutWbTemp= PsyTwbFnTdbWPb(OutDbTemp,HumRatIn,BPress)
EffectTemp= OutWbTemp + (1.0d0-RefrigRack(RackNum)%EvapEffect)*(OutDbTemp-OutWbTemp)
END IF !evapAvail
! Obtain water-cooled condenser inlet/outlet temps
IF (RefrigRack(RackNum)%CondenserType==RefrigCondenserTypeWater) THEN
InletNode = RefrigRack(RackNum)%InletNode
OutletNode = RefrigRack(RackNum)%OutletNode
RefrigRack(RackNum)%InletTemp = Node(InletNode)%Temp
EffectTemp = Node(InletNode)%Temp + 5.0d0 ! includes approach temp
IF (RefrigRack(RackNum)%InletTemp < RefrigRack(RackNum)%InletTempMin) THEN
! RefrigRack(RackNum)%LowTempWarn = RefrigRack(RackNum)%LowTempWarn +1
IF (RefrigRack(RackNum)%LowTempWarnIndex == 0) THEN
CALL ShowWarningMessage('Refrigeration:CompressorRack: '//TRIM(RefrigRack(RackNum)%Name))
CALL ShowContinueError('Water-cooled condenser inlet temp lower than minimum allowed temp. '// &
'Check returning water temperature and/or minimum temperature setpoints.')
END IF !LowTempWarnIndex
CALL ShowRecurringWarningErrorAtEnd('Refrigeration Compressor Rack '// TRIM(RefrigRack(RackNum)%Name) // &
' - Condenser inlet temp lower than minimum allowed ... continues',&
RefrigRack(RackNum)%LowTempWarnIndex)
!END IF !LowTempWarn
END IF !InletTempMin
END IF !RefrigCondenserTypeWater
COPFTempOutput = CurveValue(RefrigRack(RackNum)%COPFTempPtr,EffectTemp)
END IF !Location Zone
CompressorCOPactual = RefrigRack(RackNum)%RatedCOP * COPFTempOutput
IF(CompressorCOPactual > 0.0d0) THEN
TotalCompressorPower = TotalRackDeliveredCapacity / CompressorCOPactual
TotalCondenserHeat = TotalCompressorPower + TotalRackDeliveredCapacity
ELSE
IF(ShowCOPWarning(RackNum)) THEN
CALL ShowWarningError('Refrigeration:CompressorRack: '//TRIM(RefrigRack(RackNum)%Name))
CALL ShowContinueError(' The calculated COP has a value of zero or is negative. Refer to Engineering Documentation for')
CALL ShowContinueError(' further explanation of Compressor Rack COP as a Function of Temperature Curve.')
ShowCOPWarning(RackNum) = .FALSE.
END IF
END IF
!calculate condenser fan usage here if not water-cooled; if water-cooled, fan is in separate tower object
! fan loads > 0 only if the connected cases are operating
IF(TotalRackDeliveredCapacity > 0.0d0 .AND. RefrigRack(RackNum)%CondenserType /= RefrigCondenserTypeWater) THEN
IF(RefrigRack(RackNum)%TotCondFTempPtr /= 0) THEN
IF(RefrigRack(RackNum)%HeatRejectionLocation == LocationZone) THEN
CondenserFrac = MAX(0.0d0,MIN(1.0d0,CurveValue(RefrigRack(RackNum)%TotCondFTempPtr, &
Node(HeatRejectZoneNodeNum)%Temp)))
TotalCondenserFanPower = RefrigRack(RackNum)%CondenserFanPower * CondenserFrac
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToZone + &
RefrigRack(RackNum)%CondenserFanPower * CondenserFrac
ELSE
CondenserFrac = MAX(0.0d0,MIN(1.0d0,CurveValue(RefrigRack(RackNum)%TotCondFTempPtr,EffectTemp)))
TotalCondenserFanPower = RefrigRack(RackNum)%CondenserFanPower * CondenserFrac
END IF !location zone
ELSE
CondenserFrac = 1.0d0
TotalCondenserFanPower = RefrigRack(RackNum)%CondenserFanPower * CondenserFrac
END IF !TotCondFTempPtr
END IF !Cooling Water type
! calculate evap water use and water pump power, if applicable
! assumes pump runs whenever evap cooling is available to minimize scaling
IF(RefrigRack(RackNum)%CondenserType==RefrigCondenserTypeEvap .AND. EvapAvail) THEN
TotalCondenserPumpPower = RefrigRack(RackNum)%EvapPumpPower
HumRatOut = PsyWFnTdbTwbPb(EffectTemp,OutWbTemp,BPress)
TotalEvapWaterUseRate = RefrigRack(RackNum)%CondenserAirFlowRate* CondenserFrac * &
PsyRhoAirFnPbTdbW(BPress,OutDbTemp,HumRatIn) * (HumRatOut-HumRatIn) / RhoH2O(EffectTemp)
END IF !evapAvail
! calculate basin water heater load
IF(RefrigRack(RackNum)%CondenserType == RefrigCondenserTypeEvap) THEN
IF ((TotalRackDeliveredCapacity == 0.0d0) .AND. &
(EvapAvail) .AND. &
(OutDbTemp < RefrigRack(RackNum)%BasinHeaterSetPointTemp)) THEN
TotalBasinHeatPower = MAX(0.0d0,RefrigRack(RackNum)%BasinHeaterPowerFTempDiff * &
(RefrigRack(RackNum)%BasinHeaterSetPointTemp - OutDbTemp))
! provide warning if no heater power exists
IF (TotalBasinHeatPower == 0.0d0) THEN
!RefrigRack(RackNum)%EvapFreezeWarn = RefrigRack(RackNum)%EvapFreezeWarn + 1
IF (RefrigRack(RackNum)%EvapFreezeWarnIndex == 0) THEN
CALL ShowWarningMessage('Refrigeration Compressor Rack '// TRIM(RefrigRack(RackNum)%Name) // &
' - Evap cooling of condenser underway with no basin heater power')
CALL ShowContinueError('and condenser inlet air dry-bulb temp at or below the basin heater setpoint temperature.' )
CALL ShowContinueErrorTimeStamp('Continuing simulation.')
END IF !EvapFreezeWarnIndex == 0
CALL ShowRecurringWarningErrorAtEnd('Refrigeration Compressor Rack '// TRIM(RefrigRack(RackNum)%Name) // &
' - Evap cooling of condenser underway with no basin heater power ... continues',&
RefrigRack(RackNum)%EvapFreezeWarnIndex)
!END IF
END IF ! TotalBasinHeatPower == 0 when at outdoor freezing conditions
END IF ! cap
END IF !evap condenser type
! add in compressor and condenser fan power to rack heat rejection variables if the heat rejection location is to the zone
! if walk-ins are served by rack, user must specify heat rejection zone and 100% of heat
! rejection goes to that zone - that is, no condenser heat rejection goes to the HVAC return air
IF (RefrigRack(RackNum)%HeatRejectionLocation == LocationZone) THEN
TotalCondenserHeat = TotalRackDeliveredCapacity + TotalCompressorPower + TotalCondenserFanPower
IF(HeatRejectZoneNum > 0 .AND. TotalRackDeliveredCapacity > 0.0d0) THEN
IF (RefrigRack(RackNum)%NumWalkIns == 0)THEN
! rack report variables for condenser heat to Zone and/or HVAC
! The difference between TotalHeatRejectedToZone and TotalRackDeliveredCapacity is the heat sent to return air
RackSenCreditToZone = TotalCondenserHeat * (TotalHeatRejectedToZone / TotalRackDeliveredCapacity)
RackSenCreditToHVAC = TotalCondenserHeat - RackSenCreditToZone
ELSE ! walkins present and no rack heat rejection goes to return air
RackSenCreditToZone = TotalCondenserHeat
RackSenCreditToHVAC = 0.d0
END IF !walkins present
! Update globals for use in Air Heat Balance and Zone Equipment Manager
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToZone + RackSenCreditToZone
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToHVAC = &
RefrigCaseCredit(HeatRejectZoneNum)%SenCaseCreditToHVAC + RackSenCreditToHVAC
END IF !zone # > 0 and tot del cap > 0
END IF !rack heat rejection to zone
RETURN
END SUBROUTINE CalcRackSystem