module_ctrans_aqchem.F
References to this file elsewhere.
1 MODULE module_ctrans_aqchem
2 !***********************************************************************
3 ! Portions of Models-3/CMAQ software were developed or based on *
4 ! information from various groups: Federal Government employees, *
5 ! contractors working on a United States Government contract, and *
6 ! non-Federal sources (including research institutions). These *
7 ! research institutions have given the Government permission to *
8 ! use, prepare derivative works, and distribute copies of their *
9 ! work in Models-3/CMAQ to the public and to permit others to do *
10 ! so. EPA therefore grants similar permissions for use of the *
11 ! Models-3/CMAQ software, but users are requested to provide copies *
12 ! of derivative works to the Government without restrictions as to *
13 ! use by others. Users are responsible for acquiring their own *
14 ! copies of commercial software associated with Models-3/CMAQ and *
15 ! for complying with vendor requirements. Software copyrights by *
16 ! the MCNC Environmental Modeling Center are used with their *
17 ! permissions subject to the above restrictions. *
18 !***********************************************************************
19
20 ! RCS file, release, date & time of last delta, author, state, [and locker]
21 ! $Header: /project/work/rep/CCTM/src/cloud/cloud_radm/aqchem.F,v 1.19 2002/12/12 20:08:47 sjr Exp $
22
23 ! what(1) key, module and SID; SCCS file; date and time of last delta:
24 !
25
26 CONTAINS
27 SUBROUTINE AQCHEM ( TEMP, PRES_PA, TAUCLD, PRCRATE, &
28 WCAVG, WTAVG, AIRM, ALFA0, ALFA2, ALFA3, GAS, &
29 AEROSOL, GASWDEP, AERWDEP, HPWDEP )
30
31 !-----------------------------------------------------------------------
32 !
33 ! DESCRIPTION:
34 ! Compute concentration changes in cloud due to aqueous chemistry,
35 ! scavenging and wet deposition amounts.
36 !
37 ! Revision History:
38 ! No Date Who What
39 ! -- -------- --- -----------------------------------------
40 ! 0 / /86 CW BEGIN PROGRAM - Walceks's Original Code
41 ! 1 / /86 RB INCORPORATE INTO RADM
42 ! 2 03/23/87 DH REFORMAT
43 ! 3 04/11/88 SJR STREAMLINED CODE - ADDED COMMENTS
44 ! 4 08/27/88 SJR COMMENTS, MODIFIED FOR RPM
45 ! 4a 03/15/96 FSB Scanned hard copy to develop Models3
46 ! Version.
47 ! 5 04/24/96 FSB Made into Models3 Format
48 ! 6 02/18/97 SJR Revisions to link with Models3
49 ! 7 08/12/97 SJR Revised for new concentration units (moles/mole)
50 ! and new treatment of nitrate and nitric acid
51 ! 8 01/15/98 sjr revised to add new aitken mode scavenging
52 ! and aerosol number scavenging
53 ! 9 12/15/98 David Wong at LM:
54 ! -- change division of XL, TEMP to multiplication of XL, TEMP
55 ! reciprocal, respectively
56 ! -- change / TOTOX / TSIV to / ( TOTOX * TSIV )
57 ! 10 03/18/99 David Wong at LM:
58 ! -- removed "* 1.0" redundant calculation at TEMP1 calculation
59 ! 11 04/27/00 sjr Added aerosol surface area as modeled species
60 !
61 ! Reference:
62 ! Walcek & Taylor, 1986, A theoretical Method for computing
63 ! vertical distributions of acidity and sulfate within cumulus
64 ! clouds, J. Atmos Sci., Vol. 43, no. 4 pp 339 - 355
65 !
66 ! Called by: AQMAP
67 !
68 ! Calls the following subroutines: none
69 !
70 ! Calls the following functions: HLCONST
71 !
72 ! ARGUMENTS TYPE I/O DESCRIPTION
73 ! --------- ---- ------------ --------------------------------
74 ! GAS(ngas) real input&output Concentration for species i=1,11
75 ! GASWDEP(ngas) real output wet deposition for species
76 ! (1) = SO2 conc (mol/mol of S02)
77 ! (2) = HNO3 conc (mol/mol of HNO3)
78 ! (3) = N2O5 conc (mol/mol of N2O5)
79 ! (4) = CO2 conc (mol/mol of CO2)
80 ! (5) = NH3 conc (mol/mol of NH3)
81 ! (6) = H2O2 conc (mol/mol of H2O2)
82 ! (7) = O3 conc (mol/mol of O3)
83 ! (8) = FOA conc (mol/mol of FOA)
84 ! (9) = MHP conc (mol/mol of MHP)
85 ! (10)= PAA conc (mol/mol of PAA)
86 ! (11)= H2SO4 conc (mol/mol of H2SO4)
87 !
88 ! AEROSOL(naer) real input&output Concentration for species i=1,21
89 ! AERWDEP(naer) real output wet deposition for species
90 ! (1) = SO4AKN conc (mol/mol)
91 ! (2) = SO4ACC conc (mol/mol)
92 ! (3) = NH4AKN conc (mol/mol)
93 ! (4) = NH4ACC conc (mol/mol)
94 ! (5) = NO3AKN conc (mol/mol)
95 ! (6) = NO3ACC conc (mol/mol)
96 ! (7) = NO3COR conc (mol/mol)
97 ! (8) = ORGAKN conc (mol/mol)
98 ! (9) = ORGACC conc (mol/mol)
99 ! (10)= PRIAKN conc (mol/mol)
100 ! (11)= PRIACC conc (mol/mol)
101 ! (12)= PRICOR conc (mol/mol)
102 ! (13)= CACO3 conc (mol/mol)
103 ! (14)= MGCO3 conc (mol/mol)
104 ! (15)= NACL conc (mol/mol)
105 ! (16)= A3FE conc (mol/mol)
106 ! (17)= B2MN conc (mol/mol)
107 ! (18)= KCL conc (mol/mol)
108 ! (19)= NUMAKN conc (#/mol)
109 ! (20)= NUMACC conc (#/mol)
110 ! (21)= NUMCOR conc (#/mol)
111 ! (22)= SRFAKN conc (m2/mol)
112 ! (23)= SRFACC conc (m2/mol)
113 !
114 !-----------------------------------------------------------------------
115
116 IMPLICIT NONE
117
118
119
120 ! INCLUDE 'CONST.EXT' ! constants
121 ! INCLUDE FILE CONST.EXT
122 ! Contains: Fundamental constants for air quality modeling
123 ! Dependent Upon: none
124 ! Revision History:
125 ! Adapted 6/92 by CJC from ROM's PI.EXT.
126 ! 3/1/93 John McHenry - include constants needed by LCM aqueous chemistry
127 ! 9/93 by John McHenry - include additional constants needed for FMEM clouds
128 ! and aqueous chemistry
129
130 ! 3/4/96 Dr. Francis S. Binkowski - reflect current Models3 view that MKS
131 ! units should be used wherever possible and that sources be documented.
132 ! Some variables have been added, names changed, and values revised.
133
134 ! 3/7/96 - add universal gas constant and compute gas constant in chemical
135 ! form. TWOPI is now calculated rather than input.
136
137 ! 3/13/96 - group declarations and parameter statements
138 ! 9/13/96 - include more physical constants
139 ! 12/24/96 - eliminate silly EPSILON, AMISS
140 ! 1/06/97 - eliminate most derived constants - YOJ
141 ! 1/17/97 (comments only) to provide numerical values as reference - DWB
142
143 ! FSB References:
144
145 ! CRC76, CRC Handbook of Chemistry and Physics (76th Ed),
146 ! CRC Press, 1995
147 ! Hobbs, P.V. Basic Physical Chemistry for the Atmospheric Sciences,
148 ! Cambridge Univ. Press, 206 pp, 1995.
149 ! Snyder, J.P., Map Projections-A Working Manual, U.S. Geological Survey
150 ! Paper 1395 U.S.GPO, Washington, DC, 1987.
151 ! Stull, R. B., An Introduction to Bounday Layer Meteorology, Kluwer,
152 ! Dordrecht, 1988
153 !.......................................................................
154
155
156 ! Geometric Constants:
157
158 REAL*8 PI ! pi (single precision 3.141593)
159 PARAMETER ( PI = 3.14159265358979324 )
160
161 REAL PI180 ! pi/180 [ rad/deg ]
162 PARAMETER ( PI180 = PI / 180.0 )
163
164 ! Geodetic Constants:
165
166 REAL REARTH ! radius of the earth [ m ]
167 ! FSB: radius of sphere having same surface area as
168 ! Clarke ellipsoid of 1866 ( Source: Snyder, 1987)
169 PARAMETER ( REARTH = 6370997.0 )
170
171 REAL SIDAY ! length of a sidereal day [ sec ]
172 ! FSB: Source: CRC76 pp. 14-6
173 PARAMETER ( SIDAY = 86164.09 )
174
175 REAL GRAV ! mean gravitational acceleration [ m/sec**2 ]
176 ! FSB: Value is mean of polar and equatorial values.
177 ! Source: CRC Handbook (76th Ed) pp. 14-6
178 PARAMETER ( GRAV = 9.80622 )
179
180 REAL DG2M ! latitude degrees to meters
181 PARAMETER ( DG2M = REARTH * PI180 )
182
183 ! Solar Constant:
184 REAL SOLCNST ! Solar constant [ W/m**2 ], p14-2 CRC76
185 PARAMETER ( SOLCNST = 1373.0 )
186
187 ! Fundamental Constants: ( Source: CRC76, pp. 1-1 to 1-6)
188
189 REAL AVO ! Avogadro's Constant [ number/mol ]
190 PARAMETER ( AVO = 6.0221367E23 )
191
192 REAL RGASUNIV ! universal gas constant [ J/mol-K ]
193 PARAMETER ( RGASUNIV = 8.314510 )
194
195 REAL STDATMPA ! standard atmosphere [ Pa ]
196 PARAMETER ( STDATMPA = 101325.0 )
197
198 REAL STDTEMP ! Standard Temperature [ K ]
199 PARAMETER ( STDTEMP = 273.15 )
200
201 REAL STFBLZ ! Stefan-Boltzmann [ W/(m**2 K**4) ]
202 PARAMETER ( STFBLZ = 5.67051E-8 )
203
204 ! FSB Non-MKS
205
206 REAL MOLVOL ! Molar volume at STP [ L/mol ] Non MKS units
207 PARAMETER ( MOLVOL = 22.41410 )
208
209 ! Atmospheric Constants:
210
211 REAL MWAIR ! mean molecular weight for dry air [ g/mol ]
212 ! FSB: 78.06% N2, 21% O2, and 0.943% A on a mole
213 ! fraction basis ( Source : Hobbs, 1995) pp. 69-70
214 PARAMETER ( MWAIR = 28.9628 )
215
216 REAL RDGAS ! dry-air gas constant [ J / kg-K ]
217 PARAMETER ( RDGAS = 1.0E3 * RGASUNIV / MWAIR ) ! 287.07548994
218
219 REAL MWWAT ! mean molecular weight for water vapor [ g/mol ]
220 PARAMETER ( MWWAT = 18.0153 )
221
222 REAL RWVAP ! gas constant for water vapor [ J/kg-K ]
223 PARAMETER ( RWVAP = 1.0E3 * RGASUNIV / MWWAT ) ! 461.52492604
224
225 ! FSB NOTE: CPD, CVD, CPWVAP and CVWVAP are calculated assuming dry air and
226 ! water vapor are classical ideal gases, i.e. vibration does not contribute
227 ! to internal energy.
228
229 REAL CPD ! specific heat of dry air at constant pressure [ J/kg-K ]
230 PARAMETER ( CPD = 7.0 * RDGAS / 2.0 ) ! 1004.7642148
231
232 REAL CVD ! specific heat of dry air at constant volume [ J/kg-K ]
233 PARAMETER ( CVD = 5.0 * RDGAS / 2.0 ) ! 717.68872485
234
235 REAL CPWVAP ! specific heat for water vapor at constant pressure [ J/kg-K ]
236 PARAMETER ( CPWVAP = 4.0 * RWVAP ) ! 1846.0997042
237
238 REAL CVWVAP ! specific heat for water vapor at constant volume [ J/kg-K ]
239 PARAMETER ( CVWVAP = 3.0 * RWVAP ) ! 1384.5747781
240
241 REAL VP0 ! vapor press of water at 0 C [ Pa ] Source: CRC76 pp. 6-15
242 PARAMETER ( VP0 = 611.29 )
243
244 ! FSB The following values are taken from p. 641 of Stull (1988):
245
246 REAL LV0 ! latent heat of vaporization of water at 0 C [ J/kg ]
247 PARAMETER ( LV0 = 2.501E6 )
248
249 REAL DLVDT ! Rate of change of latent heat of vaporization with
250 ! respect to temperature [ J/kg-K ]
251 PARAMETER ( DLVDT = 2370.0 )
252
253 REAL LF0 ! latent heat of fusion of water at 0 C [ J/kg ]
254 PARAMETER ( LF0 = 3.34E5 )
255
256 !.......................................................................
257 ! INCLUDE 'PARMS3.EXT' ! I/O parameters definitions
258 ! INCLUDE 'AQ_PARAMS2.EXT' ! aqueous chemistry shared parameters
259
260
261 ! Aqeuous species pointers INCLUDE File
262
263 !...........PARAMETERS and their descriptions:
264
265 INTEGER NGAS ! number of gas phase species for AQCHEM
266 PARAMETER ( NGAS = 11 )
267
268 INTEGER NAER ! number of aerosol species for AQCHEM
269 PARAMETER ( NAER = 23 )
270
271 !...pointers for the AQCHEM array GAS
272
273 INTEGER LSO2 ! local pointer to SO2
274 PARAMETER ( LSO2 = 1 )
275
276 INTEGER LHNO3 ! local pointer to HNO3
277 PARAMETER ( LHNO3 = 2 )
278
279 INTEGER LN2O5 ! local pointer to N2O5
280 PARAMETER ( LN2O5 = 3 )
281
282 INTEGER LCO2 ! local pointer to CO2
283 PARAMETER ( LCO2 = 4 )
284
285 INTEGER LNH3 ! local pointer to NH3
286 PARAMETER ( LNH3 = 5 )
287
288 INTEGER LH2O2 ! local pointer to H2O2
289 PARAMETER ( LH2O2 = 6 )
290
291 INTEGER LO3 ! local pointer to O3
292 PARAMETER ( LO3 = 7 )
293
294 INTEGER LFOA ! local pointer to FOA
295 PARAMETER ( LFOA = 8 )
296
297 INTEGER LMHP ! local pointer to MHP
298 PARAMETER ( LMHP = 9 )
299
300 INTEGER LPAA ! local pointer to PAA
301 PARAMETER ( LPAA = 10 )
302
303 INTEGER LH2SO4 ! local pointer to H2SO4
304 PARAMETER ( LH2SO4 = 11 )
305
306 !...pointers for the AQCHEM array AEROSOL
307
308 INTEGER LSO4AKN ! local pointer to SO4I aerosol
309 PARAMETER ( LSO4AKN = 1 )
310
311 INTEGER LSO4ACC ! local pointer to SO4 aerosol
312 PARAMETER ( LSO4ACC = 2 )
313
314 INTEGER LNH4AKN ! local pointer to NH4I aerosol
315 PARAMETER ( LNH4AKN = 3 )
316
317 INTEGER LNH4ACC ! local pointer to NH4 aerosol
318 PARAMETER ( LNH4ACC = 4 )
319
320 INTEGER LNO3AKN ! local pointer to NO3I aerosol
321 PARAMETER ( LNO3AKN = 5 )
322
323 INTEGER LNO3ACC ! local pointer to NO3 aerosol
324 PARAMETER ( LNO3ACC = 6 )
325
326 INTEGER LNO3COR ! local pointer to course aerosol nitrate
327 PARAMETER ( LNO3COR = 7 )
328
329 INTEGER LORGAKN ! local pointer to organic I aerosol
330 PARAMETER ( LORGAKN = 8 )
331
332 INTEGER LORGACC ! local pointer to organic aerosol
333 PARAMETER ( LORGACC = 9 )
334
335 INTEGER LPRIAKN ! local pointer to primary I aerosol
336 PARAMETER ( LPRIAKN = 10 )
337
338 INTEGER LPRIACC ! local pointer to primary aerosol
339 PARAMETER ( LPRIACC = 11 )
340
341 INTEGER LPRICOR ! local pointer to primary I aerosol
342 PARAMETER ( LPRICOR = 12 )
343
344 INTEGER LCACO3 ! local pointer to CaCO3 aerosol
345 PARAMETER ( LCACO3 = 13 )
346
347 INTEGER LMGCO3 ! local pointer to MgCO3 aerosol
348 PARAMETER ( LMGCO3 = 14 )
349
350 INTEGER LNACL ! local pointer to NaCl aerosol
351 PARAMETER ( LNACL = 15 )
352
353 INTEGER LA3FE ! local pointer to Fe+++ aerosol
354 PARAMETER ( LA3FE = 16 )
355
356 INTEGER LB2MN ! local pointer to Mn++ aerosol
357 PARAMETER ( LB2MN = 17 )
358
359 INTEGER LKCL ! local pointer to NaCl aerosol
360 PARAMETER ( LKCL = 18 )
361
362 INTEGER LNUMAKN ! local pointer to # Aitken aerosol
363 PARAMETER ( LNUMAKN = 19 )
364
365 INTEGER LNUMACC ! local pointer to # accumulation aerosol
366 PARAMETER ( LNUMACC = 20 )
367
368 INTEGER LNUMCOR ! local pointer to # coarse aerosol
369 PARAMETER ( LNUMCOR = 21 )
370
371 INTEGER LSRFAKN ! local pointer to sfc area Aitken aerosol
372 PARAMETER ( LSRFAKN = 22 )
373
374 INTEGER LSRFACC ! local pntr to sfc area accumulation aerosol
375 PARAMETER ( LSRFACC = 23 )
376
377 !...surrogate names, their background values, and units
378 !... for AQCHEM's GAS species
379
380 CHARACTER*16 SGRGAS( NGAS ) ! surrogate name for gases
381 SAVE SGRGAS
382
383 REAL BGNDGAS( NGAS ) ! background values for each gas
384 SAVE BGNDGAS
385
386 CHARACTER*16 BUNTSGAS( NGAS ) ! units of bkgnd values
387 SAVE BUNTSGAS
388
389 DATA SGRGAS( 1 ), BGNDGAS( 1 ) /'SO2 ', 0.0 /
390 DATA SGRGAS( 2 ), BGNDGAS( 2 ) /'HNO3 ', 0.0 /
391 DATA SGRGAS( 3 ), BGNDGAS( 3 ) /'N2O5 ', 0.0 /
392 DATA SGRGAS( 4 ), BGNDGAS( 4 ) /'CO2 ', 340.0 /
393 DATA SGRGAS( 5 ), BGNDGAS( 5 ) /'NH3 ', 0.0 /
394 DATA SGRGAS( 6 ), BGNDGAS( 6 ) /'H2O2 ', 0.0 /
395 DATA SGRGAS( 7 ), BGNDGAS( 7 ) /'O3 ', 0.0 /
396 DATA SGRGAS( 8 ), BGNDGAS( 8 ) /'FOA ', 0.0 /
397 DATA SGRGAS( 9 ), BGNDGAS( 9 ) /'MHP ', 0.0 /
398 DATA SGRGAS( 10 ), BGNDGAS( 10 ) /'PAA ', 0.0 /
399 DATA SGRGAS( 11 ), BGNDGAS( 11 ) /'H2SO4 ', 0.0 /
400
401 DATA BUNTSGAS( 1 ) / 'ppm' /
402 DATA BUNTSGAS( 2 ) / 'ppm' /
403 DATA BUNTSGAS( 3 ) / 'ppm' /
404 DATA BUNTSGAS( 4 ) / 'ppm' /
405 DATA BUNTSGAS( 5 ) / 'ppm' /
406 DATA BUNTSGAS( 6 ) / 'ppm' /
407 DATA BUNTSGAS( 7 ) / 'ppm' /
408 DATA BUNTSGAS( 8 ) / 'ppm' /
409 DATA BUNTSGAS( 9 ) / 'ppm' /
410 DATA BUNTSGAS( 10 ) / 'ppm' /
411 DATA BUNTSGAS( 11 ) / 'ppm' /
412
413 !...surrogate names, their background values, units, and molecular weights
414 !... for AQCHEM's AEROSOL species
415
416 CHARACTER*16 SGRAER( NAER ) ! surrogate name for aerosols
417 SAVE SGRAER
418
419 REAL SGRAERMW( NAER ) ! molecular weight for aerosol species
420 SAVE SGRAERMW
421
422 CHARACTER*16 BUNTSAER( NAER ) ! units of bkgnd values
423 SAVE BUNTSAER
424
425 REAL BGNDAER( NAER ) ! bkground vals each aerosols
426 SAVE BGNDAER
427
428 DATA SGRAER( 1 ), SGRAERMW( 1 ) / 'SO4_AITKEN ' , 96.0 /
429 DATA SGRAER( 2 ), SGRAERMW( 2 ) / 'SO4_ACCUM ' , 96.0 /
430 DATA SGRAER( 3 ), SGRAERMW( 3 ) / 'NH4_AITKEN ' , 18.0 /
431 DATA SGRAER( 4 ), SGRAERMW( 4 ) / 'NH4_ACCUM ' , 18.0 /
432 DATA SGRAER( 5 ), SGRAERMW( 5 ) / 'NO3_AITKEN ' , 62.0 /
433 DATA SGRAER( 6 ), SGRAERMW( 6 ) / 'NO3_ACCUM ' , 62.0 /
434 DATA SGRAER( 7 ), SGRAERMW( 7 ) / 'NO3_COARSE ' , 62.0 /
435 DATA SGRAER( 8 ), SGRAERMW( 8 ) / 'ORG_AITKEN ' , 120.0 /
436 DATA SGRAER( 9 ), SGRAERMW( 9 ) / 'ORG_ACCUM ' , 120.0 /
437 DATA SGRAER( 10 ), SGRAERMW( 10 ) / 'PRI_AITKEN ' , 200.0 /
438 DATA SGRAER( 11 ), SGRAERMW( 11 ) / 'PRI_ACCUM ' , 200.0 /
439 DATA SGRAER( 12 ), SGRAERMW( 12 ) / 'PRI_COARSE ' , 100.0 /
440 DATA SGRAER( 13 ), SGRAERMW( 13 ) / 'CACO3 ' , 100.1 /
441 DATA SGRAER( 14 ), SGRAERMW( 14 ) / 'MGCO3 ' , 84.3 /
442 DATA SGRAER( 15 ), SGRAERMW( 15 ) / 'NACL ' , 58.4 /
443 DATA SGRAER( 16 ), SGRAERMW( 16 ) / 'A3FE ' , 55.8 /
444 DATA SGRAER( 17 ), SGRAERMW( 17 ) / 'B2MN ' , 54.9 /
445 DATA SGRAER( 18 ), SGRAERMW( 18 ) / 'KCL ' , 74.6 /
446 DATA SGRAER( 19 ), SGRAERMW( 19 ) / 'NUM_AITKEN ' , 1.0 /
447 DATA SGRAER( 20 ), SGRAERMW( 20 ) / 'NUM_ACCUM ' , 1.0 /
448 DATA SGRAER( 21 ), SGRAERMW( 21 ) / 'NUM_COARSE ' , 1.0 /
449 DATA SGRAER( 22 ), SGRAERMW( 22 ) / 'SRF_AITKEN ' , 1.0 /
450 DATA SGRAER( 23 ), SGRAERMW( 23 ) / 'SRF_ACCUM ' , 1.0 /
451
452 DATA BGNDAER( 1 ), BUNTSAER( 1 ) / 0.0, 'ug/m3' /
453 DATA BGNDAER( 2 ), BUNTSAER( 2 ) / 0.0, 'ug/m3' /
454 DATA BGNDAER( 3 ), BUNTSAER( 3 ) / 0.0, 'ug/m3' /
455 DATA BGNDAER( 4 ), BUNTSAER( 4 ) / 0.0, 'ug/m3' /
456 DATA BGNDAER( 5 ), BUNTSAER( 5 ) / 0.0, 'ug/m3' /
457 DATA BGNDAER( 6 ), BUNTSAER( 6 ) / 0.0, 'ug/m3' /
458 DATA BGNDAER( 7 ), BUNTSAER( 7 ) / 0.0, 'ug/m3' /
459 DATA BGNDAER( 8 ), BUNTSAER( 8 ) / 0.0, 'ug/m3' /
460 DATA BGNDAER( 9 ), BUNTSAER( 9 ) / 0.0, 'ug/m3' /
461 DATA BGNDAER( 10 ), BUNTSAER( 10 ) / 0.0, 'ug/m3' /
462 DATA BGNDAER( 11 ), BUNTSAER( 11 ) / 0.0, 'ug/m3' /
463 DATA BGNDAER( 12 ), BUNTSAER( 12 ) / 0.0, 'ug/m3' /
464 DATA BGNDAER( 13 ), BUNTSAER( 13 ) / 0.0, 'ug/m3' /
465 DATA BGNDAER( 14 ), BUNTSAER( 14 ) / 0.0, 'ug/m3' /
466 DATA BGNDAER( 15 ), BUNTSAER( 15 ) / 0.0, 'ug/m3' /
467 DATA BGNDAER( 16 ), BUNTSAER( 16 ) / 0.010, 'ug/m3' /
468 DATA BGNDAER( 17 ), BUNTSAER( 17 ) / 0.005, 'ug/m3' /
469 DATA BGNDAER( 18 ), BUNTSAER( 18 ) / 0.0, 'ug/m3' /
470 DATA BGNDAER( 19 ), BUNTSAER( 19 ) / 0.0, '#/m3' /
471 DATA BGNDAER( 20 ), BUNTSAER( 20 ) / 0.0, '#/m3' /
472 DATA BGNDAER( 21 ), BUNTSAER( 21 ) / 0.0, '#/m3' /
473 DATA BGNDAER( 22 ), BUNTSAER( 22 ) / 0.0, 'm2/m3' /
474 DATA BGNDAER( 23 ), BUNTSAER( 23 ) / 0.0, 'm2/m3' /
475 CHARACTER*120 XMSG ! Exit status message
476 DATA XMSG / ' ' /
477
478 !...........PARAMETERS and their descriptions:
479
480 INTEGER NUMOX ! number of oxidizing reactions
481 PARAMETER ( NUMOX = 5 )
482
483 REAL H2ODENS ! density of water at 20 C and 1 ATM
484 PARAMETER ( H2ODENS = 1000.0 ) ! (kg/m3)
485
486 INTEGER NLIQS ! number of liquid phase species
487 PARAMETER ( NLIQS = 33 )
488
489 REAL ONETHIRD ! 1/3
490 PARAMETER ( ONETHIRD = 1.0 / 3.0 )
491
492 REAL TWOTHIRDS ! 2/3
493 PARAMETER ( TWOTHIRDS = 2.0 / 3.0 )
494
495 REAL CONCMIN ! minimum concentration
496 PARAMETER ( CONCMIN = 1.0E-30 )
497
498 REAL SEC2HR ! convert seconds to hours
499 PARAMETER ( SEC2HR = 1.0 / 3600.0 )
500
501 !...........ARGUMENTS and their descriptions
502
503 INTEGER JDATE ! current model date, coded YYYYDDD
504 INTEGER JTIME ! current model time, coded HHMMSS
505
506 REAL AIRM ! total air mass in cloudy layers (mol/m2)
507 REAL ALFA0 ! scav coef for aitken aerosol number
508 REAL ALFA2 ! scav coef for aitken aerosol sfc area
509 REAL ALFA3 ! scav coef for aitken aerosol mass
510 REAL HPWDEP ! hydrogen wet deposition (mm mol/liter)
511 REAL PRCRATE ! precip rate (mm/hr)
512 REAL PRES_PA ! pressure (Pa)
513 REAL TAUCLD ! timestep for cloud (s)
514 REAL TEMP ! temperature (K)
515 REAL WCAVG ! liquid water content (kg/m3)
516 REAL WTAVG ! total water content (kg/m3)
517 REAL GAS ( NGAS ) ! gas phase concentrations (mol/molV)
518 REAL AEROSOL( NAER ) ! aerosol concentrations (mol/molV)
519 REAL GASWDEP( NGAS ) ! gas phase wet deposition array (mm mol/liter)
520 REAL AERWDEP( NAER ) ! aerosol wet deposition array (mm mol/liter)
521
522 !...........LOCAL VARIABLES (scalars) and their descriptions:
523
524 CHARACTER*16 PNAME ! driver program name
525 DATA PNAME / 'AQCHEM' /
526 SAVE PNAME
527
528 INTEGER I20C ! loop counter for do loop 20
529 INTEGER I30C ! loop counter for do loop 30
530 INTEGER ITERAT ! # iterations of aqueaous chemistry solver
531 INTEGER I7777C ! aqueous chem iteration counter
532 INTEGER ICNTAQ ! aqueous chem iteration counter
533 INTEGER LIQ ! loop counter for liquid species
534 INTEGER IOX ! index over oxidation reactions
535
536 REAL atrah
537 REAL DEPSUM
538 REAL BETASO4
539 REAL A ! iron's anion concentration
540 REAL AC ! H+ concentration in cloudwater (mol/liter)
541 REAL ACT1 ! activity corretion factor!single ions
542 REAL ACT2 ! activity factor correction!double ions
543 REAL ACTB !
544 REAL AE ! guess for H+ conc in cloudwater (mol/liter)
545 REAL B ! manganese's anion concentration
546 REAL PRES_ATM ! pressure (Atm)
547 REAL BB ! lower limit guess of cloudwater pH
548 REAL CA ! Calcium conc in cloudwater (mol/liter)
549 REAL CAA ! inital Calcium in cloudwater (mol/liter)
550 REAL NO3CORA ! initial NO3COR in cloudwater (mol/liter)
551 REAL CL ! Cl- conc in cloudwater (mol/liter)
552 REAL CLA ! initial Cl in cloudwater (mol/liter)
553 REAL CO2H ! Henry's Law constant for CO2
554 REAL CO21 ! First dissociation constant for CO2
555 REAL CO22 ! Second dissociation constant for CO2
556 REAL CO212 ! CO21*CO22
557 REAL CO212H ! CO2H*CO21*CO22
558 REAL CO21H ! CO2H*CO21
559 REAL CO2L ! CO2 conc in cloudwater (mol/liter)
560 REAL CO3 ! CO3= conc in cloudwater (mol/liter)
561 REAL CO3A ! initial CO3 in cloudwater (mol/liter)
562 REAL CTHK1 ! cloud thickness (m)
563 REAL DTRMV !
564 REAL DTS6 !
565 REAL EBETASO4T ! EXP( -BETASO4 * TAUCLD )
566 REAL EALFA0T ! EXP( -ALFA0 * TAUCLD )
567 REAL EALFA2T ! EXP( -ALFA2 * TAUCLD )
568 REAL EALFA3T ! EXP( -ALFA3 * TAUCLD )
569 REAL FA ! functional value ??
570 REAL FB ! functional value ??
571 REAL FE ! Fe+++ conc in cloudwater (mol/liter)
572 REAL FEA ! initial Fe in cloudwater (mol/liter)
573 REAL FNH3 ! frac weight of NH3 to total ammonia
574 REAL FNH4ACC ! frac weight of NH4 acc to total ammonia
575 REAL FHNO3 ! frac weight of HNO3 to total NO3
576 REAL FNO3ACC ! frac weight of NO3 acc to total NO3
577 REAL FNO3COR ! frac weight of NO3 cor to total NO3
578 REAL FRACACC ! frac ACC that was from accum mode
579 REAL FRACCOR ! frac NO3 that was from coarse mode
580 REAL FRACLIQ ! fraction of water in liquid form
581 REAL FOA1 ! First dissociation constant for FOA
582 REAL FOAH ! Henry's Law constant for FOA
583 REAL FOA1H ! FOAH*FOA1
584 REAL FOAL ! FOA conc in cloudwater (mol/liter)
585 REAL FTST !
586 REAL GM !
587 REAL GM1 !
588 REAL GM1LOG !
589 REAL GM2 ! activity correction factor
590 REAL GM2LOG !
591 REAL HA !
592 REAL HB !
593 REAL H2OW !
594 REAL H2O2H ! Henry's Law Constant for H2O2
595 REAL H2O2L ! H2O2 conc in cloudwater (mol/liter)
596 REAL HCO2 ! HCO2 conc in cloudwater (mol/liter)
597 REAL HCO3 ! HCO3 conc in cloudwater (mol/liter)
598 REAL HNO3H ! Henry's Law Constant for HNO3
599 REAL HNO31 ! First dissociation constant for HNO3
600 REAL HNO31H !
601 REAL HNO3L ! HNO3 conc in cloudwater (mol/liter)
602 REAL HSO3 ! HSO3 conc in cloudwater (mol/liter)
603 REAL HSO4 ! HSO4 concn in cloudwater (mol/liter)
604 REAL HTST !
605 REAL K ! K conc in cloudwater (mol/liter)
606 REAL KA ! initial K in cloudwater (mol/liter)
607 REAL LGTEMP ! log of TEMP
608 REAL M3NEW ! accumulation mode mass at time t
609 REAL M3OLD ! accumulation mode mass at time 0
610 REAL MG !
611 REAL MGA ! inital Mg in cloudwater (mol/liter)
612 REAL MHPH ! Henry's Law Constant for MHP
613 REAL MHPL ! MHP conc in cloudwater (mol/liter)
614 REAL MN ! Mn++ conc in cloudwater (mol/liter)
615 REAL MNA ! initial Mn in cloudwater (mol/liter)
616 REAL NA ! Na conc in cloudwater (mol/liter)
617 REAL NAA ! initial Na in cloudwater (mol/liter)
618 REAL NH31 ! First dissociation constant for NH3
619 REAL NH3H ! Henry's Law Constant for NH3
620 REAL NH3DH20 !
621 REAL NH31HDH !
622 REAL NH3L ! NH3 conc in cloudwater (mol/liter)
623 REAL NH4 ! NH4+ conc in cloudwater (mol/liter)
624 REAL NH4AKNA ! init NH4 akn conc in cloudwater (mol/liter)
625 REAL NH4ACCA ! init NH4 acc conc in cloudwater (mol/liter)
626 REAL NITAER ! total aerosol nitrate
627 REAL NO3 ! NO3 conc in cloudwater (mol/liter)
628 REAL NO3ACCA ! init NO3 acc conc in cloudwater (mol/liter)
629 REAL NO3AKNA ! init NO3 akn conc in cloudwater (mol/liter)
630 REAL O3H ! Henry's Law Constant for O3
631 REAL O3L ! O3 conc in cloudwater (mol/liter)
632 REAL OH ! OH conc in cloudwater (mol/liter)
633 REAL ORGN ! ORGANIC aerosol in cloudwater (mol/liter)
634 REAL ORGACCA ! init ORG ACC aerosol in cloudwater (mol/liter)
635 REAL ORGAKNA ! init ORG AKN aerosol in cloudwater (mol/liter)
636 REAL PAAH ! Henry's Law Constant for PAA
637 REAL PAAL ! PAA conc in cloudwater (mol/liter)
638 REAL PCO20 ! total CO2 partial pressure (atm)
639 REAL PCO2F ! gas only CO2 partial pressure (atm)
640 REAL PFOA0 ! total ORGANIC acid partial pressure (atm)
641 REAL PFOAF ! gas only ORGANIC ACID partial press (atm)
642 REAL PH2O20 ! total H2O2 partial pressure (atm)
643 REAL PH2O2F ! gas only H2O2 partial pressure (atm)
644 REAL PHNO30 ! total HNO3 partial pressure (atm)
645 REAL PHNO3F ! gas only HNO3 partial pressure (atm)
646 REAL PMHP0 ! total MHP partial pressure (atm)
647 REAL PMHPF ! gas only MHP partial pressure (atm)
648 REAL PNH30 ! total NH3 partial pressure (atm)
649 REAL PNH3F ! gas only NH3 partial pressure (atm)
650 REAL PO30 ! total O3 partial pressure (atm)
651 REAL PO3F ! gas only O3 partial pressure (atm)
652 REAL PPAA0 ! total PAA partial pressure (atm)
653 REAL PPAAF ! gas only PAA partial pressure (atm)
654 REAL PRIM ! PRIMARY acc+akn aerosol in cloudwater (mol/liter)
655 REAL PRIMCOR ! PRIMARY coarse aerosol in cloudwater (mol/liter)
656 REAL PRIACCA ! init PRI ACC aerosol in cloudwater (mol/liter)
657 REAL PRIAKNA ! init PRI AKN aerosol in cloudwater (mol/liter)
658 REAL PRICORA ! init PRI COR aerosol in cloudwater (mol/liter)
659 REAL PSO20 ! total SO2 partial pressure (atm)
660 REAL PSO2F ! gas only SO2 partial pressure (atm)
661 REAL RATE !
662 REAL RECIPA1 !
663 REAL RECIPA2 !
664 REAL RECIPAP1 ! one over pressure (/atm)
665 REAL RH2O2 !
666 REAL RMHP !
667 REAL RPAA !
668 REAL RT ! gas const * temperature (liter atm/mol)
669 REAL SCVEFF ! Scavenging efficiency (%)
670 DATA SCVEFF / 100.0 / ! currently set to 100%
671 SAVE SCVEFF
672 REAL SIV ! dissolved so2 in cloudwater (mol/liter)
673 REAL SK6 !
674 REAL SK6TS6 !
675 REAL SO21 ! First dissociation constant for SO2
676 REAL SO22 ! Second dissociation constant for SO2
677 REAL SO2H ! Henry's Law Constant for SO2
678 REAL SO212 ! SO21*SO22
679 REAL SO212H ! SO21*SO22*SO2H
680 REAL SO21H ! SO21*SO2H
681 REAL SO2L ! SO2 conc in cloudwater (mol/liter)
682 REAL SO3 ! SO3= conc in cloudwater (mol/liter)
683 REAL SO4 ! SO4= conc in cloudwater (mol/liter)
684 REAL STION ! ionic strength
685 REAL TAC !
686 REAL TEMP1 !
687 REAL TIMEW ! cloud chemistry clock (sec)
688 REAL TOTOX !
689 REAL TOTAMM ! total ammonium
690 REAL TOTNIT ! total nitrate
691 REAL TS6 ! SO4 conc in cloudwater (mol/liter)
692 REAL TS6AKNA ! init SO4 akn conc in cloudwater (mol/liter)
693 REAL TS6ACCA ! init SO4 acc conc in cloudwater (mol/liter)
694 REAL TSIV !
695 REAL TST !
696 REAL WETFAC ! converts mol/l to mm-mol/l based on precip
697 REAL XC1 ! (/mm)
698 REAL XC2 ! (liter-atm/mol/mm)
699 REAL XL ! conversion factor (liter-atm/mol)
700 REAL ONE_OVER_XL ! 1.0 / XL
701 REAL PRES_ATM_OVER_XL ! PRES_ATM / XL
702 REAL XLCO2 !
703 REAL XLH2O2 !
704 REAL XLHNO3 !
705 REAL XLMHP !
706 REAL XLNH3 !
707 REAL XLO3 !
708 REAL XLPAA !
709 REAL XLSO2 !
710
711 !...........LOCAL VARIABLES (arrays) and their descriptions:
712
713 REAL LIQUID( NLIQS ) ! wet deposition array (mm mol/liter)
714 REAL WETDEP( NLIQS ) ! wet deposition array (mm mol/liter)
715 REAL DSIVDT( 0:NUMOX ) ! rate of so2 oxid incloud (mol/liter/sec)
716 REAL DS4 ( 0:NUMOX ) ! S(IV) oxidized over timestep DTW(0)
717 REAL*8 DTW ( 0:NUMOX ) ! cloud chemistry timestep (sec)
718
719 REAL ONE_OVER_TEMP ! 1.0 / TEMP
720
721 !...........EXTERNAL FUNCTIONS and their descriptions:
722
723 ! REAL HLCONST
724 ! EXTERNAL HLCONST
725
726 !*********************************************************************
727 ! begin body of subroutine AQCHEM
728
729 ONE_OVER_TEMP = 1.0 / TEMP
730
731 !...check for bad temperature, cloud air mass, or pressure
732
733 IF ( TEMP .LE. 0.0 ) THEN
734 IF ( AIRM .LE. 0.0 ) THEN
735 IF ( PRES_PA .LE. 0.0 ) THEN
736 ! XMSG = 'MET DATA ERROR'
737 !cc CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
738 write(0,*)TEMP,AIRM,PRES_PA
739 CALL wrf_error_fatal ( ' met data error in aqchem')
740 END IF
741 END IF
742 END IF
743
744 !...compute several conversion factors
745
746 ICNTAQ = 0
747 ITERAT = 0
748 RT = ( MOLVOL / STDTEMP ) * TEMP ! R * T (liter atm / mol)
749 PRES_ATM = PRES_PA / STDATMPA ! pressure (atm)
750 CTHK1 = AIRM * RT / ( PRES_ATM * 1000.0 ) ! cloud thickness (m)
751 XL = WCAVG * RT / H2ODENS ! conversion factor (l-atm/mol)
752 ONE_OVER_XL = 1.0 / XL
753 PRES_ATM_OVER_XL = PRES_ATM / XL
754 TST = 0.999
755 GM = SCVEFF / 100.0
756 ACT1 = 1.0
757 ACT2 = 1.0
758 GM2 = 1.0
759 TIMEW = 0.0
760 RECIPAP1 = 1.0 / PRES_ATM
761 XC1 = 1.0 / ( WCAVG * CTHK1 )
762 XC2 = RT / ( 1000.0 * CTHK1 )
763 FRACLIQ = WCAVG / WTAVG
764 gaswdep=0.
765 aerwdep=0.
766
767 !...set equilibrium constants as a function of temperature
768 !... Henry's law constants
769
770 SO2H = HLCONST( 'SO2 ', TEMP, .FALSE., 0.0 )
771 CO2H = HLCONST( 'CO2 ', TEMP, .FALSE., 0.0 )
772 NH3H = HLCONST( 'NH3 ', TEMP, .FALSE., 0.0 )
773 H2O2H = HLCONST( 'H2O2 ', TEMP, .FALSE., 0.0 )
774 O3H = HLCONST( 'O3 ', TEMP, .FALSE., 0.0 )
775 HNO3H = HLCONST( 'HNO3 ', TEMP, .FALSE., 0.0 )
776 MHPH = HLCONST( 'METHYLHYDROPEROX', TEMP, .FALSE., 0.0 )
777 PAAH = HLCONST( 'PEROXYACETIC_ACI', TEMP, .FALSE., 0.0 )
778 FOAH = HLCONST( 'FORMIC_ACID ', TEMP, .FALSE., 0.0 )
779 atraH = HLCONST( 'ATRA ', TEMP, .true., 1.0e-4 )
780
781 TEMP1 = ONE_OVER_TEMP - 1.0 / 298.0
782
783 !...dissociation constants
784
785 FOA1 = 1.80E-04 * EXP( -2.00E+01 * TEMP1 ) ! Martell and Smith (1977)
786 SK6 = 1.02E-02 * EXP( 2.72E+03 * TEMP1 ) ! Smith and Martell (1976)
787 SO21 = 1.30E-02 * EXP( 1.96E+03 * TEMP1 ) ! Smith and Martell (1976)
788 SO22 = 6.60E-08 * EXP( 1.50E+03 * TEMP1 ) ! Smith and Martell (1976)
789 CO21 = 4.30E-07 * EXP( -1.00E+03 * TEMP1 ) ! Smith and Martell (1976)
790 CO22 = 4.68E-11 * EXP( -1.76E+03 * TEMP1 ) ! Smith and Martell (1976)
791 H2OW = 1.00E-14 * EXP( -6.71E+03 * TEMP1 ) ! Smith and Martell (1976)
792 NH31 = 1.70E-05 * EXP( -4.50E+02 * TEMP1 ) ! Smith and Martell (1976)
793 HNO31 = 1.54E+01 * EXP( 8.70E+03 * TEMP1 ) ! Schwartz (1984)
794
795 !...Kinetic oxidation rates
796 !... From Chamedies (1982)
797
798 RH2O2 = 8.0E+04 * EXP( -3650.0 * TEMP1 )
799
800 !...From Kok
801
802 RMHP = 1.75E+07 * EXP( -3801.0 * TEMP1 )
803 RPAA = 3.64E+07 * EXP( -3994.0 * TEMP1 )
804
805 !...make initializations
806
807 DO LIQ = 1, NLIQS
808 WETDEP( LIQ ) = 0.0
809 END DO
810
811 DO IOX = 0, NUMOX
812 DSIVDT( IOX ) = 0.0
813 DTW ( IOX ) = 0.0
814 DS4 ( IOX ) = 0.0
815 END DO
816
817 !...compute the initial accumulation aerosol 3rd moment
818
819 M3OLD = ( AEROSOL( LSO4ACC ) * SGRAERMW( LSO4ACC ) / 1.8e6 &
820 + AEROSOL( LNH4ACC ) * SGRAERMW( LNH4ACC ) / 1.8e6 &
821 + AEROSOL( LNO3ACC ) * SGRAERMW( LNO3ACC ) / 1.8e6 &
822 + AEROSOL( LORGACC ) * SGRAERMW( LORGACC ) / 2.0e6 &
823 + AEROSOL( LPRIACC ) * SGRAERMW( LPRIACC ) / 2.2e6 )
824 !cc & * 6.0 / PI ! cancels out in division at end of subroutine
825
826 !...compute fractional weights for several species
827
828 NITAER = AEROSOL( LNO3ACC ) + AEROSOL( LNO3COR )
829 IF ( NITAER .GT. 0.0 ) THEN
830 FRACACC = AEROSOL( LNO3ACC ) / NITAER
831 FRACCOR = AEROSOL( LNO3COR ) / NITAER
832 ELSE
833 FRACACC = 1.0
834 FRACCOR = 0.0
835 END IF
836
837 TOTNIT = GAS( LHNO3 ) + AEROSOL( LNO3ACC ) + AEROSOL( LNO3COR )
838 IF ( TOTNIT .GT. 0.0 ) THEN
839 FHNO3 = GAS( LHNO3 ) / TOTNIT
840 FNO3ACC = AEROSOL( LNO3ACC ) / TOTNIT
841 FNO3COR = AEROSOL( LNO3COR ) / TOTNIT
842 ELSE
843 FHNO3 = 1.0
844 FNO3ACC = 0.0
845 FNO3COR = 0.0
846 END IF
847
848 TOTAMM = GAS( LNH3 ) + AEROSOL( LNH4ACC )
849 IF ( TOTAMM .GT. 0.0 ) THEN
850 FNH3 = GAS( LNH3 ) / TOTAMM
851 FNH4ACC = AEROSOL( LNH4ACC ) / TOTAMM
852 ELSE
853 FNH3 = 1.0
854 FNH4ACC = 0.0
855 END IF
856
857 !...initial concentration from accumulation-mode aerosol loading (mol/liter)
858 !... an assumption is made that all of the accumulation-mode
859 !... aerosol mass in incorporated into the cloud droplets
860
861 TS6ACCA = ( AEROSOL( LSO4ACC ) &
862 + GAS ( LH2SO4 ) ) * PRES_ATM_OVER_XL
863 NO3ACCA = AEROSOL( LNO3ACC ) * PRES_ATM_OVER_XL
864 NH4ACCA = AEROSOL( LNH4ACC ) * PRES_ATM_OVER_XL
865 ORGACCA = AEROSOL( LORGACC ) * PRES_ATM_OVER_XL
866 PRIACCA = AEROSOL( LPRIACC ) * PRES_ATM_OVER_XL
867
868 !...initial concentration from coarse-mode aerosol loading (mol/liter)
869 !... an assumption is made that all of the coarse-mode
870 !... aerosol mass in incorporated into the cloud droplets
871
872 CLA = ( AEROSOL( LNACL ) &
873 + AEROSOL( LKCL ) ) * PRES_ATM_OVER_XL
874 NO3CORA = AEROSOL( LNO3COR ) * PRES_ATM_OVER_XL
875 CAA = AEROSOL( LCACO3 ) * PRES_ATM_OVER_XL
876 MGA = AEROSOL( LMGCO3 ) * PRES_ATM_OVER_XL
877 NAA = AEROSOL( LNACL ) * PRES_ATM_OVER_XL
878 KA = AEROSOL( LKCL ) * PRES_ATM_OVER_XL
879 FEA = AEROSOL( LA3FE ) * PRES_ATM_OVER_XL
880 MNA = AEROSOL( LB2MN ) * PRES_ATM_OVER_XL
881 CO3A = ( AEROSOL( LCACO3 ) &
882 + AEROSOL( LMGCO3 ) ) * PRES_ATM_OVER_XL
883 PRICORA = AEROSOL( LPRICOR ) * PRES_ATM_OVER_XL
884
885 !...set constant factors that will be used in later multiplications (moles/atm)
886
887 XLH2O2 = H2O2H * XL
888 XLO3 = O3H * XL
889 XLMHP = MHPH * XL
890 XLPAA = PAAH * XL
891 XLSO2 = SO2H * XL
892 XLNH3 = NH3H * XL
893 XLHNO3 = HNO3H * XL
894 XLCO2 = CO2H * XL
895
896 SO212 = SO21 * SO22
897 SO21H = SO21 * SO2H
898 SO212H = SO212 * SO2H
899 CO212 = CO21 * CO22
900 CO21H = CO21 * CO2H
901 CO212H = CO22 * CO21H
902 NH3DH20 = NH31 / H2OW
903 NH31HDH = NH3H * NH3DH20
904 FOA1H = FOA1 * FOAH
905 HNO31H = HNO31 * HNO3H
906
907 !...If kinetic calculations are made, return to this point
908
909 I20C = 0
910 20 CONTINUE
911
912 I20C = I20C + 1
913 IF ( I20C .GE. 1000 ) THEN
914 XMSG = 'EXCESSIVE LOOPING AT I20C'
915 !cc CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
916 END IF
917
918 !...set aitken-mode aerosol loading (mol/liter)
919
920 NO3AKNA = AEROSOL( LNO3AKN ) * PRES_ATM_OVER_XL &
921 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
922 NH4AKNA = AEROSOL( LNH4AKN ) * PRES_ATM_OVER_XL &
923 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
924 TS6AKNA = AEROSOL( LSO4AKN ) * PRES_ATM_OVER_XL &
925 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
926 ORGAKNA = AEROSOL( LORGAKN ) * PRES_ATM_OVER_XL &
927 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
928 PRIAKNA = AEROSOL( LPRIAKN ) * PRES_ATM_OVER_XL &
929 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
930
931 !...Initial gas phase partial pressures (atm)
932 !... = initial partial pressure - amount deposited partial pressure
933
934 PSO20 = GAS( LSO2 ) * PRES_ATM &
935 + DS4( 0 ) * XL &
936 - ( WETDEP( 8 ) + WETDEP( 9 ) + WETDEP( 10 ) ) * XC2
937 PNH30 = GAS( LNH3 ) * PRES_ATM &
938 + ( NH4ACCA + NH4AKNA ) * XL &
939 - ( WETDEP( 2 ) + WETDEP( 15 ) ) * XC2
940 PHNO30 = ( GAS( LHNO3 ) + 2.0 * GAS( LN2O5 ) ) * PRES_ATM &
941 + ( NO3ACCA + NO3CORA + NO3AKNA ) * XL &
942 - ( WETDEP( 14 ) + WETDEP( 32 ) ) * XC2
943 PH2O20 = GAS( LH2O2 ) * PRES_ATM - WETDEP( 17 ) * XC2
944 PO30 = GAS( LO3 ) * PRES_ATM - WETDEP( 18 ) * XC2
945 PFOA0 = GAS( LFOA ) * PRES_ATM &
946 - ( WETDEP( 22 ) + WETDEP( 23 ) ) * XC2
947 PMHP0 = GAS( LMHP ) * PRES_ATM - WETDEP( 24 ) * XC2
948 PPAA0 = GAS( LPAA ) * PRES_ATM - WETDEP( 25 ) * XC2
949 PCO20 = GAS( LCO2 ) * PRES_ATM &
950 + CO3A * XL &
951 - ( WETDEP( 11 ) + WETDEP( 12 ) + WETDEP( 13 ) ) * XC2
952
953 !...don't allow gas concentrations to go below zero
954
955 PSO20 = MAX( PSO20, 0.0 )
956 PNH30 = MAX( PNH30, 0.0 )
957 PH2O20 = MAX( PH2O20, 0.0 )
958 PO30 = MAX( PO30, 0.0 )
959 PFOA0 = MAX( PFOA0, 0.0 )
960 PMHP0 = MAX( PMHP0, 0.0 )
961 PPAA0 = MAX( PPAA0, 0.0 )
962 PCO20 = MAX( PCO20, 0.0 )
963 PHNO30 = MAX( PHNO30, 0.0 )
964
965 !...Molar concentrations of soluble aerosols
966 !... = Initial amount - amount deposited (mol/liter)
967
968 TS6 = TS6ACCA + TS6AKNA &
969 - ( WETDEP( 6 ) + WETDEP( 7 ) ) * XC1 &
970 - DS4( 0 )
971 CL = CLA - WETDEP( 16 ) * XC1
972 CA = CAA - WETDEP( 3 ) * XC1
973 MG = MGA - WETDEP( 29 ) * XC1
974 NA = NAA - WETDEP( 4 ) * XC1
975 K = KA - WETDEP( 30 ) * XC1
976 FE = FEA - WETDEP( 19 ) * XC1
977 MN = MNA - WETDEP( 20 ) * XC1
978 ORGN = ORGACCA + ORGAKNA - WETDEP( 27 ) * XC1
979 PRIM = PRIACCA + PRIAKNA - WETDEP( 28 ) * XC1
980 PRIMCOR = PRICORA - WETDEP( 33 ) * XC1
981 A = 3.0 * FE
982 B = 2.0 * MN
983
984 !...don't allow aerosol concentrations to go below zero
985
986 TS6 = MAX( TS6, 0.0 )
987 CL = MAX( CL, 0.0 )
988 CA = MAX( CA, 0.0 )
989 MG = MAX( MG, 0.0 )
990 NA = MAX( NA, 0.0 )
991 K = MAX( K, 0.0 )
992 FE = MAX( FE, 0.0 )
993 MN = MAX( MN, 0.0 )
994 ORGN = MAX( ORGN, 0.0 )
995 PRIM = MAX( PRIM, 0.0 )
996 PRIMCOR = MAX( PRIMCOR, 0.0 )
997 A = MAX( A, 0.0 )
998 B = MAX( B, 0.0 )
999
1000 SK6TS6 = SK6 * TS6
1001
1002 !...find solution of the equation using a method of reiterative
1003 !... bisections Make initial guesses for pH: between .01 to 10.
1004
1005 HA = 0.01
1006 HB = 10.0
1007
1008 I7777C = 0
1009 7777 CONTINUE
1010
1011 I7777C = I7777C + 1
1012 IF ( I7777C .GE. 1000 ) THEN
1013 XMSG = 'EXCESSIVE LOOPING AT I7777C'
1014 !cc CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1015 END IF
1016
1017 HA = MAX( HA - 0.8, 0.1 )
1018 HB = MIN( HB + 0.8, 9.9 )
1019 AE = 10.0**( -HA )
1020
1021 RECIPA1 = 1.0 / ( AE * ACT1 )
1022 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1023
1024 !...calculate final gas phase partial pressure of SO2, NH3, HNO3
1025 !... HCOOH, and CO2 (atm)
1026
1027 PSO2F = PSO20 / ( 1.0 + XLSO2 * ( 1.0 + SO21 * RECIPA1 &
1028 + SO212 * RECIPA2 ) )
1029
1030 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1031
1032 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1033
1034 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1035
1036 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1037 + CO212 * RECIPA2 ) )
1038
1039 !...calculate liquid phase concentrations (moles/liter)
1040
1041 SO4 = SK6TS6 / ( AE * GM2 + SK6 )
1042 HSO4 = TS6 - SO4
1043 SO3 = SO212H * PSO2F * RECIPA2
1044 HSO3 = SO21H * PSO2F * RECIPA1
1045 CO3 = CO212H * PCO2F * RECIPA2
1046 HCO3 = CO21H * PCO2F * RECIPA1
1047 OH = H2OW * RECIPA1
1048 NH4 = NH31HDH * PNH3F * AE
1049 HCO2 = FOA1H * PFOAF * RECIPA1
1050 NO3 = HNO31H * PHNO3F * RECIPA1
1051
1052 !...compute functional value
1053
1054 FA = AE + NH4 + 2.0 * (CA + MG - CO3 - SO3 - SO4 ) - OH - HCO3 &
1055 - HSO3 - NO3 - HSO4 - HCO2
1056
1057 !...Start iteration and bisection ****************<<<<<<<
1058
1059 I30C = 0
1060 30 CONTINUE
1061
1062 I30C = I30C + 1
1063 IF ( I30C .GE. 1000 ) THEN
1064 XMSG = 'EXCESSIVE LOOPING AT I30C'
1065 !cc CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1066 END IF
1067
1068 BB = ( HA + HB ) / 2.0
1069 AE = 10.0**( -BB )
1070
1071 ICNTAQ = ICNTAQ + 1
1072 IF ( ICNTAQ .GE. 3000 ) THEN
1073 XMSG = 'Maximum AQCHEM total iterations exceeded'
1074 !cc CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1075 END IF
1076
1077 RECIPA1 = 1.0 / ( AE * ACT1 )
1078 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1079
1080 !...calculate final gas phase partial pressure of SO2, NH3, HNO3
1081 !... HCOOH, and CO2 (atm)
1082
1083 PSO2F = PSO20 / ( 1.0 + XLSO2 &
1084 * ( 1.0 + SO21 * RECIPA1 + SO212 * RECIPA2 ) )
1085
1086 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1087
1088 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1089
1090 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1091
1092 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1093 + CO212 * RECIPA2 ) )
1094
1095 !...calculate liquid phase concentrations (moles/liter)
1096
1097 SO4 = SK6TS6 / ( AE * GM2 + SK6 )
1098 HSO4 = TS6 - SO4
1099 SO3 = SO212H * PSO2F * RECIPA2
1100 HSO3 = SO21H * PSO2F * RECIPA1
1101 CO3 = CO212H * PCO2F * RECIPA2
1102 HCO3 = CO21H * PCO2F * RECIPA1
1103 OH = H2OW * RECIPA1
1104 NH4 = NH31HDH * PNH3F * AE
1105 HCO2 = FOA1H * PFOAF * RECIPA1
1106 NO3 = HNO31H * PHNO3F * RECIPA1
1107
1108 !...compute functional value
1109
1110 FB = AE + NH4 + 2.0 * ( CA + MG - CO3 - SO3 - SO4 ) - OH - HCO3 &
1111 - HSO3 - NO3 - HSO4 - HCO2
1112
1113 !...Calculate and check the sign of the product of the two functional values
1114
1115 FTST = FA * FB
1116 IF ( FTST .LE. 0.0 ) THEN
1117 HB = BB
1118 ELSE
1119 HA = BB
1120 FA = FB
1121 END IF
1122
1123 !...Check convergence of solutions
1124
1125 HTST = HA / HB
1126 IF ( HTST .LE. TST ) GO TO 30
1127
1128 !...end of zero-finding routine ****************<<<<<<<<<<<<
1129
1130 !...compute Ionic strength and activity coefficient by the Davies equation
1131
1132 STION = 0.5 * (AE + NH4 + OH + HCO3 + HSO3 &
1133 + 4.0 * (SO4 + CO3 + SO3 + CA + MG + MN) &
1134 + NO3 + HSO4 + 9.0 * FE + NA + K + CL + A + B + HCO2)
1135 GM1LOG = -0.509 * ( SQRT( STION ) &
1136 / ( 1.0 + SQRT( STION ) ) - 0.2 * STION )
1137 GM2LOG = GM1LOG * 4.0
1138 GM1 = 10.0**GM1LOG
1139 GM2 = MAX( 10.0**GM2LOG, 1.0E-30 )
1140 ACTB = ACT1
1141 ACT1 = MAX( GM1 * GM1, 1.0E-30 )
1142 ACT2 = MAX( GM1 * GM1 * GM2, 1.0E-30 )
1143
1144 !...check for convergence and possibly go to 7777, to recompute
1145 !... Gas and liquid phase concentrations
1146
1147 TAC = ABS( ACTB - ACT1 ) / ACTB
1148 IF ( TAC .GE. 1.0E-2 ) GO TO 7777
1149
1150 !...return an error if the pH is not in range
1151
1152 !cc IF ( ( HA .LT. 0.02 ) .OR. ( HA .GT. 9.49 ) ) THEN
1153 IF ( ( HA .LT. 0.1 ) .OR. ( HA .GT. 9.9 ) ) THEN
1154 print *, ha
1155 ! XMSG = 'PH VALUE OUT OF RANGE'
1156 !CC CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1157 END IF
1158
1159 !...Make those concentration calculations which can be made outside
1160 !... of the function.
1161
1162 SO2L = SO2H * PSO2F
1163 AC = 10.0**( -BB )
1164 SIV = SO3 + HSO3 + SO2L
1165
1166 !...Calculate final gas phase concentrations of oxidants (atm)
1167
1168 PH2O2F = ( PH2O20 + XL * DS4( 1 ) ) / ( 1.0 + XLH2O2 )
1169 PO3F = ( PO30 + XL * DS4( 2 ) ) / ( 1.0 + XLO3 )
1170 PMHPF = ( PMHP0 + XL * DS4( 4 ) ) / ( 1.0 + XLMHP )
1171 PPAAF = ( PPAA0 + XL * DS4( 5 ) ) / ( 1.0 + XLPAA )
1172
1173 PH2O2F = MAX( PH2O2F, 0.0 )
1174 PO3F = MAX( PO3F, 0.0 )
1175 PMHPF = MAX( PMHPF, 0.0 )
1176 PPAAF = MAX( PPAAF, 0.0 )
1177
1178 !...Calculate liquid phase concentrations of oxidants (moles/liter)
1179
1180 H2O2L = PH2O2F * H2O2H
1181 O3L = PO3F * O3H
1182 MHPL = PMHPF * MHPH
1183 PAAL = PPAAF * PAAH
1184 FOAL = PFOAF * FOAH
1185 NH3L = PNH3F * NH3H
1186 CO2L = PCO2F * CO2H
1187 HNO3L = PHNO3F * HNO3H
1188
1189 !...load the liquid concentration array with current values
1190
1191 LIQUID( 1 ) = AC
1192 LIQUID( 2 ) = NH4
1193 LIQUID( 3 ) = CA
1194 LIQUID( 4 ) = NA
1195 LIQUID( 5 ) = OH
1196 LIQUID( 6 ) = SO4
1197 LIQUID( 7 ) = HSO4
1198 LIQUID( 8 ) = SO3
1199 LIQUID( 9 ) = HSO3
1200 LIQUID( 10 ) = SO2L
1201 LIQUID( 11 ) = CO3
1202 LIQUID( 12 ) = HCO3
1203 LIQUID( 13 ) = CO2L
1204 LIQUID( 14 ) = NO3
1205 LIQUID( 15 ) = NH3L
1206 LIQUID( 16 ) = CL
1207 LIQUID( 17 ) = H2O2L
1208 LIQUID( 18 ) = O3L
1209 LIQUID( 19 ) = FE
1210 LIQUID( 20 ) = MN
1211 LIQUID( 21 ) = A
1212 LIQUID( 22 ) = FOAL
1213 LIQUID( 23 ) = HCO2
1214 LIQUID( 24 ) = MHPL
1215 LIQUID( 25 ) = PAAL
1216 LIQUID( 26 ) = 0.0
1217 LIQUID( 27 ) = ORGN
1218 LIQUID( 28 ) = PRIM
1219 LIQUID( 29 ) = MG
1220 LIQUID( 30 ) = K
1221 LIQUID( 31 ) = B
1222 LIQUID( 32 ) = HNO3L
1223 LIQUID( 33 ) = PRIMCOR
1224
1225 !...if the maximum cloud lifetime has not been reached, the compute
1226 !... the next timestep.
1227
1228 IF ( TIMEW .LT. TAUCLD ) THEN
1229
1230 !...make kinetics calculations
1231 !... note: DS4(i) and DSIV(I) are negative numbers!
1232
1233 DTRMV = 300.0
1234 IF ( ( CTHK1 .GT. 1.0E-10 ) .AND. ( PRCRATE .GT. 1.0E-10 ) ) &
1235 DTRMV = 3.6 * WTAVG * 1000.0 * CTHK1 / PRCRATE ! <<<uma found bug, was .36
1236 DTRMV = MIN( DTRMV, 300.0 )
1237 ITERAT = ITERAT + 1
1238
1239 !...Define the total S(iv) available for oxidation
1240
1241 TSIV = PSO20 * ONE_OVER_XL
1242
1243 !...Calculate sulfur iv oxidation rate due to H2O2
1244
1245 DSIVDT( 1 ) = -RH2O2 * H2O2L * SO2L / ( 0.1 + AC )
1246 TOTOX = PH2O20 * ONE_OVER_XL
1247 IF ( ( DSIVDT( 1 ) .EQ. 0.0 ) .OR. &
1248 ( TSIV .LE. CONCMIN ) .OR. &
1249 ( TOTOX .LE. CONCMIN ) ) THEN
1250 DTW( 1 ) = DTRMV
1251 ELSE
1252 DTW( 1 ) = -0.05 * MIN( TOTOX, TSIV ) / DSIVDT( 1 )
1253 END IF
1254
1255 !...Calculate sulfur iv oxidation rate due to O3
1256
1257 IF ( BB .GE. 2.7 ) THEN
1258 DSIVDT( 2 ) = -4.19E5 * ( 1.0 + 2.39E-4 / AC ) * O3L * SIV
1259 ELSE
1260 DSIVDT( 2 ) = -1.9E4 * SIV * O3L / SQRT( AC )
1261 END IF
1262 TOTOX = PO30 * ONE_OVER_XL
1263 IF ( ( DSIVDT( 2 ) .EQ. 0.0 ) .OR. &
1264 ( TSIV .LE. CONCMIN ) .OR. &
1265 ( TOTOX .LE. CONCMIN ) ) THEN
1266 DTW( 2 ) = DTRMV
1267 ELSE
1268 DTW( 2 ) = -0.01 * MIN( TOTOX, TSIV ) / DSIVDT( 2 )
1269 END IF
1270
1271 !...Calculate sulfur iv oxidation rate due to 02 catalyzed by Mn++
1272 !... and Fe+++ See Table IV Walcek & Taylor ( 1986)
1273
1274 IF ( BB .GE. 4.0 ) THEN ! 4.0 < pH
1275
1276 IF ( SIV .LE. 1.0E-5 ) THEN
1277 DSIVDT( 3 ) = -5000.0 * MN * HSO3
1278 ELSE IF ( SIV .GT. 1.0E-5 ) THEN
1279 DSIVDT( 3 ) = -( 4.7 * MN * MN / AC &
1280 + 1.0E7 * FE * SIV * SIV )
1281 END IF ! end of first pass through SIV conc.
1282
1283 ELSE ! pH , + 4.0
1284
1285 IF ( SIV .LE. 1.0E-5 ) THEN
1286 DSIVDT( 3 ) = -3.0 * ( 5000.0 * MN * HSO3 &
1287 + 0.82 * FE * SIV / AC )
1288 ELSE
1289 DSIVDT( 3 ) = -( 4.7 * MN * MN / AC &
1290 + ( 0.82 * FE * SIV / AC ) &
1291 * ( 1.0 + 1.7E3 * MN**1.5 / ( 6.3E-6 + FE ) ) )
1292 END IF ! end of second pass through SIV conc.
1293
1294 END IF ! end of pass through pH
1295
1296 IF ( ( DSIVDT( 3 ) .EQ. 0.0 ) .OR. ( TSIV .LE. CONCMIN ) ) THEN
1297 DTW( 3 ) = DTRMV
1298 ELSE
1299 DTW( 3 ) = -0.1 * TSIV / DSIVDT( 3 )
1300 END IF
1301
1302 !...Calculate sulfur oxidation rate due to MHP
1303
1304 DSIVDT( 4 ) = -RMHP * AC * MHPL * HSO3
1305 TOTOX = PMHP0 * ONE_OVER_XL
1306 IF ( ( DSIVDT( 4 ) .EQ. 0.0 ) .OR. &
1307 ( TSIV .LE. CONCMIN ) .OR. &
1308 ( TOTOX .LE. CONCMIN ) ) THEN
1309 DTW( 4 ) = DTRMV
1310 ELSE
1311 DTW( 4 ) = -0.1 * MIN( TOTOX, TSIV ) / DSIVDT( 4 )
1312 END IF
1313
1314 !...Calculate sulfur oxidation due to PAA
1315
1316 DSIVDT( 5 ) = -RPAA * HSO3 * PAAL * ( AC + 1.65E-5 )
1317 TOTOX = PPAA0 * ONE_OVER_XL
1318 IF ( ( DSIVDT( 5 ) .EQ. 0.0 ) .OR. &
1319 ( TSIV .LE. CONCMIN ) .OR. &
1320 ( TOTOX .LE. CONCMIN ) ) THEN
1321 DTW( 5 ) = DTRMV
1322 ELSE
1323 DTW( 5 ) = -0.1 * MIN( TOTOX, TSIV ) / DSIVDT( 5 )
1324 END IF
1325
1326 !...Calculate total sulfur iv oxidation rate
1327
1328 DSIVDT( 0 ) = 0.0
1329 DO IOX = 1, NUMOX
1330 DSIVDT( 0 ) = DSIVDT( 0 ) + DSIVDT( IOX )
1331 END DO
1332
1333 !...Calculate a minimum time step required
1334
1335 DTW( 0 ) = MIN( DTW( 1 ), DTW( 2 ), DTW( 3 ), &
1336 DTW( 4 ), DTW( 5 ) )
1337
1338 !...check for large time step
1339
1340 IF ( DTW( 0 ) .GT. 8.0E+37 ) THEN
1341 WRITE(6,1001) PRCRATE, DSIVDT(0), TS6, DTW(0), CTHK1, WTAVG
1342 ELSE
1343
1344 !...calculate the change in sulfur iv for this time step
1345
1346 60 DTS6 = ABS( DTW( 0 ) * ( -DSIVDT( 0 ) - TS6 * PRCRATE &
1347 / ( 3600.0 * CTHK1 * WTAVG ) ) )
1348
1349 !...If DSIV(0), sulfur iv oxidized during this time step would be
1350 !... less than 5% of sulfur oxidized since time 0, then double DT
1351
1352 IF ( DTW( 0 ) .LE. TAUCLD ) THEN
1353 IF ( DTS6 .LT. 0.05 * TS6 ) THEN
1354 DTW( 0 ) = DTW( 0 ) * 2.0
1355 GO TO 60
1356 END IF
1357 END IF
1358 END IF
1359 DTW( 0 ) = MIN( REAL(DTW( 0 )), DTRMV )
1360
1361 !...Limit the timestep to prevent negative SO2 concentrations and mass creation
1362 !... for sulfate (suggested by Bonyoung Koo, ENVIRON Corp)
1363
1364 IF ( DSIVDT( 0 ) .LT. 0.0 ) THEN
1365 DTW( 0 ) = MIN( REAL(DTW( 0 )), -TSIV * 1.00001 / DSIVDT( 0 ) )
1366 ENDIF
1367
1368 !...alternative bug fix (BUT EXPENSIVE)
1369
1370 ! if ( ( -DSIVDT( 0 ) * DTW( 0 ) ) .gt. TSIV ) then
1371 ! dtw( 0 ) = -TSIV * 1.00001 / DSIVDT( 0 )
1372 ! end if
1373
1374 !...If the total time after this time increment will be greater than
1375 !... TAUCLD sec., then set DTW(0) so that total time will be TAUCLD
1376
1377 IF ( TIMEW + DTW( 0 ) .GT. TAUCLD ) DTW( 0 ) = TAUCLD - TIMEW
1378 !cc IF ( TS6 .LT. 1.0E-11 ) DTW( 0 ) = TAUCLD - TIMEW
1379 IF ( ITERAT .GT. 100 ) DTW( 0 ) = TAUCLD - TIMEW
1380
1381 ! print *, iterat, dtw(0)
1382
1383 !...Set DSIV(I), I = 0,NUMOX, the amount of S(IV) oxidized by each
1384 !... individual oxidizing agent, as well as the total.
1385
1386 DO IOX = 0, NUMOX
1387 DS4( IOX ) = DS4( IOX ) + DTW( 0 ) * DSIVDT( IOX )
1388 END DO
1389
1390 !...Compute depositions and concentrations for each species
1391
1392 WETFAC = PRCRATE * FRACLIQ * DTW( 0 ) * SEC2HR
1393 DO LIQ = 1, NLIQS
1394 WETDEP( LIQ ) = WETDEP( LIQ ) + LIQUID( LIQ ) * WETFAC
1395 END DO
1396
1397 TIMEW = TIMEW + DTW( 0 )
1398
1399 !...Return to make additional calculations
1400
1401 GO TO 20
1402 END IF
1403
1404 !...At this point, TIMEW=TAUCLD
1405 !... compute the scavenging coefficient for SO4 which will be used for
1406 !... scavenging aerosol number in the accumulation and coarse mode
1407
1408 DEPSUM = ( WETDEP( 6 ) + WETDEP( 7 ) ) * XC1
1409
1410 IF ( ( TS6ACCA + TS6AKNA - DS4( 0 ) ) .NE. 0.0 ) THEN
1411 BETASO4 = DEPSUM / ( ( TS6ACCA + TS6AKNA - DS4( 0 ) ) * TAUCLD )
1412 ELSE
1413 BETASO4 = 0.0
1414 END IF
1415
1416 EBETASO4T = EXP( -BETASO4 * TAUCLD )
1417 EALFA0T = EXP( -ALFA0 * TAUCLD )
1418 EALFA2T = EXP( -ALFA2 * TAUCLD )
1419 EALFA3T = EXP( -ALFA3 * TAUCLD )
1420
1421 !...Compute the output concentrations and wetdeposition amounts
1422
1423 TOTAMM = ( PNH3F + ( NH4 + NH3L ) * XL ) * RECIPAP1
1424 TOTNIT = ( PHNO3F + ( NO3 + HNO3L ) * XL ) * RECIPAP1
1425
1426 !...gas-phase species wet deposition (mm mol/lit)
1427 if(prcrate.gt.1.e-10)then
1428 GASWDEP( LSO2 ) = ( WETDEP( 8 ) + WETDEP( 9 ) + WETDEP( 10 ) ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1429 GASWDEP( LNH3 ) = WETDEP( 15 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1430 GASWDEP( LH2O2 ) = WETDEP( 17 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1431 GASWDEP( LO3 ) = WETDEP( 18 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1432 GASWDEP( LCO2 ) = (WETDEP( 11 ) + WETDEP( 12 ) + WETDEP( 13 ) )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1433 GASWDEP( LFOA ) = (WETDEP( 22 ) + WETDEP( 23 ) )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1434 GASWDEP( LMHP ) = WETDEP( 24 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1435 GASWDEP( LPAA ) = WETDEP( 25 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1436 GASWDEP( LHNO3 ) = WETDEP( 32 )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1437 GASWDEP( LN2O5 ) = 0.0
1438 GASWDEP( LH2SO4 ) = 0.0
1439
1440 !...gas concentrations (mol/molV)
1441
1442
1443 !...aerosol species wet deposition (mm mol/lit)
1444 !... there is no wet deposition of aitken particles, they attached
1445 !... to the accumulation mode particles
1446
1447 AERWDEP( LSO4AKN ) = 0.0
1448 AERWDEP( LSO4ACC ) = ( WETDEP( 6 ) + WETDEP( 7 ) ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1449 AERWDEP( LNH4AKN ) = 0.0
1450 AERWDEP( LNH4ACC ) = WETDEP( 2 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1451 AERWDEP( LNO3AKN ) = 0.0
1452 AERWDEP( LNO3ACC ) = WETDEP( 14 ) * FRACACC * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1453 AERWDEP( LNO3COR ) = WETDEP( 14 ) * FRACCOR * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1454 AERWDEP( LORGAKN ) = 0.0
1455 AERWDEP( LORGACC ) = WETDEP( 27 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1456 AERWDEP( LPRIAKN ) = 0.0
1457 AERWDEP( LPRIACC ) = WETDEP( 28 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1458 AERWDEP( LPRICOR ) = WETDEP( 33 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1459 AERWDEP( LNACL ) = WETDEP( 4 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1460 AERWDEP( LA3FE ) = WETDEP( 19 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1461 AERWDEP( LB2MN ) = WETDEP( 20 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1462 AERWDEP( LCACO3 ) = WETDEP( 3 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1463 AERWDEP( LMGCO3 ) = WETDEP( 29 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1464 AERWDEP( LKCL ) = WETDEP( 30 ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1465 AERWDEP( LNUMAKN ) = 0.0
1466 AERWDEP( LNUMACC ) = AEROSOL( LNUMACC ) * AIRM &
1467 * ( 1.0 - EBETASO4T ) * XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1468 AERWDEP( LNUMCOR ) = AEROSOL( LNUMCOR ) * AIRM &
1469 * ( 1.0 - EBETASO4T )* XL * RECIPAP1 / PRCRATE * FRACLIQ * taucld * SEC2HR
1470 AERWDEP( LSRFAKN ) = 0.0
1471 AERWDEP( LSRFACC ) = 0.0
1472
1473 endif
1474 GAS( LSO2 ) = ( PSO2F + XL * SIV ) * RECIPAP1
1475 GAS( LNH3 ) = FNH3 * TOTAMM
1476 GAS( LH2O2 ) = ( PH2O2F + XL * H2O2L ) * RECIPAP1
1477 GAS( LO3 ) = ( PO3F + XL * O3L ) * RECIPAP1
1478 GAS( LCO2 ) = ( PCO2F + XL * CO2L ) * RECIPAP1
1479 GAS( LFOA ) = ( PFOAF + XL * ( FOAL &
1480 + HCO2 ) ) * RECIPAP1
1481 GAS( LMHP ) = ( PMHPF + XL * MHPL ) * RECIPAP1
1482 GAS( LPAA ) = ( PPAAF + XL * PAAL ) * RECIPAP1
1483 GAS( LHNO3 ) = FHNO3 * TOTNIT
1484 GAS( LN2O5 ) = 0.0 ! assume all into aerosol
1485 GAS( LH2SO4 ) = 0.0 ! assume all into aerosol
1486
1487 !...aerosol concentrations (mol/molV)
1488
1489 AEROSOL( LSO4AKN ) = AEROSOL( LSO4AKN ) * EALFA3T
1490 AEROSOL( LSO4ACC ) = TS6 * XL * RECIPAP1
1491 AEROSOL( LNH4AKN ) = AEROSOL( LNH4AKN ) * EALFA3T
1492 AEROSOL( LNH4ACC ) = FNH4ACC * TOTAMM
1493 AEROSOL( LNO3AKN ) = AEROSOL( LNO3AKN ) * EALFA3T
1494 AEROSOL( LNO3ACC ) = FNO3ACC * TOTNIT
1495 AEROSOL( LNO3COR ) = FNO3COR * TOTNIT
1496 AEROSOL( LORGAKN ) = AEROSOL( LORGAKN ) * EALFA3T
1497 AEROSOL( LORGACC ) = ORGN * XL * RECIPAP1
1498 AEROSOL( LPRIAKN ) = AEROSOL( LPRIAKN ) * EALFA3T
1499 AEROSOL( LPRIACC ) = PRIM * XL * RECIPAP1
1500 AEROSOL( LPRICOR ) = PRIMCOR* XL * RECIPAP1
1501 AEROSOL( LNACL ) = NA * XL * RECIPAP1
1502 AEROSOL( LA3FE ) = FE * XL * RECIPAP1
1503 AEROSOL( LB2MN ) = MN * XL * RECIPAP1
1504 AEROSOL( LCACO3 ) = CA * XL * RECIPAP1
1505 AEROSOL( LMGCO3 ) = MG * XL * RECIPAP1
1506 AEROSOL( LKCL ) = K * XL * RECIPAP1
1507 AEROSOL( LNUMAKN ) = AEROSOL( LNUMAKN ) * EALFA0T
1508 AEROSOL( LNUMACC ) = AEROSOL( LNUMACC ) * EBETASO4T
1509 AEROSOL( LNUMCOR ) = AEROSOL( LNUMCOR ) * EBETASO4T
1510
1511 !...compute the final accumulation aerosol 3rd moment
1512
1513 M3NEW = ( AEROSOL( LSO4ACC ) * SGRAERMW( LSO4ACC ) / 1.8e6 &
1514 + AEROSOL( LNH4ACC ) * SGRAERMW( LNH4ACC ) / 1.8e6 &
1515 + AEROSOL( LNO3ACC ) * SGRAERMW( LNO3ACC ) / 1.8e6 &
1516 + AEROSOL( LORGACC ) * SGRAERMW( LORGACC ) / 2.0e6 &
1517 + AEROSOL( LPRIACC ) * SGRAERMW( LPRIACC ) / 2.2e6 )
1518 !CC & * 6.0 / PI ! cancels out in division below
1519
1520 AEROSOL( LSRFAKN ) = AEROSOL( LSRFAKN ) * EALFA2T
1521 AEROSOL( LSRFACC ) = AEROSOL( LSRFACC ) &
1522 * ( EXP( -BETASO4 * TAUCLD * ONETHIRD ) ) &
1523 * ( M3NEW / MAX( M3OLD, CONCMIN) ) ** TWOTHIRDS
1524
1525 !...store the amount of hydrogen deposition
1526
1527 HPWDEP = WETDEP( 1 )
1528
1529 RETURN
1530
1531 !...formats
1532
1533 1001 FORMAT (1X,'STORM RATE=', F6.3, 'DSIVDT(0) =', F10.5, &
1534 'TS6=', F10.5, 'DTW(0)=', F10.5, 'CTHK1=', F10.5, &
1535 'WTAVG=', F10.5)
1536
1537 END SUBROUTINE AQCHEM
1538 !.........................................................................
1539
1540 INTEGER FUNCTION TRIMLEN ( STRING )
1541
1542 !***********************************************************************
1543 ! function body starts at line 43
1544 !
1545 ! FUNCTION: return the effective length of argument CHARACTER*(*) STRING,
1546 ! after trailing blanks have been trimmed.
1547 !
1548 ! PRECONDITIONS REQUIRED: none
1549 !
1550 ! SUBROUTINES AND FUNCTIONS CALLED: none
1551 !
1552 ! REVISION HISTORY:
1553 ! Prototype 8/91 by CJC
1554 ! Version 2/93 for CRAY by CJC
1555 !
1556 !***********************************************************************
1557
1558 IMPLICIT NONE
1559
1560
1561 !........... ARGUMENTS and their descriptions:
1562
1563 CHARACTER*(*) STRING
1564
1565
1566 !........... SCRATCH LOCAL VARIABLES and their descriptions:
1567
1568 INTEGER L, K
1569
1570
1571 !***********************************************************************
1572 ! begin body of function TRIMLEN
1573
1574 L = LEN( STRING )
1575 DO 11 K = L, 1, -1
1576 IF ( STRING( K:K ) .NE. ' ' ) THEN
1577 GO TO 12
1578 END IF
1579 11 CONTINUE
1580
1581 K = 1
1582
1583 12 CONTINUE
1584
1585 TRIMLEN = K
1586
1587 ! RETURN
1588
1589 END FUNCTION TRIMLEN
1590
1591
1592 !***********************************************************************
1593 ! Portions of Models-3/CMAQ software were developed or based on *
1594 ! information from various groups: Federal Government employees, *
1595 ! contractors working on a United States Government contract, and *
1596 ! non-Federal sources (including research institutions). These *
1597 ! research institutions have given the Government permission to *
1598 ! use, prepare derivative works, and distribute copies of their *
1599 ! work in Models-3/CMAQ to the public and to permit others to do *
1600 ! so. EPA therefore grants similar permissions for use of the *
1601 ! Models-3/CMAQ software, but users are requested to provide copies *
1602 ! of derivative works to the Government without restrictions as to *
1603 ! use by others. Users are responsible for acquiring their own *
1604 ! copies of commercial software associated with Models-3/CMAQ and *
1605 ! for complying with vendor requirements. Software copyrights by *
1606 ! the MCNC Environmental Modeling Center are used with their *
1607 ! permissions subject to the above restrictions. *
1608 !***********************************************************************
1609
1610 ! RCS file, release, date & time of last delta, author, state, [and locker]
1611 ! $Header: /project/work/rep/CCTM/src/cloud/cloud_radm/hlconst.F,v 1.8 2002/05/02 20:43:08 sjr Exp $
1612
1613 ! what(1) key, module and SID; SCCS file; date and time of last delta:
1614 ! %W% %P% %G% %U%
1615
1616 REAL FUNCTION HLCONST ( NAME, TEMP, EFFECTIVE, HPLUS )
1617
1618 !-----------------------------------------------------------------------
1619 !
1620 ! FUNCTION: return the Henry's law constant for the specified substance
1621 ! at the given temperature
1622 !
1623 ! revision history:
1624 ! who when what
1625 ! --------- -------- -------------------------------------
1626 ! S.Roselle 08/15/97 code written for Models-3
1627 ! J.Gipson 06/18/01 added Henry's Law constants 50-55 for saprc99
1628 ! W.Hutzell 07/03/01 added Henry's Law constants 56-57 for Atrazine
1629 ! and the daughter products from Atrazine and OH
1630 ! reactions.
1631 ! J.Gipson. 09/06/02 added Henry's Law constants 59-73 for toxicz
1632 ! S.Roselle 11/07/02 added capability for calculating the effective
1633 ! Henry's law constant and updated coefficients
1634 ! in Henry's law constant table
1635 !-----------------------------------------------------------------------
1636
1637 IMPLICIT NONE
1638
1639 !...........INCLUDES and their descriptions
1640
1641 ! INCLUDE 'IODECL3.EXT' ! I/O definitions and declarations
1642 ! INCLUDE 'PARMS3.EXT' ! I/O parameters definitions
1643
1644 !...........PARAMETERS and their descriptions:
1645
1646 INTEGER MXSPCS ! Number of substances
1647 PARAMETER ( MXSPCS = 73 )
1648
1649 INTEGER MXDSPCS ! Number of dissociating species
1650 PARAMETER ( MXDSPCS = 12 )
1651
1652 !...........ARGUMENTS and their descriptions
1653
1654 CHARACTER*(*) NAME ! name of substance
1655 REAL TEMP ! temperature (K)
1656 LOGICAL EFFECTIVE ! true=compute the effective henry's law constant
1657 REAL HPLUS ! hydrogen ion concentration (mol/l)
1658
1659 !...........SCRATCH LOCAL VARIABLES and their descriptions:
1660
1661 CHARACTER*16 PNAME ! program name
1662 DATA PNAME / 'HLCONST' /
1663 SAVE PNAME
1664 CHARACTER*16 SUBNAME( MXSPCS ) ! list of substance names
1665 SAVE SUBNAME
1666 CHARACTER*120 XMSG ! Exit status message
1667 DATA XMSG / ' ' /
1668
1669 INTEGER SPC ! species index
1670 INTEGER LSO2 ! SO2 pointer
1671 INTEGER LHSO3 ! HSO3 pointer
1672 INTEGER LHNO2 ! HNO3 pointer
1673 INTEGER LHNO3 ! HNO3 pointer
1674 INTEGER LCO2 ! CO2 pointer
1675 INTEGER LHCO3 ! HCO3 pointer
1676 INTEGER LH2O2 ! H2O2 pointer
1677 INTEGER LHCHO ! HCHO pointer
1678 INTEGER LHCOOH ! HCOOH pointer
1679 INTEGER LHO2 ! HO2 pointer
1680 INTEGER LNH4OH ! NH4OH pointer
1681 INTEGER LH2O ! H2O pointer
1682
1683 REAL HPLUSI ! 1 / HPLUS
1684 REAL HPLUS2I ! 1 / HPLUS**2
1685 REAL TFAC ! (298-T)/(T*298)
1686 REAL AKEQ1 ! temp var for dissociation constant
1687 REAL AKEQ2 ! temp var for dissociation constant
1688 REAL OHION ! OH ion concentration
1689 REAL KH ! temp var for henry's law constant
1690 REAL A( MXSPCS ) ! Henry's law constants at 298.15K (M/atm) (taken from Rolf Sanders'
1691 SAVE A ! Compilation of Henry's Law Constants for Inorganic and Organic Species
1692 ! of Potential Importance in Environment Chemistry 1999)
1693 REAL E( MXSPCS ) ! enthalpy (like activation energy) (K) (taken from Rolf Sanders'
1694 SAVE E ! Compilation of Henry's Law Constants for Inorganic and Organic Species
1695 ! of Potential Importance in Environment Chemistry 1999)
1696 REAL B( MXDSPCS ) ! dissociation constant at 298.15K (M or M2) (taken from Table 6.A.1,
1697 SAVE B ! Seinfeld and Pandis, Atmospheric Chemistry and Physics, 1997)
1698 REAL D( MXDSPCS ) ! -dH/R (K) (taken from Table 6.A.1,
1699 SAVE D ! Seinfeld and Pandis, Atmospheric Chemistry and Physics, 1997)
1700
1701 DATA SUBNAME( 1), A( 1), E( 1) / 'O3 ', 1.2E-02, 2.7E+03 / ! Chameides 1984
1702 DATA SUBNAME( 2), A( 2), E( 2) / 'HO2 ', 4.0E+03, 5.9E+03 / ! Hanson et al. 1992
1703 DATA SUBNAME( 3), A( 3), E( 3) / 'H2O2 ', 8.3E+04, 7.4E+03 / ! OSullivan et al. 1996
1704 DATA SUBNAME( 4), A( 4), E( 4) / 'NH3 ', 6.1E+01, 4.2E+03 / ! Clegg and Brimblecombe 1989
1705 DATA SUBNAME( 5), A( 5), E( 5) / 'NO ', 1.9E-03, 1.4E+03 / ! Lide and Frederikse 1995
1706 DATA SUBNAME( 6), A( 6), E( 6) / 'NO2 ', 1.2E-02, 2.5E+03 / ! Chameides 1984
1707 DATA SUBNAME( 7), A( 7), E( 7) / 'NO3 ', 2.0E+00, 2.0E+03 / ! Thomas et al. 1993
1708 DATA SUBNAME( 8), A( 8), E( 8) / 'N2O5 ', 1.0E+30, 0.0E+00 / ! "inf" Sander and Crutzen 1996
1709 DATA SUBNAME( 9), A( 9), E( 9) / 'HNO2 ', 5.0E+01, 4.9E+03 / ! Becker et al. 1996
1710 DATA SUBNAME( 10), A( 10), E( 10) / 'HNO3 ', 2.1E+05, 8.7E+03 / ! Leieveld and Crutzen 1991
1711 DATA SUBNAME( 11), A( 11), E( 11) / 'HNO4 ', 1.2E+04, 6.9E+03 / ! Regimbal and Mozurkewich 1997
1712 DATA SUBNAME( 12), A( 12), E( 12) / 'SO2 ', 1.4E+00, 2.9E+03 / ! Linde and Frederikse 1995
1713 DATA SUBNAME( 13), A( 13), E( 13) / 'H2SO4 ', 1.0E+30, 0.0E+00 / ! infinity
1714 DATA SUBNAME( 14), A( 14), E( 14) / 'METHANE ', 1.4E-03, 1.6E+03 / ! Linde and Frederikse 1995
1715 DATA SUBNAME( 15), A( 15), E( 15) / 'ETHANE ', 1.9E-03, 2.3E+03 / ! Linde and Frederikse 1995
1716 DATA SUBNAME( 16), A( 16), E( 16) / 'PROPANE ', 1.5E-03, 2.7E+03 / ! Linde and Frederikse 1995
1717 DATA SUBNAME( 17), A( 17), E( 17) / 'BUTANE ', 1.1E-03, 0.0E+00 / ! Mackay and Shiu 1981
1718 DATA SUBNAME( 18), A( 18), E( 18) / 'PENTANE ', 8.1E-04, 0.0E+00 / ! Mackay and Shiu 1981
1719 DATA SUBNAME( 19), A( 19), E( 19) / 'HEXANE ', 6.0E-04, 0.0E+00 / ! Mackay and Shiu 1981
1720 DATA SUBNAME( 20), A( 20), E( 20) / 'OCTANE ', 3.4E-04, 0.0E+00 / ! Mackay and Shiu 1981
1721 DATA SUBNAME( 21), A( 21), E( 21) / 'NONANE ', 2.0E-04, 0.0E+00 / ! Mackay and Shiu 1981
1722 DATA SUBNAME( 22), A( 22), E( 22) / 'DECANE ', 1.4E-04, 0.0E+00 / ! Mackay and Shiu 1981
1723 DATA SUBNAME( 23), A( 23), E( 23) / 'ETHENE ', 4.7E-03, 0.0E+00 / ! Mackay and Shiu 1981
1724 DATA SUBNAME( 24), A( 24), E( 24) / 'PROPENE ', 4.8E-03, 0.0E+00 / ! Mackay and Shiu 1981
1725 DATA SUBNAME( 25), A( 25), E( 25) / 'ISOPRENE ', 2.8E-02, 0.0E+00 / ! Karl and Lindinger 1997
1726 DATA SUBNAME( 26), A( 26), E( 26) / 'ACETYLENE ', 4.1E-02, 1.8E+03 / ! Wilhelm et al. 1977
1727 DATA SUBNAME( 27), A( 27), E( 27) / 'BENZENE ', 1.6E-01, 4.1E+03 / ! Staudinger and Roberts 1996
1728 DATA SUBNAME( 28), A( 28), E( 28) / 'TOLUENE ', 1.5E-01, 4.0E+03 / ! Staudinger and Roberts 1996
1729 DATA SUBNAME( 29), A( 29), E( 29) / 'O-XYLENE ', 1.9E-01, 4.0E+03 / ! Staudinger and Roberts 1996
1730 DATA SUBNAME( 30), A( 30), E( 30) / 'METHANOL ', 2.2E+02, 0.0E+00 / ! Snider and Dawson 1985
1731 DATA SUBNAME( 31), A( 31), E( 31) / 'ETHANOL ', 1.9E+02, 6.6E+03 / ! Snider and Dawson 1985
1732 DATA SUBNAME( 32), A( 32), E( 32) / '2-CRESOL ', 8.2E+02, 0.0E+00 / ! Betterton 1992
1733 DATA SUBNAME( 33), A( 33), E( 33) / '4-CRESOL ', 1.3E+02, 0.0E+00 / ! Betterton 1992
1734 DATA SUBNAME( 34), A( 34), E( 34) / 'METHYLHYDROPEROX', 3.1E+02, 5.2E+03 / ! OSullivan et al. 1996
1735 DATA SUBNAME( 35), A( 35), E( 35) / 'FORMALDEHYDE ', 3.2E+03, 6.8E+03 / ! Staudinger and Roberts 1996
1736 DATA SUBNAME( 36), A( 36), E( 36) / 'ACETALDEHYDE ', 1.4E+01, 5.6E+03 / ! Staudinger and Roberts 1996
1737 DATA SUBNAME( 37), A( 37), E( 37) / 'GENERIC_ALDEHYDE', 4.2E+03, 0.0E+00 / ! Graedel and Goldberg 1983
1738 DATA SUBNAME( 38), A( 38), E( 38) / 'GLYOXAL ', 3.6E+05, 0.0E+00 / ! Zhou and Mopper 1990
1739 DATA SUBNAME( 39), A( 39), E( 39) / 'ACETONE ', 3.0E+01, 4.6E+03 / ! Staudinger and Roberts 1996
1740 DATA SUBNAME( 40), A( 40), E( 40) / 'FORMIC_ACID ', 8.9E+03, 6.1E+03 / ! Johnson et al. 1996
1741 DATA SUBNAME( 41), A( 41), E( 41) / 'ACETIC_ACID ', 4.1E+03, 6.3E+03 / ! Johnson et al. 1996
1742 DATA SUBNAME( 42), A( 42), E( 42) / 'METHYL_GLYOXAL ', 3.2E+04, 0.0E+00 / ! Zhou and Mopper 1990
1743 DATA SUBNAME( 43), A( 43), E( 43) / 'CO ', 9.9E-04, 1.3E+03 / ! Linde and Frederikse 1995
1744 DATA SUBNAME( 44), A( 44), E( 44) / 'CO2 ', 3.6E-02, 2.2E+03 / ! Zheng et al. 1997
1745 DATA SUBNAME( 45), A( 45), E( 45) / 'PAN ', 2.8E+00, 6.5E+03 / ! Kames et al. 1991
1746 DATA SUBNAME( 46), A( 46), E( 46) / 'MPAN ', 1.7E+00, 0.0E+00 / ! Kames and Schurath 1995
1747 DATA SUBNAME( 47), A( 47), E( 47) / 'OH ', 3.0E+01, 4.5E+03 / ! Hanson et al. 1992
1748 DATA SUBNAME( 48), A( 48), E( 48) / 'METHYLPEROXY_RAD', 2.0E+03, 6.6E+03 / ! Lelieveld and Crutzen 1991
1749 DATA SUBNAME( 49), A( 49), E( 49) / 'PEROXYACETIC_ACI', 8.4E+02, 5.3E+03 / ! OSullivan et al. 1996
1750 DATA SUBNAME( 50), A( 50), E( 50) / 'PROPANOIC_ACID ', 5.7E+03, 0.0E+00 / ! Kahn et al. 1995
1751 DATA SUBNAME( 51), A( 51), E( 51) / '2-NITROPHENOL ', 7.0E+01, 4.6E+03 / ! USEPA 1982
1752 DATA SUBNAME( 52), A( 52), E( 52) / 'PHENOL ', 1.9E+03, 7.3E+03 / ! USEPA 1982
1753 DATA SUBNAME( 53), A( 53), E( 53) / 'BIACETYL ', 7.4E+01, 5.7E+03 / ! Betteron 1991
1754 DATA SUBNAME( 54), A( 54), E( 54) / 'BENZALDEHYDE ', 3.9E+01, 4.8E+03 / ! Staudinger and Roberts 1996
1755 DATA SUBNAME( 55), A( 55), E( 55) / 'PINENE ', 4.9E-02, 0.0E+00 / ! Karl and Lindinger 1997
1756 DATA SUBNAME( 56), A( 56), E( 56) / 'ATRA ', 4.1E+05, 6.0E+03 / ! CIBA Corp (1989) and Scholtz (1999)
1757 DATA SUBNAME( 57), A( 57), E( 57) / 'DATRA ', 4.1E+05, 6.0E+03 / ! assumed same as Atrazine
1758 DATA SUBNAME( 58), A( 58), E( 58) / 'ADIPIC_ACID ', 2.0E+08, 0.0E+00 / ! Saxena and Hildemann (1996)
1759 DATA SUBNAME( 59), A( 59), E( 59) / 'ACROLEIN ', 8.2E+00, 0.0E+00 / ! Meylan and Howard (1991)
1760 DATA SUBNAME( 60), A( 60), E( 60) / '1,3-BUTADIENE ', 1.4E-02, 0.0E+00 / ! Mackay and Shiu (1981)
1761 DATA SUBNAME( 61), A( 61), E( 61) / 'ACRYLONITRILE ', 7.3E+00, 0.0E+00 / ! Meylan and Howard (1991)
1762 DATA SUBNAME( 62), A( 62), E( 62) / 'CARBONTETRACHLOR', 3.4E-02, 4.2E+03 / ! Staudinger and Roberts (1996)
1763 DATA SUBNAME( 63), A( 63), E( 63) / 'PROPYLENE_DICHLO', 3.4E-01, 4.3E+03 / ! Staudinger and Roberts (1996)
1764 DATA SUBNAME( 64), A( 64), E( 64) / '1,3DICHLORPROPEN', 6.5E-01, 4.2E+03 / ! Wright et al (1992b)
1765 DATA SUBNAME( 65), A( 65), E( 65) / '1,1,2,2-CL4ETHAN', 2.4E+00, 3.2E+03 / ! Staudinger and Roberts (1996)
1766 DATA SUBNAME( 66), A( 66), E( 66) / 'CHLOROFORM ', 2.5E-01, 4.5E+03 / ! Staudinger and Roberts (1996)
1767 DATA SUBNAME( 67), A( 67), E( 67) / '1,2DIBROMOETHANE', 1.5E+00, 3.9E+03 / ! Ashworth et al (1988)
1768 DATA SUBNAME( 68), A( 68), E( 68) / '1,2DICHLOROETHAN', 7.3E-01, 4.2E+03 / ! Staudinger and Roberts (1996)
1769 DATA SUBNAME( 69), A( 69), E( 69) / 'METHYLENE_CHLORI', 3.6E-01, 4.1E+03 / ! Staudinger and Roberts (1996)
1770 DATA SUBNAME( 70), A( 70), E( 70) / 'PERCHLOROETHYLEN', 5.9E-02, 4.8E+03 / ! Staudinger and Roberts (1996)
1771 DATA SUBNAME( 71), A( 71), E( 71) / 'TRICHLOROETHENE ', 1.0E-01, 4.6E+03 / ! Staudinger and Roberts (1996)
1772 DATA SUBNAME( 72), A( 72), E( 72) / 'VINYL_CHLORIDE ', 3.9E-02, 3.1E+03 / ! Staudinger and Roberts (1996)
1773 DATA SUBNAME( 73), A( 73), E( 73) / 'ETHYLENE_OXIDE ', 8.4E+00, 0.0E+00 / ! CRC
1774
1775 DATA LSO2, B( 1), D( 1) / 1, 1.30E-02, 1.96E+03 / ! SO2*H2O<=>HSO3+H : Smith and Martell (1976)
1776 DATA LHSO3, B( 2), D( 2) / 2, 6.60E-08, 1.50E+03 / ! HSO3<=>SO3+H : Smith and Martell (1976)
1777 DATA LHNO2, B( 3), D( 3) / 3, 5.10E-04, -1.26E+03 / ! HNO2(aq)<=>NO2+H : Schwartz and White (1981)
1778 DATA LHNO3, B( 4), D( 4) / 4, 1.54E+01, 8.70E+03 / ! HNO3(aq)<=>NO3+H : Schwartz (1984)
1779 DATA LCO2, B( 5), D( 5) / 5, 4.30E-07, -1.00E+03 / ! CO2*H2O<=>HCO3+H : Smith and Martell (1976)
1780 DATA LHCO3, B( 6), D( 6) / 6, 4.68E-11, -1.76E+03 / ! HCO3<=>CO3+H : Smith and Martell (1976)
1781 DATA LH2O2, B( 7), D( 7) / 7, 2.20E-12, -3.73E+03 / ! H2O2(aq)<=>HO2+H : Smith and Martell (1976)
1782 DATA LHCHO, B( 8), D( 8) / 8, 2.53E+03, 4.02E+03 / ! HCHO(aq)<=>H2C(OH)2 : Le Hanaf (1968)
1783 DATA LHCOOH, B( 9), D( 9) / 9, 1.80E-04, -2.00E+01 / ! HCOOH(aq)<=>HCOO+H : Martell and Smith (1977)
1784 DATA LHO2, B( 10), D( 10) / 10, 3.50E-05, 0.00E+00 / ! HO2(aq)<=>H+O2 : Perrin (1982)
1785 DATA LNH4OH, B( 11), D( 11) / 11, 1.70E-05, -4.50E+02 / ! NH4*OH<=>NH4+OH : Smith and Martell (1976)
1786 DATA LH2O, B( 12), D( 12) / 12, 1.00E-14, -6.71E+03 / ! H2O<=>H+OH : Smith and Martell (1976)
1787
1788 !...........EXTERNAL FUNCTIONS and their descriptions:
1789
1790 ! INTEGER INDEX1
1791 ! INTEGER TRIMLEN ! string length, excl. trailing blanks
1792
1793 ! EXTERNAL TRIMLEN
1794
1795 !-----------------------------------------------------------------------
1796 ! begin body of subroutine HLCONST
1797
1798 SPC = INDEX1( NAME, MXSPCS, SUBNAME )
1799
1800 !...error if species not found in table
1801
1802 IF ( SPC .LE. 0 ) THEN
1803 ! XMSG = NAME( 1:TRIMLEN( NAME ) ) // ' not found in Henry''s '//
1804 ! & ' Law Constant table in routine HLCONST.'
1805 !CC CALL M3EXIT ( PNAME, 0, 0, XMSG, XSTAT2 )
1806 END IF
1807
1808 !...compute the Henry's Law Constant
1809
1810 TFAC = ( 298.0 - TEMP) / ( 298.0 * TEMP )
1811 KH = A( SPC ) * EXP( E( SPC ) * TFAC )
1812 HLCONST = KH
1813
1814 !...compute the effective Henry's law constants
1815
1816 IF ( EFFECTIVE ) THEN
1817
1818 IF ( HPLUS .LE. 0.0 ) THEN
1819 ! XMSG = 'Negative or Zero [H+] concentration specified ' //
1820 ! & 'in HLCONST '
1821 !CC CALL M3EXIT ( PNAME, 0, 0, XMSG, XSTAT2 )
1822 END IF
1823
1824 HPLUSI = 1.0 / HPLUS
1825 HPLUS2I = HPLUSI * HPLUSI
1826
1827 CHECK_NAME: SELECT CASE ( NAME( 1:TRIMLEN( NAME ) ) )
1828
1829 CASE ('SO2') ! SO2H2O <=> HSO3- + H+
1830 ! & HSO3- <=> SO3= + H+
1831
1832 AKEQ1 = B( LSO2 ) * EXP( D( LSO2 ) * TFAC )
1833 AKEQ2 = B( LHSO3 ) * EXP( D( LHSO3 ) * TFAC )
1834 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I )
1835
1836 CASE ('HNO2') ! HNO2(aq) <=> NO2- + H+
1837
1838 AKEQ1 = B( LHNO2 ) * EXP( D( LHNO2 ) * TFAC )
1839 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1840
1841 CASE ('HNO3') ! HNO3(aq) <=> NO3- + H+
1842
1843 AKEQ1 = B( LHNO3 ) * EXP( D( LHNO3 ) * TFAC )
1844 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1845
1846 CASE ('CO2') ! CO2H2O <=> HCO3- + H+
1847 ! & HCO3- <=> CO3= + H+
1848
1849 AKEQ1 = B( LCO2 ) * EXP( D( LCO2 ) * TFAC )
1850 AKEQ2 = B( LHCO3 ) * EXP( D( LHCO3 ) * TFAC )
1851 HLCONST = KH &
1852 * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I )
1853
1854 CASE ('H2O2') ! H2O2(aq) <=> HO2- + H+
1855
1856 AKEQ1 = B( LH2O2 ) * EXP( D( LH2O2 ) * TFAC )
1857 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1858
1859 CASE ('FORMALDEHYDE') ! HCHO(aq) <=> H2C(OH)2(aq)
1860
1861 AKEQ1 = B( LHCHO ) * EXP( D( LHCHO ) * TFAC )
1862 HLCONST = KH * ( 1.0 + AKEQ1 )
1863
1864 CASE ('FORMIC_ACID') ! HCOOH(aq) <=> HCOO- + H+
1865
1866 AKEQ1 = B( LHCOOH ) * EXP( D( LHCOOH ) * TFAC )
1867 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1868
1869 CASE ('HO2') ! HO2(aq) <=> H+ + O2-
1870
1871 AKEQ1 = B( LHO2 ) * EXP( D( LHO2 ) * TFAC )
1872 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1873
1874 CASE ('NH3') ! NH4OH <=> NH4+ + OH-
1875
1876 AKEQ1 = B( LNH4OH ) * EXP( D( LNH4OH ) * TFAC )
1877 AKEQ2 = B( LH2O ) * EXP( D( LH2O ) * TFAC )
1878 OHION = AKEQ2 * HPLUSI
1879 HLCONST = KH * ( 1.0 + AKEQ1 / OHION )
1880
1881 END SELECT CHECK_NAME
1882
1883 END IF
1884
1885 ! RETURN
1886 END FUNCTION HLCONST
1887 !.........................................................................
1888 ! Version "@(#)$Header: /env/proj/archive/cvs/ioapi/./ioapi/src/index1.f,v 1.2 2000/11/28 21:22:49 smith_w Exp $"
1889 ! EDSS/Models-3 I/O API. Copyright (C) 1992-1999 MCNC
1890 ! Distributed under the GNU LESSER GENERAL PUBLIC LICENSE version 2.1
1891 ! See file "LGPL.txt" for conditions of use.
1892 !.........................................................................
1893
1894 INTEGER FUNCTION INDEX1 (NAME, N, NLIST)
1895
1896 !***********************************************************************
1897 ! subroutine body starts at line 46
1898 !
1899 ! FUNCTION:
1900 !
1901 ! Searches for NAME in list NLIST and returns the subscript
1902 ! (1...N) at which it is found, or returns 0 when NAME not
1903 ! found in NLIST
1904 !
1905 ! PRECONDITIONS REQUIRED: none
1906 !
1907 ! SUBROUTINES AND FUNCTIONS CALLED: none
1908 !
1909 ! REVISION HISTORY:
1910 !
1911 ! 5/88 Modified for ROMNET
1912 ! 9/94 Modified for Models-3 by CJC
1913 !
1914 !***********************************************************************
1915
1916 IMPLICIT NONE
1917
1918 !....... Arguments and their descriptions:
1919
1920 CHARACTER*(*) NAME ! Character string being searched for
1921 INTEGER N ! Length of array to be searched
1922 CHARACTER*(*) NLIST(*) ! array to be searched
1923
1924 !....... Local variable:
1925
1926 INTEGER I ! loop counter
1927
1928 !.....................................................................
1929 !....... begin body of INDEX1()
1930
1931 DO 100 I = 1, N
1932
1933 IF ( NAME .EQ. NLIST( I ) ) THEN ! Found NAME in NLIST
1934 INDEX1 = I
1935 RETURN
1936 ENDIF
1937
1938 100 CONTINUE
1939
1940 INDEX1 = 0 ! not found
1941 RETURN
1942
1943 END FUNCTION INDEX1
1944
1945 END MODULE module_ctrans_aqchem