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 | :: | EvapFluidCoolerNum |
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 CalcSingleSpeedEvapFluidCooler(EvapFluidCoolerNum)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma
! DATE WRITTEN May 2009
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! To simulate the operation of a single-speed fan evaporative fluid cooler.
! METHODOLOGY EMPLOYED:
! The evaporative fluid cooler is modeled using effectiveness-NTU relationships for
! counterflow heat exchangers based on Merkel's theory.
!
! The subroutine calculates the period of time required to meet a
! leaving water temperature setpoint. It assumes that part-load
! operation represents a linear interpolation of two steady-state regimes.
! Cyclic losses are neglected. The period of time required to meet the
! leaving water temperature setpoint is used to determine the required
! fan power and energy.
!
! A RunFlag is passed by the upper level manager to indicate the ON/OFF status,
! or schedule, of the evaporative fluid cooler. If the evaporative fluid cooler is OFF, outlet water
! temperature and flow rate are passed through the model from inlet node to
! outlet node without intervention. Reports are also updated with fan power and energy being zero.
!
! When the RunFlag indicates an ON condition for the evaporative fluid cooler, the
! mass flow rate and water temperature are read from the inlet node of the
! evaporative fluid cooler (water-side). The outdoor air wet-bulb temperature is used
! as the entering condition to the evaporative fluid cooler (air-side).
! The evaporative fluid cooler fan is turned on and design parameters are used
! to calculate the leaving water temperature.
! If the calculated leaving water temperature is below the setpoint, a fan
! run-time fraction is calculated and used to determine fan power. The leaving
! water temperature setpoint is placed on the outlet node. If the calculated
! leaving water temperature is at or above the setpoint, the calculated
! leaving water temperature is placed on the outlet node and the fan runs at
! full power. Water mass flow rate is passed from inlet node to outlet node
! with no intervention.
!
!
! REFERENCES:
! ASHRAE HVAC1KIT: A Toolkit for Primary HVAC System Energy Calculation. 1999.
! Based on SingleSpeedTower subroutine by Dan Fisher ,Sept 1998
! Dec. 2008. BG. added RunFlag logic per original methodology
! USE STATEMENTS:
! USE FluidProperties, ONLY : GetSpecificHeatGlycol
USE DataPlant, ONLY : PlantLoop, SingleSetpoint, DualSetpointDeadband
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: EvapFluidCoolerNum
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIteration = 100 ! Maximum fluid bypass iteration calculations
CHARACTER(len=3), PARAMETER :: MaxItChar = '100'
REAL(r64), PARAMETER :: BypassFractionThreshold = 0.01d0 !Threshold to stop bypass iteration
REAL(r64), PARAMETER :: OWTLowerLimit = 0.0d0 ! The limit of evaporative fluid cooler exit fluid temperature used
! in the fluid bypass calculation to avoid fluid freezing. For water,
! it is 0 degreeC and for glycols, it can be much lower. The fluid type
! is stored at the loop. Current choices are Water and Steam,
! needs to expand for glycols
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: AirFlowRate
REAL(r64) :: UAdesign ! UA value at design conditions (entered by user or calculated)
REAL(r64) :: InletWaterTemp
REAL(r64) :: FanModeFrac
REAL(r64) :: FanPowerOn
REAL(r64) :: CpWater
REAL(r64) :: TempSetPoint
!Added variables for fluid bypass
INTEGER :: NumIteration
INTEGER :: CapacityControl ! Capacity Control (0 - FanCycling, 1 - FluidBypass)
INTEGER :: BypassFlag ! Flag indicator for fluid bypass (0 - no bypass, 1 - bypass)
REAL(r64) :: BypassFraction ! Fluid bypass fraction
REAL(r64) :: BypassFraction2 ! Fluid bypass fraction
REAL(r64) :: BypassFractionPrev
REAL(r64) :: OutletWaterTempPrev
INTEGER :: LoopNum
INTEGER :: LoopSideNum
!set inlet and outlet nodes
WaterInletNode = SimpleEvapFluidCooler(EvapFluidCoolerNum)%WaterInletNodeNum
WaterOutletNode = SimpleEvapFluidCooler(EvapFluidCoolerNum)%WaterOutletNodeNum
Qactual = 0.0d0
FanPower = 0.0d0
InletWaterTemp = Node(WaterInletNode)%Temp
OutletWaterTemp = InletWaterTemp
LoopNum = SimpleEvapFluidCooler(EvapFluidCoolerNum)%LoopNum
LoopSideNum = SimpleEvapFluidCooler(EvapFluidCoolerNum)%LoopSideNum
AirFlowRate = 0.0d0
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpoint
CASE (DualSetPointDeadBand)
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpointHi
END SELECT
! Added for fluid bypass. First assume no fluid bypass
BypassFlag = 0
BypassFraction = 0.0d0
BypassFraction2 = 0.0d0
SimpleEvapFluidCooler(EvapFluidCoolerNum)%BypassFraction = 0.0d0
CapacityControl = SimpleEvapFluidCooler(EvapFluidCoolerNum)%CapacityControl
! MassFlowTol is a parameter to indicate a no flow condition
IF(WaterMassFlowRate .LE. MassFlowTolerance .OR. PlantLoop(LoopNum)%Loopside(LoopSideNum)%FlowLock .EQ. 0) RETURN
IF(InletWaterTemp > TempSetPoint)THEN
! Turn on evaporative fluid cooler fan
UAdesign = SimpleEvapFluidCooler(EvapFluidCoolerNum)%HighSpeedEvapFluidCoolerUA
AirFlowRate = SimpleEvapFluidCooler(EvapFluidCoolerNum)%HighSpeedAirFlowRate
FanPowerOn = SimpleEvapFluidCooler(EvapFluidCoolerNum)%HighSpeedFanPower
Call SimSimpleEvapFluidCooler(EvapFluidCoolerNum,WaterMassFlowRate,AirFlowRate,UAdesign, OutletWaterTemp)
IF(OutletWaterTemp .LE. TempSetPoint)THEN
IF(CapacityControl == 0 .OR. OutletWaterTemp <= OWTLowerLimit)THEN
! Setpoint was met with pump ON and fan ON, calculate run-time fraction
FanModeFrac = (TempSetPoint-InletWaterTemp)/(OutletWaterTemp-InletWaterTemp)
FanPower = FanModeFrac * FanPowerOn
OutletWaterTemp = TempSetPoint
ELSE
!FluidBypass, fan runs at full speed for the entire time step
FanModeFrac = 1.0d0
FanPower = FanPowerOn
BypassFlag = 1
ENDIF
ELSE
! Setpoint was not met, evaporative fluid cooler ran at full capacity
FanModeFrac = 1.0d0
FanPower = FanPowerOn
END IF
ELSEIF(InletWaterTemp <=TempSetPoint)THEN
!Inlet water temperature lower than setpoint, assume 100% bypass, evaporative fluid cooler fan off
IF(CapacityControl == 1)THEN
IF(InletWaterTemp > OWTLowerLimit)THEN
FanPower = 0.0d0
BypassFraction = 1.0d0
SimpleEvapFluidCooler(EvapFluidCoolerNum)%BypassFraction = 1.0d0
OutletWaterTemp = InletWaterTemp
ENDIF
ENDIF
END IF
! Calculate bypass fraction since OWTLowerLimit < OutletWaterTemp < TempSetPoint.
! The iteration ends when the numer of iteration exceeds the limit or the difference
! between the new and old bypass fractions is less than the threshold.
IF (BypassFlag == 1) THEN
BypassFraction = (TempSetPoint - OutletWaterTemp) / (InletWaterTemp - OutletWaterTemp)
IF(BypassFraction >1.0d0 .OR. BypassFraction<0.0d0)THEN
! Bypass cannot meet setpoint, assume no bypass
BypassFlag = 0
BypassFraction = 0.0d0
SimpleEvapFluidCooler(EvapFluidCoolerNum)%BypassFraction = 0.0d0
AirFlowRate = 0.0d0
ELSE
NumIteration = 0
BypassFractionPrev = BypassFraction
OutletWaterTempPrev = OutletWaterTemp
DO WHILE (NumIteration < MaxIteration)
NumIteration = NumIteration + 1
! need to iterate for the new OutletWaterTemp while bypassing evaporative fluid cooler water
Call SimSimpleEvapFluidCooler(EvapFluidCoolerNum, WaterMassFlowRate * (1.0d0-BypassFraction), &
AirFlowRate, UAdesign, OutletWaterTemp)
! Calc new BypassFraction based on the new OutletWaterTemp
IF(ABS(OutletWaterTemp - OWTLowerLimit)<=0.01d0)THEN
BypassFraction2 = BypassFraction
EXIT
ELSEIF(OutletWaterTemp < OWTLowerLimit)THEN
! Set OutletWaterTemp = OWTLowerLimit, and use linear interpolation to calculate the bypassFraction
BypassFraction2 = BypassFractionPrev - (BypassFractionPrev-BypassFraction)*(OutletWaterTempPrev-OWTLowerLimit) &
/(OutletWaterTempPrev-OutletWaterTemp)
Call SimSimpleEvapFluidCooler(EvapFluidCoolerNum, WaterMassFlowRate * (1.0d0-BypassFraction2), &
AirFlowRate, UAdesign, OutletWaterTemp)
IF (OutletWaterTemp < OWTLowerLimit) THEN
!Use previous iteraction values
BypassFraction2 = BypassFractionPrev
OutletWaterTemp = OutletWaterTempPrev
ENDIF
EXIT
ELSE
BypassFraction2 = (TempSetPoint-OutletWaterTemp) / (InletWaterTemp - OutletWaterTemp)
ENDIF
! Compare two BypassFraction to determine when to stop
IF(ABS(BypassFraction2 - BypassFraction) <= BypassFractionThreshold) EXIT
BypassFractionPrev = BypassFraction
OutletWaterTempPrev = OutletWaterTemp
BypassFraction = BypassFraction2
END DO
IF(NumIteration > MaxIteration) THEN
CALL ShowWarningError('Evaporative fluid cooler fluid bypass iteration ' &
//'exceeds maximum limit of '//MaxItChar//' for '//TRIM(SimpleEvapFluidCooler(EvapFluidCoolerNum)%Name))
ENDIF
SimpleEvapFluidCooler(EvapFluidCoolerNum)%BypassFraction = BypassFraction2
! may not meet TempSetPoint due to limit of evaporative fluid cooler outlet temp to OWTLowerLimit
OutletWaterTemp = (1.0-BypassFraction2)*OutletWaterTemp + BypassFraction2*InletWaterTemp
ENDIF
ENDIF
!Should this be water inlet node num?????
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleEvapFluidCooler(EvapFluidCoolerNum)%LoopNum)%FluidName, &
Node(WaterInletNode)%Temp, &
PlantLoop(SimpleEvapFluidCooler(EvapFluidCoolerNum)%LoopNum)%FluidIndex, &
'CalcSingleSpeedEvapFluidCooler')
Qactual = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
AirFlowRateRatio = AirFlowRate / SimpleEvapFluidCooler(EvapFluidCoolerNum)%HighSpeedAirFlowRate
RETURN
END SUBROUTINE CalcSingleSpeedEvapFluidCooler