1 2 SUBROUTINE PRM_PCHI(ADJ,VDINP,JIN) 3 !*********************************************************************** 4 ! PRM_PCHI Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Calculates Hourly Concentration for POINT Sources 7 ! with PRIME Downwash Algorithm 8 ! 9 ! PROGRAMMER: Roger Brode, PES, Inc. 10 ! 11 ! DATE: November 10, 2000 12 ! 13 ! MODIFIED: To correct WETFLUX values for conversion from 14 ! seconds to hours and to include SQRT(2PI) in 15 ! denominator of integrated vertical term. 16 ! - R.Brode, MACTEC, 3/9/2004 17 ! 18 ! INPUTS: Downwind Distance 19 ! Crosswind Distance 20 ! Plume Height 21 ! Stack Top Wind Speed 22 ! Lateral Dispersion Parameter 23 ! Vertical Dispersion Parameter 24 ! Stability Class 25 ! Mixing Height 26 ! Receptor Height Above Ground 27 ! Emission Rate and Units Scaling Factor 28 ! Source Parameter Arrays 29 ! 30 ! OUTPUTS: PRMVAL, PRIME Concentration for Particular 31 ! Source/Receptor Combination, summed across 32 ! three PRIME "sources", i.e., primary source, 33 ! inside cavity source and outside cavity source 34 ! 35 ! CALLED FROM: PRMCALC 36 !*********************************************************************** 37 38 ! Variable Declarations 39 USE MAIN1 40 IMPLICIT NONE 41 CHARACTER MODNAM*12 42 43 INTEGER :: JIN 44 REAL :: ADJ , VDINP , DRYFLUX , WETFLUX 45 SAVE 46 47 ! Variable Initializations 48 MODNAM = 'PRM_PCHI' ! 330554 49 50 !---- Calculate the exponential decay term, D --- CALL DECAY 51 CALL DECAY(X) 52 53 !---- Calculate the hourly concentration value 54 ITYP = 0 55 IF ( CONC ) THEN 56 ITYP = 1 ! 330554 57 !---- Calculate the contribution due to horizontal plume, CWRAP 58 IF ( FOPT.EQ.0.0 ) THEN 59 CWRAP = 0.0 ! 0 60 ELSE 61 CALL PRM_PLUME(ZRT,CWRAP) ! 330554 62 ENDIF 63 64 !---- Calculate the contribution due to terrain-following plume, CLIFT 65 IF ( ZRT.EQ.ZFLAG ) THEN ! 330554 66 !---- Effective receptor heights are equal, therefore CLIFT = CWRAP 67 CLIFT = CWRAP ! 330554 68 ELSEIF ( FOPT.EQ.1.0 ) THEN 69 CLIFT = 0.0 ! 0 70 ELSE 71 CALL PRM_PLUME(ZFLAG,CLIFT) ! 0 72 ENDIF 73 74 PRMVAL(ITYP) = PRMVAL(ITYP) + ADJ*EMIFAC(ITYP) & 75 & *(FOPT*CWRAP+(1.0-FOPT)*CLIFT)*D 76 ENDIF 77 78 IF ( DEPOS .OR. DDEP ) THEN ! 330554 79 ! Calculate DRYFLUX, vertical term for wet deposition 80 !---- Calculate the contribution due to horizontal plume, CWRAP 81 IF ( FOPT.EQ.0.0 ) THEN ! 0 82 CWRAP = 0.0 ! 0 83 ELSE 84 CALL PRM_PLUME(ZRT-ZFLAG+ZRDEP,CWRAP) ! 0 85 ENDIF 86 87 !---- Calculate the contribution due to terrain-following plume, CLIFT 88 IF ( ZRT.EQ.ZFLAG ) THEN ! 0 89 !---- Effective receptor heights are equal, therefore CLIFT = CWRAP 90 CLIFT = CWRAP ! 0 91 ELSEIF ( FOPT.EQ.1.0 ) THEN 92 CLIFT = 0.0 ! 0 93 ELSE 94 CALL PRM_PLUME(ZRDEP,CLIFT) ! 0 95 ENDIF 96 97 DRYFLUX = (FOPT*CWRAP+(1.0-FOPT)*CLIFT)*D ! 0 98 ENDIF 99 IF ( DEPOS .OR. WDEP ) THEN ! 330554 100 ! Calculate WETFLUX, vertical term for wet deposition 101 ! Note that the SRT2PI for the integrated vertical term 102 ! has been removed since it should be divided by SRT2PI. 103 ! Additional factor of 3600. has been added to denominator 104 ! to account for conversion from seconds to hours when 105 ! divided by wind speed below. 106 IF ( PRATE.GT.0. ) THEN ! 0 107 IF ( NPD.EQ.0 ) THEN ! 0 108 WETFLUX = (ADJ*FRACSAT*PRATE*1.0E6*RGAS*TA) & 109 & /(ZSUBP*HENRY(ISRC)*1.0E9*DENOM*3600.) 110 ELSE 111 WETFLUX = 1.0E-3*ADJ*WASHOUT(JIN)*PRATE/(ZSUBP*3600.) ! 0 112 ENDIF 113 ELSE 114 WETFLUX = 0.0 ! 0 115 ENDIF 116 ENDIF 117 118 IF ( DEPOS ) THEN ! 330554 119 ITYP = ITYP + 1 ! 0 120 PRMVAL(ITYP) = PRMVAL(ITYP) + ADJ*VDINP*EMIFAC(ITYP)*DRYFLUX + & 121 & QTK*WETFLUX*EMIFAC(ITYP)*FSUBY/UEFF 122 ENDIF 123 124 IF ( DDEP ) THEN ! 330554 125 ITYP = ITYP + 1 ! 0 126 PRMVAL(ITYP) = PRMVAL(ITYP) + ADJ*VDINP*EMIFAC(ITYP)*DRYFLUX 127 ENDIF 128 129 IF ( WDEP ) THEN ! 330554 130 ITYP = ITYP + 1 ! 0 131 PRMVAL(ITYP) = PRMVAL(ITYP) + QTK*WETFLUX*EMIFAC(ITYP) & 132 & *FSUBY/UEFF 133 ENDIF 134 135 ! Print Out Debugging Information --- CALL DEBOUT 136 IF ( DEBUG ) CALL DEBOUT ! 330554 137 138 CONTINUE 139 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