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 GetExhaustAbsorberInput
! SUBROUTINE INFORMATION:
! AUTHOR: Jason Glazer
! DATE WRITTEN: March 2001
! MODIFIED Mahabir Bhandari, ORNL, Aug 2011, modified to accomodate Exhaust Fired Double Effect Absorption Chiller
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the Exhaust Fired Absorption chiller model in the object ChillerHeater:Absorption:DoubleEffect
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor
! 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: GetCurveCheck
USE GlobalNames, ONLY: VerifyUniqueChillerName
USE OutAirNodeManager, ONLY: CheckAndAddAirNodeNumber
USE MicroturbineElectricGenerator, ONLY: GetMTGeneratorExhaustNode
IMPLICIT NONE !
! PARAMETERS
!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
INTEGER :: MTExhaustNodeNum ! Exhaust node number passed from MicroTurbine
LOGICAL, SAVE :: ErrorsFound=.false.
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
CHARACTER(len=MaxNameLength) :: ChillerName
LOGICAL :: errflag
LOGICAL :: Okay
!FLOW
cCurrentModuleObject = 'ChillerHeater:Absorption:DoubleEffect'
NumExhaustAbsorbers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumExhaustAbsorbers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment found in input file')
ErrorsFound=.true.
ENDIF
IF (ALLOCATED(ExhaustAbsorber)) RETURN
!ALLOCATE ARRAYS
ALLOCATE (ExhaustAbsorber(NumExhaustAbsorbers))
ALLOCATE (ExhaustAbsorberReport(NumExhaustAbsorbers))
ALLOCATE(CheckEquipName(NumExhaustAbsorbers))
CheckEquipName=.true.
!LOAD ARRAYS
DO AbsorberNum = 1 , NumExhaustAbsorbers
CALL GetObjectItem(cCurrentModuleObject,AbsorberNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),ExhaustAbsorber%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
ExhaustAbsorber(AbsorberNum)%Name = cAlphaArgs(1)
ChillerName = TRIM(cCurrentModuleObject)//' Named ' // TRIM(ExhaustAbsorber(AbsorberNum)%Name)
! Assign capacities
ExhaustAbsorber(AbsorberNum)%NomCoolingCap = rNumericArgs(1)
ExhaustAbsorber(AbsorberNum)%NomHeatCoolRatio = rNumericArgs(2)
! Assign efficiencies
ExhaustAbsorber(AbsorberNum)%ThermalEnergyCoolRatio = rNumericArgs(3)
ExhaustAbsorber(AbsorberNum)%ThermalEnergyHeatRatio = rNumericArgs(4)
ExhaustAbsorber(AbsorberNum)%ElecCoolRatio = rNumericArgs(5)
ExhaustAbsorber(AbsorberNum)%ElecHeatRatio = rNumericArgs(6)
! Assign Node Numbers to specified nodes
ExhaustAbsorber(AbsorberNum)%ChillReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(2), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 1, ObjectIsNotParent)
ExhaustAbsorber(AbsorberNum)%ChillSupplyNodeNum = &
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')
! Condenser node processing depends on condenser type, see below
ExhaustAbsorber(AbsorberNum)%HeatReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(6), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 3, ObjectIsNotParent)
ExhaustAbsorber(AbsorberNum)%HeatSupplyNodeNum = &
GetOnlySingleNode(cAlphaArgs(7), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Outlet, 3, ObjectIsNotParent)
CALL TestCompSet(TRIM(cCurrentModuleObject),cAlphaArgs(1),cAlphaArgs(6),cAlphaArgs(7),'Hot Water Nodes')
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing node input for '// &
TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .FALSE.
END IF
! Assign Part Load Ratios
ExhaustAbsorber(AbsorberNum)%MinPartLoadRat = rNumericArgs(7)
ExhaustAbsorber(AbsorberNum)%MaxPartLoadRat = rNumericArgs(8)
ExhaustAbsorber(AbsorberNum)%OptPartLoadRat = rNumericArgs(9)
! Assign Design Conditions
ExhaustAbsorber(AbsorberNum)%TempDesCondReturn = rNumericArgs(10)
ExhaustAbsorber(AbsorberNum)%TempDesCHWSupply = rNumericArgs(11)
ExhaustAbsorber(AbsorberNum)%EvapVolFlowRate = rNumericArgs(12)
IF (SameString(cAlphaArgs(16),'AirCooled') ) THEN
ExhaustAbsorber(AbsorberNum)%CondVolFlowRate = 0.0011d0 ! Condenser flow rate not used for this cond type
ELSE
ExhaustAbsorber(AbsorberNum)%CondVolFlowRate = rNumericArgs(13)
ENDIF
ExhaustAbsorber(AbsorberNum)%HeatVolFlowRate = rNumericArgs(14)
! Assign Curve Numbers
ExhaustAbsorber(AbsorberNum)%CoolCapFTCurve = GetCurveCheck(cAlphaArgs(8), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%ThermalEnergyCoolFTCurve = GetCurveCheck(cAlphaArgs(9), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%ThermalEnergyCoolFPLRCurve = GetCurveCheck(cAlphaArgs(10), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%ElecCoolFTCurve = GetCurveCheck(cAlphaArgs(11), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%ElecCoolFPLRCurve = GetCurveCheck(cAlphaArgs(12), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%HeatCapFCoolCurve = GetCurveCheck(cAlphaArgs(13), ErrorsFound, ChillerName)
ExhaustAbsorber(AbsorberNum)%ThermalEnergyHeatFHPLRCurve = GetCurveCheck(cAlphaArgs(14), ErrorsFound, ChillerName)
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing curve input for '// &
TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
ErrorsFound = .FALSE.
END IF
IF (SameString(cAlphaArgs(15),'LeavingCondenser')) THEN
ExhaustAbsorber(AbsorberNum)%isEnterCondensTemp = .FALSE.
ELSEIF (SameString(cAlphaArgs(15),'EnteringCondenser')) THEN
ExhaustAbsorber(AbsorberNum)%isEnterCondensTemp = .TRUE.
ELSE
ExhaustAbsorber(AbsorberNum)%isEnterCondensTemp = .TRUE.
CALL ShowWarningError('Invalid '//TRIM(cAlphaFieldNames(15))//'='//TRIM(cAlphaArgs(15)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('resetting to ENTERING-CONDENSER, simulation continues')
ENDIF
! Assign Other Paramters
IF (SameString(cAlphaArgs(16),'AirCooled') ) THEN
ExhaustAbsorber(AbsorberNum)%isWaterCooled = .FALSE.
ELSEIF (SameString(cAlphaArgs(16),'WaterCooled')) THEN
ExhaustAbsorber(AbsorberNum)%isWaterCooled = .TRUE.
ELSE
ExhaustAbsorber(AbsorberNum)%isWaterCooled = .TRUE.
CALL ShowWarningError('Invalid '//TRIM(cAlphaFieldNames(16))//'='//TRIM(cAlphaArgs(16)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(cAlphaArgs(1)))
CALL ShowContinueError('resetting to WATER-COOLED, simulation continues')
ENDIF
IF (ExhaustAbsorber(AbsorberNum)%isWaterCooled) THEN
ExhaustAbsorber(AbsorberNum)%CondReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(4), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 2, ObjectIsNotParent)
ExhaustAbsorber(AbsorberNum)%CondSupplyNodeNum = &
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 Water Nodes')
ELSE
ExhaustAbsorber(AbsorberNum)%CondReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(4), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Air, &
NodeConnectionType_OutsideAirReference, 2, ObjectIsNotParent)
ExhaustAbsorber(AbsorberNum)%CondSupplyNodeNum = &
GetOnlySingleNode(cAlphaArgs(5), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Air, &
NodeConnectionType_Outlet, 2, ObjectIsNotParent)
! Connection not required for air or evap cooled condenser so no call to TestCompSet here
CALL CheckAndAddAirNodeNumber(ExhaustAbsorber(AbsorberNum)%CondReturnNodeNum,Okay)
IF (.not. Okay) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Adding OutdoorAir:Node='//TRIM(cAlphaArgs(4)))
ENDIF
ENDIF
ExhaustAbsorber(AbsorberNum)%CHWLowLimitTemp = rNumericArgs(15)
ExhaustAbsorber(AbsorberNum)%SizFac = rNumericArgs(16)
ExhaustAbsorber(AbsorberNum)%TypeOf = cAlphaArgs(17)
IF (SameString(cAlphaArgs(17) , 'Generator:MicroTurbine') ) THEN
ExhaustAbsorber(AbsorberNum)%CompType_Num = iGeneratorMicroturbine
ExhaustAbsorber(AbsorberNum)%ExhuastSourceName = cAlphaArgs(18)
CALL GetMTGeneratorExhaustNode(ExhaustAbsorber(AbsorberNum)%CompType_Num, &
ExhaustAbsorber(AbsorberNum)%ExhuastSourceName, MTExhaustNodeNum)
ExhaustAbsorber(AbsorberNum)%ExhaustAirInletNodeNum = MTExhaustNodeNum
ENDIF
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
DO AbsorberNum = 1, NumExhaustAbsorbers
ChillerName = ExhaustAbsorber(AbsorberNum)%Name
CALL SetupOutputVariable('Chiller Heater Evaporator Cooling Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%CoolingLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Cooling Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%CoolingEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater Heating Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%HeatingLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%HeatingEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='BOILERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater Condenser Heat Transfer Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%TowerLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Heat Transfer Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%TowerEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater Cooling Source Heat COP [W/W]', &
ExhaustAbsorberReport(AbsorberNum)%ThermalEnergyCOP ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Electric Power [W]', &
ExhaustAbsorberReport(AbsorberNum)%ElectricPower ,'System','Average',ChillerName)
! Do not include this on meters, this would duplicate the cool electric and heat electric
CALL SetupOutputVariable('Chiller Heater Electric Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%ElectricEnergy,'System','Sum',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Electric Power [W]', &
ExhaustAbsorberReport(AbsorberNum)%CoolElectricPower ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Electric Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%CoolElectricEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='Electricity',GroupKey='Plant',EndUseKey='Cooling')
CALL SetupOutputVariable('Chiller Heater Heating Electric Power [W]', &
ExhaustAbsorberReport(AbsorberNum)%HeatElectricPower ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Electric Energy [J]', &
ExhaustAbsorberReport(AbsorberNum)%HeatElectricEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='Electricity',GroupKey='Plant',EndUseKey='Heating')
CALL SetupOutputVariable('Chiller Heater Evaporator Inlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%ChillReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Outlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%ChillSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Mass Flow Rate [kg/s]', &
ExhaustAbsorberReport(AbsorberNum)%ChillWaterFlowRate ,'System','Average',ChillerName)
IF (ExhaustAbsorber(AbsorberNum)%isWaterCooled) THEN
CALL SetupOutputVariable('Chiller Heater Condenser Inlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%CondReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Outlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%CondSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Mass Flow Rate [kg/s]', &
ExhaustAbsorberReport(AbsorberNum)%CondWaterFlowRate ,'System','Average',ChillerName)
ELSE
CALL SetupOutputVariable('Chiller Heater Condenser Inlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%CondReturnTemp ,'System','Average',ChillerName)
ENDIF
CALL SetupOutputVariable('Chiller Heater Heating Inlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%HotWaterReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Outlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%HotWaterSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Mass Flow Rate [kg/s]', &
ExhaustAbsorberReport(AbsorberNum)%HotWaterFlowRate ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Part Load Ratio []', &
ExhaustAbsorberReport(AbsorberNum)%CoolPartLoadRatio ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Maximum Cooling Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%CoolingCapacity ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Part Load Ratio []', &
ExhaustAbsorberReport(AbsorberNum)%HeatPartLoadRatio ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Maximum Heating Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%HeatingCapacity ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Runtime Fraction []', &
ExhaustAbsorberReport(AbsorberNum)%FractionOfPeriodRunning ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Source Exhaust Inlet Temperature [C]', &
ExhaustAbsorberReport(AbsorberNum)%ExhaustInTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Source Exhaust Inlet Mass Flow Rate [kg/s]', &
ExhaustAbsorberReport(AbsorberNum)%ExhaustInFlow ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Heat Recovery Potential Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%ExhHeatRecPotentialHeat ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Heat Recovery Potential Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%ExhHeatRecPotentialCool ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Source Heat Transfer Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%CoolThermalEnergyUseRate ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Source Heat Transfer Rate [W]', &
ExhaustAbsorberReport(AbsorberNum)%HeatThermalEnergyUseRate ,'System','Average',ChillerName)
END DO
RETURN
END SUBROUTINE GetExhaustAbsorberInput