| blob | 10d64e0cae35f4695a9c2fa628bc56c00f48f6fb |
1 MODULE module_dep_simple
2 IMPLICIT NONE
3 !
4 ! many of these parameters will depend on the RADM mechanism!
5 ! if you change it, lets talk about it and get it done!!!
6 !
8 INTEGER, PARAMETER :: dep_seasons = 5 , nlu = 25, &
9 nseason = 1, nseasons = 2
10 !
11 ! following currently hardwired to USGS
12 !
13 INTEGER, PARAMETER :: isice_temp=24,iswater_temp=16
14 character, parameter :: mminlu='USGS'
15 !
16 INTEGER :: ixxxlu(nlu)
17 REAL :: kpart(nlu), &
18 rac(nlu,dep_seasons), rclo(nlu,dep_seasons), rcls(nlu,dep_seasons), &
19 rgso(nlu,dep_seasons), rgss(nlu,dep_seasons), &
20 ri(nlu,dep_seasons), rlu(nlu,dep_seasons)
21 !
22 ! NO MORE THAN 1000 SPECIES FOR DEPOSITION
23 !
24 REAL, DIMENSION (1:1000) :: dratio,hstar,hstar4,f0,dhr,scpr23
25 ! .. Default Accessibility ..
26 PUBLIC
27 logical, allocatable :: is_aerosol(:) ! true if field is aerosol (any phase)
28 ! ..
29 CONTAINS
30 subroutine wesely_driver(id,ktau,dtstep, &
31 config_flags, &
32 gmt,julday,t_phy,moist,p8w,t8w,raincv, &
33 p_phy,chem,rho_phy,dz8w,ddvel,aer_res_def,aer_res_zcen, &
34 ivgtyp,tsk,gsw,vegfra,pbl,rmol,ust,znt,xlat,xlong,z,z_at_w,&
35 numgas, &
36 ids,ide, jds,jde, kds,kde, &
37 ims,ime, jms,jme, kms,kme, &
38 its,ite, jts,jte, kts,kte )
39 !----------------------------------------------------------------------
40 USE module_model_constants
41 USE module_configure
42 USE module_state_description
43 USE module_data_sorgam
45 INTEGER, INTENT(IN ) :: id,julday, &
46 numgas, &
47 ids,ide, jds,jde, kds,kde, &
48 ims,ime, jms,jme, kms,kme, &
49 its,ite, jts,jte, kts,kte
50 INTEGER, INTENT(IN ) :: &
51 ktau
52 REAL, INTENT(IN ) :: &
53 dtstep,gmt
54 !
55 ! advected moisture variables
56 !
57 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ), &
58 INTENT(IN ) :: moist
59 !
60 ! advected chemical species
61 !
62 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
63 INTENT(INOUT ) :: chem
64 !
65 ! deposition velocities
66 !
67 REAL, DIMENSION( its:ite, jts:jte, num_chem ), &
68 INTENT(INOUT ) :: ddvel
69 !
70 ! input from met model
71 !
73 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
74 INTENT(IN ) :: &
75 t_phy, &
76 p_phy, &
77 dz8w, &
78 z , &
79 t8w,p8w,z_at_w , &
80 rho_phy
81 INTEGER,DIMENSION( ims:ime , jms:jme ) , &
82 INTENT(IN ) :: &
83 ivgtyp
84 REAL, DIMENSION( ims:ime , jms:jme ) , &
85 INTENT(INOUT ) :: &
86 tsk, &
87 gsw, &
88 vegfra, &
89 pbl, &
90 rmol, &
91 ust, &
92 xlat, &
93 xlong, &
94 znt,raincv
96 !--- deposition and emissions stuff
97 ! ..
98 ! .. Local Scalars ..
99 REAL :: clwchem,dvfog,dvpart,pa,rad,rhchem,ta,ustar,vegfrac,z1,zntt
100 INTEGER :: i, iland, iprt, iseason, j, jce, jcs, n, nr, ipr,jpr,nvr
101 LOGICAL :: highnh3, rainflag, vegflag, wetflag
102 ! ..
103 ! .. Local Arrays ..
104 REAL :: p(kts:kte), srfres(numgas),ddvel0d(numgas)
105 !
106 ! necessary for aerosols (module dependent)
107 !
108 real :: aer_res_def(its:ite,jts:jte), aer_res_zcen(its:ite,jts:jte)
109 real :: rcx(numgas)
111 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
114 ! ..
115 ! .. Intrinsic Functions ..
116 INTRINSIC max, min
117 ! ..
118 CALL wrf_debug(15,'in dry_dep_wesely')
119 iseason = 1
120 if(julday.lt.90.or.julday.gt.270)then
121 iseason=2
122 CALL wrf_debug(15,'setting iseason to 2')
123 endif
124 do 100 j=jts,jte
125 do 100 i=its,ite
126 iprt=0
127 iland = ivgtyp(i,j)
128 ta = tsk(i,j)
129 rad = gsw(i,j)
130 vegfrac = vegfra(i,j)
131 pa = .01*p_phy(i,kts,j)
132 clwchem = moist(i,kts,j,p_qc)
133 ustar = ust(i,j)
134 zntt = znt(i,j)
136 z1 = z_at_w(i,kts+1,j)-z_at_w(i,kts,j)
138 ! Set logical default values
139 rainflag = .FALSE.
140 wetflag = .FALSE.
141 highnh3 = .FALSE.
142 if(p_qr.gt.1)then
143 if(moist(i,kts,j,p_qr).gt.1.e-18 .or. raincv(i,j).gt.0.)rainflag = .true.
144 endif
145 rhchem = MIN( 100.,100. * moist(i,kts,j,p_qv) / &
146 (3.80*exp(17.27*(t_phy(i,kts,j)-273.)/(t_phy(i,kts,j)-36.))/pa))
147 rhchem = MAX(5.,RHCHEM)
148 if (rhchem >= 95.) wetflag = .true.
150 if(p_nh3.gt.1)then
151 if(chem(i,kts,j,p_nh3).gt.2.*chem(i,kts,j,p_so2))highnh3 = .true.
152 endif
154 !--- deposition
156 ! if(snowc(i,j).gt.0.)iseason=4
157 CALL rc(rcx,ta,rad,rhchem,iland,iseason,numgas, &
158 wetflag,rainflag,highnh3,iprt,p_o3,p_so2,p_nh3)
159 srfres=0.
160 DO n = 1, numgas-2
161 srfres(n) = rcx(n)
162 END DO
163 CALL deppart(rmol(i,j),ustar,rhchem,clwchem,iland,dvpart,dvfog)
164 ddvel0d=0.
165 aer_res_def(i,j)=0.
166 aer_res_zcen(i,j)=0.
167 CALL landusevg(ddvel0d,ustar,rmol(i,j),zntt,z1,dvpart,iland, &
168 numgas,srfres,aer_res_def(i,j),aer_res_zcen(i,j),p_sulf)
170 !wig: CMBZ does not have HO and HO2 last so need to copy all species
171 ! ddvel(i,j,1:numgas-2)=ddvel0d(1:numgas-2)
172 ddvel(i,j,1:numgas)=ddvel0d(1:numgas)
173 if ( (config_flags%chem_opt == RADM2 ) .or. &
174 (config_flags%chem_opt == RADM2SORG ) .or. &
175 (config_flags%chem_opt == RADM2SORG_AQ) ) then
176 ddvel(i,j,p_hcl) = ddvel(i,j,p_hno3)
177 end if
180 100 continue
181 !
182 ! For the additional CBMZ species, assign similar RADM counter parts for
183 ! now. Short lived species get a zero velocity since dry dep should be
184 ! unimportant. **ALSO**, treat p_sulf as h2so4 vapor, not aerosol sulfate
185 !
186 if ( (config_flags%chem_opt == CBMZ ) .or. &
187 (config_flags%chem_opt == CBMZ_BB ) .or. &
188 (config_flags%chem_opt == CBMZ_BB_KPP ) .or. &
189 (config_flags%chem_opt == CBMZ_MOSAIC_4BIN_AQ) .or. &
190 (config_flags%chem_opt == CBMZ_MOSAIC_8BIN_AQ) .or. &
191 (config_flags%chem_opt == CBMZ_MOSAIC_4BIN) .or. &
192 (config_flags%chem_opt == CBMZ_MOSAIC_8BIN) ) then
193 do j=jts,jte
194 do i=its,ite
195 ddvel(i,j,p_sulf) = ddvel(i,j,p_hno3)
196 ddvel(i,j,p_hcl) = ddvel(i,j,p_hno3)
197 ddvel(i,j,p_ch3o2) = 0
198 ddvel(i,j,p_ethp) = 0
199 ddvel(i,j,p_ch3oh) = ddvel(i,j,p_hcho)
200 ddvel(i,j,p_c2h5oh) = ddvel(i,j,p_hcho)
201 !wig, 1-May-2007 (added par to tables) ddvel(i,j,p_par) = ddvel(i,j,p_hc5)
202 ddvel(i,j,p_to2) = 0
203 ddvel(i,j,p_cro) = 0
204 ddvel(i,j,p_open) = ddvel(i,j,p_xyl)
205 ddvel(i,j,p_op3) = ddvel(i,j,p_op2)
206 ddvel(i,j,p_c2o3) = 0
207 ddvel(i,j,p_ro2) = 0
208 ddvel(i,j,p_ano2) = 0
209 ddvel(i,j,p_nap) = 0
210 ddvel(i,j,p_xo2) = 0
211 ddvel(i,j,p_xpar) = 0
212 ddvel(i,j,p_isoprd) = 0
213 ddvel(i,j,p_isopp) = 0
214 ddvel(i,j,p_isopn) = 0
215 ddvel(i,j,p_isopo2) = 0
216 if( config_flags%chem_opt == CBMZ ) then
217 ddvel(i,j,p_dms) = 0
218 ddvel(i,j,p_msa) = ddvel(i,j,p_hno3)
219 ddvel(i,j,p_dmso) = 0
220 ddvel(i,j,p_dmso2) = 0
221 ddvel(i,j,p_ch3so2h) = 0
222 ddvel(i,j,p_ch3sch2oo) = 0
223 ddvel(i,j,p_ch3so2) = 0
224 ddvel(i,j,p_ch3so3) = 0
225 ddvel(i,j,p_ch3so2oo) = 0
226 ddvel(i,j,p_ch3so2ch2oo) = 0
227 ddvel(i,j,p_mtf) = 0
228 end if
229 end do
230 end do
231 end if
233 ! For the additional CBM4 species, assign similar RADM counter parts for
234 ! now. Short lived species get a zero velocity since dry dep should be
235 ! unimportant.
236 !
237 if (config_flags%chem_opt == CBM4_KPP ) then
238 do j=jts,jte
239 do i=its,ite
240 ddvel(i,j,p_open) = ddvel(i,j,p_xyl)
241 ddvel(i,j,p_ro2) = 0
242 ddvel(i,j,p_xo2) = 0
243 ddvel(i,j,p_ald2) = ddvel(i,j,p_ald)
244 ddvel(i,j,p_iso) = 0
245 end do
246 end do
247 end if
249 ! For gocartracm,radm
250 !
251 if ((config_flags%chem_opt == GOCARTRACM_KPP) .OR. &
252 (config_flags%chem_opt == GOCARTRADM2_KPP) .OR. &
253 (config_flags%chem_opt == GOCARTRADM2)) then
254 do j=jts,jte
255 do i=its,ite
256 ddvel(i,j,p_sulf) = 0.
257 ddvel(i,j,p_dms) = 0.
258 ddvel(i,j,p_msa) = ddvel(i,j,p_hno3)
259 if( config_flags%chem_opt == GOCARTRADM2 ) then
260 ddvel(i,j,p_hcl) = ddvel(i,j,p_hno3)
261 end if
262 end do
263 end do
264 end if
265 ! For gocartsimple : need msa. On the other hand sulf comes from aerosol routine
266 !
267 if (config_flags%chem_opt == GOCART_SIMPLE ) then
268 do j=jts,jte
269 do i=its,ite
270 ddvel(i,j,p_msa) = ddvel(i,j,p_sulf)
271 ddvel(i,j,p_sulf) = 0.
272 ddvel(i,j,p_dms) = 0.
273 end do
274 end do
275 end if
277 END SUBROUTINE wesely_driver
279 ! **********************************************************************
280 ! ************************** SUBROUTINE RC ***************************
281 ! **********************************************************************
282 SUBROUTINE rc(rcx,t,rad,rh,iland,iseason,numgas, &
283 wetflag,rainflag,highnh3,iprt,p_o3,p_so2,p_nh3)
284 ! THIS SUBROUTINE CALCULATES SURFACE RESISTENCES ACCORDING
285 ! TO THE MODEL OF
286 ! M. L. WESELY,
287 ! ATMOSPHERIC ENVIRONMENT 23 (1989), 1293-1304
288 ! WITH SOME ADDITIONS ACCORDING TO
289 ! J. W. ERISMAN, A. VAN PUL, AND P. WYERS,
290 ! ATMOSPHERIC ENVIRONMENT 28 (1994), 2595-2607
291 ! WRITTEN BY WINFRIED SEIDL, APRIL 1997
292 ! MODYFIED BY WINFRIED SEIDL, MARCH 2000
293 ! FOR MM5 VERSION 3
294 !----------------------------------------------------------------------
295 ! .. Scalar Arguments ..
296 REAL :: rad, rh, t
297 INTEGER :: iland, iseason, numgas
298 LOGICAL :: highnh3, rainflag, wetflag
299 real :: rcx(numgas)
300 ! ..
301 INTEGER :: iprt,p_o3,p_so2,p_nh3
302 ! ..
303 ! .. Local Scalars ..
304 REAL :: rclx, rdc, resice, rgsx, rluo1, rluo2, rlux, rmx, rs, rsmx, &
305 tc, rdtheta, z
306 INTEGER :: n
307 ! ..
308 ! .. Local Arrays ..
309 REAL :: hstary(numgas)
310 ! ..
311 ! .. Intrinsic Functions ..
312 INTRINSIC exp
313 ! ..
314 DO n = 1, numgas
315 rcx(n) = 1.
316 END DO
318 tc = t - 273.15
319 rdtheta = 0.
321 z = 200./(rad+0.1)
323 !!! HARDWIRE VALUES FOR TESTING
324 ! z=0.4727409
325 ! tc=22.76083
326 ! t=tc+273.15
327 ! rad = 412.8426
328 ! rainflag=.false.
329 ! wetflag=.false.
331 IF ((tc<=0.) .OR. (tc>=40.)) THEN
332 rs = 9999.
333 ELSE
334 rs = ri(iland,iseason)*(1+z*z)*(400./(tc*(40.-tc)))
335 END IF
336 rdc = 100*(1.+1000./(rad+10))/(1+1000.*rdtheta)
337 rluo1 = 1./(1./3000.+1./3./rlu(iland,iseason))
338 rluo2 = 1./(1./1000.+1./3./rlu(iland,iseason))
339 resice = 1000.*exp(-tc-4.)
341 DO n = 1, numgas
342 IF (hstar(n)==0.) GO TO 10
343 hstary(n) = hstar(n)*exp(dhr(n)*(1./t-1./298.))
344 rmx = 1./(hstary(n)/3000.+100.*f0(n))
345 rsmx = rs*dratio(n) + rmx
346 rclx = 1./(hstary(n)/1.E+5/rcls(iland,iseason)+f0(n)/rclo(iland, &
347 iseason)) + resice
348 rgsx = 1./(hstary(n)/1.E+5/rgss(iland,iseason)+f0(n)/rgso(iland, &
349 iseason)) + resice
350 rlux = rlu(iland,iseason)/(1.E-5*hstary(n)+f0(n)) + resice
351 IF (wetflag) THEN
352 rlux = 1./(1./3./rlu(iland,iseason)+1.E-7*hstary(n)+f0(n)/rluo1)
353 END IF
354 IF (rainflag) THEN
355 rlux = 1./(1./3./rlu(iland,iseason)+1.E-7*hstary(n)+f0(n)/rluo2)
356 END IF
357 rcx(n) = 1./(1./rsmx+1./rlux+1./(rdc+rclx)+1./(rac(iland, &
358 iseason)+rgsx))
359 IF (rcx(n)<1.) rcx(n) = 1.
360 10 END DO
362 ! SPECIAL TREATMENT FOR OZONE
363 if(p_o3.gt.1)then
364 hstary(p_o3) = hstar(p_o3)*exp(dhr(p_o3)*(1./t-1./298.))
365 rmx = 1./(hstary(p_o3)/3000.+100.*f0(p_o3))
366 rsmx = rs*dratio(p_o3) + rmx
367 rlux = rlu(iland,iseason)/(1.E-5*hstary(p_o3)+f0(p_o3)) + resice
368 rclx = rclo(iland,iseason) + resice
369 rgsx = rgso(iland,iseason) + resice
370 IF (wetflag) rlux = rluo1
371 IF (rainflag) rlux = rluo2
372 rcx(p_o3) = 1./(1./rsmx+1./rlux+1./(rdc+rclx)+1./(min(100.,rac(iland, &
373 iseason))+rgsx))
374 IF (rcx(p_o3)<1.) rcx(p_o3) = 1.
375 endif
377 ! SPECIAL TREATMENT FOR SO2 (Wesely)
378 ! HSTARY(P_SO2)=HSTAR(P_SO2)*EXP(DHR(P_SO2)*(1./T-1./298.))
379 ! RMX=1./(HSTARY(P_SO2)/3000.+100.*F0(P_SO2))
380 ! RSMX=RS*DRATIO(P_SO2)+RMX
381 ! RLUX=RLU(ILAND,ISEASON)/(1.E-5*HSTARY(P_SO2)+F0(P_SO2))
382 ! & +RESICE
383 ! RCLX=RCLS(ILAND,ISEASON)+RESICE
384 ! RGSX=RGSS(ILAND,ISEASON)+RESICE
385 ! IF ((wetflag).OR.(RAINFLAG)) THEN
386 ! IF (ILAND.EQ.1) THEN
387 ! RLUX=50.
388 ! ELSE
389 ! RLUX=100.
390 ! END IF
391 ! END IF
392 ! RCX(P_SO2)=1./(1./RSMX+1./RLUX+1./(RDC+RCLX)
393 ! & +1./(RAC(ILAND,ISEASON)+RGSX))
394 ! IF (RCX(P_SO2).LT.1.) RCX(P_SO2)=1.
396 ! SO2 according to Erisman et al. 1994
397 ! R_STOM
398 rsmx = rs*dratio(p_so2)
399 ! R_EXT
400 IF (tc>(-1.)) THEN
401 IF (rh<81.3) THEN
402 rlux = 25000.*exp(-0.0693*rh)
403 ELSE
404 rlux = 0.58E12*exp(-0.278*rh)
405 END IF
406 END IF
407 IF (((wetflag) .OR. (rainflag)) .AND. (tc>(-1.))) THEN
408 rlux = 1.
409 END IF
410 IF ((tc>=(-5.)) .AND. (tc<=(-1.))) THEN
411 rlux = 200.
412 END IF
413 IF (tc<(-5.)) THEN
414 rlux = 500.
415 END IF
416 ! INSTEAD OF R_INC R_CL and R_DC of Wesely are used
417 rclx = rcls(iland,iseason)
418 ! DRY SURFACE
419 rgsx = 1000.
420 ! WET SURFACE
421 IF ((wetflag) .OR. (rainflag)) THEN
422 IF (highnh3) THEN
423 rgsx = 0.
424 ELSE
425 rgsx = 500.
426 END IF
427 END IF
428 ! WATER
429 IF (iland==iswater_temp) THEN
430 rgsx = 0.
431 END IF
432 ! SNOW
433 IF ((iseason==4) .OR. (iland==isice_temp)) THEN
434 IF (tc>2.) THEN
435 rgsx = 0.
436 END IF
437 IF ((tc>=(-1.)) .AND. (tc<=2.)) THEN
438 rgsx = 70.*(2.-tc)
439 END IF
440 IF (tc<(-1.)) THEN
441 rgsx = 500.
442 END IF
443 END IF
444 ! TOTAL SURFACE RESISTENCE
445 IF ((iseason/=4) .AND. (ixxxlu(iland)/=1) .AND. (iland/=iswater_temp) .AND. &
446 (iland/=isice_temp)) THEN
447 rcx(p_so2) = 1./(1./rsmx+1./rlux+1./(rclx+rdc+rgsx))
448 ELSE
449 rcx(p_so2) = rgsx
450 END IF
451 IF (rcx(p_so2)<1.) rcx(p_so2) = 1.
452 ! NH3 according to Erisman et al. 1994
453 ! R_STOM
454 !
455 !
456 if(p_nh3.gt.1)then
457 !
458 !
459 rsmx = rs*dratio(p_nh3)
460 ! GRASSLAND (PASTURE DURING GRAZING)
461 IF (ixxxlu(iland)==3) THEN
462 IF (iseason==1) THEN
463 ! SUMMER
464 rcx(p_nh3) = 1000.
465 END IF
466 IF ((iseason==2) .OR. (iseason==3) .OR. (iseason==5)) THEN
467 ! WINTER, NO SNOW
468 IF (tc>-1.) THEN
469 IF (rad/=0.) THEN
470 rcx(p_nh3) = 50.
471 ELSE
472 rcx(p_nh3) = 100.
473 END IF
474 IF ((wetflag) .OR. (rainflag)) THEN
475 rcx(p_nh3) = 20.
476 END IF
477 END IF
478 IF ((tc>=(-5.)) .AND. (tc<=-1.)) THEN
479 rcx(p_nh3) = 200.
480 END IF
481 IF (tc<(-5.)) THEN
482 rcx(p_nh3) = 500.
483 END IF
484 END IF
485 END IF
486 ! AGRICULTURAL LAND (CROPS AND UNGRAZED PASTURE)
487 IF (ixxxlu(iland)==2) THEN
488 IF (iseason==1) THEN
489 ! SUMMER
490 IF (rad/=0.) THEN
491 rcx(p_nh3) = rsmx
492 ELSE
493 rcx(p_nh3) = 200.
494 END IF
495 IF ((wetflag) .OR. (rainflag)) THEN
496 rcx(p_nh3) = 50.
497 END IF
498 END IF
499 IF ((iseason==2) .OR. (iseason==3) .OR. (iseason==5)) THEN
500 ! WINTER, NO SNOW
501 IF (tc>-1.) THEN
502 IF (rad/=0.) THEN
503 rcx(p_nh3) = rsmx
504 ELSE
505 rcx(p_nh3) = 300.
506 END IF
507 IF ((wetflag) .OR. (rainflag)) THEN
508 rcx(p_nh3) = 100.
509 END IF
510 END IF
511 IF ((tc>=(-5.)) .AND. (tc<=-1.)) THEN
512 rcx(p_nh3) = 200.
513 END IF
514 IF (tc<(-5.)) THEN
515 rcx(p_nh3) = 500.
516 END IF
517 END IF
518 END IF
519 ! SEMI-NATURAL ECOSYSTEMS AND FORESTS
520 IF ((ixxxlu(iland)==4) .OR. (ixxxlu(iland)==5) .OR. (ixxxlu( &
521 iland)==6)) THEN
522 IF (rad/=0.) THEN
523 rcx(p_nh3) = 500.
524 ELSE
525 rcx(p_nh3) = 1000.
526 END IF
527 IF ((wetflag) .OR. (rainflag)) THEN
528 IF (highnh3) THEN
529 rcx(p_nh3) = 100.
530 ELSE
531 rcx(p_nh3) = 0.
532 END IF
533 END IF
534 IF ((iseason==2) .OR. (iseason==3) .OR. (iseason==5)) THEN
535 ! WINTER, NO SNOW
536 IF ((tc>=(-5.)) .AND. (tc<=-1.)) THEN
537 rcx(p_nh3) = 200.
538 END IF
539 IF (tc<(-5.)) THEN
540 rcx(p_nh3) = 500.
541 END IF
542 END IF
543 END IF
544 ! WATER
545 IF (iland==iswater_temp) THEN
546 rcx(p_nh3) = 0.
547 END IF
548 ! URBAN AND DESERT (SOIL SURFACES)
549 IF (ixxxlu(iland)==1) THEN
550 IF ( .NOT. wetflag) THEN
551 rcx(p_nh3) = 50.
552 ELSE
553 rcx(p_nh3) = 0.
554 END IF
555 END IF
556 ! SNOW COVERED SURFACES OR PERMANENT ICE
557 IF ((iseason==4) .OR. (iland==isice_temp)) THEN
558 IF (tc>2.) THEN
559 rcx(p_nh3) = 0.
560 END IF
561 IF ((tc>=(-1.)) .AND. (tc<=2.)) THEN
562 rcx(p_nh3) = 70.*(2.-tc)
563 END IF
564 IF (tc<(-1.)) THEN
565 rcx(p_nh3) = 500.
566 END IF
567 END IF
568 IF (rcx(p_nh3)<1.) rcx(p_nh3) = 1.
569 endif
570 END SUBROUTINE rc
571 ! **********************************************************************
572 ! ************************ SUBROUTINE DEPPART **************************
573 ! **********************************************************************
574 SUBROUTINE deppart(rmol,ustar,rh,clw,iland,dvpart,dvfog)
575 ! THIS SUBROUTINE CALCULATES SURFACE DEPOSITION VELOCITIES
576 ! FOR FINE AEROSOL PARTICLES ACCORDING TO THE MODEL OF
577 ! J. W. ERISMAN, A. VAN PUL, AND P. WYERS,
578 ! ATMOSPHERIC ENVIRONMENT 28 (1994), 2595-2607
579 ! WRITTEN BY WINFRIED SEIDL, APRIL 1997
580 ! MODIFIED BY WINFRIED SEIDL, MARCH 2000
581 ! FOR MM5 VERSION 3
582 ! ----------------------------------------------------------------------
583 ! .. Scalar Arguments ..
584 REAL :: clw, dvfog, dvpart, rh, rmol, ustar
585 INTEGER :: iland
586 ! ..
587 ! .. Intrinsic Functions ..
588 INTRINSIC exp
589 ! ..
590 dvpart = ustar/kpart(iland)
591 IF (rmol<0.) THEN
592 ! INSTABLE LAYERING CORRECTION
593 dvpart = dvpart*(1.+(-300.*rmol)**0.66667)
594 END IF
595 IF (rh>80.) THEN
596 ! HIGH RELATIVE HUMIDITY CORRECTION
597 ! ACCORDING TO J. W. ERISMAN ET AL.
598 ! ATMOSPHERIC ENVIRONMENT 31 (1997), 321-332
599 dvpart = dvpart*(1.+0.37*exp((rh-80.)/20.))
600 END IF
602 ! SEDIMENTATION VELOCITY OF FOG WATER ACCORDING TO
603 ! R. FORKEL, W. SEIDL, R. DLUGI AND E. DEIGELE
604 ! J. GEOPHYS. RES. 95D (1990), 18501-18515
605 dvfog = 0.06*clw
606 IF (ixxxlu(iland)==5) THEN
607 ! TURBULENT DEPOSITION OF FOG WATER IN CONIFEROUS FOREST ACCORDI
608 ! A. T. VERMEULEN ET AL.
609 ! ATMOSPHERIC ENVIRONMENT 31 (1997), 375-386
610 dvfog = dvfog + 0.195*ustar*ustar
611 END IF
613 END SUBROUTINE deppart
614 SUBROUTINE landusevg(vgs,ustar,rmol,z0,zz,dvparx,iland,numgas, &
615 srfres,aer_res_def,aer_res_zcen,p_sulf)
616 ! This subroutine calculates the species specific deposition velocit
617 ! as a function of the local meteorology and land use. The depositi
618 ! Velocity is also landuse specific.
619 ! Reference: Hsieh, C.M., Wesely, M.L. and Walcek, C.J. (1986)
620 ! A Dry Deposition Module for Regional Acid Deposition
621 ! EPA report under agreement DW89930060-01
622 ! Revised version by Darrell Winner (January 1991)
623 ! Environmental Engineering Science 138-78
624 ! California Institute of Technology
625 ! Pasadena, CA 91125
626 ! Modified by Winfried Seidl (August 1997)
627 ! Fraunhofer-Institut fuer Atmosphaerische Umweltforschung
628 ! Garmisch-Partenkirchen, D-82467
629 ! for use of Wesely and Erisman surface resistances
630 ! Inputs:
631 ! Ustar : The grid average friction velocity (m/s)
632 ! Rmol : Reciprocal of the Monin-Obukhov length (1/m)
633 ! Z0 : Surface roughness height for the grid square (m)
634 ! SrfRes : Array of landuse/atmospheric/species resistances (s/m)
635 ! Slist : Array of chemical species codes
636 ! Dvparx : Array of surface deposition velocity of fine aerosol p
637 ! Outputs:
638 ! Vgs : Array of species and landuse specific deposition
639 ! velocities (m/s)
640 ! Vg : Cell-average deposition velocity by species (m/s)
641 ! Variables used:
642 ! SCPR23 : (Schmidt #/Prandtl #)**(2/3) Diffusion correction fac
643 ! Zr : Reference Height (m)
644 ! Iatmo : Parameter specifying the stabilty class (Function of
645 ! Z0 : Surface roughness height (m)
646 ! karman : Von Karman constant (from module_model_constants)
647 USE module_model_constants, only: karman
648 ! Local Variables
649 ! .. Scalar Arguments ..
650 REAL :: dvparx, rmol, ustar, z0, zz
651 real :: aer_res_def, aer_res_zcen, polint
652 INTEGER :: iland, numgas, p_sulf
653 ! ..
654 ! .. Array Arguments ..
655 REAL :: srfres(numgas), vgs(numgas)
656 ! ..
657 ! .. Local Scalars ..
658 REAL :: rmol_tmp, vgp, vgpart, zr
659 INTEGER :: jspec
660 ! ..
661 ! .. Local Arrays ..
662 REAL :: vgspec(numgas)
663 ! ..
664 ! Calculate aerodynamic resistance for reference height = layer center
665 zr = zz*0.5
666 rmol_tmp = rmol
667 CALL depvel(numgas,rmol_tmp,zr,z0,ustar,vgspec,vgpart,aer_res_zcen)
668 ! Set the reference height (10.0 m)
669 ! zr = 10.0
670 zr = 2.0
672 ! CALCULATE THE DEPOSITION VELOCITY without any surface
673 ! resistance term, i.e. 1 / (ra + rb)
674 CALL depvel(numgas,rmol,zr,z0,ustar,vgspec,vgpart,aer_res_def)
676 ! Calculate the deposition velocity for each species
677 ! and grid cell by looping through all the possibile combinations
678 ! of the two
680 vgp = 1.0/((1.0/vgpart)+(1.0/dvparx))
682 ! Loop through the various species
684 DO jspec = 1, numgas
686 ! Add in the surface resistance term, rc (SrfRes)
688 vgs(jspec) = 1.0/(1.0/vgspec(jspec)+srfres(jspec))
689 END DO
690 vgs(p_sulf) = vgp
692 CALL cellvg(vgs,ustar,zz,zr,rmol,numgas)
694 RETURN
695 END SUBROUTINE landusevg
697 SUBROUTINE cellvg(vgtemp,ustar,dz,zr,rmol,nspec)
698 ! THIS PROGRAM HAS BEEN DESIGNED TO CALCULATE THE CELL AVERAGE
699 ! DEPOSITION VELOCITY GIVEN THE VALUE OF VG AT SOME REFERENCE
700 ! HEIGHT ZR WHICH IS MUCH SMALLER THAN THE CELL HEIGHT DZ.
701 ! PROGRAM WRITTEN BY GREGORY J.MCRAE (NOVEMBER 1977)
702 ! Modified by Darrell A. Winner (February 1991)
703 !.....PROGRAM VARIABLES...
704 ! VgTemp - DEPOSITION VELOCITY AT THE REFERENCE HEIGHT
705 ! USTAR - FRICTION VELOCITY
706 ! RMOL - RECIPROCAL OF THE MONIN-OBUKHOV LENGTH
707 ! ZR - REFERENCE HEIGHT
708 ! DZ - CELL HEIGHT
709 ! CELLVG - CELL AVERAGE DEPOSITION VELOCITY
710 ! VK - VON KARMAN CONSTANT
711 USE module_model_constants, only: karman
712 ! Local Variables
713 ! .. Scalar Arguments ..
714 REAL :: dz, rmol, ustar, zr
715 INTEGER :: nspec
716 ! ..
717 ! .. Array Arguments ..
718 REAL :: vgtemp(nspec)
719 ! ..
720 ! .. Local Scalars ..
721 REAL :: a, fac, pdz, pzr, vk
722 INTEGER :: nss
723 ! ..
724 ! .. Intrinsic Functions ..
725 INTRINSIC alog, sqrt
726 ! ..
727 ! Set the von Karman constant
728 vk = karman
730 ! DETERMINE THE STABILITY BASED ON THE CONDITIONS
731 ! 1/L < 0 UNSTABLE
732 ! 1/L = 0 NEUTRAL
733 ! 1/L > 0 STABLE
736 DO nss = 1, nspec
737 IF (rmol<0) THEN
738 pdz = sqrt(1.0-9.0*dz*rmol)
739 pzr = sqrt(1.0-9.0*zr*rmol)
740 fac = ((pdz-1.0)/(pzr-1.0))*((pzr+1.0)/(pdz+1.0))
741 a = 0.74*dz*alog(fac) + (0.164/rmol)*(pdz-pzr)
742 ELSE IF (rmol==0) THEN
743 a = 0.74*(dz*alog(dz/zr)-dz+zr)
744 ELSE
745 a = 0.74*(dz*alog(dz/zr)-dz+zr) + (2.35*rmol)*(dz-zr)**2
746 END IF
748 ! CALCULATE THE DEPOSITION VELOCITIY
750 vgtemp(nss) = vgtemp(nss)/(1.0+vgtemp(nss)*a/(vk*ustar*(dz-zr)))
751 END DO
753 RETURN
754 END SUBROUTINE cellvg
755 SUBROUTINE depvel(numgas,rmol,zr,z0,ustar,depv,vgpart,aer_res)
756 ! THIS FUNCTION HAS BEEN DESIGNED TO EVALUATE AN UPPER LIMIT
757 ! FOR THE POLLUTANT DEPOSITION VELOCITY AS A FUNCTION OF THE
758 ! SURFACE ROUGHNESS AND METEOROLOGICAL CONDITIONS.
759 ! PROGRAM WRITTEN BY GREGORY J.MCRAE (NOVEMBER 1977)
760 ! Modified by Darrell A. Winner (Feb. 1991)
761 ! by Winfried Seidl (Aug. 1997)
762 !.....PROGRAM VARIABLES...
763 ! RMOL - RECIPROCAL OF THE MONIN-OBUKHOV LENGTH
764 ! ZR - REFERENCE HEIGHT
765 ! Z0 - SURFACE ROUGHNESS HEIGHT
766 ! SCPR23 - (Schmidt #/Prandtl #)**(2/3) Diffusion correction fact
767 ! UBAR - ABSOLUTE VALUE OF SURFACE WIND SPEED
768 ! DEPVEL - POLLUTANT DEPOSITION VELOCITY
769 ! Vk - VON KARMAN CONSTANT
770 ! USTAR - FRICTION VELOCITY U*
771 ! POLINT - POLLUTANT INTEGRAL
772 ! AER_RES - AERODYNAMIC RESISTANCE
773 !.....REFERENCES...
774 ! MCRAE, G.J. ET AL. (1983) MATHEMATICAL MODELING OF PHOTOCHEMICAL
775 ! AIR POLLUTION, ENVIRONMENTAL QUALITY LABORATORY REPORT 18,
776 ! CALIFORNIA INSTITUTE OF TECHNOLOGY, PASADENA, CALIFORNIA.
777 !.....RESTRICTIONS...
778 ! 1. THE MODEL EDDY DIFFUSIVITIES ARE BASED ON MONIN-OBUKHOV
779 ! SIMILARITY THEORY AND SO ARE ONLY APPLICABLE IN THE
780 ! SURFACE LAYER, A HEIGHT OF O(30M).
781 ! 2. ALL INPUT UNITS MUST BE CONSISTENT
782 ! 3. THE PHI FUNCTIONS USED TO CALCULATE THE FRICTION
783 ! VELOCITY U* AND THE POLLUTANT INTEGRALS ARE BASED
784 ! ON THE WORK OF BUSINGER ET AL.(1971).
785 ! 4. THE MOMENTUM AND POLLUTANT DIFFUSIVITIES ARE NOT
786 ! THE SAME FOR THE CASES L<0 AND L>0.
787 USE module_model_constants, only: karman
788 ! Local Variables
789 ! .. Scalar Arguments ..
790 REAL :: rmol, ustar, vgpart, z0, zr, aer_res
791 INTEGER :: numgas
792 ! ..
793 ! .. Array Arguments ..
794 REAL :: depv(numgas)
795 ! ..
796 ! .. Local Scalars ..
797 REAL :: ao, ar, polint, vk
798 INTEGER :: l
799 ! ..
800 ! .. Intrinsic Functions ..
801 INTRINSIC alog
802 ! ..
803 ! Set the von Karman constant
804 vk = karman
806 ! Calculate the diffusion correction factor
807 ! SCPR23 is calculated as (Sc/Pr)**(2/3) using Sc= 1.15 and Pr= 1.0
808 ! SCPR23 = 1.10
810 ! DETERMINE THE STABILITY BASED ON THE CONDITIONS
811 ! 1/L < 0 UNSTABLE
812 ! 1/L = 0 NEUTRAL
813 ! 1/L > 0 STABLE
815 if(abs(rmol) < 1.E-6 ) rmol = 0.
817 IF (rmol<0) THEN
818 ar = ((1.0-9.0*zr*rmol)**(0.25)+0.001)**2
819 ao = ((1.0-9.0*z0*rmol)**(0.25)+0.001)**2
820 polint = 0.74*(alog((ar-1.0)/(ar+1.0))-alog((ao-1.0)/(ao+1.0)))
821 ELSE IF (rmol==0.) THEN
822 polint = 0.74*alog(zr/z0)
823 ELSE
824 polint = 0.74*alog(zr/z0) + 4.7*rmol*(zr-z0)
825 END IF
827 ! CALCULATE THE Maximum DEPOSITION VELOCITY
829 DO l = 1, numgas
830 depv(l) = ustar*vk/(2.0*scpr23(l)+polint)
831 END DO
832 vgpart = ustar*vk/polint
833 aer_res = polint/(karman*max(ustar,1.0e-4))
835 RETURN
836 END SUBROUTINE depvel
838 SUBROUTINE dep_init(id,config_flags,numgas)
839 USE module_model_constants
840 USE module_configure
841 USE module_state_description
842 TYPE (grid_config_rec_type) , INTENT (in) :: config_flags
843 ! ..
844 ! .. Scalar Arguments ..
845 integer, intent(in) :: id, numgas
847 ! ..
848 ! .. Local Scalars ..
849 REAL :: sc
850 INTEGER :: iland, iseason, l
851 integer :: iprt
852 ! ..
853 ! .. Local Arrays ..
854 REAL :: dat1(nlu,dep_seasons), dat2(nlu,dep_seasons), &
855 dat3(nlu,dep_seasons), dat4(nlu,dep_seasons), &
856 dat5(nlu,dep_seasons), dat6(nlu,dep_seasons), &
857 dat7(nlu,dep_seasons), dvj(numgas)
858 ! ..
859 ! .. Make sure that the model is being run with a soil model. Otherwise,
860 ! iland will be zero in deppart, which will try to pull non-exisant
861 ! array locations.
862 call nl_get_sf_surface_physics(id,l)
863 if( l == 0 ) &
864 call wrf_error_fatal("ERROR: Cannot use dry deposition without using a soil model.")
866 ! ..
867 ! .. Data Statements ..
868 ! RI for stomatal resistance
869 ! data ((ri(ILAND,ISEASON),ILAND=1,nlu),ISEASON=1,dep_seasons)/0.10E+11, &
870 DATA ((dat1(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.10E+11, &
871 0.60E+02, 0.60E+02, 0.60E+02, 0.60E+02, 0.70E+02, 0.12E+03, &
872 0.12E+03, 0.12E+03, 0.12E+03, 0.70E+02, 0.13E+03, 0.70E+02, &
873 0.13E+03, 0.10E+03, 0.10E+11, 0.80E+02, 0.10E+03, 0.10E+11, &
874 0.80E+02, 0.10E+03, 0.10E+03, 0.10E+11, 0.10E+11, 0.10E+11, &
875 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
876 0.10E+11, 0.10E+11, 0.10E+11, 0.12E+03, 0.10E+11, 0.10E+11, &
877 0.70E+02, 0.25E+03, 0.50E+03, 0.10E+11, 0.10E+11, 0.50E+03, &
878 0.10E+11, 0.10E+11, 0.50E+03, 0.50E+03, 0.10E+11, 0.10E+11, &
879 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
880 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.12E+03, 0.10E+11, &
881 0.10E+11, 0.70E+02, 0.25E+03, 0.50E+03, 0.10E+11, 0.10E+11, &
882 0.50E+03, 0.10E+11, 0.10E+11, 0.50E+03, 0.50E+03, 0.10E+11, &
883 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
884 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
885 0.10E+11, 0.10E+11, 0.70E+02, 0.40E+03, 0.80E+03, 0.10E+11, &
886 0.10E+11, 0.80E+03, 0.10E+11, 0.10E+11, 0.80E+03, 0.80E+03, &
887 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.12E+03, 0.12E+03, &
888 0.12E+03, 0.12E+03, 0.14E+03, 0.24E+03, 0.24E+03, 0.24E+03, &
889 0.12E+03, 0.14E+03, 0.25E+03, 0.70E+02, 0.25E+03, 0.19E+03, &
890 0.10E+11, 0.16E+03, 0.19E+03, 0.10E+11, 0.16E+03, 0.19E+03, &
891 0.19E+03, 0.10E+11, 0.10E+11, 0.10E+11/
892 ! ..
893 IF (nlu/=25) THEN
894 call wrf_debug(0, 'number of land use classifications not correct ')
895 CALL wrf_error_fatal ( "LAND USE CLASSIFICATIONS NOT 25")
896 END IF
897 IF (dep_seasons/=5) THEN
898 call wrf_debug(0, 'number of dep_seasons not correct ')
899 CALL wrf_error_fatal ( "DEP_SEASONS NOT 5")
900 END IF
902 ! SURFACE RESISTANCE DATA FOR DEPOSITION MODEL OF
903 ! M. L. WESELY, ATMOSPHERIC ENVIRONMENT 23 (1989) 1293-1304
905 ! Seasonal categories:
906 ! 1: midsummer with lush vegetation
907 ! 2: autumn with unharvested cropland
908 ! 3: late autumn with frost, no snow
909 ! 4: winter, snow on ground and subfreezing
910 ! 5: transitional spring with partially green short annuals
912 ! Land use types:
913 ! USGS type Wesely type
914 ! 1: Urban and built-up land 1
915 ! 2: Dryland cropland and pasture 2
916 ! 3: Irrigated cropland and pasture 2
917 ! 4: Mix. dry/irrg. cropland and pasture 2
918 ! 5: Cropland/grassland mosaic 2
919 ! 6: Cropland/woodland mosaic 4
920 ! 7: Grassland 3
921 ! 8: Shrubland 3
922 ! 9: Mixed shrubland/grassland 3
923 ! 10: Savanna 3, always summer
924 ! 11: Deciduous broadleaf forest 4
925 ! 12: Deciduous needleleaf forest 5, autumn and winter modi
926 ! 13: Evergreen broadleaf forest 4, always summer
927 ! 14: Evergreen needleleaf forest 5
928 ! 15: Mixed Forest 6
929 ! 16: Water Bodies 7
930 ! 17: Herbaceous wetland 9
931 ! 18: Wooded wetland 6
932 ! 19: Barren or sparsely vegetated 8
933 ! 20: Herbaceous Tundra 9
934 ! 21: Wooded Tundra 6
935 ! 22: Mixed Tundra 6
936 ! 23: Bare Ground Tundra 8
937 ! 24: Snow or Ice -, always winter
938 ! 25: No data 8
941 ! Order of data:
942 ! |
943 ! | seasonal category
944 ! \|/
945 ! ---> landuse type
946 ! 1 2 3 4 5 6 7 8 9
947 ! RLU for outer surfaces in the upper canopy
948 DO iseason = 1, dep_seasons
949 DO iland = 1, nlu
950 ri(iland,iseason) = dat1(iland,iseason)
951 END DO
952 END DO
953 ! data ((rlu(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.10E+11, &
954 DATA ((dat2(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.10E+11, &
955 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, &
956 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, &
957 0.20E+04, 0.20E+04, 0.10E+11, 0.25E+04, 0.20E+04, 0.10E+11, &
958 0.25E+04, 0.20E+04, 0.20E+04, 0.10E+11, 0.10E+11, 0.10E+11, &
959 0.10E+11, 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, &
960 0.90E+04, 0.90E+04, 0.90E+04, 0.20E+04, 0.90E+04, 0.90E+04, &
961 0.20E+04, 0.40E+04, 0.80E+04, 0.10E+11, 0.90E+04, 0.80E+04, &
962 0.10E+11, 0.90E+04, 0.80E+04, 0.80E+04, 0.10E+11, 0.10E+11, &
963 0.10E+11, 0.10E+11, 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, &
964 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, 0.20E+04, 0.90E+04, &
965 0.90E+04, 0.20E+04, 0.40E+04, 0.80E+04, 0.10E+11, 0.90E+04, &
966 0.80E+04, 0.10E+11, 0.90E+04, 0.80E+04, 0.80E+04, 0.10E+11, &
967 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
968 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
969 0.10E+11, 0.10E+11, 0.20E+04, 0.60E+04, 0.90E+04, 0.10E+11, &
970 0.90E+04, 0.90E+04, 0.10E+11, 0.90E+04, 0.90E+04, 0.90E+04, &
971 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.40E+04, 0.40E+04, &
972 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, &
973 0.20E+04, 0.40E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.30E+04, &
974 0.10E+11, 0.40E+04, 0.30E+04, 0.10E+11, 0.40E+04, 0.30E+04, &
975 0.30E+04, 0.10E+11, 0.10E+11, 0.10E+11/
976 DO iseason = 1, dep_seasons
977 DO iland = 1, nlu
978 rlu(iland,iseason) = dat2(iland,iseason)
979 END DO
980 END DO
981 ! RAC for transfer that depends on canopy height and density
982 ! data ((rac(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.10E+03, &
983 DATA ((dat3(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.10E+03, &
984 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+04, 0.10E+03, &
985 0.10E+03, 0.10E+03, 0.10E+03, 0.20E+04, 0.20E+04, 0.20E+04, &
986 0.20E+04, 0.20E+04, 0.00E+00, 0.30E+03, 0.20E+04, 0.00E+00, &
987 0.30E+03, 0.20E+04, 0.20E+04, 0.00E+00, 0.00E+00, 0.00E+00, &
988 0.10E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+04, &
989 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, 0.15E+04, 0.20E+04, &
990 0.20E+04, 0.20E+04, 0.17E+04, 0.00E+00, 0.20E+03, 0.17E+04, &
991 0.00E+00, 0.20E+03, 0.17E+04, 0.17E+04, 0.00E+00, 0.00E+00, &
992 0.00E+00, 0.10E+03, 0.10E+02, 0.10E+02, 0.10E+02, 0.10E+02, &
993 0.10E+04, 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+04, &
994 0.20E+04, 0.20E+04, 0.20E+04, 0.15E+04, 0.00E+00, 0.10E+03, &
995 0.15E+04, 0.00E+00, 0.10E+03, 0.15E+04, 0.15E+04, 0.00E+00, &
996 0.00E+00, 0.00E+00, 0.10E+03, 0.10E+02, 0.10E+02, 0.10E+02, &
997 0.10E+02, 0.10E+04, 0.10E+02, 0.10E+02, 0.10E+02, 0.10E+02, &
998 0.10E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.15E+04, 0.00E+00, &
999 0.50E+02, 0.15E+04, 0.00E+00, 0.50E+02, 0.15E+04, 0.15E+04, &
1000 0.00E+00, 0.00E+00, 0.00E+00, 0.10E+03, 0.50E+02, 0.50E+02, &
1001 0.50E+02, 0.50E+02, 0.12E+04, 0.80E+02, 0.80E+02, 0.80E+02, &
1002 0.10E+03, 0.12E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.15E+04, &
1003 0.00E+00, 0.20E+03, 0.15E+04, 0.00E+00, 0.20E+03, 0.15E+04, &
1004 0.15E+04, 0.00E+00, 0.00E+00, 0.00E+00/
1005 DO iseason = 1, dep_seasons
1006 DO iland = 1, nlu
1007 rac(iland,iseason) = dat3(iland,iseason)
1008 END DO
1009 END DO
1010 ! RGSS for ground surface SO2
1011 ! data ((rgss(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.40E+03, &
1012 DATA ((dat4(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.40E+03, &
1013 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.50E+03, 0.35E+03, &
1014 0.35E+03, 0.35E+03, 0.35E+03, 0.50E+03, 0.50E+03, 0.50E+03, &
1015 0.50E+03, 0.10E+03, 0.10E+01, 0.10E+01, 0.10E+03, 0.10E+04, &
1016 0.10E+01, 0.10E+03, 0.10E+03, 0.10E+04, 0.10E+03, 0.10E+04, &
1017 0.40E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.50E+03, &
1018 0.35E+03, 0.35E+03, 0.35E+03, 0.35E+03, 0.50E+03, 0.50E+03, &
1019 0.50E+03, 0.50E+03, 0.10E+03, 0.10E+01, 0.10E+01, 0.10E+03, &
1020 0.10E+04, 0.10E+01, 0.10E+03, 0.10E+03, 0.10E+04, 0.10E+03, &
1021 0.10E+04, 0.40E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, &
1022 0.50E+03, 0.35E+03, 0.35E+03, 0.35E+03, 0.35E+03, 0.50E+03, &
1023 0.50E+03, 0.50E+03, 0.50E+03, 0.20E+03, 0.10E+01, 0.10E+01, &
1024 0.20E+03, 0.10E+04, 0.10E+01, 0.20E+03, 0.20E+03, 0.10E+04, &
1025 0.10E+03, 0.10E+04, 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, &
1026 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, 0.10E+03, &
1027 0.10E+03, 0.10E+03, 0.50E+03, 0.10E+03, 0.10E+03, 0.10E+01, &
1028 0.10E+03, 0.10E+03, 0.10E+04, 0.10E+03, 0.10E+03, 0.10E+03, &
1029 0.10E+04, 0.10E+03, 0.10E+04, 0.50E+03, 0.15E+03, 0.15E+03, &
1030 0.15E+03, 0.15E+03, 0.50E+03, 0.35E+03, 0.35E+03, 0.35E+03, &
1031 0.35E+03, 0.50E+03, 0.50E+03, 0.50E+03, 0.50E+03, 0.20E+03, &
1032 0.10E+01, 0.10E+01, 0.20E+03, 0.10E+04, 0.10E+01, 0.20E+03, &
1033 0.20E+03, 0.10E+04, 0.10E+03, 0.10E+04/
1034 DO iseason = 1, dep_seasons
1035 DO iland = 1, nlu
1036 rgss(iland,iseason) = dat4(iland,iseason)
1037 END DO
1038 END DO
1039 ! RGSO for ground surface O3
1040 ! data ((rgso(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.30E+03, &
1041 DATA ((dat5(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.30E+03, &
1042 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.20E+03, 0.20E+03, &
1043 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, &
1044 0.20E+03, 0.30E+03, 0.20E+04, 0.10E+04, 0.30E+03, 0.40E+03, &
1045 0.10E+04, 0.30E+03, 0.30E+03, 0.40E+03, 0.35E+04, 0.40E+03, &
1046 0.30E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.20E+03, &
1047 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, &
1048 0.20E+03, 0.20E+03, 0.30E+03, 0.20E+04, 0.80E+03, 0.30E+03, &
1049 0.40E+03, 0.80E+03, 0.30E+03, 0.30E+03, 0.40E+03, 0.35E+04, &
1050 0.40E+03, 0.30E+03, 0.15E+03, 0.15E+03, 0.15E+03, 0.15E+03, &
1051 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, &
1052 0.20E+03, 0.20E+03, 0.20E+03, 0.30E+03, 0.20E+04, 0.10E+04, &
1053 0.30E+03, 0.40E+03, 0.10E+04, 0.30E+03, 0.30E+03, 0.40E+03, &
1054 0.35E+04, 0.40E+03, 0.60E+03, 0.35E+04, 0.35E+04, 0.35E+04, &
1055 0.35E+04, 0.35E+04, 0.35E+04, 0.35E+04, 0.35E+04, 0.35E+04, &
1056 0.35E+04, 0.35E+04, 0.20E+03, 0.35E+04, 0.35E+04, 0.20E+04, &
1057 0.35E+04, 0.35E+04, 0.40E+03, 0.35E+04, 0.35E+04, 0.35E+04, &
1058 0.40E+03, 0.35E+04, 0.40E+03, 0.30E+03, 0.15E+03, 0.15E+03, &
1059 0.15E+03, 0.15E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, &
1060 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.20E+03, 0.30E+03, &
1061 0.20E+04, 0.10E+04, 0.30E+03, 0.40E+03, 0.10E+04, 0.30E+03, &
1062 0.30E+03, 0.40E+03, 0.35E+04, 0.40E+03/
1063 DO iseason = 1, dep_seasons
1064 DO iland = 1, nlu
1065 rgso(iland,iseason) = dat5(iland,iseason)
1066 END DO
1067 END DO
1068 ! RCLS for exposed surfaces in the lower canopy SO2
1069 ! data ((rcls(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.10E+11, &
1070 DATA ((dat6(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.10E+11, &
1071 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, &
1072 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.20E+04, &
1073 0.20E+04, 0.20E+04, 0.10E+11, 0.25E+04, 0.20E+04, 0.10E+11, &
1074 0.25E+04, 0.20E+04, 0.20E+04, 0.10E+11, 0.10E+11, 0.10E+11, &
1075 0.10E+11, 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, &
1076 0.90E+04, 0.90E+04, 0.90E+04, 0.20E+04, 0.90E+04, 0.90E+04, &
1077 0.20E+04, 0.20E+04, 0.40E+04, 0.10E+11, 0.90E+04, 0.40E+04, &
1078 0.10E+11, 0.90E+04, 0.40E+04, 0.40E+04, 0.10E+11, 0.10E+11, &
1079 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
1080 0.90E+04, 0.90E+04, 0.90E+04, 0.90E+04, 0.20E+04, 0.90E+04, &
1081 0.90E+04, 0.20E+04, 0.30E+04, 0.60E+04, 0.10E+11, 0.90E+04, &
1082 0.60E+04, 0.10E+11, 0.90E+04, 0.60E+04, 0.60E+04, 0.10E+11, &
1083 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
1084 0.10E+11, 0.90E+04, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, &
1085 0.90E+04, 0.90E+04, 0.20E+04, 0.20E+03, 0.40E+03, 0.10E+11, &
1086 0.90E+04, 0.40E+03, 0.10E+11, 0.90E+04, 0.40E+03, 0.40E+03, &
1087 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.40E+04, 0.40E+04, &
1088 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, 0.40E+04, &
1089 0.20E+04, 0.40E+04, 0.20E+04, 0.20E+04, 0.20E+04, 0.30E+04, &
1090 0.10E+11, 0.40E+04, 0.30E+04, 0.10E+11, 0.40E+04, 0.30E+04, &
1091 0.30E+04, 0.10E+11, 0.10E+11, 0.10E+11/
1092 DO iseason = 1, dep_seasons
1093 DO iland = 1, nlu
1094 rcls(iland,iseason) = dat6(iland,iseason)
1095 END DO
1096 END DO
1097 ! RCLO for exposed surfaces in the lower canopy O3
1098 ! data ((rclo(ILAND,ISEASON),ILAND=1,25),ISEASON=1,5)/0.10E+11, &
1099 DATA ((dat7(iland,iseason),iland=1,nlu),iseason=1,dep_seasons)/0.10E+11, &
1100 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, &
1101 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, &
1102 0.10E+04, 0.10E+04, 0.10E+11, 0.10E+04, 0.10E+04, 0.10E+11, &
1103 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+11, 0.10E+11, 0.10E+11, &
1104 0.10E+11, 0.40E+03, 0.40E+03, 0.40E+03, 0.40E+03, 0.40E+03, &
1105 0.40E+03, 0.40E+03, 0.40E+03, 0.10E+04, 0.40E+03, 0.40E+03, &
1106 0.10E+04, 0.10E+04, 0.60E+03, 0.10E+11, 0.40E+03, 0.60E+03, &
1107 0.10E+11, 0.40E+03, 0.60E+03, 0.60E+03, 0.10E+11, 0.10E+11, &
1108 0.10E+11, 0.10E+11, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, &
1109 0.40E+03, 0.40E+03, 0.40E+03, 0.40E+03, 0.10E+04, 0.40E+03, &
1110 0.40E+03, 0.10E+04, 0.10E+04, 0.60E+03, 0.10E+11, 0.80E+03, &
1111 0.60E+03, 0.10E+11, 0.80E+03, 0.60E+03, 0.60E+03, 0.10E+11, &
1112 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+04, 0.10E+04, 0.10E+04, &
1113 0.10E+04, 0.40E+03, 0.10E+04, 0.10E+04, 0.10E+04, 0.10E+04, &
1114 0.40E+03, 0.40E+03, 0.10E+04, 0.15E+04, 0.60E+03, 0.10E+11, &
1115 0.80E+03, 0.60E+03, 0.10E+11, 0.80E+03, 0.60E+03, 0.60E+03, &
1116 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+11, 0.10E+04, 0.10E+04, &
1117 0.10E+04, 0.10E+04, 0.50E+03, 0.50E+03, 0.50E+03, 0.50E+03, &
1118 0.10E+04, 0.50E+03, 0.15E+04, 0.10E+04, 0.15E+04, 0.70E+03, &
1119 0.10E+11, 0.60E+03, 0.70E+03, 0.10E+11, 0.60E+03, 0.70E+03, &
1120 0.70E+03, 0.10E+11, 0.10E+11, 0.10E+11/
1121 DO iseason = 1, dep_seasons
1122 DO iland = 1, nlu
1123 rclo(iland,iseason) = dat7(iland,iseason)
1124 END DO
1125 END DO
1126 DO l = 1, numgas
1127 hstar(l) = 0.
1128 hstar4(l) = 0.
1129 dhr(l) = 0.
1130 f0(l) = 0.
1131 dvj(l) = 99.
1132 END DO
1134 ! HENRY''S LAW COEFFICIENTS
1135 ! Effective Henry''s law coefficient at pH 7
1136 ! [KH298]=mole/(l atm)
1138 if (config_flags%chem_opt /= CBM4_KPP) then
1140 hstar(p_no2) = 6.40E-3
1141 hstar(p_no) = 1.90E-3
1142 hstar(p_pan) = 2.97E+0
1143 hstar(p_o3) = 1.13E-2
1144 hstar(p_hcho) = 2.97E+3
1145 hstar(p_aco3) = 1.14E+1
1146 hstar(p_tpan) = 2.97E+0
1147 hstar(p_hono) = 3.47E+5
1148 hstar(p_no3) = 1.50E+1
1149 hstar(p_hno4) = 2.00E+13
1150 hstar(p_h2o2) = 7.45E+4
1151 hstar(p_co) = 8.20E-3
1152 hstar(p_ald) = 1.14E+1
1153 hstar(p_op1) = 2.21E+2
1154 hstar(p_op2) = 1.68E+6
1155 hstar(p_paa) = 4.73E+2
1156 hstar(p_ket) = 3.30E+1
1157 hstar(p_gly) = 1.40E+6
1158 hstar(p_mgly) = 3.71E+3
1159 hstar(p_dcb) = 1.40E+6
1160 hstar(p_onit) = 1.13E+0
1161 hstar(p_so2) = 2.53E+5
1162 hstar(p_eth) = 2.00E-3
1163 hstar(p_hc3) = 1.42E-3
1164 hstar(p_hc5) = 1.13E-3
1165 hstar(p_hc8) = 1.42E-3
1166 hstar(p_olt) = 4.76E-3
1167 hstar(p_oli) = 1.35E-3
1168 hstar(p_tol) = 1.51E-1
1169 hstar(p_csl) = 4.00E+5
1170 hstar(p_xyl) = 1.45E-1
1171 hstar(p_iso) = 4.76E-3
1172 hstar(p_hno3) = 2.69E+13
1173 hstar(p_ora1) = 9.85E+6
1174 hstar(p_ora2) = 9.63E+5
1175 hstar(p_nh3) = 1.04E+4
1176 hstar(p_n2o5) = 1.00E+10
1177 if(p_ol2.gt.1) hstar(p_ol2) = 4.67E-3
1178 if(p_par.gt.1) hstar(p_par) = 1.13E-3 !wig, 1-May-2007: for CBMZ
1179 if(p_ch4.gt.1) then
1180 hstar(p_ch4) = 1.50E-3
1181 dhr(p_ch4)= 0.
1182 f0(p_ch4)=0.
1183 dvj(p_ch4)=0.250
1184 end if
1185 if(p_co2.gt.1) then
1186 hstar(p_co2) = 1.86E-1
1187 dhr(p_co2)= 1636.
1188 f0(p_co2)=0.
1189 dvj(p_co2)=0.151
1190 end if
1191 !
1192 ! FOLLOWING FOR RACM
1193 !
1194 if(p_ete.gt.1)then
1195 HSTAR(p_ETE )=4.67E-3
1196 HSTAR(p_API )=4.76E-3
1197 HSTAR(p_LIM )=4.76E-3
1198 HSTAR(p_DIEN)=4.76E-3
1199 HSTAR(p_MACR)=1.14E+1
1200 HSTAR(p_UDD )=1.40E+6
1201 HSTAR(p_HKET)=7.80E+3
1202 DHR(p_ETE )= 0.
1203 DHR(p_API )= 0.
1204 DHR(p_LIM )= 0.
1205 DHR(p_DIEN)= 0.
1206 DHR(p_MACR)= 6266.
1207 DHR(p_UDD )= 0.
1208 DHR(p_HKET)= 0.
1209 F0(p_ETE )=0.
1210 F0(p_API )=0.
1211 F0(p_LIM )=0.
1212 F0(p_DIEN)=0.
1213 F0(p_MACR)=0.
1214 F0(p_UDD )=0.
1215 F0(p_HKET)=0.
1216 DVJ(p_ETE )=0.189
1217 DVJ(p_API )=0.086
1218 DVJ(p_LIM )=0.086
1219 DVJ(p_DIEN)=0.136
1220 DVJ(p_MACR)=0.120
1221 DVJ(p_UDD )=0.092
1222 DVJ(p_HKET)=0.116
1223 endif
1224 ! -DH/R (for temperature correction)
1225 ! [-DH/R]=K
1227 dhr(p_no2) = 2500.
1228 dhr(p_no) = 1480.
1229 dhr(p_pan) = 5760.
1230 dhr(p_o3) = 2300.
1231 dhr(p_hcho) = 7190.
1232 dhr(p_aco3) = 6266.
1233 dhr(p_tpan) = 5760.
1234 dhr(p_hono) = 3775.
1235 dhr(p_no3) = 0.
1236 dhr(p_hno4) = 0.
1237 dhr(p_h2o2) = 6615.
1238 dhr(p_co) = 0.
1239 dhr(p_ald) = 6266.
1240 dhr(p_op1) = 5607.
1241 dhr(p_op2) = 10240.
1242 dhr(p_paa) = 6170.
1243 dhr(p_ket) = 5773.
1244 dhr(p_gly) = 0.
1245 dhr(p_mgly) = 7541.
1246 dhr(p_dcb) = 0.
1247 dhr(p_onit) = 5487.
1248 dhr(p_so2) = 5816.
1249 dhr(p_eth) = 0.
1250 dhr(p_hc3) = 0.
1251 dhr(p_hc5) = 0.
1252 dhr(p_hc8) = 0.
1253 dhr(p_olt) = 0.
1254 dhr(p_oli) = 0.
1255 dhr(p_tol) = 0.
1256 dhr(p_csl) = 0.
1257 dhr(p_xyl) = 0.
1258 dhr(p_iso) = 0.
1259 dhr(p_hno3) = 8684.
1260 dhr(p_ora1) = 5716.
1261 dhr(p_ora2) = 8374.
1262 dhr(p_nh3) = 3660.
1263 dhr(p_n2o5) = 0.
1264 if(p_ol2.gt.1)dhr(p_ol2) = 0.
1265 if(p_par.gt.1)dhr(p_par) = 0. !wig, 1-May-2007: for CBMZ
1266 ! REACTIVITY FACTORS
1267 ! [f0]=1
1269 f0(p_no2) = 0.1
1270 f0(p_no) = 0.
1271 f0(p_pan) = 0.1
1272 f0(p_o3) = 1.
1273 f0(p_hcho) = 0.
1274 f0(p_aco3) = 1.
1275 f0(p_tpan) = 0.1
1276 f0(p_hono) = 0.1
1277 f0(p_no3) = 1.
1278 f0(p_hno4) = 0.1
1279 f0(p_h2o2) = 1.
1280 f0(p_co) = 0.
1281 f0(p_ald) = 0.
1282 f0(p_op1) = 0.1
1283 f0(p_op2) = 0.1
1284 f0(p_paa) = 0.1
1285 f0(p_ket) = 0.
1286 f0(p_gly) = 0.
1287 f0(p_mgly) = 0.
1288 f0(p_dcb) = 0.
1289 f0(p_onit) = 0.
1290 f0(p_so2) = 0.
1291 f0(p_eth) = 0.
1292 f0(p_hc3) = 0.
1293 f0(p_hc5) = 0.
1294 f0(p_hc8) = 0.
1295 f0(p_olt) = 0.
1296 f0(p_oli) = 0.
1297 f0(p_tol) = 0.
1298 f0(p_csl) = 0.
1299 f0(p_xyl) = 0.
1300 f0(p_iso) = 0.
1301 f0(p_hno3) = 0.
1302 f0(p_ora1) = 0.
1303 f0(p_ora2) = 0.
1304 f0(p_nh3) = 0.
1305 f0(p_n2o5) = 1.
1306 if(p_ol2.gt.1)f0(p_ol2) = 0.
1307 if(p_par.gt.1)f0(p_par) = 0. !wig, 1-May-2007: for CBMZ
1308 ! DIFFUSION COEFFICIENTS
1309 ! [DV]=cm2/s (assumed: 1/SQRT(molar mass) when not known)
1311 dvj(p_no2) = 0.147
1312 dvj(p_no) = 0.183
1313 dvj(p_pan) = 0.091
1314 dvj(p_o3) = 0.175
1315 dvj(p_hcho) = 0.183
1316 dvj(p_aco3) = 0.115
1317 dvj(p_tpan) = 0.082
1318 dvj(p_hono) = 0.153
1319 dvj(p_no3) = 0.127
1320 dvj(p_hno4) = 0.113
1321 dvj(p_h2o2) = 0.171
1322 dvj(p_co) = 0.189
1323 dvj(p_ald) = 0.151
1324 dvj(p_op1) = 0.144
1325 dvj(p_op2) = 0.127
1326 dvj(p_paa) = 0.115
1327 dvj(p_ket) = 0.118
1328 dvj(p_gly) = 0.131
1329 dvj(p_mgly) = 0.118
1330 dvj(p_dcb) = 0.107
1331 dvj(p_onit) = 0.092
1332 dvj(p_so2) = 0.126
1333 dvj(p_eth) = 0.183
1334 dvj(p_hc3) = 0.151
1335 dvj(p_hc5) = 0.118
1336 dvj(p_hc8) = 0.094
1337 dvj(p_olt) = 0.154
1338 dvj(p_oli) = 0.121
1339 dvj(p_tol) = 0.104
1340 dvj(p_csl) = 0.096
1341 dvj(p_xyl) = 0.097
1342 dvj(p_iso) = 0.121
1343 dvj(p_hno3) = 0.126
1344 dvj(p_ora1) = 0.153
1345 dvj(p_ora2) = 0.124
1346 dvj(p_nh3) = 0.227
1347 dvj(p_n2o5) = 0.110
1348 dvj(p_ho) = 0.243
1349 dvj(p_ho2) = 0.174
1350 if(p_ol2.gt.1)dvj(p_ol2) = 0.189
1351 if(p_par.gt.1)dvj(p_par) = 0.118 !wig, 1-May-2007: for CBMZ
1352 DO l = 1, numgas
1353 hstar4(l) = hstar(l) ! preliminary
1354 ! Correction of diff. coeff
1355 dvj(l) = dvj(l)*(293.15/298.15)**1.75
1356 sc = 0.15/dvj(l) ! Schmidt Number at 20°C
1357 dratio(l) = 0.242/dvj(l) ! ! of water vapor and gas at
1358 ! Ratio of diffusion coeffi
1359 scpr23(l) = (sc/0.72)**(2./3.) ! (Schmidt # / Prandtl #)**
1360 END DO
1362 else ! CB4
1363 hstar(p_no2) = 6.40E-3
1364 hstar(p_no) = 1.90E-3
1365 hstar(p_pan) = 2.97E+0
1366 hstar(p_o3) = 1.13E-2
1367 hstar(p_hcho) = 2.97E+3
1368 hstar(p_hono) = 3.47E+5
1369 hstar(p_no3) = 1.50E+1
1370 hstar(p_h2o2) = 7.45E+4
1371 hstar(p_co) = 8.20E-3
1372 hstar(p_ald2) = 1.14E+1
1373 hstar(p_onit) = 1.13E+0
1374 hstar(p_so2) = 2.53E+5
1375 hstar(p_eth) = 2.00E-3
1376 hstar(p_ole) = 3.05E-3 !(average of oli and olt)
1377 hstar(p_tol) = 1.51E-1
1378 hstar(p_cres) = 4.00E+5
1379 hstar(p_xyl) = 1.45E-1
1380 hstar(p_iso) = 4.76E-3
1381 hstar(p_hno3) = 2.69E+13
1382 hstar(p_nh3) = 1.04E+4
1383 hstar(p_n2o5) = 1.00E+10
1384 hstar(p_par) = 1.13E-3
1386 ! -DH/R (for temperature correction)
1387 ! [-DH/R]=K
1389 dhr(p_no2) = 2500.
1390 dhr(p_no) = 1480.
1391 dhr(p_pan) = 5760.
1392 dhr(p_o3) = 2300.
1393 dhr(p_hcho) = 7190.
1394 dhr(p_hono) = 3775.
1395 dhr(p_no3) = 0.
1396 dhr(p_h2o2) = 6615.
1397 dhr(p_co) = 0.
1398 dhr(p_ald2) = 6266.
1399 dhr(p_onit) = 5487.
1400 dhr(p_so2) = 5816.
1401 dhr(p_eth) = 0.
1402 dhr(p_ole) = 0.
1403 dhr(p_tol) = 0.
1404 dhr(p_cres) = 0.
1405 dhr(p_xyl) = 0.
1406 dhr(p_iso) = 0.
1407 dhr(p_hno3) = 8684.
1408 dhr(p_nh3) = 3660.
1409 dhr(p_n2o5) = 0.
1410 dhr(p_par) = 0.
1411 ! REACTIVITY FACTORS
1412 ! [f0]=1
1414 f0(p_no2) = 0.1
1415 f0(p_no) = 0.
1416 f0(p_pan) = 0.1
1417 f0(p_o3) = 1.
1418 f0(p_hcho) = 0.
1419 f0(p_hono) = 0.1
1420 f0(p_no3) = 1.
1421 f0(p_h2o2) = 1.
1422 f0(p_co) = 0.
1423 f0(p_ald2) = 0.
1424 f0(p_onit) = 0.
1425 f0(p_so2) = 0.
1426 f0(p_eth) = 0.
1427 f0(p_ole) = 0.
1428 f0(p_tol) = 0.
1429 f0(p_csl) = 0.
1430 f0(p_xyl) = 0.
1431 f0(p_iso) = 0.
1432 f0(p_hno3) = 0.
1433 f0(p_nh3) = 0.
1434 f0(p_n2o5) = 1.
1435 f0(p_par) = 0.
1436 ! DIFFUSION COEFFICIENTS
1437 ! [DV]=cm2/s (assumed: 1/SQRT(molar mass) when not known)
1439 dvj(p_no2) = 0.147
1440 dvj(p_no) = 0.183
1441 dvj(p_pan) = 0.091
1442 dvj(p_o3) = 0.175
1443 dvj(p_hcho) = 0.183
1444 dvj(p_hono) = 0.153
1445 dvj(p_no3) = 0.127
1446 dvj(p_h2o2) = 0.171
1447 dvj(p_co) = 0.189
1448 dvj(p_ald2) = 0.151
1449 dvj(p_onit) = 0.092
1450 dvj(p_so2) = 0.126
1451 dvj(p_eth) = 0.183
1452 dvj(p_ole) = 0.135
1453 dvj(p_tol) = 0.104
1454 dvj(p_csl) = 0.096
1455 dvj(p_xyl) = 0.097
1456 dvj(p_iso) = 0.121
1457 dvj(p_hno3) = 0.126
1458 dvj(p_nh3) = 0.227
1459 dvj(p_n2o5) = 0.110
1460 dvj(p_par) = 0.118
1461 DO l = 1, numgas
1462 hstar4(l) = hstar(l) ! preliminary
1463 ! Correction of diff. coeff
1464 dvj(l) = dvj(l)*(293.15/298.15)**1.75
1465 sc = 0.15/dvj(l) ! Schmidt Number at 20°C
1466 dratio(l) = 0.242/dvj(l) ! ! of water vapor and gas at
1467 ! Ratio of diffusion coeffi
1468 scpr23(l) = (sc/0.72)**(2./3.) ! (Schmidt # / Prandtl #)**
1470 end DO
1471 end if
1475 ! DATA FOR AEROSOL PARTICLE DEPOSITION FOR THE MODEL OF
1476 ! J. W. ERISMAN, A. VAN PUL AND P. WYERS
1477 ! ATMOSPHERIC ENVIRONMENT 28 (1994), 2595-2607
1479 ! vd = (u* / k) * CORRECTION FACTORS
1481 ! CONSTANT K FOR LANDUSE TYPES:
1482 ! urban and built-up land
1483 kpart(1) = 500.
1484 ! dryland cropland and pasture
1485 kpart(2) = 500.
1486 ! irrigated cropland and pasture
1487 kpart(3) = 500.
1488 ! mixed dryland/irrigated cropland and past
1489 kpart(4) = 500.
1490 ! cropland/grassland mosaic
1491 kpart(5) = 500.
1492 ! cropland/woodland mosaic
1493 kpart(6) = 100.
1494 ! grassland
1495 kpart(7) = 500.
1496 ! shrubland
1497 kpart(8) = 500.
1498 ! mixed shrubland/grassland
1499 kpart(9) = 500.
1500 ! savanna
1501 kpart(10) = 500.
1502 ! deciduous broadleaf forest
1503 kpart(11) = 100.
1504 ! deciduous needleleaf forest
1505 kpart(12) = 100.
1506 ! evergreen broadleaf forest
1507 kpart(13) = 100.
1508 ! evergreen needleleaf forest
1509 kpart(14) = 100.
1510 ! mixed forest
1511 kpart(15) = 100.
1512 ! water bodies
1513 kpart(16) = 500.
1514 ! herbaceous wetland
1515 kpart(17) = 500.
1516 ! wooded wetland
1517 kpart(18) = 500.
1518 ! barren or sparsely vegetated
1519 kpart(19) = 500.
1520 ! herbaceous tundra
1521 kpart(20) = 500.
1522 ! wooded tundra
1523 kpart(21) = 100.
1524 ! mixed tundra
1525 kpart(22) = 500.
1526 ! bare ground tundra
1527 kpart(23) = 500.
1528 ! snow or ice
1529 kpart(24) = 500.
1530 ! Comments:
1531 kpart(25) = 500.
1532 ! Erisman et al. (1994) give
1533 ! k = 500 for low vegetation and k = 100 for forests.
1535 ! For desert k = 500 is taken according to measurements
1536 ! on bare soil by
1537 ! J. Fontan, A. Lopez, E. Lamaud and A. Druilhet (1997)
1538 ! Vertical Flux Measurements of the Submicronic Aerosol Particles
1539 ! and Parametrisation of the Dry Deposition Velocity
1540 ! in: Biosphere-Atmosphere Exchange of Pollutants
1541 ! and Trace Substances
1542 ! Editor: S. Slanina. Springer-Verlag Berlin, Heidelberg, 1997
1543 ! pp. 381-390
1545 ! For coniferous forest the Erisman value of k = 100 is taken.
1546 ! Measurements of Erisman et al. (1997) in a coniferous forest
1547 ! in the Netherlands, lead to values of k between 20 and 38
1548 ! (Atmospheric Environment 31 (1997), 321-332).
1549 ! However, these high values of vd may be reached during
1550 ! instable cases. The eddy correlation measurements
1551 ! of Gallagher et al. (1997) made during the same experiment
1552 ! show for stable cases (L>0) values of k between 200 and 250
1553 ! at minimum (Atmospheric Environment 31 (1997), 359-373).
1554 ! Fontan et al. (1997) found k = 250 in a forest
1555 ! of maritime pine in southwestern France.
1557 ! For gras, model calculations of Davidson et al. support
1558 ! the value of 500.
1559 ! C. I. Davidson, J. M. Miller and M. A. Pleskov
1560 ! The Influence of Surface Structure on Predicted Particles
1561 ! Dry Deposition to Natural Gras Canopies
1562 ! Water, Air, and Soil Pollution 18 (1982) 25-43
1564 ! Snow covered surface: The experiment of Ibrahim et al. (1983)
1565 ! gives k = 436 for 0.7 um diameter particles.
1566 ! The deposition velocity of Milford and Davidson (1987)
1567 ! gives k = 154 for continental sulfate aerosol.
1568 ! M. Ibrahim, L. A. Barrie and F. Fanaki
1569 ! Atmospheric Environment 17 (1983), 781-788
1571 ! J. B. Milford and C. I. Davidson
1572 ! The Sizes of Particulate Sulfate and Nitrate in the Atmosphere
1573 ! - A Review
1574 ! JAPCA 37 (1987), 125-134
1575 ! no data
1576 ! WRITE (0,*) ' return from rcread '
1577 ! *********************************************************
1579 ! Simplified landuse scheme for deposition and biogenic emission
1580 ! subroutines
1581 ! (ISWATER and ISICE are already defined elsewhere,
1582 ! therefore water and ice are not considered here)
1584 ! 1 urban or bare soil
1585 ! 2 agricultural
1586 ! 3 grassland
1587 ! 4 deciduous forest
1588 ! 5 coniferous and mixed forest
1589 ! 6 other natural landuse categories
1592 IF (mminlu=='OLD ') THEN
1593 ixxxlu(1) = 1
1594 ixxxlu(2) = 2
1595 ixxxlu(3) = 3
1596 ixxxlu(4) = 4
1597 ixxxlu(5) = 5
1598 ixxxlu(6) = 5
1599 ixxxlu(7) = 0
1600 ixxxlu(8) = 6
1601 ixxxlu(9) = 1
1602 ixxxlu(10) = 6
1603 ixxxlu(11) = 0
1604 ixxxlu(12) = 4
1605 ixxxlu(13) = 6
1606 END IF
1607 IF (mminlu=='USGS') THEN
1608 ixxxlu(1) = 1
1609 ixxxlu(2) = 2
1610 ixxxlu(3) = 2
1611 ixxxlu(4) = 2
1612 ixxxlu(5) = 2
1613 ixxxlu(6) = 4
1614 ixxxlu(7) = 3
1615 ixxxlu(8) = 6
1616 ixxxlu(9) = 3
1617 ixxxlu(10) = 6
1618 ixxxlu(11) = 4
1619 ixxxlu(12) = 5
1620 ixxxlu(13) = 4
1621 ixxxlu(14) = 5
1622 ixxxlu(15) = 5
1623 ixxxlu(16) = 0
1624 ixxxlu(17) = 6
1625 ixxxlu(18) = 4
1626 ixxxlu(19) = 1
1627 ixxxlu(20) = 6
1628 ixxxlu(21) = 4
1629 ixxxlu(22) = 6
1630 ixxxlu(23) = 1
1631 ixxxlu(24) = 0
1632 ixxxlu(25) = 1
1633 END IF
1634 IF (mminlu=='SiB ') THEN
1635 ixxxlu(1) = 4
1636 ixxxlu(2) = 4
1637 ixxxlu(3) = 4
1638 ixxxlu(4) = 5
1639 ixxxlu(5) = 5
1640 ixxxlu(6) = 6
1641 ixxxlu(7) = 3
1642 ixxxlu(8) = 6
1643 ixxxlu(9) = 6
1644 ixxxlu(10) = 6
1645 ixxxlu(11) = 1
1646 ixxxlu(12) = 2
1647 ixxxlu(13) = 6
1648 ixxxlu(14) = 1
1649 ixxxlu(15) = 0
1650 ixxxlu(16) = 0
1651 ixxxlu(17) = 1
1652 END IF
1653 RETURN
1654 END SUBROUTINE dep_init
1655 END MODULE module_dep_simple