SUBROUTINE GetMTGeneratorInput
! SUBROUTINE INFORMATION:
! AUTHOR R. Raustad/D. Shirey
! DATE WRITTEN Mar 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This routine gets the input information for the Microturbine (MT) Generator model.
! METHODOLOGY EMPLOYED:
! EnergyPlus input processor.
! REFERENCES:
! na
! USE STATEMENTS:
USE BranchNodeConnections, ONLY: TestCompSet
USE CurveManager, ONLY: GetCurveIndex, CurveValue, GetCurveType, GetCurveMinMaxValues
USE InputProcessor, ONLY: GetNumObjectsFound, GetObjectItem, VerifyName, SameString
USE DataIPShortCuts ! Data for field names, blank numerics
USE NodeInputManager, ONLY: GetOnlySingleNode
USE OutAirNodeManager, ONLY: CheckOutAirNodeNumber
USE ScheduleManager, ONLY: GetScheduleIndex
USE General, ONLY: TrimSigDigits, RoundSigDigits
USE Psychrometrics, ONLY: PsyRhoAirFnPbTdbW
USE PlantUtilities, ONLY: RegisterPlantCompDesignFlow
IMPLICIT NONE !
! PARAMETERS:
! na
! LOCAL VARIABLES:
INTEGER :: GeneratorNum ! Index to generator
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. ! Error flag... trips fatal error message at end of get input
LOGICAL :: IsNotOK ! Flag to verify name
LOGICAL :: IsBlank ! Flag for blank name
REAL(r64) :: ElectOutFTempElevOutput ! Output of Electrical Power Output Modifier Curve (function of temp and elev)
REAL(r64) :: ElecEfficFTempOutput ! Output of Electrical Efficiency Modifier Curve (function of temp)
REAL(r64) :: ElecEfficFPLROutput ! Output of Electrical Efficiency Modifier Curve (function of PLR)
REAL(r64) :: AncillaryPowerOutput ! Output of Ancillary Power Modifer Curve (function of temps and fuel flow)
REAL(r64) :: RefFuelUseMdot ! Fuel mass flow rate at reference conditions (kg/s)
REAL(r64) :: RefBaroPressure ! Reference barometric pressure, adjusted for reference elevation (Pa)
REAL(r64) :: ThermalEffTempElevOutput ! Output of Thermal Efficiency Modifier Curve (function of temp and elevation)
REAL(r64) :: HeatRecRateFPLROutput ! Output of Heat Recovery Rate Modifier Curve (function of PLR)
REAL(r64) :: HeatRecRateFTempOutput ! Output of Heat Recovery Rate Modifier Curve (function of inlet water temp)
REAL(r64) :: HeatRecRateFFlowOutput ! Output of Heat Recovery Rate Modifier Curve (function of water flow rate)
REAL(r64) :: ExhFlowFTempOutput ! Output of Exhaust Air Flow Modifier Curve (function of inlet air temp)
REAL(r64) :: ExhFlowFPLROutput ! Output of Exhaust Air Flow Modifier Curve (function of PLR)
REAL(r64) :: ExhAirTempFTempOutput ! Output of Exhaust Air Temperature Modifier Curve (function of inlet air temp)
REAL(r64) :: ExhOutAirTempFPLROutput ! Output of Exhaust Air Temperature Modifier Curve (function of PLR)
REAL(r64) :: Var1Min= 0.0d0 ! Minimum value for variable 1, value obtained from a curve object
REAL(r64) :: Var1Max= 0.0d0 ! Maximum value for variable 1, value obtained from a curve object
REAL(r64), DIMENSION(19) :: NumArray ! Numeric data array
CHARACTER(len=MaxNameLength),DIMENSION(20) :: AlphArray ! Character string data array
CHARACTER(len=MaxNameLength) :: FuelType ! Type of fuel used for generator
! FLOW:
cCurrentModuleObject = 'Generator:MicroTurbine'
NumMTGenerators = GetNumObjectsFound(cCurrentModuleObject)
IF (NumMTGenerators <= 0) THEN
CALL ShowSevereError('No '//TRIM(cCurrentModuleObject)//' equipment specified in input file')
ErrorsFound=.TRUE.
END IF
! ALLOCATE ARRAYS
ALLOCATE (MTGenerator(NumMTGenerators))
ALLOCATE (MTGeneratorReport(NumMTGenerators))
ALLOCATE(CheckEquipName(NumMTGenerators))
CheckEquipName=.true.
! LOAD ARRAYS WITH MICROTURBINE GENERATOR DATA
DO GeneratorNum = 1 , NumMTGenerators
CALL GetObjectItem(cCurrentModuleObject,GeneratorNum,AlphArray,NumAlphas, &
NumArray,NumNums,IOSTAT,NumBlank=lNumericFieldBlanks,AlphaBlank=lAlphaFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
IsNotOK=.false.
IsBlank=.false.
CALL VerifyName(AlphArray(1),MTGenerator%Name,GeneratorNum-1,IsNotOK,IsBlank,TRIM(cCurrentModuleObject)//' Name')
IF (IsNotOK) THEN
ErrorsFound=.TRUE.
IF (IsBlank) AlphArray(1)='xxxxx'
END IF
MTGenerator(GeneratorNum)%Name = AlphArray(1)
MTGenerator(GeneratorNum)%RefElecPowerOutput = NumArray(1)
IF (MTGenerator(GeneratorNum)%RefElecPowerOutput .LE. 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(1))//'='//TRIM(RoundSigDigits(NumArray(1),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be greater than 0.')
ErrorsFound=.TRUE.
END IF
MTGenerator(GeneratorNum)%MinElecPowerOutput = NumArray(2)
MTGenerator(GeneratorNum)%MaxElecPowerOutput = NumArray(3)
IF (MTGenerator(GeneratorNum)%MinElecPowerOutput .LT. 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(2))//'='//TRIM(RoundSigDigits(NumArray(2),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' must be greater than 0.')
ErrorsFound = .TRUE.
END IF
IF (lNumericFieldBlanks(3)) THEN
MTGenerator(GeneratorNum)%MaxElecPowerOutput = MTGenerator(GeneratorNum)%RefElecPowerOutput
ELSE
IF (MTGenerator(GeneratorNum)%MaxElecPowerOutput .LE. 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(3))//'='//TRIM(RoundSigDigits(NumArray(3),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' must be greater than 0.')
ErrorsFound = .TRUE.
END IF
END IF
IF (MTGenerator(GeneratorNum)%MinElecPowerOutput .GE. MTGenerator(GeneratorNum)%MaxElecPowerOutput) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'= '//TRIM(MTGenerator(GeneratorNum)%Name))
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' ['//TRIM(RoundSigDigits(NumArray(2),2))//'] > '// &
TRIM(cNumericFieldNames(3))//' ['//TRIM(RoundSigDigits(NumArray(3),2))//']')
CALL ShowContinueError('Minimum Full Load Electrical Power Output must be less than or equal')
CALL ShowContinueError('to Maximum Full Load Electrical Power Output.')
ErrorsFound = .TRUE.
END IF
IF (MTGenerator(GeneratorNum)%RefElecPowerOutput .GT. MTGenerator(GeneratorNum)%MaxElecPowerOutput .OR. &
MTGenerator(GeneratorNum)%RefElecPowerOutput .LT. MTGenerator(GeneratorNum)%MinElecPowerOutput) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//'= '//TRIM(MTGenerator(GeneratorNum)%Name))
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be >= '//TRIM(cNumericFieldNames(2)))
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' must be <= '//TRIM(cNumericFieldNames(3)))
CALL ShowContinueError(TRIM(cNumericFieldNames(1))//' = '//TRIM(RoundSigDigits(NumArray(1),2)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(2))//' = '//TRIM(RoundSigDigits(NumArray(2),2)) )
CALL ShowContinueError(TRIM(cNumericFieldNames(3))//' = '//TRIM(RoundSigDigits(NumArray(3),2)) )
ErrorsFound = .TRUE.
END IF
MTGenerator(GeneratorNum)%RefElecEfficiencyLHV = NumArray(4)
IF (MTGenerator(GeneratorNum)%RefElecEfficiencyLHV .LE. 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(4))//'='//TRIM(RoundSigDigits(NumArray(4),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(4))//' must be greater than 0.')
ErrorsFound = .TRUE.
END IF
MTGenerator(GeneratorNum)%RefCombustAirInletTemp = NumArray(5)
MTGenerator(GeneratorNum)%RefCombustAirInletHumRat = NumArray(6)
MTGenerator(GeneratorNum)%RefElevation = NumArray(7)
IF (MTGenerator(GeneratorNum)%RefCombustAirInletHumRat .LE. 0.0d0) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(6))//'='//TRIM(RoundSigDigits(NumArray(6),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(6))//' must be greater than 0.')
ErrorsFound = .TRUE.
ELSE
! Barometric pressure adjusted for elevation
RefBaroPressure = 101325.0d0 * (1.d0-2.25577D-05*MTGenerator(GeneratorNum)%RefElevation)**5.2559d0
MTGenerator(GeneratorNum)%RefCombustAirInletDensity = PsyRhoAirFnPbTdbW(RefBaroPressure, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp,MTGenerator(GeneratorNum)%RefCombustAirInletHumRat)
END IF
MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum = GetCurveIndex(AlphArray(2)) ! Convert curve name to number
IF (MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(2))//'='//TRIM(AlphArray(2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ELSE
! Verify curve object, only legal type is BiQuadratic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum))
CASE('BIQUADRATIC')
! Check electrical power output at reference combustion inlet temp and elevation
ElectOutFTempElevOutput = CurveValue(MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp, &
MTGenerator(GeneratorNum)%RefElevation)
IF (ABS(ElectOutFTempElevOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(2))//' = '//TRIM(AlphArray(2)))
CALL ShowContinueError('...Curve output at reference conditions should equal 1 (+-10%).')
CALL ShowContinueError('...Reference combustion air inlet temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefCombustAirInletTemp,4))//' C')
CALL ShowContinueError('...Reference elevation = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefElevation,4))//' m')
CALL ShowContinueError('...Curve output = '//TRIM(TrimSigDigits(ElectOutFTempElevOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(2))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum)))
CALL ShowContinueError('... Curve type must be BIQUADRATIC.') !TODO rename point (curves)
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%ElecEffFTempCurveNum = GetCurveIndex(AlphArray(3)) ! Convert curve name to number
IF (MTGenerator(GeneratorNum)%ElecEffFTempCurveNum .EQ. 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowSevereError(TRIM(cAlphaFieldNames(3))//' not found = '//TRIM(AlphArray(3)))
ErrorsFound = .TRUE.
ELSE
! Verify curve object, only legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ElecEffFTempCurveNum))
CASE('QUADRATIC', 'CUBIC')
! Check electrical efficiency at reference combustion inlet temp
ElecEfficFTempOutput = CurveValue(MTGenerator(GeneratorNum)%ElecEffFTempCurveNum, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp)
IF (ABS(ElecEfficFTempOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(3))//' = '//TRIM(AlphArray(3)))
CALL ShowContinueError('... Curve output at reference condition should equal 1 (+-10%).')
CALL ShowContinueError('... Reference combustion air inlet temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefCombustAirInletTemp,4))//' C')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ElecEfficFTempOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...illegal '//TRIM(cAlphaFieldNames(3))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ElecEffFTempCurveNum)))
CALL ShowContinueError('Curve type must be QUADRATIC or CUBIC.') !TODO rename point (curves)
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum = GetCurveIndex(AlphArray(4)) ! Convert curve name to number
IF (MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum .EQ. 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowSevereError(TRIM(cAlphaFieldNames(4))//' not found = '//TRIM(AlphArray(4)))
ErrorsFound = .TRUE.
ELSE
! Verify curve object, only legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum))
CASE('QUADRATIC', 'CUBIC')
! Check electrical efficiency at PLR = 1
ElecEfficFPLROutput = CurveValue(MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum, 1.0d0)
IF (ABS(ElecEfficFPLROutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(4))//' = '//TRIM(AlphArray(4)))
CALL ShowContinueError('... Curve output at a part-load ratio of 1 should equal 1 (+-10%).')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ElecEfficFPLROutput,4)))
END IF
CALL GetCurveMinMaxValues(MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum,Var1Min,Var1Max)
MTGenerator(GeneratorNum)%MinPartLoadRat = Var1Min
MTGenerator(GeneratorNum)%MaxPartLoadRat = Var1Max
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...illegal '//TRIM(cAlphaFieldNames(4))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum)))
CALL ShowContinueError('Curve type must be QUADRATIC or CUBIC.') !TODO rename point (curves)
ErrorsFound=.TRUE.
END SELECT
END IF
! Fuel Type case statement
SELECT CASE (TRIM(AlphArray(5)))
CASE (' ') ! If blank, then the default is Natural Gas
FuelType = 'Gas'
CASE ('GAS','NATURALGAS','NATURAL GAS')
FuelType = 'Gas'
! CASE ('DIESEL')
! FuelType = 'Diesel'
! CASE ('GASOLINE')
! FuelType = 'Gasoline'
! CASE ('FUEL OIL #1','FUELOIL#1','FUEL OIL','DISTILLATE OIL')
! FuelType = 'FuelOil#1'
! CASE ('FUEL OIL #2','FUELOIL#2','RESIDUAL OIL')
! FuelType = 'FuelOil#2'
CASE ('PROPANE','LPG','PROPANEGAS','PROPANE GAS')
FuelType = 'Propane'
! CASE ('OTHERFUEL1')
! FuelType = 'OtherFuel1'
! CASE ('OTHERFUEL2')
! FuelType = 'OtherFuel2'
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(5))//' = '//TRIM(AlphArray(5)))
ErrorsFound=.TRUE.
END SELECT
MTGenerator(GeneratorNum)%FuelHigherHeatingValue = NumArray(8)
MTGenerator(GeneratorNum)%FuelLowerHeatingValue = NumArray(9)
IF(MTGenerator(GeneratorNum)%FuelLowerHeatingValue .LE. 0.0d0)THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(9))//'='//TRIM(RoundSigDigits(NumArray(9),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//' must be greater than 0.')
ErrorsFound=.TRUE.
END IF
IF(MTGenerator(GeneratorNum)%FuelHigherHeatingValue .LE. 0.0d0)THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(8))//'='//TRIM(RoundSigDigits(NumArray(8),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' must be greater than 0.')
ErrorsFound=.TRUE.
END IF
IF(MTGenerator(GeneratorNum)%FuelLowerHeatingValue .GT. MTGenerator(GeneratorNum)%FuelHigherHeatingValue)THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//' must be greater than the '//&
TRIM(cNumericFieldNames(9)))
CALL ShowContinueError(TRIM(cNumericFieldNames(8))//'='//TRIM(RoundSigDigits(NumArray(8),2)))
CALL ShowContinueError(TRIM(cNumericFieldNames(9))//'='//TRIM(RoundSigDigits(NumArray(9),2)))
ErrorsFound=.TRUE.
END IF
MTGenerator(GeneratorNum)%StandbyPower = NumArray(10)
IF( MTGenerator(GeneratorNum)%StandbyPower .LT. 0.0d0)THEN
CALL ShowWarningError('Invalid '//TRIM(cNumericFieldNames(10))//'='//TRIM(RoundSigDigits(NumArray(10),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(10))//' must be greater than 0.')
CALL ShowContinueError('Resetting to 0 and the simulation continues.')
MTGenerator(GeneratorNum)%StandbyPower = 0.0d0
END IF
MTGenerator(GeneratorNum)%AncillaryPower = NumArray(11)
IF( MTGenerator(GeneratorNum)%AncillaryPower .LT. 0.0d0)THEN
CALL ShowWarningError('Invalid '//TRIM(cNumericFieldNames(11))//'='//TRIM(RoundSigDigits(NumArray(11),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(11))//' must be greater than 0.')
CALL ShowContinueError('Resetting to 0 and the simulation continues.')
MTGenerator(GeneratorNum)%AncillaryPower = 0.0d0
END IF
MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum = GetCurveIndex(AlphArray(6)) ! Convert curve name to number
! If blank, then the calc routine assumes modifier curve value = 1 for entire simulation
IF (.NOT. lAlphaFieldBlanks(6) .AND. MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum .EQ. 0) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(6))//'='//TRIM(AlphArray(6)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
ErrorsFound = .TRUE.
ELSE IF(MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum .GT. 0)THEN
! Verify curve object, only legal type is Quadratic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum))
CASE('QUADRATIC')
IF (MTGenerator(GeneratorNum)%FuelLowerHeatingValue.GT.0.0d0 .AND. &
MTGenerator(GeneratorNum)%RefElecEfficiencyLHV.GT.0.0d0) THEN
RefFuelUseMdot = (MTGenerator(GeneratorNum)%RefElecPowerOutput / MTGenerator(GeneratorNum)%RefElecEfficiencyLHV) / &
(MTGenerator(GeneratorNum)%FuelLowerHeatingValue * 1000.0d0)
AncillaryPowerOutput = CurveValue(MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum, RefFuelUseMdot)
IF (ABS(AncillaryPowerOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(6))//' = '//TRIM(AlphArray(6)))
CALL ShowContinueError('... Curve output at reference conditions should equal 1 (+-10%).')
CALL ShowContinueError('... Reference Electrical Power Output = '// &
TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefElecPowerOutput,2))//' W')
CALL ShowContinueError('... Reference Electrical Efficiency (LHV basis) = '// &
TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefElecEfficiencyLHV,4)))
CALL ShowContinueError('... Fuel Lower Heating Value = '// &
TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%FuelLowerHeatingValue,2))//' kJ/kg')
CALL ShowContinueError('... Calculated fuel flow = '// &
TRIM(TrimSigDigits(RefFuelUseMdot,4))//' kg/s')
CALL ShowContinueError('... Curve output = '// &
TRIM(TrimSigDigits(AncillaryPowerOutput,4)))
END IF
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(6))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
IF (.NOT. lAlphaFieldBlanks(7) ) THEN
MTGenerator(GeneratorNum)%HeatRecInletNodeNum = &
GetOnlySingleNode(AlphArray(7),ErrorsFound,TRIM(cCurrentModuleObject),MTGenerator(GeneratorNum)%Name, &
NodeType_Water,NodeConnectionType_Inlet,1,ObjectIsNotParent)
END IF
IF (.NOT. lAlphaFieldBlanks(8) ) THEN
MTGenerator(GeneratorNum)%HeatRecOutletNodeNum = &
GetOnlySingleNode(AlphArray(8),ErrorsFound,TRIM(cCurrentModuleObject),MTGenerator(GeneratorNum)%Name, &
NodeType_Water,NodeConnectionType_Outlet,1,ObjectIsNotParent)
END IF
IF (MTGenerator(GeneratorNum)%HeatRecInletNodeNum .GT. 0 .AND. &
MTGenerator(GeneratorNum)%HeatRecOutletNodeNum .GT.0) THEN
CALL TestCompSet(TRIM(cCurrentModuleObject),MTGenerator(GeneratorNum)%Name,AlphArray(7),AlphArray(8),'Heat Recovery Nodes')
END IF
IF ( (MTGenerator(GeneratorNum)%HeatRecOutletNodeNum .GT. 0 .AND. MTGenerator(GeneratorNum)%HeatRecInletNodeNum == 0) .OR. &
(MTGenerator(GeneratorNum)%HeatRecOutletNodeNum == 0 .AND. MTGenerator(GeneratorNum)%HeatRecInletNodeNum .GT. 0) ) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... If one Heat Recovery Water Node Name is specified, then both the Inlet and Outlet Heat Recovery')
CALL ShowContinueError('... Water Node Names must be specified. Only one water node is being specified for this generator.')
ErrorsFound=.TRUE.
END IF
! Heat recovery to water input fields only valid if water nodes are defined
IF (MTGenerator(GeneratorNum)%HeatRecInletNodeNum .NE. 0 .AND. &
MTGenerator(GeneratorNum)%HeatRecOutletNodeNum .NE. 0) THEN
MTGenerator(GeneratorNum)%HeatRecActive=.TRUE.
MTGenerator(GeneratorNum)%RefThermalEffLHV = NumArray(12)
IF( MTGenerator(GeneratorNum)%RefThermalEffLHV .LT. 0.0d0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(12))//' must be >= 0.')
CALL ShowContinueError('Resetting to 0 and the simulation continues.')
MTGenerator(GeneratorNum)%RefThermalEffLHV = 0.0d0
END IF
! Next store thermal power output ranges using nominal thermal to electrical efficiency ratio and electrical power data
MTGenerator(GeneratorNum)%RefThermalPowerOutput = MTGenerator(GeneratorNum)%RefElecPowerOutput * &
MTGenerator(GeneratorNum)%RefThermalEffLHV / MTGenerator(GeneratorNum)%RefElecEfficiencyLHV
MTGenerator(GeneratorNum)%MinThermalPowerOutput = MTGenerator(GeneratorNum)%MinElecPowerOutput * &
MTGenerator(GeneratorNum)%RefThermalEffLHV / MTGenerator(GeneratorNum)%RefElecEfficiencyLHV
MTGenerator(GeneratorNum)%MaxThermalPowerOutput = MTGenerator(GeneratorNum)%MaxElecPowerOutput * &
MTGenerator(GeneratorNum)%RefThermalEffLHV / MTGenerator(GeneratorNum)%RefElecEfficiencyLHV
MTGenerator(GeneratorNum)%RefInletWaterTemp = NumArray(13)
IF (SameString(AlphArray(9), 'InternalControl')) THEN
MTGenerator(GeneratorNum)%InternalFlowControl = .TRUE. ! A9, \field Heat Recovery Water Flow Operating Mode
MTGenerator(GeneratorNum)%PlantFlowControl = .FALSE.
END IF
IF ( (.NOT. (SameString(AlphArray(9), 'InternalControl'))) .AND. &
(.NOT. (SameString(AlphArray(9), 'PlantControl'))) ) THEN
CALL ShowSevereError('Invalid '//TRIM(cAlphaFieldNames(9))//'='//TRIM(AlphArray(9)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError('Operating Mode must be INTERNAL CONTROL or PLANT CONTROL.')
ErrorsFound = .TRUE.
END IF
MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate = NumArray(14)
IF(MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate .LE. 0.0d0)THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(14))//'='//TRIM(RoundSigDigits(NumArray(14),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(14))//' must be greater than 0.')
ErrorsFound = .TRUE.
END IF
IF (MTGenerator(GeneratorNum)%InternalFlowControl) THEN ! Get Heat Recovery Water Flow Rate Modifier Curve
MTGenerator(GeneratorNum)%HeatRecFlowFTempPowCurveNum = GetCurveIndex(AlphArray(10))
IF (MTGenerator(GeneratorNum)%HeatRecFlowFTempPowCurveNum .NE. 0) THEN
! Verify curve object, only legal type is BiQuadratic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%HeatRecFlowFTempPowCurveNum))
CASE('BIQUADRATIC')
! NEED TO FIGURE OUT WHAT TO USE FOR Pnet............Shirey
!
! HeatRecFlowFTempPowCurveOutput = CurveValue(MTGenerator(GeneratorNum)%HeatRecFlowFTempPowCurveNum, Pnet)
! IF(ABS(HeatRecFlowFTempPowCurveOutput-1.0d0) .GT. 0.1d0)THEN !
! CALL ShowWarningError('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
! CALL ShowContinueError('Heat Recovery Water Flow Rate Modifier Curve (function of temp and power) = '//TRIM(AlphArray(10)))
! CALL ShowContinueError('... Curve ouput at a reference conditions should equal 1 (+-10%).')
! CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(HeatRecFlowFTempPowCurveOutput,4)))
! END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(10))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%HeatRecFlowFTempPowCurveNum)))
CALL ShowContinueError('Curve type must be BIQUADRATIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
END IF ! End of IF (MTGenerator(GeneratorNum)%InternalFlowControl) THEN
MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum = GetCurveIndex(AlphArray(11)) ! convert curve name to number
IF (MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum .NE. 0) THEN
! Verify curve object, only legal types are BiQuadratic and BiCubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum))
CASE('BIQUADRATIC', 'BICUBIC')
ThermalEffTempElevOutput = CurveValue(MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp, &
MTGenerator(GeneratorNum)%RefElevation)
IF (ABS(ThermalEffTempElevOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(11))//' = ' //TRIM(AlphArray(11)))
CALL ShowContinueError('... Curve output at reference conditions should equal 1 (+-10%).')
CALL ShowContinueError('... Reference combustion air inlet temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefCombustAirInletTemp,4))//' C')
CALL ShowContinueError('... Reference elevation = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefElevation,4))//' m')
CALL ShowContinueError('... Curve output = ' &
//TRIM(TrimSigDigits(ThermalEffTempElevOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(11))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum)))
CALL ShowContinueError('Curve type must be BIQUADRATIC or BICUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum = GetCurveIndex(AlphArray(12)) ! convert curve name to number
IF (MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum .NE. 0) THEN
! Verify curve object, only legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum))
CASE('QUADRATIC', 'CUBIC')
HeatRecRateFPLROutput = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum, 1.0d0)
IF (ABS(HeatRecRateFPLROutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(12))//' = '//TRIM(AlphArray(12)))
CALL ShowContinueError('... Curve output at a part-load ratio of 1 should equal 1 (+-10%).')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(HeatRecRateFPLROutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(12))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC or CUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum = GetCurveIndex(AlphArray(13)) ! convert curve name to number
IF (MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum .NE. 0) THEN
! Verify curve object, only legal type is Quadratic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum))
CASE('QUADRATIC')
HeatRecRateFTempOutput = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum, &
MTGenerator(GeneratorNum)%RefInletWaterTemp)
IF (ABS(HeatRecRateFTempOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(13))//' = ' //TRIM(AlphArray(13)))
CALL ShowContinueError('... Curve output at reference condition should equal 1 (+-10%).')
CALL ShowContinueError('... Reference inlet water temperature temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefInletWaterTemp,4))//' C')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(HeatRecRateFTempOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(13))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum = GetCurveIndex(AlphArray(14))
IF (MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum .NE. 0) THEN
! Verify curve object, only legal type is Quadratic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum))
CASE('QUADRATIC')
HeatRecRateFFlowOutput = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum, &
MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate)
IF (ABS(HeatRecRateFFlowOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(14))//' = ' //TRIM(AlphArray(14)))
CALL ShowContinueError('... Curve output at reference condition should equal 1 (+-10%).')
CALL ShowContinueError('... Reference Heat Recovery Water Flow Rate = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate,4))//' m3/s')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(HeatRecRateFFlowOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(14))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate = NumArray(15)
IF (MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate .LT. 0.0d0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(15))//' must be >= 0.')
CALL ShowContinueError('Resetting to 0 and the simulation continues.')
MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate = 0.0d0
END IF
MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate = NumArray(16)
IF (MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate .LT. 0.0d0)THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(16))//' must be >= 0.')
CALL ShowContinueError('Resetting to 0 and the simulation continues.')
MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate = 0.0d0
END IF
IF (MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate .LT. MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(16))//' must be >= '//TRIM(cNumericFieldNames(15)))
CALL ShowContinueError('Resetting '//TRIM(cNumericFieldNames(16))//' = '//TRIM(cNumericFieldNames(15))// &
' and the simulation continues.')
MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate = MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate
END IF
! Check if reference heat recovery water flow rate is below the minimum flow rate
IF (MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate .LT. MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(14))//' must be >= '//TRIM(cNumericFieldNames(15)))
CALL ShowContinueError('Resetting '//TRIM(cNumericFieldNames(14))//' = '//TRIM(cNumericFieldNames(15))// &
' and the simulation continues.')
MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate = MTGenerator(GeneratorNum)%HeatRecMinVolFlowRate
END IF
! Check if reference heat recovery water flow rate is above the maximum flow rate
IF (MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate .GT. MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cNumericFieldNames(14))//' must be <= '//TRIM(cNumericFieldNames(16)))
CALL ShowContinueError('Resetting '//TRIM(cNumericFieldNames(14))//' = '//TRIM(cNumericFieldNames(16))// &
' and the simulation continues.')
MTGenerator(GeneratorNum)%RefHeatRecVolFlowRate = MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate
END IF
CALL RegisterPlantCompDesignFlow( MTGenerator(GeneratorNum)%HeatRecInletNodeNum ,&
MTGenerator(GeneratorNum)%HeatRecMaxVolFlowRate)
MTGenerator(GeneratorNum)%HeatRecMaxWaterTemp = NumArray(17)
END IF ! End of 'IF (MTGenerator(GeneratorNum)%HeatRecInletNodeNum .NE. 0 .AND. &
! MTGenerator(GeneratorNum)%HeatRecOutletNodeNum .NE. 0) THEN'
IF (.NOT. lAlphaFieldBlanks(15) ) THEN
MTGenerator(GeneratorNum)%CombustionAirInletNodeNum = &
GetOnlySingleNode(AlphArray(15),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Inlet,2,ObjectIsNotParent)
END IF
! Combustion air inlet node must be an outside air node
IF (.NOT. lAlphaFieldBlanks(15) .AND. .not. CheckOutAirNodeNumber(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(15))//' is not a valid Outdoor Air Node = '//TRIM(AlphArray(15)))
CALL ShowContinueError('it does not appear in an OutdoorAir:NodeList or as an OutdoorAir:Node.')
ErrorsFound=.TRUE.
END IF
IF (.NOT. lAlphaFieldBlanks(16)) THEN
MTGenerator(GeneratorNum)%CombustionAirOutletNodeNum = &
GetOnlySingleNode(AlphArray(16),ErrorsFound,TRIM(cCurrentModuleObject),AlphArray(1), &
NodeType_Air,NodeConnectionType_Outlet,2,ObjectIsNotParent)
END IF
IF (MTGenerator(GeneratorNum)%CombustionAirOutletNodeNum .GT. 0 .AND. &
MTGenerator(GeneratorNum)%CombustionAirInletNodeNum == 0) THEN
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('A '//TRIM(cAlphaFieldNames(15))//' must be specified when a '//TRIM(cAlphaFieldNames(16))// &
' is specified.')
ErrorsFound=.TRUE.
END IF
! Get other exhaust air inputs only if combustion air inlet and outlet nodes are valid
IF (MTGenerator(GeneratorNum)%CombustionAirOutletNodeNum .GT. 0 .AND. &
MTGenerator(GeneratorNum)%CombustionAirInletNodeNum .GT. 0) THEN
MTGenerator(GeneratorNum)%ExhAirCalcsActive = .TRUE.
MTGenerator(GeneratorNum)%RefExhaustAirMassFlowRate = NumArray(18)
IF (MTGenerator(GeneratorNum)%RefExhaustAirMassFlowRate .LE. 0.0d0 .AND. &
.NOT. lNumericFieldBlanks(18)) THEN
CALL ShowSevereError('Invalid '//TRIM(cNumericFieldNames(18))//'='//TRIM(RoundSigDigits(NumArray(18),2)))
CALL ShowContinueError('Entered in '//TRIM(cCurrentModuleObject)//'='//TRIM(AlphArray(1)))
CALL ShowContinueError(TRIM(cNumericFieldNames(18))//' must be greater than 0.')
ErrorsFound=.TRUE.
END IF
MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum = GetCurveIndex(AlphArray(17))
IF (MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum .NE. 0) THEN
! Verify curve object, only legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum))
CASE('QUADRATIC', 'CUBIC')
ExhFlowFTempOutput = CurveValue(MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp)
IF (ABS(ExhFlowFTempOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(17))//' = ' //TRIM(AlphArray(17)))
CALL ShowContinueError('... Curve output at reference condition should equal 1 (+-10%).')
CALL ShowContinueError('... Reference combustion air inlet temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefCombustAirInletTemp,4))//' C')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ExhFlowFTempOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(17))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC or CUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum = GetCurveIndex(AlphArray(18)) ! convert curve name to number
IF (MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum .NE. 0) THEN
! Verify curve object, legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum))
CASE('QUADRATIC', 'CUBIC')
ExhFlowFPLROutput = CurveValue(MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum, 1.0d0)
IF (ABS(ExhFlowFPLROutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(18))//' = ' //TRIM(AlphArray(18)))
CALL ShowContinueError('... Curve output at a part-load ratio of 1 should equal 1 (+-10%).')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ExhFlowFPLROutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(18))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC or CUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%NomExhAirOutletTemp = NumArray(19)
MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum = GetCurveIndex(AlphArray(19))
IF (MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum .NE. 0) THEN
! Verify curve object, only legal types are Quadratic and Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum))
CASE('QUADRATIC', 'CUBIC')
ExhAirTempFTempOutput = CurveValue(MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum, &
MTGenerator(GeneratorNum)%RefCombustAirInletTemp)
IF (ABS(ExhAirTempFTempOutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(19))//' = ' //TRIM(AlphArray(19)))
CALL ShowContinueError('... Curve output at reference condition should equal 1 (+-10%).')
CALL ShowContinueError('... Reference combustion air inlet temperature = ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%RefCombustAirInletTemp,4))//' C')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ExhAirTempFTempOutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(19))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC or CUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum = GetCurveIndex(AlphArray(20)) ! convert curve name to number
IF (MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum .NE. 0) THEN
! Verify curve object, legal types are Quadratic or Cubic
SELECT CASE(GetCurveType(MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum))
CASE('QUADRATIC', 'CUBIC')
ExhOutAirTempFPLROutput = CurveValue(MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum, 1.0d0)
IF (ABS(ExhOutAirTempFPLROutput-1.0d0) .GT. 0.1d0) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError(TRIM(cAlphaFieldNames(20))//' = ' //TRIM(AlphArray(20)))
CALL ShowContinueError('... Curve output at a part-load ratio of 1 should equal 1 (+-10%).')
CALL ShowContinueError('... Curve output = '//TRIM(TrimSigDigits(ExhOutAirTempFPLROutput,4)))
END IF
CASE DEFAULT
CALL ShowSevereError(TRIM(cCurrentModuleObject)//' "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... illegal '//TRIM(cAlphaFieldNames(20))//' type'// &
' for this object = '//TRIM(GetCurveType(MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum)))
CALL ShowContinueError('... Curve type must be QUADRATIC or CUBIC.')
ErrorsFound=.TRUE.
END SELECT
END IF
END IF ! End of ' IF (MTGenerator(GeneratorNum)%CombustionAirOutletNodeNum .GT. 0 .AND. &
! MTGenerator(GeneratorNum)%CombustionAirInletNodeNum .GT. 0) THEN
END DO
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in processing input for '//TRIM(cCurrentModuleObject))
END IF
DO GeneratorNum = 1, NumMTGenerators
CALL SetupOutputVariable('Generator Produced Electric Power [W]', &
MTGeneratorReport(GeneratorNum)%PowerGen,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Electric Energy [J]', &
MTGeneratorReport(GeneratorNum)%EnergyGen,'System','Sum',MTGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ElectricityProduced',EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Generator LHV Basis Electric Efficiency []', &
MTGeneratorReport(GeneratorNum)%ElectricEfficiencyLHV,'System','Average',MTGenerator(GeneratorNum)%Name)
! Fuel specific report variables
CALL SetupOutputVariable('Generator '// TRIM(FuelType)//' HHV Basis Rate [W]', &
MTGeneratorReport(GeneratorNum)%FuelEnergyUseRateHHV,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator '// TRIM(FuelType)//' HHV Basis Energy [J]', &
MTGeneratorReport(GeneratorNum)%FuelEnergyHHV,'System','Sum',MTGenerator(GeneratorNum)%Name, &
ResourceTypeKey=FuelType,EndUseKey='COGENERATION',GroupKey='Plant')
CALL SetupOutputVariable('Generator '// TRIM(FuelType)//' Mass Flow Rate [kg/s]', &
MTGeneratorReport(GeneratorNum)%FuelMdot,'System','Average',MTGenerator(GeneratorNum)%Name)
! general fuel use report (to match other generators)
CALL SetupOutputVariable('Generator Fuel HHV Basis Rate [W]', &
MTGeneratorReport(GeneratorNum)%FuelEnergyUseRateHHV,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Fuel HHV Basis Energy [J]', &
MTGeneratorReport(GeneratorNum)%FuelEnergyHHV,'System','Sum',MTGenerator(GeneratorNum)%Name)
! Heat recovery (to water) report variables
IF (MTGenerator(GeneratorNum)%HeatRecActive) THEN
CALL SetupOutputVariable('Generator Produced Thermal Rate [W]', &
MTGeneratorReport(GeneratorNum)%QHeatRecovered,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Produced Thermal Energy [J]', &
MTGeneratorReport(GeneratorNum)%ExhaustEnergyRec,'System','Sum',MTGenerator(GeneratorNum)%Name, &
ResourceTypeKey='ENERGYTRANSFER',EndUseKey='HEATRECOVERY',GroupKey='Plant')
CALL SetupOutputVariable('Generator Thermal Efficiency LHV Basis []', &
MTGeneratorReport(GeneratorNum)%ThermalEfficiencyLHV,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Heat Recovery Inlet Temperature [C]', &
MTGeneratorReport(GeneratorNum)%HeatRecInletTemp,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Heat Recovery Outlet Temperature [C]', &
MTGeneratorReport(GeneratorNum)%HeatRecOutletTemp,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Heat Recovery Water Mass Flow Rate [kg/s]', &
MTGeneratorReport(GeneratorNum)%HeatRecMdot,'System','Average',MTGenerator(GeneratorNum)%Name)
END IF
IF (MTGenerator(GeneratorNum)%StandbyPower .GT. 0.0d0) THEN ! Report Standby Power if entered by user
CALL SetupOutputVariable('Generator Standby Electric Power [W]', &
MTGeneratorReport(GeneratorNum)%StandbyPowerRate,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Standby Electric Energy [J]', &
MTGeneratorReport(GeneratorNum)%StandbyEnergy,'System','Sum',MTGenerator(GeneratorNum)%Name, &
ResourceTypeKey='Electricity',EndUseKey='Cogeneration',GroupKey='Plant')
END IF
IF (MTGenerator(GeneratorNum)%AncillaryPower .GT. 0.0d0) THEN ! Report Ancillary Power if entered by user
CALL SetupOutputVariable('Generator Ancillary Electric Power [W]', &
MTGeneratorReport(GeneratorNum)%AncillaryPowerRate,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Ancillary Electric Energy [J]', &
MTGeneratorReport(GeneratorNum)%AncillaryEnergy,'System','Sum',MTGenerator(GeneratorNum)%Name)
END IF
! Report combustion air outlet conditions if exhaust air calculations are active
IF (MTGenerator(GeneratorNum)%ExhAirCalcsActive) THEN
CALL SetupOutputVariable('Generator Exhaust Air Mass Flow Rate [kg/s]', &
MTGeneratorReport(GeneratorNum)%ExhAirMassFlowRate ,'System','Average',MTGenerator(GeneratorNum)%Name)
CALL SetupOutputVariable('Generator Exhaust Air Temperature [C]', &
MTGeneratorReport(GeneratorNum)%ExhAirTemperature,'System','Average',MTGenerator(GeneratorNum)%Name)
ENDIF
END DO
RETURN
END SUBROUTINE GetMTGeneratorInput