SUBROUTINE GetTowerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: April 1998
! MODIFIED Don Shirey, Jan 2001 and Sept/Oct 2002; Richard Raustad, FSEC, Feb 2005 (added VS tower)
! B. Griffith, Aug. 2006 water consumption modeling and water system connections
! T Hong, Aug. 2008: added fluid bypass for single speed tower
! A Flament, July 2010, added multi-cell capability for the 3 types of cooling tower
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Obtains input data for cooling towers and stores it in SimpleTower data structure. Additional structure
! (VSTower) stores the coefficients for each VS tower.
! METHODOLOGY EMPLOYED:
! Uses "Get" routines to read in the data.
! REFERENCES:
! na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, MakeUPPERCase
USE DataIPShortCuts ! Data for field names, blank numerics
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE DataSizing, ONLY: AutoSize
USE CurveManager, ONLY: GetCurveIndex
USE ScheduleManager, ONLY: GetScheduleIndex
USE WaterManager , ONLY: SetupTankDemandComponent
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
USE General, ONLY: TrimSigDigits
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: OutputFormat ='(F5.2)'
CHARACTER(len=*), PARAMETER :: Blank = ' '
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: TowerNum ! Tower number, reference counter for SimpleTower data array
INTEGER :: NumSingleSpeedTowers ! Total number of single-speed cooling towers
INTEGER :: SingleSpeedTowerNumber ! Specific single-speed tower of interest
INTEGER :: NumTwoSpeedTowers ! Number of two-speed cooling towers
INTEGER :: TwoSpeedTowerNumber ! Specific two-speed tower of interest
INTEGER :: NumVariableSpeedTowers ! Number of variable-speed cooling towers
INTEGER :: VariableSpeedTowerNumber ! Specific variable-speed tower of interest
INTEGER :: NumVSCoolToolsModelCoeffs ! Number of CoolTools VS cooling tower coefficient objects
INTEGER :: NumVSYorkCalcModelCoeffs ! Number of YorkCalc VS cooling tower coefficient objects
INTEGER :: NumVSMerkelTowers ! Number of Merkel variable speed cooling towers
INTEGER :: MerkelVSTowerNum ! specific merkel variable speed tower of interest
INTEGER :: VSModelCoeffNum ! Specific variable-speed tower coefficient object of interest
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: NumAlphas2 ! Number of elements in the alpha2 array
INTEGER :: NumNums2 ! Number of elements in the numeric2 array
INTEGER :: IOStat ! IO Status when calling get input subroutine
INTEGER :: CoeffNum ! Index for reading user defined VS tower coefficients
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL, SAVE :: ErrorsFound=.false. ! Logical flag set .true. if errors found while getting input data
CHARACTER(len=6) :: OutputChar ! report variable for warning messages
CHARACTER(len=6) :: OutputCharLo ! report variable for warning messages
CHARACTER(len=6) :: OutputCharHi ! report variable for warning messages
REAL(r64), DIMENSION(29) :: NumArray ! Numeric input data array
REAL(r64), DIMENSION(43) :: NumArray2 ! Numeric input data array for VS tower coefficients
CHARACTER(len=MaxNameLength),DIMENSION(15) :: AlphArray ! Character string input data array
CHARACTER(len=MaxNameLength),DIMENSION(1) :: AlphArray2 ! Character string input data array for VS tower coefficients
! Get number of all cooling towers specified in the input data file (idf)
NumSingleSpeedTowers = GetNumObjectsFound(cCoolingTower_SingleSpeed)
NumTwoSpeedTowers = GetNumObjectsFound(cCoolingTower_TwoSpeed)
NumVariableSpeedTowers = GetNumObjectsFound(cCoolingTower_VariableSpeed)
NumVSMerkelTowers = GetNumObjectsFound(cCoolingTower_VariableSpeedMerkel)
NumSimpleTowers = NumSingleSpeedTowers + NumTwoSpeedTowers + NumVariableSpeedTowers + NumVSMerkelTowers
IF (NumSimpleTowers <=0 ) &
CALL ShowFatalError('No Cooling Tower objects found in input, however, a branch object has specified a cooling tower. '//&
'Search the input for CoolingTower to determine the cause for this error.')
! See if load distribution manager has already gotten the input
IF (ALLOCATED(SimpleTower))RETURN
! Allocate data structures to hold tower input data, report data and tower inlet conditions
ALLOCATE (SimpleTower(NumSimpleTowers))
ALLOCATE (SimpleTowerReport(NumSimpleTowers))
ALLOCATE (SimpleTowerInlet(NumSimpleTowers))
ALLOCATE(CheckEquipName(NumSimpleTowers))
CheckEquipName=.true.
! Allocate variable-speed tower structure with data specific to this type
IF(NumVariableSpeedTowers .GT. 0)THEN
ALLOCATE (VSTower(NumVariableSpeedTowers))
! Allow users to input model coefficients other than default
NumVSCoolToolsModelCoeffs = GetNumObjectsFound('CoolingTowerPerformance:CoolTools')
NumVSYorkCalcModelCoeffs = GetNumObjectsFound('CoolingTowerPerformance:YorkCalc')
END IF
! Load data structures with cooling tower input data
cCurrentModuleObject = cCoolingTower_SingleSpeed
DO SingleSpeedTowerNumber = 1 , NumSingleSpeedTowers
TowerNum = SingleSpeedTowerNumber
CALL GetObjectItem(cCurrentModuleObject,SingleSpeedTowerNumber,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, AlphaFieldnames=cAlphaFieldNames, &
NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),SimpleTower%Name,TowerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
SimpleTower(TowerNum)%Name = AlphArray(1)
SimpleTower(TowerNum)%TowerType = TRIM(cCurrentModuleObject)
SimpleTower(TowerNum)%TowerType_Num = CoolingTower_SingleSpeed
SimpleTower(TowerNum)%TowerMassFlowRateMultiplier = 2.5d0
SimpleTower(TowerNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
SimpleTower(TowerNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Chilled Water Nodes')
SimpleTower(TowerNum)%DesignWaterFlowRate = NumArray(1)
SimpleTower(TowerNum)%HighSpeedAirFlowRate = NumArray(2)
SimpleTower(TowerNum)%HighSpeedFanPower = NumArray(3)
SimpleTower(TowerNum)%HighSpeedTowerUA = NumArray(4)
SimpleTower(TowerNum)%FreeConvAirFlowRate = NumArray(5)
SimpleTower(TowerNum)%FreeConvAirFlowRateSizingFactor = NumArray(6)
SimpleTower(TowerNum)%FreeConvTowerUA = NumArray(7)
SimpleTower(TowerNum)%FreeConvTowerUASizingFactor = NumArray(8)
SimpleTower(TowerNum)%HeatRejectCapNomCapSizingRatio = NumArray(9)
SimpleTower(TowerNum)%TowerNominalCapacity = NumArray(10)
SimpleTower(TowerNum)%TowerFreeConvNomCap = NumArray(11)
SimpleTower(TowerNum)%TowerFreeConvNomCapSizingFactor = NumArray(12)
IF (NumAlphas >= 4) THEN
IF (SameString(AlphArray(4),'UFactorTimesAreaAndDesignWaterFlowRate')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
ELSEIF (SameString(AlphArray(4),'NominalCapacity')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_NominalCapacity
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(AlphArray(4)))
errorsfound = .true.
ENDIF
ELSE
! Since Performance Input Method has been omitted then assume it to be UA and DESIGN WATER FLOW RATE
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
ENDIF
! Basin heater power as a function of temperature must be greater than or equal to 0
SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff = NumArray(13)
IF(NumArray(13) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater power as a function of temperature difference must be >= 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = NumArray(14)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 14) THEN
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(simpleTower(TowerNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//':"'//TRIM(SimpleTower(TowerNum)%Name)//&
'", '//TRIM(cNumericFieldNames(14))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(AlphArray(5) .NE. Blank)THEN
SimpleTower(TowerNum)%BasinHeaterSchedulePtr = GetScheduleIndex(AlphArray(5))
IF(SimpleTower(TowerNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater schedule name "'//TRIM(AlphArray(5)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
! begin water use and systems get input
IF (SameString(AlphArray(6),'LossFactor')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByUserFactor
ELSEIF (SameString(AlphArray(6), 'SaturatedExit')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSEIF (AlphArray(6) == Blank) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(6))//' = '//TRIM(AlphArray(6)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UserEvapLossFactor = NumArray(15) ! N11 , \field Evaporation Loss Factor
SimpleTower(TowerNum)%DriftLossFraction = NumArray(16)/100.0d0 ! N12, \field Drift Loss Percent
If ((NumNums < 16) .and. (SimpleTower(TowerNum)%DriftLossFraction == 0.0d0) ) Then
! assume Drift loss not entered and should be defaulted
SimpleTower(TowerNum)%DriftLossFraction = 0.008d0 /100.0d0
endif
SimpleTower(TowerNum)%ConcentrationRatio = NumArray(17) ! N13, \field Blowdown Concentration Ratio
SimpleTower(TowerNum)%SizFac = NumArray(21) ! N17 \field Sizing Factor
IF (SimpleTower(TowerNum)%SizFac <= 0.0d0) SimpleTower(TowerNum)%SizFac = 1.0d0
If (SameString(AlphArray(7), 'ScheduledRate')) then
SimpleTower(TowerNum)%BlowdownMode = BlowdownBySchedule
ELSEIF (SameString(AlphArray(7), 'ConcentrationRatio')) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
ELSEIF (AlphArray(7) == Blank) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
If ((NumNums < 17) .and.(SimpleTower(TowerNum)%ConcentrationRatio == 0.0d0) ) THEN
! assume Concetratino ratio was omitted and should be defaulted
SimpleTower(TowerNum)%ConcentrationRatio = 3.0d0
endif
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(7))//' = '//TRIM(AlphArray(7)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%SchedIDBlowdown = GetScheduleIndex(AlphArray(8))
If ((SimpleTower(TowerNum)%SchedIDBlowdown == 0) .AND. (SimpleTower(TowerNum)%BlowdownMode == BlowdownBySchedule))Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(8))//' = '//TRIM(AlphArray(8)))
errorsfound = .true.
endif
IF (AlphArray(9) == Blank) THEN
SimpleTower(TowerNum)%SuppliedByWaterSystem = .false.
ELSE ! water from storage tank
!
Call SetupTankDemandComponent(AlphArray(1), TRIM(cCurrentModuleObject), AlphArray(9), ErrorsFound, &
SimpleTower(TowerNum)%WaterTankID, SimpleTower(TowerNum)%WaterTankDemandARRID)
SimpleTower(TowerNum)%SuppliedByWaterSystem = .TRUE.
ENDIF
! outdoor air inlet node
IF (lAlphaFieldBlanks(10)) THEN
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = 0
ELSE
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = &
GetOnlySingleNode(AlphArray(10),ErrorsFound,TRIM(cCurrentModuleObject),SimpleTower(TowerNum)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF(.not. CheckOutAirNodeNumber(SimpleTower(TowerNum)%OutdoorAirInletNodeNum))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" Outdoor Air Inlet Node Name not valid Outdoor Air Node= '//TRIM(AlphArray(10)))
CALL ShowContinueError('...does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.true.
END IF
ENDIF
! fluid bypass for single speed tower
IF (lAlphaFieldBlanks(11).or.AlphArray(11) == Blank) THEN
SimpleTower(TowerNum)%CapacityControl = CapacityControl_FanCycling ! FanCycling
ELSE
SELECT CASE (MakeUPPERCase(AlphArray(11)))
CASE ('FANCYCLING')
SimpleTower(TowerNum)%CapacityControl = CapacityControl_FanCycling
CASE ('FLUIDBYPASS')
SimpleTower(TowerNum)%CapacityControl = CapacityControl_FluidBypass
CASE DEFAULT
SimpleTower(TowerNum)%CapacityControl = CapacityControl_FanCycling
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" The Capacity Control is not specified correctly. The default Fan Cycling is used.')
END SELECT
ENDIF
!added for multi-cell
SimpleTower(TowerNum)%NumCell = NumArray(18)
If ((NumNums < 18) .and. (SimpleTower(TowerNum)%NumCell == 0) ) Then
! assume Number of Cells not entered and should be defaulted
SimpleTower(TowerNum)%NumCell = 1
endif
SimpleTower(TowerNum)%MinFracFlowRate = NumArray(19)
If ((NumNums < 19) .and. (SimpleTower(TowerNum)%MinFracFlowRate == 0.0d0) ) Then
! assume Cell Minimum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MinFracFlowRate = 0.33d0
endif
SimpleTower(TowerNum)%MaxFracFlowRate = NumArray(20)
If ((NumNums < 20) .and. (SimpleTower(TowerNum)%MaxFracFlowRate == 0.0d0) ) Then
! assume Cell Maximum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MaxFracFlowRate = 2.5d0
endif
IF (NumAlphas >= 12) THEN
IF (lAlphaFieldBlanks(12).or.AlphArray(12) == Blank) THEN
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
ELSE
IF (SameString(AlphArray(12),'MinimalCell') .OR. &
SameString(AlphArray(12),'MaximalCell') ) THEN
IF (SameString(AlphArray(12),'MinimalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MinCell
SimpleTower(TowerNum)%CellCtrl='MinimalCell'
ENDIF
IF (SameString(AlphArray(12),'MaximalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
SimpleTower(TowerNum)%CellCtrl='MaximalCell'
ENDIF
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(12))//' = '//TRIM(AlphArray(12)))
CALL ShowContinueError('Occurs in '//SimpleTower(TowerNum)%TowerType//'='//TRIM(SimpleTower(TowerNum)%Name))
ErrorsFound=.TRUE.
END IF
END IF
ELSE
!assume Cell Control not entered and should be defaulted
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
END IF
! High speed air flow rate must be greater than free convection air flow rate.
! Can't tell yet if autosized, check later in InitTower.
IF (SimpleTower(TowerNum)%HighSpeedAirFlowRate <= SimpleTower(TowerNum)%FreeConvAirFlowRate .and. &
SimpleTower(TowerNum)%HighSpeedAirFlowRate .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow rate must be less than the design air flow rate.')
ErrorsFound=.true.
ENDIF
! Check various inputs if Performance Input Method = "UA and Design Water Flow Rate"
IF (SimpleTower(TowerNum)%PerformanceInputMethod_Num == PIM_UFactor) THEN
IF (SimpleTower(TowerNum)%DesignWaterFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower performance input method requires a design water flow rate greater than zero.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%HighSpeedTowerUA <= SimpleTower(TowerNum)%FreeConvTowerUA .and. &
SimpleTower(TowerNum)%HighSpeedTowerUA .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection UA must be less than the design tower UA.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%FreeConvTowerUA > 0.0d0 .and. SimpleTower(TowerNum)%FreeConvAirFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow rate must be greater than zero when free convection UA is greater than zero.')
ErrorsFound=.true.
END IF
ELSEIF(SimpleTower(TowerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity) THEN
IF (SimpleTower(TowerNum)%TowerNominalCapacity == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower performance input method requires valid nominal capacity.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%DesignWaterFlowRate .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%DesignWaterFlowRate > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and design water flow rate have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and design water flow rate is being autosized.')
ENDIF
CALL ShowContinueError('Design water flow rate must be left blank when nominal tower capacity input method is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%HighSpeedTowerUA .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%HighSpeedTowerUA > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal tower capacity and design tower UA have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal tower capacity has been specified and design tower UA is being autosized.')
ENDIF
CALL ShowContinueError('Design tower UA field must be left blank when nominal tower capacity input method is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%FreeConvTowerUA .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%FreeConvTowerUA > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and free convection UA have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and free convection UA is being autosized.')
ENDIF
CALL ShowContinueError('Free convection UA should be left blank when nominal tower capacity input method is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%TowerFreeConvNomCap >= SimpleTower(TowerNum)%TowerNominalCapacity) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection nominal capacity must be less than the nominal (design) tower capacity.')
ErrorsFound=.true.
END IF
IF (SimpleTower(TowerNum)%TowerFreeConvNomCap > 0.0d0 .and. SimpleTower(TowerNum)%FreeConvAirFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow must be greater than zero when tower free convection capacity is specified.')
ErrorsFound=.true.
END IF
ELSE ! Tower performance input method is not specified as a valid "choice"
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower Performance Input Method must be "UFactorTimesAreaAndDesignWaterFlowRate" or "NominalCapacity".')
CALL ShowContinueError('Tower Performanace Input Method currently specified as: '// &
TRIM(AlphArray(4)))
ErrorsFound=.true.
ENDIF
END DO ! End Single-Speed Tower Loop
cCurrentModuleObject = cCoolingTower_TwoSpeed
DO TwoSpeedTowerNumber = 1 , NumTwoSpeedTowers
TowerNum = NumSingleSpeedTowers + TwoSpeedTowerNumber
CALL GetObjectItem(cCurrentModuleObject,TwoSpeedTowerNumber,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),SimpleTower%Name,TowerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
SimpleTower(TowerNum)%Name = AlphArray(1)
SimpleTower(TowerNum)%TowerType = TRIM(cCurrentModuleObject)
SimpleTower(TowerNum)%TowerType_Num = CoolingTower_TwoSpeed
SimpleTower(TowerNum)%TowerMassFlowRateMultiplier = 2.5d0
SimpleTower(TowerNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
SimpleTower(TowerNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Chilled Water Nodes')
IF (NumAlphas >= 4) THEN
IF (SameString(AlphArray(4),'UFactorTimesAreaAndDesignWaterFlowRate')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
ELSEIF (SameString(AlphArray(4),'NominalCapacity')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_NominalCapacity
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(AlphArray(4)))
errorsfound = .true.
ENDIF
ELSE
! Since Performance Input Method has been omitted then assume it to be UA and DESIGN WATER FLOW RATE
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
ENDIF
SimpleTower(TowerNum)%DesignWaterFlowRate = NumArray(1)
SimpleTower(TowerNum)%HighSpeedAirFlowRate = NumArray(2)
SimpleTower(TowerNum)%HighSpeedFanPower = NumArray(3)
SimpleTower(TowerNum)%HighSpeedTowerUA = NumArray(4)
SimpleTower(TowerNum)%LowSpeedAirFlowRate = NumArray(5)
SimpleTower(TowerNum)%LowSpeedAirFlowRateSizingFactor = NumArray(6)
SimpleTower(TowerNum)%LowSpeedFanPower = NumArray(7)
SimpleTower(TowerNum)%LowSpeedFanPowerSizingFactor = NumArray(8)
SimpleTower(TowerNum)%LowSpeedTowerUA = NumArray(9)
SimpleTower(TowerNum)%LowSpeedTowerUASizingFactor = NumArray(10)
SimpleTower(TowerNum)%FreeConvAirFlowRate = NumArray(11)
SimpleTower(TowerNum)%FreeConvAirFlowRateSizingFactor = NumArray(12)
SimpleTower(TowerNum)%FreeConvTowerUA = NumArray(13)
SimpleTower(TowerNum)%FreeConvTowerUASizingFactor = NumArray(14)
SimpleTower(TowerNum)%HeatRejectCapNomCapSizingRatio = NumArray(15)
SimpleTower(TowerNum)%TowerNominalCapacity = NumArray(16)
SimpleTower(TowerNum)%TowerLowSpeedNomCap = NumArray(17)
SimpleTower(TowerNum)%TowerLowSpeedNomCapSizingFactor = NumArray(18)
SimpleTower(TowerNum)%TowerFreeConvNomCap = NumArray(19)
SimpleTower(TowerNum)%TowerFreeConvNomCapSizingFactor = NumArray(20)
! Basin heater power as a function of temperature must be greater than or equal to 0
SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff = NumArray(21)
IF(NumArray(21) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater power as a function of temperature difference must be >= 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = NumArray(22)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 22) THEN
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(simpleTower(TowerNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//':"'//TRIM(SimpleTower(TowerNum)%Name)//&
'", '//TRIM(cNumericFieldNames(22))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(AlphArray(5) .NE. Blank)THEN
SimpleTower(TowerNum)%BasinHeaterSchedulePtr = GetScheduleIndex(AlphArray(5))
IF(SimpleTower(TowerNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater schedule name "'//TRIM(AlphArray(5)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
! begin water use and systems get input
IF (SameString(AlphArray(6),'LossFactor')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByUserFactor
ELSEIF (SameString(AlphArray(6), 'SaturatedExit')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSEIF (lAlphaFieldBlanks(6)) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(AlphArray(6)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UserEvapLossFactor = NumArray(23) ! N23 , \field Evaporation Loss Factor
SimpleTower(TowerNum)%DriftLossFraction = NumArray(24) / 100.0d0 ! N24, \field Drift Loss Percent
If ((NumNums < 24) .and. (SimpleTower(TowerNum)%DriftLossFraction == 0.0d0) ) Then
! assume Drift loss not entered and should be defaulted
SimpleTower(TowerNum)%DriftLossFraction = 0.008d0 /100.0d0
endif
SimpleTower(TowerNum)%ConcentrationRatio = NumArray(25) ! N17, \field Blowdown Concentration Ratio
SimpleTower(TowerNum)%SizFac = NumArray(29) ! N21 \field Sizing Factor
IF (SimpleTower(TowerNum)%SizFac <= 0.0d0) SimpleTower(TowerNum)%SizFac = 1.0d0
If (SameString(AlphArray(7), 'ScheduledRate')) then
SimpleTower(TowerNum)%BlowdownMode = BlowdownBySchedule
ELSEIF (SameString(AlphArray(7), 'ConcentrationRatio')) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
ELSEIF (lAlphaFieldBlanks(7)) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
If ((NumNums < 25) .and.(SimpleTower(TowerNum)%ConcentrationRatio == 0.0d0) ) THEN
! assume Concetration ratio was omitted and should be defaulted
SimpleTower(TowerNum)%ConcentrationRatio = 3.0d0
endif
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(AlphArray(7)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%SchedIDBlowdown = GetScheduleIndex(AlphArray(8))
If ((SimpleTower(TowerNum)%SchedIDBlowdown == 0) .AND. (SimpleTower(TowerNum)%BlowdownMode == BlowdownBySchedule)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(AlphArray(8)))
errorsfound = .true.
endif
!added for multi-cell
SimpleTower(TowerNum)%NumCell = NumArray(26)
If ((NumNums < 26) .and. (SimpleTower(TowerNum)%NumCell == 0) ) Then
! assume Number of Cells not entered and should be defaulted
SimpleTower(TowerNum)%NumCell = 1
endif
SimpleTower(TowerNum)%MinFracFlowRate = NumArray(27)
If ((NumNums < 27) .and. (SimpleTower(TowerNum)%MinFracFlowRate == 0.0d0) ) Then
! assume Cell Minimum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MinFracFlowRate = 0.33d0
endif
SimpleTower(TowerNum)%MaxFracFlowRate = NumArray(28)
If ((NumNums < 28) .and. (SimpleTower(TowerNum)%MaxFracFlowRate == 0.0d0) ) Then
! assume Cell Maximum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MaxFracFlowRate = 2.5d0
endif
IF (NumAlphas >= 11) THEN
IF (lAlphaFieldBlanks(11).or.AlphArray(11) == Blank) THEN
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
ELSE
IF (SameString(AlphArray(11),'MinimalCell') .OR. &
SameString(AlphArray(11),'MaximalCell') ) THEN
IF (SameString(AlphArray(11),'MinimalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MinCell
SimpleTower(TowerNum)%CellCtrl= 'MinimalCell'
ENDIF
IF (SameString(AlphArray(11),'MaximalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
ENDIF
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(12))//' = '//TRIM(AlphArray(12)))
CALL ShowContinueError('Occurs in '//SimpleTower(TowerNum)%TowerType//'='//TRIM(SimpleTower(TowerNum)%Name))
ErrorsFound=.TRUE.
END IF
END IF
ELSE
!assume Cell Control not entered and should be defaulted
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
END IF
IF (lAlphaFieldBlanks(9)) THEN
SimpleTower(TowerNum)%SuppliedByWaterSystem = .false.
ELSE ! water from storage tank
!
Call SetupTankDemandComponent(AlphArray(1), TRIM(cCurrentModuleObject), AlphArray(9), ErrorsFound, &
SimpleTower(TowerNum)%WaterTankID, SimpleTower(TowerNum)%WaterTankDemandARRID)
SimpleTower(TowerNum)%SuppliedByWaterSystem = .TRUE.
ENDIF
! outdoor air inlet node
IF (lAlphaFieldBlanks(10)) THEN
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = 0
ELSE
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = &
GetOnlySingleNode(AlphArray(10),ErrorsFound,TRIM(cCurrentModuleObject),SimpleTower(TowerNum)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF(.not. CheckOutAirNodeNumber(SimpleTower(TowerNum)%OutdoorAirInletNodeNum))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" Outdoor Air Inlet Node Name not valid Outdoor Air Node= '//TRIM(AlphArray(10)))
CALL ShowContinueError('...does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.true.
END IF
ENDIF
! High speed air flow rate must be greater than low speed air flow rate.
! Can't tell yet if autosized, check later in InitTower.
IF (SimpleTower(TowerNum)%HighSpeedAirFlowRate <= SimpleTower(TowerNum)%LowSpeedAirFlowRate .and. &
SimpleTower(TowerNum)%HighSpeedAirFlowRate .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Low speed air flow rate must be less than the high speed air flow rate.')
ErrorsFound=.true.
ENDIF
! Low speed air flow rate must be greater than free convection air flow rate.
! Can't tell yet if autosized, check later in InitTower.
IF (SimpleTower(TowerNum)%LowSpeedAirFlowRate <= SimpleTower(TowerNum)%FreeConvAirFlowRate .and. &
SimpleTower(TowerNum)%LowSpeedAirFlowRate .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow rate must be less than the low speed air flow rate.')
ErrorsFound=.true.
ENDIF
! Check various inputs if Performance Input Method = "UA and Design Water Flow Rate"
IF (SimpleTower(TowerNum)%PerformanceInputMethod_Num == PIM_UFactor) THEN
IF (SimpleTower(TowerNum)%DesignWaterFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower performance input method requires a design water flow rate greater than zero.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%HighSpeedTowerUA <= SimpleTower(TowerNum)%LowSpeedTowerUA .and. &
SimpleTower(TowerNum)%HighSpeedTowerUA .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower UA at low fan speed must be less than the tower UA at high fan speed.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%LowSpeedTowerUA <= SimpleTower(TowerNum)%FreeConvTowerUA .and. &
SimpleTower(TowerNum)%LowSpeedTowerUA .NE. AutoSize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower UA at free convection air flow rate must be less than the tower UA at low fan speed.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%FreeConvTowerUA > 0.0d0 .and. SimpleTower(TowerNum)%FreeConvAirFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow rate must be greater than zero when free convection UA is greater than zero.')
ErrorsFound=.true.
END IF
ELSEIF(SimpleTower(TowerNum)%PerformanceInputMethod_Num == PIM_NominalCapacity) THEN
IF (SimpleTower(TowerNum)%TowerNominalCapacity == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower performance input method requires valid high-speed nominal capacity.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%TowerLowSpeedNomCap == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower performance input method requires valid low-speed nominal capacity.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%DesignWaterFlowRate .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%DesignWaterFlowRate > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and design water flow rate have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and design water flow rate is being autosized.')
ENDIF
CALL ShowContinueError('Design water flow rate must be left blank when nominal tower capacity input method is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%HighSpeedTowerUA .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%HighSpeedTowerUA > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and tower UA at high fan speed have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and tower UA at high fan speed is being autosized.')
ENDIF
CALL ShowContinueError('Tower UA at high fan speed must be left blank when nominal tower capacity input method'// &
' is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%LowSpeedTowerUA .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%LowSpeedTowerUA > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and tower UA at low fan speed have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and tower UA at low fan speed is being autosized.')
ENDIF
CALL ShowContinueError('Tower UA at low fan speed must be left blank when nominal tower capacity input method'// &
' is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%FreeConvTowerUA .NE. 0.0d0) THEN
IF (SimpleTower(TowerNum)%FreeConvTowerUA > 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method and free convection UA have been specified.')
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Nominal capacity input method has been specified and free convection UA is being autosized.')
ENDIF
CALL ShowContinueError('Free convection UA should be left blank when nominal tower capacity input method is used.')
ErrorsFound=.true.
ENDIF
IF (SimpleTower(TowerNum)%TowerLowSpeedNomCap >= SimpleTower(TowerNum)%TowerNominalCapacity) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Low-speed nominal capacity must be less than the high-speed nominal capacity.')
ErrorsFound=.true.
END IF
IF (SimpleTower(TowerNum)%TowerFreeConvNomCap >= SimpleTower(TowerNum)%TowerLowSpeedNomCap) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection nominal capacity must be less than the low-speed nominal capacity.')
ErrorsFound=.true.
END IF
IF (SimpleTower(TowerNum)%TowerFreeConvNomCap > 0.0d0 .and. SimpleTower(TowerNum)%FreeConvAirFlowRate == 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Free convection air flow must be greater than zero when tower free convection capacity is specified.')
ErrorsFound=.true.
END IF
ELSE ! Tower performance input method is not specified as a valid "choice"
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Tower Performance Input Method must be "UFactorTimesAreaAndDesignWaterFlowRate" or "NominalCapacity".')
CALL ShowContinueError('Tower Performanace Input Method currently specified as: '// &
TRIM(AlphArray(4)))
ErrorsFound=.true.
ENDIF
END DO ! End Two-Speed Tower Loop
cCurrentModuleObject = cCoolingTower_VariableSpeed
DO VariableSpeedTowerNumber = 1 , NumVariableSpeedTowers
TowerNum = NumSingleSpeedTowers + NumTwoSpeedTowers + VariableSpeedTowerNumber
CALL GetObjectItem(cCurrentModuleObject,VariableSpeedTowerNumber,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),SimpleTower%Name,TowerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
SimpleTower(TowerNum)%VSTower = VariableSpeedTowerNumber
SimpleTower(TowerNum)%Name = AlphArray(1)
SimpleTower(TowerNum)%TowerType = TRIM(cCurrentModuleObject)
SimpleTower(TowerNum)%TowerType_Num = CoolingTower_VariableSpeed
SimpleTower(TowerNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
SimpleTower(TowerNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Chilled Water Nodes')
IF((SameString(AlphArray(4),'CoolToolsUserDefined') .OR. SameString(AlphArray(4),'YorkCalcUserDefined')) .AND. &
lAlphaFieldBlanks(5) )THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" a '//TRIM(cAlphaFieldNames(5))//' must be specified when '//TRIM(cAlphaFieldNames(4))// &
' is specified as CoolToolsUserDefined or YorkCalcUserDefined')
ErrorsFound = .TRUE.
ELSEIF((SameString(AlphArray(4),'CoolToolsCrossFlow') .OR. &
SameString(AlphArray(4),'YorkCalc')) .AND. .NOT. lAlphaFieldBlanks(5) )THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" a Tower Model Coefficient Name is specified and the Tower Model Type'// &
' is not specified as CoolToolsUserDefined or YorkCalcUserDefined. The '// &
'CoolingTowerPerformance:CoolTools (orCoolingTowerPerformance:YorkCalc) data object will not be used.')
ELSE
SimpleTower(TowerNum)%ModelCoeffObjectName = AlphArray(5)
END IF
IF(.NOT. lAlphaFieldBlanks(6) )THEN
SimpleTower(TowerNum)%FanPowerfAirFlowCurve = GetCurveIndex(AlphArray(6))
IF(SimpleTower(TowerNum)%FanPowerfAirFlowCurve .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" the Fan Power Ratio as a function of Air Flow Rate Ratio Curve Name specified as '//TRIM(AlphArray(6)) &
//' was not found. Fan Power as a function of Air Flow Rate Ratio will default to Fan Power = (Air'// &
' Flow Rate Ratio)^3 and the simulation continues.')
END IF
END IF
ALLOCATE (VSTower(VariableSpeedTowerNumber)%Coeff(35))
VSTower(VariableSpeedTowerNumber)%Coeff = 0.0d0
IF(SameString(AlphArray(4),'CoolToolsCrossFlow'))THEN
SimpleTower(TowerNum)%TowerModelType = CoolToolsXFModel
! set cross-flow model coefficients
! Outputs approach in F
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = -2.1985908408527
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = -24.3108065555106
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 21.9333667825398
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = -4.94979078884808
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = 14.6788552214526
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = -15.4612468065777
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = 2.83753688605444
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = 10.0023162199558
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = 2.70780345372045
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = -5.91993527180418
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = 0.194222288920726
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.142543400927955
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = -0.0818947291400898
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = -0.169584760441541
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = 0.0186741309635284
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = 0.0536824177590012
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = -0.00375848174056975
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = 0.000623763881051551
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = -0.000709769430542879
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = 0.0000234697776728891
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 2.45541543720225
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.607566456611435
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.117339576910507
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 1.64648551160799
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.135898905926974
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = -0.152577581866506
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.034055419164321
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(28) = 0.00274052705314173
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(29) = -0.00442366885652332
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(30) = 0.0000687098236486247
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(31) = -0.0416435261408276
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(32) = 0.00263481599534274
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(33) = -0.010325259545311
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(34) = 0.000356999078067433
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(35) = 0.000249188476685273
! Outputs approach in C
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = 0.52049709836241d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = -10.617046395344d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 10.7292974722538d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = -2.74988377158227d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = 4.73629943913743d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = -8.25759700874711d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = 1.57640938114136d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = 6.51119643791324d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = 1.50433525206692d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = -3.2888529287801d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = 0.0257786145353773d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.182464289315254d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = -0.0818947291400898d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = -0.215010003996285d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = 0.0186741309635284d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = 0.0536824177590012d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = -0.00270968955115031d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = 0.00112277498589279d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = -0.00127758497497718d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = 0.0000760420796601607d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 1.43600088336017d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.5198695909109d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.117339576910507d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 1.50492810819924d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.135898905926974d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = -0.152577581866506d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.0533843828114562d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(28) = 0.00493294869565511d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(29) = -0.00796260394174197d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(30) = 0.000222619828621544d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(31) = -0.0543952001568055d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(32) = 0.00474266879161693d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(33) = -0.0185854671815598d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(34) = 0.00115667701293848d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(35) = 0.000807370664460284d0
! set minimum and maximum boundaries for CoolTools crossflow model input variables
VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp = -1.0d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp = 26.6667d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp = 1.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp = 11.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp = 1.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp = 11.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio = 0.75d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio = 1.25d0
! CoolTools counterflow model does not work properly. The empirical model seems flawed since the tower
! operates in the free convection regime on the design day.
! ELSEIF(SameString(AlphArray(5),'COOLTOOLS COUNTERFLOW'))THEN
! SimpleTower(TowerNum)%TowerModelType = CoolToolsCFModel
!! set counter-flow model coefficients
!! Outputs approach in F
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = -4.48760943345722
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = 0.741749875850003
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 1.74679844252553
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = -0.397320959632943
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = 19.5106208955792
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = -9.79489761472574
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = 1.96690857354709
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = -1.40803729637148
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = 0.633867141219563
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = -0.517255742412696
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = 0.0546335532842876
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.0468060318806566
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = -0.0244033403339062
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = -0.267365212754448
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = 0.0385664546399435
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = 0.037765628073743
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = -0.000928698541521428
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = -0.000122211107650076
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = 0.000682937021895334
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = 0.00000679217734960548
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 1.47274732178792
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.869303590626237
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.149995781695274
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 2.4548219494635
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.161092120908292
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = -0.0830303891087807
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.0251101427687245
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(28) = 0.00430042875730149
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(29) = -0.013969370453107
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(30) = 0.000096171182587938
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(31) = -0.0251558254472348
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(32) = 0.0077094706621763
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(33) = -0.0173842428341529
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(34) = 0.000244578460749651
!! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(35) = 0.000123026859143619
!
!! Outputs approach in C
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = -1.92653164860338
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = 1.17466595655408
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 0.536606417689184
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = -0.220733866462746
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = 6.4745897765876
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = -4.75598392569308
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = 1.09272698530394
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = -0.110853998895391
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = 0.352148411788646
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = -0.287364301340387
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = 0.0160624154449042
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.0389845209910517
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = -0.0244033403339062
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = -0.223657243353147
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = 0.0385664546399435
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = 0.037765628073743
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = -0.000497969128726743
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = -0.000219979993770137
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = 0.0012292866394116
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = 0.0000220066546127218
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 0.767702044158785
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.731689870392589
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.149995781695274
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 2.00780209496408
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.161092120908292
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = -0.0830303891087807
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.0341193367495736
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(28) = 0.00774077176314268
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(29) = -0.0251448668155926
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(30) = 0.000311594631584919
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(31) = -0.0311927664658427
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(32) = 0.0138770471919173
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(33) = -0.0312916371014752
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(34) = 0.000792434212828869
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(35) = 0.000398607023625325
!! set minimum and maximum boundaries for CoolTools counterflow model input variables
! VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp = -1.0
! VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp = 26.6667
! VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp = 1.1111
! VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp = 11.1111
! VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp = 1.1111
! VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp = 11.1111
! VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio = 0.75
! VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio = 1.25
ELSEIF(SameString(AlphArray(4),'YorkCalc'))THEN
SimpleTower(TowerNum)%TowerModelType = YorkCalcModel
! set counter-flow model coefficients
! Outputs approach in F
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = 2.471005863
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = -0.139855144
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 0.001325024
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = 0.768721437
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = -0.023370562
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = 0.000149476
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = -0.01116139
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = 0.000325406
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = -0.00000230183
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = 9.852803844
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = -0.173673565
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.000811069
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = 1.749920395
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = 0.004930143
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = -0.00022193
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = -0.009865402
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = -0.000283361
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = 0.00000466261
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = 0.09746009
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = -0.011167959
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 0.000138903
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.135414837
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.001004747
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 0.0000119203
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.002255673
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = 0.0000192893
! VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.000000260086
! Outputs approach in C
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(1) = -0.359741205d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(2) = -0.055053608d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(3) = 0.0023850432d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(4) = 0.173926877d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(5) = -0.0248473764d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(6) = 0.00048430224d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(7) = -0.005589849456d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(8) = 0.0005770079712d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(9) = -0.00001342427256d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(10) = 2.84765801111111d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(11) = -0.121765149d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(12) = 0.0014599242d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(13) = 1.680428651d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(14) = -0.0166920786d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(15) = -0.0007190532d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(16) = -0.025485194448d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(17) = 0.0000487491696d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(18) = 0.00002719234152d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(19) = -0.0653766255555556d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(20) = -0.002278167d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(21) = 0.0002500254d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(22) = -0.0910565458d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(23) = 0.00318176316d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(24) = 0.000038621772d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(25) = -0.0034285382352d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(26) = 0.00000856589904d0
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(27) = -0.000001516821552d0
! set minimum and maximum boundaries for YorkCalc model input variables
VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp = -34.4d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp = 29.4444d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp = 1.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp = 22.2222d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp = 1.1111d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp = 40.0d0
VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio = 0.75d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio = 1.25d0
VSTower(SimpleTower(TowerNum)%VSTower)%MaxLiquidToGasRatio = 8.0d0
ELSEIF(SameString(AlphArray(4),'CoolToolsUserDefined'))THEN
SimpleTower(TowerNum)%TowerModelType = CoolToolsUserDefined
! Nested Get-input routines below. Should pull out of here and read in beforehand.
DO VSModelCoeffNum = 1, NumVSCoolToolsModelCoeffs
CALL GetObjectItem('CoolingTowerPerformance:CoolTools',VSModelCoeffNum, &
AlphArray2,NumAlphas2, NumArray2 ,NumNums2,IOSTAT)
IF(.NOT. SameString(AlphArray2(1),SimpleTower(TowerNum)%ModelCoeffObjectName))CYCLE
VSTower(SimpleTower(TowerNum)%VSTower)%FoundModelCoeff = .TRUE.
! verify the correct number of coefficients for the CoolTools model
IF(NumNums2 /= 43)THEN
CALL ShowSevereError('CoolingTower:VariableSpeed "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". The number of numeric inputs for object CoolingTowerPerformance:CoolTools "' &
//TRIM(SimpleTower(TowerNum)%ModelCoeffObjectName)//'" must equal 43.')
ErrorsFound=.true.
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp = NumArray2(1)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp = NumArray2(2)
VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp = NumArray2(3)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp = NumArray2(4)
VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp = NumArray2(5)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp = NumArray2(6)
VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio = NumArray2(7)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio = NumArray2(8)
DO CoeffNum = 9, NumNums2
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(CoeffNum-8)= NumArray2(CoeffNum)
END DO
END IF
EXIT
END DO
IF(.NOT. VSTower(SimpleTower(TowerNum)%VSTower)%FoundModelCoeff)THEN
CALL ShowSevereError('CoolingTower:VariableSpeed "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined name for variable speed cooling tower model coefficients object not found = ' &
//TRIM(SimpleTower(TowerNum)%ModelCoeffObjectName))
ErrorsFound=.true.
END IF
ELSEIF(SameString(AlphArray(4),'YorkCalcUserDefined'))THEN
SimpleTower(TowerNum)%TowerModelType = YorkCalcUserDefined
! Nested Get-input routines below. Should pull out of here and read in beforehand.
DO VSModelCoeffNum = 1, NumVSYorkCalcModelCoeffs
CALL GetObjectItem('CoolingTowerPerformance:YorkCalc',VSModelCoeffNum, &
AlphArray2,NumAlphas2, NumArray2 ,NumNums2,IOSTAT)
IF(.NOT. SameString(AlphArray2(1),SimpleTower(TowerNum)%ModelCoeffObjectName))CYCLE
VSTower(SimpleTower(TowerNum)%VSTower)%FoundModelCoeff = .TRUE.
! verify the correct number of coefficients for the YorkCalc model
IF(NumNums2 /= 36)THEN
CALL ShowSevereError('CoolingTower:VariableSpeed "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". The number of numeric inputs for object CoolingTowerPerformance:YorkCalc "' &
//TRIM(SimpleTower(TowerNum)%ModelCoeffObjectName)//'" must equal 36.')
ErrorsFound=.true.
ELSE
VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp = NumArray2(1)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp = NumArray2(2)
VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp = NumArray2(3)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp = NumArray2(4)
VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp = NumArray2(5)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp = NumArray2(6)
VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio = NumArray2(7)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio = NumArray2(8)
VSTower(SimpleTower(TowerNum)%VSTower)%MaxLiquidToGasRatio = NumArray2(9)
DO CoeffNum = 10, NumNums2
VSTower(SimpleTower(TowerNum)%VSTower)%Coeff(CoeffNum-9)= NumArray2(CoeffNum)
END DO
END IF
EXIT
END DO
IF(.NOT. VSTower(SimpleTower(TowerNum)%VSTower)%FoundModelCoeff)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined name for variable speed cooling tower model coefficients object not found = ' &
//TRIM(SimpleTower(TowerNum)%ModelCoeffObjectName))
ErrorsFound=.true.
END IF
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". Illegal Tower Model Type = '//TRIM(AlphArray(5)))
CALL ShowContinueError(' Tower Model Type must be "CoolToolsCrossFlow", "YorkCalc",'// &
' "CoolToolsUserDefined", or "YorkCalcUserDefined.')
ErrorsFound=.true.
END IF
SimpleTower(TowerNum)%TowerMassFlowRateMultiplier = VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio
! check user defined minimums to be greater than 0
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined minimum approach temperature must be > 0')
ErrorsFound=.true.
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined minimum range temperature must be > 0')
ErrorsFound=.true.
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio .LT. 0.0d0)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined minimum water flow rate ratio must be > 0')
ErrorsFound=.true.
END IF
! check that the user defined maximums are greater than the minimums
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined maximum approach temperature must be > the minimum approach temperature')
ErrorsFound=.true.
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined maximum range temperature must be > the minimum range temperature')
ErrorsFound=.true.
END IF
IF(VSTower(SimpleTower(TowerNum)%VSTower)%MaxWaterFlowRatio .LT. &
VSTower(SimpleTower(TowerNum)%VSTower)%MinWaterFlowRatio)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(SimpleTower(TowerNum)%Name)//&
'". User defined maximum water flow rate ratio must be > the minimum water flow rate ratio')
ErrorsFound=.true.
END IF
SimpleTower(TowerNum)%DesignInletWB = NumArray(1)
IF(NumArray(1) .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp .OR. &
NumArray(1) .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp) THEN
WRITE(OutputChar,OutputFormat)SimpleTower(TowerNum)%DesignInletWB
WRITE(OutputCharLo,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MinInletAirWBTemp
WRITE(OutputCharHi,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MaxInletAirWBTemp
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" the design inlet air wet-bulb temperature of '//TRIM(OutputChar)//' must be within' &
//' the model limits of '//TRIM(OutputCharLo)//' and '//TRIM(OutputCharHi)//' degrees C')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%DesignApproach = NumArray(2)
IF(NumArray(2) .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp .OR. &
NumArray(2) .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp) THEN
WRITE(OutputChar,OutputFormat)SimpleTower(TowerNum)%DesignApproach
WRITE(OutputCharLo,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MinApproachTemp
WRITE(OutputCharHi,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MaxApproachTemp
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" the design approach temperature of '//TRIM(OutputChar)//' must be within ' &
//' the model limits of '//TRIM(OutputCharLo)//' and '//TRIM(OutputCharHi)//' degrees C')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%DesignRange = NumArray(3)
IF(NumArray(3) .LT. VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp .OR. &
NumArray(3) .GT. VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp) THEN
WRITE(OutputChar,OutputFormat)SimpleTower(TowerNum)%DesignRange
WRITE(OutputCharLo,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MinRangeTemp
WRITE(OutputCharHi,OutputFormat)VSTower(SimpleTower(TowerNum)%VSTower)%MaxRangeTemp
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" the design range temperature of '//TRIM(OutputChar)//' must be within ' &
//' the model limits of '//TRIM(OutputCharLo)//' and '//TRIM(OutputCharHi)//' degrees C')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%DesignWaterFlowRate = NumArray(4)
IF(NumArray(4) .LE. 0.0d0 .AND. NumArray(4) .NE. autosize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" design water flow rate must be > 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%HighSpeedAirFlowRate = NumArray(5)
IF(NumArray(5) .LE. 0.0d0 .AND. NumArray(5) .NE. autosize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" design air flow rate must be > 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%HighSpeedFanPower = NumArray(6)
IF(NumArray(6) .LE. 0.0d0 .AND. NumArray(6) .NE. autosize) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" design fan power must be > 0')
ErrorsFound = .TRUE.
END IF
! minimum air flow rate fraction must be >= 0.2 and <= 0.5, below this value the tower fan cycles to maintain the setpoint
SimpleTower(TowerNum)%MinimumVSAirFlowFrac = NumArray(7)
SimpleTower(TowerNum)%MinimumVSAirFlowFrac = NumArray(7)
IF(NumArray(7) .LT. 0.2d0 .OR. NumArray(7) .GT. 0.5d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" minimum VS air flow rate ratio must be >= 0.2 and <= 0.5')
ErrorsFound = .TRUE.
END IF
! fraction of tower capacity in free convection regime must be >= to 0 and <= 0.2
SimpleTower(TowerNum)%FreeConvectionCapacityFraction = NumArray(8)
IF(NumArray(8) .LT. 0.0d0 .OR. NumArray(8) .GT. 0.2d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" fraction of tower capacity in free convection regime must be >= 0 and <= 0.2')
ErrorsFound = .TRUE.
END IF
! Basin heater power as a function of temperature must be greater than or equal to 0
SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff = NumArray(9)
IF(NumArray(9) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater power as a function of temperature difference must be >= 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = NumArray(10)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 10) THEN
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(simpleTower(TowerNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//':"'//TRIM(SimpleTower(TowerNum)%Name)//&
'", '//TRIM(cNumericFieldNames(10))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
! Performance Input Method for Variable Speed Towers is assigned to be UA AND DESIGN WATER FLOW RATE
! for autosizing calculations (see SizeTower)
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
! Makeup water drift percentage must be greater than or equal to 0
! SimpleTower(TowerNum)%MakeupWaterDrift = NumArray(10)/100.0
! IF(NumArray(10) .LT. 0.0) THEN
! CALL ShowSevereError('COOLING TOWER:VARIABLE SPEED, "'//TRIM(SimpleTower(TowerNum)%Name)//&
! '" Makeup Water Drift as a percentage of design water flow rate must be >= 0')
! ErrorsFound = .TRUE.
! END IF
IF(AlphArray(7) .NE. Blank)THEN
SimpleTower(TowerNum)%BasinHeaterSchedulePtr = GetScheduleIndex(AlphArray(7))
IF(SimpleTower(TowerNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater schedule name "'//TRIM(AlphArray(7)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
! IF(AlphArray(9) .NE. ' ')THEN
! SimpleTower(TowerNum)%BlowDownSchedulePtr = GetScheduleIndex(AlphArray(9))
! IF(SimpleTower(TowerNum)%BlowDownSchedulePtr .EQ. 0)THEN
! CALL ShowWarningError('COOLING TOWER:VARIABLE SPEED, "'//TRIM(SimpleTower(TowerNum)%Name)//&
! '" blowdown schedule name "'//TRIM(AlphArray(9)) &
! //'" was not found. Basin blowdown will not be modeled and the simulation continues')
! END IF
! END IF
! begin water use and systems get input
IF (SameString(AlphArray(8),'LossFactor')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByUserFactor
ELSEIF (SameString(AlphArray(8), 'SaturatedExit')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSEIF (lAlphaFieldBlanks(8)) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(AlphArray(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UserEvapLossFactor = NumArray(11) ! N11 , \field Evaporation Loss Factor
SimpleTower(TowerNum)%DriftLossFraction = NumArray(12) / 100.0d0 ! N12, \field Drift Loss Percent
SimpleTower(TowerNum)%ConcentrationRatio = NumArray(13) ! N13, \field Blowdown Concentration Ratio
SimpleTower(TowerNum)%SizFac = NumArray(17) ! N14 \field Sizing Factor
IF (SimpleTower(TowerNum)%SizFac <= 0.0d0) SimpleTower(TowerNum)%SizFac = 1.0d0
If (SameString(AlphArray(9), 'ScheduledRate')) then
SimpleTower(TowerNum)%BlowdownMode = BlowdownBySchedule
ELSEIF (SameString(AlphArray(9), 'ConcentrationRatio')) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
ELSEIF (lAlphaFieldBlanks(9)) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
ELSE
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(AlphArray(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%SchedIDBlowdown = GetScheduleIndex(AlphArray(10))
If ((SimpleTower(TowerNum)%SchedIDBlowdown == 0) .and. (SimpleTower(TowerNum)%BlowdownMode == BlowdownBySchedule)) Then
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(AlphArray(10)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
errorsfound = .true.
endif
!added for multi-cell
SimpleTower(TowerNum)%NumCell = NumArray(14)
If ((NumNums < 14) .and. (SimpleTower(TowerNum)%NumCell == 0) ) Then
! assume Number of Cells not entered and should be defaulted
SimpleTower(TowerNum)%NumCell = 1
endif
SimpleTower(TowerNum)%MinFracFlowRate = NumArray(15)
If ((NumNums < 15) .and. (SimpleTower(TowerNum)%MinFracFlowRate == 0.0d0) ) Then
! assume Cell Minimum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MinFracFlowRate = 0.33d0
endif
SimpleTower(TowerNum)%MaxFracFlowRate = NumArray(16)
If ((NumNums < 16) .and. (SimpleTower(TowerNum)%MaxFracFlowRate == 0.0d0) ) Then
! assume Cell Maximum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MaxFracFlowRate = 2.5d0
endif
IF (NumAlphas >= 13) THEN
IF (lAlphaFieldBlanks(13).or.AlphArray(13) == Blank) THEN
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
ELSE
IF (SameString(AlphArray(13),'MinimalCell') .OR. &
SameString(AlphArray(13),'MaximalCell') ) THEN
IF (SameString(AlphArray(13),'MinimalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MinCell
SimpleTower(TowerNum)%CellCtrl= 'MinimalCell'
ENDIF
IF (SameString(AlphArray(13),'MaximalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
ENDIF
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(13))//' = '//TRIM(AlphArray(13)))
CALL ShowContinueError('Occurs in '//SimpleTower(TowerNum)%TowerType//'='//TRIM(SimpleTower(TowerNum)%Name))
ErrorsFound=.TRUE.
END IF
END IF
ELSE
!assume Cell Control not entered and should be defaulted
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
END IF
IF (lAlphaFieldBlanks(11) ) THEN
SimpleTower(TowerNum)%SuppliedByWaterSystem = .false.
ELSE ! water from storage tank
!
Call SetupTankDemandComponent(AlphArray(1), TRIM(cCurrentModuleObject), AlphArray(11), ErrorsFound, &
SimpleTower(TowerNum)%WaterTankID, SimpleTower(TowerNum)%WaterTankDemandARRID)
SimpleTower(TowerNum)%SuppliedByWaterSystem = .TRUE.
ENDIF
! outdoor air inlet node
IF (lAlphaFieldBlanks(12) ) THEN
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = 0
ELSE
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = &
GetOnlySingleNode(AlphArray(12),ErrorsFound,TRIM(cCurrentModuleObject),SimpleTower(TowerNum)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF(.not. CheckOutAirNodeNumber(SimpleTower(TowerNum)%OutdoorAirInletNodeNum))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" Outdoor Air Inlet Node Name not valid Outdoor Air Node= '//TRIM(AlphArray(12)))
CALL ShowContinueError('...does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.true.
END IF
ENDIF
END DO ! End Variable-Speed Tower Loop
cCurrentModuleObject = cCoolingTower_VariableSpeedMerkel
DO MerkelVSTowerNum= 1, NumVSMerkelTowers
TowerNum = NumSingleSpeedTowers + NumTwoSpeedTowers + NumVariableSpeedTowers + MerkelVSTowerNum
CALL GetObjectItem(cCurrentModuleObject,MerkelVSTowerNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, NumBlank=lNumericFieldBlanks,&
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),SimpleTower%Name,TowerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
SimpleTower(TowerNum)%Name = AlphArray(1)
SimpleTower(TowerNum)%TowerType = TRIM(cCurrentModuleObject)
SimpleTower(TowerNum)%TowerType_Num = CoolingTower_VariableSpeedMerkel
SimpleTower(TowerNum)%WaterInletNodeNum = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
SimpleTower(TowerNum)%WaterOutletNodeNum = &
GetOnlySingleNode(AlphArray(3),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(2),AlphArray(3),'Chilled Water Nodes')
IF (SameString(AlphArray(4),'UFactorTimesAreaAndDesignWaterFlowRate')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_UFactor
ELSEIF (SameString(AlphArray(4),'NominalCapacity')) THEN
SimpleTower(TowerNum)%PerformanceInputMethod_Num = PIM_NominalCapacity
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid, '//TRIM(cAlphaFieldNames(4))//' = '//TRIM(AlphArray(4)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%FanPowerfAirFlowCurve = GetCurveIndex(AlphArray(5))
IF (SimpleTower(TowerNum)%FanPowerfAirFlowCurve == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(AlphArray(5)))
CALL ShowContinueError('Curve name not found.')
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%HeatRejectCapNomCapSizingRatio = NumArray(1)
SimpleTower(TowerNum)%TowerNominalCapacity = NumArray(2)
SimpleTower(TowerNum)%TowerFreeConvNomCap = NumArray(3)
SimpleTower(TowerNum)%TowerFreeConvNomCapSizingFactor = NumArray(4)
SimpleTower(TowerNum)%DesignWaterFlowRate = NumArray(5)
SimpleTower(TowerNum)%DesignWaterFlowPerUnitNomCap = NumArray(6)
SimpleTower(TowerNum)%HighSpeedAirFlowRate = NumArray(7)
IF (lNumericFieldBlanks(8)) THEN
SimpleTower(TowerNum)%DefaultedDesignAirFlowScalingFactor = .TRUE.
ELSE
SimpleTower(TowerNum)%DefaultedDesignAirFlowScalingFactor = .FALSE.
ENDIF
SimpleTower(TowerNum)%DesignAirFlowPerUnitNomCap = NumArray(8)
SimpleTower(TowerNum)%MinimumVSAirFlowFrac = NumArray(9)
SimpleTower(TowerNum)%HighSpeedFanPower = NumArray(10)
SimpleTower(TowerNum)%DesignFanPowerPerUnitNomCap = NumArray(11)
SimpleTower(TowerNum)%FreeConvAirFlowRate = NumArray(12)
SimpleTower(TowerNum)%FreeConvAirFlowRateSizingFactor = NumArray(13)
SimpleTower(TowerNum)%HighSpeedTowerUA = NumArray(14)
SimpleTower(TowerNum)%FreeConvTowerUA = NumArray(15)
SimpleTower(TowerNum)%FreeConvTowerUASizingFactor = NumArray(16)
SimpleTower(TowerNum)%UAModFuncAirFlowRatioCurvePtr = GetCurveIndex(AlphArray(6))
IF (SimpleTower(TowerNum)%UAModFuncAirFlowRatioCurvePtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(AlphArray(6)))
CALL ShowContinueError('Curve name not found.')
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UAModFuncWetbulbDiffCurvePtr = GetCurveIndex(AlphArray(7))
IF (SimpleTower(TowerNum)%UAModFuncWetbulbDiffCurvePtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(AlphArray(7)))
CALL ShowContinueError('Curve name not found.')
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UAModFuncWaterFlowRatioCurvePtr = GetCurveIndex(AlphArray(8))
IF (SimpleTower(TowerNum)%UAModFuncWaterFlowRatioCurvePtr == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(AlphArray(8)))
CALL ShowContinueError('Curve name not found.')
errorsfound = .true.
ENDIF
! Basin heater power as a function of temperature must be greater than or equal to 0
SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff = NumArray(17)
IF(NumArray(17) .LT. 0.0d0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater power as a function of temperature difference must be >= 0')
ErrorsFound = .TRUE.
END IF
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = NumArray(18)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 18) THEN
SimpleTower(TowerNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(simpleTower(TowerNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//':"'//TRIM(SimpleTower(TowerNum)%Name)//&
'", '//TRIM(cNumericFieldNames(18))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(AlphArray(9) .NE. Blank)THEN
SimpleTower(TowerNum)%BasinHeaterSchedulePtr = GetScheduleIndex(AlphArray(9))
IF(SimpleTower(TowerNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" basin heater schedule name "'//TRIM(AlphArray(9)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
! begin water use and systems get input
IF (SameString(AlphArray(10),'LossFactor')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByUserFactor
ELSEIF (SameString(AlphArray(10), 'SaturatedExit')) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSEIF (lAlphaFieldBlanks(10)) THEN
SimpleTower(TowerNum)%EvapLossMode = EvapLossByMoistTheory
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(AlphArray(10)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%UserEvapLossFactor = NumArray(19) ! N19 , \field Evaporation Loss Factor
SimpleTower(TowerNum)%DriftLossFraction = NumArray(20) / 100.0d0 ! N20, \field Drift Loss Percent
If ((NumNums < 20) .and. (SimpleTower(TowerNum)%DriftLossFraction == 0.0d0) ) THEN
! assume Drift loss not entered and should be defaulted
SimpleTower(TowerNum)%DriftLossFraction = 0.008d0 /100.0d0
ENDIF
SimpleTower(TowerNum)%ConcentrationRatio = NumArray(21) ! N21, \field Blowdown Concentration Ratio
SimpleTower(TowerNum)%SizFac = NumArray(25) ! N25 \field Sizing Factor
IF (SimpleTower(TowerNum)%SizFac <= 0.0d0) SimpleTower(TowerNum)%SizFac = 1.0d0
If (SameString(AlphArray(11), 'ScheduledRate')) then
SimpleTower(TowerNum)%BlowdownMode = BlowdownBySchedule
ELSEIF (SameString(AlphArray(11), 'ConcentrationRatio')) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
ELSEIF (lAlphaFieldBlanks(11)) THEN
SimpleTower(TowerNum)%BlowdownMode = BlowdownByConcentration
If ((NumNums < 21) .and.(SimpleTower(TowerNum)%ConcentrationRatio == 0.0d0) ) THEN
! assume Concetration ratio was omitted and should be defaulted
SimpleTower(TowerNum)%ConcentrationRatio = 3.0d0
endif
ELSE
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(11))//'='//TRIM(AlphArray(11)))
errorsfound = .true.
ENDIF
SimpleTower(TowerNum)%SchedIDBlowdown = GetScheduleIndex(AlphArray(12))
If ((SimpleTower(TowerNum)%SchedIDBlowdown == 0) .AND. (SimpleTower(TowerNum)%BlowdownMode == BlowdownBySchedule)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(12))//'='//TRIM(AlphArray(12)))
errorsfound = .true.
ENDIF
!added for multi-cell
SimpleTower(TowerNum)%NumCell = NumArray(22)
If ((NumNums < 22) .and. (SimpleTower(TowerNum)%NumCell == 0) ) Then
! assume Number of Cells not entered and should be defaulted
SimpleTower(TowerNum)%NumCell = 1
endif
SimpleTower(TowerNum)%MinFracFlowRate = NumArray(23)
If ((NumNums < 23) .and. (SimpleTower(TowerNum)%MinFracFlowRate == 0.0d0) ) Then
! assume Cell Minimum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MinFracFlowRate = 0.33d0
endif
SimpleTower(TowerNum)%MaxFracFlowRate = NumArray(24)
If ((NumNums < 24) .and. (SimpleTower(TowerNum)%MaxFracFlowRate == 0.0d0) ) Then
! assume Cell Maximum Water Flow Rate Fraction not entered and should be defaulted
SimpleTower(TowerNum)%MaxFracFlowRate = 2.5d0
endif
SimpleTower(TowerNum)%TowerMassFlowRateMultiplier = SimpleTower(TowerNum)%MaxFracFlowRate
IF (NumAlphas >= 15) THEN
IF (lAlphaFieldBlanks(15).or.AlphArray(15) == Blank) THEN
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
ELSE
IF (SameString(AlphArray(15),'MinimalCell') .OR. &
SameString(AlphArray(15),'MaximalCell') ) THEN
IF (SameString(AlphArray(15),'MinimalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MinCell
SimpleTower(TowerNum)%CellCtrl= 'MinimalCell'
ENDIF
IF (SameString(AlphArray(15),'MaximalCell')) THEN
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
ENDIF
ELSE
CALL ShowSevereError('Illegal '//TRIM(cAlphaFieldNames(15))//' = '//TRIM(AlphArray(15)))
CALL ShowContinueError('Occurs in '//SimpleTower(TowerNum)%TowerType//'='//TRIM(SimpleTower(TowerNum)%Name))
ErrorsFound=.TRUE.
END IF
END IF
ELSE
!assume Cell Control not entered and should be defaulted
SimpleTower(TowerNum)%CellCtrl= 'MaximalCell'
SimpleTower(TowerNum)%CellCtrl_Num=CellCtrl_MaxCell
END IF
IF (lAlphaFieldBlanks(13)) THEN
SimpleTower(TowerNum)%SuppliedByWaterSystem = .false.
ELSE ! water from storage tank
!
Call SetupTankDemandComponent(AlphArray(1), TRIM(cCurrentModuleObject), AlphArray(13), ErrorsFound, &
SimpleTower(TowerNum)%WaterTankID, SimpleTower(TowerNum)%WaterTankDemandARRID)
SimpleTower(TowerNum)%SuppliedByWaterSystem = .TRUE.
ENDIF
! outdoor air inlet node
IF (lAlphaFieldBlanks(14)) THEN
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = 0
ELSE
SimpleTower(TowerNum)%OutdoorAirInletNodeNum = &
GetOnlySingleNode(AlphArray(14),ErrorsFound,TRIM(cCurrentModuleObject),SimpleTower(TowerNum)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
IF(.not. CheckOutAirNodeNumber(SimpleTower(TowerNum)%OutdoorAirInletNodeNum))THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//', "'//TRIM(SimpleTower(TowerNum)%Name)//&
'" Outdoor Air Inlet Node Name not valid Outdoor Air Node= '//TRIM(AlphArray(14)))
CALL ShowContinueError('...does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.true.
END IF
ENDIF
ENDDO ! end merkel vs tower loop
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting cooling tower input.')
ENDIF
! Set up output variables CurrentModuleObject='CoolingTower:SingleSpeed'
DO TowerNum = 1, NumSingleSpeedTowers
CALL SetupOutputVariable('Cooling Tower Inlet Temperature [C]', &
SimpleTowerReport(TowerNum)%InletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Outlet Temperature [C]', &
SimpleTowerReport(TowerNum)%OutletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Mass Flow Rate [kg/s]', &
SimpleTowerReport(TowerNum)%WaterMassFlowRate,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Heat Transfer Rate [W]', &
SimpleTowerReport(TowerNum)%Qactual,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Power [W]', &
SimpleTowerReport(TowerNum)%FanPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Energy [J]', &
SimpleTowerReport(TowerNum)%FanEnergy,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
! Added for fluid bypass
CALL SetupOutputVariable('Cooling Tower Bypass Fraction []', &
SimpleTowerReport(TowerNum)%BypassFraction,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Operating Cells Count []',&
SimpleTowerReport(TowerNum)%NumCellON,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Cycling Ratio []', &
SimpleTowerReport(TowerNum)%FanCyclingRatio,'System','Average',SimpleTower(TowerNum)%Name)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Power [W]', &
SimpleTowerReport(TowerNum)%BasinHeaterPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Energy [J]', &
SimpleTowerReport(TowerNum)%BasinHeaterConsumption,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
END IF
END DO
! CurrentModuleObject='CoolingTower:TwoSpeed'
DO TowerNum = NumSingleSpeedTowers+1, NumSingleSpeedTowers+NumTwoSpeedTowers
CALL SetupOutputVariable('Cooling Tower Inlet Temperature [C]', &
SimpleTowerReport(TowerNum)%InletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Outlet Temperature [C]', &
SimpleTowerReport(TowerNum)%OutletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Mass Flow Rate [kg/s]', &
SimpleTowerReport(TowerNum)%WaterMassFlowRate,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Heat Transfer Rate [W]', &
SimpleTowerReport(TowerNum)%Qactual,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Power [W]', &
SimpleTowerReport(TowerNum)%FanPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Energy [J]', &
SimpleTowerReport(TowerNum)%FanEnergy,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Fan Cycling Ratio []', &
SimpleTowerReport(TowerNum)%FanCyclingRatio,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Speed Level []',&
SimpleTowerReport(TowerNum)%SpeedSelected,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Operating Cells Count []',&
SimpleTowerReport(TowerNum)%NumCellON,'System','Average',SimpleTower(TowerNum)%Name)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Power [W]', &
SimpleTowerReport(TowerNum)%BasinHeaterPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Energy [J]', &
SimpleTowerReport(TowerNum)%BasinHeaterConsumption,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
END IF
END DO
! CurrentModuleObject='CoolingTower:VariableSpeed'
DO TowerNum = NumSingleSpeedTowers+NumTwoSpeedTowers+1, NumSingleSpeedTowers+NumTwoSpeedTowers+NumVariableSpeedTowers
CALL SetupOutputVariable('Cooling Tower Inlet Temperature [C]', &
SimpleTowerReport(TowerNum)%InletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Outlet Temperature [C]', &
SimpleTowerReport(TowerNum)%OutletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Mass Flow Rate [kg/s]', &
SimpleTowerReport(TowerNum)%WaterMassFlowRate,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Heat Transfer Rate [W]', &
SimpleTowerReport(TowerNum)%Qactual,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Power [W]', &
SimpleTowerReport(TowerNum)%FanPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Energy [J]', &
SimpleTowerReport(TowerNum)%FanEnergy,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Air Flow Rate Ratio []', &
SimpleTowerReport(TowerNum)%AirFlowRatio,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Part Load Ratio []', &
SimpleTowerReport(TowerNum)%FanCyclingRatio,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Operating Cells Count []',&
SimpleTowerReport(TowerNum)%NumCellON,'System','Average',SimpleTower(TowerNum)%Name)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Power [W]', &
SimpleTowerReport(TowerNum)%BasinHeaterPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Energy [J]', &
SimpleTowerReport(TowerNum)%BasinHeaterConsumption,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
END IF
! CALL SetupOutputVariable('Tower Makeup Water Consumption [m3]', &
! SimpleTowerReport(TowerNum)%WaterAmountUsed,'System','Sum',SimpleTower(TowerNum)%Name, &
! ResourceTypeKey='Water',EndUseKey='HeatRejection',GroupKey='Plant')
END DO
! CurrentModuleObject='CoolingTower:VariableSpeed:Merkel'
DO TowerNum = NumSingleSpeedTowers+NumTwoSpeedTowers+NumVariableSpeedTowers+1, &
NumSingleSpeedTowers+NumTwoSpeedTowers+NumVariableSpeedTowers+NumVSMerkelTowers
CALL SetupOutputVariable('Cooling Tower Inlet Temperature [C]', &
SimpleTowerReport(TowerNum)%InletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Outlet Temperature [C]', &
SimpleTowerReport(TowerNum)%OutletWaterTemp,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Mass Flow Rate [kg/s]', &
SimpleTowerReport(TowerNum)%WaterMassFlowRate,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Heat Transfer Rate [W]', &
SimpleTowerReport(TowerNum)%Qactual,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Power [W]', &
SimpleTowerReport(TowerNum)%FanPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Fan Electric Energy [J]', &
SimpleTowerReport(TowerNum)%FanEnergy,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Fan Speed Ratio []', &
SimpleTowerReport(TowerNum)%AirFlowRatio,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Operating Cells Count []',&
SimpleTowerReport(TowerNum)%NumCellON,'System','Average',SimpleTower(TowerNum)%Name)
IF(SimpleTower(TowerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Power [W]', &
SimpleTowerReport(TowerNum)%BasinHeaterPower,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Basin Heater Electric Energy [J]', &
SimpleTowerReport(TowerNum)%BasinHeaterConsumption,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='HeatRejection',GroupKey='Plant')
END IF
ENDDO
! setup common water reporting for all types of towers.
Do TowerNum = 1 , NumSingleSpeedTowers+NumTwoSpeedTowers+NumVariableSpeedTowers+NumVSMerkelTowers
If (SimpleTower(TowerNum)%SuppliedByWaterSystem) THEN
CALL SetupOutputVariable('Cooling Tower Make Up Water Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%MakeUpVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Make Up Water Volume [m3]', &
SimpleTowerReport(TowerNum)%MakeUpVol,'System','Sum',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Storage Tank Water Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%TankSupplyVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Storage Tank Water Volume [m3]', &
SimpleTowerReport(TowerNum)%TankSupplyVol,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Water', EndUseKey='HeatRejection', GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Starved Storage Tank Water Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%StarvedMakeUpVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Starved Storage Tank Water Volume [m3]', &
SimpleTowerReport(TowerNum)%StarvedMakeUpVol,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Water', EndUseKey='HeatRejection', GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Make Up Mains Water Volume [m3]', &
SimpleTowerReport(TowerNum)%StarvedMakeUpVol,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='MainsWater', EndUseKey='HeatRejection', GroupKey='Plant')
ELSE ! tower water from mains and gets metered
CALL SetupOutputVariable('Cooling Tower Make Up Water Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%MakeUpVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Make Up Water Volume [m3]', &
SimpleTowerReport(TowerNum)%MakeUpVol,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='Water', EndUseKey='HeatRejection', GroupKey='Plant')
CALL SetupOutputVariable('Cooling Tower Make Up Mains Water Volume [m3]', &
SimpleTowerReport(TowerNum)%MakeUpVol,'System','Sum',SimpleTower(TowerNum)%Name, &
ResourceTypeKey='MainsWater', EndUseKey='HeatRejection', GroupKey='Plant')
ENDIF
CALL SetupOutputVariable('Cooling Tower Water Evaporation Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%EvaporationVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Water Evaporation Volume [m3]', &
SimpleTowerReport(TowerNum)%EvaporationVol,'System','Sum',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Water Drift Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%DriftVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Water Drift Volume [m3]', &
SimpleTowerReport(TowerNum)%DriftVol,'System','Sum',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Water Blowdown Volume Flow Rate [m3/s]', &
SimpleTowerReport(TowerNum)%BlowdownVdot,'System','Average',SimpleTower(TowerNum)%Name)
CALL SetupOutputVariable('Cooling Tower Water Blowdown Volume [m3]', &
SimpleTowerReport(TowerNum)%BlowdownVol,'System','Sum',SimpleTower(TowerNum)%Name)
ENDDO ! loop all towers
RETURN
END SUBROUTINE GetTowerInput