SUBROUTINE GetPollutionFactorInput
! SUBROUTINE INFORMATION:
! AUTHOR Linda Lawrie
! DATE WRITTEN August 2008
! MODIFIED na
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! SetupPollutionCalculation must be called after meters are initialized. This caused a problem
! in runs so have added this routine to allow central get for most inputs.
! METHODOLOGY EMPLOYED:
! na
! REFERENCES:
! na
! USE STATEMENTS:
USE DataIPShortCuts
USE InputProcessor, ONLY: GetNumObjectsFound,GetObjectItem,MakeUPPERCase
USE DataInterfaces, ONLY: ShowWarningError,ShowSevereError,ShowFatalError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
! na
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS:
! na
! DERIVED TYPE DEFINITIONS:
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: NumAlphas
INTEGER :: NumNums
INTEGER :: Loop
INTEGER :: IOSTAT
LOGICAL :: ErrorsFound = .False.
INTEGER, external :: GetMeterIndex
IF (.not. GetInputFlagPollution) RETURN ! Input already gotten
GetInputFlagPollution=.false.
cCurrentModuleObject='EnvironmentalImpactFactors'
NumEnvImpactFactors=GetNumObjectsFound(cCurrentModuleObject)
IF (NumEnvImpactFactors > 0) THEN
! Now find and load all of the user inputs and factors.
CALL GetObjectItem(cCurrentModuleObject,1,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
ELSE
IF (PollutionReportSetup) &
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': not entered. Values will be defaulted.')
ENDIF
Pollution%PurchHeatEffic = 0.3d0
Pollution%PurchCoolCOP = 3.0d0
Pollution%SteamConvEffic = 0.25d0
Pollution%CarbonEquivN2O = 0.0d0
Pollution%CarbonEquivCH4 = 0.0d0
Pollution%CarbonEquivCO2 = 0.0d0
IF (NumEnvImpactFactors > 0) THEN
!If Heating Efficiency defined by the User is negative or zero then a default of 30% will be assigned.
If(rNumericArgs(1) > 0.0d0) Then
Pollution%PurchHeatEffic = rNumericArgs(1)
End If
!If COP defined by the User is negative or zero then a default of 3.0 will be assigned.
If(rNumericArgs(2) > 0.0d0) Then
Pollution%PurchCoolCOP = rNumericArgs(2)
End If
!If Steam Conversion Efficiency defined by the User is negative or zero then a default of 25% will be assigned.
If(rNumericArgs(1) > 0.0d0) Then
Pollution%SteamConvEffic = rNumericArgs(3)
End If
!Load the Total Carbon Equivalent Pollution Factor coefficients
Pollution%CarbonEquivN2O = rNumericArgs(4)
Pollution%CarbonEquivCH4 = rNumericArgs(5)
Pollution%CarbonEquivCO2 = rNumericArgs(6)
End If
!Compare all of the Fuel Factors and compare to PollutionCalculationFactors List
cCurrentModuleObject='FuelFactors'
NumFuelFactors = GetNumObjectsFound(cCurrentModuleObject)
Do Loop = 1,NumFuelFactors
! Now find and load all of the user inputs and factors.
CALL GetObjectItem(cCurrentModuleObject,Loop,cAlphaArgs,NumAlphas,rNumericArgs,NumNums,IOSTAT, &
AlphaBlank=lAlphaFieldBlanks,NumBlank=lNumericFieldBlanks, &
AlphaFieldnames=cAlphaFieldNames,NumericFieldNames=cNumericFieldNames)
FuelType%FuelTypeNames(Loop) = Trim(cAlphaArgs(1))
SELECT CASE (MakeUPPERCase(FuelType%FuelTypeNames(Loop)))
CASE ('NATURALGAS','NATURAL GAS','GAS')
IF (Pollution%NatGasCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%NatGasCoef%FuelFactorUsed = .True.
!Natural Gas Coeffs
Pollution%NatGasCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%NatGasCoef%SourceSched,ErrorsFound)
END IF
Pollution%NatGasCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%NatGasCoef%CO2Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%NatGasCoef%COSched,ErrorsFound)
END IF
Pollution%NatGasCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%NatGasCoef%CH4Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%NatGasCoef%NOxSched,ErrorsFound)
END IF
Pollution%NatGasCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%NatGasCoef%N2OSched,ErrorsFound)
END IF
Pollution%NatGasCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%NatGasCoef%SO2Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%NatGasCoef%PMSched,ErrorsFound)
END IF
Pollution%NatGasCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%NatGasCoef%PM10Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%NatGasCoef%PM25Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%NatGasCoef%NH3Sched,ErrorsFound)
END IF
Pollution%NatGasCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%NatGasCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%NatGasCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%NatGasCoef%HgSched,ErrorsFound)
END IF
Pollution%NatGasCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%NatGasCoef%PbSched,ErrorsFound)
END IF
Pollution%NatGasCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%NatGasCoef%WaterSched,ErrorsFound)
END IF
Pollution%NatGasCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%NatGasCoef%NucHiSched,ErrorsFound)
END IF
Pollution%NatGasCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Natural Gas',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%NatGasCoef%NucLoSched,ErrorsFound)
END IF
CASE ('RESIDUALOIL','RESIDUAL OIL','FUEL OIL #2','FUELOIL#2')
IF (Pollution%FuelOil2Coef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%FuelOil2Coef%FuelFactorUsed = .True.
!FuelOil#2 Coeffs
Pollution%FuelOil2Coef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%FuelOil2Coef%SourceSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%FuelOil2Coef%CO2Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%FuelOil2Coef%COSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%FuelOil2Coef%CH4Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%FuelOil2Coef%NOxSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%FuelOil2Coef%N2OSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%FuelOil2Coef%SO2Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%FuelOil2Coef%PMSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%FuelOil2Coef%PM10Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%FuelOil2Coef%PM25Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%FuelOil2Coef%NH3Sched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%FuelOil2Coef%NMVOCSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%FuelOil2Coef%HgSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%FuelOil2Coef%PbSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%FuelOil2Coef%WaterSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%FuelOil2Coef%NucHiSched,ErrorsFound)
END IF
Pollution%FuelOil2Coef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#2',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%FuelOil2Coef%NucLoSched,ErrorsFound)
END IF
CASE ('DISTILLATEOIL','DISTILLATE OIL','FUEL OIL #1','FUELOIL#1','FUEL OIL')
IF (Pollution%FuelOil1Coef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%FuelOil1Coef%FuelFactorUsed = .True.
!FuelOil#1 Coeffs
Pollution%FuelOil1Coef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%FuelOil1Coef%SourceSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%FuelOil1Coef%CO2Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%FuelOil1Coef%COSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%FuelOil1Coef%CH4Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%FuelOil1Coef%NOxSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%FuelOil1Coef%N2OSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%FuelOil1Coef%SO2Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%FuelOil1Coef%PMSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%FuelOil1Coef%PM10Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%FuelOil1Coef%PM25Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%FuelOil1Coef%NH3Sched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%FuelOil1Coef%NMVOCSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%FuelOil1Coef%HgSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%FuelOil1Coef%PbSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%FuelOil1Coef%WaterSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%FuelOil1Coef%NucHiSched,ErrorsFound)
END IF
Pollution%FuelOil1Coef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Fuel Oil#1',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%FuelOil1Coef%NucLoSched,ErrorsFound)
END IF
CASE ('COAL')
IF (Pollution%CoalCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%CoalCoef%FuelFactorUsed = .True.
! Coal
Pollution%CoalCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%CoalCoef%SourceSched,ErrorsFound)
END IF
Pollution%CoalCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%CoalCoef%CO2Sched,ErrorsFound)
END IF
Pollution%CoalCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%CoalCoef%COSched,ErrorsFound)
END IF
Pollution%CoalCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%CoalCoef%CH4Sched,ErrorsFound)
END IF
Pollution%CoalCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%CoalCoef%NOxSched,ErrorsFound)
END IF
Pollution%CoalCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%CoalCoef%N2OSched,ErrorsFound)
END IF
Pollution%CoalCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%CoalCoef%SO2Sched,ErrorsFound)
END IF
Pollution%CoalCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%CoalCoef%PMSched,ErrorsFound)
END IF
Pollution%CoalCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%CoalCoef%PM10Sched,ErrorsFound)
END IF
Pollution%CoalCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%CoalCoef%PM25Sched,ErrorsFound)
END IF
Pollution%CoalCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%CoalCoef%NH3Sched,ErrorsFound)
END IF
Pollution%CoalCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%CoalCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%CoalCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%CoalCoef%HgSched,ErrorsFound)
END IF
Pollution%CoalCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%CoalCoef%PbSched,ErrorsFound)
END IF
Pollution%CoalCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%CoalCoef%WaterSched,ErrorsFound)
END IF
Pollution%CoalCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%CoalCoef%NucHiSched,ErrorsFound)
END IF
Pollution%CoalCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Coal',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%CoalCoef%NucLoSched,ErrorsFound)
END IF
CASE ('ELECTRICITY','ELECTRIC','ELEC')
IF (Pollution%ElecCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%ElecCoef%FuelFactorUsed = .True.
!Electric Coeffs
Pollution%ElecCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%ElecCoef%SourceSched,ErrorsFound)
END IF
Pollution%ElecCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%ElecCoef%CO2Sched,ErrorsFound)
END IF
Pollution%ElecCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%ElecCoef%COSched,ErrorsFound)
END IF
Pollution%ElecCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%ElecCoef%CH4Sched,ErrorsFound)
END IF
Pollution%ElecCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%ElecCoef%NOxSched,ErrorsFound)
END IF
Pollution%ElecCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%ElecCoef%N2OSched,ErrorsFound)
END IF
Pollution%ElecCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%ElecCoef%SO2Sched,ErrorsFound)
END IF
Pollution%ElecCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%ElecCoef%PMSched,ErrorsFound)
END IF
Pollution%ElecCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%ElecCoef%PM10Sched,ErrorsFound)
END IF
Pollution%ElecCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%ElecCoef%PM25Sched,ErrorsFound)
END IF
Pollution%ElecCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%ElecCoef%NH3Sched,ErrorsFound)
END IF
Pollution%ElecCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%ElecCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%ElecCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%ElecCoef%HgSched,ErrorsFound)
END IF
Pollution%ElecCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%ElecCoef%PbSched,ErrorsFound)
END IF
Pollution%ElecCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%ElecCoef%WaterSched,ErrorsFound)
END IF
Pollution%ElecCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%ElecCoef%NucHiSched,ErrorsFound)
END IF
Pollution%ElecCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Electricity',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%ElecCoef%NucLoSched,ErrorsFound)
END IF
CASE ('GASOLINE')
IF (Pollution%GasolineCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%GasolineCoef%FuelFactorUsed = .True.
!Gasoline Coeffs
Pollution%GasolineCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%GasolineCoef%SourceSched,ErrorsFound)
END IF
Pollution%GasolineCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%GasolineCoef%CO2Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%GasolineCoef%COSched,ErrorsFound)
END IF
Pollution%GasolineCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%GasolineCoef%CH4Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%GasolineCoef%NOxSched,ErrorsFound)
END IF
Pollution%GasolineCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%GasolineCoef%N2OSched,ErrorsFound)
END IF
Pollution%GasolineCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%GasolineCoef%SO2Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%GasolineCoef%PMSched,ErrorsFound)
END IF
Pollution%GasolineCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%GasolineCoef%PM10Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%GasolineCoef%PM25Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%GasolineCoef%NH3Sched,ErrorsFound)
END IF
Pollution%GasolineCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%GasolineCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%GasolineCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%GasolineCoef%HgSched,ErrorsFound)
END IF
Pollution%GasolineCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%GasolineCoef%PbSched,ErrorsFound)
END IF
Pollution%GasolineCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%GasolineCoef%WaterSched,ErrorsFound)
END IF
Pollution%GasolineCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%GasolineCoef%NucHiSched,ErrorsFound)
END IF
Pollution%GasolineCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Gasoline',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%GasolineCoef%NucLoSched,ErrorsFound)
END IF
CASE ('PROPANE','LPG','PROPANEGAS','PROPANE GAS')
IF (Pollution%PropaneCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%PropaneCoef%FuelFactorUsed = .True.
!Propane Coeffs
Pollution%PropaneCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%PropaneCoef%SourceSched,ErrorsFound)
END IF
Pollution%PropaneCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%PropaneCoef%CO2Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%PropaneCoef%COSched,ErrorsFound)
END IF
Pollution%PropaneCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%PropaneCoef%CH4Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%PropaneCoef%NOxSched,ErrorsFound)
END IF
Pollution%PropaneCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%PropaneCoef%N2OSched,ErrorsFound)
END IF
Pollution%PropaneCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%PropaneCoef%SO2Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%PropaneCoef%PMSched,ErrorsFound)
END IF
Pollution%PropaneCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%PropaneCoef%PM10Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%PropaneCoef%PM25Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%PropaneCoef%NH3Sched,ErrorsFound)
END IF
Pollution%PropaneCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%PropaneCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%PropaneCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%PropaneCoef%HgSched,ErrorsFound)
END IF
Pollution%PropaneCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%PropaneCoef%PbSched,ErrorsFound)
END IF
Pollution%PropaneCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%PropaneCoef%WaterSched,ErrorsFound)
END IF
Pollution%PropaneCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%PropaneCoef%NucHiSched,ErrorsFound)
END IF
Pollution%PropaneCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Propane',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%PropaneCoef%NucLoSched,ErrorsFound)
END IF
CASE ('DIESEL')
IF (Pollution%DieselCoef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%DieselCoef%FuelFactorUsed = .True.
!Diesel Coeffs
Pollution%DieselCoef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%DieselCoef%SourceSched,ErrorsFound)
END IF
Pollution%DieselCoef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%DieselCoef%CO2Sched,ErrorsFound)
END IF
Pollution%DieselCoef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%DieselCoef%COSched,ErrorsFound)
END IF
Pollution%DieselCoef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%DieselCoef%CH4Sched,ErrorsFound)
END IF
Pollution%DieselCoef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%DieselCoef%NOxSched,ErrorsFound)
END IF
Pollution%DieselCoef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%DieselCoef%N2OSched,ErrorsFound)
END IF
Pollution%DieselCoef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%DieselCoef%SO2Sched,ErrorsFound)
END IF
Pollution%DieselCoef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%DieselCoef%PMSched,ErrorsFound)
END IF
Pollution%DieselCoef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%DieselCoef%PM10Sched,ErrorsFound)
END IF
Pollution%DieselCoef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%DieselCoef%PM25Sched,ErrorsFound)
END IF
Pollution%DieselCoef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%DieselCoef%NH3Sched,ErrorsFound)
END IF
Pollution%DieselCoef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%DieselCoef%NMVOCSched,ErrorsFound)
END IF
Pollution%DieselCoef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%DieselCoef%HgSched,ErrorsFound)
END IF
Pollution%DieselCoef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%DieselCoef%PbSched,ErrorsFound)
END IF
Pollution%DieselCoef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%DieselCoef%WaterSched,ErrorsFound)
END IF
Pollution%DieselCoef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%DieselCoef%NucHiSched,ErrorsFound)
END IF
Pollution%DieselCoef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'Diesel',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%DieselCoef%NucLoSched,ErrorsFound)
END IF
CASE ('OTHERFUEL1')
IF (Pollution%OtherFuel1Coef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%OtherFuel1Coef%FuelFactorUsed = .True.
!OtherFuel1 Coeffs
Pollution%OtherFuel1Coef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%OtherFuel1Coef%SourceSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%OtherFuel1Coef%CO2Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%OtherFuel1Coef%COSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%OtherFuel1Coef%CH4Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%OtherFuel1Coef%NOxSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%OtherFuel1Coef%N2OSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%OtherFuel1Coef%SO2Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%OtherFuel1Coef%PMSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%OtherFuel1Coef%PM10Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%OtherFuel1Coef%PM25Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%OtherFuel1Coef%NH3Sched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%OtherFuel1Coef%NMVOCSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%OtherFuel1Coef%HgSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%OtherFuel1Coef%PbSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%OtherFuel1Coef%WaterSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%OtherFuel1Coef%NucHiSched,ErrorsFound)
END IF
Pollution%OtherFuel1Coef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel1',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%OtherFuel1Coef%NucLoSched,ErrorsFound)
END IF
CASE ('OTHERFUEL2')
IF (Pollution%OtherFuel2Coef%FuelFactorUsed) THEN
CALL ShowWarningError(TRIM(cCurrentModuleObject)//': '//TRIM(FuelType%FuelTypeNames(Loop))//' already entered.'// &
' Previous entry will be used.')
CYCLE
ENDIF
Pollution%OtherFuel2Coef%FuelFactorUsed = .True.
!OtherFuel2 Coeffs
Pollution%OtherFuel2Coef%Source = rNumericArgs(2)
IF (.not. lAlphaFieldBlanks(3)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(3)),trim(cAlphaArgs(3)), &
Pollution%OtherFuel2Coef%SourceSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%CO2 = rNumericArgs(3)
IF (.not. lAlphaFieldBlanks(4)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(4)),trim(cAlphaArgs(4)), &
Pollution%OtherFuel2Coef%CO2Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%CO = rNumericArgs(4)
IF (.not. lAlphaFieldBlanks(5)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(5)),trim(cAlphaArgs(5)), &
Pollution%OtherFuel2Coef%COSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%CH4 = rNumericArgs(5)
IF (.not. lAlphaFieldBlanks(6)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(6)),trim(cAlphaArgs(6)), &
Pollution%OtherFuel2Coef%CH4Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%NOx = rNumericArgs(6)
IF (.not. lAlphaFieldBlanks(7)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(7)),trim(cAlphaArgs(7)), &
Pollution%OtherFuel2Coef%NOxSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%N2O = rNumericArgs(7)
IF (.not. lAlphaFieldBlanks(8)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(8)),trim(cAlphaArgs(8)), &
Pollution%OtherFuel2Coef%N2OSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%SO2 = rNumericArgs(8)
IF (.not. lAlphaFieldBlanks(9)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(9)),trim(cAlphaArgs(9)), &
Pollution%OtherFuel2Coef%SO2Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%PM = rNumericArgs(9)
IF (.not. lAlphaFieldBlanks(10)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(10)),trim(cAlphaArgs(10)), &
Pollution%OtherFuel2Coef%PMSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%PM10 = rNumericArgs(10)
IF (.not. lAlphaFieldBlanks(11)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(11)),trim(cAlphaArgs(11)), &
Pollution%OtherFuel2Coef%PM10Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%PM25 = rNumericArgs(11)
IF (.not. lAlphaFieldBlanks(12)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(12)),trim(cAlphaArgs(12)), &
Pollution%OtherFuel2Coef%PM25Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%NH3 = rNumericArgs(12)
IF (.not. lAlphaFieldBlanks(13)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(13)),trim(cAlphaArgs(13)), &
Pollution%OtherFuel2Coef%NH3Sched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%NMVOC = rNumericArgs(13)
IF (.not. lAlphaFieldBlanks(14)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(14)),trim(cAlphaArgs(14)), &
Pollution%OtherFuel2Coef%NMVOCSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%Hg = rNumericArgs(14)
IF (.not. lAlphaFieldBlanks(15)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(15)),trim(cAlphaArgs(15)), &
Pollution%OtherFuel2Coef%HgSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%Pb = rNumericArgs(15)
IF (.not. lAlphaFieldBlanks(16)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(16)),trim(cAlphaArgs(16)), &
Pollution%OtherFuel2Coef%PbSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%Water = rNumericArgs(16)
IF (.not. lAlphaFieldBlanks(17)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(17)),trim(cAlphaArgs(17)), &
Pollution%OtherFuel2Coef%WaterSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%NucHi = rNumericArgs(17)
IF (.not. lAlphaFieldBlanks(18)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(18)),trim(cAlphaArgs(18)), &
Pollution%OtherFuel2Coef%NucHiSched,ErrorsFound)
END IF
Pollution%OtherFuel2Coef%NucLo = rNumericArgs(18)
IF (.not. lAlphaFieldBlanks(19)) THEN
CALL CheckFFSchedule(trim(cCurrentModuleObject),'OtherFuel2',trim(cAlphaFieldNames(19)),trim(cAlphaArgs(19)), &
Pollution%OtherFuel2Coef%NucLoSched,ErrorsFound)
END IF
CASE DEFAULT
CALL ShowSevereError('Illegal FuelType for Pollution Calc Entered='//TRIM(FuelType%FuelTypeNames(Loop)))
ErrorsFound=.true.
END SELECT
End Do ! End of the NumEnergyTypes Do Loop
FuelType%ElecFacilityIndex = GetMeterIndex('Electricity:Facility')
FuelType%DieselFacilityIndex = GetMeterIndex('Diesel:Facility')
FuelType%PurchCoolFacilityIndex = GetMeterIndex('DistrictCooling:Facility')
FuelType%PurchHeatFacilityIndex = GetMeterIndex('DistrictHeating:Facility')
FuelType%NatGasFacilityIndex = GetMeterIndex('Gas:Facility')
FuelType%GasolineFacilityIndex = GetMeterIndex('Gasoline:Facility')
FuelType%CoalFacilityIndex = GetMeterIndex('Coal:Facility')
FuelType%FuelOil1FacilityIndex = GetMeterIndex('FuelOil#1:Facility')
FuelType%FuelOil2FacilityIndex = GetMeterIndex('FuelOil#2:Facility')
FuelType%PropaneFacilityIndex = GetMeterIndex('Propane:Facility')
FuelType%OtherFuel1FacilityIndex = GetMeterIndex('OtherFuel1:Facility')
FuelType%OtherFuel2FacilityIndex = GetMeterIndex('OtherFuel2:Facility')
FuelType%ElecProducedFacilityIndex = GetMeterIndex('ElectricityProduced:Facility')
FuelType%SteamFacilityIndex = GetMeterIndex('Steam:Facility')
FuelType%ElecPurchasedFacilityIndex = GetMeterIndex('ElectricityPurchased:Facility')
FuelType%ElecSurplusSoldFacilityIndex = GetMeterIndex('ElectricitySurplusSold:Facility')
IF (PollutionReportSetup) THEN ! only do this if reporting on the pollution
!Need to go through all of the Fuel Types and make sure a Fuel Factor was found for each type of energy being simulated
! Check for Electricity
If(.not. Pollution%ElecCoef%FuelFactorUsed &
.and. ((FuelType%ElecFacilityIndex > 0) .or. (FuelType%ElecProducedFacilityIndex > 0) &
.or. (FuelType%PurchCoolFacilityIndex > 0))) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for ELECTRICITY')
ErrorsFound=.true.
End If
! Check for Natural Gas
If(.not. Pollution%NatGasCoef%FuelFactorUsed &
.and. ((FuelType%NatGasFacilityIndex > 0) .or. (FuelType%PurchHeatFacilityIndex>0) &
.or. (FuelType%SteamFacilityIndex > 0))) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for NATURAL GAS')
ErrorsFound=.true.
End If
! Check for Residual Oil
If(.not. Pollution%FuelOil2Coef%FuelFactorUsed .and. (FuelType%FuelOil2FacilityIndex>0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for RESIDUAL/FUEL OIL #2')
ErrorsFound=.true.
End If
! Check for Distillate Oil
If(.not. Pollution%FuelOil1Coef%FuelFactorUsed .and. (FuelType%FuelOil1FacilityIndex>0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for DISTILLATE/FUEL OIL #1')
ErrorsFound=.true.
End If
! Check for Coal
If(.not. Pollution%CoalCoef%FuelFactorUsed .and. (FuelType%CoalFacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for COAL')
ErrorsFound=.true.
End If
! Check for Gasoline
If(.not. Pollution%GasolineCoef%FuelFactorUsed .and. (FuelType%GasolineFacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for GASOLINE')
ErrorsFound=.true.
End If
! Check for Propane
If(.not. Pollution%PropaneCoef%FuelFactorUsed .and. (FuelType%PropaneFacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for PROPANE')
ErrorsFound=.true.
End If
! Check for Diesel
If(.not. Pollution%DieselCoef%FuelFactorUsed .and. (FuelType%DieselFacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for DIESEL')
ErrorsFound=.true.
End If
! Check for OtherFuel1
If(.not. Pollution%OtherFuel1Coef%FuelFactorUsed .and. (FuelType%OtherFuel1FacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for OTHERFUEL1')
ErrorsFound=.true.
End If
! Check for OtherFuel2
If(.not. Pollution%OtherFuel2Coef%FuelFactorUsed .and. (FuelType%OtherFuel2FacilityIndex > 0)) Then
CALL ShowSevereError(TRIM(cCurrentModuleObject)// &
' Not Found or Fuel not specified For Pollution Calculation for OTHERFUEL2')
ErrorsFound=.true.
End If
END IF
IF (ErrorsFound) THEN
CALL ShowFatalError('Errors found in getting Pollution Calculation Reporting Input')
ENDIF
RETURN
END SUBROUTINE GetPollutionFactorInput