1 SUBROUTINE IBLVAL(XARG) 2 !======================================================================= 3 ! IBLVAL Module of the AMS/EPA Regulatory Model - AERMOD 4 ! 5 ! Purpose: Calculating effective parameters for the inhomogeneous 6 ! boundary layer (IBL). 7 ! 8 ! Input: Downwind distance, XARG (m) 9 ! 10 ! Output: Effective parameters for wind speed, turbulence and 11 ! lapse rate 12 ! 13 ! Called by: PCALC, VCALC, ACALC, PLUMEF, PWIDTH 14 ! 15 ! Assumptions: 16 ! 17 ! Developer(s): Roger Brode, PES, Inc. 18 ! Date: January 17, 1995 19 ! 20 ! Revision history: 21 ! 22 !RWB Modified to use ZRT (height of receptor above stack 23 ! base) instead of ZFLAG (height of receptor above 24 ! ground) in defining the layer for the effective 25 ! parameters. 26 ! R.W. Brode, PES, 8/5/98 27 ! 28 !RWB Added calculation of effective Dtheta/Dz (TGEFF and 29 ! TGEFF3) for use in calculating stable sigma-z. 30 ! R.W. Brode, PES, 8/5/98 31 ! 32 !RWB Modified to let plume centroid height follow plume 33 ! centerline height above ZI/2. Also limit upper bound 34 ! of averaging layer for direct plume to be .LE. ZI. 35 ! This is needed to address cases where the 36 ! plume height may exceed ZI. For the SBL, the effective 37 ! parameters are calculated at the plume centerline height. 38 ! R.W. Brode, PES, 1/26/95 39 ! 40 ! Reference(s): "Options for the Treatment of Inhomogeneity", 41 ! Al Cimorelli, Revision 5, 12/13/94 42 ! 43 !----------------------------------------------------------------------- 44 ! 45 !---- Variable declarations 46 ! 47 USE MAIN1 48 IMPLICIT NONE 49 CHARACTER MODNAM*12 50 INTEGER :: NDXEFF , NDXBHI , NDXBLO , NDXALO 51 REAL :: XARG , SZNEW , ZHI , ZLO , SZOLD , SZ3NEW , SZ3OLD , & 52 & SZDAVG , SZDNEW , SZDOLD 53 54 SAVE 55 ! 56 !---- Data dictionary 57 ! 58 !---- Data initializations 59 MODNAM = 'IBLVAL' ! 40087K 60 ! 61 ! ************************************************************* 62 ! 63 64 !RWB Initialize the effective parameters based on 65 !RWB values at plume height 66 IF ( STABLE .OR. (UNSTAB .AND. (HS.GE.ZI)) ) THEN 67 HTEFF = HE ! 33119K 68 CALL LOCATE(GRIDHT,1,MXGLVL,HTEFF,NDXEFF) 69 CALL GINTRP(GRIDHT(NDXEFF),GRIDWS(NDXEFF),GRIDHT(NDXEFF+1), & 70 & GRIDWS(NDXEFF+1),HTEFF,UEFF) 71 CALL GINTRP(GRIDHT(NDXEFF),GRIDSV(NDXEFF),GRIDHT(NDXEFF+1), & 72 & GRIDSV(NDXEFF+1),HTEFF,SVEFF) 73 CALL GINTRP(GRIDHT(NDXEFF),GRIDSW(NDXEFF),GRIDHT(NDXEFF+1), & 74 & GRIDSW(NDXEFF+1),HTEFF,SWEFF) 75 CALL GINTRP(GRIDHT(NDXEFF),GRIDTG(NDXEFF),GRIDHT(NDXEFF+1), & 76 & GRIDTG(NDXEFF+1),HTEFF,TGEFF) 77 IF ( PVMRM ) CALL GINTRP(GRIDHT(NDXEFF),GRIDEPS(NDXEFF), & 78 & GRIDHT(NDXEFF+1),GRIDEPS(NDXEFF+1), & 79 & HTEFF,EPSEFF) 80 81 !RWB Modify treatment of low wind/low turbulence cases. 82 !RWB R. Brode, PES, 8/15/96 83 SWEFF = MAX(SWEFF,SWMIN) 84 SVEFF = MAX(SVEFF,SVMIN,0.05*UEFF) 85 UEFF = SQRT(UEFF*UEFF+2.*SVEFF*SVEFF) 86 87 !RJP Add temporary debugging statement here. 88 89 IF ( DEBUG ) THEN 90 WRITE (DBGUNT,6014) UEFF , SVEFF , SWEFF ! 0 91 6014 FORMAT (5X,'Initial effective parameters ', & 92 & 'for the stable ','plume:',//,5x,'Ueff = ',F7.2, & 93 & ' m/s; ','SVeff = ',F7.2,' m/s; SWeff = ',F7.2, & 94 & ' m/s.',/) 95 ENDIF 96 97 ELSEIF ( UNSTAB .AND. (HS.LT.ZI) ) THEN 98 99 ! Direct and Indirect Source 100 101 IF ( PPF.LT.1.0 ) THEN !6968044 102 !RWB Initialize effective parameters based on values at the 103 !RWB plume centroid height (CENTER) 104 HTEFF = CENTER !6950906 105 CALL LOCATE(GRIDHT,1,MXGLVL,HTEFF,NDXEFF) 106 CALL GINTRP(GRIDHT(NDXEFF),GRIDWS(NDXEFF),GRIDHT(NDXEFF+1), & 107 & GRIDWS(NDXEFF+1),HTEFF,UEFFD) 108 CALL GINTRP(GRIDHT(NDXEFF),GRIDSV(NDXEFF),GRIDHT(NDXEFF+1), & 109 & GRIDSV(NDXEFF+1),HTEFF,SVEFFD) 110 CALL GINTRP(GRIDHT(NDXEFF),GRIDSW(NDXEFF),GRIDHT(NDXEFF+1), & 111 & GRIDSW(NDXEFF+1),HTEFF,SWEFFD) 112 IF ( PVMRM ) CALL GINTRP(GRIDHT(NDXEFF),GRIDEPS(NDXEFF), & 113 & GRIDHT(NDXEFF+1),GRIDEPS(NDXEFF+1),& 114 & HTEFF,EPSEFFD) 115 116 !RWB Modify treatment of low wind/low turbulence cases. 117 !RWB R. Brode, PES, 8/15/96 118 SWEFFD = MAX(SWEFFD,SWMIN) 119 SVEFFD = MAX(SVEFFD,SVMIN,0.05*UEFFD) 120 UEFFD = SQRT(UEFFD*UEFFD+2.*SVEFFD*SVEFFD) 121 122 !RJP Add temporary debugging statement here. 123 124 IF ( DEBUG ) THEN 125 WRITE (DBGUNT,6015) UEFFD , SVEFFD , SWEFFD ! 0 126 6015 FORMAT (5X,'Initial effective parameters ', & 127 & 'for the direct convective ','plume:',//,5x, & 128 & 'UeffD = ',F7.2,' m/s; ','SVeffD = ',F7.2, & 129 & ' m/s; SWeffD = ',F7.2,' m/s.',/) 130 ENDIF 131 132 ENDIF 133 !RJP 134 !RJP Penetrated source 135 !RJP 136 IF ( PPF.GT.0.0 ) THEN !6968044 137 HTEFF = HE3 ! 208794 138 CALL LOCATE(GRIDHT,1,MXGLVL,HTEFF,NDXEFF) 139 CALL GINTRP(GRIDHT(NDXEFF),GRIDWS(NDXEFF),GRIDHT(NDXEFF+1), & 140 & GRIDWS(NDXEFF+1),HTEFF,UEFF3) 141 CALL GINTRP(GRIDHT(NDXEFF),GRIDSV(NDXEFF),GRIDHT(NDXEFF+1), & 142 & GRIDSV(NDXEFF+1),HTEFF,SVEFF3) 143 CALL GINTRP(GRIDHT(NDXEFF),GRIDSW(NDXEFF),GRIDHT(NDXEFF+1), & 144 & GRIDSW(NDXEFF+1),HTEFF,SWEFF3) 145 CALL GINTRP(GRIDHT(NDXEFF),GRIDTG(NDXEFF),GRIDHT(NDXEFF+1), & 146 & GRIDTG(NDXEFF+1),HTEFF,TGEFF3) 147 IF ( PVMRM ) CALL GINTRP(GRIDHT(NDXEFF),GRIDEPS(NDXEFF), & 148 & GRIDHT(NDXEFF+1),GRIDEPS(NDXEFF+1),& 149 & HTEFF,EPSEFF3) 150 151 !RWB Modify treatment of low wind/low turbulence cases. 152 !RWB R. Brode, PES, 8/15/96 153 SWEFF3 = MAX(SWEFF3,SWMIN) 154 SVEFF3 = MAX(SVEFF3,SVMIN,0.05*UEFF3) 155 UEFF3 = SQRT(UEFF3*UEFF3+2.*SVEFF3*SVEFF3) 156 157 !RJP Add temporary debugging statement here. 158 159 IF ( DEBUG ) THEN 160 WRITE (DBGUNT,6016) PPF , UEFF3 , SVEFF3 , SWEFF3 ! 0 161 6016 FORMAT (5X,'Penetration fraction = ',f6.3,/,5X, & 162 & 'Initial effective parameters ', & 163 & 'for the penetrated ','plume:',//,5x,'Ueff3 = ', & 164 & F7.2,' m/s; ','SVeff3 = ',F7.2,' m/s; SWeff3 = ',& 165 & F7.2,' m/s.',/) 166 ENDIF 167 ENDIF 168 169 ENDIF 170 171 ! End initialization. Next compute averages across plume layer. 172 173 IF ( SRCTYP(ISRC).EQ.'POINT' ) THEN ! 40087K 174 ! Determine Dispersion Parameters --- CALL PDIS 175 CALL PDIS(XARG) !2021756 176 ELSEIF ( SRCTYP(ISRC).EQ.'VOLUME' ) THEN 177 ! Determine Dispersion Parameters --- CALL VDIS 178 CALL VDIS(XARG) !1972560 179 ELSEIF ( SRCTYP(ISRC).EQ.'AREA' .OR. SRCTYP(ISRC) & 180 & .EQ.'AREAPOLY' .OR. SRCTYP(ISRC).EQ.'AREACIRC' .OR. & 181 & SRCTYP(ISRC).EQ.'OPENPIT' ) THEN 182 ! Determine Vertical Dispersion Parameters --- CALL ADISZ 183 CALL ADISZ(XARG) ! 36092K 184 ENDIF 185 186 IF ( STABLE .OR. (UNSTAB .AND. (HS.GE.ZI)) ) THEN ! 40087K 187 188 SZNEW = SZ ! 33119K 189 190 CENTER = HE 191 IF ( CENTER.LE.5.0 .AND. ZRT.LE.5.0 ) THEN 192 ZHI = 5.0 ! 31671K 193 ZLO = 0.0 194 ELSEIF ( CENTER.GT.ZRT ) THEN 195 ZHI = CENTER !1447872 196 ZLO = MAX(CENTER-SZCOEF*SZNEW,ZRT) 197 ELSE 198 ZHI = MIN(CENTER+SZCOEF*SZNEW,ZRT) ! 0 199 ZLO = CENTER 200 ENDIF 201 202 !RJP Add temporary debugging statement here. 203 204 IF ( DEBUG ) THEN ! 33119K 205 WRITE (DBGUNT,6030) IREC , CENTER , SZNEW , ZRT , ZLO , ZHI ! 0 206 6030 FORMAT (5X,'Stable plume calculation',' for receptor # ',I3,& 207 & //,5x,'Height of plume center of mass = ',f6.1, & 208 & ' m; Sigma-z estimate = ',f11.1,' m; ', & 209 & 'Receptor height = ',f6.1,' m; ',/,5x,'New ', & 210 & 'effective parameters are averaged between ',f6.1, & 211 & ' and ',F6.1,' meters.',/) 212 ENDIF 213 214 CALL LOCATE(GRIDHT,1,MXGLVL,ZHI,NDXBHI) ! 33119K 215 CALL LOCATE(GRIDHT,1,MXGLVL,ZLO,NDXBLO) 216 NDXALO = NDXBLO + 1 217 CALL ANYAVG(MXGLVL,GRIDHT,GRIDWS,ZLO,NDXALO,ZHI,NDXBHI,UEFF) 218 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSV,ZLO,NDXALO,ZHI,NDXBHI,SVEFF) 219 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSW,ZLO,NDXALO,ZHI,NDXBHI,SWEFF) 220 CALL ANYAVG(MXGLVL,GRIDHT,GRIDTG,ZLO,NDXALO,ZHI,NDXBHI,TGEFF) 221 IF ( PVMRM ) CALL ANYAVG(MXGLVL,GRIDHT,GRIDEPS,ZLO,NDXALO,ZHI, & 222 & NDXBHI,EPSEFF) 223 SZOLD = SZ 224 225 !RWB Modify treatment of low wind/low turbulence cases. 226 !RWB R. Brode, PES, 8/15/96 227 SWEFF = MAX(SWEFF,SWMIN) 228 SVEFF = MAX(SVEFF,SVMIN,0.05*UEFF) 229 UEFF = SQRT(UEFF*UEFF+2.*SVEFF*SVEFF) 230 231 !RJP Add temporary debugging statement here. 232 233 IF ( DEBUG ) THEN 234 WRITE (DBGUNT,6031) UEFF , SVEFF , SWEFF ! 0 235 6031 FORMAT (5X,'Effective parameters for stable ','plume:',//, & 236 & 5x,'Ueff = ',F7.2,' m/s; ','SVeff = ',F7.2, & 237 & ' m/s; SWeff = ',F7.2,' m/s.',/) 238 ENDIF 239 240 ELSEIF ( UNSTAB .AND. (HS.LT.ZI) ) THEN 241 !RJP 242 !RJP Process effective values for direct and penetrated plumes 243 !RJP 244 !RJP First, process the penetrated plume, then the direct plumes. 245 !RJP 246 247 IF ( PPF.GT.0.0 ) THEN !6968044 248 249 SZ3NEW = SZ3 ! 208794 250 251 !RWB Change ZEFF to ZRT in following block. RWB 1/23/95 252 IF ( HE3.GT.ZRT ) THEN 253 ZHI = HE3 ! 208794 254 ZLO = MAX(HE3-SZCOEF*SZ3NEW,ZRT) 255 ELSE 256 ZHI = MIN(HE3+SZCOEF*SZ3NEW,ZRT) ! 0 257 ZLO = HE3 258 ENDIF 259 260 !RJP Add temporary debugging statement here. 261 262 IF ( DEBUG ) THEN ! 208794 263 WRITE (DBGUNT,6040) IREC , HE3 , SZ3NEW , ZRT , ZLO , ZHI! 0 264 6040 FORMAT (5X,'Penetrated plume calculation', & 265 & ' for receptor # ',I3,//,5x, & 266 & 'Height of plume center of mass = ',f6.1, & 267 & ' m; Sigma-z estimate = ',f11.1,' m; ', & 268 & 'Receptor height = ',f6.1,' m; ',/,5x,'New ', & 269 & 'effective parameters are averaged between ', & 270 & f6.1,' and ',F6.1,' meters.',/) 271 ENDIF 272 273 CALL LOCATE(GRIDHT,1,MXGLVL,ZHI,NDXBHI) ! 208794 274 CALL LOCATE(GRIDHT,1,MXGLVL,ZLO,NDXBLO) 275 NDXALO = NDXBLO + 1 276 CALL ANYAVG(MXGLVL,GRIDHT,GRIDWS,ZLO,NDXALO,ZHI,NDXBHI, & 277 & UEFF3) 278 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSV,ZLO,NDXALO,ZHI,NDXBHI, & 279 & SVEFF3) 280 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSW,ZLO,NDXALO,ZHI,NDXBHI, & 281 & SWEFF3) 282 CALL ANYAVG(MXGLVL,GRIDHT,GRIDTG,ZLO,NDXALO,ZHI,NDXBHI, & 283 & TGEFF3) 284 IF ( PVMRM ) CALL ANYAVG(MXGLVL,GRIDHT,GRIDEPS,ZLO,NDXALO, & 285 & ZHI,NDXBHI,EPSEFF3) 286 SZ3OLD = SZ3 287 288 !RWB Modify treatment of low wind/low turbulence cases. R. Brode, PES, 289 !RWB 8/15/96 290 SWEFF3 = MAX(SWEFF3,SWMIN) 291 SVEFF3 = MAX(SVEFF3,SVMIN,0.05*UEFF3) 292 UEFF3 = SQRT(UEFF3*UEFF3+2.*SVEFF3*SVEFF3) 293 294 !RJP Add temporary debugging statement here. 295 296 IF ( DEBUG ) THEN 297 WRITE (DBGUNT,6041) UEFF3 , SVEFF3 , SWEFF3 ! 0 298 6041 FORMAT (5X,'Effective parameters for penetrated ', & 299 & 'plume:',//,5x,'Ueff3 = ',F7.2,' m/s; ', & 300 & 'SVeff3 = ',F7.2,' m/s; SWeff3 = ',F7.2,' m/s.', & 301 & /) 302 ENDIF 303 304 ENDIF 305 306 IF ( PPF.LT.1.0 ) THEN !6968044 307 308 !RJP Process the direct plumes here. ************************* 309 310 SZDAVG = 0.5*(SZD1+SZD2) !6950906 311 SZDNEW = SZDAVG 312 313 !RWB Computation of CENTER (plume centroid height) has been 314 !RWB moved to SUB. CENTROID (CALC1.FOR). 315 316 !RWB Change ZEFF to ZRT in following block. RWB 1/23/95 317 IF ( CENTER.LE.5.0 .AND. ZRT.LE.5.0 ) THEN 318 ZHI = MIN(5.0,ZI) ! 26118 319 ZLO = 0.0 320 ELSEIF ( CENTER.GT.ZRT ) THEN 321 !RWB Limit ZHI to be .LE. ZI 322 ZHI = MIN(CENTER,ZI) !6924788 323 ZLO = MAX(CENTER-SZCOEF*SZDNEW,ZRT) 324 ELSE 325 ZHI = MIN(CENTER+SZCOEF*SZDNEW,ZRT) ! 0 326 ZHI = MIN(ZHI,ZI) 327 ZLO = CENTER 328 ENDIF 329 330 !RJP Add temporary debugging statement here. 331 332 IF ( DEBUG ) THEN !6950906 333 WRITE (DBGUNT,6050) IREC , CENTER , SZDNEW , ZRT , ZLO , & 334 & ZHI 335 6050 FORMAT (5X,'Direct plume calculation',' for receptor # ',& 336 & I3,//,5x,'Height of plume center of mass = ', & 337 & f6.1,' m; Sigma-z estimate = ',f11.1,' m; ', & 338 & 'Receptor height = ',f6.1,' m; ',/,5x,'New ', & 339 & 'effective parameters are averaged between ', & 340 & f6.1,' and ',F6.1,' meters.',/) 341 ENDIF 342 343 !RWB Check for ZHI .LE. ZLO, skip averages 344 IF ( ZHI.GT.ZLO ) THEN !6950906 345 CALL LOCATE(GRIDHT,1,MXGLVL,ZHI,NDXBHI) !6950906 346 CALL LOCATE(GRIDHT,1,MXGLVL,ZLO,NDXBLO) 347 NDXALO = NDXBLO + 1 348 CALL ANYAVG(MXGLVL,GRIDHT,GRIDWS,ZLO,NDXALO,ZHI,NDXBHI, & 349 & UEFFD) 350 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSV,ZLO,NDXALO,ZHI,NDXBHI, & 351 & SVEFFD) 352 CALL ANYAVG(MXGLVL,GRIDHT,GRIDSW,ZLO,NDXALO,ZHI,NDXBHI, & 353 & SWEFFD) 354 IF ( PVMRM ) CALL ANYAVG(MXGLVL,GRIDHT,GRIDEPS,ZLO, & 355 & NDXALO,ZHI,NDXBHI,EPSEFFD) 356 ELSE 357 !RWB Use values at ZI if ZHI .LE. ZLO 358 HTEFF = ZI ! 0 359 CALL LOCATE(GRIDHT,1,MXGLVL,HTEFF,NDXEFF) 360 CALL GINTRP(GRIDHT(NDXEFF),GRIDWS(NDXEFF), & 361 & GRIDHT(NDXEFF+1),GRIDWS(NDXEFF+1),HTEFF, & 362 & UEFFD) 363 CALL GINTRP(GRIDHT(NDXEFF),GRIDSV(NDXEFF), & 364 & GRIDHT(NDXEFF+1),GRIDSV(NDXEFF+1),HTEFF, & 365 & SVEFFD) 366 CALL GINTRP(GRIDHT(NDXEFF),GRIDSW(NDXEFF), & 367 & GRIDHT(NDXEFF+1),GRIDSW(NDXEFF+1),HTEFF, & 368 & SWEFFD) 369 IF ( PVMRM ) CALL GINTRP(GRIDHT(NDXEFF),GRIDEPS(NDXEFF), & 370 & GRIDHT(NDXEFF+1), & 371 & GRIDEPS(NDXEFF+1),HTEFF,EPSEFFD) 372 ENDIF 373 SZDOLD = SZDAVG !6950906 374 375 !RWB Modify treatment of low wind/low turbulence cases. 376 !RWB R. Brode, PES, 8/15/96 377 SWEFFD = MAX(SWEFFD,SWMIN) 378 SVEFFD = MAX(SVEFFD,SVMIN,0.05*UEFFD) 379 UEFFD = SQRT(UEFFD*UEFFD+2.*SVEFFD*SVEFFD) 380 381 !RJP Add temporary debugging statement here. 382 383 IF ( DEBUG ) THEN 384 WRITE (DBGUNT,6051) UEFFD , SVEFFD , SWEFFD ! 0 385 6051 FORMAT (5X,'Effective parameters for direct ','plume:', & 386 & //,5x,'UeffD = ',F7.2,' m/s; ','SVeffD = ',F7.2, & 387 & ' m/s; SWeffD = ',F7.2,' m/s.',/) 388 ENDIF 389 390 ENDIF 391 392 ENDIF 393 394 !RWB Set effective parameters for indirect source = direct source 395 IF ( UNSTAB .AND. HS.LT.ZI ) THEN ! 40087K 396 UEFFN = UEFFD !6968044 397 SVEFFN = SVEFFD 398 SWEFFN = SWEFFD 399 ENDIF 400 401 CONTINUE ! 40087K 402 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