SUBROUTINE CalcMTGeneratorModel(GeneratorNum,Runflag,MyLoad,FirstHVACIteration)
! SUBROUTINE INFORMATION:
! AUTHOR R. Raustad/D. Shirey
! DATE WRITTEN Mar 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Simulate a combustion generator.
! METHODOLOGY EMPLOYED:
! Curve fits of performance data.
! REFERENCES: na
! USE STATEMENTS:
USE DataHVACGlobals, ONLY: FirstTimeStepSysFlag
USE DataEnvironment, ONLY: OutDryBulbTemp, OutHumRat, OutBaroPress, Elevation
USE CurveManager, ONLY: CurveValue
USE Psychrometrics, ONLY: PsyHFnTdbW, PsyCpAirFnWTdb, PsyHfgAirFnWTdb, PsyRhoAirFnPbTdbW
USE General, ONLY: TrimSigDigits
USE FluidProperties, ONLY: GetSpecificHeatGlycol, GetDensityGlycol
USE DataPlant, ONLY: PlantLoop
IMPLICIT NONE
! SUBROUTINE ARGUMENT DEFINITIONS:
REAL(r64), INTENT(IN) :: MyLoad ! Generator demand (W)
INTEGER, INTENT(IN) :: GeneratorNum ! Generator number
LOGICAL, INTENT(IN) :: RunFlag ! TRUE when generator is being asked to operate
LOGICAL, INTENT(IN) :: FirstHVACIteration !unused1208
! SUBROUTINE PARAMETER DEFINITIONS:
REAL(r64), PARAMETER :: KJtoJ = 1000.0d0 ! Convert kilojoules to joules
INTEGER, PARAMETER :: MaxAncPowerIter = 50 ! Maximum number of iteration (subroutine ancillary power iteration loop)
REAL(r64), PARAMETER :: AncPowerDiffToler = 5.0d0 ! Tolerance for Ancillary Power Difference (W)
REAL(r64), PARAMETER :: RelaxFactor = 0.7d0 ! Relaxation factor for iteration loop
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
REAL(r64) :: MinPartLoadRat ! Min allowed operating fraction at full load
REAL(r64) :: MaxPartLoadRat ! Max allowed operating fraction at full load
REAL(r64) :: ReferencePowerOutput ! Generator reference capacity (W)
REAL(r64) :: RefElecEfficiency ! Reference electrical efficiency
REAL(r64) :: OperatingElecEfficiency ! Actual operating efficiency
REAL(r64) :: ElecEfficiencyFTemp ! Electrical efficiency as a function of temperature curve output
REAL(r64) :: ElecEfficiencyFPLR ! Electrical efficiency as a function of PLR curve output
REAL(r64) :: ThermalEffFTempElev ! Thermal efficiency as a function of air temperature and elevation
REAL(r64) :: PLR ! Generator operating part load ratio
REAL(r64) :: PowerFTempElev ! Power ratio as a function of inlet air temperature and elevation
REAL(r64) :: CombustionAirInletTemp ! Combustion air inlet temperature (C)
REAL(r64) :: CombustionAirInletPress ! Barometric pressure of combustion inlet air (Pa)
REAL(r64) :: CombustionAirInletW ! Combustion air inlet humidity ratio (kg/kg)
REAL(r64) :: ExhFlowFTemp ! Exhaust air flow rate as a function of temperature curve output
REAL(r64) :: ExhFlowFPLR ! Exhaust air flow rate as a function of part-load ratio curve output
REAL(r64) :: ExhAirMassFlowRate ! Actual exhaust air mass flow rate (accounting for temp and PLR modifier curves)
REAL(r64) :: ExhAirTempFTemp ! Exhaust air temperature as a function of inlet air temp curve output
REAL(r64) :: ExhAirTempFPLR ! Exhaust air temperature as a function of part-load ratio curve output
REAL(r64) :: ExhaustAirTemp ! Actual exhaust air temperature (accounting for temp and PLR modifier curves)
REAL(r64) :: CpAir ! Heat capacity of air (J/kg-C)
REAL(r64) :: H2OHtOfVap ! Heat of vaporization of water (J/kg)
REAL(r64) :: ActualElevation ! Actual elevation of the microturbine (m)
REAL(r64) :: AirDensity ! Density of air at actual combustion inlet air conditions (kg/m3)
REAL(r64) :: ElecPowerGenerated ! Generator electric power output (W)
REAL(r64) :: FullLoadPowerOutput ! Generator full-load power output at actual inlet conditions and elevation (W)
REAL(r64) :: FuelUseEnergyRateLHV ! Rate of fuel energy required to run microturbine, LHV basis (W)
REAL(r64) :: QHeatRecToWater ! Recovered waste heat to water (W)
REAL(r64) :: MinHeatRecMdot ! Heat recovery flow rate if minimal heat recovery is accomplished (kg/s)
INTEGER :: HeatRecInNode ! Heat recovery fluid inlet node number
REAL(r64) :: HeatRecInTemp ! Heat recovery fluid inlet temperature (C)
REAL(r64) :: HeatRecOutTemp ! Heat recovery fluid outlet temperature (C)
REAL(r64) :: HeatRecMdot ! Heat recovery fluid mass flow rate (kg/s)
REAL(r64) :: HeatRecVolFlowRate ! Heat recovery fluid flow rate (m3/s)
REAL(r64) :: HeatRecCp ! Specific heat of the heat recovery fluid (J/kg-K)
REAL(r64) :: HeatRecRateFPLR ! Heat recovery rate as a function of PLR curve output
REAL(r64) :: HeatRecRateFTemp ! Heat recovery rate as a function of inlet water temp curve output
REAL(r64) :: HeatRecRateFFlow ! Heat recovery rate as a function of water flow rate curve output
REAL(r64) :: FuelHigherHeatingValue ! Higher heating value (HHV) of fuel (kJ/kg)
REAL(r64) :: FuelLowerHeatingValue ! Lower heating value (LLV) of fuel kJ/kg)
REAL(r64) :: HRecRatio ! When maximum temperature is reached the amount of recovered heat has to be reduced
REAL(r64) :: AncillaryPowerRate ! Ancillary power used by pump (if not specified in manufacturers data)
REAL(r64) :: AncillaryPowerRateLast ! Ancillary power used by pump from last iteration (iteration loop within this subroutine)
REAL(r64) :: AncillaryPowerRateDiff ! Difference between ancillary power rate and ancillary power rate last (last iteration)
REAL(r64) :: AnciPowerFMdotFuel ! Ancillary power as a function of fuel flow curve output
INTEGER :: AncPowerCalcIterIndex ! Index for subroutine iteration loop if Ancillary Power (function of fuel flow) is used
REAL(r64) :: rho ! local fluid density
! Load local variables from data structure (for code readability)
MinPartLoadRat = MTGenerator(GeneratorNum)%MinPartLoadRat
MaxPartLoadRat = MTGenerator(GeneratorNum)%MaxPartLoadRat
ReferencePowerOutput = MTGenerator(GeneratorNum)%RefElecPowerOutput
RefElecEfficiency = MTGenerator(GeneratorNum)%RefElecEfficiencyLHV
! Initialize variables
MTGenerator(GeneratorNum)%ElecPowerGenerated = 0.0d0
MTGenerator(GeneratorNum)%HeatRecInletTemp = 0.0d0
MTGenerator(GeneratorNum)%HeatRecOutletTemp = 0.0d0
MTGenerator(GeneratorNum)%HeatRecMdot = 0.0d0
MTGenerator(GeneratorNum)%QHeatRecovered = 0.0d0
MTGenerator(GeneratorNum)%ExhaustEnergyRec = 0.0d0
MTGenerator(GeneratorNum)%FuelEnergyUseRateHHV = 0.0d0
MTGenerator(GeneratorNum)%FuelMdot = 0.0d0
MTGenerator(GeneratorNum)%AncillaryPowerRate = 0.0d0
MTGenerator(GeneratorNum)%StandbyPowerRate = 0.0d0
MTGenerator(GeneratorNum)%FuelEnergyUseRateLHV = 0.0d0
MTGenerator(GeneratorNum)%ExhaustAirMassFlowRate = 0.0d0
MTGenerator(GeneratorNum)%ExhaustAirTemperature = 0.0d0
MTGenerator(GeneratorNum)%ExhaustAirHumRat = 0.0d0
ExhAirTempFTemp = 0.0d0
QHeatRecToWater = 0.0d0
IF (MTGenerator(GeneratorNum)%HeatRecActive) THEN
HeatRecInNode = MTGenerator(GeneratorNum)%HeatRecInletNodeNum
HeatRecInTemp = Node(HeatRecInNode)%Temp
HeatRecCp = GetSpecificHeatGlycol(PlantLoop(MTGenerator(GeneratorNum)%HRLoopNum)%FluidName, &
HeatRecInTemp, &
PlantLoop(MTGenerator(GeneratorNum)%HRLoopNum)%FluidIndex, &
'CalcMTGeneratorModel')
HeatRecMdot = Node(HeatRecInNode)%MassFlowRate
ELSE
HeatRecInTemp=0.0d0
HeatRecCp=0.0d0
HeatRecMdot=0.0d0
END IF
! Set combustion inlet air temperature, humidity ratio and pressure local variables
IF (MTGenerator(GeneratorNum)%CombustionAirInletNodeNum == 0) THEN ! no inlet air node specified, so use weather file values
CombustionAirInletTemp = OutDryBulbTemp
CombustionAirInletW = OutHumRat
CombustionAirInletPress = OutBaroPress
ActualElevation = Elevation ! from DataEnvironment
ELSE ! use inlet node information
CombustionAirInletTemp = Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)%Temp
CombustionAirInletW = Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)%HumRat
CombustionAirInletPress = Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)%Press
ActualElevation = Elevation ! from DataEnvironment
IF (Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)%Height .GT. 0.0d0) THEN
ActualElevation = Elevation + Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)%Height
END IF
! Initialize combustion outlet air conditions to inlet air conditions (all node properties)
IF (MTGenerator(GeneratorNum)%ExhAirCalcsActive) THEN
Node(MTGenerator(GeneratorNum)%CombustionAirOutletNodeNum) = Node(MTGenerator(GeneratorNum)%CombustionAirInletNodeNum)
END IF
END IF
! If no loop demand or generator OFF, set some variables and then return
! IF (.NOT. Runflag .OR. MyLoad .LE. 0.0d0) THEN
IF (MyLoad .LE. 0.0d0) THEN
MTGenerator(GeneratorNum)%HeatRecInletTemp = HeatRecInTemp
MTGenerator(GeneratorNum)%HeatRecOutletTemp = HeatRecInTemp
IF (Runflag) THEN
MTGenerator(GeneratorNum)%StandbyPowerRate = MTGenerator(GeneratorNum)%StandbyPower
END IF
MTGenerator(GeneratorNum)%ExhaustAirTemperature = CombustionAirInletTemp
MTGenerator(GeneratorNum)%ExhaustAirHumRat = CombustionAirInletW
RETURN
END IF
! Calculate power modifier curve value (function of inlet air temperature and elevation)
PowerFTempElev = CurveValue(MTGenerator(GeneratorNum)%ElecPowFTempElevCurveNum, CombustionAirInletTemp, Elevation)
! Warn user if power modifier curve output is less than 0
IF (PowerFTempElev .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%PowerFTempElevErrorIndex == 0) THEN
! MTGenerator(GeneratorNum)%PowerFTempElevErrorCount = MTGenerator(GeneratorNum)%PowerFTempElevErrorCount + 1
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Electrical Power Modifier curve (function of temperature and elevation) output is '// &
'less than zero ('//TRIM(TrimSigDigits(PowerFTempElev,4))//').')
CALL ShowContinueError('... Value occurs using a combustion inlet air temperature of ' &
//TRIM(TrimSigDigits(CombustionAirInletTemp,2))//' C.')
CALL ShowContinueError('... and an elevation of '//TRIM(TrimSigDigits(Elevation,2))//' m.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Electrical Power Modifier curve is less than zero warning continues...' &
, MTGenerator(GeneratorNum)%PowerFTempElevErrorIndex, PowerFTempElev, PowerFTempElev)
PowerFTempElev = 0.0d0
END IF
! Calculate available full-load power output. cannot exceed maximum full-load power output.
FullLoadPowerOutput = MIN((ReferencePowerOutput * PowerFTempElev),MTGenerator(GeneratorNum)%MaxElecPowerOutput)
! Also can't be below the minimum full-load power output.
FullLoadPowerOutput = MAX(FullLoadPowerOutput,MTGenerator(GeneratorNum)%MinElecPowerOutput)
AncillaryPowerRate = MTGenerator(GeneratorNum)%AncillaryPower
AncillaryPowerRateLast = AncillaryPowerRate
AncillaryPowerRateDiff = AncPowerDiffToler + 1.0d0 ! Initialize to force through DO WHILE Loop at least once
AncPowerCalcIterIndex = 0 ! Initialize iteration index (counter)
DO WHILE (AncillaryPowerRateDiff .GT. AncPowerDiffToler .AND. AncPowerCalcIterIndex .LE. MaxAncPowerIter)
AncPowerCalcIterIndex = AncPowerCalcIterIndex + 1 ! Increment iteration loop counter
! Calculate operating power output (gross)
ElecPowerGenerated = MIN( MAX(0.0d0,MyLoad + AncillaryPowerRate), FullLoadPowerOutput )
! Calculate PLR, but must be between the minPLR and maxPLR
IF (FullLoadPowerOutput .GT. 0.0d0) THEN
PLR = MIN(ElecPowerGenerated/FullLoadPowerOutput, MaxPartLoadRat)
PLR = MAX(PLR, MinPartLoadRat)
ELSE
PLR = 0.0d0
END IF
! Recalculate ElecPowerGenerated based on "final" PLR
ElecPowerGenerated = FullLoadPowerOutput * PLR
! Calculate electrical efficiency modifier curve output (function of temp)
ElecEfficiencyFTemp = CurveValue(MTGenerator(GeneratorNum)%ElecEffFTempCurveNum, CombustionAirInletTemp)
! Warn user if efficiency modifier curve output is less than 0
IF (ElecEfficiencyFTemp .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%EffFTempErrorIndex == 0) THEN
! MTGenerator(GeneratorNum)%EffFTempErrorCount = MTGenerator(GeneratorNum)%EffFTempErrorCount + 1
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Electrical Efficiency Modifier (function of temperature) output is less than ' &
//'zero ('//TRIM(TrimSigDigits(ElecEfficiencyFTemp,4))//').')
CALL ShowContinueError('... Value occurs using a combustion inlet air temperature of ' &
//TRIM(TrimSigDigits(CombustionAirInletTemp,2))//' C.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Electrical Efficiency Modifier (function of temperature) output is less than zero warning continues...' &
, MTGenerator(GeneratorNum)%EffFTempErrorIndex, ElecEfficiencyFTemp, ElecEfficiencyFTemp)
ElecEfficiencyFTemp = 0.0d0
END IF
! Calculate efficiency modifier curve output (function of PLR)
ElecEfficiencyFPLR = CurveValue(MTGenerator(GeneratorNum)%ElecEffFPLRCurveNum, PLR)
! Warn user if efficiency modifier curve output is less than 0
IF (ElecEfficiencyFPLR .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%EffFPLRErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Electrical Efficiency Modifier (function of part-load ratio) output is less than'// &
' zero ('//TRIM(TrimSigDigits(ElecEfficiencyFPLR,4))//').')
CALL ShowContinueError('... Value occurs using a part-load ratio of ' &
//TRIM(TrimSigDigits(PLR,3))//'.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Electrical Efficiency Modifier (function of part-load ratio) output is less than zero warning'// &
' continues...', MTGenerator(GeneratorNum)%EffFPLRErrorIndex, ElecEfficiencyFPLR, ElecEfficiencyFPLR)
ElecEfficiencyFPLR = 0.0d0
END IF
! Calculate operating electrical efficiency
OperatingElecEfficiency = RefElecEfficiency * ElecEfficiencyFTemp * ElecEfficiencyFPLR
! Calculate fuel use (W = J/s), LHV basis
IF (OperatingElecEfficiency .GT. 0.0d0) THEN
FuelUseEnergyRateLHV = ElecPowerGenerated / OperatingElecEfficiency
ELSE
FuelUseEnergyRateLHV = 0.0d0 ! If fuel use rate is zero, then
ElecPowerGenerated = 0.0d0 ! electric power generated must be zero.
END IF
! Set fuel heating values
FuelHigherHeatingValue = MTGenerator(GeneratorNum)%FuelHigherHeatingValue
FuelLowerHeatingValue = MTGenerator(GeneratorNum)%FuelLowerHeatingValue
! Calculate fuel mass flow rate
MTGenerator(GeneratorNum)%FuelMdot = FuelUseEnergyRateLHV / (FuelLowerHeatingValue * KJtoJ)
! Calculate ancillary power requirement
IF (MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum .GT. 0) THEN
AnciPowerFMdotFuel = CurveValue(MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum, MTGenerator(GeneratorNum)%FuelMdot)
! Warn user if ancillary power modifier curve output is less than 0
IF (AnciPowerFMdotFuel .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%AnciPowerFMdotFuelErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Ancillary Power Modifier (function of fuel input) output is less than'// &
' zero ('//TRIM(TrimSigDigits(AnciPowerFMdotFuel,4))//').')
CALL ShowContinueError('... Value occurs using a fuel input mass flow rate of ' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%FuelMdot,4))//' kg/s.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Ancillary Power Modifier (function of fuel input) output is less than zero warning'// &
' continues...', MTGenerator(GeneratorNum)%AnciPowerFMdotFuelErrorIndex, AnciPowerFMdotFuel, AnciPowerFMdotFuel)
AnciPowerFMdotFuel = 0.0d0
END IF
ELSE
AnciPowerFMdotFuel = 1.0d0
END IF
AncillaryPowerRateLast = AncillaryPowerRate
IF (MTGenerator(GeneratorNum)%AncillaryPowerFuelCurveNum .GT. 0) THEN
AncillaryPowerRate = RelaxFactor * MTGenerator(GeneratorNum)%AncillaryPower * AnciPowerFMdotFuel - &
(1.0d0 - RelaxFactor) * AncillaryPowerRateLast
END IF
AncillaryPowerRateDiff = ABS(AncillaryPowerRate - AncillaryPowerRateLast)
END DO
IF (AncPowerCalcIterIndex .GT. MaxAncPowerIter) THEN
IF (MTGenerator(GeneratorNum)%AnciPowerIterErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Iteration loop for electric power generation is not converging within tolerance.')
CALL ShowContinueError('... Check the Ancillary Power Modifier Curve (function of fuel input).')
CALL ShowContinueError('... Ancillary Power = '//TRIM(TrimSigDigits(AncillaryPowerRate,1))//' W.')
CALL ShowContinueError('... Fuel input rate = '//TRIM(TrimSigDigits(AnciPowerFMdotFuel,4))//' kg/s.')
CALL ShowContinueErrorTimeStamp('... Simulation will continue.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Iteration loop for electric power generation is not converging within tolerance continues...', &
MTGenerator(GeneratorNum)%AnciPowerIterErrorIndex)
END IF
! Calculate electrical power generated
MTGenerator(GeneratorNum)%ElecPowerGenerated = ElecPowerGenerated - AncillaryPowerRate
! Report fuel energy use rate on HHV basis, which is the unit of measure when the fuel is sold
MTGenerator(GeneratorNum)%FuelEnergyUseRateHHV = MTGenerator(GeneratorNum)%FuelMdot * FuelHigherHeatingValue * KJtoJ
MTGenerator(GeneratorNum)%AncillaryPowerRate = AncillaryPowerRate ! Move to data structure for later reporting
MTGenerator(GeneratorNum)%FuelEnergyUseRateLHV = FuelUseEnergyRateLHV ! Move to data structure for reporting calculations
! When generator operates, standby losses are 0
MTGenerator(GeneratorNum)%StandbyPowerRate = 0.0d0
! Calculate heat recovery if active
IF (MTGenerator(GeneratorNum)%HeatRecActive) THEN
IF (MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum .GT. 0) THEN
ThermalEffFTempElev = CurveValue(MTGenerator(GeneratorNum)%ThermEffFTempElevCurveNum, CombustionAirInletTemp, Elevation)
! Warn user if power modifier curve output is less than 0
IF (ThermalEffFTempElev .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%ThermEffFTempElevErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Electrical Power Modifier curve (function of temperature and elevation) output is '// &
'less than zero ('//TRIM(TrimSigDigits(PowerFTempElev,4))//').')
CALL ShowContinueError('... Value occurs using a combustion inlet air temperature of ' &
//TRIM(TrimSigDigits(CombustionAirInletTemp,2))//' C.')
CALL ShowContinueError('... and an elevation of '//TRIM(TrimSigDigits(Elevation,2))//' m.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Electrical Power Modifier curve is less than zero warning continues...' &
, MTGenerator(GeneratorNum)%ThermEffFTempElevErrorIndex, ThermalEffFTempElev, ThermalEffFTempElev)
ThermalEffFTempElev = 0.0d0
END IF
ELSE
ThermalEffFTempElev = 1.0d0 ! If no curve provided, assume multiplier factor = 1.0
END IF
QHeatRecToWater = FuelUseEnergyRateLHV * MTGenerator(GeneratorNum)%RefThermalEffLHV * ThermalEffFTempElev
! Calculate heat recovery rate modifier curve output (function of PLR)
IF (MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum .GT. 0) THEN
HeatRecRateFPLR = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFPLRCurveNum, PLR)
! Warn user if heat recovery modifier curve output is less than 0
IF (HeatRecRateFPLR .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%HeatRecRateFPLRErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Heat Recovery Rate Modifier (function of part-load ratio) output is less than'// &
' zero ('//TRIM(TrimSigDigits(HeatRecRateFPLR,4))//').')
CALL ShowContinueError('... Value occurs using a part-load ratio of ' &
//TRIM(TrimSigDigits(PLR,3))//'.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Heat Recovery Rate Modifier (function of part-load ratio) output is less than zero warning'// &
' continues...', MTGenerator(GeneratorNum)%HeatRecRateFPLRErrorIndex, HeatRecRateFPLR, HeatRecRateFPLR)
HeatRecRateFPLR = 0.0d0
END IF
ELSE
HeatRecRateFPLR = 1.0d0 ! If no curve provided, assume multiplier factor = 1.0
END IF
! Calculate heat recovery rate modifier curve output (function of inlet water temp)
IF (MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum .GT. 0) THEN
HeatRecRateFTemp = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFTempCurveNum, HeatRecInTemp)
IF (HeatRecRateFTemp .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%HeatRecRateFTempErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Heat Recovery Rate Modifier (function of inlet water temp) output is less than ' &
//'zero ('//TRIM(TrimSigDigits(HeatRecRateFTemp,4))//').')
CALL ShowContinueError('... Value occurs using an inlet water temperature temperature of ' &
//TRIM(TrimSigDigits(HeatRecInTemp,2))//' C.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Heat Recovery Rate Modifier (function of inlet water temp) output is less than zero warning continues...' &
, MTGenerator(GeneratorNum)%HeatRecRateFTempErrorIndex, HeatRecRateFTemp, HeatRecRateFTemp)
HeatRecRateFTemp = 0.0d0
END IF
ELSE
HeatRecRateFTemp = 1.0d0 ! If no curve provided, assume multiplier factor = 1.0
END IF
! Calculate heat recovery rate modifier curve output (function of water [volumetric] flow rate)
IF (MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum .GT. 0) THEN
rho = GetDensityGlycol(PlantLoop(MTGenerator(GeneratorNum)%HRLoopNum)%FluidName, &
HeatRecInTemp, &
PlantLoop(MTGenerator(GeneratorNum)%HRLoopNum)%FluidIndex, &
'CalcMTGeneratorModel')
HeatRecVolFlowRate = HeatRecMdot / rho
HeatRecRateFFlow = CurveValue(MTGenerator(GeneratorNum)%HeatRecRateFWaterFlowCurveNum,HeatRecVolFlowRate)
IF (HeatRecRateFFlow .LT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%HeatRecRateFFlowErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('... Heat Recovery Rate Modifier (function of water flow rate) output is less than ' &
//'zero ('//TRIM(TrimSigDigits(HeatRecRateFFlow,4))//').')
CALL ShowContinueError('... Value occurs using a water flow rate of ' &
//TRIM(TrimSigDigits(HeatRecVolFlowRate,4))//' m3/s.')
CALL ShowContinueErrorTimeStamp('... Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Heat Recovery Rate Modifier (function of water flow rate) output is less than zero warning continues...' &
, MTGenerator(GeneratorNum)%HeatRecRateFFlowErrorIndex, HeatRecRateFFlow, HeatRecRateFFlow)
HeatRecRateFFlow = 0.0d0
END IF
ELSE
HeatRecRateFFlow = 1.0d0 ! If no curve provided, assume multiplier factor = 1.0
END IF
QHeatRecToWater = QHeatRecToWater * HeatRecRateFPLR * HeatRecRateFTemp * HeatRecRateFFlow
! Check for divide by zero
IF ((HeatRecMdot .GT. 0.0d0) .AND. (HeatRecCp .GT. 0.0d0)) THEN
HeatRecOutTemp = HeatRecInTemp + QHeatRecToWater/ (HeatRecMdot * HeatRecCp)
ELSE
HeatRecMdot = 0.0d0
HeatRecOutTemp = HeatRecInTemp
QHeatRecToWater = 0.0d0
END IF
! Now verify the maximum heat recovery temperature was not exceeded
HRecRatio = 1.0d0
MinHeatRecMdot=0.0d0
IF (HeatRecOutTemp > MTGenerator(GeneratorNum)%HeatRecMaxWaterTemp) THEN
IF (MTGenerator(GeneratorNum)%HeatRecMaxWaterTemp /= HeatRecInTemp) THEN
MinHeatRecMdot = QHeatRecToWater/(HeatRecCp * (MTGenerator(GeneratorNum)%HeatRecMaxWaterTemp - HeatRecInTemp))
IF (MinHeatRecMdot < 0.0d0) MinHeatRecMdot = 0.0d0
END IF
! Recalculate outlet water temperature with minimum flow rate (will normally match the max water outlet temp,
! unless the inlet water temp is greater than the max outlet temp)
IF ((MinHeatRecMdot .GT. 0.0d0) .AND. (HeatRecCp .GT. 0.0d0)) THEN
HeatRecOutTemp = QHeatRecToWater/(MinHeatRecMdot * HeatRecCp) + HeatRecInTemp
HRecRatio = HeatRecMdot/MinHeatRecMdot
ELSE
HeatRecOutTemp = HeatRecInTemp
HRecRatio = 0.0d0
END IF
QHeatRecToWater = QHeatRecToWater*HRecRatio ! Scale heat recovery rate using HRecRatio. Don't adjust flow rate.
END IF
! Check water mass flow rate against minimum
IF (MTGenerator(GeneratorNum)%HeatRecMinMassFlowRate .GT. HeatRecMdot .AND. HeatRecMdot .GT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%HRMinFlowErrorIndex == 0) THEN
CALL ShowWarningError('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Heat reclaim water flow rate is below the generators minimum mass flow rate of (' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%HeatRecMinMassFlowRate,4))//').')
CALL ShowContinueError('...Heat reclaim water mass flow rate = '//TRIM(TrimSigDigits(HeatRecMdot,4))//'.')
CALL ShowContinueErrorTimeStamp('...Check inputs for heat recovery water flow rate.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Heat recovery water flow rate is below the generators minimum mass flow rate warning continues...' &
, MTGenerator(GeneratorNum)%HRMinFlowErrorIndex, HeatRecMdot, HeatRecMdot)
END IF
! Check water mass flow rate against maximum
IF (HeatRecMdot .GT. MTGenerator(GeneratorNum)%HeatRecMaxMassFlowRate .AND. HeatRecMdot .GT. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%HRMaxFlowErrorIndex == 0) THEN
CALL ShowWarningError('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Heat reclaim water flow rate is above the generators maximum mass flow rate of (' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%HeatRecMaxMassFlowRate,4))//').')
CALL ShowContinueError('...Heat reclaim water mass flow rate = '//TRIM(TrimSigDigits(HeatRecMdot,4))//'.')
CALL ShowContinueErrorTimeStamp('...Check inputs for heat recovery water flow rate.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Heat recovery water flow rate is above the generators maximum mass flow rate warning continues...' &
, MTGenerator(GeneratorNum)%HRMaxFlowErrorIndex, HeatRecMdot, HeatRecMdot)
END IF
! Set report variables
MTGenerator(GeneratorNum)%HeatRecInletTemp = HeatRecInTemp
MTGenerator(GeneratorNum)%HeatRecOutletTemp = HeatRecOutTemp
MTGenerator(GeneratorNum)%HeatRecMdot = HeatRecMdot
MTGenerator(GeneratorNum)%QHeatRecovered = QHeatRecToWater
END IF ! End of IF (MTGenerator(GeneratorNum)%HeatRecActive) THEN
! Calculate combustion air outlet conditions if exhaust air calculations are active
IF (MTGenerator(GeneratorNum)%ExhAirCalcsActive) THEN
IF (MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum .NE. 0) THEN ! Exhaust Flow Rate versus Inlet Air Temp
ExhFlowFTemp = CurveValue(MTGenerator(GeneratorNum)%ExhFlowFTempCurveNum,CombustionAirInletTemp)
! Warn user if exhaust modifier curve output is less than or equal to 0
IF (ExhFlowFTemp .LE. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%ExhFlowFTempErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Exhaust Air Flow Rate Modifier (function of temperature) output is less than or equal '&
//'to zero ('//TRIM(TrimSigDigits(ExhFlowFTemp,4))//').')
CALL ShowContinueError('...Value occurs using a combustion inlet air temperature of ' &
//TRIM(TrimSigDigits(CombustionAirInletTemp,2))//'.')
CALL ShowContinueErrorTimeStamp('...Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Exhaust Air Flow Rate Modifier (function of temperature) output is less than or equal to zero warning continues...'&
, MTGenerator(GeneratorNum)%ExhFlowFTempErrorIndex, ExhFlowFTemp, ExhFlowFTemp)
ExhFlowFTemp = 0.0d0
END IF
ELSE
ExhFlowFTemp = 1.0d0 ! No curve input means modifier = 1.0 always
END IF
IF (MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum .NE. 0) THEN ! Exhaust Flow Rate versus Part-Load Ratio
ExhFlowFPLR = CurveValue(MTGenerator(GeneratorNum)%ExhFlowFPLRCurveNum,PLR)
! Warn user if exhaust modifier curve output is less than or equal to 0
IF (ExhFlowFPLR .LE. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%ExhFlowFPLRErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Exhaust Air Flow Rate Modifier (function of part-load ratio) output is less than or '&
//'equal to zero ('//TRIM(TrimSigDigits(ExhFlowFPLR,4))//').')
CALL ShowContinueError('...Value occurs using a part-load ratio of ' &
//TRIM(TrimSigDigits(PLR,2))//'.')
CALL ShowContinueErrorTimeStamp('...Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Exhaust Air Flow Rate Modifier (function of part-load ratio) output is less than or equal to zero warning'&
//' continues...', MTGenerator(GeneratorNum)%ExhFlowFPLRErrorIndex, ExhFlowFPLR, ExhFlowFPLR)
ExhFlowFPLR = 0.0d0
END IF
ELSE
ExhFlowFPLR = 1.0d0 ! No curve input means modifier = 1.0 always
END IF
! Calculate exhaust air mass flow, accounting for temperature and PLR modifier factors
ExhAirMassFlowRate = MTGenerator(GeneratorNum)%RefExhaustAirMassFlowRate * ExhFlowFTemp * ExhFlowFPLR
! Adjust for difference in air density at reference conditions versus actual inlet air conditions
AirDensity = PsyRhoAirFnPbTdbW(CombustionAirInletPress,CombustionAirInletTemp,CombustionAirInletW)
IF (MTGenerator(GeneratorNum)%RefCombustAirInletDensity .GE. 0.0d0) THEN
ExhAirMassFlowRate = MAX(0.0d0,ExhAirMassFlowRate*AirDensity/MTGenerator(GeneratorNum)%RefCombustAirInletDensity)
ELSE
ExhAirMassFlowRate = 0.0d0
END IF
MTGenerator(GeneratorNum)%ExhaustAirMassFlowRate = ExhAirMassFlowRate
IF (MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum .NE. 0) THEN ! Exhaust Air Temp versus Inlet Air Temp
ExhAirTempFTemp = CurveValue(MTGenerator(GeneratorNum)%ExhAirTempFTempCurveNum,CombustionAirInletTemp)
! Warn user if exhaust modifier curve output is less than or equal to 0
IF (ExhAirTempFTemp .LE. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%ExhTempFTempErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Exhaust Air Temperature Modifier (function of temperature) output is less than or equal '&
//'to zero ('//TRIM(TrimSigDigits(ExhAirTempFTemp,4))//').')
CALL ShowContinueError('...Value occurs using a combustion inlet air temperature of ' &
//TRIM(TrimSigDigits(CombustionAirInletTemp,2))//'.')
CALL ShowContinueErrorTimeStamp('...Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Exhaust Air Temperature Modifier (function of temperature) output is less than or equal to zero'//&
' warning continues...', MTGenerator(GeneratorNum)%ExhTempFTempErrorIndex, ExhAirTempFTemp, ExhAirTempFTemp)
ExhAirTempFTemp = 0.0d0
END IF
ELSE
ExhAirTempFTemp = 1.0d0 ! No curve input means modifier = 1.0 always
END IF
IF (MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum .NE. 0) THEN ! Exhaust Air Temp versus Part-Load Ratio
ExhAirTempFPLR = CurveValue(MTGenerator(GeneratorNum)%ExhAirTempFPLRCurveNum,PLR)
! Warn user if exhaust modifier curve output is less than or equal to 0
IF (ExhAirTempFPLR .LE. 0.0d0) THEN
IF (MTGenerator(GeneratorNum)%ExhTempFPLRErrorIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...Exhaust Air Temperature Modifier (function of part-load ratio) output is less than or '&
//'equal to zero ('//TRIM(TrimSigDigits(ExhAirTempFPLR,4))//').')
CALL ShowContinueError('...Value occurs using a part-load ratio of ' &
//TRIM(TrimSigDigits(PLR,2))//'.')
CALL ShowContinueErrorTimeStamp('...Resetting curve output to zero and continuing simulation.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'//&
' Exhaust Air Temperature Modifier (function of part-load ratio) output is less than or equal to zero warning' &
//' continues...', MTGenerator(GeneratorNum)%ExhTempFPLRErrorIndex, ExhAirTempFPLR, ExhAirTempFPLR)
ExhAirTempFPLR = 0.0d0
END IF
ELSE
ExhAirTempFPLR = 1.0d0 ! No curve input means modifier = 1.0 always
END IF
IF (ExhAirMassFlowRate .LE. 0.0d0) THEN
MTGenerator(GeneratorNum)%ExhaustAirTemperature = CombustionAirInletTemp
MTGenerator(GeneratorNum)%ExhaustAirHumRat = CombustionAirInletW
ELSE
! Calculate exhaust air temperature, accounting for inlet air temperature and PLR modifier factors
ExhaustAirTemp = MTGenerator(GeneratorNum)%NomExhAirOutletTemp * ExhAirTempFTemp * ExhAirTempFPLR
MTGenerator(GeneratorNum)%ExhaustAirTemperature = ExhaustAirTemp
! Adjust exhaust air temperature if heat recovery to water is being done
IF (QHeatRecToWater .GT. 0.0d0) THEN
CpAir = PsyCpAirFnWTdb(CombustionAirInletW,CombustionAirInletTemp)
IF (CpAir .GT. 0.0d0) THEN
MTGenerator(GeneratorNum)%ExhaustAirTemperature = ExhaustAirTemp - QHeatRecToWater / (CpAir * ExhAirMassFlowRate)
END IF
END IF
! Calculate exhaust air humidity ratio
H2OHtOfVap = PsyHfgAirFnWTdb(1.0d0,16.0d0,'CalcMTGeneratorModel') ! W not used, passing 1.0 as dummy.
! Assume fuel is at 16C (ASHRAE HOF)
IF (H2OHtOfVap .GT. 0.0d0) THEN
MTGenerator(GeneratorNum)%ExhaustAirHumRat = CombustionAirInletW + MTGenerator(GeneratorNum)%FuelMdot * &
((FuelHigherHeatingValue-FuelLowerHeatingValue)*KJtoJ/H2OHtOfVap) / &
ExhAirMassFlowRate
ELSE
MTGenerator(GeneratorNum)%ExhaustAirHumRat = CombustionAirInletW
END IF
END IF
IF (MTGenerator(GeneratorNum)%ExhaustAirTemperature .LT. CombustionAirInletTemp) THEN
IF (MTGenerator(GeneratorNum)%ExhTempLTInletTempIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...The model has calculated the exhaust air temperature to be less than '&
//'the combustion air inlet temperature.')
CALL ShowContinueError('...Value of exhaust air temperature =' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%ExhaustAirTemperature,4))//' C.')
CALL ShowContinueError('...Value of combustion air inlet temp ='//TRIM(TrimSigDigits(CombustionAirInletTemp,4))//' C.')
CALL ShowContinueErrorTimeStamp('... Simulation will continue.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'// &
' Exhaust air temperature less than combustion air inlet temperature warning continues...', &
MTGenerator(GeneratorNum)%ExhTempLTInletTempIndex, MTGenerator(GeneratorNum)%ExhaustAirTemperature, &
MTGenerator(GeneratorNum)%ExhaustAirTemperature)
END IF
IF (MTGenerator(GeneratorNum)%ExhaustAirHumRat .LT. CombustionAirInletW) THEN
IF (MTGenerator(GeneratorNum)%ExhHRLTInletHRIndex == 0) THEN
CALL ShowWarningMessage('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'"')
CALL ShowContinueError('...The model has calculated the exhaust air humidity ratio to be less than '&
//'the combustion air inlet humidity ratio.')
CALL ShowContinueError('...Value of exhaust air humidity ratio =' &
//TRIM(TrimSigDigits(MTGenerator(GeneratorNum)%ExhaustAirHumRat,6))//' kgWater/kgDryAir.')
CALL ShowContinueError('...Value of combustion air inlet humidity ratio ='//TRIM(TrimSigDigits(CombustionAirInletW,6))&
//' kgWater/kgDryAir.')
CALL ShowContinueErrorTimeStamp('... Simulation will continue.')
ENDIF
CALL ShowRecurringWarningErrorAtEnd('GENERATOR:MICROTURBINE "'//TRIM(MTGenerator(GeneratorNum)%Name)//'":'// &
' Exhaust air humidity ratio less than combustion air inlet humidity ratio warning continues...', &
MTGenerator(GeneratorNum)%ExhHRLTInletHRIndex, MTGenerator(GeneratorNum)%ExhaustAirHumRat, &
MTGenerator(GeneratorNum)%ExhaustAirHumRat)
END IF
END IF ! End of IF (MTGenerator(GeneratorNum)%ExhAirCalcsActive) THEN
RETURN
END SUBROUTINE CalcMTGeneratorModel