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 GetGasAbsorberInput
! SUBROUTINE INFORMATION:
! AUTHOR: Jason Glazer
! DATE WRITTEN: March 2001
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the Direct Fired Absorption chiller modelin the object ChillerHeater:Absorption:DirectFired
! 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
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
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:DirectFired'
NumGasAbsorbers = GetNumObjectsFound(cCurrentModuleObject)
IF (NumGasAbsorbers <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment found in input file')
ErrorsFound=.true.
ENDIF
IF (ALLOCATED(GasAbsorber)) RETURN
!ALLOCATE ARRAYS
ALLOCATE (GasAbsorber(NumGasAbsorbers))
ALLOCATE (GasAbsorberReport(NumGasAbsorbers))
ALLOCATE(CheckEquipName(NumGasAbsorbers))
CheckEquipName=.true.
!LOAD ARRAYS
DO AbsorberNum = 1 , NumGasAbsorbers
CALL GetObjectItem(cCurrentModuleObject,AbsorberNum,cAlphaArgs,NumAlphas, &
rNumericArgs,NumNums,IOSTAT, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(cAlphaArgs(1),GasAbsorber%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
GasAbsorber(AbsorberNum)%Name = cAlphaArgs(1)
ChillerName = TRIM(cCurrentModuleObject)//' Named ' // TRIM(GasAbsorber(AbsorberNum)%Name)
! Assign capacities
GasAbsorber(AbsorberNum)%NomCoolingCap = rNumericArgs(1)
GasAbsorber(AbsorberNum)%NomHeatCoolRatio = rNumericArgs(2)
! Assign efficiencies
GasAbsorber(AbsorberNum)%FuelCoolRatio = rNumericArgs(3)
GasAbsorber(AbsorberNum)%FuelHeatRatio = rNumericArgs(4)
GasAbsorber(AbsorberNum)%ElecCoolRatio = rNumericArgs(5)
GasAbsorber(AbsorberNum)%ElecHeatRatio = rNumericArgs(6)
! Assign Node Numbers to specified nodes
GasAbsorber(AbsorberNum)%ChillReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(2), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 1, ObjectIsNotParent)
GasAbsorber(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
GasAbsorber(AbsorberNum)%HeatReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(6), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 3, ObjectIsNotParent)
GasAbsorber(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
GasAbsorber(AbsorberNum)%MinPartLoadRat = rNumericArgs(7)
GasAbsorber(AbsorberNum)%MaxPartLoadRat = rNumericArgs(8)
GasAbsorber(AbsorberNum)%OptPartLoadRat = rNumericArgs(9)
! Assign Design Conditions
GasAbsorber(AbsorberNum)%TempDesCondReturn = rNumericArgs(10)
GasAbsorber(AbsorberNum)%TempDesCHWSupply = rNumericArgs(11)
GasAbsorber(AbsorberNum)%EvapVolFlowRate = rNumericArgs(12)
IF (SameString(cAlphaArgs(16),'AirCooled') ) THEN
GasAbsorber(AbsorberNum)%CondVolFlowRate = 0.0011d0 ! Condenser flow rate not used for this cond type
ELSE
GasAbsorber(AbsorberNum)%CondVolFlowRate = rNumericArgs(13)
ENDIF
GasAbsorber(AbsorberNum)%HeatVolFlowRate = rNumericArgs(14)
! Assign Curve Numbers
GasAbsorber(AbsorberNum)%CoolCapFTCurve = GetCurveCheck(cAlphaArgs(8), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%FuelCoolFTCurve = GetCurveCheck(cAlphaArgs(9), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%FuelCoolFPLRCurve = GetCurveCheck(cAlphaArgs(10), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%ElecCoolFTCurve = GetCurveCheck(cAlphaArgs(11), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%ElecCoolFPLRCurve = GetCurveCheck(cAlphaArgs(12), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%HeatCapFCoolCurve = GetCurveCheck(cAlphaArgs(13), ErrorsFound, ChillerName)
GasAbsorber(AbsorberNum)%FuelHeatFHPLRCurve = 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
GasAbsorber(AbsorberNum)%isEnterCondensTemp = .FALSE.
ELSEIF (SameString(cAlphaArgs(15),'EnteringCondenser')) THEN
GasAbsorber(AbsorberNum)%isEnterCondensTemp = .TRUE.
ELSE
GasAbsorber(AbsorberNum)%isEnterCondensTemp = .TRUE.
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid value')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(15))//'="'//TRIM(cAlphaArgs(15))//'"')
CALL ShowContinueError('resetting to EnteringCondenser, simulation continues')
ENDIF
! Assign Other Paramters
IF (SameString(cAlphaArgs(16),'AirCooled') ) THEN
GasAbsorber(AbsorberNum)%isWaterCooled = .FALSE.
ELSEIF (SameString(cAlphaArgs(16),'WaterCooled')) THEN
GasAbsorber(AbsorberNum)%isWaterCooled = .TRUE.
ELSE
GasAbsorber(AbsorberNum)%isWaterCooled = .TRUE.
CALL ShowWarningError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid value')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(16))//'='//TRIM(cAlphaArgs(16)))
CALL ShowContinueError('resetting to WaterCooled, simulation continues')
ENDIF
IF (GasAbsorber(AbsorberNum)%isWaterCooled) THEN
GasAbsorber(AbsorberNum)%CondReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(4), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Water, &
NodeConnectionType_Inlet, 2, ObjectIsNotParent)
GasAbsorber(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
GasAbsorber(AbsorberNum)%CondReturnNodeNum = &
GetOnlySingleNode(cAlphaArgs(4), ErrorsFound, TRIM(cCurrentModuleObject), cAlphaArgs(1),NodeType_Air, &
NodeConnectionType_OutsideAirReference, 2, ObjectIsNotParent)
GasAbsorber(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(GasAbsorber(AbsorberNum)%CondReturnNodeNum,Okay)
IF (.not. Okay) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//', Adding OutdoorAir:Node='//TRIM(cAlphaArgs(4)))
ENDIF
ENDIF
GasAbsorber(AbsorberNum)%CHWLowLimitTemp = rNumericArgs(15)
GasAbsorber(AbsorberNum)%FuelHeatingValue = rNumericArgs(16)
GasAbsorber(AbsorberNum)%SizFac = rNumericArgs(17)
!Fuel Type Case Statement
SELECT CASE (cAlphaArgs(18))
CASE ('GAS','NATURALGAS','NATURAL GAS')
GasAbsorber(AbsorberNum)%FuelType = 'Gas'
CASE ('DIESEL')
GasAbsorber(AbsorberNum)%FuelType = 'Diesel'
CASE ('GASOLINE')
GasAbsorber(AbsorberNum)%FuelType = 'Gasoline'
CASE ('FUEL OIL #1','FUELOIL#1','FUEL OIL','DISTILLATE OIL')
GasAbsorber(AbsorberNum)%FuelType = 'FuelOil#1'
CASE ('FUEL OIL #2','FUELOIL#2','RESIDUAL OIL')
GasAbsorber(AbsorberNum)%FuelType = 'FuelOil#2'
CASE ('PROPANE','LPG','PROPANEGAS','PROPANE GAS')
GasAbsorber(AbsorberNum)%FuelType = 'Propane'
CASE ('OTHERFUEL1')
GasAbsorber(AbsorberNum)%FuelType = 'OtherFuel1'
CASE ('OTHERFUEL2')
GasAbsorber(AbsorberNum)%FuelType = 'OtherFuel2'
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'="'//TRIM(cAlphaArgs(1))//'", invalid value')
CALL ShowContinueError('Invalid '//TRIM(cAlphaFieldNames(18))//'='//TRIM(cAlphaArgs(18)))
CALL ShowContinueError('Valid choices are Electricity, NaturalGas, PropaneGas, Diesel, Gasoline, FuelOil#1, FuelOil#2,'// &
'OtherFuel1 or OtherFuel2')
ErrorsFound=.true.
END SELECT
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
DO AbsorberNum = 1, NumGasAbsorbers
ChillerName = GasAbsorber(AbsorberNum)%Name
CALL SetupOutputVariable('Chiller Heater Evaporator Cooling Rate [W]', &
GasAbsorberReport(AbsorberNum)%CoolingLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Cooling Energy [J]', &
GasAbsorberReport(AbsorberNum)%CoolingEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='CHILLERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater Heating Rate [W]', &
GasAbsorberReport(AbsorberNum)%HeatingLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Energy [J]', &
GasAbsorberReport(AbsorberNum)%HeatingEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='BOILERS',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater Condenser Heat Transfer Rate [W]', &
GasAbsorberReport(AbsorberNum)%TowerLoad ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Heat Transfer Energy [J]', &
GasAbsorberReport(AbsorberNum)%TowerEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATREJECTION',GroupKey='Plant')
CALL SetupOutputVariable('Chiller Heater '// TRIM(GasAbsorber(AbsorberNum)%FuelType)//' Rate [W]', &
GasAbsorberReport(AbsorberNum)%FuelUseRate ,'System','Average',ChillerName)
! Do not include this on meters, this would duplicate the cool fuel and heat fuel
CALL SetupOutputVariable('Chiller Heater '// TRIM(GasAbsorber(AbsorberNum)%FuelType)//' Energy [J]', &
GasAbsorberReport(AbsorberNum)%FuelEnergy,'System','Sum',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling ' &
// TRIM(GasAbsorber(AbsorberNum)%FuelType)//' Rate [W]', &
GasAbsorberReport(AbsorberNum)%CoolFuelUseRate ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling ' &
// TRIM(GasAbsorber(AbsorberNum)%FuelType)//' Energy [J]', &
GasAbsorberReport(AbsorberNum)%CoolFuelEnergy,'System','Sum',ChillerName, &
ResourceTypeKey=GasAbsorber(AbsorberNum)%FuelType,GroupKey='Plant',EndUseKey='Cooling')
CALL SetupOutputVariable('Chiller Heater Cooling COP [W/W]', &
GasAbsorberReport(AbsorberNum)%FuelCOP ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating '// TRIM(GasAbsorber(AbsorberNum)%FuelType)// &
' Rate [W]',GasAbsorberReport(AbsorberNum)%HeatFuelUseRate ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating '// TRIM(GasAbsorber(AbsorberNum)%FuelType)// &
' Energy [J]',GasAbsorberReport(AbsorberNum)%HeatFuelEnergy,'System','Sum',ChillerName, &
ResourceTypeKey=GasAbsorber(AbsorberNum)%FuelType,GroupKey='Plant',EndUseKey='Heating')
CALL SetupOutputVariable('Chiller Heater Electric Power [W]', &
GasAbsorberReport(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]', &
GasAbsorberReport(AbsorberNum)%ElectricEnergy,'System','Sum',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Electric Power [W]', &
GasAbsorberReport(AbsorberNum)%CoolElectricPower ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Electric Energy [J]', &
GasAbsorberReport(AbsorberNum)%CoolElectricEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='Electricity',GroupKey='Plant',EndUseKey='Cooling')
CALL SetupOutputVariable('Chiller Heater Heating Electric Power [W]', &
GasAbsorberReport(AbsorberNum)%HeatElectricPower ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Electric Energy [J]', &
GasAbsorberReport(AbsorberNum)%HeatElectricEnergy,'System','Sum',ChillerName, &
ResourceTypeKey='Electricity',GroupKey='Plant',EndUseKey='Heating')
CALL SetupOutputVariable('Chiller Heater Evaporator Inlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%ChillReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Outlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%ChillSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Evaporator Mass Flow Rate [kg/s]', &
GasAbsorberReport(AbsorberNum)%ChillWaterFlowRate ,'System','Average',ChillerName)
IF (GasAbsorber(AbsorberNum)%isWaterCooled) THEN
CALL SetupOutputVariable('Chiller Heater Condenser Inlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%CondReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Outlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%CondSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Condenser Mass Flow Rate [kg/s]', &
GasAbsorberReport(AbsorberNum)%CondWaterFlowRate ,'System','Average',ChillerName)
ELSE
CALL SetupOutputVariable('Chiller Heater Condenser Inlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%CondReturnTemp ,'System','Average',ChillerName)
ENDIF
CALL SetupOutputVariable('Chiller Heater Heating Inlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%HotWaterReturnTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Outlet Temperature [C]', &
GasAbsorberReport(AbsorberNum)%HotWaterSupplyTemp ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Mass Flow Rate [kg/s]', &
GasAbsorberReport(AbsorberNum)%HotWaterFlowRate ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Cooling Part Load Ratio []', &
GasAbsorberReport(AbsorberNum)%CoolPartLoadRatio ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Maximum Cooling Rate [W]', &
GasAbsorberReport(AbsorberNum)%CoolingCapacity ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Heating Part Load Ratio []', &
GasAbsorberReport(AbsorberNum)%HeatPartLoadRatio ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Maximum Heating Rate [W]', &
GasAbsorberReport(AbsorberNum)%HeatingCapacity ,'System','Average',ChillerName)
CALL SetupOutputVariable('Chiller Heater Runtime Fraction []', &
GasAbsorberReport(AbsorberNum)%FractionOfPeriodRunning ,'System','Average',ChillerName)
END DO
RETURN
END SUBROUTINE GetGasAbsorberInput