1 SUBROUTINE EMFACT(QARG) 2 !*********************************************************************** 3 ! EMFACT Module of the AMS/EPA Regulatory Model - AERMOD 4 ! 5 ! PURPOSE: Applies Variable Emission Rate and 6 ! Unit Conversion Factors 7 ! 8 ! PROGRAMMER: Roger Brode, Jeff Wang 9 ! MODIFIED : for handling OpenPit Source Type - PES, 7/26/94 10 ! 11 ! DATE: March 2, 1992 12 ! 13 ! MODIFIED: To include an option to vary emissions by season, 14 ! hour-of-day, and day-of-week (SHRDOW). 15 ! R.W. Brode, PES, 4/10/2000 16 ! 17 ! INPUTS: Arrays of Source Parameters 18 ! Date and Hour 19 ! Meteorological Variables for One Hour 20 ! Variable Emission Rate Flags and Factors 21 ! Unit Conversion Rate Factors 22 ! 23 ! OUTPUTS: Adjusted Emission Rate, QTK 24 ! 25 ! CALLED FROM: PCALC 26 ! VCALC 27 ! ACALC 28 !*********************************************************************** 29 30 ! Variable Declarations 31 USE MAIN1 32 IMPLICIT NONE 33 CHARACTER MODNAM*12 34 35 SAVE 36 REAL :: QARG 37 38 ! Variable Initializations 39 MODNAM = 'EMFACT' ! 27396 40 41 ! Apply Emission Unit Factor (EMIFAC) and Variable Emission Rate 42 ! Factor, Based on Value of QFLAG 43 IF ( QFLAG(ISRC).EQ.' ' ) THEN 44 QTK = QARG ! 27396 45 46 !*---- ISCSTM Modification: To handle hourly emissions - jah 11/4/94 47 ELSEIF ( QFLAG(ISRC).EQ.'HOURLY' ) THEN 48 QTK = QARG ! 0 49 !*---- 50 !*# 51 52 ELSEIF ( QFLAG(ISRC).EQ.'MONTH' ) THEN 53 QTK = QARG*QFACT(IMONTH,ISRC) ! 0 54 55 ELSEIF ( QFLAG(ISRC).EQ.'HROFDY' ) THEN 56 QTK = QARG*QFACT(IHOUR,ISRC) ! 0 57 58 ELSEIF ( QFLAG(ISRC).EQ.'WSPEED' ) THEN 59 QTK = QARG*QFACT(IUCAT,ISRC) ! 0 60 61 ELSEIF ( QFLAG(ISRC).EQ.'SEASON' ) THEN 62 QTK = QARG*QFACT(ISEAS,ISRC) ! 0 63 64 ELSEIF ( QFLAG(ISRC).EQ.'SEASHR' ) THEN 65 QTK = QARG*QFACT((IHOUR+(ISEAS-1)*24),ISRC) ! 0 66 67 ELSEIF ( QFLAG(ISRC).EQ.'SHRDOW' ) THEN 68 QTK = QARG*QFACT((IHOUR+(ISEAS-1)*24+(IDAY_OF_WEEK-1)*96),ISRC)! 0 69 70 ELSEIF ( QFLAG(ISRC).EQ.'SHRDOW7' ) THEN 71 QTK = QARG*QFACT((IHOUR+(ISEAS-1)*24+(IDAY_OF_WEEK7-1)*96), & 72 & ISRC) 73 74 ENDIF 75 76 CONTINUE ! 27396 77 END
HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use