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) | :: | SecondaryNum |
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 CalculateSecondary(SecondaryNum)
! SUBROUTINE INFORMATION:
! AUTHOR Therese Stovall, ORNL
! DATE WRITTEN Spring 2009
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Find the total cooling load, pump power, and needed primary refrigerant supply temperature
! for a secondary system.
! METHODOLOGY EMPLOYED:
! Sum the loads for the cases and walk-ins supplied by a secondary loop.
! Calculate the pumping power.
! Assume that the fluid supply and return temperatures are fixed and the
! fluid flow rate is varied to meed the variable load.
! User has been told in IO and Eng ref: for secondary systems/pumps: pump energy is f(viscosity),
! but since specifying Tcircfluid as steady
! state in loop, specify power for fluid and system head/resistance at that temp
!ashrae 2006 p4.1 supports 78% eff for pump impellers
! all power into heat because it would otherwise not be counted in zone
! if use semihermetic motor, also need to add motor ineff as heat
! REFERENCES:
! SCE report
! others
! USE STATEMENTS:
USE CurveManager, ONLY : CurveValue
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW,PsyWFnTdbTwbPb,PsyTwbFnTdbWPb,&
PsyHFnTdbW,PsyTsatFnHPb, PsyWFnTdpPb,PsyHFnTdbRhPb
!unused USE DataWater, ONLY: WaterStorage
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: SecondaryNum
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER ::ErrorTol = 0.001d0 !Iterative solution tolerance
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
LOGICAL :: AtPartLoad ! Whether or not need to iterate on pump power
LOGICAL :: DeRate ! If true, need to derate aircoils because don't carry over unmet energy
Integer :: CaseID ! used in summing case loads on loop
Integer :: CaseNum ! used in summing case loads on loop
Integer :: CoilID ! used in summing coil loads on loop
Integer :: CoilIndex ! used in summing coil loads on loop
Integer :: DistPipeZoneNum ! used to assign case credit to zone
Integer :: Iter ! loop counter
Integer :: NumPumps ! number of pumps (or stages if used to approx var speed) on loop
Integer :: PumpID ! loop counter
Integer :: ReceiverZoneNum ! used to assign case credit it zone
Integer :: WalkInID ! used in summing walk-in loads on loop
Integer :: WalkInIndex ! used in summing walk-in loads on loop
Integer :: ZoneNodeNum ! used to establish environmental temperature for dist piping heat gains
REAL(r64) :: CpBrine ! Specific heat (W/kg)
REAL(r64) :: CircRatio ! Per ASHRAE definition = mass flow at pump/mass flow to condenser
REAL(r64) :: DensityBrine ! Density (kg/m3)
REAL(r64) :: DiffTemp ! (C)
REAL(r64) :: DistPipeHeatGain ! Optional (W)
REAL(r64) :: Error ! Used in iterative soln for pumps needed to meet load (that has to include pump energy)
REAL(r64) :: Eta ! Secondary loop heat exchanger eta, dimensionless
REAL(r64) :: FlowVolNeeded ! Flow rate needed to meet load (m3/s)
REAL(r64) :: LoadRequested =0.0d0 ! Load necessary to meet current and all stored energy needs (W)
REAL(r64) :: LocalTimeStep = 0.0d0 !TimeStepZone for case/walkin systems, TimeStepSys for coil systems
REAL(r64) :: MaxLoad ! Secondary loop capacity can be limited by heat exchanger or pumps (W)
REAL(r64) :: MaxVolFlow ! Flow can be limited by either total pump capacity or heat exchanger design (m3/s)
REAL(r64) :: PartLdFrac ! Used to ratio pump power
REAL(r64) :: PartPumpFrac ! Used to see if part pumps dispatched meets part pump load
!REAL(r64) :: PartPower ! Used to ratio power for last pump added to loop
REAL(r64) :: PrevTotalLoad ! Used in pump energy convergence test
REAL(r64) :: ReceiverHeatGain ! Optional (W)
REAL(r64) :: RefrigerationLoad ! Load for cases and walk-ins served by loop, does not include pump energy (W)
REAL(r64) :: StoredEnergyRate ! Used to meet loads unmet in previous time step (related to defrost cycles
! on cases/walk-ins served)(W)
REAL(r64) :: TBrineAverage ! (C)
REAL(r64) :: TBrineIn ! Brine temperature going to heat exchanger, C
REAL(r64) :: TCondense ! Condensing temperature for a phase change secondary loop, C
REAL(r64) :: TEvap ! Evaporating temperature in secondary loop heat exchanger (C)
REAL(r64) :: TotalCoolingLoad ! Cooling load reported back to compressor rack or detailed system (W)
REAL(r64) :: TotalHotDefrostCondCredit ! Used to credit condenser when heat reclaim used for hot gas/brine defrost (W)
REAL(r64) :: TotalPumpPower ! Total Pumping power for loop, W
REAL(r64) :: TotalLoad ! Total Cooling Load on secondary loop, W
REAL(r64) :: TPipesReceiver ! Temperature used for contents of pipes and/or receiver in calculating shell losses (C)
REAL(r64) :: VarFrac ! Pump power fraction for variable speed pump, dimensionless
REAL(r64) :: VolFlowRate ! Used in dispatching pumps to meet load (m3/s)
REAL(r64) :: UnmetEnergy ! Cumulative, grows and shrinks with defrost cycles on loads served by loop (J)
LocalTimeStep = TimeStepZone
IF(UseSysTimeStep) LocalTimeStep = TimeStepSys
NumPumps = Secondary(SecondaryNum)%NumPumps
TEvap = Secondary(SecondaryNum)%TEvapDesign
MaxVolFlow = Secondary(SecondaryNum)%MaxVolFlow
MaxLoad = Secondary(SecondaryNum)%MaxLoad
UnMetEnergy = Secondary(SecondaryNum)%UnMetEnergy
SELECT CASE (Secondary(SecondaryNum)%FluidType)
CASE(SecFluidTypeAlwaysLiquid)
CpBrine = Secondary(SecondaryNum)%CpBrineRated
DensityBrine = Secondary(SecondaryNum)%DensityBrineRated
Eta = Secondary(SecondaryNum)%HeatExchangeEta
TBrineAverage= Secondary(SecondaryNum)%TBrineAverage
TBrineIn = Secondary(SecondaryNum)%TBrineInRated
TPipesReceiver = TBrineAverage
CASE(SecFluidTypePhaseChange)
CircRatio = Secondary(SecondaryNum)%CircRate
TCondense = Secondary(SecondaryNum)%TCondense
TPipesReceiver = TCondense
END SELECT ! Fluid type
!Initialize this secondary for this time step
TotalLoad = 0.0d0
TotalPumpPower = 0.0d0
RefrigerationLoad = 0.0d0
TotalHotDefrostCondCredit = 0.0d0
FlowVolNeeded = 0.0d0
DeRate = .FALSE.
!SCE page 28 gives a delta T for pipe heat gains
! (.25F each for supply and discharge) for use with mdot*cp.
! However, another author shows this as a major diff between dx and secondary
! So - allow the user to include this in his total load, even though he has to do
! most of the calculations before the input (to get to SumUADistPiping)).
DistPipeHeatGain = 0.0d0
IF (Secondary(SecondaryNum)%SumUADistPiping > mysmallnumber) THEN
ZoneNodeNum = Secondary(SecondaryNum)%DistPipeZoneNodeNum
DiffTemp = Node(ZoneNodeNum)%Temp - TPipesReceiver
DistPipeHeatGain = DiffTemp * Secondary(SecondaryNum)%SumUADistPiping
DistPipeZoneNum = Secondary(SecondaryNum)%DistPipeZoneNum
! 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)
Secondary(SecondaryNum)%DistPipeZoneHeatGain = - DistPipeHeatGain
RefrigCaseCredit(DistPipeZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(DistPipeZoneNum)%SenCaseCreditToZone - DistPipeHeatGain
END IF !calc distribution piping heat gains
ReceiverHeatGain = 0.0d0
IF (Secondary(SecondaryNum)%SumUAReceiver > mysmallnumber) THEN
ZoneNodeNum = Secondary(SecondaryNum)%ReceiverZoneNodeNum
DiffTemp = Node(ZoneNodeNum)%Temp - TPipesReceiver
ReceiverHeatGain = DiffTemp * Secondary(SecondaryNum)%SumUAReceiver
ReceiverZoneNum = Secondary(SecondaryNum)%ReceiverZoneNum
! receiver heat load is a positive number (ie. heat absorbed by receiver, so needs to be subtracted
! from refrigcasecredit (- for cooling zone, + for heating zone)
Secondary(SecondaryNum)%ReceiverZoneHeatGain = - ReceiverHeatGain
RefrigCaseCredit(ReceiverZoneNum)%SenCaseCreditToZone = &
RefrigCaseCredit(ReceiverZoneNum)%SenCaseCreditToZone - ReceiverHeatGain
END IF !calc receiver heat gains
!Sum up all the case and walk-in loads served by the secondary loop
IF(Secondary(SecondaryNum)%NumCases > 0) THEN
DO CaseNum = 1, Secondary(SecondaryNum)%NumCases
CaseID = Secondary(SecondaryNum)%CaseNum(CaseNum)
CALL CalculateCase(CaseID)
! increment TotalCoolingLoad Hot gas/brine defrost credits for each secondary loop
RefrigerationLoad = RefrigerationLoad + RefrigCase(CaseID)%TotalCoolingLoad
TotalHotDefrostCondCredit = TotalHotDefrostCondCredit + RefrigCase(CaseID)%HotDefrostCondCredit
END DO !CaseNum
END IF !NumCases > 0
IF(Secondary(SecondaryNum)%NumWalkIns > 0) THEN
DO WalkInIndex=1,Secondary(SecondaryNum)%NumWalkIns
WalkInID=Secondary(SecondaryNum)%WalkInNum(WalkInIndex)
CALL CalculateWalkIn(WalkInID)
! increment TotalCoolingLoad for each system
RefrigerationLoad = RefrigerationLoad + WalkIn(WalkInID)%TotalCoolingLoad
TotalHotDefrostCondCredit = TotalHotDefrostCondCredit + WalkIn(WalkInID)%HotDefrostCondCredit
END DO !NumWalkIns systems
END IF !Secondary(SecondaryNum)%NumWalkIns > 0
IF(Secondary(SecondaryNum)%NumCoils > 0) THEN
DO CoilIndex=1,Secondary(SecondaryNum)%NumCoils
CoilID=Secondary(SecondaryNum)%CoilNum(CoilIndex)
! already CALL CalculateCoil(CoilID) for each coil, dispatched in coilset order for each zone
! increment TotalCoolingLoad for each system
! here will find out if secondary can serve total load, if not will derate coil outout/case credits
RefrigerationLoad = RefrigerationLoad + WarehouseCoil(CoilID)%TotalCoolingLoad
TotalHotDefrostCondCredit = TotalHotDefrostCondCredit + WarehouseCoil(CoilID)%HotDefrostCondCredit
END DO !NumCoils on seocndary system
END IF !Secondary(SecondaryNum)%NumCoils > 0
TotalLoad = RefrigerationLoad + DistPipeHeatGain + ReceiverHeatGain
AtPartLoad = .TRUE.
!Check to see if load is already >+ maxload without pump heat
IF(Secondary(SecondaryNum)%FluidType == SecFluidTypeAlwaysLiquid) THEN !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
FlowVolNeeded = TotalLoad/eta/(cpBrine*DensityBrine*(TBrineIn - TEvap))
! For brine/glycol systems, find flow volume needed to meet load
! Per ashrae 2006, p4.1, eval mass flow rate to pump at brine return (to chiller) temp
! because pumps located in return piping
IF(FlowVolNeeded >= MaxVolFlow) THEN
!Don't need to iterate on pumps, just set to max. Will have unmet load this time step (unless coils present)
VolFlowRate = MaxVolFlow
TotalPumpPower = Secondary(SecondaryNum)%PumpTotRatedPower
TotalLoad = TotalLoad + TotalPumpPower*Secondary(SecondaryNum)%PumpPowertoHeat
AtPartLoad = .FALSE.
IF(Secondary(SecondaryNum)%NumCoils > 0) DeRate = .TRUE.
END IF !flowvolneeded >= maxvolflow
ELSE ! have SecFluidTypePhaseChange !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
IF(TotalLoad >= MaxLoad) THEN
TotalPumpPower = Secondary(SecondaryNum)%PumpTotRatedPower
TotalLoad = TotalLoad + TotalPumpPower*Secondary(SecondaryNum)%PumpPowertoHeat
VolFlowRate = MaxVolFlow
AtPartLoad = .FALSE.
IF(Secondary(SecondaryNum)%NumCoils > 0)DeRate = .TRUE.
END IF
END IF !fluid type check for max load or max flow >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
! If totalLoad < maxload, then need to calculate partial pump load
! Need an iterative soln for pump energy needed to meet total load
! because that total load has to include pump energy
IF(AtPartLoad) THEN
DO Iter=1,10
IF(TotalLoad<=0.0d0) THEN
! Load on secondary loop is zero (or negative).
! Set volumetric flow rate and pump power to be zero.
VolFlowRate=0.0d0
TotalPumpPower=0.0d0
EXIT
END IF
PrevTotalLoad = TotalLoad
IF(Secondary(SecondaryNum)%FluidType == SecFluidTypeAlwaysLiquid) THEN
FlowVolNeeded = TotalLoad/eta/(cpBrine*DensityBrine*(TBrineIn - TEvap))
PartLdFrac = FlowVolNeeded/MaxVolFlow
ELSE
PartLdFrac = TotalLoad/MaxLoad
END IF
IF(Secondary(SecondaryNum)%PumpControlType == SecPumpControlConstant) THEN
VolFlowRate = 0.d0
TotalPumpPower = 0.d0
DO PumpID = 1, NumPumps !dispatch pumps to meet needed flow rate
IF(Secondary(SecondaryNum)%FluidType == SecFluidTypeAlwaysLiquid) THEN !>>>>>>>>>>>>>>>>>>>>>
VolFlowRate = VolFlowRate + Secondary(SecondaryNum)%PumpIncrementFlowVol
TotalPumpPower = TotalPumpPower + Secondary(SecondaryNum)%PumpIncrementPower
IF(VolFlowRate >= FlowVolNeeded)EXIT
ELSE ! fluid type phase change >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
VolFlowRate = VolFlowRate + Secondary(SecondaryNum)%PumpIncrementFlowVol
TotalPumpPower = TotalPumpPower + Secondary(SecondaryNum)%PumpIncrementPower
PartPumpFrac = TotalPumpPower/Secondary(SecondaryNum)%PumpTotRatedPower
IF(PartPumpFrac >= PartLdFrac)EXIT
END IF !fluid type >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
END DO !Dispatching pumps until fluid flow need is met
ELSE ! pump type variable
VarFrac = MAX(0.1d0,CurveValue(Secondary(SecondaryNum)%VarSpeedCurvePtr,PartLdFrac))
TotalPumpPower = Secondary(SecondaryNum)%PumpTotRatedPower * VarFrac
VolFlowRate = MaxVolFlow * PartLdFrac
END IF ! pump type
TotalLoad = RefrigerationLoad + DistPipeHeatGain + ReceiverHeatGain &
+ TotalPumpPower*Secondary(SecondaryNum)%PumpPowertoHeat
Error = DABS((TotalLoad-PrevTotalLoad)/PrevTotalLoad)
IF (Error < Errortol) EXIT
END DO !end iteration on pump energy convergence
! IF (Iter >=10 .AND. .NOT. WarmupFlag)THEN
! If( .not. warmupflag) Then
! Write(OutputFileDebug,707)Month, CurrentTime, Iter, TotalLoad, TotalPumpPower
! End If
!707 format(' in iter loop at 707: ',1x,I2,1x,F5.2,1x,I5,7(F10.5,1x))
! END IF !didn't converge
END IF !(AtPartLoad)
!If only loads are cases and walk-ins, that is, no air coils:
! Account for difference between load and capacity on secondary loop. Assume system able to provide
! rated capacity. If it can't, that unmet energy will be stored and discharged at the system level.
! Meet current load to the extent possible. If extra capacity available,
! apply it to previously unmet/stored loads. If capacity less than current load,
! (e.g. as it may be following defrost cycles on cases or walk-ins served by secondary loop)
! save the unmet/stored load to be met in succeeding time steps.
IF(Secondary(SecondaryNum)%NumCoils == 0) THEN
StoredEnergyRate = MAX(0.d0,(UnMetEnergy/TimeStepZone/SecInHour))
LoadRequested = TotalLoad + StoredEnergyRate
IF(MaxLoad > LoadRequested) THEN
! Have at least as much capacity avail as needed, even counting stored energy
TotalCoolingLoad = LoadRequested
RefrigerationLoad = RefrigerationLoad + StoredEnergyRate
UnMetEnergy = 0.0d0
ELSE
!Don't have as much capacity as needed (likely following defrost periods)
TotalCoolingLoad = MaxLoad
RefrigerationLoad = RefrigerationLoad - (TotalLoad - Maxload)
IF(.NOT. WarmUpFlag) UnMetEnergy=UnMetEnergy + ((TotalLoad - Maxload)* TimeStepZone * SecInHour)
END IF ! load requested greater than MaxLoad
IF(Secondary(SecondaryNum)%UnMetEnergy > MyLargeNumber) THEN
Secondary(SecondaryNum)%UnMetEnergy=MyLargeNumber
IF(ShowUnmetSecondEnergyWarning(SecondaryNum)) THEN
CALL ShowWarningError('Secondary Refrigeration Loop: '//TRIM(Secondary(SecondaryNum)%Name))
CALL ShowContinueError(' This secondary system has insufficient capacity to meet the refrigeration loads.')
ShowUnmetSecondEnergyWarning(SecondaryNum) = .FALSE.
END IF
END IF !>my large number
Secondary(SecondaryNum)%UnMetEnergy = UnMetEnergy
ELSE ! air coils on secondary loop, no "unmet" energy accounting, just reduce amount of cooling provided to zone by coils
DeRate = .FALSE.
IF(TotalLoad > MaxLoad)DeRate = .TRUE.
! TotalLoad = RefrigerationLoad + DistPipeHeatGain + ReceiverHeatGain &
! + TotalPumpPower*Secondary(SecondaryNum)%PumpPowertoHeat
CALL FinalRateCoils(DeRate,SecondarySystem,SecondaryNum,TotalLoad,MaxLoad) !assign case credits for coils on this loop
END IF ! no air coils on secondary loop
Secondary(SecondaryNum)%PumpPowerTotal = TotalPumpPower
Secondary(SecondaryNum)%PumpElecEnergyTotal = TotalPumpPower * LocalTimeStep * SecInHour
Secondary(SecondaryNum)%TotalRefrigLoad = RefrigerationLoad
Secondary(SecondaryNum)%TotalRefrigEnergy = RefrigerationLoad * LocalTimeStep * SecInHour
Secondary(SecondaryNum)%TotalCoolingLoad = TotalCoolingLoad
Secondary(SecondaryNum)%TotalCoolingEnergy = TotalCoolingLoad * LocalTimeStep * SecInHour
Secondary(SecondaryNum)%FlowVolActual = VolFlowRate
Secondary(SecondaryNum)%HotDefrostCondCredit = TotalHotDefrostCondCredit
Secondary(SecondaryNum)%DistPipeHeatGain = DistPipeHeatGain
Secondary(SecondaryNum)%DistPipeHeatGainEnergy = DistPipeHeatGain * LocalTimeStep * SecInHour
Secondary(SecondaryNum)%ReceiverHeatGain = ReceiverHeatGain
Secondary(SecondaryNum)%ReceiverHeatGainEnergy = ReceiverHeatGain * LocalTimeStep * SecInHour
RETURN
END SUBROUTINE CalculateSecondary