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 GetICEngineGeneratorInput
! SUBROUTINE INFORMATION:
! AUTHOR: Dan Fisher
! DATE WRITTEN: Sept. 2000
! PURPOSE OF THIS SUBROUTINE:
! This routine will get the input
! required by the IC ENGINE Generator models.
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor
! REFERENCES: na
! USE STATEMENTS:
USE InputProcessor, ONLY : GetNumObjectsFound, GetObjectItem, VerifyName
USE DataIPShortCuts ! Data for field names, blank numerics
USE CurveManager, ONLY : GetCurveIndex, CurveValue
USE NodeInputManager, ONLY: GetOnlySingleNode
USE BranchNodeConnections, ONLY: TestCompSet
Use General, Only: RoundSigDigits
Use PlantUtilities, ONLY: RegisterPlantCompDesignFlow
IMPLICIT NONE !
! PARAMETERS
!LOCAL VARIABLES
INTEGER :: GeneratorNum !Generator 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
CHARACTER(len=MaxNameLength),DIMENSION(10) :: AlphArray !character string data
REAL(r64), DIMENSION(11) :: NumArray !numeric data
LOGICAL, SAVE :: ErrorsFound=.false. ! error flag
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
REAL(r64) :: xValue ! test curve limits
!FLOW
cCurrentModuleObject = 'Generator:InternalCombustionEngine'
NumICEngineGenerators = GetNumObjectsFound(cCurrentModuleObject)
IF (NumICEngineGenerators <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.true.
ENDIF
!ALLOCATE ARRAYS
ALLOCATE (ICEngineGenerator(NumICEngineGenerators))
ALLOCATE(CheckEquipName(NumICEngineGenerators))
CheckEquipName=.true.
ALLOCATE (ICEngineGeneratorReport(NumICEngineGenerators))
!LOAD ARRAYS WITH IC ENGINE Generator CURVE FIT DATA
DO GeneratorNum = 1 , NumICEngineGenerators
CALL GetObjectItem(cCurrentModuleObject,GeneratorNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT, AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),ICEngineGenerator%Name,GeneratorNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.true.
IF (IsBlank) AlphArray(1)='xxxxx'
ENDIF
ICEngineGenerator(GeneratorNum)%Name = AlphArray(1)
ICEngineGenerator(GeneratorNum)%RatedPowerOutput = NumArray(1)
IF (NumArray(1) == 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(NumArray(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
! Not sure what to do with electric nodes, so do not use optional arguments
ICEngineGenerator(GeneratorNum)%ElectricCircuitNode = &
GetOnlySingleNode(AlphArray(2),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Electric,NodeConnectionType_Electric,1,ObjectIsNotParent)
ICEngineGenerator(GeneratorNum)%MinPartLoadRat = NumArray(2)
ICEngineGenerator(GeneratorNum)%MaxPartLoadRat = NumArray(3)
ICEngineGenerator(GeneratorNum)%OptPartLoadRat = NumArray(4)
!Load Special IC ENGINE Generator Curve Fit Inputs
ICEngineGenerator(GeneratorNum)%ElecOutputFuelCurve = GetCurveIndex(AlphArray(3)) ! convert curve name to number
IF (ICEngineGenerator(GeneratorNum)%ElecOutputFuelCurve .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(3))//'='//TRIM(AlphArray(3)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
END IF
ICEngineGenerator(GeneratorNum)%RecJacHeattoFuelCurve = GetCurveIndex(AlphArray(4)) ! convert curve name to number
IF (ICEngineGenerator(GeneratorNum)%RecJacHeattoFuelCurve .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(4))//'='//TRIM(AlphArray(4)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
END IF
ICEngineGenerator(GeneratorNum)%RecLubeHeattoFuelCurve = GetCurveIndex(AlphArray(5)) ! convert curve name to number
IF (ICEngineGenerator(GeneratorNum)%RecLubeHeattoFuelCurve .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//'='//TRIM(AlphArray(5)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
END IF
ICEngineGenerator(GeneratorNum)%TotExhausttoFuelCurve = GetCurveIndex(AlphArray(6)) ! convert curve name to number
IF (ICEngineGenerator(GeneratorNum)%TotExhausttoFuelCurve .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(AlphArray(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
END IF
ICEngineGenerator(GeneratorNum)%ExhaustTempCurve = GetCurveIndex(AlphArray(7)) ! convert curve name to number
IF (ICEngineGenerator(GeneratorNum)%ExhaustTempCurve .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(7))//'='//TRIM(AlphArray(7)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ELSE
xValue = CurveValue(ICEngineGenerator(GeneratorNum)%ExhaustTempCurve, 1.0d0)
IF (xValue < ReferenceTemp) THEN
CALL ShowSevereError('GetICEngineGeneratorInput: '//trim(cAlphaFieldNames(7))//' output has very low value.')
CALL ShowContinueError('...curve generates ['//trim(RoundSigDigits(xValue,3))//' C] at PLR=1.0')
CALL ShowContinueError('...this is less than the Reference Temperature ['//trim(RoundSigDigits(ReferenceTemp,2))// &
' C] and may cause errors.')
ENDIF
END IF
ICEngineGenerator(GeneratorNum)%UACoef(1) = NumArray(5)
ICEngineGenerator(GeneratorNum)%UACoef(2) = NumArray(6)
ICEngineGenerator(GeneratorNum)%MaxExhaustperPowerOutput = NumArray(7)
ICEngineGenerator(GeneratorNum)%DesignMinExitGasTemp = NumArray(8)
ICEngineGenerator(GeneratorNum)%FuelHeatingValue = NumArray(9)
ICEngineGenerator(GeneratorNum)%DesignHeatRecVolFlowRate = NumArray(10)
IF (ICEngineGenerator(GeneratorNum)%DesignHeatRecVolFlowRate > 0.0d0) THEN
ICEngineGenerator(GeneratorNum)%HeatRecActive=.true.
ICEngineGenerator(GeneratorNum)%HeatRecInletNodeNum = &
GetOnlySingleNode(AlphArray(8),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent)
IF (ICEngineGenerator(GeneratorNum)%HeatRecInletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(8))//'='//TRIM(AlphArray(8)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
ICEngineGenerator(GeneratorNum)%HeatRecOutletNodeNum = &
GetOnlySingleNode(AlphArray(9),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent)
IF (ICEngineGenerator(GeneratorNum)%HeatRecOutletNodeNum == 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(AlphArray(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound=.true.
ENDIF
CALL TestCompSet(TRIM(cCurrentModuleObject),AlphArray(1),AlphArray(8),AlphArray(9),'Heat Recovery Nodes')
Call RegisterPlantCompDesignFlow(ICEngineGenerator(GeneratorNum)%HeatRecInletNodeNum, &
ICEngineGenerator(GeneratorNum)%DesignHeatRecVolFlowRate )
ELSE
ICEngineGenerator(GeneratorNum)%HeatRecActive=.false.
ICEngineGenerator(GeneratorNum)%HeatRecInletNodeNum = 0
ICEngineGenerator(GeneratorNum)%HeatRecOutletNodeNum = 0
IF (.NOT. lAlphaFieldBlanks(8) .OR. .NOT. lAlphaFieldBlanks(9) ) THEN
CALL ShowWarningError('Since Design Heat Flow Rate = 0.0, Heat Recovery inactive for '// &
TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('However, Node names were specified for Heat Recovery inlet or outlet nodes')
ENDIF
ENDIF
!Fuel Type Case Statement
SELECT CASE (AlphArray(10))
CASE (' ') !If blank then the default is Diesel
ICEngineGenerator(GeneratorNum)%FuelType = 'Diesel'
CASE ('GAS','NATURALGAS','NATURAL GAS')
ICEngineGenerator(GeneratorNum)%FuelType = 'Gas'
CASE ('DIESEL')
ICEngineGenerator(GeneratorNum)%FuelType = 'Diesel'
CASE ('GASOLINE')
ICEngineGenerator(GeneratorNum)%FuelType = 'Gasoline'
CASE ('FUEL OIL #1','FUELOIL#1','FUEL OIL','DISTILLATE OIL')
ICEngineGenerator(GeneratorNum)%FuelType = 'FuelOil#1'
CASE ('FUEL OIL #2','FUELOIL#2','RESIDUAL OIL')
ICEngineGenerator(GeneratorNum)%FuelType = 'FuelOil#2'
CASE ('PROPANE','LPG','PROPANEGAS','PROPANE GAS')
ICEngineGenerator(GeneratorNum)%FuelType = 'Propane'
CASE ('OTHERFUEL1')
ICEngineGenerator(GeneratorNum)%FuelType = 'OtherFuel1'
CASE ('OTHERFUEL2')
ICEngineGenerator(GeneratorNum)%FuelType = 'OtherFuel2'
CASE DEFAULT
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(10))//'='//TRIM(AlphArray(10)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound=.true.
END SELECT
ICEngineGenerator(GeneratorNum)%HeatRecMaxTemp = NumArray(11)
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
ENDIF
DO GeneratorNum = 1, NumICEngineGenerators
CALL SetupOutputVariable('Generator Produced Electric Power [W]', &
ICEngineGeneratorReport(GeneratorNum)%PowerGen,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Electric Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%EnergyGen,'System','Sum',ICEngineGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Generator '// TRIM(ICEngineGenerator(GeneratorNum)%FuelType)//' Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%FuelEnergyUseRate,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator '// TRIM(ICEngineGenerator(GeneratorNum)%FuelType)//' Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%FuelEnergy,'System','Sum',ICEngineGenerator(GeneratorNum)%Name, &
ResourceTypeKey=ICEngineGenerator(GeneratorNum)%FuelType,EndUseKey='COGENERATION',GroupKey='Plant')
! general fuel use report to match other generators.
CALL SetupOutputVariable('Generator Fuel HHV Basis Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%FuelEnergyUseRate,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Fuel HHV Basis Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%FuelEnergy,'System','Sum',ICEngineGenerator(GeneratorNum)%Name )
CALL SetupOutputVariable('Generator '// TRIM(ICEngineGenerator(GeneratorNum)%FuelType)//' Mass Flow Rate [kg/s]', &
ICEngineGeneratorReport(GeneratorNum)%FuelMdot,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Exhaust Air Temperature [C]', &
ICEngineGeneratorReport(GeneratorNum)%ExhaustStackTemp,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
IF (ICEngineGenerator(GeneratorNum)%HeatRecActive) THEN
CALL SetupOutputVariable('Generator Heat Recovery Mass Flow Rate [kg/s]', &
ICEngineGeneratorReport(GeneratorNum)%HeatRecMdot,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Jacket Heat Recovery Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%QJacketRecovered,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Jacket Heat Recovery Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%JacketEnergyRec,'System','Sum',ICEngineGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Generator Lube Heat Recovery Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%QLubeOilRecovered,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Lube Heat Recovery Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%LubeOilEnergyRec,'System','Sum',ICEngineGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Generator Exhaust Heat Recovery Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%QExhaustRecovered,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Exhaust Heat Recovery Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%ExhaustEnergyRec,'System','Sum',ICEngineGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Generator Produced Thermal Rate [W]', &
ICEngineGeneratorReport(GeneratorNum)%QTotalHEatRecovered,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Thermal Energy [J]', &
ICEngineGeneratorReport(GeneratorNum)%TotalHeatEnergyRec,'System','Sum',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Heat Recovery Inlet Temperature [C]', &
ICEngineGeneratorReport(GeneratorNum)%HeatRecInletTemp,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Heat Recovery Outlet Temperature [C]', &
ICEngineGeneratorReport(GeneratorNum)%HeatRecOutletTemp,'System','Average',ICEngineGenerator(GeneratorNum)%Name)
ENDIF
END DO
RETURN
END SUBROUTINE GetICEngineGeneratorInput