SUBROUTINE GetTESCoilInput
! SUBROUTINE INFORMATION:
! AUTHOR <author>
! DATE WRITTEN <date_written>
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! <description>
! METHODOLOGY EMPLOYED:
! <description>
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, GetObjectItemNum, VerifyName, SameString,GetObjectDefMaxArgs
USE WaterManager, ONLY: SetupTankDemandComponent, SetupTankSupplyComponent
USE GlobalNames, ONLY: VerifyUniqueCoilName
USE DataSizing, ONLY: AutoSize
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
USE ScheduleManager, ONLY: GetScheduleIndex
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
USE FluidProperties, ONLY: CheckFluidPropertyName, FindGlycol, GetFluidDensityTemperatureLimits, &
GetFluidSpecificHeatTemperatureLimits
USE DataZoneEquipment, ONLY: FindControlledZoneIndexFromSystemNodeNumberForZone
USE DataHeatBalance, ONLY: IntGainTypeOf_PackagedTESCoilTank
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: RoutineName='GetTESCoilInput: ' ! include trailing blank space
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: item ! do loop counter
INTEGER :: NumAlphas ! Number of alphas in input
INTEGER :: NumNumbers ! Number of numeric items in input
INTEGER :: IOStatus ! Input status returned from GetObjectItem
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: ErrorsFound=.false. ! Set to true if errors in input, fatal at end of routine
LOGICAL :: errflag
REAL(r64) :: TminRho
REAL(r64) :: TmaxRho
REAL(r64) :: TminCp
REAL(r64) :: TmaxCp
INTEGER :: ZoneIndexTrial
cCurrentModuleObject = 'Coil:Cooling:DX:SingleSpeed:ThermalStorage'
NumTESCoils = GetNumObjectsFound(cCurrentModuleObject)
ALLOCATE( TESCoil (NumTESCoils))
ALLOCATE( CheckEquipName(NumTESCoils))
CheckEquipName = .TRUE.
DO item = 1, NumTESCoils
CALL GetObjectItem(cCurrentModuleObject, item, cAlphaArgs, NumAlphas, rNumericArgs, NumNumbers, &
IOStatus, NumBlank=lNumericFieldBlanks, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames= cAlphaFieldNames , NumericFieldNames= cNumericFieldNames )
IsNotOK=.FALSE.
IsBlank=.FALSE.
CALL VerifyName(cAlphaArgs(1), TESCoil%Name, item - 1, IsNotOK, IsBlank, TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
CALL VerifyUniqueCoilName(cCurrentModuleObject, cAlphaArgs(1), errflag, TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
TESCoil(item)%Name = cAlphaArgs(1)
IF (lAlphaFieldBlanks(2)) THEN
TESCoil(item)%AvailSchedNum = ScheduleAlwaysOn
ELSE
TESCoil(item)%AvailSchedNum = GetScheduleIndex(cAlphaArgs(2))
IF (TESCoil(item)%AvailSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(2))//'="'//TRIM(cAlphaArgs(2))//'".')
ErrorsFound=.TRUE.
ENDIF
ENDIF
SELECT CASE (cAlphaArgs(3))
CASE ('SCHEDULEDMODES')
TESCoil(item)%ModeControlType = ScheduledOpModes
CASE ('EMSCONTROLLED')
TESCoil(item)%ModeControlType = EMSActuatedOpModes
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(3))//'="'//TRIM(cAlphaArgs(3))//'".')
CALL ShowContinueError('Available choices are ScheduledModes or EMSControlled')
ErrorsFound=.TRUE.
END SELECT
IF (lAlphaFieldBlanks(4)) THEN
IF (TESCoil(item)%ModeControlType == ScheduledOpModes) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//' is blank but a schedule is needed')
ErrorsFound=.TRUE.
ENDIF
ELSE
TESCoil(item)%ControlModeSchedNum = GetScheduleIndex(cAlphaArgs(4))
IF (TESCoil(item)%ControlModeSchedNum == 0 .AND. TESCoil(item)%ModeControlType == ScheduledOpModes) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(4))//'="'//TRIM(cAlphaArgs(4))//'".')
ErrorsFound=.TRUE.
ENDIF
ENDIF
SELECT CASE (cAlphaArgs(5))
CASE ('ICE')
TESCoil(item)%StorageMedia = IceBased
CASE ('WATER')
TESCoil(item)%StorageMedia = FluidBased
TESCoil(item)%StorageFluidName = 'WATER'
TESCoil(item)%StorageFluidIndex = FindGlycol('WATER')
CASE ('USERDEFINEDFLUIDTYPE' )
TESCoil(item)%StorageMedia = FluidBased
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(5))//'="'//TRIM(cAlphaArgs(5))//'".')
CALL ShowContinueError('Available choices are Ice, Water, or UserDefindedFluidType')
ErrorsFound=.TRUE.
END SELECT
IF (SameString(cAlphaArgs(5), 'USERDEFINEDFLUIDTYPE' )) THEN
IF (.NOT. (lAlphaFieldBlanks(6))) THEN
TESCoil(item)%StorageFluidName = cAlphaArgs(6)
IF(CheckFluidPropertyName(cAlphaArgs(6)) == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", missing fluid data')
CALL ShowContinueError('Check that fluid property data have been input for fluid name = '//trim(cAlphaArgs(6)) )
ErrorsFound=.TRUE.
ELSE
TESCoil(item)%StorageFluidIndex = FindGlycol(cAlphaArgs(6))
IF (TESCoil(item)%StorageFluidIndex == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid fluid data')
CALL ShowContinueError('Check that correct fluid property data have been input for fluid name = '//trim(cAlphaArgs(6)) )
ErrorsFound=.TRUE.
ENDIF
ENDIF
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Storage Type is set to UserDefinedFluidType but no name of fluid was entered.' )
ErrorsFound=.TRUE.
ENDIF
ENDIF
IF ((TESCoil(item)%StorageMedia == FluidBased) .AND. (.not. lNumericFieldBlanks(1))) THEN
TESCoil(item)%FluidStorageVolume = rNumericArgs(1)
ELSEIF ((TESCoil(item)%StorageMedia == FluidBased) .AND. ( lNumericFieldBlanks(1))) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' cannot be blank for Water storage type')
CALL ShowContinueError('Enter fluid storage tank volume in m3/s.')
ErrorsFound=.TRUE.
ENDIF
IF ((TESCoil(item)%StorageMedia == IceBased) .AND. (.not. lNumericFieldBlanks(2))) THEN
IF (rNumericArgs(2) == AutoCalculate) THEN
TESCoil(item)%IceStorageCapacity = rNumericArgs(2)
ELSE
TESCoil(item)%IceStorageCapacity = rNumericArgs(2) * 1.d+09 ! input in giga joules, used as joules internally
ENDIF
ELSEIF ((TESCoil(item)%StorageMedia == IceBased) .AND. (lNumericFieldBlanks(2))) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' cannot be blank for Ice storage type')
CALL ShowContinueError('Enter ice storage tank capacity in GJ.')
ErrorsFound=.TRUE.
ENDIF
TESCoil(item)%StorageCapacitySizingFactor = rNumericArgs(3)
TESCoil(item)%StorageAmbientNodeNum = GetOnlySingleNode(cAlphaArgs(7), ErrorsFound, TRIM(cCurrentModuleObject), &
cAlphaArgs(1), NodeType_Air, NodeConnectionType_Sensor, &
1, ObjectIsNotParent)
ZoneIndexTrial = FindControlledZoneIndexFromSystemNodeNumberForZone(TESCoil(item)%StorageAmbientNodeNum)
IF (ZoneIndexTrial > 0) THEN ! tank is inside a zone so setup internal gains
CALL SetupZoneInternalGain(ZoneIndexTrial, &
'Coil:Cooling:DX:SingleSpeed:ThermalStorage', &
TESCoil(item)%Name, &
IntGainTypeOf_PackagedTESCoilTank, &
ConvectionGainRate = TESCoil(item)%QdotAmbient )
ENDIF
TESCoil(item)%StorageUA = rNumericArgs(4)
TESCoil(item)%RatedFluidTankTemp = rNumericArgs(5)
TESCoil(item)%RatedEvapAirVolFlowRate = rNumericArgs(6)
TESCoil(item)%EvapAirInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(8),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Inlet,1,ObjectIsNotParent)
TESCoil(item)%EvapAirOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(9),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Air,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject), cAlphaArgs(1), cAlphaArgs(8), cAlphaArgs(9), 'Air Nodes')
SELECT CASE (cAlphaArgs(10))
CASE ('YES')
TESCoil(item)%CoolingOnlyModeIsAvailable = .TRUE.
CASE ('NO')
TESCoil(item)%CoolingOnlyModeIsAvailable = .FALSE.
CASE DEFAULT
TESCoil(item)%CoolingOnlyModeIsAvailable = .FALSE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(10))//'="'//TRIM(cAlphaArgs(10))//'".')
CALL ShowContinueError('Available choices are Yes or No.')
ErrorsFound=.TRUE.
END SELECT
TESCoil(item)%CoolingOnlyRatedTotCap = rNumericArgs(7)
IF (TESCoil(item)%CoolingOnlyModeIsAvailable) THEN ! get input data for this mode
TESCoil(item)%CoolingOnlyRatedSHR = rNumericArgs(8)
TESCoil(item)%CoolingOnlyRatedCOP = rNumericArgs(9)
TESCoil(item)%CoolingOnlyCapFTempCurve = GetCurveIndex( cAlphaArgs(11) )
IF (TESCoil(item)%CoolingOnlyCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(11)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(11))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(11))//'="'//TRIM(cAlphaArgs(11))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyCapFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%CoolingOnlyCapFTempObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(11))//'="'//TRIM(cAlphaArgs(11))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlyCapFFlowCurve = GetCurveIndex( cAlphaArgs(12) )
IF (TESCoil(item)%CoolingOnlyCapFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(12)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(12))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(12))//'="'//TRIM(cAlphaArgs(12))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyCapFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingOnlyCapFFlowObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyCapFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(12))//'="'//TRIM(cAlphaArgs(12))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlyEIRFTempCurve = GetCurveIndex( cAlphaArgs(13) )
IF (TESCoil(item)%CoolingOnlyEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(13)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(13))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(13))//'="'//TRIM(cAlphaArgs(13))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyEIRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%CoolingOnlyEIRFTempObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(13))//'="'//TRIM(cAlphaArgs(13))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlyEIRFFlowCurve = GetCurveIndex( cAlphaArgs(14) )
IF (TESCoil(item)%CoolingOnlyEIRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(14)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(14))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(14))//'="'//TRIM(cAlphaArgs(14))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyEIRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingOnlyEIRFFlowObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyEIRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(14))//'="'//TRIM(cAlphaArgs(14))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlyPLFFPLRCurve = GetCurveIndex( cAlphaArgs(15) )
IF (TESCoil(item)%CoolingOnlyPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(15)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(15))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(15))//'="'//TRIM(cAlphaArgs(15))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingOnlyPLFFPLRObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlyPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(15))//'="'//TRIM(cAlphaArgs(15))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlySHRFTempCurve = GetCurveIndex( cAlphaArgs(16) )
IF (TESCoil(item)%CoolingOnlySHRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(16)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(16))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(16))//'="'//TRIM(cAlphaArgs(16))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlySHRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%CoolingOnlySHRFTempObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlySHRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(16))//'="'//TRIM(cAlphaArgs(16))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingOnlySHRFFlowCurve = GetCurveIndex( cAlphaArgs(17) )
IF (TESCoil(item)%CoolingOnlySHRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(17)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(17))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(17))//'="'//TRIM(cAlphaArgs(17))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlySHRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingOnlySHRFFlowObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingOnlySHRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(17))//'="'//TRIM(cAlphaArgs(17))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
ENDIF
SELECT CASE (cAlphaArgs(18))
CASE ('YES')
TESCoil(item)%CoolingAndChargeModeAvailable = .TRUE.
CASE ('NO')
TESCoil(item)%CoolingAndChargeModeAvailable = .FALSE.
CASE DEFAULT
TESCoil(item)%CoolingAndChargeModeAvailable = .FALSE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(18))//'="'//TRIM(cAlphaArgs(18))//'".')
CALL ShowContinueError('Available choices are Yes or No.')
ErrorsFound=.TRUE.
END SELECT
IF (TESCoil(item)%CoolingAndChargeModeAvailable ) THEN
TESCoil(item)%CoolingAndChargeRatedTotCap = rNumericArgs(10) ! gross total evaporator cooling capacity [W]
TESCoil(item)%CoolingAndChargeRatedTotCapSizingFactor = rNumericArgs(11) !sizing factor for gross total evaporator [ ]
TESCoil(item)%CoolingAndChargeRatedChargeCap = rNumericArgs(12) !net storage charging capacity at rating conditions [W]
TESCoil(item)%CoolingAndChargeRatedChargeCapSizingFactor = rNumericArgs(13) !sizing factor for charging capacity [ ]
TESCoil(item)%CoolingAndChargeRatedSHR = rNumericArgs(14) ! Sensible heat ratio (sens cap/total cap) [W/W]
TESCoil(item)%CoolingAndChargeCoolingRatedCOP = rNumericArgs(15) ! Coefficient of performance , for cooling [W/W]
TESCoil(item)%CoolingAndChargeChargingRatedCOP = rNumericArgs(16) ! Coefficient of performance , for charging [W/W]
TESCoil(item)%CoolingAndChargeCoolingCapFTempCurve = GetCurveIndex( cAlphaArgs(19) )
IF (TESCoil(item)%CoolingAndChargeCoolingCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(19)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(19))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(19))//'="'//TRIM(cAlphaArgs(19))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingCapFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndChargeCoolingCapFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(19))//'="'//TRIM(cAlphaArgs(19))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeCoolingCapFFlowCurve = GetCurveIndex( cAlphaArgs(20) )
IF (TESCoil(item)%CoolingAndChargeCoolingCapFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(20)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(20))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(20))//'="'//TRIM(cAlphaArgs(20))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingCapFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeCoolingCapFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingCapFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(20))//'="'//TRIM(cAlphaArgs(20))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeCoolingEIRFTempCurve = GetCurveIndex( cAlphaArgs(21) )
IF (TESCoil(item)%CoolingAndChargeCoolingEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(21)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(21))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(21))//'="'//TRIM(cAlphaArgs(21))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingEIRFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndChargeCoolingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(21))//'="'//TRIM(cAlphaArgs(21))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeCoolingEIRFFlowCurve = GetCurveIndex( cAlphaArgs(22) )
IF (TESCoil(item)%CoolingAndChargeCoolingEIRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(22)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(22))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(22))//'="'//TRIM(cAlphaArgs(22))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingEIRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeCoolingEIRFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingEIRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(22))//'="'//TRIM(cAlphaArgs(22))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeCoolingPLFFPLRCurve = GetCurveIndex( cAlphaArgs(23) )
IF (TESCoil(item)%CoolingAndChargeCoolingPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(23)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(23))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(23))//'="'//TRIM(cAlphaArgs(23))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeCoolingPLFFPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeCoolingPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(23))//'="'//TRIM(cAlphaArgs(23))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeChargingCapFTempCurve = GetCurveIndex( cAlphaArgs(24) )
IF (TESCoil(item)%CoolingAndChargeChargingCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(24)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(24))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(24))//'="'//TRIM(cAlphaArgs(24))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingCapFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndChargeCoolingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(24))//'="'//TRIM(cAlphaArgs(24))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeChargingCapFEvapPLRCurve = GetCurveIndex( cAlphaArgs(25) )
IF (TESCoil(item)%CoolingAndChargeChargingCapFEvapPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(25)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(25))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(25))//'="'//TRIM(cAlphaArgs(25))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingCapFEvapPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeChargingCapFEvapPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingCapFEvapPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(25))//'="'//TRIM(cAlphaArgs(25))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeChargingEIRFTempCurve = GetCurveIndex( cAlphaArgs(26) )
IF (TESCoil(item)%CoolingAndChargeChargingEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(26)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(26))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(26))//'="'//TRIM(cAlphaArgs(26))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingEIRFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndChargeChargingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(26))//'="'//TRIM(cAlphaArgs(26))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeChargingEIRFFLowCurve = GetCurveIndex( cAlphaArgs(27) )
IF (TESCoil(item)%CoolingAndChargeChargingEIRFFLowCurve == 0) THEN
IF (lAlphaFieldBlanks(27)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(27))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(27))//'="'//TRIM(cAlphaArgs(27))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingEIRFFLowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeChargingEIRFFLowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingEIRFFLowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(27))//'="'//TRIM(cAlphaArgs(27))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeChargingPLFFPLRCurve = GetCurveIndex( cAlphaArgs(28) )
IF (TESCoil(item)%CoolingAndChargeChargingPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(28)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(28))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(28))//'="'//TRIM(cAlphaArgs(28))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeChargingPLFFPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeChargingPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(28))//'="'//TRIM(cAlphaArgs(28))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeSHRFTempCurve = GetCurveIndex( cAlphaArgs(29) )
IF (TESCoil(item)%CoolingAndChargeSHRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(29)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(29))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(29))//'="'//TRIM(cAlphaArgs(29))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeSHRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV, &
CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndChargeSHRFTempObjectNum = GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeSHRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(29))//'="'//TRIM(cAlphaArgs(29))//'".')
CALL ShowContinueError('Choose a curve or table with two or three independent variables.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndChargeSHRFFlowCurve = GetCurveIndex( cAlphaArgs(30) )
IF (TESCoil(item)%CoolingAndChargeSHRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(30)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(30))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(30))//'="'//TRIM(cAlphaArgs(30))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeSHRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndChargeSHRFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndChargeSHRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(30))//'="'//TRIM(cAlphaArgs(30))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
ENDIF ! Cooling and Charge Mode available
SELECT CASE (cAlphaArgs(31))
CASE ('YES')
TESCoil(item)%CoolingAndDischargeModeAvailable = .TRUE.
CASE ('NO')
TESCoil(item)%CoolingAndDischargeModeAvailable = .FALSE.
CASE DEFAULT
TESCoil(item)%CoolingAndDischargeModeAvailable = .FALSE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(31))//'="'//TRIM(cAlphaArgs(31))//'".')
CALL ShowContinueError('Available choices are Yes or No.')
ErrorsFound=.TRUE.
END SELECT
IF ( TESCoil(item)%CoolingAndDischargeModeAvailable ) THEN
TESCoil(item)%CoolingAndDischargeRatedTotCap = rNumericArgs(17) ! gross total evaporator cooling capacity [W]
TESCoil(item)%CoolingAndDischargeRatedTotCapSizingFactor = rNumericArgs(18) !sizing factor gross total cooling capacity []
TESCoil(item)%CoolingAndDischargeRatedDischargeCap = rNumericArgs(19) !net storage discharging capacity [W]
TESCoil(item)%CoolingAndDischargeRatedDischargeCapSizingFactor = rNumericArgs(20) !sizing factor discharging capacity []
TESCoil(item)%CoolingAndDischargeRatedSHR = rNumericArgs(21) ! Sensible heat ratio (sens cap/total cap) [W/W]
TESCoil(item)%CoolingAndDischargeCoolingRatedCOP = rNumericArgs(22) ! Coefficient of performance , for cooling [W/W]
TESCoil(item)%CoolingAndDischargeDischargingRatedCOP = rNumericArgs(23) ! Coefficient of performance , for charging [W/W]
TESCoil(item)%CoolingAndDischargeCoolingCapFTempCurve = GetCurveIndex( cAlphaArgs(32) )
IF (TESCoil(item)%CoolingAndDischargeCoolingCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(32)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(32))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(32))//'="'//TRIM(cAlphaArgs(32))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingCapFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndDischargeCoolingCapFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(32))//'="'//TRIM(cAlphaArgs(32))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeCoolingCapFFlowCurve = GetCurveIndex( cAlphaArgs(33) )
IF (TESCoil(item)%CoolingAndDischargeCoolingCapFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(33)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(33))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(33))//'="'//TRIM(cAlphaArgs(33))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingCapFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeCoolingCapFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingCapFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(33))//'="'//TRIM(cAlphaArgs(33))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeCoolingEIRFTempCurve = GetCurveIndex( cAlphaArgs(34) )
IF (TESCoil(item)%CoolingAndDischargeCoolingEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(34)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(34))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(34))//'="'//TRIM(cAlphaArgs(34))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingEIRFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndDischargeCoolingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(34))//'="'//TRIM(cAlphaArgs(34))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeCoolingEIRFFlowCurve = GetCurveIndex( cAlphaArgs(35) )
IF (TESCoil(item)%CoolingAndDischargeCoolingEIRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(35)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(35))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(35))//'="'//TRIM(cAlphaArgs(35))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingEIRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeCoolingEIRFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingEIRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(35))//'="'//TRIM(cAlphaArgs(35))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeCoolingPLFFPLRCurve = GetCurveIndex( cAlphaArgs(36) )
IF (TESCoil(item)%CoolingAndDischargeCoolingPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(36)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(36))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(36))//'="'//TRIM(cAlphaArgs(36))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeCoolingPLFFPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeCoolingPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(36))//'="'//TRIM(cAlphaArgs(36))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingCapFTempCurve = GetCurveIndex( cAlphaArgs(37) )
IF (TESCoil(item)%CoolingAndDischargeDischargingCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(37)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(37))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(37))//'="'//TRIM(cAlphaArgs(37))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndDischargeDischargingCapFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(37))//'="'//TRIM(cAlphaArgs(37))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingCapFFlowCurve = GetCurveIndex( cAlphaArgs(38) )
IF (TESCoil(item)%CoolingAndDischargeDischargingCapFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(38)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(38))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(38))//'="'//TRIM(cAlphaArgs(38))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeDischargingCapFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(38))//'="'//TRIM(cAlphaArgs(38))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingCapFEvapPLRCurve = GetCurveIndex( cAlphaArgs(39) )
IF (TESCoil(item)%CoolingAndDischargeDischargingCapFEvapPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(39)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(39))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(39))//'="'//TRIM(cAlphaArgs(39))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFEvapPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeDischargingCapFEvapPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingCapFEvapPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(39))//'="'//TRIM(cAlphaArgs(39))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingEIRFTempCurve = GetCurveIndex( cAlphaArgs(40) )
IF (TESCoil(item)%CoolingAndDischargeDischargingEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(40)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(40))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(40))//'="'//TRIM(cAlphaArgs(40))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingEIRFTempCurve) )
CASE (CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndDischargeDischargingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(40))//'="'//TRIM(cAlphaArgs(40))//'".')
CALL ShowContinueError('Choose a curve or table with three independent variables -- x, y, and z.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingEIRFFLowCurve = GetCurveIndex( cAlphaArgs(41) )
IF (TESCoil(item)%CoolingAndDischargeDischargingEIRFFLowCurve == 0) THEN
IF (lAlphaFieldBlanks(41)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(41))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(41))//'="'//TRIM(cAlphaArgs(41))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingEIRFFLowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeDischargingEIRFFLowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingEIRFFLowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(41))//'="'//TRIM(cAlphaArgs(41))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeDischargingPLFFPLRCurve = GetCurveIndex( cAlphaArgs(42) )
IF (TESCoil(item)%CoolingAndDischargeDischargingPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(42)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(42))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(42))//'="'//TRIM(cAlphaArgs(42))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeDischargingPLFFPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeDischargingPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(42))//'="'//TRIM(cAlphaArgs(42))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeSHRFTempCurve = GetCurveIndex( cAlphaArgs(43) )
IF (TESCoil(item)%CoolingAndDischargeSHRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(43)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(43))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(43))//'="'//TRIM(cAlphaArgs(43))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeSHRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV, &
CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%CoolingAndDischargeSHRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeSHRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(43))//'="'//TRIM(cAlphaArgs(43))//'".')
CALL ShowContinueError('Choose a curve or table with two or three independent variables.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%CoolingAndDischargeSHRFFlowCurve = GetCurveIndex( cAlphaArgs(44) )
IF (TESCoil(item)%CoolingAndDischargeSHRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(44)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(44))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(44))//'="'//TRIM(cAlphaArgs(44))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeSHRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%CoolingAndDischargeSHRFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%CoolingAndDischargeSHRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(44))//'="'//TRIM(cAlphaArgs(44))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
ENDIF ! cooling and discharge mode available
SELECT CASE (cAlphaArgs(45))
CASE ('YES')
TESCoil(item)%ChargeOnlyModeAvailable = .TRUE.
CASE ('NO')
TESCoil(item)%ChargeOnlyModeAvailable = .FALSE.
CASE DEFAULT
TESCoil(item)%ChargeOnlyModeAvailable = .FALSE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(45))//'="'//TRIM(cAlphaArgs(45))//'".')
CALL ShowContinueError('Available choices are Yes or No.')
ErrorsFound=.TRUE.
END SELECT
IF ( TESCoil(item)%ChargeOnlyModeAvailable ) THEN
TESCoil(item)%ChargeOnlyRatedCapacity = rNumericArgs(24) ! net storage charging capacity at rating conditions [W]
TESCoil(item)%ChargeOnlyRatedCapacitySizingFactor = rNumericArgs(25) !sizing factor for charging capacity []
TESCoil(item)%ChargeOnlyRatedCOP = rNumericArgs(26) ! coefficient of performance at rating conditions [W/W]
TESCoil(item)%ChargeOnlyChargingCapFTempCurve = GetCurveIndex( cAlphaArgs(46) )
IF (TESCoil(item)%ChargeOnlyChargingCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(46)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(46))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(46))//'="'//TRIM(cAlphaArgs(46))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%ChargeOnlyChargingCapFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%ChargeOnlyChargingCapFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%ChargeOnlyChargingCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(46))//'="'//TRIM(cAlphaArgs(46))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%ChargeOnlyChargingEIRFTempCurve = GetCurveIndex( cAlphaArgs(47) )
IF (TESCoil(item)%ChargeOnlyChargingEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(47)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(47))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(47))//'="'//TRIM(cAlphaArgs(47))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%ChargeOnlyChargingEIRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%ChargeOnlyChargingEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%ChargeOnlyChargingEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(47))//'="'//TRIM(cAlphaArgs(47))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
ENDIF ! Charge only mode available
SELECT CASE (cAlphaArgs(48))
CASE ('YES')
TESCoil(item)%DischargeOnlyModeAvailable = .TRUE.
CASE ('NO')
TESCoil(item)%DischargeOnlyModeAvailable = .FALSE.
CASE DEFAULT
TESCoil(item)%DischargeOnlyModeAvailable = .FALSE.
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(48))//'="'//TRIM(cAlphaArgs(48))//'".')
CALL ShowContinueError('Available choices are Yes or No.')
ErrorsFound=.TRUE.
END SELECT
IF ( TESCoil(item)%DischargeOnlyModeAvailable ) THEN
TESCoil(item)%DischargeOnlyRatedDischargeCap = rNumericArgs(27) ! gross total evaporator cooling capacity [W]
TESCoil(item)%DischargeOnlyRatedDischargeCapSizingFactor = rNumericArgs(28) ! sizing factor for cooling capacity []
TESCoil(item)%DischargeOnlyRatedSHR = rNumericArgs(29)! sensible heat ratio (sens cap/total cap)
TESCoil(item)%DischargeOnlyRatedCOP = rNumericArgs(30)! coefficient of performance for discharging [W/W]
TESCoil(item)%DischargeOnlyCapFTempCurve = GetCurveIndex( cAlphaArgs(49) )
IF (TESCoil(item)%DischargeOnlyCapFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(49)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(49))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(49))//'="'//TRIM(cAlphaArgs(49))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyCapFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%DischargeOnlyCapFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyCapFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(49))//'="'//TRIM(cAlphaArgs(49))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlyCapFFlowCurve = GetCurveIndex( cAlphaArgs(50) )
IF (TESCoil(item)%DischargeOnlyCapFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(50)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(50))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(50))//'="'//TRIM(cAlphaArgs(50))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyCapFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%DischargeOnlyCapFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyCapFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(50))//'="'//TRIM(cAlphaArgs(50))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlyEIRFTempCurve = GetCurveIndex( cAlphaArgs(51) )
IF (TESCoil(item)%DischargeOnlyEIRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(51)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(51))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(51))//'="'//TRIM(cAlphaArgs(51))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyEIRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV)
TESCoil(item)%DischargeOnlyEIRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyEIRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(51))//'="'//TRIM(cAlphaArgs(51))//'".')
CALL ShowContinueError('Choose a curve or table with two independent variables, x and y.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlyEIRFFlowCurve = GetCurveIndex( cAlphaArgs(52) )
IF (TESCoil(item)%DischargeOnlyEIRFFlowCurve == 0) THEN
IF (lAlphaFieldBlanks(52)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(52))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(52))//'="'//TRIM(cAlphaArgs(52))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyEIRFFlowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%DischargeOnlyEIRFFlowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyEIRFFlowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(52))//'="'//TRIM(cAlphaArgs(52))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlyPLFFPLRCurve = GetCurveIndex( cAlphaArgs(53) )
IF (TESCoil(item)%DischargeOnlyPLFFPLRCurve == 0) THEN
IF (lAlphaFieldBlanks(53)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(53))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(53))//'="'//TRIM(cAlphaArgs(53))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyPLFFPLRCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%DischargeOnlyPLFFPLRObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlyPLFFPLRCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(53))//'="'//TRIM(cAlphaArgs(53))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlySHRFTempCurve = GetCurveIndex( cAlphaArgs(54) )
IF (TESCoil(item)%DischargeOnlySHRFTempCurve == 0) THEN
IF (lAlphaFieldBlanks(54)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(54))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(54))//'="'//TRIM(cAlphaArgs(54))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlySHRFTempCurve) )
CASE (CurveType_BiCubic, CurveType_BiQuadratic, CurveType_QuadraticLinear, CurveType_TableTwoIV, &
CurveType_TriQuadratic, CurveType_TableMultiIV)
TESCoil(item)%DischargeOnlySHRFTempObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlySHRFTempCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(54))//'="'//TRIM(cAlphaArgs(54))//'".')
CALL ShowContinueError('Choose a curve or table with two or three independent variables')
ErrorsFound=.TRUE.
END SELECT
ENDIF
TESCoil(item)%DischargeOnlySHRFFLowCurve = GetCurveIndex( cAlphaArgs(55) )
IF (TESCoil(item)%DischargeOnlySHRFFLowCurve == 0) THEN
IF (lAlphaFieldBlanks(55)) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Required '//TRIM(cAlphaFieldNames(55))//'is blank.')
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('Not found '//TRIM(cAlphaFieldNames(55))//'="'//TRIM(cAlphaArgs(55))//'".')
ENDIF
ErrorsFound=.TRUE.
ELSE
! Verify Curve Object, any curve with just x as single independent variable
SELECT CASE( GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlySHRFFLowCurve) )
CASE (CurveType_Linear, CurveType_Quadratic, CurveType_Cubic, CurveType_Quartic,&
CurveType_Exponent, CurveType_TableOneIV, CurveType_ExponentialSkewNormal, &
CurveType_Sigmoid,CurveType_RectangularHyperbola1, CurveType_RectangularHyperbola2, &
CurveType_ExponentialDecay, CurveType_DoubleExponentialDecay)
TESCoil(item)%DischargeOnlySHRFFLowObjectNum = &
GetCurveObjectTypeNum(TESCoil(item)%DischargeOnlySHRFFLowCurve)
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(55))//'="'//TRIM(cAlphaArgs(55))//'".')
CALL ShowContinueError('Choose a curve or table with one independent variable, x.')
ErrorsFound=.TRUE.
END SELECT
ENDIF
ENDIF ! Discharge Only mode available
TESCoil(item)%AncillaryControlsPower = rNumericArgs(31)
TESCoil(item)%ColdWeatherMinimumTempLimit = rNumericArgs(32)
TESCoil(item)%ColdWeatherAncillaryPower = rNumericArgs(33)
TESCoil(item)%CondAirInletNodeNum = GetOnlySingleNode(cAlphaArgs(56),ErrorsFound, &
TRIM(cCurrentModuleObject),TESCoil(item)%Name, &
NodeType_Air,NodeConnectionType_OutsideAirReference,1,ObjectIsNotParent)
TESCoil(item)%CondAirOutletNodeNum = GetOnlySingleNode(cAlphaArgs(57),ErrorsFound, &
TRIM(cCurrentModuleObject),TESCoil(item)%Name, &
NodeType_Air,NodeConnectionType_ReliefAir,1,ObjectIsNotParent)
TESCoil(item)%CondenserAirVolumeFlow = rNumericArgs(34)
TESCoil(item)%CondenserAirFlowSizingFactor = rNumericArgs(35)
SELECT CASE ( cAlphaArgs(58) )
CASE ('AIRCOOLED')
TESCoil(item)%CondenserType = AirCooled
CASE ('EVAPORATIVELYCOOLED')
TESCoil(item)%CondenserType = EvapCooled
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError(TRIM(cAlphaFieldNames(58))//'="'//TRIM(cAlphaArgs(58))//'".')
CALL ShowContinueError('Available choices are AirCooled or EvaporativelyCooled.')
ErrorsFound=.TRUE.
END SELECT
TESCoil(item)%EvapCondEffect = rNumericArgs(36)
TESCoil(item)%EvapCondPumpElecNomPower = rNumericArgs(37)
TESCoil(item)%BasinHeaterPowerFTempDiff = rNumericArgs(38)
TESCoil(item)%BasinHeaterSetpointTemp = rNumericArgs(39)
IF (lAlphaFieldBlanks(59)) THEN
TESCoil(item)%BasinHeaterAvailSchedNum = ScheduleAlwaysOn
ELSE
TESCoil(item)%BasinHeaterAvailSchedNum = GetScheduleIndex(cAlphaArgs(59))
IF (TESCoil(item)%BasinHeaterAvailSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(59))//'="'//TRIM(cAlphaArgs(59))//'".')
ErrorsFound=.TRUE.
ENDIF
ENDIF
IF (lAlphaFieldBlanks(60)) THEN
TESCoil(item)%EvapWaterSupplyMode = WaterSupplyFromMains
ELSE
TESCoil(item)%EvapWaterSupplyName = cAlphaArgs(60)
TESCoil(item)%EvapWaterSupplyMode = WaterSupplyFromTank
CALL SetupTankDemandComponent(TESCoil(item)%Name,TRIM(cCurrentModuleObject), &
TESCoil(item)%EvapWaterSupplyName, ErrorsFound, TESCoil(item)%EvapWaterSupTankID, &
TESCoil(item)%EvapWaterTankDemandARRID )
ENDIF
IF (lAlphaFieldBlanks(61)) THEN
TESCoil(item)%CondensateCollectMode = CondensateDiscarded
ELSE
TESCoil(item)%CondensateCollectName = cAlphaArgs(61)
TESCoil(item)%CondensateCollectMode = CondensateToTank
CALL SetupTankSupplyComponent(TESCoil(item)%Name,TRIM(cCurrentModuleObject), &
TESCoil(item)%CondensateCollectName, ErrorsFound, TESCoil(item)%CondensateTankID, &
TESCoil(item)%CondensateTankSupplyARRID )
ENDIF
IF (.NOT. lAlphaFieldBlanks(62)) THEN
TESCoil(item)%TESPlantInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(62),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 2, ObjectIsNotParent)
TESCoil(item)%TESPlantConnectionAvailable = .TRUE.
ELSE
TESCoil(item)%TESPlantConnectionAvailable = .FALSE.
ENDIF
IF (.NOT. lAlphaFieldBlanks(63)) THEN
TESCoil(item)%TESPlantOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(63),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, 2, ObjectIsNotParent)
ELSE
IF (TESCoil(item)%TESPlantConnectionAvailable) THEN
CALL ShowSevereError(RoutineName//trim(cCurrentModuleObject)//'="'//trim(TESCoil(item)%Name)//'", invalid')
CALL ShowContinueError('...'//TRIM(cAlphaFieldNames(63))//' cannot be blank.')
ErrorsFound=.TRUE.
ENDIF
ENDIF
IF (TESCoil(item)%TESPlantConnectionAvailable) THEN
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(62), cAlphaArgs(63),'Water Nodes')
ENDIF
IF (.NOT. lNumericFieldBlanks(40) ) THEN
TESCoil(item)%TESPlantDesignVolumeFlowRate = rNumericArgs(40)
ENDIF
IF (.NOT. lNumericFieldBlanks(41) ) THEN
TESCoil(item)%TESPlantEffectiveness = rNumericArgs(41)
ENDIF
IF (TESCoil(item)%StorageMedia == FluidBased) THEN
IF (.NOT. lNumericFieldBlanks(42) ) THEN
TESCoil(item)%MinimumFluidTankTempLimit = rNumericArgs(42)
ELSE
Call GetFluidDensityTemperatureLimits(TESCoil(item)%StorageFluidIndex, TminRho, TmaxRho)
CALL GetFluidSpecificHeatTemperatureLimits(TESCoil(item)%StorageFluidIndex, TminCp, TmaxCp)
TESCoil(item)%MinimumFluidTankTempLimit = MAX(TminRho, TminCp)
ENDIF
IF (.NOT. lNumericFieldBlanks(43) ) THEN
TESCoil(item)%MaximumFluidTankTempLimit = rNumericArgs(43)
ELSE
Call GetFluidDensityTemperatureLimits(TESCoil(item)%StorageFluidIndex, TminRho, TmaxRho)
CALL GetFluidSpecificHeatTemperatureLimits(TESCoil(item)%StorageFluidIndex, TminCp, TmaxCp)
TESCoil(item)%MaximumFluidTankTempLimit = MIN(TmaxRho, TmaxCp)
ENDIF
ENDIF
ENDDO
IF (ErrorsFound) THEN
CALL ShowFatalError(RoutineName//'Errors found in getting '//TRIM(cCurrentModuleObject)//' input. '//&
'Preceding condition(s) causes termination.')
END IF
! setup reporting
DO item = 1, NumTESCoils
CALL SetupOutputVariable('Cooling Coil Operating Mode Index []', &
TESCoil(item)%CurControlMode, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Total Cooling Rate [W]', &
TESCoil(item)%EvapTotCoolingRate, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Total Cooling Energy [J]', &
TESCoil(item)%EvapTotCoolingEnergy, 'System', 'Sum', TESCoil(item)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='COOLINGCOILS',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Sensible Cooling Rate [W]', &
TESCoil(item)%EvapSensCoolingRate, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Sensible Cooling Energy [J]', &
TESCoil(item)%EvapSensCoolingEnergy, 'System', 'Sum', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Latent Cooling Rate [W]', &
TESCoil(item)%EvapLatCoolingRate, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Latent Cooling Energy [J]', &
TESCoil(item)%EvapLatCoolingEnergy, 'System', 'Sum', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Electric Power [W]', &
TESCoil(item)%ElecCoolingPower, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Electric Energy [J]', &
TESCoil(item)%ElecCoolingEnergy, 'System', 'Sum', TESCoil(item)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Runtime Fraction []', &
TESCoil(item)%RuntimeFraction, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Cold Weather Protection Electric Energy [J]', &
TESCoil(item)%ElectColdWeatherEnergy, 'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',EndUseSubKey='Thermal Protection', &
GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Cold Weather Protection Electric Power [W]', &
TESCoil(item)%ElectColdWeatherPower, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Thermal Storage Mechanical Heat Transfer Rate [W]', &
TESCoil(item)%QdotTES, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Thermal Storage Mechanical Heat Transfer Energy [J]', &
TESCoil(item)%Q_TES, 'System', 'Sum', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Thermal Storage Ambient Heat Transfer Rate [W]', &
TESCoil(item)%QdotAmbient, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Thermal Storage Ambient Heat Transfer Energy [J]', &
TESCoil(item)%Q_Ambient, 'System', 'Sum', TESCoil(item)%Name)
IF (TESCoil(item)%TESPlantConnectionAvailable) THEN
CALL SetupOutputVariable('Cooling Coil Thermal Storage Plant Heat Transfer Rate [W]', &
TESCoil(item)%QdotPlant, 'System', 'Average', TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Thermal Storage Plant Heat Transfer Energy [J]', &
TESCoil(item)%Q_Plant, 'System', 'Sum', TESCoil(item)%Name)
ENDIF
IF (TESCoil(item)%CondenserType == EvapCooled) THEN
CALL SetupOutputVariable('Cooling Coil Condenser Inlet Temperature [C]', &
TESCoil(item)%CondInletTemp,'System','Average', TESCoil(item)%Name)
IF (TESCoil(item)%EvapWaterSupplyMode == WaterSupplyFromMains) THEN
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Water Volume [m3]',TESCoil(item)%EvapWaterConsump, &
'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Water',EndUseKey='Cooling',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Mains Supply Water Volume [m3]', &
TESCoil(item)%EvapWaterConsump, &
'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='MainsWater',EndUseKey='Cooling',GroupKey='System')
ELSEIF (TESCoil(item)%EvapWaterSupplyMode == WaterSupplyFromTank) THEN
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Storage Tank Water Volume [m3]',&
TESCoil(item)%EvapWaterConsump, &
'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Water',EndUseKey='Cooling' , GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Starved Water Volume [m3]', &
TESCoil(item)%EvapWaterStarvMakup, &
'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Water',EndUseKey='Cooling', GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Starved Mains Water Volume [m3]',&
TESCoil(item)%EvapWaterStarvMakup, &
'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='MainsWater',EndUseKey='Cooling', GroupKey='System')
ENDIf
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Pump Electric Power [W]',TESCoil(item)%EvapCondPumpElecPower, &
'System','Average',TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Evaporative Condenser Pump Electric Energy [J]', &
TESCoil(item)%EvapCondPumpElecConsumption,'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',GroupKey='System')
CALL SetupOutputVariable('Cooling Coil Basin Heater Electric Power [W]', &
TESCoil(item)%ElectEvapCondBasinHeaterPower, 'System','Average',TESCoil(item)%Name)
CALL SetupOutputVariable('Cooling Coil Basin Heater Electric Energy [J]', &
TESCoil(item)%ElectEvapCondBasinHeaterEnergy, 'System','Sum',TESCoil(item)%Name, &
ResourceTypeKey='Electric',EndUseKey='COOLING',EndUseSubKey='Thermal Protection', &
GroupKey='System')
ENDIF
IF (TESCoil(item)%StorageMedia == FluidBased) THEN
CALL SetupOutputVariable('Cooling Coil Fluid Thermal Storage End Temperature [C]', &
TESCoil(item)%FluidTankTempFinal, 'System','Average',TESCoil(item)%Name)
ELSEIF (TESCoil(item)%StorageMedia == IceBased) THEN
CALL SetupOutputVariable('Cooling Coil Ice Thermal Storage End Fraction []', &
TESCoil(item)%IceFracRemain, 'System','Average',TESCoil(item)%Name)
ENDIF
ENDDO
IF (AnyEnergyManagementSystemInModel) THEN
DO item = 1, NumTESCoils
! setup EMS actuator for control mode
CALL SetupEMSActuator('Coil:Cooling:DX:SingleSpeed:ThermalStorage', TESCoil(item)%Name, &
'Operating Mode' , '[ ]', &
TESCoil(item)%EMSControlModeOn, &
TESCoil(item)%EMSControlModeValue )
ENDDO
ENDIF
RETURN
END SUBROUTINE GetTESCoilInput