SUBROUTINE GetElectricEIRChillerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Richard Raustad, FSEC
! DATE WRITTEN: June 2004
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input required by the Electric EIR Chiller model.
! METHODOLOGY EMPLOYED:
!
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE CurveManager, ONLY: GetCurveIndex
USE FluidProperties, ONLY: FindGlycol
USE CurveManager, ONLY: CurveValue
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE OutAirNodeManager, ONLY: CheckAndAddAirNodeNumber
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE ScheduleManager, ONLY: GetScheduleIndex
USE DataSizing, ONLY: Autosize
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! PARAMETERS
CHARACTER(len=*), PARAMETER :: RoutineName='GetElectricEIRChillerInput: ' ! include trailing blank space
! LOCAL VARIABLES
INTEGER :: EIRChillerNum ! Chiller counter
INTEGER :: NumAlphas ! Number of elements in the alpha array
INTEGER :: NumNums ! Number of elements in the numeric array
INTEGER :: IOStat ! IO Status when calling get input subroutine
LOGICAL, SAVE :: ErrorsFound=.false. ! True when input errors are found
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
REAL(r64) :: CurveVal ! Used to verify EIR-FT and CAP-FT curves equal 1 at reference conditions
LOGICAL :: FoundNegValue = .FALSE. ! Used to evaluate PLFFPLR curve objects
INTEGER :: CurveCheck = 0 ! Used to evaluate PLFFPLR curve objects
REAL(r64), DIMENSION(11) :: CurveValArray ! Used to evaluate PLFFPLR curve objects
REAL(r64) :: CurveValTmp ! Used to evaluate PLFFPLR curve objects
LOGICAL :: errflag ! Used to tell if a unique chiller name has been specified
CHARACTER(len=132) :: StringVar ! Used for EIRFPLR warning messages
INTEGER :: CurveValPtr ! Index to EIRFPLR curve output
LOGICAL, SAVE :: AllocatedFlag =.FALSE. ! True when arrays are allocated
LOGICAL :: Okay
! FLOW
IF (AllocatedFlag) RETURN
cCurrentModuleObject = 'Chiller:Electric:EIR'
NumElectricEIRChillers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumElectricEIRChillers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
END IF
! ALLOCATE ARRAYS
ALLOCATE (ElectricEIRChiller(NumElectricEIRChillers))
ALLOCATE (ElectricEIRChillerReport(NumElectricEIRChillers))
ALLOCATE(CheckEquipName(NumElectricEIRChillers))
CheckEquipName=.true.
AllocatedFlag = .TRUE.
! Load arrays with electric EIR chiller data
DO EIRChillerNum = 1 , NumElectricEIRChillers
CALL GetObjectItem(cCurrentModuleObject,EIRChillerNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ElectricEIRChiller%Name,EIRChillerNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
END IF
CALL VerifyUniqueChillerName(TRIM(cCurrentModuleObject),cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%Name = cAlphaArgs(1)
! Performance curves
ElectricEIRChiller(EIRChillerNum)%ChillerCapFT = GetCurveIndex(cAlphaArgs(2))
IF (ElectricEIRChiller(EIRChillerNum)%ChillerCapFT .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//' "'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(cAlphaArgs(2)))
ErrorsFound = .TRUE.
END IF
ElectricEIRChiller(EIRChillerNum)%ChillerEIRFT = GetCurveIndex(cAlphaArgs(3))
IF (ElectricEIRChiller(EIRChillerNum)%ChillerEIRFT .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(cAlphaArgs(3)))
ErrorsFound = .TRUE.
END IF
ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR = GetCurveIndex(cAlphaArgs(4))
IF (ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR .EQ. 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(cAlphaArgs(4)))
ErrorsFound = .TRUE.
END IF
ElectricEIRChiller(EIRChillerNum)%EvapInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
ElectricEIRChiller(EIRChillerNum)%EvapOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(6),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 1, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(5),cAlphaArgs(6),'Chilled Water Nodes')
IF (SameString(cAlphaArgs(9),'WaterCooled')) THEN
ElectricEIRChiller(EIRChillerNum)%CondenserType = WaterCooled
ELSEIF(SameString(cAlphaArgs(9),'AirCooled')) THEN
ElectricEIRChiller(EIRChillerNum)%CondenserType = AirCooled
ELSEIF(SameString(cAlphaArgs(9),'EvaporativelyCooled')) THEN
ElectricEIRChiller(EIRChillerNum)%CondenserType = EvapCooled
ELSE
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//': '//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Valid entries are AirCooled, WaterCooled, or EvaporativelyCooled')
ErrorsFound=.true.
END IF
IF (ElectricEIRChiller(EIRChillerNum)%CondenserType == AirCooled .or. &
ElectricEIRChiller(EIRChillerNum)%CondenserType == EvapCooled) THEN
! Connection not required for air or evap cooled condenser
! If the condenser inlet is blank for air cooled and evap cooled condensers then supply a generic name
! since it is not used elsewhere for connection
IF(lAlphaFieldBlanks(7))THEN
IF (LEN_TRIM(cAlphaArgs(1)) < (MaxNameLength - 25) ) THEN ! protect against long name leading to > 100 chars
cAlphaArgs(7) = TRIM(cAlphaArgs(1))//' INLET NODE FOR CONDENSER'
ELSE
cAlphaArgs(7) = TRIM(cAlphaArgs(1)(1:75))//' INLET NODE FOR CONDENSER'
ENDIF
END IF
IF(lAlphaFieldBlanks(8))THEN
IF (LEN_TRIM(cAlphaArgs(1)) < (MaxNameLength - 26) ) THEN ! protect against long name leading to > 100 chars
cAlphaArgs(8) = TRIM(cAlphaArgs(1))//' OUTLET NODE FOR CONDENSER'
ELSE
cAlphaArgs(8) = TRIM(cAlphaArgs(1)(1:74))//' OUTLET NODE FOR CONDENSER'
ENDIF
END IF
ElectricEIRChiller(EIRChillerNum)%CondInletNodeNum = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Air,NodeConnectionType_OutsideAirReference, 2, ObjectIsNotParent)
CALL CheckAndAddAirNodeNumber(ElectricEIRChiller(EIRChillerNum)%CondInletNodeNum,Okay)
IF (.not. Okay) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Adding OutdoorAir:Node='//TRIM(cAlphaArgs(7)))
ENDIF
ElectricEIRChiller(EIRChillerNum)%CondOutletNodeNum = GetOnlySingleNode(cAlphaArgs(8),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Air,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
ELSEIF (ElectricEIRChiller(EIRChillerNum)%CondenserType == WaterCooled) THEN
! Condenser inlet node name is necessary for water-cooled condenser
IF (lAlphaFieldBlanks(7) .or. lAlphaFieldBlanks(8) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Condenser Inlet or Outlet Node Name is blank.')
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%CondInletNodeNum = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ElectricEIRChiller(EIRChillerNum)%CondOutletNodeNum = GetOnlySingleNode(cAlphaArgs(8),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Water,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(7),cAlphaArgs(8),'Condenser Water Nodes')
ELSE
! Condenser inlet node name is necessary (never should reach this part of code)
IF (lAlphaFieldBlanks(7) .or. lAlphaFieldBlanks(8) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Condenser Inlet or Outlet Node Name is blank.')
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%CondInletNodeNum = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Unknown,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ElectricEIRChiller(EIRChillerNum)%CondOutletNodeNum = GetOnlySingleNode(cAlphaArgs(8),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Unknown,NodeConnectionType_Outlet, 2, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(7),cAlphaArgs(8),'Condenser (unknown?) Nodes')
END IF
SELECT CASE (TRIM(cAlphaArgs(10)))
CASE ( 'CONSTANTFLOW' )
ElectricEIRChiller(EIRChillerNum)%FlowMode = ConstantFlow
CASE ( 'VARIABLEFLOW' )
ElectricEIRChiller(EIRChillerNum)%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(cAlphaArgs(10)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
ElectricEIRChiller(EIRChillerNum)%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
ElectricEIRChiller(EIRChillerNum)%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(cAlphaArgs(10)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
ElectricEIRChiller(EIRChillerNum)%FlowMode = NotModulated
END SELECT
! Chiller rated performance data
ElectricEIRChiller(EIRChillerNum)%RefCap = rNumericArgs(1)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%RefCOP = rNumericArgs(2)
IF (rNumericArgs(2) == 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cNumericFieldNames(2))//'='//TRIM(RoundSigDigits(rNumericArgs(2),2)))
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%TempRefEvapOut = rNumericArgs(3)
ElectricEIRChiller(EIRChillerNum)%TempRefCondIn = rNumericArgs(4)
ElectricEIRChiller(EIRChillerNum)%EvapVolFlowRate = rNumericArgs(5)
IF (ElectricEIRChiller(EIRChillerNum)%CondenserType == AirCooled .OR. &
ElectricEIRChiller(EIRChillerNum)%CondenserType == EvapCooled) THEN ! Condenser flow rate not used for these cond types
ElectricEIRChiller(EIRChillerNum)%CondVolFlowRate = 0.0011d0
ELSE
ElectricEIRChiller(EIRChillerNum)%CondVolFlowRate = rNumericArgs(6)
END IF
ElectricEIRChiller(EIRChillerNum)%MinPartLoadRat = rNumericArgs(7)
ElectricEIRChiller(EIRChillerNum)%MaxPartLoadRat = rNumericArgs(8)
ElectricEIRChiller(EIRChillerNum)%OptPartLoadRat = rNumericArgs(9)
ElectricEIRChiller(EIRChillerNum)%MinUnLoadRat = rNumericArgs(10)
ElectricEIRChiller(EIRChillerNum)%SizFac = rNumericArgs(15)
IF (ElectricEIRChiller(EIRChillerNum)%SizFac <= 0.0d0) ElectricEIRChiller(EIRChillerNum)%SizFac = 1.0d0
IF(ElectricEIRChiller(EIRChillerNum)%MinPartLoadRat .GT. ElectricEIRChiller(EIRChillerNum)%MaxPartLoadRat) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(7))//' ['//TRIM(RoundSigDigits(rNumericArgs(7),3))//'] > '// &
TRIM(cNumericFieldNames(8))//' ['//TRIM(RoundSigDigits(rNumericArgs(8),3))//']')
CALL ShowContinueError('Minimum part load ratio must be less than or equal to the '// &
'maximum part load ratio ')
ErrorsFound=.true.
END IF
IF(ElectricEIRChiller(EIRChillerNum)%MinUnLoadRat .LT. ElectricEIRChiller(EIRChillerNum)%MinPartLoadRat .OR. &
ElectricEIRChiller(EIRChillerNum)%MinUnLoadRat .GT. ElectricEIRChiller(EIRChillerNum)%MaxPartLoadRat) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' = '//TRIM(RoundSigDigits(rNumericArgs(10),3)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be greater than or equal to the '// &
TRIM(cNumericFieldNames(7)))
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be less than or equal to the '// &
TRIM(cNumericFieldNames(8)))
ErrorsFound=.true.
END IF
IF(ElectricEIRChiller(EIRChillerNum)%OptPartLoadRat .LT. ElectricEIRChiller(EIRChillerNum)%MinPartLoadRat .OR. &
ElectricEIRChiller(EIRChillerNum)%OptPartLoadRat .GT. ElectricEIRChiller(EIRChillerNum)%MaxPartLoadRat) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' = '//TRIM(RoundSigDigits(rNumericArgs(9),3)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' must be greater than or equal to the '// &
TRIM(cNumericFieldNames(7)))
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' must be less than or equal to the '// &
TRIM(cNumericFieldNames(8)))
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%CondenserFanPowerRatio = rNumericArgs(11)
ElectricEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac = rNumericArgs(12)
IF(ElectricEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac .LT. 0.0d0 .OR. &
ElectricEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac .GT. 1.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' = '//TRIM(RoundSigDigits(rNumericArgs(12),3)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' must be greater than or equal to zero' )
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' must be less than or equal to one' )
ErrorsFound=.true.
END IF
ElectricEIRChiller(EIRChillerNum)%TempLowLimitEvapOut = rNumericArgs(13)
! These are the heat recovery inputs
ElectricEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate = rNumericArgs(14)
IF ((ElectricEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate > 0.0d0) &
.OR. (ElectricEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate == Autosize) )THEN
ElectricEIRChiller(EIRChillerNum)%HeatRecActive=.True.
ElectricEIRChiller(EIRChillerNum)%HeatRecInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(11),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 3, ObjectIsNotParent)
IF (ElectricEIRChiller(EIRChillerNum)%HeatRecInletNodeNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(11))//'='//TRIM(cAlphaArgs(11)))
ErrorsFound=.True.
END IF
ElectricEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(12),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 3, ObjectIsNotParent)
IF (ElectricEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(12))//'='//TRIM(cAlphaArgs(12)))
ErrorsFound=.True.
END IF
IF (ElectricEIRChiller(EIRChillerNum)%CondenserType .NE. WaterCooled) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Heat Recovery requires a Water Cooled Condenser.')
ErrorsFound=.True.
END IF
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(11),cAlphaArgs(12),'Heat Recovery Nodes')
!store heat recovery volume flow for plant sizing
IF (ElectricEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate > 0.d0) THEN
Call RegisterPlantCompDesignFlow(ElectricEIRChiller(EIRChillerNum)%HeatRecInletNodeNum, & !CR 6953
ElectricEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate)
ENDIF
IF (NumNums > 17 ) THEN
IF (.NOT. lNumericFieldBlanks(18)) THEN
ElectricEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = rNumericArgs(18)
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = 1.d0
ENDIF
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = 1.d0
ENDIF
IF (NumAlphas > 13) THEN
IF ( .NOT. lAlphaFieldBlanks(14)) THEN
ElectricEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = GetScheduleIndex(cAlphaArgs(14))
IF (ElectricEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(14))//'='//TRIM(cAlphaArgs(14)))
ErrorsFound=.True.
ENDIF
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = 0
ENDIF
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = 0
ENDIF
If (NumAlphas > 14) THEN
IF ( .NOT. lAlphaFieldBlanks(15)) THEN
ElectricEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = &
GetOnlySingleNode(cAlphaArgs(15), ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Sensor, 1, ObjectIsNotParent)
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = 0
ENDIF
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = 0
ENDIF
ELSE
ElectricEIRChiller(EIRChillerNum)%HeatRecActive=.False.
ElectricEIRChiller(EIRChillerNum)%DesignHeatRecMassFlowRate = 0.0d0
ElectricEIRChiller(EIRChillerNum)%HeatRecInletNodeNum = 0
ElectricEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum = 0
IF (.not. lAlphaFieldBlanks(11) .or. .not. lAlphaFieldBlanks(12) ) THEN
! IF (cAlphaArgs(11) /= ' ' .or. cAlphaArgs(12) /= ' ') THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Since Reference Heat Reclaim Volume Flow Rate = 0.0, heat recovery is inactive.')
CALL ShowContinueError('However, node names were specified for heat recovery inlet or outlet nodes.')
END IF
END IF
! Check the CAP-FT, EIR-FT, and PLR curves and warn user if different from 1.0 by more than +-10%
IF (ElectricEIRChiller(EIRChillerNum)%ChillerCAPFT > 0) THEN
CurveVal = CurveValue(ElectricEIRChiller(EIRChillerNum)%ChillerCAPFT, &
ElectricEIRChiller(EIRChillerNum)%TempRefEvapOut,ElectricEIRChiller(EIRChillerNum)%TempRefCondIn)
IF(CurveVal .GT. 1.10d0 .OR. CurveVal .LT. 0.90d0)THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Capacity ratio as a function of temperature curve output is not equal to 1.0' // &
' (+ or - 10%) at reference conditions.')
CALL ShowContinueError('Curve output at reference conditions = '//TRIM(TrimSigDigits(CurveVal,3)))
END IF
END IF
IF (ElectricEIRChiller(EIRChillerNum)%ChillerEIRFT > 0) THEN
CurveVal = CurveValue(ElectricEIRChiller(EIRChillerNum)%ChillerEIRFT, &
ElectricEIRChiller(EIRChillerNum)%TempRefEvapOut,ElectricEIRChiller(EIRChillerNum)%TempRefCondIn)
IF(CurveVal .GT. 1.10d0 .OR. CurveVal .LT. 0.90d0)THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Energy input ratio as a function of temperature curve output is not equal to 1.0' // &
' (+ or - 10%) at reference conditions.')
CALL ShowContinueError('Curve output at reference conditions = '//TRIM(TrimSigDigits(CurveVal,3)))
END IF
END IF
IF (ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR > 0) THEN
CurveVal = CurveValue(ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR, 1.0d0)
IF(CurveVal .GT. 1.10d0 .OR. CurveVal .LT. 0.90d0)THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Energy input ratio as a function of part-load ratio curve output is not equal to 1.0' // &
' (+ or - 10%) at reference conditions.')
CALL ShowContinueError('Curve output at reference conditions = '//TRIM(TrimSigDigits(CurveVal,3)))
END IF
END IF
IF (ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR > 0) THEN
FoundNegValue = .FALSE.
DO CurveCheck = 0, 10, 1
CurveValTmp = CurveValue(ElectricEIRChiller(EIRChillerNum)%ChillerEIRFPLR, REAL(CurveCheck/10.0d0,r64))
IF(CurveValTmp .LT. 0.0d0) FoundNegValue = .TRUE.
CurveValArray(CurveCheck+1) = INT(CurveValTmp*100.0d0)/100.0d0
END DO
IF(FoundNegValue)THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Energy input ratio as a function of part-load ratio curve shows negative values.')
CALL ShowContinueError('EIR as a function of PLR curve output at various part-load ratios shown below:')
CALL ShowContinueError('PLR = 0.00 0.10 0.20 0.30 0.40 0.50 0.60 0.70 0.80 0.90 1.00')
WRITE(StringVar,530)(CurveValArray(CurveValPtr), CurveValPtr = 1, 11)
530 FORMAT('Curve Output = ',11(F7.2))
CALL ShowContinueError(TRIM(StringVar))
ErrorsFound = .TRUE.
END IF
END IF
! Basin heater power as a function of temperature must be greater than or equal to 0
ElectricEIRChiller(EIRChillerNum)%BasinHeaterPowerFTempDiff = rNumericArgs(16)
IF(rNumericArgs(16) .LT. 0.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(16))//' must be >= 0')
ErrorsFound = .TRUE.
END IF
ElectricEIRChiller(EIRChillerNum)%BasinHeaterSetPointTemp = rNumericArgs(17)
IF(ElectricEIRChiller(EIRChillerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0) THEN
IF(NumNums .LT. 17) THEN
ElectricEIRChiller(EIRChillerNum)%BasinHeaterSetPointTemp = 2.0d0
ENDIF
IF(ElectricEIRChiller(EIRChillerNum)%BasinHeaterSetPointTemp < 2.0d0) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//' "'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(17))//' is less than 2 deg C. Freezing could occur.')
END IF
END IF
IF(.NOT. lAlphaFieldBlanks(13))THEN
ElectricEIRChiller(EIRChillerNum)%BasinHeaterSchedulePtr = GetScheduleIndex(cAlphaArgs(13))
IF(ElectricEIRChiller(EIRChillerNum)%BasinHeaterSchedulePtr .EQ. 0)THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowWarningError(TRIM(cAlphaFieldNames(13))//' "'//TRIM(cAlphaArgs(13)) &
//'" was not found. Basin heater operation will not be modeled and the simulation continues')
END IF
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
END IF
DO EIRChillerNum = 1, NumElectricEIRChillers
CALL SetupOutputVariable('Chiller Part Load Ratio []', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerPartLoadRatio,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Cycling Ratio []', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerCyclingRatio,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Electric Power [W]', &
ElectricEIRChillerReport(EIRChillerNum)%Power,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Electric Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%Energy,'System','Sum',ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Cooling Rate [W]', &
ElectricEIRChillerReport(EIRChillerNum)%QEvap,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Cooling Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%EvapEnergy,'System','Sum',ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller False Load Heat Transfer Rate [W]', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerFalseLoadRate,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller False Load Heat Transfer Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerFalseLoad,'System','Sum',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Inlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%EvapInletTemp,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Outlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%EvapOutletTemp,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Mass Flow Rate [kg/s]', &
ElectricEIRChillerReport(EIRChillerNum)%Evapmdot,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Rate [W]', &
ElectricEIRChillerReport(EIRChillerNum)%QCond,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%CondEnergy,'System','Sum',ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller COP [W/W]', &
ElectricEIRChillerReport(EIRChillerNum)%ActualCOP,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Capacity Temperature Modifier Multiplier []', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerCapFT,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller EIR Temperature Modifier Multiplier []', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerEIRFT,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller EIR Part Load Modifier Multiplier []', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerEIRFPLR,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
! Condenser mass flow and outlet temp are valid for water cooled
IF (ElectricEIRChiller(EIRChillerNum)%CondenserType == WaterCooled)THEN
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%CondInletTemp,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Outlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%CondOutletTemp,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Mass Flow Rate [kg/s]', &
ElectricEIRChillerReport(EIRChillerNum)%Condmdot,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
! If heat recovery is active then setup report variables
IF (ElectricEIRChiller(EIRChillerNum)%HeatRecActive) THEN
CALL SetupOutputVariable('Chiller Total Recovered Heat Rate [W]', &
ElectricEIRChillerReport(EIRChillerNum)%QHeatRecovery,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Total Recovered Heat Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%EnergyHeatRecovery,'System','Sum', &
ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heat Recovery Inlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%HeatRecInletTemp,'System','Average', &
ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Heat Recovery Outlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%HeatRecOutletTemp,'System','Average', &
ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Heat Recovery Mass Flow Rate [kg/s]', &
ElectricEIRChillerReport(EIRChillerNum)%HeatRecMassFlow,'System','Average', &
ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Effective Heat Rejection Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%ChillerCondAvgTemp,'System','Average', &
ElectricEIRChiller(EIRChillerNum)%Name)
END IF
ELSE
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ElectricEIRChillerReport(EIRChillerNum)%CondInletTemp,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
IF(ElectricEIRChiller(EIRChillerNum)%CondenserFanPowerRatio > 0) THEN
CALL SetupOutputVariable('Chiller Condenser Fan Electric Power [W]', &
ElectricEIRChillerReport(EIRChillerNum)%CondenserFanPowerUse,'System','Average' &
,ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Fan Electric Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%CondenserFanEnergyConsumption,'System','Sum', &
ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
END IF
IF (ElectricEIRChiller(EIRChillerNum)%CondenserType == EvapCooled) THEN
IF(ElectricEIRChiller(EIRChillerNum)%BasinHeaterPowerFTempDiff .GT. 0.0d0)THEN
CALL SetupOutputVariable('Chiller Basin Heater Electric Power [W]', &
ElectricEIRChillerReport(EIRChillerNum)%BasinHeaterPower,'System','Average',ElectricEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Basin Heater Electric Energy [J]', &
ElectricEIRChillerReport(EIRChillerNum)%BasinHeaterConsumption,'System','Sum', &
ElectricEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='Electric',EndUseKey='CHILLERS',GroupKey='Plant')
END IF
ENDIF
END IF
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Chiller Nominal Capacity', ElectricEIRChiller(EIRChillerNum)%Name, '[W]', &
ElectricEIRChiller(EIRChillerNum)%RefCap )
ENDIF
END DO
RETURN
END SUBROUTINE GetElectricEIRChillerInput