SUBROUTINE SizeFluidCooler(FluidCoolerNum)
! SUBROUTINE INFORMATION:
! AUTHOR Chandan Sharma
! DATE WRITTEN August 2008
! MODIFIED April 2010, Chandan Sharma, FSEC
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine is for sizing fluid cooler Components for which capacities and flow rates
! have not been specified in the input. This subroutine also calculates fluid cooler UA if the user
! has specified fluid cooler performance via the "Nominal Capacity" method.
! METHODOLOGY EMPLOYED:
! Obtains condenser flow rate from the plant sizing array. If fluid cooler performance is specified
! via the "Nominal Capacity" method, the water flow rate is directly proportional to capacity.
! REFERENCES:
! Based on SizeTower by Don Shirey, Sept/Oct 2002; Richard Raustad, Feb 2005
! USE STATEMENTS:
USE DataSizing
USE DataPlant, ONLY: PlantSizesOkayToFinalize
USE DataIPShortCuts ! Data for field names, blank numerics
USE General, ONLY: SolveRegulaFalsi, RoundSigDigits
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ReportSizingManager, ONLY: ReportSizingOutput
USE OutputReportPredefined
USE InputProcessor , ONLY : SameString
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: FluidCoolerNum
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: MaxIte = 500 ! Maximum number of iterations
REAL(r64), PARAMETER :: Acc = 0.0001d0 ! Accuracy of result
CHARACTER(len=*), PARAMETER :: CalledFrom = 'SizeFluidCooler'
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: PltSizCondNum ! Plant Sizing index for condenser loop
INTEGER :: SolFla ! Flag of solver
REAL(r64) :: DesFluidCoolerLoad ! Design fluid cooler load [W]
REAL(r64) :: UA0 ! Lower bound for UA [W/C]
REAL(r64) :: UA1 ! Upper bound for UA [W/C]
REAL(r64) :: UA ! Calculated UA value
REAL(r64) :: OutWaterTempAtUA0 ! Water outlet temperature at UA0
REAL(r64) :: OutWaterTempAtUA1 ! Water outlet temperature at UA1
REAL(r64), DIMENSION(5) :: Par ! Parameter array need for RegulaFalsi routine
CHARACTER(len=MaxNameLength) :: equipName
REAL(r64) :: Cp ! local specific heat for fluid
REAL(r64) :: rho ! local density for fluid
REAL(r64) :: tmpDesignWaterFlowRate ! local temporary for water volume flow rate
REAL(r64) :: tmpHighSpeedFanPower !local temporary for high speed fan power
REAL(r64) :: tmpHighSpeedAirFlowRate ! local temporary for high speed air flow rate
REAL(r64) :: tmpHighSpeedEvapFluidCoolerUA ! local temporary for high speed cooler UA
LOGICAL :: ErrorsFound
PltSizCondNum = 0
DesFluidCoolerLoad = 0.0d0
tmpDesignWaterFlowRate = SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate
tmpHighSpeedFanPower = SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower
tmpHighSpeedAirFlowRate= SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate
tmpHighSpeedEvapFluidCoolerUA = SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA
! Find the appropriate Plant Sizing object
PltSizCondNum = PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%PlantSizNum
IF(SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate == AutoSize) THEN
IF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizCondNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
tmpDesignWaterFlowRate = PlantSizData(PltSizCondNum)%DesVolFlowRate
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate = tmpDesignWaterFlowRate
ELSE
tmpDesignWaterFlowRate = 0.d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate = tmpDesignWaterFlowRate
ENDIF
IF (PlantSizesOkayToFinalize) &
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Autosized design water flow rate [m3/s]', SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate)
ELSE
CALL ShowSevereError('Autosizing error for fluid cooler object = '//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
CALL ShowFatalError('Autosizing of fluid cooler condenser flow rate requires a loop Sizing:Plant object.')
ENDIF
! This conditional statement is to trap when the user specified Condenser/Fluid Cooler water design setpoint
! temperature is less than design inlet air dry bulb temperature
IF ( PlantSizData(PltSizCondNum)%ExitTemp <= &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ) THEN
CALL ShowSevereError('Error when autosizing the UA value for fluid cooler = '&
//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//'.' )
CALL ShowContinueError('Design Loop Exit Temperature ('// TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)) // &
' C) must be greater than design entering air dry-bulb temperature ('// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp,2)) //&
' C) when autosizing the fluid cooler UA.')
CALL ShowContinueError('It is recommended that the Design Loop Exit Temperature = design inlet air dry-bulb temp '// &
'plus the Fluid Cooler design approach temperature (e.g., 4 C).')
CALL ShowContinueError('If using HVACTemplate:Plant:ChilledWaterLoop, then check that input field ' // &
'Condenser Water Design Setpoint must be > design inlet air dry-bulb temp if autosizing '// &
'the Fluid Cooler.')
CALL ShowFatalError('Review and revise design input values as appropriate.')
ENDIF
ENDIF
CALL RegisterPlantCompDesignFlow(SimpleFluidCooler(FluidCoolerNum)%WaterInletNodeNum, tmpDesignWaterFlowRate)
IF (SimpleFluidCooler(FluidCoolerNum)%PerformanceInputMethod_Num == PIM_UFactor .and. &
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA /= AutoSize) THEN
IF (PltSizCondNum > 0) THEN
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
PlantSizData(PltSizCondNum)%ExitTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = rho * Cp * tmpDesignWaterFlowRate * PlantSizData(PltSizCondNum)%DeltaT
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity = DesFluidCoolerLoad
ELSE
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity = 0.0d0
ENDIF
END IF
IF (SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower == AutoSize) THEN
! We assume the nominal fan power is 0.0105 times the design load
IF (SimpleFluidCooler(FluidCoolerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity) THEN
tmpHighSpeedFanPower = 0.0105d0 * SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower = tmpHighSpeedFanPower
ELSE
IF(DesFluidCoolerLoad .GT. 0.0d0) THEN
tmpHighSpeedFanPower = 0.0105d0 * DesFluidCoolerLoad
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower = tmpHighSpeedFanPower
ELSEIF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizCondNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
! This conditional statement is to trap when the user specified Condenser/Fluid Cooler water design setpoint
! temperature is less than design inlet air dry bulb temperature
IF ( PlantSizData(PltSizCondNum)%ExitTemp <= &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ) THEN
CALL ShowSevereError('Error when autosizing the UA value for fluid cooler = '&
//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//'.' )
CALL ShowContinueError('Design Loop Exit Temperature ('// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)) // &
' C) must be greater than design entering air dry-bulb temperature ('// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp,2)) //&
' C) when autosizing the fluid cooler UA.')
CALL ShowContinueError('It is recommended that the Design Loop Exit Temperature = design inlet air '// &
'dry-bulb temp plus the Fluid Cooler design approach temperature (e.g., 4 C).')
CALL ShowContinueError('If using HVACTemplate:Plant:ChilledWaterLoop, then check that input field ' // &
'Condenser Water Design Setpoint must be > design inlet air dry-bulb temp if autosizing '// &
'the Fluid Cooler.')
CALL ShowFatalError('Review and revise design input values as appropriate.')
ENDIF
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
PlantSizData(PltSizCondNum)%ExitTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = rho * Cp * tmpDesignWaterFlowRate * PlantSizData(PltSizCondNum)%DeltaT
tmpHighSpeedFanPower = 0.0105d0 * DesFluidCoolerLoad
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower = tmpHighSpeedFanPower
ELSE
tmpHighSpeedFanPower = 0.d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower = tmpHighSpeedFanPower
ENDIF
ELSE
CALL ShowSevereError('Autosizing of fluid cooler fan power requires a loop Sizing:Plant object.')
CALL ShowFatalError(' Occurs in fluid cooler object = '//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_SingleSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'Fan Power at Design Air Flow Rate [W]', SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower)
ELSEIF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_TwoSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'Fan Power at High Fan Speed [W]', SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower)
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate == AutoSize) THEN
IF (SimpleFluidCooler(FluidCoolerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity) THEN
tmpHighSpeedAirFlowRate = SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity / &
(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp - &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp) * 4.0d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate = tmpHighSpeedAirFlowRate
ELSE
IF(DesFluidCoolerLoad .GT. 0.0d0) THEN
tmpHighSpeedAirFlowRate = DesFluidCoolerLoad / &
(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp - &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp) * 4.0d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate = tmpHighSpeedAirFlowRate
ELSEIF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizCondNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
! This conditional statement is to trap when the user specified Condenser/Fluid Cooler water design setpoint
! temperature is less than design inlet air dry bulb temperature
IF ( PlantSizData(PltSizCondNum)%ExitTemp <= &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ) THEN
CALL ShowSevereError('Error when autosizing the UA value for fluid cooler = '//&
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//'.' )
CALL ShowContinueError('Design Loop Exit Temperature ('// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)) // &
' C) must be greater than design entering air dry-bulb temperature ('// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp,2)) //&
' C) when autosizing the fluid cooler UA.')
CALL ShowContinueError('It is recommended that the Design Loop Exit Temperature = design inlet air '// &
'dry-bulb temp plus the Fluid Cooler design approach temperature (e.g., 4 C).')
CALL ShowContinueError('If using HVACTemplate:Plant:ChilledWaterLoop, then check that input field ' // &
'Condenser Water Design Setpoint must be > design inlet air dry-bulb temp if autosizing '// &
'the Fluid Cooler.')
CALL ShowFatalError('Review and revise design input values as appropriate.')
ENDIF
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
PlantSizData(PltSizCondNum)%ExitTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = rho * Cp * tmpDesignWaterFlowRate * PlantSizData(PltSizCondNum)%DeltaT
tmpHighSpeedAirFlowRate = DesFluidCoolerLoad / &
(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp - &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp) * 4.0d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate = tmpHighSpeedAirFlowRate
ELSE
tmpHighSpeedAirFlowRate = 0.d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate = tmpHighSpeedAirFlowRate
ENDIF
ELSE
CALL ShowSevereError('Autosizing of fluid cooler air flow rate requires a loop Sizing:Plant object')
CALL ShowFatalError(' Occurs in fluid cooler object = '//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_SingleSpeed) THEN
IF (PlantSizesOkayToFinalize) &
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Design Air Flow Rate [m3/s]', SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate)
ELSEIF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType == 'FluidCooler:TwoSpeed') THEN
IF (PlantSizesOkayToFinalize) &
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Air Flow Rate at High Fan Speed [m3/s]', SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate)
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA == AutoSize) THEN
IF (PltSizCondNum > 0) THEN
IF (PlantSizData(PltSizCondNum)%DesVolFlowRate >= SmallWaterVolFlow) THEN
! This conditional statement is to trap when the user specified Condenser/Fluid Cooler water design setpoint
! temperature is less than design inlet air dry bulb temperature
IF ( PlantSizData(PltSizCondNum)%ExitTemp <= &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ) THEN
CALL ShowSevereError('Error when autosizing the UA value for fluid cooler = '//&
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//'.' )
CALL ShowContinueError('Design Loop Exit Temperature ('// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)) // &
' C) must be greater than design entering air dry-bulb temperature ('// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp,2)) //&
' C) when autosizing the fluid cooler UA.')
CALL ShowContinueError('It is recommended that the Design Loop Exit Temperature = design inlet air dry-bulb temp '// &
'plus the Fluid Cooler design approach temperature (e.g., 4 C).')
CALL ShowContinueError('If using HVACTemplate:Plant:ChilledWaterLoop, then check that input field ' // &
'Condenser Water Design Setpoint must be > design inlet air dry-bulb temp if autosizing '// &
'the Fluid Cooler.')
CALL ShowFatalError('Review and revise design input values as appropriate.')
ENDIF
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
PlantSizData(PltSizCondNum)%ExitTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = rho * Cp * tmpDesignWaterFlowRate * PlantSizData(PltSizCondNum)%DeltaT
Par(1) = DesFluidCoolerLoad
Par(2) = REAL(FluidCoolerNum,r64)
Par(3) = rho * tmpDesignWaterFlowRate ! design water mass flow rate
Par(4) = tmpHighSpeedAirFlowRate ! design air volume flow rate
Par(5) = Cp
UA0 = 0.0001d0 * DesFluidCoolerLoad ! Assume deltaT = 10000K (limit)
UA1 = DesFluidCoolerLoad ! Assume deltaT = 1K
SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp = PlantSizData(PltSizCondNum)%ExitTemp + &
PlantSizData(PltSizCondNum)%DeltaT
SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp = SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb = SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirWetbulbTemp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress = StdBaroPress
SimpleFluidCoolerInlet(FluidCoolerNum)%AirHumRat = &
PsyWFnTdbTwbPb(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress,CalledFrom)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, UA, SimpleFluidCoolerUAResidual, UA0, UA1, Par)
IF (SolFla == -1) THEN
CALL ShowWarningError('Iteration limit exceeded in calculating fluid cooler UA.')
CALL ShowContinueError('Autosizing of fluid cooler UA failed for fluid cooler = '//&
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
CALL ShowContinueError('The final UA value =' //TRIM(RoundSigDigits(UA,2))//' W/K, and the simulation continues...')
ELSEIF (SolFla == -2) THEN
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA0,OutWaterTempAtUA0)
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA1,OutWaterTempAtUA1)
CALL ShowSevereError(CalledFrom//': The combination of design input values did not allow the calculation of a ')
CALL ShowContinueError('reasonable UA value. Review and revise design input values as appropriate. Specifying hard')
CALL ShowContinueError('sizes for some "autosizable" fields while autosizing other "autosizable" fields may be ')
CALL ShowContinueError('contributing to this problem.')
CALL ShowContinueError('This model iterates on UA to find the heat transfer required to provide the design outlet ')
CALL ShowContinueError('water temperature. Initially, the outlet water temperatures at high and low UA values are ')
CALL ShowContinueError('calculated. The Design Exit Water Temperature should be between the outlet water ')
CALL ShowContinueError('temperatures calculated at high and low UA values. If the Design Exit Water Temperature is ')
CALL ShowContinueError('out of this range, the solution will not converge and UA will not be calculated. ')
CALL ShowContinueError('The possible solutions could be to manually input adjusted water and/or air flow rates based ')
CALL ShowContinueError('on the autosized values shown below or to adjust design fluid cooler air inlet dry-bulb ' // &
'temperature.')
CALL ShowContinueError('Plant:Sizing object inputs also influence these results (e.g. DeltaT and ExitTemp).')
CALL ShowContinueError('Inputs to the fluid cooler object:')
CALL ShowContinueError('Design Fluid Cooler Load [W] = '//TRIM(RoundSigDigits(Par(1),2)))
CALL ShowContinueError('Design Fluid Cooler Water Volume Flow Rate [m3/s] = '// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate,6)))
CALL ShowContinueError('Design Fluid Cooler Air Volume Flow Rate [m3/s] = '//TRIM(RoundSigDigits(Par(4),2)))
CALL ShowContinueError('Design Fluid Cooler Air Inlet Dry-bulb Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp,2)))
CALL ShowContinueError('Inputs to the plant sizing object:')
CALL ShowContinueError('Design Exit Water Temp [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)))
CALL ShowContinueError('Loop Design Temperature Difference [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%DeltaT,2)))
CALL ShowContinueError('Design Fluid Cooler Water Inlet Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp,2)))
CALL ShowContinueError('Calculated water outlet temp at low UA [C] (UA = '// &
TRIM(RoundSigDigits(UA0,2))//' W/K) = '// TRIM(RoundSigDigits(OutWaterTempAtUA0,2)))
CALL ShowContinueError('Calculated water outlet temp at high UA [C](UA = '// &
TRIM(RoundSigDigits(UA1,2))//' W/K) = '// TRIM(RoundSigDigits(OutWaterTempAtUA1,2)))
CALL ShowFatalError('Autosizing of Fluid Cooler UA failed for fluid cooler = '// &
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
ENDIF
tmpHighSpeedEvapFluidCoolerUA = UA
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA = tmpHighSpeedEvapFluidCoolerUA
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity = DesFluidCoolerLoad
ELSE
tmpHighSpeedEvapFluidCoolerUA = 0.d0
IF (PlantSizesOkayToFinalize) SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA = tmpHighSpeedEvapFluidCoolerUA
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_SingleSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'U-factor Times Area Value at Design Air Flow Rate [W/K]', &
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA)
ELSEIF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_TwoSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'U-factor Times Area Value at High Fan Speed [W/K]', &
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA)
ENDIF
ELSE
CALL ShowSevereError('Autosizing error for fluid cooler object = '//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
CALL ShowFatalError('Autosizing of fluid cooler UA requires a loop Sizing:Plant object.')
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity) THEN
IF (SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate >= SmallWaterVolFlow) THEN
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity
Par(1) = DesFluidCoolerLoad
Par(2) = REAL(FluidCoolerNum,r64)
Par(3) = rho * tmpDesignWaterFlowRate ! design water mass flow rate
Par(4) = tmpHighSpeedAirFlowRate ! design air volume flow rate
Par(5) = Cp
UA0 = 0.0001d0 * DesFluidCoolerLoad ! Assume deltaT = 10000K (limit)
UA1 = DesFluidCoolerLoad ! Assume deltaT = 1K
SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp ! design inlet water temperature
SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ! design inlet air dry-bulb temp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirWetbulbTemp ! design inlet air wet-bulb temp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress = StdBaroPress
SimpleFluidCoolerInlet(FluidCoolerNum)%AirHumRat = &
PsyWFnTdbTwbPb(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, UA, SimpleFluidCoolerUAResidual, UA0, UA1, Par)
IF (SolFla == -1) THEN
CALL ShowWarningError('Iteration limit exceeded in calculating fluid cooler UA.')
CALL ShowContinueError('Autosizing of fluid cooler UA failed for fluid cooler = '//&
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
CALL ShowContinueError('The final UA value =' //TRIM(RoundSigDigits(UA,2))//' W/K, and the simulation continues...')
ELSEIF (SolFla == -2) THEN
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA0,OutWaterTempAtUA0)
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA1,OutWaterTempAtUA1)
CALL ShowSevereError(CalledFrom//': The combination of design input values did not allow the calculation of a ')
CALL ShowContinueError('reasonable UA value. Review and revise design input values as appropriate. Specifying hard')
CALL ShowContinueError('sizes for some "autosizable" fields while autosizing other "autosizable" fields may be ')
CALL ShowContinueError('contributing to this problem.')
CALL ShowContinueError('This model iterates on UA to find the heat transfer required to provide the design outlet ')
CALL ShowContinueError('water temperature. Initially, the outlet water temperatures at high and low UA values are ')
CALL ShowContinueError('calculated. The Design Exit Water Temperature should be between the outlet water ')
CALL ShowContinueError('temperatures calculated at high and low UA values. If the Design Exit Water Temperature is ')
CALL ShowContinueError('out of this range, the solution will not converge and UA will not be calculated. ')
CALL ShowContinueError('The possible solutions could be to manually input adjusted water and/or air flow rates based ')
CALL ShowContinueError('on the autosized values shown below or to adjust design fluid cooler air inlet dry-bulb ' // &
'temperature.')
CALL ShowContinueError('Plant:Sizing object inputs also influence these results (e.g. DeltaT and ExitTemp).')
CALL ShowContinueError('Inputs to the fluid cooler object:')
CALL ShowContinueError('Design Fluid Cooler Load [W] = '//TRIM(RoundSigDigits(Par(1),2)))
CALL ShowContinueError('Design Fluid Cooler Water Volume Flow Rate [m3/s] = '// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate,6)))
CALL ShowContinueError('Design Fluid Cooler Air Volume Flow Rate [m3/s] = '//TRIM(RoundSigDigits(Par(4),2)))
CALL ShowContinueError('Design Fluid Cooler Air Inlet Dry-bulb Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp,2)))
CALL ShowContinueError('Inputs to the plant sizing object:')
CALL ShowContinueError('Design Exit Water Temp [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)))
CALL ShowContinueError('Loop Design Temperature Difference [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%DeltaT,2)))
CALL ShowContinueError('Design Fluid Cooler Water Inlet Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp,2)))
CALL ShowContinueError('Calculated water outlet temp at low UA [C] (UA = '// &
TRIM(RoundSigDigits(UA0,2))//' W/K) = '// TRIM(RoundSigDigits(OutWaterTempAtUA0,2)))
CALL ShowContinueError('Calculated water outlet temp at high UA [C] (UA = '// &
TRIM(RoundSigDigits(UA1,2))//' W/K) = '// TRIM(RoundSigDigits(OutWaterTempAtUA1,2)))
CALL ShowFatalError('Autosizing of Fluid Cooler UA failed for fluid cooler = '// &
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
ENDIF
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA = UA
ELSE
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA = 0.0d0
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_SingleSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'Fluid cooler UA value at design air flow rate based on nominal capacity input [W/K]', &
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA)
ELSEIF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_TwoSpeed) THEN
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'Fluid cooler UA value at high fan speed based on nominal capacity input [W/K]', &
SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA)
ENDIF
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRate == AutoSize .AND. PlantSizesOkayToFinalize ) THEN
SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRate = SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRateSizingFactor &
* SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Air Flow Rate at Low Fan Speed [m3/s]', SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRate)
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%LowSpeedFanPower == AutoSize .AND. PlantSizesOkayToFinalize ) THEN
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFanPower = SimpleFluidCooler(FluidCoolerNum)%LowSpeedFanPowerSizingFactor &
* SimpleFluidCooler(FluidCoolerNum)%HighSpeedFanPower
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Fan Power at Low Fan Speed [W]', SimpleFluidCooler(FluidCoolerNum)%LowSpeedFanPower)
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA == AutoSize .AND. PlantSizesOkayToFinalize ) THEN
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA = &
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUASizingFactor &
* SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'U-factor Times Area Value at Low Fan Speed [W/K]', SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA)
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity .AND. &
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_TwoSpeed) THEN
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCap == Autosize) THEN
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCap = &
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCapSizingFactor &
* SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity
CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, SimpleFluidCooler(FluidCoolerNum)%Name, &
'Low Fan Speed Nominal Capacity [W]', SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCap)
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate >= SmallWaterVolFlow .AND. &
SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCap > 0.0d0) THEN
rho = GetDensityGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
InitConvTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex,&
'SizeFluidCooler')
Cp = GetSpecificHeatGlycol(PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidName, &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp, &
PlantLoop(SimpleFluidCooler(FluidCoolerNum)%LoopNum)%FluidIndex, &
'SizeFluidCooler')
DesFluidCoolerLoad = SimpleFluidCooler(FluidCoolerNum)%FluidCoolerLowSpeedNomCap
Par(1) = DesFluidCoolerLoad
Par(2) = REAL(FluidCoolerNum,r64)
Par(3) = rho * tmpDesignWaterFlowRate ! design water mass flow rate
Par(4) = SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRate ! Air volume flow rate at low fan speed
Par(5) = Cp
UA0 = 0.0001d0 * DesFluidCoolerLoad ! Assume deltaT = 10000K (limit)
UA1 = DesFluidCoolerLoad ! Assume deltaT = 1K
SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringWaterTemp ! design inlet water temperature
SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirTemp ! design inlet air dry-bulb temp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb = &
SimpleFluidCooler(FluidCoolerNum)%DesignEnteringAirWetbulbTemp ! design inlet air wet-bulb temp
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress = StdBaroPress
SimpleFluidCoolerInlet(FluidCoolerNum)%AirHumRat = &
PsyWFnTdbTwbPb(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirWetBulb, &
SimpleFluidCoolerInlet(FluidCoolerNum)%AirPress,CalledFrom)
CALL SolveRegulaFalsi(Acc, MaxIte, SolFla, UA, SimpleFluidCoolerUAResidual, UA0, UA1, Par)
IF (SolFla == -1) THEN
CALL ShowWarningError('Iteration limit exceeded in calculating fluid cooler UA.')
CALL ShowContinueError('Autosizing of fluid cooler UA failed for fluid cooler = '//&
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
CALL ShowContinueError('The final UA value at low fan speed =' //TRIM(RoundSigDigits(UA,2))// &
' W/C, and the simulation continues...')
ELSEIF (SolFla == -2) THEN
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA0,OutWaterTempAtUA0)
CALL SimSimpleFluidCooler(INT(Par(2)),Par(3),Par(4),UA1,OutWaterTempAtUA1)
CALL ShowSevereError(CalledFrom//': The combination of design input values did not allow the calculation of a ')
CALL ShowContinueError('reasonable low-speed UA value. Review and revise design input values as appropriate. ')
CALL ShowContinueError('Specifying hard sizes for some "autosizable" fields while autosizing other "autosizable" ')
CALL ShowContinueError('fields may be contributing to this problem.')
CALL ShowContinueError('This model iterates on UA to find the heat transfer required to provide the design outlet ')
CALL ShowContinueError('water temperature. Initially, the outlet water temperatures at high and low UA values are ')
CALL ShowContinueError('calculated. The Design Exit Water Temperature should be between the outlet water ')
CALL ShowContinueError('temperatures calculated at high and low UA values. If the Design Exit Water Temperature is ')
CALL ShowContinueError('out of this range, the solution will not converge and UA will not be calculated. ')
CALL ShowContinueError('The possible solutions could be to manually input adjusted water and/or air flow rates based ')
CALL ShowContinueError('on the autosized values shown below or to adjust design fluid cooler air inlet dry-bulb ' // &
'temperature.')
CALL ShowContinueError('Plant:Sizing object inputs also influence these results (e.g. DeltaT and ExitTemp).')
CALL ShowContinueError('Inputs to the fluid cooler object:')
CALL ShowContinueError('Design Fluid Cooler Load [W] = '//TRIM(RoundSigDigits(Par(1),2)))
CALL ShowContinueError('Design Fluid Cooler Water Volume Flow Rate [m3/s] = '// &
TRIM(RoundSigDigits(SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate,6)))
CALL ShowContinueError('Design Fluid Cooler Air Volume Flow Rate [m3/s] = '//TRIM(RoundSigDigits(Par(4),2)))
CALL ShowContinueError('Design Fluid Cooler Air Inlet Dry-bulb Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%AirTemp,2)))
CALL ShowContinueError('Inputs to the plant sizing object:')
CALL ShowContinueError('Design Exit Water Temp [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%ExitTemp,2)))
CALL ShowContinueError('Loop Design Temperature Difference [C] = '// &
TRIM(RoundSigDigits(PlantSizData(PltSizCondNum)%DeltaT,2)))
CALL ShowContinueError('Design Fluid Cooler Water Inlet Temp [C] = '// &
TRIM(RoundSigDigits(SimpleFluidCoolerInlet(FluidCoolerNum)%WaterTemp,2)))
CALL ShowContinueError('Calculated water outlet temp at low UA [C](UA = '// &
TRIM(RoundSigDigits(UA0,2))//' W/C) = '// TRIM(RoundSigDigits(OutWaterTempAtUA0,2)))
CALL ShowContinueError('Calculated water outlet temp at high UA [C](UA = '// &
TRIM(RoundSigDigits(UA1,2))//' W/C) = '// TRIM(RoundSigDigits(OutWaterTempAtUA1,2)))
CALL ShowFatalError('Autosizing of Fluid Cooler UA failed for fluid cooler = '// &
TRIM(SimpleFluidCooler(FluidCoolerNum)%Name))
ENDIF
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA = UA
ELSE
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA = 0.0d0
ENDIF
IF (PlantSizesOkayToFinalize) CALL ReportSizingOutput(SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType, &
SimpleFluidCooler(FluidCoolerNum)%Name, &
'U-factor Times Area Value at Low Fan Speed [W/C]', &
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA)
ENDIF
ErrorsFound = .FALSE.
IF (PlantSizesOkayToFinalize) THEN
!create predefined report
equipName = SimpleFluidCooler(FluidCoolerNum)%Name
CALL PreDefTableEntry(pdchMechType,equipName,SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType)
CALL PreDefTableEntry(pdchMechNomCap,equipName,SimpleFluidCooler(FluidCoolerNum)%FluidCoolerNominalCapacity)
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%FluidCoolerType_Num == FluidCooler_TwoSpeed) THEN
IF (SimpleFluidCooler(FluidCoolerNum)%DesignWaterFlowRate > 0.0d0) THEN
IF (SimpleFluidCooler(FluidCoolerNum)%HighSpeedAirFlowRate <= &
SimpleFluidCooler(FluidCoolerNum)%LowSpeedAirFlowRate) THEN
CALL ShowSevereError('FluidCooler:TwoSpeed "'//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//&
'". Low speed air flow rate must be less than high speed air flow rate.')
ErrorsFound=.true.
ENDIF
IF (SimpleFluidCooler(FluidCoolerNum)%HighSpeedFluidCoolerUA <= &
SimpleFluidCooler(FluidCoolerNum)%LowSpeedFluidCoolerUA) THEN
CALL ShowSevereError('FluidCooler:TwoSpeed "'//TRIM(SimpleFluidCooler(FluidCoolerNum)%Name)//&
'". Fluid cooler UA at low fan speed must be less than the fluid cooler UA at high fan speed.')
ErrorsFound=.true.
ENDIF
END IF
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('SizeFluidCooler: Program terminated due to previous condition(s).')
ENDIF
RETURN
END SUBROUTINE SizeFluidCooler