1 2 SUBROUTINE AER_PCHI(XARG,ADJ,VDINP,JIN,AEROUT) 3 !*********************************************************************** 4 ! AER_PCHI Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Calculates Hourly Concentration for POINT Sources 7 ! Using Gaussian Plume Equation 8 ! 9 ! PROGRAMMER: Roger Brode, PES, Inc. 10 ! 11 ! DATE: November 10, 2000 12 ! 13 ! MODIFIED: To include lateral term (FSUBY) in weighting of 14 ! direct and penetrated contributions for wet dep. 15 ! Added debug statement for CONC based on ENSR. 16 ! - R.Brode, MACTEC, 7/27/2004 17 ! 18 ! MODIFIED: To correct WETFLUX values for conversion from 19 ! seconds to hours and to include SQRT(2PI) in 20 ! denominator of integrated vertical term. 21 ! - R.Brode, MACTEC, 3/9/2004 22 ! 23 ! INPUTS: Distance, XARG (downwind for plume; radial for pancake) 24 ! Crosswind Distance 25 ! Plume Height 26 ! Stack Top Wind Speed 27 ! Lateral Dispersion Parameter 28 ! Vertical Dispersion Parameter 29 ! Stability Class 30 ! Mixing Height 31 ! Receptor Height Above Ground 32 ! Emission Rate and Units Scaling Factor 33 ! Source Parameter Arrays 34 ! 35 ! OUTPUTS: AEROUT, AERMOD Concentration for Particular 36 ! Source/Receptor Combination 37 ! 38 ! CALLED FROM: AERCALC, VOLCALC, ACALC 39 !*********************************************************************** 40 41 ! Variable Declarations 42 USE MAIN1 43 IMPLICIT NONE 44 INTEGER :: JIN 45 REAL :: AEROUT(NUMTYP) , XARG , ADJ , VDINP , DRYFLUX , WETFLUX 46 CHARACTER MODNAM*12 47 48 SAVE 49 50 ! Variable Initializations 51 MODNAM = 'AER_PCHI' !3465570 52 53 !---- Calculate the contribution due to horizontal plume, CWRAP 54 IF ( FOPT.EQ.0.0 ) THEN 55 CWRAP = 0.0 ! 0 56 ELSE 57 CALL CPLUME(ZRT,CWRAP) !3465570 58 ENDIF 59 60 !---- Calculate the contribution due to terrain-following plume, CLIFT 61 IF ( ZRT.EQ.ZFLAG ) THEN !3465570 62 !---- Effective receptor heights are equal, therefore CLIFT = CWRAP 63 CLIFT = CWRAP !3465570 64 ELSEIF ( FOPT.EQ.1.0 ) THEN 65 CLIFT = 0.0 ! 0 66 ELSE 67 CALL CPLUME(ZFLAG,CLIFT) ! 0 68 ENDIF 69 70 !---- Calculate the exponential decay term, D --- CALL DECAY 71 CALL DECAY(XARG) !3465570 72 73 !---- Calculate the hourly concentration and deposition values 74 ITYP = 0 75 IF ( CONC ) THEN 76 ITYP = 1 !3465570 77 AEROUT(ITYP) = ADJ*EMIFAC(ITYP)*(FOPT*CWRAP+(1.0-FOPT)*CLIFT)*D 78 79 ! ENHANCEMENT TO DEBUG OUTPUT BASED ON ENSR 80 IF ( DEBUG ) THEN 81 WRITE (DBGUNT,10) ITYP , ADJ , FOPT , CWRAP , CLIFT , D , & 82 & AEROUT(ITYP) 83 10 FORMAT (/,'ITYP = ',I2,' - CONC:',/, & 84 & 'AEROUT(ITYP) = ADJ * EMIFAC(ITYP) * (FOPT * ', & 85 & 'CWRAP + (1.0 -FOPT) * CLIFT) * D',/,' ADJ = ', & 86 & G16.8,/,' FOPT = ',G16.8,/,' CWRAP = ',G16.8,/, & 87 & ' CLIFT = ',G16.8,/,' D = ',G16.8,/, & 88 & ' AEROUT(ITYP) = ',G16.8,/) 89 ENDIF 90 91 ENDIF 92 93 IF ( DEPOS .OR. DDEP ) THEN !3465570 94 ! Calculate DRYFLUX, vertical term for wet deposition 95 !---- Calculate the contribution due to horizontal plume, CWRAP 96 IF ( FOPT.EQ.0.0 ) THEN ! 0 97 CWRAP = 0.0 ! 0 98 ELSE 99 CALL CPLUME(ZRT-ZFLAG+ZRDEP,CWRAP) ! 0 100 ENDIF 101 102 !---- Calculate the contribution due to terrain-following plume, CLIFT 103 IF ( ZRT.EQ.ZFLAG ) THEN ! 0 104 !---- Effective receptor heights are equal, therefore CLIFT = CWRAP 105 CLIFT = CWRAP ! 0 106 ELSEIF ( FOPT.EQ.1.0 ) THEN 107 CLIFT = 0.0 ! 0 108 ELSE 109 CALL CPLUME(ZRDEP,CLIFT) ! 0 110 ENDIF 111 112 DRYFLUX = (FOPT*CWRAP+(1.0-FOPT)*CLIFT)*D ! 0 113 ENDIF 114 IF ( DEPOS .OR. WDEP ) THEN !3465570 115 ! Calculate WETFLUX, vertical term for wet deposition. 116 ! Note that the SRT2PI for the integrated vertical term 117 ! has been removed since it should be divided by SRT2PI. 118 ! Additional factor of 3600. has been added to denominator 119 ! to account for conversion from seconds to hours when 120 ! divided by wind speed below. 121 IF ( PRATE.GT.0. ) THEN ! 0 122 IF ( NPD.EQ.0 ) THEN ! 0 123 WETFLUX = (ADJ*FRACSAT*PRATE*1.0E6*RGAS*TA) & 124 & /(ZSUBP*HENRY(ISRC)*1.0E9*DENOM*3600.) 125 ELSE 126 WETFLUX = 1.0E-3*ADJ*WASHOUT(JIN)*PRATE/(ZSUBP*3600.) ! 0 127 ENDIF 128 ELSE 129 WETFLUX = 0.0 ! 0 130 ENDIF 131 ENDIF 132 133 IF ( DEPOS ) THEN !3465570 134 ITYP = ITYP + 1 ! 0 135 IF ( STABLE .OR. (UNSTAB .AND. (HS.GE.ZI)) ) THEN 136 AEROUT(ITYP) = ADJ*VDINP*EMIFAC(ITYP)*DRYFLUX + & 137 & QTK*WETFLUX*EMIFAC(ITYP)*FSUBY/UEFF 138 ELSEIF ( UNSTAB ) THEN 139 AEROUT(ITYP) = ADJ*VDINP*EMIFAC(ITYP)*DRYFLUX + & 140 & QTK*WETFLUX*EMIFAC(ITYP) & 141 & *(PPF*FSUBY3/UEFF3+(1.-PPF)*FSUBY/UEFFD) 142 ENDIF 143 144 IF ( DEBUG ) THEN ! 0 145 WRITE (DBGUNT,11) ITYP , ADJ , VDINP , DRYFLUX , WETFLUX , & 146 & AEROUT(ITYP) 147 11 FORMAT (/,'ITYP = ',I2,' - DEPOS:',/,' ADJ = ',G16.8,/, & 148 & ' VPDINP = ',G16.8,/,' DRYFLUX = ',G16.8,/, & 149 & ' WETFLUX = ',G16.8,/,' AEROUT(ITYP) = ',G16.8,/) 150 ENDIF 151 152 ENDIF 153 154 IF ( DDEP ) THEN !3465570 155 ITYP = ITYP + 1 ! 0 156 AEROUT(ITYP) = ADJ*VDINP*EMIFAC(ITYP)*DRYFLUX 157 158 IF ( DEBUG ) THEN 159 WRITE (DBGUNT,12) ITYP , ADJ , VDINP , DRYFLUX , & 160 & AEROUT(ITYP) 161 12 FORMAT (/,'ITYP = ',I2,' - DDEP:',/,' ADJ = ',G16.8,/, & 162 & ' VPDINP = ',G16.8,/,' DRYFLUX = ',G16.8,/, & 163 & ' AEROUT(ITYP) = ',G16.8,/) 164 ENDIF 165 166 ENDIF 167 168 IF ( WDEP ) THEN !3465570 169 ITYP = ITYP + 1 ! 0 170 IF ( STABLE .OR. (UNSTAB .AND. (HS.GE.ZI)) ) THEN 171 AEROUT(ITYP) = QTK*WETFLUX*EMIFAC(ITYP)*FSUBY/UEFF ! 0 172 ELSEIF ( UNSTAB ) THEN 173 AEROUT(ITYP) = QTK*WETFLUX*EMIFAC(ITYP) & 174 & *(PPF*FSUBY3/UEFF3+(1.-PPF)*FSUBY/UEFFD) 175 ENDIF 176 177 IF ( DEBUG ) THEN ! 0 178 WRITE (DBGUNT,13) ITYP , ADJ , ZSUBP , PRATE , WETFLUX , & 179 & AEROUT(ITYP) 180 13 FORMAT (/,'ITYP = ',I2,' - WDEP:',/,' ADJ = ',G16.8,/, & 181 & ' ZSUBP = ',G16.8,/,' PRATE = ',G16.8,/, & 182 & ' WETFLUX = ',G16.8,/,' AEROUT(ITYP) = ',G16.8,/) 183 ENDIF 184 185 ENDIF 186 187 188 !CRFL Call to METDEB was moved here from METEXT on 9/26/94, R.F. Lee. 189 !CRFL Print meteorological debug output. --- CALL METDEB 190 IF ( METEOR ) CALL METDEB !3465570 191 192 ! Print Out Debugging Information --- CALL DEBOUT 193 IF ( DEBUG ) CALL DEBOUT 194 195 CONTINUE 196 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