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 | :: | TowerNum |
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 CalcSingleSpeedTower(TowerNum)
! SUBROUTINE INFORMATION:
! AUTHOR Dan Fisher
! DATE WRITTEN Sept. 1998
! MODIFIED T Hong, Aug. 2008. Added fluid bypass for single speed cooling tower
! The OutletWaterTemp from SimSimpleTower can be lower than 0 degreeC
! which may not be allowed in practice if water is the tower fluid.
! Chandan Sharma, FSEC, February 2010, Added basin heater
! A Flament, July 2010, added multi-cell capability for the 3 types of cooling tower
! RE-ENGINEERED Jan 2001, Richard Raustad
! PURPOSE OF THIS SUBROUTINE:
!
! To simulate the operation of a single-speed fan cooling tower.
! METHODOLOGY EMPLOYED:
!
! The cooling tower 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. Free convection regime is also modeled. This
! occures when the pump is operating and the fan is off. If free convection
! regime cooling is all that is required for a given time step, the leaving
! water temperature is allowed to fall below the leaving water temperature
! setpoint (free cooling). At times when the cooling tower fan is required,
! the leaving water temperature is at or above the setpoint.
!
! A RunFlag is passed by the upper level manager to indicate the ON/OFF status,
! or schedule, of the cooling tower. If the tower is OFF, outlet water
! temperature and flow rate are passed through the model from inlet node to
! outlet node without intervention (with the exception of free convection
! where water temperature is allowed to float below the outlet water set
! point). Reports are also updated with fan power and energy being zero.
!
! When the RunFlag indicates an ON condition for the cooling tower, the
! mass flow rate and water temperature are read from the inlet node of the
! cooling tower (water-side). The outdoor air wet-bulb temperature is used
! as the entering condition to the cooling tower (air-side). Input deck
! parameters are read for the free convection regime (pump ON and fan OFF)
! and a leaving water temperature is calculated. If the leaving water temperature
! is at or below the setpoint, the calculated leaving water temperature is
! placed on the outlet node and no fan power is used. If the calculated leaving
! water temperature is above the setpoint, the cooling tower fan is turned on
! and design parameters are used to again 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.
!
! If a tower has multiple cells, the specified inputs of or the autosized capacity
! and air/water flow rates are for the entire tower. The number of cells to operate
! is first determined based on the user entered minimal and maximal water flow fractions
! per cell. If the loads are not met, more cells (if available) will operate to meet
! the loads. Inside each cell, the capacity controls still apply. Each cell operates
! in the same way.
! REFERENCES:
! ASHRAE HVAC1KIT: A Toolkit for Primary HVAC System Energy Calculation. 1999.
! USE STATEMENTS:
USE DataPlant, ONLY : PlantLoop, SingleSetPoint, DualSetpointDeadband
USE DataBranchAirLoopPlant, ONLY: MassFlowTolerance
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER :: TowerNum
! 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 tower exit fluid temperature used in the fluid bypass
! calculation to avoid fluid freezing. For water, it is 0 degreeC,
! 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) :: OutletWaterTempOFF
REAL(r64) :: FanModeFrac
REAL(r64) :: DesignWaterFlowRate
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
!Added variables for multicell
REAL(r64) :: WaterMassFlowRatePerCellMin
REAL(r64) :: WaterMassFlowRatePerCellMax
INTEGER :: NumCellMin = 0
INTEGER :: NumCellMax = 0
INTEGER :: NumCellON = 0
REAL(r64) :: WaterMassFlowRatePerCell
LOGICAL :: IncrNumCellFlag ! determine if yes or no we increase the number of cells
INTEGER :: LoopNum
INTEGER :: LoopSideNum
!set inlet and outlet nodes
WaterInletNode = SimpleTower(TowerNum)%WaterInletNodeNum
WaterOutletNode = SimpleTower(TowerNum)%WaterOutletNodeNum
Qactual = 0.0d0
CTFanPower = 0.0d0
OutletWaterTemp = Node(WaterInletNode)%Temp
LoopNum = SimpleTower(TowerNum)%LoopNum
LoopSideNum = SimpleTower(TowerNum)%LoopSideNum
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
IF (SimpleTower(TowerNum)%SetpointIsOnOutlet) THEN
TempSetPoint = Node(WaterOutletNode)%TempSetpoint
ELSE
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpoint
ENDIF
CASE (DualSetPointDeadBand)
IF (SimpleTower(TowerNum)%SetpointIsOnOutlet) THEN
TempSetPoint = Node(WaterOutletNode)%TempSetpointHi
ELSE
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpointHi
ENDIF
END SELECT
! Added for fluid bypass. First assume no fluid bypass
BypassFlag = 0
BypassFraction = 0.0d0
BypassFraction2 = 0.0d0
SimpleTower(TowerNum)%BypassFraction = 0.0d0
CapacityControl = SimpleTower(TowerNum)%CapacityControl
! Added for multi-cell. Determine the number of cells operating
IF (SimpleTower(TowerNum)%DesWaterMassFlowRate > 0.0D0) THEN
WaterMassFlowRatePerCellMin = SimpleTower(TowerNum)%DesWaterMassFlowRate * &
SimpleTower(TowerNum)%MinFracFlowRate / SimpleTower(TowerNum)%NumCell
WaterMassFlowRatePerCellMax = SimpleTower(TowerNum)%DesWaterMassFlowRate * &
SimpleTower(TowerNum)%MaxFracFlowRate / SimpleTower(TowerNum)%NumCell
!round it up to the nearest integer
NumCellMin = MIN(INT((WaterMassFlowRate / WaterMassFlowRatePerCellMax)+.9999d0),SimpleTower(TowerNum)%NumCell)
NumCellMax = MIN(INT((WaterMassFlowRate / WaterMassFlowRatePerCellMin)+.9999d0),SimpleTower(TowerNum)%NumCell)
ENDIF
! cap min at 1
IF(NumCellMin <= 0)NumCellMin = 1
IF(NumCellMax <= 0)NumCellMax = 1
IF(SimpleTower(TowerNum)%CellCtrl_Num == CellCtrl_MinCell)THEN
NumCellON = NumCellMin
ELSE
NumCellON = NumCellMax
END IF
SimpleTower(TowerNum)%NumCellON = NumCellON
WaterMassFlowRatePerCell = WaterMassFlowRate / NumCellON
! Do not RETURN here if flow rate is less than SmallMassFlow. Check basin heater and then RETURN.
! MassFlowTolerance is a parameter to indicate a no flow condition
IF(WaterMassFlowRate.LE.MassFlowTolerance)THEN
! for multiple cells, we assume that it's a commun bassin
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
RETURN
ENDIF
IncrNumCellFlag = .true. ! set value to true to enter in the loop
DO WHILE (IncrNumCellFlag)
IncrNumCellFlag = .false.
! Initialize local variables to the free convection design values
UAdesign = SimpleTower(TowerNum)%FreeConvTowerUA / SimpleTower(TowerNum)%NumCell
AirFlowRate = SimpleTower(TowerNum)%FreeConvAirFlowRate / SimpleTower(TowerNum)%NumCell
DesignWaterFlowRate = SimpleTower(TowerNum)%DesignWaterFlowRate
OutletWaterTempOFF = Node(WaterInletNode)%Temp
OutletWaterTemp = OutletWaterTempOFF
FanModeFrac = 0.0d0
Call SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRate,UAdesign,OutletWaterTempOFF)
! Assume Setpoint was met using free convection regime (pump ON and fan OFF)
CTFanPower = 0.0d0
OutletWaterTemp = OutletWaterTempOFF
IF(OutletWaterTempOFF > TempSetPoint)THEN
! Setpoint was not met (or free conv. not used), turn on cooling tower fan
UAdesign = SimpleTower(TowerNum)%HighSpeedTowerUA / SimpleTower(TowerNum)%NumCell
AirFlowRate = SimpleTower(TowerNum)%HighSpeedAirFlowRate / SimpleTower(TowerNum)%NumCell
! The fan power is for all cells operating
FanPowerOn = SimpleTower(TowerNum)%HighSpeedFanPower * NumCellON / SimpleTower(TowerNum)%NumCell
Call SimSimpleTower(TowerNum,WaterMassFlowRatePerCell,AirFlowRate,UAdesign, OutletWaterTemp)
IF(OutletWaterTemp .LE. TempSetPoint)THEN
IF(CapacityControl == CapacityControl_FanCycling .OR. OutletWaterTemp <= OWTLowerLimit)THEN
! Setpoint was met with pump ON and fan ON, calculate run-time fraction
FanModeFrac = (TempSetPoint-OutletWaterTempOFF)/(OutletWaterTemp-OutletWaterTempOFF)
CTFanPower = FanModeFrac * FanPowerOn
OutletWaterTemp = TempSetPoint
ELSE
!FluidBypass, fan runs at full speed for the entire time step
FanModeFrac = 1.0d0
CTFanPower = FanPowerOn
BypassFlag = 1
ENDIF
ELSE
! Setpoint was not met, cooling tower ran at full capacity
FanModeFrac = 1.0d0
CTFanPower = FanPowerOn
! if possible increase the number of cells and do the calculations again with the new water mass flow rate per cell
IF (NumCellON .lt. SimpleTower(TowerNum)%NumCell &
.and. (WaterMassFlowRate/(NumCellON+1)) .ge. WaterMassFlowRatePerCellMin) THEN
NumCellON = NumCellON + 1
WaterMassFlowRatePerCell = WaterMassFlowRate / NumCellON
IncrNumCellFlag = .true.
END IF
END IF
ELSEIF(OutletWaterTempOFF < TempSetPoint)THEN
! Need to bypass in free convection cooling mode if bypass is allowed
IF(CapacityControl == CapacityControl_FluidBypass)THEN
IF(OutletWaterTempOFF > OWTLowerLimit)THEN
BypassFlag = 1
ENDIF
ENDIF
END IF
END DO
! Calculate bypass fraction since OWTLowerLimit < OutletWaterTemp < TempSetPoint.
! The iteraction ends when the numer of iteraction exceeds the limit or the difference
! between the new and old bypass fractions is less than the threshold.
IF (BypassFlag == 1) THEN
!Inlet water temperature lower than setpoint, assume 100% bypass, tower fan off
IF(InletWaterTemp <= TempSetPoint)THEN
CTFanPower = 0.0d0
BypassFraction = 1.0d0
SimpleTower(TowerNum)%BypassFraction = 1.0d0
OutletWaterTemp = InletWaterTemp
ELSE
IF(ABS(InletWaterTemp - OutletWaterTemp)<=0.01d0) THEN
! Outlet temp is close enough to inlet temp, assume 100% bypass, tower fan off
BypassFraction = 1.0d0
SimpleTower(TowerNum)%BypassFraction = 1.0d0
CTFanPower = 0.0d0
ELSE
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
SimpleTower(TowerNum)%BypassFraction = 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 tower water
Call SimSimpleTower(TowerNum, WaterMassFlowRatePerCell * (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 SimSimpleTower(TowerNum, WaterMassFlowRatePerCell * (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('Cooling tower fluid bypass iteration ' &
//'exceeds maximum limit of '//MaxItChar//' for '//TRIM(SimpleTower(TowerNum)%Name))
ENDIF
SimpleTower(TowerNum)%BypassFraction = BypassFraction2
! may not meet TempSetPoint due to limit of tower outlet temp to OWTLowerLimit
OutletWaterTemp = (1.0-BypassFraction2)*OutletWaterTemp + BypassFraction2*InletWaterTemp
ENDIF
ENDIF
ENDIF
ENDIF
!output the fraction of the time step the fan is ON
FanCyclingRatio = FanModeFrac
! output the number of cells operating
SimpleTower(TowerNum)%NumCellON = NumCellON
!Should this be water inlet node num?????
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidName, &
Node(WaterInletNode)%Temp, &
PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidIndex, &
'CalcSingleSpeedTower')
Qactual = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
AirFlowRateRatio = (AirFlowRate * SimpleTower(TowerNum)%NumCell) / SimpleTower(TowerNum)%HighSpeedAirFlowRate
RETURN
END SUBROUTINE CalcSingleSpeedTower