1 2 3 SUBROUTINE PRMCALC(XBREC,YBREC) 4 !*********************************************************************** 5 ! PRMCALC Module of the AMS/EPA Regulatory Model - AERMOD 6 ! 7 ! PURPOSE: Calculates the PRIME downwash component of the 8 ! concentration 9 ! 10 ! PROGRAMMER: Roger Brode, PES, Inc. 11 ! 12 ! DATE: November 10, 2000 13 ! 14 ! MODIFIED: 15 ! Modified to place receptor on centerline of cavity 16 ! plumes by setting Y2 = 0.0 for SCREEN option. 17 ! R. W. Brode, MACTEC (f/k/a PES), Inc., 10/26/04 18 ! 19 ! INPUTS: XBREC - Real - Downwind distance (m) of receptor 20 ! from upwind edge of building 21 ! YBREC - Real - Lateral distance (m) of receptor from 22 ! center of upwind edge of building 23 ! 24 ! OUTPUTS: PRMVAL(NTYP) - Real - PRIME downwash component of 25 ! concentration 26 ! 27 ! CALLED FROM: PCALC 28 ! 29 !*********************************************************************** 30 ! Variable Declarations 31 USE MAIN1 32 IMPLICIT NONE 33 CHARACTER MODNAM*12 34 REAL , PARAMETER :: BIGT = 24. 35 INTEGER :: IPOSITN , NDXBH , N1 , N2 , N , IS , J 36 REAL :: XARG , ADJ 37 REAL :: DHPOUT , SYOUT , SZOUT , FYOUT 38 REAL :: USTACK , UBLDG , XBREC , YBREC , FQCAV , SYCAV , SZCAV 39 REAL :: ZHI , ZLO 40 INTEGER :: NDXBHI , NDXBLO , NDXALO 41 ! --- Declare local PRIME arrays for "3-source" data 42 REAL Q2(3) , Y2(3) , SY2(3) , Z2(3) , H2(3) , SZ2(3) , QC2(3) , & 43 & QTKSAV , PPFSAV 44 REAL :: CAV_VAL 45 46 LOGICAL :: LDBHR , L_INWAKE 47 48 49 SAVE 50 51 ! Variable Initializations 52 MODNAM = 'PRMCALC' ! 876672 53 54 ! --- PRIME --------------------------------------------------------- 55 ! --- Calculate where receptor is relative to near-wake cavity 56 ! and building (IPOSITN=1 for within bldg; 2=within 57 ! near-wake, 3=within far wake; 4=outside) 58 ! --- Note: xbrec is downwind dist. of receptor from upwind 59 ! bldg face; ybrec is crosswind dist. of receptor from 60 ! center of upwind bldg. face --- CALL POSITION 61 CALL POSITION(XBREC,YBREC,ZFLAG,IPOSITN) 62 63 IF ( IPOSITN.EQ.4 .AND. X.LE.0.0 ) THEN 64 ! --- Receptor is upwind of sources and is not within 65 ! --- a building wake - use AERMOD calculation 66 DO ITYP = 1 , NUMTYP ! 403452 67 PRMVAL(ITYP) = AERVAL(ITYP) ! 403452 68 IF ( WETSCIM ) PRMVALD(ITYP) = AERVALD(ITYP) 69 ENDDO 70 71 ELSEIF ( IPOSITN.NE.2 .AND. DISTR.LT.0.99 ) THEN 72 ! --- Receptor Too Close to Source for Calculation and is not 73 ! --- within a building near-wake (cavity) - use AERMOD calculation 74 DO ITYP = 1 , NUMTYP ! 0 75 PRMVAL(ITYP) = AERVAL(ITYP) ! 0 76 IF ( WETSCIM ) PRMVALD(ITYP) = AERVALD(ITYP) 77 ENDDO 78 ! ------------------------------------------------------------- 79 80 ELSEIF ( TOXICS .AND. DISTR.GT.80000. ) THEN 81 ! --- Receptor is beyond 80km from source - use AERMOD calculation 82 DO ITYP = 1 , NUMTYP ! 0 83 PRMVAL(ITYP) = AERVAL(ITYP) ! 0 84 IF ( WETSCIM ) PRMVALD(ITYP) = AERVALD(ITYP) 85 ENDDO 86 87 ELSEIF ( .NOT.WAKE ) THEN 88 ! --- No wake effects for this source for this hour - use AERMOD calculation 89 DO ITYP = 1 , NUMTYP ! 0 90 PRMVAL(ITYP) = AERVAL(ITYP) ! 0 91 IF ( WETSCIM ) PRMVALD(ITYP) = AERVALD(ITYP) 92 ENDDO 93 94 95 ELSE 96 ! --- Calculate PRIME concentration with downwash 97 98 ! --- Calculate effective parameters to define ambient turbulence intensities, 99 ! as averages across layer from ground to top of wake (as calculated at 100 ! a downwind distance of 15R). 101 ZHI = 1.2*RSCALE*(15.0+(DSBH/(1.2*RSCALE))**3)**0.333333 ! 473220 102 IF ( UNSTAB ) ZHI = MIN(ZHI,ZI) 103 ZLO = 0.0 104 105 CALL LOCATE(GRIDHT,1,MXGLVL,ZHI,NDXBHI) 106 CALL LOCATE(GRIDHT,1,MXGLVL,ZLO,NDXBLO) 107 NDXALO = NDXBLO + 1 108 CALL ANYAVG(MXGLVL,GRIDHT,GRIDWS,ZLO,NDXALO,ZHI,NDXBHI,UEFF) 109 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSV,ZLO,NDXALO,ZHI,NDXBHI,SVEFF) 110 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSW,ZLO,NDXALO,ZHI,NDXBHI,SWEFF) 111 CALL ANYAVG(MXGLVL,GRIDHT,GRIDTG,ZLO,NDXALO,ZHI,NDXBHI,TGEFF) 112 113 !RWB Modify treatment of low wind/low turbulence cases. 114 !RWB R. Brode, PES, 8/15/96 115 SWEFF = AMAX1(SWEFF,SWMIN) 116 SVEFF = AMAX1(SVEFF,SVMIN,0.05*UEFF) 117 UEFF = SQRT(UEFF*UEFF+2.*SVEFF*SVEFF) 118 119 IF ( DEBUG ) THEN 120 WRITE (IOUNIT,*) 'PRIME Effective Parameters: ' ! 0 121 WRITE (IOUNIT,*) 'ZLO, ZHI = ' , ZLO , ZHI 122 WRITE (IOUNIT,*) 'SWEFF, SVEFF = ' , SWEFF , SVEFF 123 WRITE (IOUNIT,*) 'UEFF, TGEFF = ' , UEFF , TGEFF 124 ENDIF 125 126 ! Calculate the plume rise --- CALL PRMDELH 127 CALL PRMDELH(X,L_INWAKE) ! 473220 128 129 IF ( .NOT.L_INWAKE ) THEN 130 ! Plume is not affected by wake, set PRMVAL = AERVAL and return 131 DO ITYP = 1 , NUMTYP ! 51468 132 PRMVAL(ITYP) = AERVAL(ITYP) ! 51468 133 ENDDO 134 RETURN ! 51468 135 ENDIF 136 137 ! Determine Effective Plume Height --- CALL PRMHEFF 138 CALL PRMHEFF ! 421752 139 140 IF ( UNSTAB .AND. HE.GE.ZI ) THEN 141 ! Plume is above ZI, set PRMVAL = AERVAL and return 142 DO ITYP = 1 , NUMTYP ! 0 143 PRMVAL(ITYP) = AERVAL(ITYP) ! 0 144 ENDDO 145 RETURN ! 0 146 ENDIF 147 148 ! --- Calculate sigmas 149 DHPOUT = DHP ! 421752 150 CALL WAKE_XSIG(X,HS,DHPOUT,NOBID,SZOUT,SYOUT,SZCAV,SYCAV) 151 SY = SYOUT 152 SZ = SZOUT 153 154 ! --- PRIME --------------------------------------------------- 155 ! --- When there is a building wake, consider treatment of mass in 156 ! --- cavity as additional sources, or as only source 157 QTKSAV = QTK 158 PPFSAV = PPF 159 ! --- Place selected plume data into transfer arrays (first element) 160 Q2(1) = QTK 161 Y2(1) = Y 162 SY2(1) = SY 163 Z2(1) = ZFLAG 164 H2(1) = HE 165 SZ2(1) = SZ 166 N1 = 1 167 N2 = 1 168 IF ( WAKE ) THEN 169 ! --- Define cavity source --- CALL CAV_SRC 170 CALL CAV_SRC(X,Y,ZFLAG,FQCAV,QC2,H2,Y2,Z2,SZ2,SY2,N1,N2) ! 421752 171 ! --- Force receptor to be on "centerline" for all plumes for SCREEN 172 IF ( SCREEN ) Y2 = 0.0 173 IF ( FQCAV.GT.0.0 ) THEN 174 ! --- Set source strengths 175 Q2(1) = QTK*(1.0-FQCAV) ! 372184 176 Q2(2) = QTK*FQCAV*QC2(2) 177 Q2(3) = QTK*FQCAV*QC2(3) 178 ENDIF 179 ENDIF 180 181 ! --- Initialize output array values to zero, because contributions 182 ! --- due to more than one source are summed here (or do loop may 183 ! --- not execute if neither source contributes) 184 DO ITYP = 1 , NUMTYP ! 421752 185 PRMVAL(ITYP) = 0.0 ! 421752 186 ENDDO 187 188 ! --- Loop over 3 possible sources (is=1 for primary source, 189 ! --- is=2 for "outside" cavity source, and is=3 for "inside" cavity source) 190 DO IS = N1 , N2 ! 421752 191 192 ! --- Cycle to next source if emission rate is 0.0 193 IF ( Q2(IS).EQ.0.0 ) GOTO 50 ! 474778 194 195 ! --- Transfer data for current source 196 QTK = Q2(IS) ! 472464 197 Y = Y2(IS) 198 SY = SY2(IS) 199 SZ = SZ2(IS) 200 HE = H2(IS) 201 ZFLAG = Z2(IS) 202 203 ! ------------------------------------------------------------- 204 ! Calculate the 'y-term' contribution to 205 ! dispersion, FSUBY --- CALL FYPLM 206 CALL FYPLM(SY,FYOUT) 207 FSUBY = FYOUT 208 209 IF ( FSUBY.EQ.0.0 ) THEN 210 ! --- Lateral term is 0.0, set PRMVAL to 0.0. 211 DO ITYP = 1 , NUMTYP ! 141910 212 PRMVAL(ITYP) = 0.0 ! 141910 213 IF ( WETSCIM ) PRMVALD(ITYP) = 0.0 214 ENDDO 215 216 ELSE 217 218 ! --- Set FOPT = 0.5 for PRIME calculation since wake is "near neutral" 219 FOPT = 0.5 ! 330554 220 221 IF ( NPD.EQ.0 ) THEN 222 ! Determine Deposition Correction Factors 223 IF ( (LDGAS .OR. LWGAS) .AND. IS.NE.3 .AND. X.GT.1. ) & 224 & THEN 225 ! Do not apply depletion for "inside cavity source", IS=3 226 CALL PRM_PDEPG(X) ! 0 227 228 ! Reassign plume height and sigmas, which may have changed 229 ! during integration 230 SY = SY2(IS) 231 SZ = SZ2(IS) 232 HE = H2(IS) 233 ELSE 234 DQCORG = 1.0 ! 330554 235 WQCORG = 1.0 236 ENDIF 237 238 ADJ = DQCORG*WQCORG ! 330554 239 240 CALL PRM_PCHI(ADJ,VDEPG,0) 241 242 ELSE 243 IF ( (LDPART .OR. LWPART) .AND. IS.NE.3 .AND. & 244 & X.GT.1. ) THEN 245 ! Do not apply depletion for "inside cavity source", IS=3 246 CALL PRM_PDEP(X) ! 0 247 248 ! Reassign plume height and sigmas, which may have changed 249 ! during integration 250 SY = SY2(IS) 251 SZ = SZ2(IS) 252 HE = H2(IS) 253 ELSE 254 DO J = 1 , NPD ! 0 255 DQCOR(J) = 1.0 ! 0 256 WQCOR(J) = 1.0 257 ENDDO 258 ENDIF 259 260 DO J = 1 , NPD ! 0 261 262 ADJ = PHI(J)*DQCOR(J)*WQCOR(J) ! 0 263 HV = (X/US)*VGRAV(J) 264 HE = MAX(0.0,HE-HV) 265 266 CALL PRM_PCHI(ADJ,VDEP(J),J) 267 268 ENDDO 269 ENDIF 270 271 ENDIF 272 273 50 ENDDO 274 275 ! --- Restore original plume data 276 QTK = QTKSAV ! 421752 277 PPF = PPFSAV 278 Y = Y2(1) 279 SY = SY2(1) 280 SZ = SZ2(1) 281 HE = H2(1) 282 ZFLAG = Z2(1) 283 284 ENDIF 285 286 CONTINUE ! 825204 287 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