?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
updated top-level README and version_decl for V4.5 (#1847)
[WRF.git] / chem / KPP / mechanisms / t1_mozcart / t1_mozcart.def
blob489c69a5300c185a0ddb01a9d96f90995b32795b
1 #include atoms_red
2 #include t1_mozcart.spc
3 #include t1_mozcart.eqn
4
5 #INLINE F90_RATES
6
7 REAL(kind=dp) FUNCTION JPL_TROE( k0_300K, n, kinf_300K, m, base, temp, cair )
8
9 !------------------------------------------------------------
10 ! ... dummy arguments
11 !------------------------------------------------------------
12 REAL(kind=dp), INTENT(IN) :: base ! base expononent
13 REAL(kind=dp), INTENT(IN) :: temp ! temperature [K]
14 REAL(kind=dp), INTENT(IN) :: cair ! air concentration [molecules/cm3]
15 REAL(kind=dp), INTENT(IN) :: k0_300K ! low pressure limit at 300 K
16 REAL(kind=dp), INTENT(IN) :: n ! exponent for low pressure limit
17 REAL(kind=dp), INTENT(IN) :: kinf_300K ! high pressure limit at 300 K
18 REAL(kind=dp), INTENT(IN) :: m ! exponent for high pressure limit
19
20 !------------------------------------------------------------
21 ! ... local variables
22 !------------------------------------------------------------
23 REAL(kind=dp) :: zt_help, k0_T, kinf_T, k_ratio
24
25 zt_help = 300._dp/temp
26 k0_T = k0_300K * zt_help**(n) * cair ! k_0 at current T
27 kinf_T = kinf_300K * zt_help**(m) ! k_inf at current T
28 k_ratio = k0_T/kinf_T
29
30 JPL_TROE = k0_T/(1._dp + k_ratio)*base**(1._dp/(1._dp + LOG10(k_ratio)**2))
31
32 END FUNCTION JPL_TROE
33
34 REAL(KIND=dp) FUNCTION usr_O_O2( temp )
35 ! for cesm-consistent reaction labels
36 ! O+O2+M -> O3+M
37
38 REAL(KIND=dp), INTENT(IN) :: temp
39
40 usr_O_O2 = 6.00e-34_dp*(temp/300._dp)**(-2.4_dp)
41
42 END FUNCTION usr_O_O2
43
44 REAL(KIND=dp) FUNCTION usr_O_O_M( temp )
45 ! for cesm-consistent reaction labels
46 ! O+O+M->O2+M
47
48 REAL(KIND=dp), INTENT(IN) :: temp
49
50 usr_O_O_M = 2.76e-34_dp * exp( 720.0_dp/temp)
51
52 END FUNCTION usr_O_O_M
53
54 REAL(KIND=dp) FUNCTION usr_HO2_HO2( temp, c_m, c_h2o )
55 ! for cesm-consistent reaction labels, equivalent to usr9
56 ! HO2+HO2 -> H2O2+O2
57 ! H2O included in fc calculation, not as reactant
58
59 REAL(KIND=dp), INTENT(IN) :: temp
60 REAL(KIND=dp), INTENT(IN) :: c_m
61 REAL(KIND=dp), INTENT(IN) :: c_h2o
62
63 REAL(KIND=dp) :: ko, kinf, fc
64
65 if( c_h2o > 0._dp ) then
66 ko = 2.3e-13_dp * exp( 600._dp/temp )
67 kinf = 1.7e-33_dp * c_m * exp( 1000._dp/temp )
68 fc = 1._dp + 1.4e-21_dp *c_h2o* exp( 2200._dp/temp )
69 usr_HO2_HO2 = (ko + kinf) * fc
70 else
71 usr_HO2_HO2 = 0._dp
72 end if
73 END FUNCTION usr_HO2_HO2
74
75 REAL(KIND=dp) FUNCTION usr_HNO3_OH( temp, c_m )
76 ! for cesm-consistent reaction labels, equivalent to usr5
77 ! HNO3 + OH -> NO3 + H2O
78
79 REAL(KIND=dp), INTENT(IN) :: temp
80 REAL(KIND=dp), INTENT(IN) :: c_m
81
82 REAL(KIND=dp) :: k0, k2
83
84 k0 = c_m * 6.5e-34_dp * exp( 1335._dp/temp )
85 k2 = exp( 2199._dp/temp )
86 k0 = k0 /(1.0_dp + k0/(2.7e-17_dp*k2))
87 k2 = exp( 460._dp/temp )
88
89 usr_HNO3_OH = k0 + 2.4e-14_dp * k2
90
91 END FUNCTION usr_HNO3_OH
92
93
94 REAL(KIND=dp) FUNCTION usr_HO2NO2_M( temp, c_m )
95 ! for cesm-consistent reaction labels
96 ! HO2NO2 + M -> HO2+NO2+M
97 ! CESM writes this as dependent on the NO2+HO2 rate
98 ! *** if M is included in reactants, must divide TROEE function by [M]
99
100 REAL(KIND=dp), INTENT(IN) :: temp
101 REAL(KIND=dp), INTENT(IN) :: c_m
102
103 usr_HO2NO2_M = TROEE( 4.76e26_dp,10900._dp, 1.8e-31_dp , 3.2_dp , &
104 4.7e-12_dp , 1.4_dp , TEMP, C_M ) /c_m
105
106 END FUNCTION usr_HO2NO2_M
107
108 REAL(KIND=dp) FUNCTION usr_PAN_M( temp, c_m )
109 ! for cesm-consistent reaction labels
110 ! PAN+M -> CH3CO3+NO2
111 ! *** if M is included in reactants, must divide TROEE function by [M]
112
113 REAL(KIND=dp), INTENT(IN) :: temp
114 REAL(KIND=dp), INTENT(IN) :: c_m
115
116 usr_PAN_M = TROEE(1.111e28_dp, 14000._dp, 8.5e-29_dp, 6.5_dp, &
117 1.1e-11_dp, 0._dp, TEMP, C_M) /c_m
118
119 END FUNCTION usr_PAN_M
120
121 REAL(KIND=dp) FUNCTION usr_CH3COCH3_OH( temp )
122 ! for cesm-consistent reaction labels
123 ! CH3COCH3 + OH -> RO2 + H2O
124
125 REAL(KIND=dp), INTENT(IN) :: temp
126
127 usr_CH3COCH3_OH = 3.82e-11_dp*exp( -2000._dp/temp ) + 1.33e-13_dp
128
129 END FUNCTION usr_CH3COCH3_OH
130
131 REAL(KIND=dp) FUNCTION usr_MCO3_NO2( temp, c_m )
132 ! for cesm-consistent reaction labels
133 ! MCO3+NO2+M -> MPAN+M
134
135 REAL(KIND=dp), INTENT(IN) :: temp
136 REAL(KIND=dp), INTENT(IN) :: c_m
137
138 usr_MCO3_NO2 = 1.1e-11_dp*300._dp/(temp*c_m)
139
140 END FUNCTION usr_MCO3_NO2
141
142
143 REAL(KIND=dp) FUNCTION usr_MPAN_M( temp, c_m )
144 ! for cesm-consistent reaction labels
145 ! MPAN+M -> MCO3+NO2+M
146
147 REAL(KIND=dp), INTENT(IN) :: temp
148 REAL(KIND=dp), INTENT(IN) :: c_m
149
150 usr_MPAN_M = 1.2221e17_dp*300._dp*exp( -14000._dp/temp )/(temp*c_m)
151
152 END FUNCTION usr_MPAN_M
153
154 REAL(KIND=dp) FUNCTION usr_N2O5_aer( aero_srf_area, aero_diam, temp )
155 ! heterogeneous uptake on aerosols: N2O5 -> 2 HNO3
156
157 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
158 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
159 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
160
161 INTEGER :: n
162 REAL(KIND=dp), parameter :: dg = .1_dp
163 REAL(KIND=dp), parameter :: gamma_n2o5 = .1_dp
164 REAL(KIND=dp) :: c_n2o5, term
165
166 n = size( aero_srf_area )
167
168 c_n2o5 = 1.40e3_dp * sqrt( temp )
169 term = 4._dp/(c_n2o5*gamma_n2o5)
170
171 usr_N2O5_aer = &
172 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
173
174 END FUNCTION usr_N2O5_aer
175
176 REAL(KIND=dp) FUNCTION usr_HONITR_aer( aero_srf_area, aero_diam, temp )
177 ! heterogeneous uptake on aerosols: HONITR -> HNO3
178
179 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
180 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
181 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
182
183 INTEGER :: n
184 REAL(KIND=dp), parameter :: dg = .1_dp
185 REAL(KIND=dp), parameter :: gamma_honitr = .005_dp
186 REAL(KIND=dp) :: c_honitr, term
187
188 n = size( aero_srf_area )
189
190 c_honitr = 1.26e3_dp * sqrt( temp )
191 term = 4._dp/(c_honitr*gamma_honitr)
192
193 usr_HONITR_aer = &
194 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
195
196 END FUNCTION usr_HONITR_aer
197
198 REAL(KIND=dp) FUNCTION usr_ONITR_aer( aero_srf_area, aero_diam, temp )
199 ! heterogeneous uptake on aerosols: ONITR -> HNO3
200
201 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
202 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
203 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
204
205 INTEGER :: n
206 REAL(KIND=dp), parameter :: dg = .1_dp
207 REAL(KIND=dp), parameter :: gamma_onitr = .005_dp
208 REAL(KIND=dp) :: c_onitr, term
209
210 n = size( aero_srf_area )
211
212 c_onitr = 1.20e3_dp * sqrt( temp )
213 term = 4._dp/(c_onitr*gamma_onitr)
214
215 usr_ONITR_aer = &
216 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
217
218 END FUNCTION usr_ONITR_aer
219
220 REAL(KIND=dp) FUNCTION usr_ISOPNIT_aer( aero_srf_area, aero_diam, temp )
221 ! heterogeneous uptake on aerosols: ISOPNITA -> HNO3
222 ! heterogeneous uptake on aerosols: ISOPNITB -> HNO3
223
224 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
225 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
226 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
227
228 INTEGER :: n
229 REAL(KIND=dp), parameter :: dg = .1_dp
230 REAL(KIND=dp), parameter :: gamma_isopnit = .005_dp
231 REAL(KIND=dp) :: c_isopnit, term
232
233 n = size( aero_srf_area )
234
235 c_isopnit = 1.20e3_dp * sqrt( temp )
236 term = 4._dp/(c_isopnit*gamma_isopnit)
237
238 usr_ISOPNIT_aer = &
239 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
240
241 END FUNCTION usr_ISOPNIT_aer
242
243 REAL(KIND=dp) FUNCTION usr_TERPNIT_aer( aero_srf_area, aero_diam, temp )
244 ! heterogeneous uptake on aerosols: TERPNIT -> HNO3
245
246 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
247 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
248 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
249
250 INTEGER :: n
251 REAL(KIND=dp), parameter :: dg = .1_dp
252 REAL(KIND=dp), parameter :: gamma_terpnit = .01_dp
253 REAL(KIND=dp) :: c_terpnit, term
254
255 n = size( aero_srf_area )
256
257 c_terpnit = .992e3_dp * sqrt( temp )
258 term = 4._dp/(c_terpnit*gamma_terpnit)
259
260 usr_TERPNIT_aer = &
261 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
262
263 END FUNCTION usr_TERPNIT_aer
264
265 REAL(KIND=dp) FUNCTION usr_NC4CH2OH_aer( aero_srf_area, aero_diam, temp )
266 ! heterogeneous uptake on aerosols: NC4CH2OH -> HNO3
267
268 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
269 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
270 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
271
272 INTEGER :: n
273 REAL(KIND=dp), parameter :: dg = .1_dp
274 REAL(KIND=dp), parameter :: gamma_nc4ch2oh = .005_dp
275 REAL(KIND=dp) :: c_nc4ch2oh, term
276
277 n = size( aero_srf_area )
278
279 c_nc4ch2oh = 1.20e3_dp * sqrt( temp )
280 term = 4._dp/(c_nc4ch2oh*gamma_nc4ch2oh)
281
282 usr_NC4CH2OH_aer = &
283 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
284
285 END FUNCTION usr_NC4CH2OH_aer
286
287 REAL(KIND=dp) FUNCTION usr_NC4CHO_aer( aero_srf_area, aero_diam, temp )
288 ! heterogeneous uptake on aerosols: NC4CHO -> HNO3
289
290 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
291 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
292 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
293
294 INTEGER :: n
295 REAL(KIND=dp), parameter :: dg = .1_dp
296 REAL(KIND=dp), parameter :: gamma_nc4cho = .005_dp
297 REAL(KIND=dp) :: c_nc4cho, term
298
299 n = size( aero_srf_area )
300
301 c_nc4cho = 1.21e3_dp * sqrt( temp )
302 term = 4._dp/(c_nc4cho*gamma_nc4cho)
303
304 usr_NC4CHO_aer = &
305 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
306
307 END FUNCTION usr_NC4CHO_aer
308
309 REAL(KIND=dp) FUNCTION usr_NTERPOOH_aer( aero_srf_area, aero_diam, temp )
310 ! heterogeneous uptake on aerosols: NTERPOOH -> HNO3
311
312 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
313 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
314 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
315
316 INTEGER :: n
317 REAL(KIND=dp), parameter :: dg = .1_dp
318 REAL(KIND=dp), parameter :: gamma_nterpooh = .01_dp
319 REAL(KIND=dp) :: c_nterpooh, term
320
321 n = size( aero_srf_area )
322
323 c_nterpooh = .957e3_dp * sqrt( temp )
324 term = 4._dp/(c_nterpooh*gamma_nterpooh)
325
326 usr_NTERPOOH_aer = &
327 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
328
329 END FUNCTION usr_NTERPOOH_aer
330
331 REAL(KIND=dp) FUNCTION usr_GLYOXAL_aer( aero_srf_area, temp )
332 ! heterogeneous uptake on aerosols: GLYOXAL ->
333
334 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
335 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
336
337 INTEGER :: n
338 REAL(KIND=dp), parameter :: gamma_glyoxal = .0002_dp
339 REAL(KIND=dp) :: c_glyoxal, term
340
341 n = size( aero_srf_area )
342
343 c_glyoxal = 1.455e4_dp * sqrt( temp/58._dp )
344 term = .25_dp * c_glyoxal * gamma_glyoxal
345
346 usr_GLYOXAL_aer = sum( aero_srf_area(1:n) ) * term
347
348 END FUNCTION usr_GLYOXAL_aer
349
350 REAL(KIND=dp) FUNCTION usr_NO3_aer( aero_srf_area, aero_diam, temp )
351 ! heterogeneous uptake on aerosols: NO3 -> HNO3
352
353 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
354 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
355 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
356
357 INTEGER :: n
358 REAL(KIND=dp), parameter :: dg = .1_dp
359 REAL(KIND=dp), parameter :: gamma_no3 = 1.e-3_dp
360 REAL(KIND=dp) :: c_no3, term
361
362 n = size( aero_srf_area )
363
364 c_no3 = 1.85e3_dp * sqrt( temp )
365 term = 4._dp/(c_no3*gamma_no3)
366
367 usr_NO3_aer = &
368 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
369
370 END FUNCTION usr_NO3_aer
371
372 REAL(KIND=dp) FUNCTION usr_NO2_aer( aero_srf_area, aero_diam, temp )
373 ! heterogeneous uptake on aerosols: NO2 -> 0.5 OH + 0.5 NO + 0.5 HNO3
374
375 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
376 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
377 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
378
379 INTEGER :: n
380 REAL(KIND=dp), parameter :: dg = .1_dp
381 REAL(KIND=dp), parameter :: gamma_no2 = 1.e-4_dp
382 REAL(KIND=dp) :: c_no2, term
383
384 n = size( aero_srf_area )
385
386 c_no2 = 2.15e3_dp * sqrt( temp )
387 term = 4._dp/(c_no2*gamma_no2)
388
389 usr_NO2_aer = &
390 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
391
392 END FUNCTION usr_NO2_aer
393
394 REAL(KIND=dp) FUNCTION usr_DMS_OH( temp, c_m )
395 ! for cesm-consistent reaction labels, equivalent to usr24
396 ! DMS + OH -> 0.5 SO2 + 0.5 HO2
397
398 REAL(KIND=dp), INTENT(IN) :: temp
399 REAL(KIND=dp), INTENT(IN) :: c_m
400
401 REAL(KIND=dp) :: ko, wrk
402
403 wrk = .21_dp*c_m
404 ko = 1._dp + 5.5e-31_dp*exp( 7460._dp/temp )*wrk
405 usr_DMS_OH = 1.7e-42_dp*exp( 7810._dp/temp )*wrk/ko
406
407 END FUNCTION usr_DMS_OH
408
409
410 REAL(KIND=dp) FUNCTION usr_HO2_aer( aero_srf_area, aero_diam, temp )
411 ! heterogeneous uptake on aerosols: HO2 -> 0.5 H2O2
412
413 REAL(KIND=dp), INTENT(IN) :: aero_srf_area(:) ! aerosol surface area
414 REAL(KIND=dp), INTENT(IN) :: aero_diam(:) ! aerosol diameter
415 REAL(KIND=dp), INTENT(IN) :: temp ! temperature (K)
416
417 INTEGER :: n
418 REAL(KIND=dp), parameter :: dg = .1_dp
419 REAL(KIND=dp), parameter :: gamma_ho2 = .2_dp
420 REAL(KIND=dp) :: c_ho2, term
421
422 n = size( aero_srf_area )
423
424 c_ho2 = 2.53e3_dp * sqrt( temp )
425 term = 4._dp/(c_ho2*gamma_ho2)
426
427 usr_HO2_aer = &
428 sum( aero_srf_area(1:n)/(.5_dp*aero_diam(1:n)/dg + term) )
429
430 END FUNCTION usr_HO2_aer
431
432 REAL(KIND=dp) FUNCTION usr_PBZNIT_M( temp, c_m )
433 ! for cesm-consistent reaction labels
434 ! PBZNIT+M=ACBZO2+NO2+M
435 ! *** if M is included in reactants, must divide TROEE function by [M]
436
437 REAL(KIND=dp), INTENT(IN) :: temp
438 REAL(KIND=dp), INTENT(IN) :: c_m
439
440 usr_PBZNIT_M = TROEE( 1.111e28_dp,14000._dp, 9.7e-29_dp , 5.6_dp , &
441 9.3e-12_dp , 0._dp , TEMP, C_M) /c_m
442
443 END FUNCTION usr_PBZNIT_M
444
445 REAL(KIND=dp) FUNCTION usr_N2O5_M( temp, c_m )
446 ! for cesm-consistent reaction labels
447 ! N2O5 + M -> NO2 + NO3 + M
448 ! CESM writes this as dependent on the NO2+NO3 rate
449 ! *** if M is included in reactants, must divide TROEE function by [M]
450
451 REAL(KIND=dp), INTENT(IN) :: temp
452 REAL(KIND=dp), INTENT(IN) :: c_m
453
454 usr_N2O5_M = TROEE(3.333e26_dp, 10900._dp, 2.2e-30_dp, 4.4_dp, &
455 1.4e-12_dp , .7_dp , TEMP, C_M ) /c_m
456
457 END FUNCTION usr_N2O5_M
458
459 REAL(KIND=dp) FUNCTION usr_SO2_OH( temp, c_m )
460 ! for cesm-consistent reaction labels, equivalent to usr23
461 ! SO2 + OH -> SO4
462 !------------------------------------------------------------------
463 ! This reaction rate constant has been updated to be
464 ! consistent with CAM-Chem (2018-10-19)
465 !------------------------------------------------------------------
466
467 REAL(KIND=dp), INTENT(IN) :: temp
468 REAL(KIND=dp), INTENT(IN) :: c_m
469
470 REAL(KIND=dp) :: fc, k0
471 REAL(KIND=dp) :: wrk
472
473 fc = 3.e-31_dp * (300._dp/temp) ** 3.3_dp
474 wrk = fc * c_m
475 k0 = wrk / (1._dp + wrk/1.5e-12_dp)
476 usr_SO2_OH = k0 * .6_dp ** (1._dp/(1._dp + &
477 (log10( wrk/1.5e-12_dp ))**2._dp))
478
479 END FUNCTION usr_SO2_OH
480
481 REAL(KIND=dp) FUNCTION usr_CO_OH_a( temp, c_m )
482 ! for cesm-consistent reaction labels, equivalent to usr8
483 ! CO+OH -> CO2+HO2
484
485 REAL(KIND=dp), INTENT(IN) :: temp
486 REAL(KIND=dp), INTENT(IN) :: c_m
487
488 REAL(KIND=dp), parameter :: boltz = 1.38044e-16_dp
489
490 usr_CO_OH_a = 1.5e-13_dp * (1._dp + 6.e-7_dp*boltz*c_m*temp)
491
492 END FUNCTION usr_CO_OH_a
493
494
495 !__________________________________________________
496
497 REAL(KIND=dp) FUNCTION Keff ( A0,B0,C0, TEMP,X1,X2,y1,y2 )
498 REAL(KIND=dp),INTENT(IN) :: X1,X2,y1,y2
499 REAL(KIND=dp),INTENT(IN) :: TEMP
500 REAL(KIND=dp),INTENT(IN):: A0,B0,C0
501 Keff = A0 * EXP(- B0 /TEMP ) &
502 *(TEMP/300._dp)**C0*(y1*X1/(X1 + X2 + 1.0e-35) &
503 +y2*(1-X1/(X1 + X2 + 1.0e-35)))
504 END FUNCTION Keff
505 !__________________________________________________
506
507 REAL(KIND=dp) FUNCTION Keff2 ( C0,X1,X2,y1,y2 )
508 REAL(KIND=dp),INTENT(IN) :: X1,X2,y1,y2
509 REAL(KIND=dp),INTENT(IN):: C0
510 Keff2 = C0*(y1*X1/(X1 + X2 + 1.0e-35) &
511 +y2*(1-X1/(X1 + X2 + 1.0e-35 )))
512 END FUNCTION Keff2
513
514 !__________________________________________________
515
516
517 REAL(KIND=dp) FUNCTION vbs_yield ( nume, den, voc_idx, bin_idx )
518 REAL(KIND=dp), INTENT(IN) :: nume, den
519 INTEGER, INTENT(IN) :: voc_idx, bin_idx
520 INTEGER, PARAMETER :: vbs_nbin = 4, vbs_nspec = 9
521
522 ! normalized (1 g/m3 density) yield for condensable vapors
523 REAL(KIND=dp) :: vbs_alphlowN(vbs_nbin,vbs_nspec)
524 REAL(KIND=dp) :: vbs_alphhiN(vbs_nbin,vbs_nspec)
525 REAL(KIND=dp) :: vbs_mw_prec(vbs_nspec)
526 ! SOA density (g/m3)
527 REAL(KIND=dp), PARAMETER :: dens_aer = 1.5
528 ! SOA molecular weight (g/mol)
529 REAL(KIND=dp), PARAMETER :: mw_aer = 250.0
530
531 ! --------------------------------------------------------------------------
532 ! Yields used in Murphy and Pandis, 2009; Tsimpidi et al., 2010;
533 ! Ahmadov et al., 2012
534
535 ! low NOx condition
536 DATA vbs_alphlowN / &
537 0.0000, 0.0750, 0.0000, 0.0000, & ! ALK4
538 0.0000, 0.3000, 0.0000, 0.0000, & ! ALK5
539 0.0045, 0.0090, 0.0600, 0.2250, & ! OLE1
540 0.0225, 0.0435, 0.1290, 0.3750, & ! OLE2
541 0.0750, 0.2250, 0.3750, 0.5250, & ! ARO1
542 0.0750, 0.3000, 0.3750, 0.5250, & ! ARO2
543 0.0090, 0.0300, 0.0150, 0.0000, & ! ISOP
544 0.0750, 0.1500, 0.7500, 0.9000, & ! SESQ
545 0.1073, 0.0918, 0.3587, 0.6075/ ! TERP
546
547 ! high NOx condition
548 DATA vbs_alphhiN / &
549 0.0000, 0.0375, 0.0000, 0.0000, & ! ALK4
550 0.0000, 0.1500, 0.0000, 0.0000, & ! ALK5
551 0.0008, 0.0045, 0.0375, 0.1500, & ! OLE1
552 0.0030, 0.0255, 0.0825, 0.2700, & ! OLE2
553 0.0030, 0.1650, 0.3000, 0.4350, & ! ARO1
554 0.0015, 0.1950, 0.3000, 0.4350, & ! ARO2
555 0.0003, 0.0225, 0.0150, 0.0000, & ! ISOP
556 0.0750, 0.1500, 0.7500, 0.9000, & ! SESQ
557 0.0120, 0.1215, 0.2010, 0.5070/ ! TERP
558
559 DATA vbs_mw_prec / &
560 120.0, & ! ALK4
561 150.0, & ! ALK5
562 120.0, & ! OLE1
563 120.0, & ! OLE2
564 150.0, & ! ARO1
565 150.0, & ! ARO2
566 136.0, & ! ISOP
567 250.0, & ! SESQ
568 180.0/ ! TERP
569
570 REAL(KIND=dp), PARAMETER :: yields_dens_aer = 1.5 ! g/m3
571
572 !
573 ! --------------------------------------------------------------------------
574
575 REAL(KIND=dp) :: B, mw_ratio, dens_ratio
576
577 ! Lane et al., ES&T, 2008
578 ! B = (RO2 + NO) / ((RO2 + NO) + (RO2 + RO2) + (RO2 + HO2))
579 ! with nume = (RO2 + NO) and den = (RO2 + RO2) + (RO2 + HO2)
580 B = nume / (nume + den + 1.0e-35_dp)
581
582 ! we need molar yields, not mass yields
583 mw_ratio = vbs_mw_prec(voc_idx)/mw_aer
584
585 ! density correction
586 dens_ratio = dens_aer / yields_dens_aer
587
588 vbs_yield = (vbs_alphhiN(bin_idx,voc_idx) * B + &
589 vbs_alphlowN(bin_idx,voc_idx) * (1.0_dp - B)) * &
590 dens_ratio * mw_ratio
591
592 END FUNCTION vbs_yield
593
594 SUBROUTINE aero_surfarea( aero_srf_area, aero_diam, rh, temp, &
595 aer_so4, aer_oc2, aer_bc2 )
596
597 IMPLICIT NONE
598
599 !-----------------------------------------------------------------
600 ! Dummy arguments
601 !-----------------------------------------------------------------
602 REAL(kind=dp), intent(in) :: rh
603 REAL(kind=dp), intent(in) :: temp
604 REAL(kind=dp), intent(in) :: aer_so4, aer_oc2, aer_bc2
605 REAL(kind=dp), intent(out) :: aero_srf_area(3)
606 REAL(kind=dp), intent(out) :: aero_diam(3)
607
608 !-----------------------------------------------------------------
609 ! Local variables
610 !-----------------------------------------------------------------
611 ! mean radius, diameter, and std dev of sulfate particles (cm) (Chin)
612 real(dp), parameter :: rm_sulf = 6.95e-6_dp
613 real(dp), parameter :: dm_sulf = 2._dp*rm_sulf
614 real(dp), parameter :: sd_sulf = 2.03_dp
615
616 ! mean radius, diameter, and std dev of organic carbon particles (cm) (Chin)
617 real(dp), parameter :: rm_orgc = 2.12e-6_dp
618 real(dp), parameter :: dm_orgc = 2._dp*rm_orgc
619 real(dp), parameter :: sd_orgc = 2.20_dp
620
621 ! mean radius, diameter, and std dev of soot/BC particles (cm) (Chin)
622 real(dp), parameter :: rm_bc = 1.18e-6_dp
623 real(dp), parameter :: dm_bc = 2._dp*rm_bc
624 real(dp), parameter :: sd_bc = 2.00_dp
625
626 real(dp), parameter :: pi = 3.1415926535897932384626433_dp
627
628 integer :: irh, rh_l, rh_u
629 real(dp) :: log_sd_sulf, log_sd_orgc, log_sd_bc
630 real(dp) :: dm_sulf_wet, dm_orgc_wet, dm_bc_wet
631 real(dp) :: rfac_sulf, rfac_oc, rfac_bc
632 real(dp) :: n, n_exp, factor, s_exp
633 !-----------------------------------------------------------------
634 ! ... table for hygroscopic growth effect on radius (Chin et al)
635 ! (no growth effect for mineral dust)
636 !-----------------------------------------------------------------
637 real(dp), dimension(7) :: table_rh, table_rfac_sulf
638 real(dp), dimension(7) :: table_rfac_bc, table_rfac_oc
639
640 data table_rh(1:7) &
641 / 0.0_dp, 0.5_dp, 0.7_dp, 0.8_dp, 0.9_dp, 0.95_dp, 0.99_dp /
642 data table_rfac_sulf(1:7) &
643 / 1.0_dp, 1.4_dp, 1.5_dp, 1.6_dp, 1.8_dp, 1.9_dp, 2.2_dp /
644 data table_rfac_oc(1:7) &
645 / 1.0_dp, 1.2_dp, 1.4_dp, 1.5_dp, 1.6_dp, 1.8_dp, 2.2_dp /
646 data table_rfac_bc(1:7) &
647 / 1.0_dp, 1.0_dp, 1.0_dp, 1.2_dp, 1.4_dp, 1.5_dp, 1.9_dp /
648
649 log_sd_sulf = log( sd_sulf )
650 log_sd_orgc = log( sd_orgc )
651 log_sd_bc = log( sd_bc )
652
653 !-----------------------------------------------------------------
654 ! ... exponent for calculating number density
655 !-----------------------------------------------------------------
656 n_exp = exp( -4.5_dp*log(sd_sulf)*log(sd_sulf) )
657 !-------------------------------------------------------------------------
658 ! ... aerosol growth interpolated from M.Chins table
659 !-------------------------------------------------------------------------
660 if (rh >= table_rh(7)) then
661 rfac_sulf = table_rfac_sulf(7)
662 rfac_oc = table_rfac_oc(7)
663 rfac_bc = table_rfac_bc(7)
664 else
665 do irh = 2,7
666 if (rh <= table_rh(irh)) then
667 exit
668 end if
669 end do
670 rh_l = irh-1
671 rh_u = irh
672
673 factor = (rh - table_rh(rh_l))/(table_rh(rh_u) - table_rh(rh_l))
674
675 rfac_sulf = table_rfac_sulf(rh_l) &
676 + factor*(table_rfac_sulf(rh_u) - table_rfac_sulf(rh_l))
677 rfac_oc = table_rfac_oc(rh_u) &
678 + factor*(table_rfac_oc(rh_u) - table_rfac_oc(rh_l))
679 rfac_bc = table_rfac_bc(rh_u) &
680 + factor*(table_rfac_bc(rh_u) - table_rfac_bc(rh_l))
681 end if
682
683 dm_sulf_wet = dm_sulf * rfac_sulf
684 dm_orgc_wet = dm_orgc * rfac_oc
685 dm_bc_wet = dm_bc * rfac_bc
686
687 ! maximum size is 0.5 micron (Chin)
688 dm_bc_wet = min(dm_bc_wet ,50.e-6_dp)
689 dm_orgc_wet = min(dm_orgc_wet,50.e-6_dp)
690
691 aero_diam(:) = (/ dm_sulf_wet, dm_orgc_wet, dm_bc_wet /)
692
693 n = aer_so4 * (6._dp/pi)*(1._dp/(dm_sulf**3))*n_exp
694 s_exp = exp( 2._dp*log_sd_sulf*log_sd_sulf )
695 aero_srf_area(1) = n * pi * (dm_sulf_wet*dm_sulf_wet) * s_exp
696
697 n = aer_oc2 * (6._dp/pi)*(1._dp/(dm_orgc**3))*n_exp
698 s_exp = exp( 2._dp*log_sd_orgc*log_sd_orgc )
699 aero_srf_area(2) = n * pi * (dm_orgc_wet*dm_orgc_wet) * s_exp
700
701 n = aer_bc2 * (6._dp/pi)*(1._dp/(dm_bc**3))*n_exp
702 s_exp = exp( 2._dp*log_sd_bc*log_sd_bc )
703 aero_srf_area(3) = n * pi * (dm_bc_wet*dm_bc_wet) * s_exp
704
705 END SUBROUTINE aero_surfarea
706
707
708 #ENDINLINE
Mirror of the official repository at https://github.com/wrf-model/WRF