Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE GetElecReformEIRChillerInput
! SUBROUTINE INFORMATION:
! AUTHOR: Lixing Gu, FSEC
! DATE WRITTEN: July 2006
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input required by the Reformulated Electric EIR Chiller model
! METHODOLOGY EMPLOYED:
!
! REFERENCES: na
! USE STATEMENTS:
USE DataInterfaces, ONLY: ShowSevereError, ShowWarningError, ShowFatalError, SetupOutputVariable, ShowContinueError
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName
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 General, ONLY: TrimSigDigits, RoundSigDigits
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE DataSizing, ONLY: Autosize
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
USE ScheduleManager, ONLY: GetScheduleIndex
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! PARAMETERS
CHARACTER(len=*), PARAMETER :: RoutineName='GetElecReformEIRChillerInput: ' ! 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 found
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag ! Error flag, used to tell if a unique chiller name has been specified
LOGICAL, SAVE :: AllocatedFlag =.FALSE. ! True when arrays are allocated
! FLOW
If (AllocatedFlag) RETURN
cCurrentModuleObject = 'Chiller:Electric:ReformulatedEIR'
NumElecReformEIRChillers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumElecReformEIRChillers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
END IF
! ALLOCATE ARRAYS
ALLOCATE (ElecReformEIRChiller(NumElecReformEIRChillers))
ALLOCATE (ElecReformEIRChillerReport(NumElecReformEIRChillers))
AllocatedFlag = .TRUE.
! Load arrays with reformulated electric EIR chiller data
DO EIRChillerNum = 1 , NumElecReformEIRChillers
CALL GetObjectItem(cCurrentModuleObject,EIRChillerNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames, &
NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ElecReformEIRChiller%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
ElecReformEIRChiller(EIRChillerNum)%Name = cAlphaArgs(1)
! Performance curves
ElecReformEIRChiller(EIRChillerNum)%ChillerCapFT = GetCurveIndex(cAlphaArgs(2))
ElecReformEIRChiller(EIRChillerNum)%CAPFTName = cAlphaArgs(2)
IF (ElecReformEIRChiller(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
ElecReformEIRChiller(EIRChillerNum)%ChillerEIRFT = GetCurveIndex(cAlphaArgs(3))
ElecReformEIRChiller(EIRChillerNum)%EIRFTName = cAlphaArgs(3)
IF (ElecReformEIRChiller(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
ElecReformEIRChiller(EIRChillerNum)%EIRFPLRName = cAlphaArgs(4)
ElecReformEIRChiller(EIRChillerNum)%ChillerEIRFPLR = GetCurveIndex(cAlphaArgs(4))
IF (ElecReformEIRChiller(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
! Chilled water inlet/outlet node names are necessary
IF (lAlphaFieldBlanks(5) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(5))//' is blank.')
ErrorsFound=.true.
END IF
IF (lAlphaFieldBlanks(6) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(6))//' is blank.')
ErrorsFound=.true.
END IF
ElecReformEIRChiller(EIRChillerNum)%EvapInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 1, ObjectIsNotParent)
ElecReformEIRChiller(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')
ElecReformEIRChiller(EIRChillerNum)%CondenserType = WaterCooled
! Condenser inlet/outlet node names are necessary
IF (lAlphaFieldBlanks(7) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(7))//' is blank.')
ErrorsFound=.true.
END IF
IF (lAlphaFieldBlanks(8) ) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(8))//' is blank.')
ErrorsFound=.true.
END IF
ElecReformEIRChiller(EIRChillerNum)%CondInletNodeNum = GetOnlySingleNode(cAlphaArgs(7),ErrorsFound, &
TRIM(cCurrentModuleObject),cAlphaArgs(1), NodeType_Water,NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ElecReformEIRChiller(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')
SELECT CASE (TRIM(cAlphaArgs(9)))
CASE ( 'CONSTANTFLOW' )
ElecReformEIRChiller(EIRChillerNum)%FlowMode = ConstantFlow
CASE ( 'VARIABLEFLOW' )
ElecReformEIRChiller(EIRChillerNum)%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
ElecReformEIRChiller(EIRChillerNum)%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
ElecReformEIRChiller(EIRChillerNum)%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
ElecReformEIRChiller(EIRChillerNum)%FlowMode = NotModulated
END SELECT
! Chiller rated performance data
ElecReformEIRChiller(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
ElecReformEIRChiller(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
ElecReformEIRChiller(EIRChillerNum)%TempRefEvapOut = rNumericArgs(3)
ElecReformEIRChiller(EIRChillerNum)%TempRefCondOut = rNumericArgs(4)
ElecReformEIRChiller(EIRChillerNum)%EvapVolFlowRate = rNumericArgs(5)
ElecReformEIRChiller(EIRChillerNum)%CondVolFlowRate = rNumericArgs(6)
ElecReformEIRChiller(EIRChillerNum)%MinPartLoadRat = rNumericArgs(7)
ElecReformEIRChiller(EIRChillerNum)%MaxPartLoadRat = rNumericArgs(8)
ElecReformEIRChiller(EIRChillerNum)%OptPartLoadRat = rNumericArgs(9)
ElecReformEIRChiller(EIRChillerNum)%MinUnLoadRat = rNumericArgs(10)
ElecReformEIRChiller(EIRChillerNum)%SizFac = rNumericArgs(14)
IF (ElecReformEIRChiller(EIRChillerNum)%SizFac <= 0.0d0) ElecReformEIRChiller(EIRChillerNum)%SizFac = 1.0d0
IF(ElecReformEIRChiller(EIRChillerNum)%MinPartLoadRat .GT. ElecReformEIRChiller(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(ElecReformEIRChiller(EIRChillerNum)%MinUnLoadRat .LT. ElecReformEIRChiller(EIRChillerNum)%MinPartLoadRat .OR. &
ElecReformEIRChiller(EIRChillerNum)%MinUnLoadRat .GT. ElecReformEIRChiller(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(ElecReformEIRChiller(EIRChillerNum)%OptPartLoadRat .LT. ElecReformEIRChiller(EIRChillerNum)%MinPartLoadRat .OR. &
ElecReformEIRChiller(EIRChillerNum)%OptPartLoadRat .GT. ElecReformEIRChiller(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
ElecReformEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac = rNumericArgs(11)
IF(ElecReformEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac .LT. 0.0d0 .OR. &
ElecReformEIRChiller(EIRChillerNum)%CompPowerToCondenserFrac .GT. 1.0d0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' = '//TRIM(RoundSigDigits(rNumericArgs(11),3)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' must be greater than or equal to zero' )
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' must be less than or equal to one' )
ErrorsFound=.true.
END IF
ElecReformEIRChiller(EIRChillerNum)%TempLowLimitEvapOut = rNumericArgs(12)
! These are the optional heat recovery inputs
ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate = rNumericArgs(13)
IF ((ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate > 0.0d0) &
.OR. (ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate == Autosize)) THEN
ElecReformEIRChiller(EIRChillerNum)%HeatRecActive=.True.
ElecReformEIRChiller(EIRChillerNum)%HeatRecInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(10),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet, 3, ObjectIsNotParent)
IF (ElecReformEIRChiller(EIRChillerNum)%HeatRecInletNodeNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(cAlphaArgs(10)))
ErrorsFound=.True.
END IF
ElecReformEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(11),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet, 3, ObjectIsNotParent)
IF (ElecReformEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(11))//'='//TRIM(cAlphaArgs(11)))
ErrorsFound=.True.
END IF
IF (ElecReformEIRChiller(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(10),cAlphaArgs(11),'Heat Recovery Nodes')
If (ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate > 0.d0) THEN
Call RegisterPlantCompDesignFlow(ElecReformEIRChiller(EIRChillerNum)%HeatRecInletNodeNum, &
ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecVolFlowRate )
ENDIF
IF (NumNums > 14) THEN
IF (.NOT. lNumericFieldBlanks(15)) THEN
ElecReformEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = rNumericArgs(15)
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = 1.d0
ENDIf
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecCapacityFraction = 1.d0
ENDIF
If (NumAlphas > 11) THEN
IF (.NOT. lAlphaFieldBlanks(12)) THEN
ElecReformEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = GetScheduleIndex(cAlphaArgs(12))
IF (ElecReformEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum == 0) THEN
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(12))//'='//TRIM(cAlphaArgs(12)))
ErrorsFound=.True.
ENDIF
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = 0
ENDIF
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecInletLimitSchedNum = 0
ENDIF
IF (NumAlphas > 12) THEN
IF ( .NOT. lAlphaFieldBlanks(13)) THEN
ElecReformEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = &
GetOnlySingleNode(cAlphaArgs(13), ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Sensor, 1, ObjectIsNotParent)
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = 0
ENDIF
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecSetpointNodeNum = 0
ENDIF
ELSE
ElecReformEIRChiller(EIRChillerNum)%HeatRecActive=.False.
ElecReformEIRChiller(EIRChillerNum)%DesignHeatRecMassFlowRate = 0.0d0
ElecReformEIRChiller(EIRChillerNum)%HeatRecInletNodeNum = 0
ElecReformEIRChiller(EIRChillerNum)%HeatRecOutletNodeNum = 0
IF ((.NOT. lAlphaFieldBlanks(10)) .OR. (.NOT. lAlphaFieldBlanks(11)) ) THEN
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'"')
CALL ShowWarningError('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
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
END IF
DO EIRChillerNum = 1, NumElecReformEIRChillers
CALL SetupOutputVariable('Chiller Part Load Ratio []', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerPartLoadRatio,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Cycling Ratio []', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerCyclingRatio,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Electric Power [W]', &
ElecReformEIRChillerReport(EIRChillerNum)%Power,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Electric Energy [J]', &
ElecReformEIRChillerReport(EIRChillerNum)%Energy,'System','Sum',ElecReformEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Cooling Rate [W]', &
ElecReformEIRChillerReport(EIRChillerNum)%QEvap,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Cooling Energy [J]', &
ElecReformEIRChillerReport(EIRChillerNum)%EvapEnergy,'System','Sum',ElecReformEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller False Load Heat Transfer Rate [W]', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerFalseLoadRate,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller False Load Heat Transfer Energy [J]', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerFalseLoad,'System','Sum',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Inlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%EvapInletTemp,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Outlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%EvapOutletTemp,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Mass Flow Rate [kg/s]', &
ElecReformEIRChillerReport(EIRChillerNum)%Evapmdot,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Rate [W]', &
ElecReformEIRChillerReport(EIRChillerNum)%QCond,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Energy [J]', &
ElecReformEIRChillerReport(EIRChillerNum)%CondEnergy,'System','Sum',ElecReformEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller COP [W/W]', &
ElecReformEIRChillerReport(EIRChillerNum)%ActualCOP,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Capacity Temperature Modifier Multiplier []', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerCapFT,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller EIR Temperature Modifier Multiplier []', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerEIRFT,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller EIR Part Load Modifier Multiplier []', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerEIRFPLR,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%CondInletTemp,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Outlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%CondOutletTemp,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Mass Flow Rate [kg/s]', &
ElecReformEIRChillerReport(EIRChillerNum)%Condmdot,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
! If heat recovery is active then setup report variables
IF (ElecReformEIRChiller(EIRChillerNum)%HeatRecActive) THEN
CALL SetupOutputVariable('Chiller Total Recovered Heat Rate [W]', &
ElecReformEIRChillerReport(EIRChillerNum)%QHeatRecovery,'System','Average',ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Total Recovered Heat Energy [J]', &
ElecReformEIRChillerReport(EIRChillerNum)%EnergyHeatRecovery,'System','Sum', &
ElecReformEIRChiller(EIRChillerNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heat Recovery Inlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%HeatRecInletTemp,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Heat Recovery Outlet Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%HeatRecOutletTemp,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Heat Recovery Mass Flow Rate [kg/s]', &
ElecReformEIRChillerReport(EIRChillerNum)%HeatRecMassFlow,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
CALL SetupOutputVariable('Chiller Effective Heat Rejection Temperature [C]', &
ElecReformEIRChillerReport(EIRChillerNum)%ChillerCondAvgTemp,'System','Average', &
ElecReformEIRChiller(EIRChillerNum)%Name)
END IF
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Chiller Nominal Capacity', ElecReformEIRChiller(EIRChillerNum)%Name, '[W]', &
ElecReformEIRChiller(EIRChillerNum)%RefCap )
ENDIF
END DO
RETURN
END SUBROUTINE GetElecReformEIRChillerInput