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) | :: | 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 CalcVariableSpeedTower(TowerNum)
! SUBROUTINE INFORMATION:
! AUTHOR Richard Raustad
! DATE WRITTEN Feb 2005
! MODIFIED A Flament, July 2010, added multi-cell capability for the 3 types of cooling tower
! B Griffith, general fluid props
! RE-ENGINEERED
! PURPOSE OF THIS SUBROUTINE:
!
! To simulate the operation of a variable-speed fan cooling tower.
! METHODOLOGY EMPLOYED:
!
! For each simulation time step, a desired range temperature (Twater,inlet-Twater,setpoint) and desired approach
! temperature (Twater,setpoint-Tair,WB) is calculated which meets the outlet water temperature setpoint. This
! desired range and approach temperature also provides a balance point for the empirical model where:
!
! Tair,WB + Twater,range + Tapproach = Node(WaterInletNode)%Temp
!
! Calculation of water outlet temperature uses one of the following equations:
!
! Twater,outlet = Tair,WB + Tapproach (1) or
! Twater,outlet = Twater,inlet - Twater,range (2)
!
! If a solution (or balance) is found, these 2 calculation methods are equal. Equation 2 is used to calculate
! the outlet water temperature in the free convection regime and at the minimum or maximum fan speed so that
! if a solution is not reached, the outlet water temperature is approximately equal to the inlet water temperature
! and the tower fan must be varied to meet the setpoint. Equation 1 is used when the fan speed is varied between
! the minimum and maximum fan speed to meet the outlet water temperature setpoint.
!
! The outlet water temperature in the free convection regime is first calculated to see if the setpoint is met.
! If the setpoint is met, the fan is OFF and the outlet water temperature is allowed to float below the set
! point temperature. If the setpoint is not met, the outlet water temperature is re-calculated at the minimum
! fan speed. If the setpoint is met, the fan is cycled to exactly meet the outlet water temperature setpoint.
! If the setpoint is not met at the minimum fan speed, the outlet water temperature is re-calculated at the
! maximum fan speed. If the setpoint at the maximum fan speed is not met, the fan runs at maximum speed the
! entire time step. If the setpoint is met at the maximum fan speed, the fan speed is varied to meet the setpoint.
!
! 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 fan speed varies in the same way.
!
! REFERENCES:
!
! Benton, D.J., Bowmand, C.F., Hydeman, M., Miller, P.,
! "An Improved Cooling Tower Algorithm for the CoolToolsTM Simulation Model".
! ASHRAE Transactions 2002, V. 108, Pt. 1.
!
! York International Corporation, "YORKcalcTM Software, Chiller-Plant Energy-Estimating Program",
! Form 160.00-SG2 (0502). © 2002.
! USE STATEMENTS:
USE General, ONLY: SolveRegulaFalsi
USE CurveManager, ONLY: CurveValue
USE DataEnvironment, ONLY: EnvironmentName, CurMnDy
USE DataGlobals, ONLY: CurrentTime
USE General, ONLY: CreateSysTimeIntervalString
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, INTENT(IN) :: TowerNum
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: OutputFormat ='(F5.2)'
CHARACTER(len=*), PARAMETER :: OutputFormat2 ='(F8.5)'
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations
REAL(r64), PARAMETER :: Acc = 0.0001d0 ! Accuracy of result
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: OutletWaterTempOFF ! Outlet water temperature with fan OFF (C)
REAL(r64) :: OutletWaterTempON ! Outlet water temperature with fan ON at maximum fan speed (C)
REAL(r64) :: OutletWaterTempMIN ! Outlet water temperature with fan at minimum speed (C)
REAL(r64) :: CpWater ! Specific heat of water
REAL(r64) :: TempSetPoint ! Outlet water temperature setpoint (C)
REAL(r64) :: FanCurveValue ! Output of fan power as a func of air flow rate ratio curve
REAL(r64) :: AirDensity ! Density of air [kg/m3]
REAL(r64) :: AirMassFlowRate ! Mass flow rate of air [kg/s]
REAL(r64) :: InletAirEnthalpy ! Enthalpy of entering moist air [J/kg]
INTEGER :: SolFla ! Flag of solver
REAL(r64), DIMENSION(6) :: Par ! Parameter array for regula falsi solver
REAL(r64) :: Twb ! inlet air wet-bulb temperature
REAL(r64) :: TwbCapped ! inlet air wet-bulb temp passed to VS tower model
REAL(r64) :: Tr ! range temperature
REAL(r64) :: TrCapped ! range temp passed to VS tower model
REAL(r64) :: Ta ! approach temperature
REAL(r64) :: TaCapped ! approach temp passed to VS tower model
REAL(r64) :: WaterFlowRateRatio ! Water flow rate ratio
REAL(r64) :: WaterFlowRateRatioCapped ! Water flow rate ratio passed to VS tower model
REAL(r64) :: WaterDensity ! density of inlet water
REAL(r64) :: FreeConvectionCapFrac ! fraction of tower capacity in free convection
REAL(r64) :: FlowFraction ! liquid to gas (L/G) ratio for cooling tower
CHARACTER(len=6) :: OutputChar ! character string used for warning messages
CHARACTER(len=6) :: OutputChar2 ! character string used for warning messages
CHARACTER(len=6) :: OutputChar3 ! character string used for warning messages
CHARACTER(len=6) :: OutputChar4 ! character string used for warning messages
CHARACTER(len=6) :: OutputChar5 ! character string used for warning messages
REAL(r64),SAVE :: TimeStepSysLast=0.0d0 ! last system time step (used to check for downshifting)
REAL(r64) :: CurrentEndTime ! end time of time step for current simulation time step
REAL(r64),SAVE :: CurrentEndTimeLast=0.0d0 ! end time of time step for last simulation time step
INTEGER :: LoopNum
INTEGER :: LoopSideNum
!Added variables for multicell
REAL(r64) :: WaterMassFlowRatePerCellMin
REAL(r64) :: WaterMassFlowRatePerCellMax
INTEGER :: NumCellMin = 0
INTEGER :: NumCellMax = 0
INTEGER :: NumCellON = 0
REAL(r64) :: WaterMassFlowRatePerCell
LOGICAL :: IncrNumCellFlag
! 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
! Set inlet and outlet nodes and initialize subroutine variables
WaterInletNode = SimpleTower(TowerNum)%WaterInletNodeNum
WaterOutletNode = SimpleTower(TowerNum)%WaterOutletNodeNum
Qactual = 0.0d0
CTFanPower = 0.0d0
OutletWaterTemp = Node(WaterInletNode)%Temp
WaterUsage = 0.0d0
Twb = SimpleTowerInlet(TowerNum)%AirWetBulb
TwbCapped = SimpleTowerInlet(TowerNum)%AirWetBulb
LoopNum = SimpleTower(TowerNum)%LoopNum
LoopSideNum = SimpleTower(TowerNum)%LoopSideNum
SELECT CASE (PlantLoop(LoopNum)%LoopDemandCalcScheme)
CASE (SingleSetPoint)
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpoint
CASE (DualSetPointDeadBand)
TempSetPoint = PlantLoop(LoopNum)%LoopSide(LoopSideNum)%TempSetpointHi
END SELECT
Tr = Node(WaterInletNode)%Temp - TempSetPoint
Ta = TempSetPoint - SimpleTowerInlet(TowerNum)%AirWetBulb
! Do not RETURN here if flow rate is less than MassFlowTolerance. Check basin heater and then RETURN.
IF(PlantLoop(LoopNum)%Loopside(LoopSideNum)%FlowLock .EQ. 0)RETURN
! MassFlowTolerance is a parameter to indicate a no flow condition
IF(WaterMassFlowRate.LE.MassFlowTolerance)THEN
CALL CalcBasinHeaterPower(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff,&
SimpleTower(TowerNum)%BasinHeaterSchedulePtr,&
SimpleTower(TowerNum)%BasinHeaterSetPointTemp,BasinHeaterPower)
RETURN
ENDIF
!loop to increment NumCell if we cannot meet the setpoint with the actual number of cells calculated above
IncrNumCellFlag = .true.
DO WHILE (IncrNumCellFlag)
IncrNumCellFlag = .false.
! Initialize inlet node water properties
WaterDensity = GetDensityGlycol(PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidName, &
Node(WaterInletNode)%Temp, &
PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidIndex,&
'CalcVariableSpeedTower')
WaterFlowRateRatio = WaterMassFlowRatePerCell / (WaterDensity*SimpleTower(TowerNum)%CalibratedWaterFlowRate &
/SimpleTower(TowerNum)%NumCell )
! check independent inputs with respect to model boundaries
Call CheckModelBounds(TowerNum, Twb, Tr, Ta, WaterFlowRateRatio, TwbCapped, TrCapped, TaCapped, WaterFlowRateRatioCapped)
! determine the free convection capacity by finding the outlet temperature at full air flow and multiplying
! the tower's full capacity temperature difference by the percentage of tower capacity in free convection
! regime specified by the user
AirFlowRateRatio = 1.0d0
OutletWaterTempOFF = Node(WaterInletNode)%Temp
OutletWaterTempON = Node(WaterInletNode)%Temp
OutletWaterTemp = OutletWaterTempOFF
FreeConvectionCapFrac = SimpleTower(TowerNum)%FreeConvectionCapacityFraction
Call SimVariableTower(TowerNum, WaterFlowRateRatioCapped, AirFlowRateRatio, TwbCapped, OutletWaterTempON)
IF(OutletWaterTempON .GT. TempSetPoint) THEN
FanCyclingRatio = 1.0d0
AirFlowRateRatio = 1.0d0
CTFanPower = SimpleTower(TowerNum)%HighSpeedFanPower * NumCellON / SimpleTower(TowerNum)%NumCell
OutletWaterTemp = OutletWaterTempON
! 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)) .gt. WaterMassFlowRatePerCellMin)THEN
NumCellON = NumCellON + 1
WaterMassFlowRatePerCell = WaterMassFlowRate / NumCellON
IncrNumCellFlag = .true.
END IF
END IF
END DO
! find the correct air ratio only if full flow is too much
IF (OutletWaterTempON .LT. TempSetPoint)THEN
! outlet water temperature is calculated in the free convection regime
OutletWaterTempOFF = Node(WaterInletNode)%Temp - FreeConvectionCapFrac * (Node(WaterInletNode)%Temp - OutletWaterTempON)
! fan is OFF
FanCyclingRatio = 0.0d0
! air flow ratio is assumed to be the fraction of tower capacity in the free convection regime (fan is OFF but air is flowing)
AirFlowRateRatio = FreeConvectionCapFrac
! Assume setpoint was met using free convection regime (pump ON and fan OFF)
CTFanPower = 0.0d0
OutletWaterTemp = OutletWaterTempOFF
IF(OutletWaterTempOFF .GT. TempSetPoint)THEN
! Setpoint was not met, turn on cooling tower fan at minimum fan speed
AirFlowRateRatio = SimpleTower(TowerNum)%MinimumVSAirFlowFrac
Call SimVariableTower(TowerNum, WaterFlowRateRatioCapped, AirFlowRateRatio, TwbCapped, OutletWaterTempMIN)
IF(OutletWaterTempMIN .LT. TempSetPoint)THEN
! if setpoint was exceeded, cycle the fan at minimum air flow to meet the setpoint temperature
IF(SimpleTower(TowerNum)%FanPowerfAirFlowCurve .EQ. 0)THEN
CTFanPower = AirFlowRateRatio**3 * SimpleTower(TowerNum)%HighSpeedFanPower * NumCellON / &
SimpleTower(TowerNum)%NumCell
ELSE
FanCurveValue = CurveValue(SimpleTower(TowerNum)%FanPowerfAirFlowCurve,AirFlowRateRatio)
CTFanPower = MAX(0.0d0,(SimpleTower(TowerNum)%HighSpeedFanPower * FanCurveValue)) * NumCellON / &
SimpleTower(TowerNum)%NumCell
END IF
! fan is cycling ON and OFF at the minimum fan speed. Adjust fan power and air flow rate ratio according to cycling rate
FanCyclingRatio = ((OutletWaterTempOFF - TempSetPoint)/(OutletWaterTempOFF - OutletWaterTempMIN))
CTFanPower = CTFanPower * FanCyclingRatio
OutletWaterTemp = TempSetPoint
AirFlowRateRatio = (FanCyclingRatio * SimpleTower(TowerNum)%MinimumVSAirFlowFrac) + &
((1-FanCyclingRatio)*FreeConvectionCapFrac)
ELSE
! if setpoint was not met at minimum fan speed, set fan speed to maximum
AirFlowRateRatio = 1.0d0
! fan will not cycle and runs the entire time step
FanCyclingRatio = 1.0d0
Call SimVariableTower(TowerNum, WaterFlowRateRatioCapped, AirFlowRateRatio, TwbCapped, OutletWaterTemp)
! Setpoint was met with pump ON and fan ON at full flow
! Calculate the fraction of full air flow to exactly meet the setpoint temperature
Par(1) = TowerNum ! Index to cooling tower
! cap the water flow rate ratio and inlet air wet-bulb temperature to provide a stable output
Par(2) = WaterFlowRateRatioCapped ! water flow rate ratio
Par(3) = TwbCapped ! Inlet air wet-bulb temperature [C]
! do not cap desired range and approach temperature to provide a valid (balanced) output for this simulation time step
Par(4) = Tr ! Tower range temperature [C]
Par(5) = Ta ! desired approach temperature [C]
Par(6) = 1.0d0 ! calculate the air flow rate ratio required for a balance
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, AirFlowRateRatio, SimpleTowerApproachResidual, &
SimpleTower(TowerNum)%MinimumVSAirFlowFrac, 1.0d0, Par)
IF (SolFla == -1) THEN
IF(.NOT. WarmUpFlag)CALL ShowWarningError('Cooling tower iteration limit exceeded when calculating air flow ' &
//'rate ratio for tower '//TRIM(SimpleTower(TowerNum)%Name))
! IF RegulaFalsi cannot find a solution then provide detailed output for debugging
ELSE IF (SolFla == -2) THEN
IF(.NOT. WarmUpFlag) THEN
WRITE(OutputChar,OutputFormat)TwbCapped
WRITE(OutputChar2,OutputFormat)Tr
WRITE(OutputChar3,OutputFormat)Ta
WRITE(OutputChar4,OutputFormat)WaterFlowRateRatioCapped
WRITE(OutputChar5,OutputFormat)SimpleTower(TowerNum)%MinimumVSAirFlowFrac
IF(SimpleTower(TowerNum)%CoolingTowerAFRRFailedCount .LT. 1)THEN
SimpleTower(TowerNum)%CoolingTowerAFRRFailedCount = SimpleTower(TowerNum)%CoolingTowerAFRRFailedCount + 1
CALL ShowWarningError('CoolingTower:VariableSpeed "'//TRIM(SimpleTower(TowerNum)%Name)//'" - ' &
//'Cooling tower air flow rate ratio calculation failed ')
CALL ShowContinueError('...with conditions as Twb = '//TRIM(OutputChar)//', Trange = ' &
//TRIM(OutputChar2)//', Tapproach = '//TRIM(OutputChar3)//', and water flow rate ratio = ' &
//TRIM(OutputChar4))
CALL ShowContinueError('...a solution could not be found within the valid range ' &
//'of air flow rate ratios')
CALL ShowContinueErrorTimeStamp(' '//'...Valid air flow rate ratio range = '//TRIM(OutputChar5)//' to 1.0.')
CALL ShowContinueError('...Consider modifying the design approach or design range temperature for this tower.')
ELSE
CALL ShowRecurringWarningErrorAtEnd('CoolingTower:VariableSpeed "'//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Cooling tower air flow rate ratio calculation failed '// &
'error continues.', &
SimpleTower(TowerNum)%CoolingTowerAFRRFailedIndex)
END IF
END IF
ENDIF
! Use theoretical cubic for deterination of fan power if user has not specified a fan power ratio curve
IF(SimpleTower(TowerNum)%FanPowerfAirFlowCurve .EQ. 0)THEN
CTFanPower = AirFlowRateRatio**3 * SimpleTower(TowerNum)%HighSpeedFanPower * NumCellON / &
SimpleTower(TowerNum)%NumCell
ELSE
FanCurveValue = CurveValue(SimpleTower(TowerNum)%FanPowerfAirFlowCurve,AirFlowRateRatio)
CTFanPower = MAX(0.0d0,(SimpleTower(TowerNum)%HighSpeedFanPower * FanCurveValue)) * NumCellON / &
SimpleTower(TowerNum)%NumCell
END IF
! outlet water temperature is calculated as the inlet air wet-bulb temperature plus tower approach temperature
OutletWaterTemp = Twb + Ta
END IF ! IF(OutletWaterTempMIN .LT. TempSetPoint)THEN
END IF ! IF(OutletWaterTempOFF .GT. TempSetPoint)THEN
END IF ! IF(OutletWaterTempON .LT. TempSetpoint) ie if tower should not run at full capacity
CpWater = GetSpecificHeatGlycol(PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidName, &
Node(SimpleTower(TowerNum)%WaterInletNodeNum)%Temp, &
PlantLoop(SimpleTower(TowerNum)%LoopNum)%FluidIndex, &
'CalcVariableSpeedTower')
Qactual = WaterMassFlowRate * CpWater * (Node(WaterInletNode)%Temp - OutletWaterTemp)
SimpleTower(TowerNum)%NumCellON = NumCellON
! Set water and air properties
AirDensity = PsyRhoAirFnPbTdbW(SimpleTowerInlet(TowerNum)%AirPress, &
SimpleTowerInlet(TowerNum)%AirTemp,SimpleTowerInlet(TowerNum)%AirHumRat)
AirMassFlowRate = AirFlowRateRatio*SimpleTower(TowerNum)%HighSpeedAirFlowRate*AirDensity&
*SimpleTower(TowerNum)%NumCellON/SimpleTower(TowerNum)%NumCell
InletAirEnthalpy = &
PsyHFnTdbRhPb(SimpleTowerInlet(TowerNum)%AirWetBulb, &
1.0d0, &
SimpleTowerInlet(TowerNum)%AirPress)
! calculate end time of current time step
CurrentEndTime = CurrentTime + SysTimeElapsed
! Print warning messages only when valid and only for the first ocurrance. Let summary provide statistics.
! Wait for next time step to print warnings. If simulation iterates, print out
! the warning for the last iteration only. Must wait for next time step to accomplish this.
! If a warning occurs and the simulation down shifts, the warning is not valid.
IF(CurrentEndTime .GT. CurrentEndTimeLast .AND. TimeStepSys .GE. TimeStepSysLast)THEN
IF(VSTower(SimpleTower(TowerNum)%VSTower)%PrintLGMessage)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountFlowFrac = &
VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountFlowFrac + 1
! Show single warning and pass additional info to ShowRecurringWarningErrorAtEnd
IF (VSTower(SimpleTower(TowerNum)%VSTower)%VSErrorCountFlowFrac < 2) THEN
CALL ShowWarningError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%LGBuffer1))
CALL ShowContinueError(TRIM(VSTower(SimpleTower(TowerNum)%VSTower)%LGBuffer2))
ELSE
CALL ShowRecurringWarningErrorAtEnd(TRIM(SimpleTower(TowerNum)%TowerType)//' "'&
//TRIM(SimpleTower(TowerNum)%Name)//'" - Liquid to gas ratio is out of range error continues...' &
,VSTower(SimpleTower(TowerNum)%VSTower)%ErrIndexLG,VSTower(SimpleTower(TowerNum)%VSTower)%LGLast, &
VSTower(SimpleTower(TowerNum)%VSTower)%LGLast)
END IF
END IF
END IF
! save last system time step and last end time of current time step (used to determine if warning is valid)
TimeStepSysLast = TimeStepSys
CurrentEndTimeLast = CurrentEndTime
! warn user on first occurrence if flow fraction is greater than maximum for the YorkCalc model, use recurring warning stats
IF(SimpleTower(TowerNum)%TowerModelType .EQ. YorkCalcModel .OR. &
SimpleTower(TowerNum)%TowerModelType .EQ. YorkCalcUserDefined)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintLGMessage = .FALSE.
! Do not report error message in free convection regime
IF(AirFlowRateRatio .GT. SimpleTower(TowerNum)%MinimumVSAirFlowFrac)THEN
FlowFraction = WaterFlowRateRatioCapped/AirFlowRateRatio
! Flow fractions greater than a MaxLiquidToGasRatio of 8 are not reliable using the YorkCalc model
IF(FlowFraction .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxLiquidToGasRatio)THEN
! Report warnings only during actual simulation
IF(.NOT. WarmUpFlag)THEN
VSTower(SimpleTower(TowerNum)%VSTower)%PrintLGMessage = .TRUE.
WRITE(OutputChar,OutputFormat)FlowFraction
WRITE(OutputChar2,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MaxLiquidToGasRatio
VSTower(SimpleTower(TowerNum)%VSTower)%LGBuffer1 = TRIM(SimpleTower(TowerNum)%TowerType)//' "' &
//TRIM(SimpleTower(TowerNum)%Name)// &
'" - Liquid to gas ratio (L/G) is out of range at '//TRIM(OutputChar)//'.'
VSTower(SimpleTower(TowerNum)%VSTower)%LGBuffer2 = ' '//'...Valid maximum ratio = '//TRIM(OutputChar2)// &
'. Occurrence info = '//TRIM(EnvironmentName)//', '//Trim(CurMnDy)//' '&
//TRIM(CreateSysTimeIntervalString())
VSTower(SimpleTower(TowerNum)%VSTower)%LGLast = FlowFraction
END IF
END IF
END IF
END IF
RETURN
END SUBROUTINE CalcVariableSpeedTower