| blob | d8698eb1bada44d2cd16aaad1b7bd344ffc24c3b |
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 !***********************************************************************
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 $
23 ! what(1) key, module and SID; SCCS file; date and time of last delta:
24 !
26 CONTAINS
27 SUBROUTINE AQCHEM ( TEMP, PRES_PA, TAUCLD, PRCRATE, &
28 WCAVG, WTAVG, AIRM, ALFA0, ALFA2, ALFA3, GAS, &
29 AEROSOL, GASWDEP, AERWDEP, HPWDEP )
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 !-----------------------------------------------------------------------
116 IMPLICIT NONE
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
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.
134 ! 3/7/96 - add universal gas constant and compute gas constant in chemical
135 ! form. TWOPI is now calculated rather than input.
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
143 ! FSB References:
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 !.......................................................................
156 ! Geometric Constants:
158 REAL*8 PI ! pi (single precision 3.141593)
159 PARAMETER ( PI = 3.14159265358979324 )
161 REAL PI180 ! pi/180 [ rad/deg ]
162 PARAMETER ( PI180 = PI / 180.0 )
164 ! Geodetic Constants:
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 )
171 REAL SIDAY ! length of a sidereal day [ sec ]
172 ! FSB: Source: CRC76 pp. 14-6
173 PARAMETER ( SIDAY = 86164.09 )
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 )
180 REAL DG2M ! latitude degrees to meters
181 PARAMETER ( DG2M = REARTH * PI180 )
183 ! Solar Constant:
184 REAL SOLCNST ! Solar constant [ W/m**2 ], p14-2 CRC76
185 PARAMETER ( SOLCNST = 1373.0 )
187 ! Fundamental Constants: ( Source: CRC76, pp. 1-1 to 1-6)
189 REAL AVO ! Avogadro's Constant [ number/mol ]
190 PARAMETER ( AVO = 6.0221367E23 )
192 REAL RGASUNIV ! universal gas constant [ J/mol-K ]
193 PARAMETER ( RGASUNIV = 8.314510 )
195 REAL STDATMPA ! standard atmosphere [ Pa ]
196 PARAMETER ( STDATMPA = 101325.0 )
198 REAL STDTEMP ! Standard Temperature [ K ]
199 PARAMETER ( STDTEMP = 273.15 )
201 REAL STFBLZ ! Stefan-Boltzmann [ W/(m**2 K**4) ]
202 PARAMETER ( STFBLZ = 5.67051E-8 )
204 ! FSB Non-MKS
206 REAL MOLVOL ! Molar volume at STP [ L/mol ] Non MKS units
207 PARAMETER ( MOLVOL = 22.41410 )
209 ! Atmospheric Constants:
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 )
216 REAL RDGAS ! dry-air gas constant [ J / kg-K ]
217 PARAMETER ( RDGAS = 1.0E3 * RGASUNIV / MWAIR ) ! 287.07548994
219 REAL MWWAT ! mean molecular weight for water vapor [ g/mol ]
220 PARAMETER ( MWWAT = 18.0153 )
222 REAL RWVAP ! gas constant for water vapor [ J/kg-K ]
223 PARAMETER ( RWVAP = 1.0E3 * RGASUNIV / MWWAT ) ! 461.52492604
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.
229 REAL CPD ! specific heat of dry air at constant pressure [ J/kg-K ]
230 PARAMETER ( CPD = 7.0 * RDGAS / 2.0 ) ! 1004.7642148
232 REAL CVD ! specific heat of dry air at constant volume [ J/kg-K ]
233 PARAMETER ( CVD = 5.0 * RDGAS / 2.0 ) ! 717.68872485
235 REAL CPWVAP ! specific heat for water vapor at constant pressure [ J/kg-K ]
236 PARAMETER ( CPWVAP = 4.0 * RWVAP ) ! 1846.0997042
238 REAL CVWVAP ! specific heat for water vapor at constant volume [ J/kg-K ]
239 PARAMETER ( CVWVAP = 3.0 * RWVAP ) ! 1384.5747781
241 REAL VP0 ! vapor press of water at 0 C [ Pa ] Source: CRC76 pp. 6-15
242 PARAMETER ( VP0 = 611.29 )
244 ! FSB The following values are taken from p. 641 of Stull (1988):
246 REAL LV0 ! latent heat of vaporization of water at 0 C [ J/kg ]
247 PARAMETER ( LV0 = 2.501E6 )
249 REAL DLVDT ! Rate of change of latent heat of vaporization with
250 ! respect to temperature [ J/kg-K ]
251 PARAMETER ( DLVDT = 2370.0 )
253 REAL LF0 ! latent heat of fusion of water at 0 C [ J/kg ]
254 PARAMETER ( LF0 = 3.34E5 )
256 !.......................................................................
257 ! INCLUDE 'PARMS3.EXT' ! I/O parameters definitions
258 ! INCLUDE 'AQ_PARAMS2.EXT' ! aqueous chemistry shared parameters
261 ! Aqeuous species pointers INCLUDE File
263 !...........PARAMETERS and their descriptions:
265 INTEGER NGAS ! number of gas phase species for AQCHEM
266 PARAMETER ( NGAS = 11 )
268 INTEGER NAER ! number of aerosol species for AQCHEM
269 PARAMETER ( NAER = 23 )
271 !...pointers for the AQCHEM array GAS
273 INTEGER LSO2 ! local pointer to SO2
274 PARAMETER ( LSO2 = 1 )
276 INTEGER LHNO3 ! local pointer to HNO3
277 PARAMETER ( LHNO3 = 2 )
279 INTEGER LN2O5 ! local pointer to N2O5
280 PARAMETER ( LN2O5 = 3 )
282 INTEGER LCO2 ! local pointer to CO2
283 PARAMETER ( LCO2 = 4 )
285 INTEGER LNH3 ! local pointer to NH3
286 PARAMETER ( LNH3 = 5 )
288 INTEGER LH2O2 ! local pointer to H2O2
289 PARAMETER ( LH2O2 = 6 )
291 INTEGER LO3 ! local pointer to O3
292 PARAMETER ( LO3 = 7 )
294 INTEGER LFOA ! local pointer to FOA
295 PARAMETER ( LFOA = 8 )
297 INTEGER LMHP ! local pointer to MHP
298 PARAMETER ( LMHP = 9 )
300 INTEGER LPAA ! local pointer to PAA
301 PARAMETER ( LPAA = 10 )
303 INTEGER LH2SO4 ! local pointer to H2SO4
304 PARAMETER ( LH2SO4 = 11 )
306 !...pointers for the AQCHEM array AEROSOL
308 INTEGER LSO4AKN ! local pointer to SO4I aerosol
309 PARAMETER ( LSO4AKN = 1 )
311 INTEGER LSO4ACC ! local pointer to SO4 aerosol
312 PARAMETER ( LSO4ACC = 2 )
314 INTEGER LNH4AKN ! local pointer to NH4I aerosol
315 PARAMETER ( LNH4AKN = 3 )
317 INTEGER LNH4ACC ! local pointer to NH4 aerosol
318 PARAMETER ( LNH4ACC = 4 )
320 INTEGER LNO3AKN ! local pointer to NO3I aerosol
321 PARAMETER ( LNO3AKN = 5 )
323 INTEGER LNO3ACC ! local pointer to NO3 aerosol
324 PARAMETER ( LNO3ACC = 6 )
326 INTEGER LNO3COR ! local pointer to course aerosol nitrate
327 PARAMETER ( LNO3COR = 7 )
329 INTEGER LORGAKN ! local pointer to organic I aerosol
330 PARAMETER ( LORGAKN = 8 )
332 INTEGER LORGACC ! local pointer to organic aerosol
333 PARAMETER ( LORGACC = 9 )
335 INTEGER LPRIAKN ! local pointer to primary I aerosol
336 PARAMETER ( LPRIAKN = 10 )
338 INTEGER LPRIACC ! local pointer to primary aerosol
339 PARAMETER ( LPRIACC = 11 )
341 INTEGER LPRICOR ! local pointer to primary I aerosol
342 PARAMETER ( LPRICOR = 12 )
344 INTEGER LCACO3 ! local pointer to CaCO3 aerosol
345 PARAMETER ( LCACO3 = 13 )
347 INTEGER LMGCO3 ! local pointer to MgCO3 aerosol
348 PARAMETER ( LMGCO3 = 14 )
350 INTEGER LNACL ! local pointer to NaCl aerosol
351 PARAMETER ( LNACL = 15 )
353 INTEGER LA3FE ! local pointer to Fe+++ aerosol
354 PARAMETER ( LA3FE = 16 )
356 INTEGER LB2MN ! local pointer to Mn++ aerosol
357 PARAMETER ( LB2MN = 17 )
359 INTEGER LKCL ! local pointer to NaCl aerosol
360 PARAMETER ( LKCL = 18 )
362 INTEGER LNUMAKN ! local pointer to # Aitken aerosol
363 PARAMETER ( LNUMAKN = 19 )
365 INTEGER LNUMACC ! local pointer to # accumulation aerosol
366 PARAMETER ( LNUMACC = 20 )
368 INTEGER LNUMCOR ! local pointer to # coarse aerosol
369 PARAMETER ( LNUMCOR = 21 )
371 INTEGER LSRFAKN ! local pointer to sfc area Aitken aerosol
372 PARAMETER ( LSRFAKN = 22 )
374 INTEGER LSRFACC ! local pntr to sfc area accumulation aerosol
375 PARAMETER ( LSRFACC = 23 )
377 !...surrogate names, their background values, and units
378 !... for AQCHEM's GAS species
380 CHARACTER*16 SGRGAS( NGAS ) ! surrogate name for gases
381 SAVE SGRGAS
383 REAL BGNDGAS( NGAS ) ! background values for each gas
384 SAVE BGNDGAS
386 CHARACTER*16 BUNTSGAS( NGAS ) ! units of bkgnd values
387 SAVE BUNTSGAS
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 /
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' /
413 !...surrogate names, their background values, units, and molecular weights
414 !... for AQCHEM's AEROSOL species
416 CHARACTER*16 SGRAER( NAER ) ! surrogate name for aerosols
417 SAVE SGRAER
419 REAL SGRAERMW( NAER ) ! molecular weight for aerosol species
420 SAVE SGRAERMW
422 CHARACTER*16 BUNTSAER( NAER ) ! units of bkgnd values
423 SAVE BUNTSAER
425 REAL BGNDAER( NAER ) ! bkground vals each aerosols
426 SAVE BGNDAER
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 /
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 / ' ' /
478 !...........PARAMETERS and their descriptions:
480 INTEGER NUMOX ! number of oxidizing reactions
481 PARAMETER ( NUMOX = 5 )
483 REAL H2ODENS ! density of water at 20 C and 1 ATM
484 PARAMETER ( H2ODENS = 1000.0 ) ! (kg/m3)
486 INTEGER NLIQS ! number of liquid phase species
487 PARAMETER ( NLIQS = 33 )
489 REAL ONETHIRD ! 1/3
490 PARAMETER ( ONETHIRD = 1.0 / 3.0 )
492 REAL TWOTHIRDS ! 2/3
493 PARAMETER ( TWOTHIRDS = 2.0 / 3.0 )
495 REAL CONCMIN ! minimum concentration
496 PARAMETER ( CONCMIN = 1.0E-30 )
498 REAL SEC2HR ! convert seconds to hours
499 PARAMETER ( SEC2HR = 1.0 / 3600.0 )
501 !...........ARGUMENTS and their descriptions
503 INTEGER JDATE ! current model date, coded YYYYDDD
504 INTEGER JTIME ! current model time, coded HHMMSS
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)
522 !...........LOCAL VARIABLES (scalars) and their descriptions:
524 CHARACTER*16 PNAME ! driver program name
525 DATA PNAME / 'AQCHEM' /
526 SAVE PNAME
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
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 !
711 !...........LOCAL VARIABLES (arrays) and their descriptions:
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)
719 REAL ONE_OVER_TEMP ! 1.0 / TEMP
721 !...........EXTERNAL FUNCTIONS and their descriptions:
723 ! REAL HLCONST
724 ! EXTERNAL HLCONST
726 !*********************************************************************
727 ! begin body of subroutine AQCHEM
729 ONE_OVER_TEMP = 1.0 / TEMP
731 !...check for bad temperature, cloud air mass, or pressure
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
744 !...compute several conversion factors
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.
767 !...set equilibrium constants as a function of temperature
768 !... Henry's law constants
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 )
781 TEMP1 = ONE_OVER_TEMP - 1.0 / 298.0
783 !...dissociation constants
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)
795 !...Kinetic oxidation rates
796 !... From Chamedies (1982)
798 RH2O2 = 8.0E+04 * EXP( -3650.0 * TEMP1 )
800 !...From Kok
802 RMHP = 1.75E+07 * EXP( -3801.0 * TEMP1 )
803 RPAA = 3.64E+07 * EXP( -3994.0 * TEMP1 )
805 !...make initializations
807 DO LIQ = 1, NLIQS
808 WETDEP( LIQ ) = 0.0
809 END DO
811 DO IOX = 0, NUMOX
812 DSIVDT( IOX ) = 0.0
813 DTW ( IOX ) = 0.0
814 DS4 ( IOX ) = 0.0
815 END DO
817 !...compute the initial accumulation aerosol 3rd moment
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
826 !...compute fractional weights for several species
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
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
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
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
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
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
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
885 !...set constant factors that will be used in later multiplications (moles/atm)
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
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
907 !...If kinetic calculations are made, return to this point
909 I20C = 0
910 20 CONTINUE
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
918 !...set aitken-mode aerosol loading (mol/liter)
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 ) )
931 !...Initial gas phase partial pressures (atm)
932 !... = initial partial pressure - amount deposited partial pressure
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
953 !...don't allow gas concentrations to go below zero
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 )
965 !...Molar concentrations of soluble aerosols
966 !... = Initial amount - amount deposited (mol/liter)
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
984 !...don't allow aerosol concentrations to go below zero
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 )
1000 SK6TS6 = SK6 * TS6
1002 !...find solution of the equation using a method of reiterative
1003 !... bisections Make initial guesses for pH: between .01 to 10.
1005 HA = 0.01
1006 HB = 10.0
1008 I7777C = 0
1009 7777 CONTINUE
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
1017 HA = MAX( HA - 0.8, 0.1 )
1018 HB = MIN( HB + 0.8, 9.9 )
1019 AE = 10.0**( -HA )
1021 RECIPA1 = 1.0 / ( AE * ACT1 )
1022 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1024 !...calculate final gas phase partial pressure of SO2, NH3, HNO3
1025 !... HCOOH, and CO2 (atm)
1027 PSO2F = PSO20 / ( 1.0 + XLSO2 * ( 1.0 + SO21 * RECIPA1 &
1028 + SO212 * RECIPA2 ) )
1030 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1032 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1034 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1036 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1037 + CO212 * RECIPA2 ) )
1039 !...calculate liquid phase concentrations (moles/liter)
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
1052 !...compute functional value
1054 FA = AE + NH4 + 2.0 * (CA + MG - CO3 - SO3 - SO4 ) - OH - HCO3 &
1055 - HSO3 - NO3 - HSO4 - HCO2
1057 !...Start iteration and bisection ****************<<<<<<<
1059 I30C = 0
1060 30 CONTINUE
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
1068 BB = ( HA + HB ) / 2.0
1069 AE = 10.0**( -BB )
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
1077 RECIPA1 = 1.0 / ( AE * ACT1 )
1078 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1080 !...calculate final gas phase partial pressure of SO2, NH3, HNO3
1081 !... HCOOH, and CO2 (atm)
1083 PSO2F = PSO20 / ( 1.0 + XLSO2 &
1084 * ( 1.0 + SO21 * RECIPA1 + SO212 * RECIPA2 ) )
1086 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1088 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1090 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1092 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1093 + CO212 * RECIPA2 ) )
1095 !...calculate liquid phase concentrations (moles/liter)
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
1108 !...compute functional value
1110 FB = AE + NH4 + 2.0 * ( CA + MG - CO3 - SO3 - SO4 ) - OH - HCO3 &
1111 - HSO3 - NO3 - HSO4 - HCO2
1113 !...Calculate and check the sign of the product of the two functional values
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
1123 !...Check convergence of solutions
1125 HTST = HA / HB
1126 IF ( HTST .LE. TST ) GO TO 30
1128 !...end of zero-finding routine ****************<<<<<<<<<<<<
1130 !...compute Ionic strength and activity coefficient by the Davies equation
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 )
1144 !...check for convergence and possibly go to 7777, to recompute
1145 !... Gas and liquid phase concentrations
1147 TAC = ABS( ACTB - ACT1 ) / ACTB
1148 IF ( TAC .GE. 1.0E-2 ) GO TO 7777
1150 !...return an error if the pH is not in range
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
1159 !...Make those concentration calculations which can be made outside
1160 !... of the function.
1162 SO2L = SO2H * PSO2F
1163 AC = 10.0**( -BB )
1164 SIV = SO3 + HSO3 + SO2L
1166 !...Calculate final gas phase concentrations of oxidants (atm)
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 )
1173 PH2O2F = MAX( PH2O2F, 0.0 )
1174 PO3F = MAX( PO3F, 0.0 )
1175 PMHPF = MAX( PMHPF, 0.0 )
1176 PPAAF = MAX( PPAAF, 0.0 )
1178 !...Calculate liquid phase concentrations of oxidants (moles/liter)
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
1189 !...load the liquid concentration array with current values
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
1225 !...if the maximum cloud lifetime has not been reached, the compute
1226 !... the next timestep.
1228 IF ( TIMEW .LT. TAUCLD ) THEN
1230 !...make kinetics calculations
1231 !... note: DS4(i) and DSIV(I) are negative numbers!
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
1239 !...Define the total S(iv) available for oxidation
1241 TSIV = PSO20 * ONE_OVER_XL
1243 !...Calculate sulfur iv oxidation rate due to H2O2
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
1255 !...Calculate sulfur iv oxidation rate due to O3
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
1271 !...Calculate sulfur iv oxidation rate due to 02 catalyzed by Mn++
1272 !... and Fe+++ See Table IV Walcek & Taylor ( 1986)
1274 IF ( BB .GE. 4.0 ) THEN ! 4.0 < pH
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.
1283 ELSE ! pH , + 4.0
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.
1294 END IF ! end of pass through pH
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
1302 !...Calculate sulfur oxidation rate due to MHP
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
1314 !...Calculate sulfur oxidation due to PAA
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
1326 !...Calculate total sulfur iv oxidation rate
1328 DSIVDT( 0 ) = 0.0
1329 DO IOX = 1, NUMOX
1330 DSIVDT( 0 ) = DSIVDT( 0 ) + DSIVDT( IOX )
1331 END DO
1333 !...Calculate a minimum time step required
1335 DTW( 0 ) = MIN( DTW( 1 ), DTW( 2 ), DTW( 3 ), &
1336 DTW( 4 ), DTW( 5 ) )
1338 !...check for large time step
1340 IF ( DTW( 0 ) .GT. 8.0E+37 ) THEN
1341 WRITE(6,1001) PRCRATE, DSIVDT(0), TS6, DTW(0), CTHK1, WTAVG
1342 ELSE
1344 !...calculate the change in sulfur iv for this time step
1346 60 DTS6 = ABS( DTW( 0 ) * ( -DSIVDT( 0 ) - TS6 * PRCRATE &
1347 / ( 3600.0 * CTHK1 * WTAVG ) ) )
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
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 )
1361 !...Limit the timestep to prevent negative SO2 concentrations and mass creation
1362 !... for sulfate (suggested by Bonyoung Koo, ENVIRON Corp)
1364 IF ( DSIVDT( 0 ) .LT. 0.0 ) THEN
1365 DTW( 0 ) = MIN( REAL(DTW( 0 )), -TSIV * 1.00001 / DSIVDT( 0 ) )
1366 ENDIF
1368 !...alternative bug fix (BUT EXPENSIVE)
1370 ! if ( ( -DSIVDT( 0 ) * DTW( 0 ) ) .gt. TSIV ) then
1371 ! dtw( 0 ) = -TSIV * 1.00001 / DSIVDT( 0 )
1372 ! end if
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
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
1381 ! print *, iterat, dtw(0)
1383 !...Set DSIV(I), I = 0,NUMOX, the amount of S(IV) oxidized by each
1384 !... individual oxidizing agent, as well as the total.
1386 DO IOX = 0, NUMOX
1387 DS4( IOX ) = DS4( IOX ) + DTW( 0 ) * DSIVDT( IOX )
1388 END DO
1390 !...Compute depositions and concentrations for each species
1392 WETFAC = PRCRATE * FRACLIQ * DTW( 0 ) * SEC2HR
1393 DO LIQ = 1, NLIQS
1394 WETDEP( LIQ ) = WETDEP( LIQ ) + LIQUID( LIQ ) * WETFAC
1395 END DO
1397 TIMEW = TIMEW + DTW( 0 )
1399 !...Return to make additional calculations
1401 GO TO 20
1402 END IF
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
1408 DEPSUM = ( WETDEP( 6 ) + WETDEP( 7 ) ) * XC1
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
1416 EBETASO4T = EXP( -BETASO4 * TAUCLD )
1417 EALFA0T = EXP( -ALFA0 * TAUCLD )
1418 EALFA2T = EXP( -ALFA2 * TAUCLD )
1419 EALFA3T = EXP( -ALFA3 * TAUCLD )
1421 !...Compute the output concentrations and wetdeposition amounts
1423 TOTAMM = ( PNH3F + ( NH4 + NH3L ) * XL ) * RECIPAP1
1424 TOTNIT = ( PHNO3F + ( NO3 + HNO3L ) * XL ) * RECIPAP1
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
1440 !...gas concentrations (mol/molV)
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
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
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
1487 !...aerosol concentrations (mol/molV)
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
1511 !...compute the final accumulation aerosol 3rd moment
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
1520 AEROSOL( LSRFAKN ) = AEROSOL( LSRFAKN ) * EALFA2T
1521 AEROSOL( LSRFACC ) = AEROSOL( LSRFACC ) &
1522 * ( EXP( -BETASO4 * TAUCLD * ONETHIRD ) ) &
1523 * ( M3NEW / MAX( M3OLD, CONCMIN) ) ** TWOTHIRDS
1525 !...store the amount of hydrogen deposition
1527 HPWDEP = WETDEP( 1 )
1529 RETURN
1531 !...formats
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)
1537 END SUBROUTINE AQCHEM
1538 !.........................................................................
1540 INTEGER FUNCTION TRIMLEN ( STRING )
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 !***********************************************************************
1558 IMPLICIT NONE
1561 !........... ARGUMENTS and their descriptions:
1563 CHARACTER*(*) STRING
1566 !........... SCRATCH LOCAL VARIABLES and their descriptions:
1568 INTEGER L, K
1571 !***********************************************************************
1572 ! begin body of function TRIMLEN
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
1581 K = 1
1583 12 CONTINUE
1585 TRIMLEN = K
1587 ! RETURN
1589 END FUNCTION TRIMLEN
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 !***********************************************************************
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 $
1613 ! what(1) key, module and SID; SCCS file; date and time of last delta:
1614 ! %W% %P% %G% %U%
1616 REAL FUNCTION HLCONST ( NAME, TEMP, EFFECTIVE, HPLUS )
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 !-----------------------------------------------------------------------
1637 IMPLICIT NONE
1639 !...........INCLUDES and their descriptions
1641 ! INCLUDE 'IODECL3.EXT' ! I/O definitions and declarations
1642 ! INCLUDE 'PARMS3.EXT' ! I/O parameters definitions
1644 !...........PARAMETERS and their descriptions:
1646 INTEGER MXSPCS ! Number of substances
1647 PARAMETER ( MXSPCS = 73 )
1649 INTEGER MXDSPCS ! Number of dissociating species
1650 PARAMETER ( MXDSPCS = 12 )
1652 !...........ARGUMENTS and their descriptions
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)
1659 !...........SCRATCH LOCAL VARIABLES and their descriptions:
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 / ' ' /
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
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)
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
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)
1788 !...........EXTERNAL FUNCTIONS and their descriptions:
1790 ! INTEGER INDEX1
1791 ! INTEGER TRIMLEN ! string length, excl. trailing blanks
1793 ! EXTERNAL TRIMLEN
1795 !-----------------------------------------------------------------------
1796 ! begin body of subroutine HLCONST
1798 SPC = INDEX1( NAME, MXSPCS, SUBNAME )
1800 !...error if species not found in table
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
1808 !...compute the Henry's Law Constant
1810 TFAC = ( 298.0 - TEMP) / ( 298.0 * TEMP )
1811 KH = A( SPC ) * EXP( E( SPC ) * TFAC )
1812 HLCONST = KH
1814 !...compute the effective Henry's law constants
1816 IF ( EFFECTIVE ) THEN
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
1824 HPLUSI = 1.0 / HPLUS
1825 HPLUS2I = HPLUSI * HPLUSI
1827 CHECK_NAME: SELECT CASE ( NAME( 1:TRIMLEN( NAME ) ) )
1829 CASE ('SO2') ! SO2H2O <=> HSO3- + H+
1830 ! & HSO3- <=> SO3= + H+
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 )
1836 CASE ('HNO2') ! HNO2(aq) <=> NO2- + H+
1838 AKEQ1 = B( LHNO2 ) * EXP( D( LHNO2 ) * TFAC )
1839 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1841 CASE ('HNO3') ! HNO3(aq) <=> NO3- + H+
1843 AKEQ1 = B( LHNO3 ) * EXP( D( LHNO3 ) * TFAC )
1844 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1846 CASE ('CO2') ! CO2H2O <=> HCO3- + H+
1847 ! & HCO3- <=> CO3= + H+
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 )
1854 CASE ('H2O2') ! H2O2(aq) <=> HO2- + H+
1856 AKEQ1 = B( LH2O2 ) * EXP( D( LH2O2 ) * TFAC )
1857 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1859 CASE ('FORMALDEHYDE') ! HCHO(aq) <=> H2C(OH)2(aq)
1861 AKEQ1 = B( LHCHO ) * EXP( D( LHCHO ) * TFAC )
1862 HLCONST = KH * ( 1.0 + AKEQ1 )
1864 CASE ('FORMIC_ACID') ! HCOOH(aq) <=> HCOO- + H+
1866 AKEQ1 = B( LHCOOH ) * EXP( D( LHCOOH ) * TFAC )
1867 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1869 CASE ('HO2') ! HO2(aq) <=> H+ + O2-
1871 AKEQ1 = B( LHO2 ) * EXP( D( LHO2 ) * TFAC )
1872 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
1874 CASE ('NH3') ! NH4OH <=> NH4+ + OH-
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 )
1881 END SELECT CHECK_NAME
1883 END IF
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 !.........................................................................
1894 INTEGER FUNCTION INDEX1 (NAME, N, NLIST)
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 !***********************************************************************
1916 IMPLICIT NONE
1918 !....... Arguments and their descriptions:
1920 CHARACTER*(*) NAME ! Character string being searched for
1921 INTEGER N ! Length of array to be searched
1922 CHARACTER*(*) NLIST(*) ! array to be searched
1924 !....... Local variable:
1926 INTEGER I ! loop counter
1928 !.....................................................................
1929 !....... begin body of INDEX1()
1931 DO 100 I = 1, N
1933 IF ( NAME .EQ. NLIST( I ) ) THEN ! Found NAME in NLIST
1934 INDEX1 = I
1935 RETURN
1936 ENDIF
1938 100 CONTINUE
1940 INDEX1 = 0 ! not found
1941 RETURN
1943 END FUNCTION INDEX1
1945 END MODULE module_ctrans_aqchem