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 GetIndirectAbsorberInput
! SUBROUTINE INFORMATION:
! AUTHOR: R. Raustad (FSEC)
! DATE WRITTEN: May 2008
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the Indirect Absorption chiller models as shown below:
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString, GetObjectDefMaxArgs
USE DataIPShortCuts
USE BranchNodeConnections, ONLY: TestCompSet
USE NodeInputManager, ONLY: GetOnlySingleNode
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE OutputReportPredefined
USE FluidProperties, ONLY: FindRefrigerant
USE CurveManager, ONLY: GetCurveIndex, GetCurveType, CurveValue
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE DataGlobals, ONLY: AnyEnergyManagementSystemInModel
IMPLICIT NONE !
! SUBROUTINE PARAMETER DEFINITIONS:
CHARACTER(len=*), PARAMETER :: Blank = ' '
CHARACTER(len=*), PARAMETER :: RoutineName='GetIndirectAbsorberInput: ' ! include trailing blank space
!LOCAL VARIABLES
INTEGER :: AbsorberNum ! Absorber 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.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
LOGICAL :: errflag ! GetInput error flag
LOGICAL, ALLOCATABLE, DIMENSION(:) :: GenInputOutputNodesUsed ! Used for SetupOutputVariable
!FLOW
cCurrentModuleObject = 'Chiller:Absorption:Indirect'
NumIndirectAbsorbers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumIndirectAbsorbers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
!See if load distribution manager has already gotten the input
ErrorsFound=.true.
ENDIF
IF (ALLOCATED(IndirectAbsorber))RETURN
!ALLOCATE ARRAYS
ALLOCATE (IndirectAbsorber(NumIndirectAbsorbers))
ALLOCATE (IndirectAbsorberReport(NumIndirectAbsorbers))
ALLOCATE(GenInputOutputNodesUsed(NumIndirectAbsorbers))
GenInputOutputNodesUsed=.FALSE.
!LOAD ARRAYS WITH BLAST CURVE FIT Absorber DATA
DO AbsorberNum = 1 , NumIndirectAbsorbers
CALL GetObjectItem(cCurrentModuleObject,AbsorberNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldNames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),IndirectAbsorber%Name,AbsorberNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) cAlphaArgs(1)='xxxxx'
ENDIF
CALL VerifyUniqueChillerName(TRIM(cCurrentModuleObject),cAlphaArgs(1),errflag,TRIM(cCurrentModuleObject)//' Name')
IF (errflag) THEN
ErrorsFound=.true.
ENDIF
IndirectAbsorber(AbsorberNum)%Name = cAlphaArgs(1)
IndirectAbsorber(AbsorberNum)%NomCap = rNumericArgs(1)
IndirectAbsorber(AbsorberNum)%NomPumpPower = rNumericArgs(2)
IF (rNumericArgs(1) == 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(rNumericArgs(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound=.true.
ENDIF
! Assign Node Numbers to specified nodes
IndirectAbsorber(AbsorberNum)%EvapInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(2),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent)
IndirectAbsorber(AbsorberNum)%EvapOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(3),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(2),cAlphaArgs(3),'Chilled Water Nodes')
IndirectAbsorber(AbsorberNum)%CondInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(4),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,2,ObjectIsNotParent)
IndirectAbsorber(AbsorberNum)%CondOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(5),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,2,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(4),cAlphaArgs(5),'Condenser (not tested) Nodes')
IndirectAbsorber(AbsorberNum)%GeneratorInputCurvePtr = GetCurveIndex(cAlphaArgs(7))
IF (IndirectAbsorber(AbsorberNum)%GeneratorInputCurvePtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%GeneratorInputCurvePtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Generator Heat Input function of part-load ratio curve type for this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%GeneratorInputCurvePtr)))
ErrorsFound=.true.
END SELECT
END IF
IndirectAbsorber(AbsorberNum)%PumpPowerCurvePtr = GetCurveIndex(cAlphaArgs(8))
IF (IndirectAbsorber(AbsorberNum)%PumpPowerCurvePtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%PumpPowerCurvePtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Pump Electric Input function of part-load ratio curve type for this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%PumpPowerCurvePtr)))
ErrorsFound=.true.
END SELECT
END IF
IF(NumAlphas .GT. 15)THEN
IF(SameString(cAlphaArgs(16),'HotWater') .OR. SameString(cAlphaArgs(16),'HotWater'))THEN
IndirectAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Water
! Default to Steam if left blank
ELSE IF(SameString(cAlphaArgs(16),'Steam') .OR. SameString(cAlphaArgs(16),Blank))THEN
IndirectAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
ELSE
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator heat source type must be Steam or Hot Water.')
CALL ShowContinueError('...Entered generator heat source type = '//TRIM(cAlphaArgs(16)))
ErrorsFound=.true.
END IF
ELSE
! Default to Steam if not entered as input
IndirectAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
END IF
IF(.NOT. SameString(cAlphaArgs(9),Blank) .AND. .NOT. SameString(cAlphaArgs(10),Blank))THEN
GenInputOutputNodesUsed(AbsorberNum) = .TRUE.
IF(IndirectAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
IndirectAbsorber(AbsorberNum)%GeneratorInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(9),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Inlet,3,ObjectIsNotParent)
IndirectAbsorber(AbsorberNum)%GeneratorOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(10),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Water,NodeConnectionType_Outlet,3,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(9),cAlphaArgs(10),'Hot Water Nodes')
ELSE
IndirectAbsorber(AbsorberNum)%SteamFluidIndex=FindRefrigerant('Steam')
IndirectAbsorber(AbsorberNum)%GeneratorInletNodeNum = &
GetOnlySingleNode(cAlphaArgs(9),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Inlet,3,ObjectIsNotParent)
IndirectAbsorber(AbsorberNum)%GeneratorOutletNodeNum = &
GetOnlySingleNode(cAlphaArgs(10),ErrorsFound,TRIM(cCurrentModuleObject),cAlphaArgs(1), &
NodeType_Steam,NodeConnectionType_Outlet,3,ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(9),cAlphaArgs(10),'Steam Nodes')
END IF
ELSE IF((SameString(cAlphaArgs(9),Blank) .AND. .NOT. SameString(cAlphaArgs(10),Blank)) .OR. &
(.NOT. SameString(cAlphaArgs(9),Blank) .AND. SameString(cAlphaArgs(10),Blank)))THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator fluid nodes must both be entered (or both left blank).')
CALL ShowContinueError('...Generator fluid inlet node = '//TRIM(cAlphaArgs(9)))
CALL ShowContinueError('...Generator fluid outlet node = '//TRIM(cAlphaArgs(10)))
ErrorsFound=.true.
ELSE
! Generator fluid type must be steam if generator inlet/outlet nodes are not used
IF(IndirectAbsorber(AbsorberNum)%GenHeatSourceType .EQ. NodeType_Water)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator fluid type must be Steam if generator inlet/outlet nodes are blank.')
CALL ShowContinueError('...Generator fluid type is set to Steam and the simulation continues.')
IndirectAbsorber(AbsorberNum)%GenHeatSourceType = NodeType_Steam
END IF
END IF
SELECT CASE (TRIM(cAlphaArgs(6)))
CASE ( 'CONSTANTFLOW' )
IndirectAbsorber(AbsorberNum)%FlowMode = ConstantFlow
CASE ( 'VARIABLEFLOW' )
IndirectAbsorber(AbsorberNum)%FlowMode = LeavingSetpointModulated
CALL ShowWarningError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Key choice is now called "LeavingSetpointModulated" and the simulation continues')
CASE ('LEAVINGSETPOINTMODULATED')
IndirectAbsorber(AbsorberNum)%FlowMode = LeavingSetpointModulated
CASE ('NOTMODULATED')
IndirectAbsorber(AbsorberNum)%FlowMode = NotModulated
CASE DEFAULT
CALL ShowSevereError(RoutineName//TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'",')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(cAlphaArgs(6)))
CALL ShowContinueError('Available choices are ConstantFlow, NotModulated, or LeavingSetpointModulated')
CALL ShowContinueError('Flow mode NotModulated is assumed and the simulation continues.')
IndirectAbsorber(AbsorberNum)%FlowMode = NotModulated
END SELECT
IndirectAbsorber(AbsorberNum)%CapFCondenserTempPtr = GetCurveIndex(cAlphaArgs(11))
IF (IndirectAbsorber(AbsorberNum)%CapFCondenserTempPtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFCondenserTempPtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Capacity Correction function of condenser temperature curve type for this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFCondenserTempPtr)))
ErrorsFound=.true.
END SELECT
END IF
IndirectAbsorber(AbsorberNum)%CapFEvaporatorTempPtr = GetCurveIndex(cAlphaArgs(12))
IF (IndirectAbsorber(AbsorberNum)%CapFEvaporatorTempPtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFEvaporatorTempPtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Capacity Correction function of evaporator temperature curve type for this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFCondenserTempPtr)))
ErrorsFound=.true.
END SELECT
END IF
IndirectAbsorber(AbsorberNum)%CapFGeneratorTempPtr = GetCurveIndex(cAlphaArgs(13))
IF (IndirectAbsorber(AbsorberNum)%CapFGeneratorTempPtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFGeneratorTempPtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
IF(IndirectAbsorber(AbsorberNum)%GenHeatSourceType .EQ. NodeType_Water)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Capacity Correction function of generator temperature curve type for this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%CapFGeneratorTempPtr)))
ErrorsFound=.true.
END IF
END SELECT
END IF
IndirectAbsorber(AbsorberNum)%HeatInputFCondTempPtr = GetCurveIndex(cAlphaArgs(14))
IF (IndirectAbsorber(AbsorberNum)%HeatInputFCondTempPtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%HeatInputFCondTempPtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Generator Heat Input Correction function of condenser temperature curve type for '// &
'this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%HeatInputFCondTempPtr)))
ErrorsFound=.true.
END SELECT
END IF
IndirectAbsorber(AbsorberNum)%HeatInputFEvapTempPtr = GetCurveIndex(cAlphaArgs(15))
IF (IndirectAbsorber(AbsorberNum)%HeatInputFEvapTempPtr .GT. 0) THEN
! Verify Curve Object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(IndirectAbsorber(AbsorberNum)%HeatInputFEvapTempPtr))
CASE('QUADRATIC', 'CUBIC')
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(IndirectAbsorber(AbsorberNum)%Name)//'"')
CALL ShowContinueError('...illegal Generator Heat Input Correction function of evaporator temperature curve type for '// &
'this object.')
CALL ShowContinueError('...Curve type = '//TRIM(GetCurveType(IndirectAbsorber(AbsorberNum)%HeatInputFEvapTempPtr)))
ErrorsFound=.true.
END SELECT
END IF
! Get remaining data
IndirectAbsorber(AbsorberNum)%MinPartLoadRat = rNumericArgs(3)
IndirectAbsorber(AbsorberNum)%MaxPartLoadRat = rNumericArgs(4)
IndirectAbsorber(AbsorberNum)%OptPartLoadRat = rNumericArgs(5)
IndirectAbsorber(AbsorberNum)%TempDesCondIn = rNumericArgs(6)
IndirectAbsorber(AbsorberNum)%MinCondInletTemp = rNumericArgs(7)
IndirectAbsorber(AbsorberNum)%TempLowLimitEvapOut = rNumericArgs(8)
IndirectAbsorber(AbsorberNum)%EvapVolFlowRate = rNumericArgs(9)
IndirectAbsorber(AbsorberNum)%CondVolFlowRate = rNumericArgs(10)
IF(NumNums .GT. 10)THEN
IndirectAbsorber(AbsorberNum)%GeneratorVolFlowRate = rNumericArgs(11)
END IF
IF(IndirectAbsorber(AbsorberNum)%GeneratorVolFlowRate == 0.0d0 .AND. &
IndirectAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Name='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('...Generator water flow rate must be greater than 0'// &
' when absorber generator fluid type is hot water.')
ErrorsFound=.true.
END IF
IF(NumNums .GT. 11)THEN
IndirectAbsorber(AbsorberNum)%MinGeneratorInletTemp = rNumericArgs(12)
ELSE
IndirectAbsorber(AbsorberNum)%MinGeneratorInletTemp = 0.0d0
END IF
IF(NumNums .GT. 12)THEN
IndirectAbsorber(AbsorberNum)%GeneratorSubCool = rNumericArgs(13)
ELSE
IndirectAbsorber(AbsorberNum)%GeneratorSubCool = 0.0d0
END IF
IF(NumNums .GT. 13)THEN
IndirectAbsorber(AbsorberNum)%LoopSubCool = rNumericArgs(14)
ELSE
IndirectAbsorber(AbsorberNum)%LoopSubCool = 0.0d0
END IF
IF(NumNums .GT. 14)THEN
IndirectAbsorber(AbsorberNum)%SizFac = rNumericArgs(15)
ELSE
IndirectAbsorber(AbsorberNum)%SizFac = 1.0d0
END IF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting Chiller:Absorption:Indirect')
ENDIF
DO AbsorberNum = 1, NumIndirectAbsorbers
CALL SetupOutputVariable('Chiller Electric Power [W]', &
IndirectAbsorberReport(AbsorberNum)%PumpingPower,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Electric Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%PumpingEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ELECTRICITY',EndUseKey='Cooling',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Cooling Rate [W]', &
IndirectAbsorberReport(AbsorberNum)%QEvap,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Cooling Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%EvapEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Evaporator Inlet Temperature [C]', &
IndirectAbsorberReport(AbsorberNum)%EvapInletTemp,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Outlet Temperature [C]', &
IndirectAbsorberReport(AbsorberNum)%EvapOutletTemp,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Evaporator Mass Flow Rate [kg/s]', &
IndirectAbsorberReport(AbsorberNum)%Evapmdot,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Rate [W]', &
IndirectAbsorberReport(AbsorberNum)%QCond,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Heat Transfer Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%CondEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Condenser Inlet Temperature [C]', &
IndirectAbsorberReport(AbsorberNum)%CondInletTemp,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Outlet Temperature [C]', &
IndirectAbsorberReport(AbsorberNum)%CondOutletTemp,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Condenser Mass Flow Rate [kg/s]', &
IndirectAbsorberReport(AbsorberNum)%Condmdot,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
IF(IndirectAbsorber(AbsorberNum)%GenHeatSourceType == NodeType_Water)THEN
CALL SetupOutputVariable('Chiller Hot Water Consumption Rate [W]', &
IndirectAbsorberReport(AbsorberNum)%QGenerator,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Hot Water Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='EnergyTransfer',EndUseKey='Cooling',GroupKey='Plant')
ELSE
IF(GenInputOutputNodesUsed(AbsorberNum))THEN
CALL SetupOutputVariable('Chiller Source Steam Rate [W]', &
IndirectAbsorberReport(AbsorberNum)%QGenerator,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Steam Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='PLANTLOOPHEATINGDEMAND',EndUseKey='CHILLERS',GroupKey='Plant')
ELSE
CALL SetupOutputVariable('Chiller Source Steam Rate [W]', &
IndirectAbsorberReport(AbsorberNum)%QGenerator,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Source Steam Energy [J]', &
IndirectAbsorberReport(AbsorberNum)%GeneratorEnergy,'System','Sum',IndirectAbsorber(AbsorberNum)%Name, &
ResourceTypeKey='Steam',EndUseKey='Cooling',GroupKey='Plant')
END IF
END IF
CALL SetupOutputVariable('Chiller COP [W/W]', &
IndirectAbsorberReport(AbsorberNum)%ActualCOP,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Part Load Ratio []', &
IndirectAbsorberReport(AbsorberNum)%ChillerPartLoadRatio,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Cycling Ratio []', &
IndirectAbsorberReport(AbsorberNum)%ChillerCyclingFrac,'System','Average',IndirectAbsorber(AbsorberNum)%Name)
CALL SetupOutputVariable('Chiller Steam Heat Loss Rate [W]', IndirectAbsorberReport(AbsorberNum)%LoopLoss, &
'System','Average',IndirectAbsorber(AbsorberNum)%Name)
IF (AnyEnergyManagementSystemInModel) THEN
CALL SetupEMSInternalVariable('Chiller Nominal Capacity', IndirectAbsorber(AbsorberNum)%Name, '[W]', &
IndirectAbsorber(AbsorberNum)%NomCap )
ENDIF
END DO
IF(ALLOCATED(GenInputOutputNodesUsed)) DEALLOCATE(GenInputOutputNodesUsed)
RETURN
END SUBROUTINE GetIndirectAbsorberInput