| blob | a23261f69ce812084f996b2beebea61fa9bd9320 |
1 MODULE module_ctrans_aqchem
2 #if ( WRF_CHEM == 1 )
3 CONTAINS
5 !***********************************************************************
6 ! Portions of Models-3/CMAQ software were developed or based on *
7 ! information from various groups: Federal Government employees, *
8 ! contractors working on a United States Government contract, and *
9 ! non-Federal sources (including research institutions). These *
10 ! research institutions have given the Government permission to *
11 ! use, prepare derivative works, and distribute copies of their *
12 ! work in Models-3/CMAQ to the public and to permit others to do *
13 ! so. EPA therefore grants similar permissions for use of the *
14 ! Models-3/CMAQ software, but users are requested to provide copies *
15 ! of derivative works to the Government without restrictions as to *
16 ! use by others. Users are responsible for acquiring their own *
17 ! copies of commercial software associated with Models-3/CMAQ and *
18 ! for complying with vendor requirements. Software copyrights by *
19 ! the MCNC Environmental Modeling Center are used with their *
20 ! permissions subject to the above restrictions. *
21 !***********************************************************************
23 ! RCS file, release, date & time of last delta, author, state, [and locker]
24 ! $Header: /project/work/rep/CCTM/src/cloud/cloud_acm/aqchem.F,v 1.32 2008/09/10 19:40:39 sjr Exp $
26 ! what(1) key, module and SID; SCCS file; date and time of last delta:
28 SUBROUTINE AQCHEM ( TEMP, PRES_PA, TAUCLD, PRCRATE, &
29 WCAVG, WTAVG, AIRM, ALFA0, ALFA2, ALFA3, GAS, &
30 AEROSOL, LIQUID, GASWDEP, AERWDEP, HPWDEP )
32 !-----------------------------------------------------------------------
33 !
34 ! DESCRIPTION:
35 ! Compute concentration changes in cloud due to aqueous chemistry,
36 ! scavenging and wet deposition amounts.
37 !
38 ! Revision History:
39 ! No Date Who What
40 ! -- -------- --- -----------------------------------------
41 ! 0 / /86 CW BEGIN PROGRAM - Walceks's Original Code
42 ! 1 / /86 RB INCORPORATE INTO RADM
43 ! 2 03/23/87 DH REFORMAT
44 ! 3 04/11/88 SJR STREAMLINED CODE - ADDED COMMENTS
45 ! 4 08/27/88 SJR COMMENTS, MODIFIED FOR RPM
46 ! 4a 03/15/96 FSB Scanned hard copy to develop Models3
47 ! Version.
48 ! 5 04/24/96 FSB Made into Models3 Format
49 ! 6 02/18/97 SJR Revisions to link with Models3
50 ! 7 08/12/97 SJR Revised for new concentration units (moles/mole)
51 ! and new treatment of nitrate and nitric acid
52 ! 8 01/15/98 sjr revised to add new aitken mode scavenging
53 ! and aerosol number scavenging
54 ! 9 12/15/98 David Wong at LM:
55 ! -- change division of XL, TEMP to multiplication of XL, TEMP
56 ! reciprocal, respectively
57 ! -- change / TOTOX / TSIV to / ( TOTOX * TSIV )
58 ! 10 03/18/99 David Wong at LM:
59 ! -- removed "* 1.0" redundant calculation at TEMP1 calculation
60 ! 11 04/27/00 sjr Added aerosol surface area as modeled species
61 ! 12 12/02 sjr changed calls to HLCONST and updated the dissociation
62 ! constants
63 ! 13 06/26/03 sjr revised calculations of DTW based on CMAS website
64 ! discussions
65 ! 14 08/05/03 sjr revision made to the coarse aerosol number washout
66 ! 15 04/20/05 us revisions to add sea salt species in the fine and
67 ! coarse aerosol modes, and HCl dissolution/dissociation
68 ! 16 10/13/05 sjr fixed bug in the integration time step calculation
69 ! (reported by Bonyoung Koo)
70 ! 17 03/01/06 sjr added elemental carbon aerosol; organic aerosols
71 ! replaced with primary, secondary biogenic, and
72 ! secondary anthropogenic; fixed 3rd moment calc to
73 ! include EC and primary organics (not secondary);
74 ! re-arranged logic for setting Cl & Na ending conc;
75 ! added pointers/indirect addressing for arrays WETDEP
76 ! and LIQUID
77 ! 16 03/30/07 sjr Limit integration timestep by cloud washout time
78 ! 17 04/10/07 sjr increased loop limits as follows: I20C <10000,
79 ! I7777C <10000, I30C <10000, ICNTAQ <60000
80 !
81 !
82 ! Reference:
83 ! Walcek & Taylor, 1986, A theoretical Method for computing
84 ! vertical distributions of acidity and sulfate within cumulus
85 ! clouds, J. Atmos Sci., Vol. 43, no. 4 pp 339 - 355
86 !
87 ! Called by: AQMAP
88 !
89 ! Calls the following subroutines: none
90 !
91 ! Calls the following functions: HLCONST
92 !
93 ! ARGUMENTS TYPE I/O DESCRIPTION
94 ! --------- ---- ------------ --------------------------------
95 ! GAS(ngas) real input&output Concentration for species i=1,12
96 ! GASWDEP(ngas) real output wet deposition for species
97 ! (01)= SO2 conc (mol/mol)
98 ! (02)= HNO3 conc (mol/mol)
99 ! (03)= N2O5 conc (mol/mol)
100 ! (04)= CO2 conc (mol/mol)
101 ! (05)= NH3 conc (mol/mol)
102 ! (06)= H2O2 conc (mol/mol)
103 ! (07)= O3 conc (mol/mol)
104 ! (08)= FOA conc (mol/mol)
105 ! (09)= MHP conc (mol/mol)
106 ! (10)= PAA conc (mol/mol)
107 ! (11)= H2SO4 conc (mol/mol)
108 ! (12)= HCL conc (mol/mol)
109 !
110 ! AEROSOL(naer) real input&output Concentration for species i=1,36
111 ! AERWDEP(naer) real output wet deposition for species
112 ! (01)= SO4AKN conc (mol/mol)
113 ! (02)= SO4ACC conc (mol/mol)
114 ! (03)= SO4COR conc (mol/mol)
115 ! (04)= NH4AKN conc (mol/mol)
116 ! (05)= NH4ACC conc (mol/mol)
117 ! (06)= NO3AKN conc (mol/mol)
118 ! (07)= NO3ACC conc (mol/mol)
119 ! (08)= NO3COR conc (mol/mol)
120 ! (09)= ORGAAKN conc (mol/mol)
121 ! (10)= ORGAACC conc (mol/mol)
122 ! (11)= ORGPAKN conc (mol/mol)
123 ! (12)= ORGPACC conc (mol/mol)
124 ! (13)= ORGBAKN conc (mol/mol)
125 ! (14)= ORGBACC conc (mol/mol)
126 ! (15)= ECAKN conc (mol/mol)
127 ! (16)= ECACC conc (mol/mol)
128 ! (17)= PRIAKN conc (mol/mol)
129 ! (18)= PRIACC conc (mol/mol)
130 ! (19)= PRICOR conc (mol/mol)
131 ! (20)= NAAKN conc (mol/mol)
132 ! (21)= NAACC conc (mol/mol)
133 ! (22)= NACOR conc (mol/mol)
134 ! (23)= CLAKN conc (mol/mol)
135 ! (24)= CLACC conc (mol/mol)
136 ! (25)= CLCOR conc (mol/mol)
137 ! (26)= NUMAKN conc ( #/mol )
138 ! (27)= NUMACC conc ( #/mol )
139 ! (28)= NUMCOR conc ( #/mol )
140 ! (29)= SRFAKN conc (m2/mol )
141 ! (30)= SRFACC conc (m2/mol )
142 ! (31)= NACL conc (mol/mol)
143 ! (32)= CACO3 conc (mol/mol)
144 ! (33)= MGCO3 conc (mol/mol)
145 ! (34)= A3FE conc (mol/mol)
146 ! (35)= B2MN conc (mol/mol)
147 ! (36)= K conc (mol/mol)
149 !-----------------------------------------------------------------------
151 IMPLICIT NONE
153 ! INCLUDE SUBST_IOPARMS ! I/O parameters definitions
154 ! INCLUDE SUBST_RXCMMN ! Mechanism reaction common block
156 !.......................................................................
157 ! INCLUDE FILE CONST.EXT
158 ! Contains: Fundamental constants for air quality modeling
159 ! Dependent Upon: none
160 ! Revision History:
161 ! Adapted 6/92 by CJC from ROM's PI.EXT.
162 ! 3/1/93 John McHenry - include constants needed by LCM aqueous chemistry
163 ! 9/93 by John McHenry - include additional constants needed for FMEM clouds
164 ! and aqueous chemistry
165 ! 3/4/96 Dr. Francis S. Binkowski - reflect current Models3 view that MKS
166 ! units should be used wherever possible and that sources be documented.
167 ! Some variables have been added, names changed, and values revised.
168 ! 3/7/96 - add universal gas constant and compute gas constant in chemical
169 ! form. TWOPI is now calculated rather than input.
170 ! 3/13/96 - group declarations and parameter statements
171 ! 9/13/96 - include more physical constants
172 ! 12/24/96 - eliminate silly EPSILON, AMISS
173 ! 1/06/97 - eliminate most derived constants - YOJ
174 ! 1/17/97 (comments only) to provide numerical values as reference - DWB
175 ! 4/30/08 - Changed REARTH to match default value in MM5 and WRF - TLO
176 ! FSB References:
177 ! CRC76, "CRC Handbook of Chemistry and Physics (76th Ed)",
178 ! CRC Press, 1995
179 ! Hobbs, P.V. "Basic Physical Chemistry for the Atmospheric Sciences",
180 ! Cambridge Univ. Press, 206 pp, 1995.
181 ! Snyder, J.P., "Map Projections-A Working Manual, U.S. Geological Survey
182 ! Paper 1395 U.S.GPO, Washington, DC, 1987.
183 ! Stull, R. B., "An Introduction to Bounday Layer Meteorology", Kluwer,
184 ! Dordrecht, 1988
185 !.......................................................................
188 ! Geometric Constants:
190 REAL PI ! pi (single precision 3.141593)
191 PARAMETER ( PI = 3.14159265358979324 )
193 REAL PI180 ! pi/180 [ rad/deg ]
194 PARAMETER ( PI180 = PI / 180.0 )
196 ! Geodetic Constants:
198 REAL REARTH ! radius of the earth [ m ]
199 ! FSB: radius of sphere having same surface area as
200 ! Clarke ellipsoid of 1866 ( Source: Snyder, 1987)
201 ! PARAMETER ( REARTH = 6370997.0 )
202 PARAMETER ( REARTH = 6370000.0 ) ! default Re in MM5 and WRF
204 REAL SIDAY ! length of a sidereal day [ sec ]
205 ! FSB: Source: CRC76 pp. 14-6
206 PARAMETER ( SIDAY = 86164.09 )
208 REAL GRAV ! mean gravitational acceleration [ m/sec**2 ]
209 ! FSB: Value is mean of polar and equatorial values.
210 ! Source: CRC Handbook (76th Ed) pp. 14-6
211 PARAMETER ( GRAV = 9.80622 )
213 REAL DG2M ! latitude degrees to meters
214 PARAMETER ( DG2M = REARTH * PI180 )
216 ! Solar Constant:
217 REAL SOLCNST ! Solar constant [ W/m**2 ], p14-2 CRC76
218 PARAMETER ( SOLCNST = 1373.0 )
220 ! Fundamental Constants: ( Source: CRC76, pp. 1-1 to 1-6)
222 REAL AVO ! Avogadro's Constant [ number/mol ]
223 PARAMETER ( AVO = 6.0221367E23 )
225 REAL RGASUNIV ! universal gas constant [ J/mol-K ]
226 PARAMETER ( RGASUNIV = 8.314510 )
228 REAL STDATMPA ! standard atmosphere [ Pa ]
229 PARAMETER ( STDATMPA = 101325.0 )
231 REAL STDTEMP ! Standard Temperature [ K ]
232 PARAMETER ( STDTEMP = 273.15 )
234 REAL STFBLZ ! Stefan-Boltzmann [ W/(m**2 K**4) ]
235 PARAMETER ( STFBLZ = 5.67051E-8 )
237 ! FSB Non-MKS
239 REAL MOLVOL ! Molar volume at STP [ L/mol ] Non MKS units
240 PARAMETER ( MOLVOL = 22.41410 )
242 ! Atmospheric Constants:
244 REAL MWAIR ! mean molecular weight for dry air [ g/mol ]
245 ! FSB: 78.06% N2, 21% O2, and 0.943% A on a mole
246 ! fraction basis ( Source : Hobbs, 1995) pp. 69-70
247 PARAMETER ( MWAIR = 28.9628 )
249 REAL RDGAS ! dry-air gas constant [ J / kg-K ]
250 PARAMETER ( RDGAS = 1.0E3 * RGASUNIV / MWAIR ) ! 287.07548994
252 REAL MWWAT ! mean molecular weight for water vapor [ g/mol ]
253 PARAMETER ( MWWAT = 18.0153 )
255 REAL RWVAP ! gas constant for water vapor [ J/kg-K ]
256 PARAMETER ( RWVAP = 1.0E3 * RGASUNIV / MWWAT ) ! 461.52492604
258 ! FSB NOTE: CPD, CVD, CPWVAP and CVWVAP are calculated assuming dry air and
259 ! water vapor are classical ideal gases, i.e. vibration does not contribute
260 ! to internal energy.
262 REAL CPD ! specific heat of dry air at constant pressure [ J/kg-K ]
263 PARAMETER ( CPD = 7.0 * RDGAS / 2.0 ) ! 1004.7642148
265 REAL CVD ! specific heat of dry air at constant volume [ J/kg-K ]
266 PARAMETER ( CVD = 5.0 * RDGAS / 2.0 ) ! 717.68872485
268 REAL CPWVAP ! specific heat for water vapor at constant pressure [ J/kg-K ]
269 PARAMETER ( CPWVAP = 4.0 * RWVAP ) ! 1846.0997042
271 REAL CVWVAP ! specific heat for water vapor at constant volume [ J/kg-K ]
272 PARAMETER ( CVWVAP = 3.0 * RWVAP ) ! 1384.5747781
274 REAL VP0 ! vapor press of water at 0 C [ Pa ] Source: CRC76 pp. 6-15
275 PARAMETER ( VP0 = 611.29 )
277 ! FSB The following values are taken from p. 641 of Stull (1988):
279 REAL LV0 ! latent heat of vaporization of water at 0 C [ J/kg ]
280 PARAMETER ( LV0 = 2.501E6 )
282 REAL DLVDT ! Rate of change of latent heat of vaporization with
283 ! respect to temperature [ J/kg-K ]
284 PARAMETER ( DLVDT = 2370.0 )
286 REAL LF0 ! latent heat of fusion of water at 0 C [ J/kg ]
287 PARAMETER ( LF0 = 3.34E5 )
289 !...Aqueous species pointers INCLUDE File
291 !...........PARAMETERS and their descriptions:
293 INTEGER, PARAMETER :: NGAS = 12 ! number of gas-phase species for AQCHEM
294 INTEGER, PARAMETER :: NAER = 36 ! number of aerosol species for AQCHEM
295 INTEGER, PARAMETER :: NLIQS = 41 ! number of liquid-phase species in AQCHEM
297 !...pointers for the AQCHEM array GAS
299 INTEGER, PARAMETER :: LSO2 = 1 ! Sulfur Dioxide
300 INTEGER, PARAMETER :: LHNO3 = 2 ! Nitric Acid
301 INTEGER, PARAMETER :: LN2O5 = 3 ! Dinitrogen Pentoxide
302 INTEGER, PARAMETER :: LCO2 = 4 ! Carbon Dioxide
303 INTEGER, PARAMETER :: LNH3 = 5 ! Ammonia
304 INTEGER, PARAMETER :: LH2O2 = 6 ! Hydrogen Perioxide
305 INTEGER, PARAMETER :: LO3 = 7 ! Ozone
306 INTEGER, PARAMETER :: LFOA = 8 ! Formic Acid
307 INTEGER, PARAMETER :: LMHP = 9 ! Methyl Hydrogen Peroxide
308 INTEGER, PARAMETER :: LPAA = 10 ! Peroxyacidic Acid
309 INTEGER, PARAMETER :: LH2SO4 = 11 ! Sulfuric Acid
310 INTEGER, PARAMETER :: LHCL = 12 ! Hydrogen Chloride
312 !...pointers for the AQCHEM array AEROSOL
314 INTEGER, PARAMETER :: LSO4AKN = 1 ! Aitken-mode Sulfate
315 INTEGER, PARAMETER :: LSO4ACC = 2 ! Accumulation-mode Sulfate
316 INTEGER, PARAMETER :: LSO4COR = 3 ! Coarse-mode Sulfate
317 INTEGER, PARAMETER :: LNH4AKN = 4 ! Aitken-mode Ammonium
318 INTEGER, PARAMETER :: LNH4ACC = 5 ! Accumulation-mode Ammonium
319 INTEGER, PARAMETER :: LNO3AKN = 6 ! Aitken-mode Nitrate
320 INTEGER, PARAMETER :: LNO3ACC = 7 ! Accumulation-mode Nitrate
321 INTEGER, PARAMETER :: LNO3COR = 8 ! Coarse-mode Nitrate
322 INTEGER, PARAMETER :: LORGAAKN = 9 ! Aitken-mode anthropogenic SOA
323 INTEGER, PARAMETER :: LORGAACC = 10 ! Accumulation-mode anthropogenic SOA
324 INTEGER, PARAMETER :: LORGPAKN = 11 ! Aitken-mode primary organic aerosol
325 INTEGER, PARAMETER :: LORGPACC = 12 ! Accumulation-mode primary organic aerosol
326 INTEGER, PARAMETER :: LORGBAKN = 13 ! Aitken-mode biogenic SOA
327 INTEGER, PARAMETER :: LORGBACC = 14 ! Accumulation-mode biogenic SOA
328 INTEGER, PARAMETER :: LECAKN = 15 ! Aitken-mode elemental carbon
329 INTEGER, PARAMETER :: LECACC = 16 ! Accumulation-mode elemental carbon
330 INTEGER, PARAMETER :: LPRIAKN = 17 ! Aitken-mode primary aerosol
331 INTEGER, PARAMETER :: LPRIACC = 18 ! Accumulation-mode primary aerosol
332 INTEGER, PARAMETER :: LPRICOR = 19 ! Coarse-mode primary aerosol
333 INTEGER, PARAMETER :: LNAAKN = 20 ! Aitken-mode Sodium
334 INTEGER, PARAMETER :: LNAACC = 21 ! Accumulation-mode Sodium
335 INTEGER, PARAMETER :: LNACOR = 22 ! Coarse-mode Sodium
336 INTEGER, PARAMETER :: LCLAKN = 23 ! Aitken-mode Chloride ion
337 INTEGER, PARAMETER :: LCLACC = 24 ! Accumulation-mode Chloride ion
338 INTEGER, PARAMETER :: LCLCOR = 25 ! Coarse-mode Chloride ion
339 INTEGER, PARAMETER :: LNUMAKN = 26 ! Aitken-mode number
340 INTEGER, PARAMETER :: LNUMACC = 27 ! Accumulation-mode number
341 INTEGER, PARAMETER :: LNUMCOR = 28 ! Coarse-mode number
342 INTEGER, PARAMETER :: LSRFAKN = 29 ! Aitken-mode surface area
343 INTEGER, PARAMETER :: LSRFACC = 30 ! Accumulation-mode surface area
344 INTEGER, PARAMETER :: LNACL = 31 ! Sodium Chloride aerosol for AE3 only {depreciated in AE4}
345 INTEGER, PARAMETER :: LCACO3 = 32 ! Calcium Carbonate aerosol (place holder)
346 INTEGER, PARAMETER :: LMGCO3 = 33 ! Magnesium Carbonate aerosol (place holder)
347 INTEGER, PARAMETER :: LA3FE = 34 ! Iron aerosol (place holder)
348 INTEGER, PARAMETER :: LB2MN = 35 ! Manganese aerosol (place holder)
349 INTEGER, PARAMETER :: LK = 36 ! Potassium aerosol (Cl- tracked separately) (place holder)
351 !...pointers for the AQCHEM arrays LIQUID and WETDEP
353 INTEGER, PARAMETER :: LACL = 1 ! Hydrogen ion
354 INTEGER, PARAMETER :: LNH4L = 2 ! Ammonium
355 INTEGER, PARAMETER :: LCAL = 3 ! Calcium
356 INTEGER, PARAMETER :: LNAACCL = 4 ! Sodium
357 INTEGER, PARAMETER :: LOHL = 5 ! Hydroxyl radical ion
358 INTEGER, PARAMETER :: LSO4ACCL = 6 ! Sulfate (attributed to accumulation mode)
359 INTEGER, PARAMETER :: LHSO4ACCL = 7 ! bisulfate (attributed to accumulation mode)
360 INTEGER, PARAMETER :: LSO3L = 8 ! sulfite
361 INTEGER, PARAMETER :: LHSO3L = 9 ! bisulfite
362 INTEGER, PARAMETER :: LSO2L = 10 ! sulfur dioxide
363 INTEGER, PARAMETER :: LCO3L = 11 ! carbonate
364 INTEGER, PARAMETER :: LHCO3L = 12 ! bicarbonate
365 INTEGER, PARAMETER :: LCO2L = 13 ! carbon dioxide
366 INTEGER, PARAMETER :: LNO3ACCL = 14 ! nitrate(attributed to accumulation mode)
367 INTEGER, PARAMETER :: LNH3L = 15 ! ammonia
368 INTEGER, PARAMETER :: LCLACCL = 16 ! chloride ion (attributed to accumulation mode)
369 INTEGER, PARAMETER :: LH2O2L = 17 ! hydrogen peroxide
370 INTEGER, PARAMETER :: LO3L = 18 ! ozone
371 INTEGER, PARAMETER :: LFEL = 19 ! iron
372 INTEGER, PARAMETER :: LMNL = 20 ! Manganese
373 INTEGER, PARAMETER :: LAL = 21 ! generalized anion associated with iron
374 INTEGER, PARAMETER :: LFOAL = 22 ! Formic acid
375 INTEGER, PARAMETER :: LHCO2L = 23 ! HCOO- ion
376 INTEGER, PARAMETER :: LMHPL = 24 ! Methyl hydrogen peroxide
377 INTEGER, PARAMETER :: LPAAL = 25 ! Peroxyacidic acid
378 INTEGER, PARAMETER :: LHCLL = 26 ! Hydrogen chloride
379 INTEGER, PARAMETER :: LPRIML = 27 ! primary aerosol
380 INTEGER, PARAMETER :: LMGL = 28 ! Magnesium
381 INTEGER, PARAMETER :: LKL = 29 ! potassium
382 INTEGER, PARAMETER :: LBL = 30 ! generalized anion associated with manganese
383 INTEGER, PARAMETER :: LHNO3L = 31 ! nitric acid
384 INTEGER, PARAMETER :: LPRIMCORL = 32 ! coarse-mode primary aerosol
385 INTEGER, PARAMETER :: LNUMCORL = 33 ! coarse-mode number
386 INTEGER, PARAMETER :: LTS6CORL = 34 ! sulfate (attributed to coarse mode)
387 INTEGER, PARAMETER :: LNACORL = 35 ! sodium (attributed to coarse mode)
388 INTEGER, PARAMETER :: LCLCORL = 36 ! chloride ion (attributed to coarse mode)
389 INTEGER, PARAMETER :: LNO3CORL = 37 ! nitrate (attributed to coarse mode)
390 INTEGER, PARAMETER :: LORGAL = 38 ! anthropogenic SOA
391 INTEGER, PARAMETER :: LORGPL = 39 ! primary organic aerosols
392 INTEGER, PARAMETER :: LORGBL = 40 ! biogenic SOA
393 INTEGER, PARAMETER :: LECL = 41 ! elemental carbon
395 !...surrogate names, their background values, and units
396 !... for AQCHEM's GAS species
398 CHARACTER*16, SAVE :: SGRGAS ( NGAS ) ! surrogate name for gases
399 CHARACTER*16, SAVE :: BUNTSGAS( NGAS ) ! units of bkgnd values
401 REAL, SAVE :: BGNDGAS( NGAS ) ! background values for each gas
403 DATA SGRGAS( LSO2 ), BGNDGAS( LSO2 ) /'SO2 ', 0.0 /
404 DATA SGRGAS( LHNO3 ), BGNDGAS( LHNO3 ) /'HNO3 ', 0.0 /
405 DATA SGRGAS( LN2O5 ), BGNDGAS( LN2O5 ) /'N2O5 ', 0.0 /
406 DATA SGRGAS( LCO2 ), BGNDGAS( LCO2 ) /'CO2 ', 340.0 /
407 DATA SGRGAS( LNH3 ), BGNDGAS( LNH3 ) /'NH3 ', 0.0 /
408 DATA SGRGAS( LH2O2 ), BGNDGAS( LH2O2 ) /'H2O2 ', 0.0 /
409 DATA SGRGAS( LO3 ), BGNDGAS( LO3 ) /'O3 ', 0.0 /
410 DATA SGRGAS( LFOA ), BGNDGAS( LFOA ) /'FOA ', 0.0 /
411 DATA SGRGAS( LMHP ), BGNDGAS( LMHP ) /'MHP ', 0.0 /
412 DATA SGRGAS( LPAA ), BGNDGAS( LPAA ) /'PAA ', 0.0 /
413 DATA SGRGAS( LH2SO4 ), BGNDGAS( LH2SO4 ) /'H2SO4 ', 0.0 /
414 DATA SGRGAS( LHCL ), BGNDGAS( LHCL ) /'HCL ', 0.0 /
416 DATA BUNTSGAS( LSO2 ) / 'ppm' /
417 DATA BUNTSGAS( LHNO3 ) / 'ppm' /
418 DATA BUNTSGAS( LN2O5 ) / 'ppm' /
419 DATA BUNTSGAS( LCO2 ) / 'ppm' /
420 DATA BUNTSGAS( LNH3 ) / 'ppm' /
421 DATA BUNTSGAS( LH2O2 ) / 'ppm' /
422 DATA BUNTSGAS( LO3 ) / 'ppm' /
423 DATA BUNTSGAS( LFOA ) / 'ppm' /
424 DATA BUNTSGAS( LMHP ) / 'ppm' /
425 DATA BUNTSGAS( LPAA ) / 'ppm' /
426 DATA BUNTSGAS( LH2SO4 ) / 'ppm' /
427 DATA BUNTSGAS( LHCL ) / 'ppm' /
429 !...surrogate names, their background values, units, and molecular weights
430 !... for AQCHEM's AEROSOL species
432 CHARACTER*16, SAVE :: SGRAER ( NAER ) ! surrogate name for aerosols
433 CHARACTER*16, SAVE :: BUNTSAER( NAER ) ! units of bkgnd values
435 REAL, SAVE :: SGRAERMW( NAER ) ! molecular weight for aerosol species
436 REAL, SAVE :: BGNDAER ( NAER ) ! bkground vals each aerosols
438 DATA SGRAER( LSO4AKN ), SGRAERMW( LSO4AKN ) / 'SO4_AITKEN ' , 96.0 /
439 DATA SGRAER( LSO4ACC ), SGRAERMW( LSO4ACC ) / 'SO4_ACCUM ' , 96.0 /
440 DATA SGRAER( LSO4COR ), SGRAERMW( LSO4COR ) / 'SO4_COARSE ' , 96.0 /
441 DATA SGRAER( LNH4AKN ), SGRAERMW( LNH4AKN ) / 'NH4_AITKEN ' , 18.0 /
442 DATA SGRAER( LNH4ACC ), SGRAERMW( LNH4ACC ) / 'NH4_ACCUM ' , 18.0 /
443 DATA SGRAER( LNO3AKN ), SGRAERMW( LNO3AKN ) / 'NO3_AITKEN ' , 62.0 /
444 DATA SGRAER( LNO3ACC ), SGRAERMW( LNO3ACC ) / 'NO3_ACCUM ' , 62.0 /
445 DATA SGRAER( LNO3COR ), SGRAERMW( LNO3COR ) / 'NO3_COARSE ' , 62.0 /
446 DATA SGRAER( LORGAAKN ), SGRAERMW( LORGAAKN ) / 'ORGA_AITKEN ' , 150.0 /
447 DATA SGRAER( LORGAACC ), SGRAERMW( LORGAACC ) / 'ORGA_ACCUM ' , 150.0 /
448 DATA SGRAER( LORGPAKN ), SGRAERMW( LORGPAKN ) / 'ORGP_AITKEN ' , 220.0 /
449 DATA SGRAER( LORGPACC ), SGRAERMW( LORGPACC ) / 'ORGP_ACCUM ' , 220.0 /
450 DATA SGRAER( LORGBAKN ), SGRAERMW( LORGBAKN ) / 'ORGB_AITKEN ' , 177.0 /
451 DATA SGRAER( LORGBACC ), SGRAERMW( LORGBACC ) / 'ORGB_ACCUM ' , 177.0 /
452 DATA SGRAER( LECAKN ), SGRAERMW( LECAKN ) / 'EC_AITKEN ' , 12.0 /
453 DATA SGRAER( LECACC ), SGRAERMW( LECACC ) / 'EC_ACCUM ' , 12.0 /
454 DATA SGRAER( LPRIAKN ), SGRAERMW( LPRIAKN ) / 'PRI_AITKEN ' , 200.0 /
455 DATA SGRAER( LPRIACC ), SGRAERMW( LPRIACC ) / 'PRI_ACCUM ' , 200.0 /
456 DATA SGRAER( LPRICOR ), SGRAERMW( LPRICOR ) / 'PRI_COARSE ' , 100.0 /
457 DATA SGRAER( LNAAKN ), SGRAERMW( LNAAKN ) / 'NA_AITKEN ' , 23.0 /
458 DATA SGRAER( LNAACC ), SGRAERMW( LNAACC ) / 'NA_ACCUM ' , 23.0 /
459 DATA SGRAER( LNACOR ), SGRAERMW( LNACOR ) / 'NA_COARSE ' , 23.0 /
460 DATA SGRAER( LCLAKN ), SGRAERMW( LCLAKN ) / 'CL_AITKEN ' , 35.5 /
461 DATA SGRAER( LCLACC ), SGRAERMW( LCLACC ) / 'CL_ACCUM ' , 35.5 /
462 DATA SGRAER( LCLCOR ), SGRAERMW( LCLCOR ) / 'CL_COARSE ' , 35.5 /
463 DATA SGRAER( LNUMAKN ), SGRAERMW( LNUMAKN ) / 'NUM_AITKEN ' , 1.0 /
464 DATA SGRAER( LNUMACC ), SGRAERMW( LNUMACC ) / 'NUM_ACCUM ' , 1.0 /
465 DATA SGRAER( LNUMCOR ), SGRAERMW( LNUMCOR ) / 'NUM_COARSE ' , 1.0 /
466 DATA SGRAER( LSRFAKN ), SGRAERMW( LSRFAKN ) / 'SRF_AITKEN ' , 1.0 /
467 DATA SGRAER( LSRFACC ), SGRAERMW( LSRFACC ) / 'SRF_ACCUM ' , 1.0 /
468 DATA SGRAER( LNACL ), SGRAERMW( LNACL ) / 'NACL ' , 58.4 / ! AE3 NaCl aerosol {depreciated in AE4}
469 DATA SGRAER( LCACO3 ), SGRAERMW( LCACO3 ) / 'CACO3 ' , 100.1 /
470 DATA SGRAER( LMGCO3 ), SGRAERMW( LMGCO3 ) / 'MGCO3 ' , 84.3 /
471 DATA SGRAER( LA3FE ), SGRAERMW( LA3FE ) / 'A3FE ' , 55.8 /
472 DATA SGRAER( LB2MN ), SGRAERMW( LB2MN ) / 'B2MN ' , 54.9 /
473 DATA SGRAER( LK ), SGRAERMW( LK ) / 'K ' , 39.1 /
475 DATA BGNDAER( LSO4AKN ), BUNTSAER( LSO4AKN ) / 0.0, 'ug/m3' /
476 DATA BGNDAER( LSO4ACC ), BUNTSAER( LSO4ACC ) / 0.0, 'ug/m3' /
477 DATA BGNDAER( LSO4COR ), BUNTSAER( LSO4COR ) / 0.0, 'ug/m3' /
478 DATA BGNDAER( LNH4AKN ), BUNTSAER( LNH4AKN ) / 0.0, 'ug/m3' /
479 DATA BGNDAER( LNH4ACC ), BUNTSAER( LNH4ACC ) / 0.0, 'ug/m3' /
480 DATA BGNDAER( LNO3AKN ), BUNTSAER( LNO3AKN ) / 0.0, 'ug/m3' /
481 DATA BGNDAER( LNO3ACC ), BUNTSAER( LNO3ACC ) / 0.0, 'ug/m3' /
482 DATA BGNDAER( LNO3COR ), BUNTSAER( LNO3COR ) / 0.0, 'ug/m3' /
483 DATA BGNDAER( LORGAAKN ), BUNTSAER( LORGAAKN ) / 0.0, 'ug/m3' /
484 DATA BGNDAER( LORGAACC ), BUNTSAER( LORGAACC ) / 0.0, 'ug/m3' /
485 DATA BGNDAER( LORGPAKN ), BUNTSAER( LORGPAKN ) / 0.0, 'ug/m3' /
486 DATA BGNDAER( LORGPACC ), BUNTSAER( LORGPACC ) / 0.0, 'ug/m3' /
487 DATA BGNDAER( LORGBAKN ), BUNTSAER( LORGBAKN ) / 0.0, 'ug/m3' /
488 DATA BGNDAER( LORGBACC ), BUNTSAER( LORGBACC ) / 0.0, 'ug/m3' /
489 DATA BGNDAER( LECAKN ), BUNTSAER( LECAKN ) / 0.0, 'ug/m3' /
490 DATA BGNDAER( LECACC ), BUNTSAER( LECACC ) / 0.0, 'ug/m3' /
491 DATA BGNDAER( LPRIAKN ), BUNTSAER( LPRIAKN ) / 0.0, 'ug/m3' /
492 DATA BGNDAER( LPRIACC ), BUNTSAER( LPRIACC ) / 0.0, 'ug/m3' /
493 DATA BGNDAER( LPRICOR ), BUNTSAER( LPRICOR ) / 0.0, 'ug/m3' /
494 DATA BGNDAER( LNAAKN ), BUNTSAER( LNAAKN ) / 0.0, 'ug/m3' /
495 DATA BGNDAER( LNAACC ), BUNTSAER( LNAACC ) / 0.0, 'ug/m3' /
496 DATA BGNDAER( LNACOR ), BUNTSAER( LNACOR ) / 0.0, 'ug/m3' /
497 DATA BGNDAER( LCLAKN ), BUNTSAER( LCLAKN ) / 0.0, 'ug/m3' /
498 DATA BGNDAER( LCLACC ), BUNTSAER( LCLACC ) / 0.0, 'ug/m3' /
499 DATA BGNDAER( LCLCOR ), BUNTSAER( LCLCOR ) / 0.0, 'ug/m3' /
500 DATA BGNDAER( LNUMAKN ), BUNTSAER( LNUMAKN ) / 0.0, ' #/m3' /
501 DATA BGNDAER( LNUMACC ), BUNTSAER( LNUMACC ) / 0.0, ' #/m3' /
502 DATA BGNDAER( LNUMCOR ), BUNTSAER( LNUMCOR ) / 0.0, ' #/m3' /
503 DATA BGNDAER( LSRFAKN ), BUNTSAER( LSRFAKN ) / 0.0, 'm2/m3' /
504 DATA BGNDAER( LSRFACC ), BUNTSAER( LSRFACC ) / 0.0, 'm2/m3' /
505 DATA BGNDAER( LNACL ), BUNTSAER( LNACL ) / 0.0, 'ug/m3' / ! AE3 NaCl aerosol {depreciated in AE4}
506 DATA BGNDAER( LCACO3 ), BUNTSAER( LCACO3 ) / 0.0, 'ug/m3' /
507 DATA BGNDAER( LMGCO3 ), BUNTSAER( LMGCO3 ) / 0.0, 'ug/m3' /
508 DATA BGNDAER( LA3FE ), BUNTSAER( LA3FE ) / 0.010, 'ug/m3' /
509 DATA BGNDAER( LB2MN ), BUNTSAER( LB2MN ) / 0.005, 'ug/m3' /
510 DATA BGNDAER( LK ), BUNTSAER( LK ) / 0.0, 'ug/m3' /
512 CHARACTER*120 XMSG ! Exit status message
513 DATA XMSG / ' ' /
515 !...........PARAMETERS and their descriptions:
517 INTEGER NUMOX ! number of oxidizing reactions
518 PARAMETER ( NUMOX = 5 )
520 REAL H2ODENS ! density of water at 20 C and 1 ATM
521 PARAMETER ( H2ODENS = 1000.0 ) ! (kg/m3)
523 REAL ONETHIRD ! 1/3
524 PARAMETER ( ONETHIRD = 1.0 / 3.0 )
526 REAL TWOTHIRDS ! 2/3
527 PARAMETER ( TWOTHIRDS = 2.0 / 3.0 )
529 REAL CONCMIN ! minimum concentration
530 PARAMETER ( CONCMIN = 1.0E-30 )
532 REAL SEC2HR ! convert seconds to hours
533 PARAMETER ( SEC2HR = 1.0 / 3600.0 )
535 !...........ARGUMENTS and their descriptions
537 ! INTEGER JDATE ! current model date, coded YYYYDDD
538 ! INTEGER JTIME ! current model time, coded HHMMSS
540 REAL AIRM ! total air mass in cloudy layers (mol/m2)
541 REAL ALFA0 ! scav coef for aitken aerosol number
542 REAL ALFA2 ! scav coef for aitken aerosol sfc area
543 REAL ALFA3 ! scav coef for aitken aerosol mass
544 REAL HPWDEP ! hydrogen wet deposition (mm mol/liter)
545 REAL PRCRATE ! precip rate (mm/hr)
546 REAL PRES_PA ! pressure (Pa)
547 REAL TAUCLD ! timestep for cloud (s)
548 REAL TEMP ! temperature (K)
549 REAL WCAVG ! liquid water content (kg/m3)
550 REAL WTAVG ! total water content (kg/m3)
552 REAL, INTENT(INOUT) :: GAS ( NGAS ) ! gas phase concentrations (mol/molV)
553 REAL, INTENT(INOUT) :: AEROSOL( NAER ) ! aerosol concentrations (mol/molV)
554 REAL, INTENT(OUT) :: LIQUID( NLIQS ) ! liquid concentrations (moles/liter)
555 REAL, INTENT(OUT) :: GASWDEP( NGAS ) ! gas phase wet deposition array (mm mol/liter)
556 REAL, INTENT(OUT) :: AERWDEP( NAER ) ! aerosol wet deposition array (mm mol/liter)
558 !...........LOCAL VARIABLES (scalars) and their descriptions:
560 LOGICAL, SAVE :: FIRSTIME = .TRUE. ! flag for first pass thru
562 CHARACTER*6 PNAME ! driver program name
563 DATA PNAME / 'AQCHEM' /
564 SAVE PNAME
565 CHARACTER( 16 ), SAVE :: AE_VRSN ! Aerosol version name
567 INTEGER I20C ! loop counter for do loop 20
568 INTEGER I30C ! loop counter for do loop 30
569 INTEGER ITERAT ! # iterations of aqueous chemistry solver
570 INTEGER I7777C ! aqueous chem iteration counter
571 INTEGER ICNTAQ ! aqueous chem iteration counter
572 INTEGER LIQ ! loop counter for liquid species
573 INTEGER IOX ! index over oxidation reactions
575 REAL DEPSUM
576 REAL BETASO4
577 REAL A ! iron's anion concentration
578 REAL AC ! H+ concentration in cloudwater (mol/liter)
579 REAL ACT1 ! activity corretion factor!single ions
580 REAL ACT2 ! activity factor correction!double ions
581 REAL ACTB !
582 REAL AE ! guess for H+ conc in cloudwater (mol/liter)
583 REAL B ! manganese's anion concentration
584 REAL PRES_ATM ! pressure (Atm)
585 REAL BB ! lower limit guess of cloudwater pH
586 REAL CA ! Calcium conc in cloudwater (mol/liter)
587 REAL CAA ! inital Calcium in cloudwater (mol/liter)
588 REAL CL ! total Cl- conc in cloudwater (mol/liter)
589 REAL CLACC ! fine Cl- in cloudwater (mol/liter)
590 REAL CLACCA ! initial fine Cl in cloudwater (mol/liter)
591 REAL CLAKNA ! initial interstitial aero Cl (mol/liter)
592 REAL CLCOR ! coarse Cl- conc in cloudwater (mol/liter)
593 REAL CLCORA ! init coarse Cl- in cloudwater (mol/liter)
594 REAL CO2H ! Henry's Law constant for CO2
595 REAL CO21 ! First dissociation constant for CO2
596 REAL CO22 ! Second dissociation constant for CO2
597 REAL CO212 ! CO21*CO22
598 REAL CO212H ! CO2H*CO21*CO22
599 REAL CO21H ! CO2H*CO21
600 REAL CO2L ! CO2 conc in cloudwater (mol/liter)
601 REAL CO3 ! CO3= conc in cloudwater (mol/liter)
602 REAL CO3A ! initial CO3 in cloudwater (mol/liter)
603 REAL CTHK1 ! cloud thickness (m)
604 REAL DTRMV !
605 REAL DTS6 !
606 REAL EBETASO4T ! EXP( -BETASO4 * TAUCLD )
607 REAL EALFA0T ! EXP( -ALFA0 * TAUCLD )
608 REAL EALFA2T ! EXP( -ALFA2 * TAUCLD )
609 REAL EALFA3T ! EXP( -ALFA3 * TAUCLD )
610 REAL EC ! elemental carbon acc+akn aerosol in cloudwater (mol/liter)
611 REAL ECACCA ! init EC ACC aerosol in cloudwater (mol/liter)
612 REAL ECAKNA ! init EC AKN aerosol in cloudwater (mol/liter)
613 REAL FA ! functional value ??
614 REAL FB ! functional value ??
615 REAL FE ! Fe+++ conc in cloudwater (mol/liter)
616 REAL FEA ! initial Fe in cloudwater (mol/liter)
617 REAL FNH3 ! frac weight of NH3 to total ammonia
618 REAL FNH4ACC ! frac weight of NH4 acc to total ammonia
619 REAL FHNO3 ! frac weight of HNO3 to total NO3
620 REAL FNO3ACC ! frac weight of NO3 acc to total NO3
621 REAL FRACLIQ ! fraction of water in liquid form
622 REAL FOA1 ! First dissociation constant for FOA
623 REAL FOAH ! Henry's Law constant for FOA
624 REAL FOA1H ! FOAH*FOA1
625 REAL FOAL ! FOA conc in cloudwater (mol/liter)
626 REAL FTST !
627 REAL GM !
628 REAL GM1 !
629 REAL GM1LOG !
630 REAL GM2 ! activity correction factor
631 REAL GM2LOG !
632 REAL HA !
633 REAL HB !
634 REAL H2OW !
635 REAL H2O2H ! Henry's Law Constant for H2O2
636 REAL H2O2L ! H2O2 conc in cloudwater (mol/liter)
637 REAL HCLH ! Henry's Law Constant for HCL
638 REAL HCL1 ! First dissociation constant for HCL
639 REAL HCL1H ! HCL1*HCLH
640 REAL HCLL ! HCl conc in cloudwater (mol/liter)
641 REAL HCO2 ! HCO2 conc in cloudwater (mol/liter)
642 REAL HCO3 ! HCO3 conc in cloudwater (mol/liter)
643 REAL HNO3H ! Henry's Law Constant for HNO3
644 REAL HNO31 ! First dissociation constant for HNO3
645 REAL HNO31H !
646 REAL HNO3L ! HNO3 conc in cloudwater (mol/liter)
647 REAL HSO3 ! HSO3 conc in cloudwater (mol/liter)
648 REAL HSO4 ! HSO4 concn in cloudwater (mol/liter)
649 REAL HSO4ACC ! accumulation mode HSO4 concn in cloudwater (mol/liter)
650 REAL HSO4COR ! coarse HSO4 concn in cloudwater (mol/liter)
651 REAL HTST !
652 REAL K ! K conc in cloudwater (mol/liter)
653 REAL KA ! initial K in cloudwater (mol/liter)
654 REAL LGTEMP ! log of TEMP
655 REAL M3NEW ! accumulation mode mass at time t
656 REAL M3OLD ! accumulation mode mass at time 0
657 REAL MG !
658 REAL MGA ! inital Mg in cloudwater (mol/liter)
659 REAL MHPH ! Henry's Law Constant for MHP
660 REAL MHPL ! MHP conc in cloudwater (mol/liter)
661 REAL MN ! Mn++ conc in cloudwater (mol/liter)
662 REAL MNA ! initial Mn in cloudwater (mol/liter)
663 REAL NA ! Na conc in cloudwater (mol/liter)
664 REAL NAACC ! Na in cloudwater (mol/liter)
665 REAL NAACCA ! initial Na in cloudwater (mol/liter)
666 REAL NAAKNA ! init Aitken mode aer conc (mol/liter)
667 REAL NACOR ! coarse Na in cloudwater (mol/liter)
668 REAL NACORA ! init Coarse Na in cloudwater (mol/liter)
669 REAL NH31 ! First dissociation constant for NH3
670 REAL NH3H ! Henry's Law Constant for NH3
671 REAL NH3DH20 !
672 REAL NH31HDH !
673 REAL NH3L ! NH3 conc in cloudwater (mol/liter)
674 REAL NH4 ! NH4+ conc in cloudwater (mol/liter)
675 REAL NH4AKNA ! init NH4 akn conc in cloudwater (mol/liter)
676 REAL NH4ACCA ! init NH4 acc conc in cloudwater (mol/liter)
677 REAL NITAER ! total aerosol nitrate
678 REAL NO3 ! NO3 conc in cloudwater (mol/liter)
679 REAL NO3ACC ! NO3 acc conc in cloudwater (mol/liter)
680 REAL NO3ACCA ! init NO3 acc conc in cloudwater (mol/liter)
681 REAL NO3AKNA ! init NO3 akn conc in cloudwater (mol/liter)
682 REAL NO3CORA ! init NO3 coa conc in cloudwater (mol/liter)
683 REAL NO3COR ! NO3 coarse conc in cloudwater (mol/liter)
684 REAL NUMCOR ! coarse aerosol number in cloudwater (mol/liter)
685 REAL NUMCORA ! initial coarse aerosol number in cloudwater (mol/liter)
686 REAL O3H ! Henry's Law Constant for O3
687 REAL O3L ! O3 conc in cloudwater (mol/liter)
688 REAL OH ! OH conc in cloudwater (mol/liter)
689 REAL ORGA ! anthro SOA in cloudwater (mol/liter)
690 REAL ORGAACCA ! init anthro ACC SOA in cloudwater (mol/liter)
691 REAL ORGAAKNA ! init anthro AKN SOA in cloudwater (mol/liter)
692 REAL ORGP ! primary ORGANIC aerosol in cloudwater (mol/liter)
693 REAL ORGPACCA ! init primary ORG ACC aerosol in cloudwater (mol/liter)
694 REAL ORGPAKNA ! init primary ORG AKN aerosol in cloudwater (mol/liter)
695 REAL ORGB ! biogenic SOA in cloudwater (mol/liter)
696 REAL ORGBACCA ! init biogenic ACC SOA in cloudwater (mol/liter)
697 REAL ORGBAKNA ! init biogenic AKN SOA in cloudwater (mol/liter)
698 REAL PAAH ! Henry's Law Constant for PAA
699 REAL PAAL ! PAA conc in cloudwater (mol/liter)
700 REAL PCO20 ! total CO2 partial pressure (atm)
701 REAL PCO2F ! gas only CO2 partial pressure (atm)
702 REAL PFOA0 ! total ORGANIC acid partial pressure (atm)
703 REAL PFOAF ! gas only ORGANIC ACID partial press (atm)
704 REAL PH2O20 ! total H2O2 partial pressure (atm)
705 REAL PH2O2F ! gas only H2O2 partial pressure (atm)
706 REAL PHCL0 ! total HCL partial pressure (atm)
707 REAL PHCLF ! gas only HCL partial pressure (atm)
708 REAL PHNO30 ! total HNO3 partial pressure (atm)
709 REAL PHNO3F ! gas only HNO3 partial pressure (atm)
710 REAL PMHP0 ! total MHP partial pressure (atm)
711 REAL PMHPF ! gas only MHP partial pressure (atm)
712 REAL PNH30 ! total NH3 partial pressure (atm)
713 REAL PNH3F ! gas only NH3 partial pressure (atm)
714 REAL PO30 ! total O3 partial pressure (atm)
715 REAL PO3F ! gas only O3 partial pressure (atm)
716 REAL PPAA0 ! total PAA partial pressure (atm)
717 REAL PPAAF ! gas only PAA partial pressure (atm)
718 REAL PRIM ! PRIMARY acc+akn aerosol in cloudwater (mol/liter)
719 REAL PRIMCOR ! PRIMARY coarse aerosol in cloudwater (mol/liter)
720 REAL PRIACCA ! init PRI ACC aerosol in cloudwater (mol/liter)
721 REAL PRIAKNA ! init PRI AKN aerosol in cloudwater (mol/liter)
722 REAL PRICORA ! init PRI COR aerosol in cloudwater (mol/liter)
723 REAL PSO20 ! total SO2 partial pressure (atm)
724 REAL PSO2F ! gas only SO2 partial pressure (atm)
725 REAL RATE !
726 REAL RECIPA1 !
727 REAL RECIPA2 !
728 REAL RECIPAP1 ! one over pressure (/atm)
729 REAL RH2O2 !
730 REAL RMHP !
731 REAL RPAA !
732 REAL RT ! gas const * temperature (liter atm/mol)
733 REAL SCVEFF ! Scavenging efficiency (%)
734 DATA SCVEFF / 100.0 / ! currently set to 100%
735 SAVE SCVEFF
736 REAL SIV ! dissolved so2 in cloudwater (mol/liter)
737 REAL SK6 !
738 REAL SK6TS6 !
739 REAL SO21 ! First dissociation constant for SO2
740 REAL SO22 ! Second dissociation constant for SO2
741 REAL SO2H ! Henry's Law Constant for SO2
742 REAL SO212 ! SO21*SO22
743 REAL SO212H ! SO21*SO22*SO2H
744 REAL SO21H ! SO21*SO2H
745 REAL SO2L ! SO2 conc in cloudwater (mol/liter)
746 REAL SO3 ! SO3= conc in cloudwater (mol/liter)
747 REAL SO4 ! SO4= conc in cloudwater (mol/liter)
748 REAL SO4ACC ! accumulation mode SO4= conc in cloudwater (mol/liter)
749 REAL SO4COR ! coarse SO4= conc in cloudwater (mol/liter)
750 REAL STION ! ionic strength
751 REAL TAC !
752 REAL TEMP1 !
753 REAL TIMEW ! cloud chemistry clock (sec)
754 REAL TOTOX !
755 REAL TOTAMM ! total ammonium
756 REAL TOTNIT ! total nitrate (excluding coarse mode)
757 REAL TS6 ! SO4 conc in cloudwater (mol/liter)
758 REAL TS6AKNA ! init SO4 akn conc in cloudwater (mol/liter)
759 REAL TS6ACC ! SO4 acc conc in cloudwater (mol/liter)
760 REAL TS6ACCA ! init SO4 acc conc in cloudwater (mol/liter)
761 REAL TS6COR ! coarse SO4 conc in cloudwater (mol/liter)
762 REAL TS6CORA ! init SO4 coa conc in cloudwater (mol/liter)
763 REAL TSIV !
764 REAL TST !
765 REAL TWASH ! washout time for clouds (sec)
766 REAL WETFAC ! converts mol/l to mm-mol/l based on precip
767 REAL XC1 ! (/mm)
768 REAL XC2 ! (liter-atm/mol/mm)
769 REAL XL ! conversion factor (liter-atm/mol)
770 REAL ONE_OVER_XL ! 1.0 / XL
771 REAL PRES_ATM_OVER_XL ! PRES_ATM / XL
772 REAL XLCO2 !
773 REAL XLH2O2 !
774 REAL XLHCL ! const in calc of HCL final partial pres
775 REAL XLHNO3 !
776 REAL XLMHP !
777 REAL XLNH3 !
778 REAL XLO3 !
779 REAL XLPAA !
780 REAL XLSO2 !
782 !...........LOCAL VARIABLES (arrays) and their descriptions:
784 REAL WETDEP( NLIQS ) ! wet deposition array (mm mol/liter)
785 REAL DSIVDT( 0:NUMOX ) ! rate of so2 oxid incloud (mol/liter/sec)
786 REAL DS4 ( 0:NUMOX ) ! S(IV) oxidized over timestep DTW(0)
787 REAL DTW ( 0:NUMOX ) ! cloud chemistry timestep (sec)
789 REAL ONE_OVER_TEMP ! 1.0 / TEMP
791 !...........EXTERNAL FUNCTIONS and their descriptions:
793 ! REAL HLCONST
794 ! EXTERNAL HLCONST
796 !*********************************************************************
797 ! begin body of subroutine AQCHEM
799 ONE_OVER_TEMP = 1.0 / TEMP
801 !...check for bad temperature, cloud air mass, or pressure
803 IF ( TEMP .LE. 0.0 .OR. AIRM .LE. 0.0 .OR. PRES_PA .LE. 0.0 ) THEN
804 XMSG = 'MET DATA ERROR, EXITING ROUTINE.'
805 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
806 write(0,*) ''
807 write(0,*) PNAME,' : ',XMSG
808 write(0,*) ''
809 write(0,*) 'TEMP :'
810 write(0,*) TEMP
811 write(0,*) 'PRES_PA :'
812 write(0,*) PRES_PA
813 write(0,*) 'TAUCLD :'
814 write(0,*) TAUCLD
815 write(0,*) 'PRCRATE :'
816 write(0,*) PRCRATE
817 write(0,*) 'WCAVG :'
818 write(0,*) WCAVG
819 write(0,*) 'WTAVG :'
820 write(0,*) WTAVG
821 write(0,*) 'AIRM :'
822 write(0,*) AIRM
823 write(0,*) 'ALFA0 :'
824 write(0,*) ALFA0
825 write(0,*) 'ALFA2 :'
826 write(0,*) ALFA2
827 write(0,*) 'ALFA3 :'
828 write(0,*) ALFA3
829 write(0,*) 'GAS :'
830 write(0,*) GAS
831 write(0,*) 'AEROSOL :'
832 write(0,*) AEROSOL
833 write(0,*) 'GASWDEP :'
834 write(0,*) GASWDEP
835 write(0,*) 'AERWDEP :'
836 write(0,*) AERWDEP
837 write(0,*) 'HPWDEP :'
838 write(0,*) HPWDEP
839 write(0,*) ''
840 return
841 END IF
843 !...initialize counters and compute several conversion factors
845 ICNTAQ = 0
846 ITERAT = 0
847 RT = ( MOLVOL / STDTEMP ) * TEMP ! R * T (liter atm / mol)
848 PRES_ATM = PRES_PA / STDATMPA ! pressure (atm)
849 CTHK1 = AIRM * RT / ( PRES_ATM * 1000.0 ) ! cloud thickness (m)
850 XL = WCAVG * RT / H2ODENS ! conversion factor (l-atm/mol)
851 ONE_OVER_XL = 1.0 / XL
852 PRES_ATM_OVER_XL = PRES_ATM / XL
853 TST = 0.999
854 GM = SCVEFF / 100.0
855 ACT1 = 1.0
856 ACT2 = 1.0
857 GM2 = 1.0
858 TIMEW = 0.0
859 RECIPAP1 = 1.0 / PRES_ATM
860 XC1 = 1.0 / ( WCAVG * CTHK1 )
861 XC2 = RT / ( 1000.0 * CTHK1 )
862 FRACLIQ = WCAVG / WTAVG
863 TWASH = WTAVG * 1000.0 * CTHK1 * 3600.0 &
864 / ( H2ODENS * MAX( 1.0E-20, PRCRATE ) )
866 !...set equilibrium constants as a function of temperature
867 !... Henry's law constants
869 SO2H = HLCONST( 'SO2 ', TEMP, .FALSE., 0.0 )
870 CO2H = HLCONST( 'CO2 ', TEMP, .FALSE., 0.0 )
871 NH3H = HLCONST( 'NH3 ', TEMP, .FALSE., 0.0 )
872 H2O2H = HLCONST( 'H2O2 ', TEMP, .FALSE., 0.0 )
873 O3H = HLCONST( 'O3 ', TEMP, .FALSE., 0.0 )
874 HCLH = HLCONST( 'HCL ', TEMP, .FALSE., 0.0 )
875 HNO3H = HLCONST( 'HNO3 ', TEMP, .FALSE., 0.0 )
876 MHPH = HLCONST( 'METHYLHYDROPEROX', TEMP, .FALSE., 0.0 )
877 PAAH = HLCONST( 'PEROXYACETIC_ACI', TEMP, .FALSE., 0.0 )
878 FOAH = HLCONST( 'FORMIC_ACID ', TEMP, .FALSE., 0.0 )
880 TEMP1 = ONE_OVER_TEMP - 1.0 / 298.0
882 !...dissociation constants
884 FOA1 = 1.80E-04 * EXP( -2.00E+01 * TEMP1 ) ! Martell and Smith (1977)
885 SK6 = 1.02E-02 * EXP( 2.72E+03 * TEMP1 ) ! Smith and Martell (1976)
886 SO21 = 1.30E-02 * EXP( 1.96E+03 * TEMP1 ) ! Smith and Martell (1976)
887 SO22 = 6.60E-08 * EXP( 1.50E+03 * TEMP1 ) ! Smith and Martell (1976)
888 CO21 = 4.30E-07 * EXP( -1.00E+03 * TEMP1 ) ! Smith and Martell (1976)
889 CO22 = 4.68E-11 * EXP( -1.76E+03 * TEMP1 ) ! Smith and Martell (1976)
890 H2OW = 1.00E-14 * EXP( -6.71E+03 * TEMP1 ) ! Smith and Martell (1976)
891 NH31 = 1.70E-05 * EXP( -4.50E+02 * TEMP1 ) ! Smith and Martell (1976)
892 HCL1 = 1.74E+06 * EXP( 6.90E+03 * TEMP1 ) ! Marsh and McElroy (1985)
893 HNO31 = 1.54E+01 * EXP( 8.70E+03 * TEMP1 ) ! Schwartz (1984)
895 !...Kinetic oxidation rates
896 !... From Chamedies (1982)
898 ! RH2O2 = 8.0E+04 * EXP( -3650.0 * TEMP1 )
899 !KW based on CMAQv5.0 From Jacobson (1997)
900 RH2O2 = 7.45E+07 * EXP( -15.96E0 * ( ( 298.0E0 / TEMP ) - 1.0E0 ) )
902 !...From Kok
904 ! RMHP = 1.75E+07 * EXP( -3801.0 * TEMP1 )
905 ! RPAA = 3.64E+07 * EXP( -3994.0 * TEMP1 )
906 !KW based on CMAQv5.0 From Jacobson (1997)
908 RMHP = 1.90E+07 * EXP( -12.75E0 * ( ( 298.0E0 / TEMP ) - 1.0E0 ) )
909 RPAA = 3.67E+07 * EXP( -13.42E0 * ( ( 298.0E0 / TEMP ) - 1.0E0 ) )
911 !...make initializations
913 DO LIQ = 1, NLIQS
914 WETDEP( LIQ ) = 0.0
915 END DO
917 DO IOX = 0, NUMOX
918 DSIVDT( IOX ) = 0.0
919 DTW ( IOX ) = 0.0
920 DS4 ( IOX ) = 0.0
921 END DO
923 !...compute the initial accumulation aerosol 3rd moment
924 !... secondary organic aerosol and water are not included
926 M3OLD = ( AEROSOL( LSO4ACC ) * SGRAERMW( LSO4ACC ) / 1.8e6 &
927 + AEROSOL( LNH4ACC ) * SGRAERMW( LNH4ACC ) / 1.8e6 &
928 + AEROSOL( LNO3ACC ) * SGRAERMW( LNO3ACC ) / 1.8e6 &
929 + AEROSOL( LORGPACC ) * SGRAERMW( LORGPACC ) / 2.0e6 &
930 + AEROSOL( LECACC ) * SGRAERMW( LECACC ) / 2.2e6 &
931 + AEROSOL( LPRIACC ) * SGRAERMW( LPRIACC ) / 2.2e6 &
932 + AEROSOL( LNAACC ) * SGRAERMW( LNAACC ) / 2.2e6 &
933 + AEROSOL( LCLACC ) * SGRAERMW( LCLACC ) / 2.2e6 )
934 !cc & * 6.0 / PI ! cancels out in division at end of subroutine
936 !...compute fractional weights for several species
938 TOTNIT = GAS( LHNO3 ) + AEROSOL( LNO3ACC )
939 IF ( TOTNIT .GT. 0.0 ) THEN
940 FHNO3 = GAS( LHNO3 ) / TOTNIT
941 FNO3ACC = AEROSOL( LNO3ACC ) / TOTNIT
942 ELSE
943 FHNO3 = 1.0
944 FNO3ACC = 0.0
945 END IF
947 TOTAMM = GAS( LNH3 ) + AEROSOL( LNH4ACC )
948 IF ( TOTAMM .GT. 0.0 ) THEN
949 FNH3 = GAS( LNH3 ) / TOTAMM
950 FNH4ACC = AEROSOL( LNH4ACC ) / TOTAMM
951 ELSE
952 FNH3 = 1.0
953 FNH4ACC = 0.0
954 END IF
956 !...initial concentration from accumulation-mode aerosol loading (mol/liter)
957 !... an assumption is made that all of the accumulation-mode
958 !... aerosol mass in incorporated into the cloud droplets
960 TS6ACCA = ( AEROSOL( LSO4ACC ) &
961 + GAS ( LH2SO4 ) ) * PRES_ATM_OVER_XL
962 NO3ACCA = AEROSOL( LNO3ACC ) * PRES_ATM_OVER_XL
963 NH4ACCA = AEROSOL( LNH4ACC ) * PRES_ATM_OVER_XL
964 ORGAACCA = AEROSOL( LORGAACC ) * PRES_ATM_OVER_XL
965 ORGPACCA = AEROSOL( LORGPACC ) * PRES_ATM_OVER_XL
966 ORGBACCA = AEROSOL( LORGBACC ) * PRES_ATM_OVER_XL
967 ECACCA = AEROSOL( LECACC ) * PRES_ATM_OVER_XL
968 PRIACCA = AEROSOL( LPRIACC ) * PRES_ATM_OVER_XL
969 NAACCA = AEROSOL( LNAACC ) * PRES_ATM_OVER_XL
970 CLACCA = AEROSOL( LCLACC ) * PRES_ATM_OVER_XL
972 !...initial concentration from coarse-mode aerosol loading (mol/liter)
973 !... an assumption is made that all of the coarse-mode
974 !... aerosol mass in incorporated into the cloud droplets
976 TS6CORA = AEROSOL( LSO4COR ) * PRES_ATM_OVER_XL
977 NO3CORA = AEROSOL( LNO3COR ) * PRES_ATM_OVER_XL
979 IF ( AE_VRSN .EQ. 'AE3' ) THEN
980 CLCORA = AEROSOL( LNACL ) * PRES_ATM_OVER_XL
981 NACORA = AEROSOL( LNACL ) * PRES_ATM_OVER_XL
982 ELSE
983 CLCORA = AEROSOL( LCLCOR ) * PRES_ATM_OVER_XL
984 NACORA = AEROSOL( LNACOR ) * PRES_ATM_OVER_XL
985 END IF
987 KA = AEROSOL( LK ) * PRES_ATM_OVER_XL
988 CAA = AEROSOL( LCACO3 ) * PRES_ATM_OVER_XL
989 MGA = AEROSOL( LMGCO3 ) * PRES_ATM_OVER_XL
990 FEA = AEROSOL( LA3FE ) * PRES_ATM_OVER_XL
991 MNA = AEROSOL( LB2MN ) * PRES_ATM_OVER_XL
992 CO3A = ( AEROSOL( LCACO3 ) &
993 + AEROSOL( LMGCO3 ) ) * PRES_ATM_OVER_XL
994 PRICORA = AEROSOL( LPRICOR ) * PRES_ATM_OVER_XL
995 NUMCORA = AEROSOL( LNUMCOR ) * PRES_ATM_OVER_XL
997 !...set constant factors that will be used in later multiplications (moles/atm)
999 XLH2O2 = H2O2H * XL
1000 XLO3 = O3H * XL
1001 XLMHP = MHPH * XL
1002 XLPAA = PAAH * XL
1003 XLSO2 = SO2H * XL
1004 XLNH3 = NH3H * XL
1005 XLHCL = HCLH * XL
1006 XLHNO3 = HNO3H * XL
1007 XLCO2 = CO2H * XL
1009 SO212 = SO21 * SO22
1010 SO21H = SO21 * SO2H
1011 SO212H = SO212 * SO2H
1012 CO212 = CO21 * CO22
1013 CO21H = CO21 * CO2H
1014 CO212H = CO22 * CO21H
1015 NH3DH20 = NH31 / H2OW
1016 NH31HDH = NH3H * NH3DH20
1017 FOA1H = FOA1 * FOAH
1018 HCL1H = HCL1 * HCLH
1019 HNO31H = HNO31 * HNO3H
1021 !...If kinetic calculations are made, return to this point
1023 I20C = 0
1024 20 CONTINUE
1026 I20C = I20C + 1
1027 IF ( I20C .GE. 10000 ) THEN
1028 XMSG = 'EXCESSIVE LOOPING AT I20C, EXITING ROUTINE.'
1029 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1030 write(0,*) ''
1031 write(0,*) PNAME,' : ',XMSG
1032 write(0,*) ''
1033 write(0,*) 'TEMP :'
1034 write(0,*) TEMP
1035 write(0,*) 'PRES_PA :'
1036 write(0,*) PRES_PA
1037 write(0,*) 'TAUCLD :'
1038 write(0,*) TAUCLD
1039 write(0,*) 'PRCRATE :'
1040 write(0,*) PRCRATE
1041 write(0,*) 'WCAVG :'
1042 write(0,*) WCAVG
1043 write(0,*) 'WTAVG :'
1044 write(0,*) WTAVG
1045 write(0,*) 'AIRM :'
1046 write(0,*) AIRM
1047 write(0,*) 'ALFA0 :'
1048 write(0,*) ALFA0
1049 write(0,*) 'ALFA2 :'
1050 write(0,*) ALFA2
1051 write(0,*) 'ALFA3 :'
1052 write(0,*) ALFA3
1053 write(0,*) 'GAS :'
1054 write(0,*) GAS
1055 write(0,*) 'AEROSOL :'
1056 write(0,*) AEROSOL
1057 write(0,*) 'GASWDEP :'
1058 write(0,*) GASWDEP
1059 write(0,*) 'AERWDEP :'
1060 write(0,*) AERWDEP
1061 write(0,*) 'HPWDEP :'
1062 write(0,*) HPWDEP
1063 write(0,*) ''
1064 return
1065 END IF
1067 !...set aitken-mode aerosol loading (mol/liter)
1069 NO3AKNA = AEROSOL( LNO3AKN ) * PRES_ATM_OVER_XL &
1070 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1071 NH4AKNA = AEROSOL( LNH4AKN ) * PRES_ATM_OVER_XL &
1072 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1073 TS6AKNA = AEROSOL( LSO4AKN ) * PRES_ATM_OVER_XL &
1074 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1075 ORGAAKNA = AEROSOL( LORGAAKN ) * PRES_ATM_OVER_XL &
1076 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1077 ORGPAKNA = AEROSOL( LORGPAKN ) * PRES_ATM_OVER_XL &
1078 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1079 ORGBAKNA = AEROSOL( LORGBAKN ) * PRES_ATM_OVER_XL &
1080 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1081 ECAKNA = AEROSOL( LECAKN ) * PRES_ATM_OVER_XL &
1082 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1083 PRIAKNA = AEROSOL( LPRIAKN ) * PRES_ATM_OVER_XL &
1084 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1085 NAAKNA = AEROSOL( LNAAKN ) * PRES_ATM_OVER_XL &
1086 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1087 CLAKNA = AEROSOL( LCLAKN ) * PRES_ATM_OVER_XL &
1088 * ( 1.0 - EXP( -ALFA3 * TIMEW ) )
1090 !...Initial gas phase partial pressures (atm)
1091 !... = initial partial pressure - amount deposited partial pressure
1093 PSO20 = GAS( LSO2 ) * PRES_ATM &
1094 + DS4( 0 ) * XL &
1095 - ( WETDEP( LSO3L ) + WETDEP( LHSO3L ) + WETDEP( LSO2L ) ) * XC2
1096 PNH30 = GAS( LNH3 ) * PRES_ATM &
1097 + ( NH4ACCA + NH4AKNA ) * XL &
1098 - ( WETDEP( LNH4L ) + WETDEP( LNH3L ) ) * XC2
1099 PHNO30 = ( GAS( LHNO3 ) + 2.0 * GAS( LN2O5 ) ) * PRES_ATM &
1100 + ( NO3ACCA + NO3CORA + NO3AKNA ) * XL &
1101 - ( WETDEP( LNO3ACCL ) + WETDEP( LHNO3L ) + WETDEP( LNO3CORL ) ) * XC2
1102 PHCL0 = GAS( LHCL ) * PRES_ATM &
1103 + ( CLACCA + CLCORA + CLAKNA ) * XL & ! new for sea salt
1104 - ( WETDEP( LCLACCL ) + WETDEP( LHCLL ) + WETDEP( LCLCORL ) ) * XC2
1105 PH2O20 = GAS( LH2O2 ) * PRES_ATM - WETDEP( LH2O2L ) * XC2
1106 PO30 = GAS( LO3 ) * PRES_ATM - WETDEP( LO3L ) * XC2
1107 PFOA0 = GAS( LFOA ) * PRES_ATM &
1108 - ( WETDEP( LFOAL ) + WETDEP( LHCO2L ) ) * XC2
1109 PMHP0 = GAS( LMHP ) * PRES_ATM - WETDEP( LMHPL ) * XC2
1110 PPAA0 = GAS( LPAA ) * PRES_ATM - WETDEP( LPAAL ) * XC2
1111 PCO20 = GAS( LCO2 ) * PRES_ATM &
1112 + CO3A * XL &
1113 - ( WETDEP( LCO3L ) + WETDEP( LHCO3L ) + WETDEP( LCO2L ) ) * XC2
1115 !...don't allow gas concentrations to go below zero
1117 PSO20 = MAX( PSO20, 0.0 )
1118 PNH30 = MAX( PNH30, 0.0 )
1119 PH2O20 = MAX( PH2O20, 0.0 )
1120 PO30 = MAX( PO30, 0.0 )
1121 PFOA0 = MAX( PFOA0, 0.0 )
1122 PMHP0 = MAX( PMHP0, 0.0 )
1123 PPAA0 = MAX( PPAA0, 0.0 )
1124 PCO20 = MAX( PCO20, 0.0 )
1125 PHCL0 = MAX( PHCL0, 0.0 )
1126 PHNO30 = MAX( PHNO30, 0.0 )
1128 !...Molar concentrations of soluble aerosols
1129 !... = Initial amount - amount deposited (mol/liter)
1131 TS6COR = MAX( TS6CORA - WETDEP( LTS6CORL ) * XC1, 0.0 )
1132 NO3COR = MAX( NO3CORA - WETDEP( LNO3CORL ) * XC1, 0.0 )
1133 NACOR = MAX( NACORA - WETDEP( LNACORL ) * XC1, 0.0 )
1134 CLCOR = MAX( CLCORA - WETDEP( LCLCORL ) * XC1, 0.0 )
1136 TS6 = TS6ACCA + TS6AKNA + TS6COR &
1137 - ( WETDEP( LSO4ACCL ) + WETDEP( LHSO4ACCL ) ) * XC1 &
1138 - DS4( 0 )
1139 NA = NAACCA + NAAKNA + NACOR &
1140 - WETDEP( LNAACCL ) * XC1
1141 CA = CAA - WETDEP( LCAL ) * XC1
1142 MG = MGA - WETDEP( LMGL ) * XC1
1143 K = KA - WETDEP( LKL ) * XC1
1144 FE = FEA - WETDEP( LFEL ) * XC1
1145 MN = MNA - WETDEP( LMNL ) * XC1
1146 ORGA = ORGAACCA + ORGAAKNA - WETDEP( LORGAL ) * XC1
1147 ORGP = ORGPACCA + ORGPAKNA - WETDEP( LORGPL ) * XC1
1148 ORGB = ORGBACCA + ORGBAKNA - WETDEP( LORGBL ) * XC1
1149 EC = ECACCA + ECAKNA - WETDEP( LECL ) * XC1
1150 PRIM = PRIACCA + PRIAKNA - WETDEP( LPRIML ) * XC1
1151 PRIMCOR = PRICORA - WETDEP( LPRIMCORL ) * XC1
1152 NUMCOR = NUMCORA - WETDEP( LNUMCORL ) * XC1
1153 A = 3.0 * FE
1154 B = 2.0 * MN
1156 !...don't allow aerosol concentrations to go below zero
1158 TS6 = MAX( TS6, 0.0 )
1159 NA = MAX( NA, 0.0 )
1160 CA = MAX( CA, 0.0 )
1161 MG = MAX( MG, 0.0 )
1162 K = MAX( K, 0.0 )
1163 FE = MAX( FE, 0.0 )
1164 MN = MAX( MN, 0.0 )
1165 ORGA = MAX( ORGA, 0.0 )
1166 ORGP = MAX( ORGP, 0.0 )
1167 ORGB = MAX( ORGB, 0.0 )
1168 EC = MAX( EC, 0.0 )
1169 PRIM = MAX( PRIM, 0.0 )
1170 PRIMCOR = MAX( PRIMCOR, 0.0 )
1171 NUMCOR = MAX( NUMCOR, 0.0 )
1172 A = MAX( A, 0.0 )
1173 B = MAX( B, 0.0 )
1175 SK6TS6 = SK6 * TS6
1177 !...find solution of the equation using a method of reiterative
1178 !... bisections Make initial guesses for pH: between .01 to 10.
1180 HA = 0.01
1181 HB = 10.0
1183 I7777C = 0
1184 7777 CONTINUE
1186 I7777C = I7777C + 1
1187 IF ( I7777C .GE. 10000 ) THEN
1188 XMSG = 'EXCESSIVE LOOPING AT I7777C, EXITING ROUTINE.'
1189 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1190 write(0,*) ''
1191 write(0,*) PNAME,' : ',XMSG
1192 write(0,*) ''
1193 write(0,*) 'TEMP :'
1194 write(0,*) TEMP
1195 write(0,*) 'PRES_PA :'
1196 write(0,*) PRES_PA
1197 write(0,*) 'TAUCLD :'
1198 write(0,*) TAUCLD
1199 write(0,*) 'PRCRATE :'
1200 write(0,*) PRCRATE
1201 write(0,*) 'WCAVG :'
1202 write(0,*) WCAVG
1203 write(0,*) 'WTAVG :'
1204 write(0,*) WTAVG
1205 write(0,*) 'AIRM :'
1206 write(0,*) AIRM
1207 write(0,*) 'ALFA0 :'
1208 write(0,*) ALFA0
1209 write(0,*) 'ALFA2 :'
1210 write(0,*) ALFA2
1211 write(0,*) 'ALFA3 :'
1212 write(0,*) ALFA3
1213 write(0,*) 'GAS :'
1214 write(0,*) GAS
1215 write(0,*) 'AEROSOL :'
1216 write(0,*) AEROSOL
1217 write(0,*) 'GASWDEP :'
1218 write(0,*) GASWDEP
1219 write(0,*) 'AERWDEP :'
1220 write(0,*) AERWDEP
1221 write(0,*) 'HPWDEP :'
1222 write(0,*) HPWDEP
1223 write(0,*) ''
1224 return
1225 END IF
1227 HA = MAX( HA - 0.8, 0.1 )
1228 HB = MIN( HB + 0.8, 9.9 )
1229 AE = 10.0**( -HA )
1231 RECIPA1 = 1.0 / ( AE * ACT1 )
1232 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1234 !...calculate final gas phase partial pressure of SO2, NH3, HNO3
1235 !... HCOOH, and CO2 (atm)
1237 PSO2F = PSO20 / ( 1.0 + XLSO2 * ( 1.0 + SO21 * RECIPA1 &
1238 + SO212 * RECIPA2 ) )
1240 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1242 PHCLF = PHCL0 / ( 1.0 + XLHCL * ( 1.0 + HCL1 * RECIPA1 ) )
1244 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1246 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1248 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1249 + CO212 * RECIPA2 ) )
1251 !...calculate liquid phase concentrations (moles/liter)
1253 SO4 = SK6TS6 / ( AE * GM2 + SK6 )
1254 HSO4 = TS6 - SO4
1255 SO3 = SO212H * PSO2F * RECIPA2
1256 HSO3 = SO21H * PSO2F * RECIPA1
1257 CO3 = CO212H * PCO2F * RECIPA2
1258 HCO3 = CO21H * PCO2F * RECIPA1
1259 OH = H2OW * RECIPA1
1260 NH4 = NH31HDH * PNH3F * AE
1261 HCO2 = FOA1H * PFOAF * RECIPA1
1262 NO3 = HNO31H * PHNO3F * RECIPA1
1263 CL = HCL1H * PHCLF * RECIPA1 ! new for sea salt
1265 !...compute functional value
1267 FA = AE + NH4 + NA + 2.0 * ( CA + MG - CO3 - SO3 - SO4 ) &
1268 - OH - HCO3 - HSO3 - NO3 - HSO4 - HCO2 - CL
1270 !...Start iteration and bisection ****************<<<<<<<
1272 I30C = 0
1273 30 CONTINUE
1275 I30C = I30C + 1
1276 IF ( I30C .GE. 10000 ) THEN
1277 XMSG = 'EXCESSIVE LOOPING AT I30C, EXITING ROUTINE.'
1278 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1279 write(0,*) ''
1280 write(0,*) PNAME,' : ',XMSG
1281 write(0,*) ''
1282 write(0,*) 'TEMP :'
1283 write(0,*) TEMP
1284 write(0,*) 'PRES_PA :'
1285 write(0,*) PRES_PA
1286 write(0,*) 'TAUCLD :'
1287 write(0,*) TAUCLD
1288 write(0,*) 'PRCRATE :'
1289 write(0,*) PRCRATE
1290 write(0,*) 'WCAVG :'
1291 write(0,*) WCAVG
1292 write(0,*) 'WTAVG :'
1293 write(0,*) WTAVG
1294 write(0,*) 'AIRM :'
1295 write(0,*) AIRM
1296 write(0,*) 'ALFA0 :'
1297 write(0,*) ALFA0
1298 write(0,*) 'ALFA2 :'
1299 write(0,*) ALFA2
1300 write(0,*) 'ALFA3 :'
1301 write(0,*) ALFA3
1302 write(0,*) 'GAS :'
1303 write(0,*) GAS
1304 write(0,*) 'AEROSOL :'
1305 write(0,*) AEROSOL
1306 write(0,*) 'GASWDEP :'
1307 write(0,*) GASWDEP
1308 write(0,*) 'AERWDEP :'
1309 write(0,*) AERWDEP
1310 write(0,*) 'HPWDEP :'
1311 write(0,*) HPWDEP
1312 write(0,*) ''
1313 return
1314 END IF
1316 BB = ( HA + HB ) / 2.0
1317 AE = 10.0**( -BB )
1319 ICNTAQ = ICNTAQ + 1
1320 IF ( ICNTAQ .GE. 60000 ) THEN
1321 XMSG = 'Maximum AQCHEM total iterations exceeded, EXITING ROUTINE.'
1322 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1323 write(0,*) ''
1324 write(0,*) PNAME,' : ',XMSG
1325 write(0,*) ''
1326 write(0,*) 'TEMP :'
1327 write(0,*) TEMP
1328 write(0,*) 'PRES_PA :'
1329 write(0,*) PRES_PA
1330 write(0,*) 'TAUCLD :'
1331 write(0,*) TAUCLD
1332 write(0,*) 'PRCRATE :'
1333 write(0,*) PRCRATE
1334 write(0,*) 'WCAVG :'
1335 write(0,*) WCAVG
1336 write(0,*) 'WTAVG :'
1337 write(0,*) WTAVG
1338 write(0,*) 'AIRM :'
1339 write(0,*) AIRM
1340 write(0,*) 'ALFA0 :'
1341 write(0,*) ALFA0
1342 write(0,*) 'ALFA2 :'
1343 write(0,*) ALFA2
1344 write(0,*) 'ALFA3 :'
1345 write(0,*) ALFA3
1346 write(0,*) 'GAS :'
1347 write(0,*) GAS
1348 write(0,*) 'AEROSOL :'
1349 write(0,*) AEROSOL
1350 write(0,*) 'GASWDEP :'
1351 write(0,*) GASWDEP
1352 write(0,*) 'AERWDEP :'
1353 write(0,*) AERWDEP
1354 write(0,*) 'HPWDEP :'
1355 write(0,*) HPWDEP
1356 write(0,*) ''
1357 return
1358 END IF
1360 RECIPA1 = 1.0 / ( AE * ACT1 )
1361 RECIPA2 = 1.0 / ( AE * AE * ACT2 )
1363 !...calculate final gas phase partial pressure of SO2, NH3, HCL, HNO3
1364 !... HCOOH, and CO2 (atm)
1366 PSO2F = PSO20 / ( 1.0 + XLSO2 &
1367 * ( 1.0 + SO21 * RECIPA1 + SO212 * RECIPA2 ) )
1369 PNH3F = PNH30 / ( 1.0 + XLNH3 * ( 1.0 + NH3DH20 * AE ) )
1371 PHCLF = PHCL0 / ( 1.0 + XLHCL * ( 1.0 + HCL1 * RECIPA1 ) )
1373 PHNO3F = PHNO30 / ( 1.0 + XLHNO3 * ( 1.0 + HNO31 * RECIPA1 ) )
1375 PFOAF = PFOA0 / ( 1.0 + XL * ( FOAH + FOA1H * RECIPA1 ) )
1377 PCO2F = PCO20 / ( 1.0 + XLCO2 * ( 1.0 + CO21 * RECIPA1 &
1378 + CO212 * RECIPA2 ) )
1380 !...calculate liquid phase concentrations (moles/liter)
1382 SO4 = SK6TS6 / ( AE * GM2 + SK6 )
1383 HSO4 = TS6 - SO4
1384 SO3 = SO212H * PSO2F * RECIPA2
1385 HSO3 = SO21H * PSO2F * RECIPA1
1386 CO3 = CO212H * PCO2F * RECIPA2
1387 HCO3 = CO21H * PCO2F * RECIPA1
1388 OH = H2OW * RECIPA1
1389 NH4 = NH31HDH * PNH3F * AE
1390 HCO2 = FOA1H * PFOAF * RECIPA1
1391 NO3 = HNO31H * PHNO3F * RECIPA1
1392 CL = HCL1H * PHCLF * RECIPA1 ! new for sea salt
1394 !...compute functional value
1396 FB = AE + NH4 + NA + 2.0 * ( CA + MG - CO3 - SO3 - SO4 ) &
1397 - OH - HCO3 - HSO3 - NO3 - HSO4 - HCO2 - CL
1399 !...Calculate and check the sign of the product of the two functional values
1401 FTST = FA * FB
1402 IF ( FTST .LE. 0.0 ) THEN
1403 HB = BB
1404 ELSE
1405 HA = BB
1406 FA = FB
1407 END IF
1409 !...Check convergence of solutions
1411 HTST = HA / HB
1412 IF ( HTST .LE. TST ) GO TO 30
1414 !...end of zero-finding routine ****************<<<<<<<<<<<<
1416 !...compute Ionic strength and activity coefficient by the Davies equation
1418 STION = 0.5 * (AE + NH4 + OH + HCO3 + HSO3 &
1419 + 4.0 * (SO4 + CO3 + SO3 + CA + MG + MN) &
1420 + NO3 + HSO4 + 9.0 * FE + NA + K + CL + A + B + HCO2)
1421 GM1LOG = -0.509 * ( SQRT( STION ) &
1422 / ( 1.0 + SQRT( STION ) ) - 0.2 * STION )
1423 GM2LOG = GM1LOG * 4.0
1424 GM1 = 10.0**GM1LOG
1425 GM2 = MAX( 10.0**GM2LOG, 1.0E-30 )
1426 ACTB = ACT1
1427 ACT1 = MAX( GM1 * GM1, 1.0E-30 )
1428 ACT2 = MAX( GM1 * GM1 * GM2, 1.0E-30 )
1430 !...check for convergence and possibly go to 7777, to recompute
1431 !... Gas and liquid phase concentrations
1433 TAC = ABS( ACTB - ACT1 ) / ACTB
1434 IF ( TAC .GE. 1.0E-2 ) GO TO 7777
1436 !...return an error if the pH is not in range
1438 !cc IF ( ( HA .LT. 0.02 ) .OR. ( HA .GT. 9.49 ) ) THEN
1439 IF ( ( HA .LT. 0.1 ) .OR. ( HA .GT. 9.9 ) ) THEN
1440 print *, ha
1441 XMSG = 'PH VALUE OUT OF RANGE, EXITING ROUTINE.'
1442 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
1443 write(0,*) ''
1444 write(0,*) PNAME,' : ',XMSG
1445 write(0,*) ''
1446 write(0,*) 'TEMP :'
1447 write(0,*) TEMP
1448 write(0,*) 'PRES_PA :'
1449 write(0,*) PRES_PA
1450 write(0,*) 'TAUCLD :'
1451 write(0,*) TAUCLD
1452 write(0,*) 'PRCRATE :'
1453 write(0,*) PRCRATE
1454 write(0,*) 'WCAVG :'
1455 write(0,*) WCAVG
1456 write(0,*) 'WTAVG :'
1457 write(0,*) WTAVG
1458 write(0,*) 'AIRM :'
1459 write(0,*) AIRM
1460 write(0,*) 'ALFA0 :'
1461 write(0,*) ALFA0
1462 write(0,*) 'ALFA2 :'
1463 write(0,*) ALFA2
1464 write(0,*) 'ALFA3 :'
1465 write(0,*) ALFA3
1466 write(0,*) 'GAS :'
1467 write(0,*) GAS
1468 write(0,*) 'AEROSOL :'
1469 write(0,*) AEROSOL
1470 write(0,*) 'GASWDEP :'
1471 write(0,*) GASWDEP
1472 write(0,*) 'AERWDEP :'
1473 write(0,*) AERWDEP
1474 write(0,*) 'HPWDEP :'
1475 write(0,*) HPWDEP
1476 write(0,*) ''
1477 return
1478 END IF
1480 !...Make those concentration calculations which can be made outside
1481 !... of the function.
1483 SO2L = SO2H * PSO2F
1484 AC = 10.0**( -BB )
1485 SIV = SO3 + HSO3 + SO2L
1487 !...Calculate final gas phase concentrations of oxidants (atm)
1489 PH2O2F = ( PH2O20 + XL * DS4( 1 ) ) / ( 1.0 + XLH2O2 )
1490 PO3F = ( PO30 + XL * DS4( 2 ) ) / ( 1.0 + XLO3 )
1491 PMHPF = ( PMHP0 + XL * DS4( 4 ) ) / ( 1.0 + XLMHP )
1492 PPAAF = ( PPAA0 + XL * DS4( 5 ) ) / ( 1.0 + XLPAA )
1494 PH2O2F = MAX( PH2O2F, 0.0 )
1495 PO3F = MAX( PO3F, 0.0 )
1496 PMHPF = MAX( PMHPF, 0.0 )
1497 PPAAF = MAX( PPAAF, 0.0 )
1499 !...Calculate liquid phase concentrations of oxidants (moles/liter)
1501 H2O2L = PH2O2F * H2O2H
1502 O3L = PO3F * O3H
1503 MHPL = PMHPF * MHPH
1504 PAAL = PPAAF * PAAH
1505 FOAL = PFOAF * FOAH
1506 NH3L = PNH3F * NH3H
1507 CO2L = PCO2F * CO2H
1508 HCLL = PHCLF * HCLH
1509 HNO3L = PHNO3F * HNO3H
1511 !...compute modal concentrations
1513 SO4COR = SK6 * TS6COR / ( AE * GM2 + SK6 )
1514 HSO4COR = MAX( TS6COR - SO4COR, 0.0 )
1516 TS6ACC = MAX( TS6 - TS6COR, 0.0 )
1517 SO4ACC = MAX( SO4 - SO4COR, 0.0 )
1518 HSO4ACC = MAX( HSO4 - HSO4COR, 0.0 )
1519 NO3ACC = MAX( NO3 - NO3COR, 0.0 )
1520 NAACC = MAX( NA - NACOR, 0.0 )
1521 CLACC = MAX( CL - CLCOR, 0.0 )
1523 !...load the liquid concentration array with current values
1525 LIQUID( LACL ) = AC
1526 LIQUID( LNH4L ) = NH4
1527 LIQUID( LCAL ) = CA
1528 LIQUID( LNAACCL ) = NAACC
1529 LIQUID( LOHL ) = OH
1530 LIQUID( LSO4ACCL ) = SO4ACC
1531 LIQUID( LHSO4ACCL ) = HSO4ACC
1532 LIQUID( LSO3L ) = SO3
1533 LIQUID( LHSO3L ) = HSO3
1534 LIQUID( LSO2L ) = SO2L
1535 LIQUID( LCO3L ) = CO3
1536 LIQUID( LHCO3L ) = HCO3
1537 LIQUID( LCO2L ) = CO2L
1538 LIQUID( LNO3ACCL ) = NO3ACC
1539 LIQUID( LNH3L ) = NH3L
1540 LIQUID( LCLACCL ) = CLACC
1541 LIQUID( LH2O2L ) = H2O2L
1542 LIQUID( LO3L ) = O3L
1543 LIQUID( LFEL ) = FE
1544 LIQUID( LMNL ) = MN
1545 LIQUID( LAL ) = A
1546 LIQUID( LFOAL ) = FOAL
1547 LIQUID( LHCO2L ) = HCO2
1548 LIQUID( LMHPL ) = MHPL
1549 LIQUID( LPAAL ) = PAAL
1550 LIQUID( LHCLL ) = HCLL
1551 LIQUID( LORGAL ) = ORGA
1552 LIQUID( LPRIML ) = PRIM
1553 LIQUID( LMGL ) = MG
1554 LIQUID( LKL ) = K
1555 LIQUID( LBL ) = B
1556 LIQUID( LHNO3L ) = HNO3L
1557 LIQUID( LPRIMCORL ) = PRIMCOR
1558 LIQUID( LNUMCORL ) = NUMCOR
1559 LIQUID( LTS6CORL ) = TS6COR
1560 LIQUID( LNACORL ) = NACOR
1561 LIQUID( LCLCORL ) = CLCOR
1562 LIQUID( LNO3CORL ) = NO3COR
1563 LIQUID( LORGPL ) = ORGP
1564 LIQUID( LORGBL ) = ORGB
1565 LIQUID( LECL ) = EC
1567 !...if the maximum cloud lifetime has not been reached, then compute
1568 !... the next timestep.
1570 IF ( TIMEW .LT. TAUCLD ) THEN
1572 !...make kinetics calculations
1573 !... note: DS4(i) and DSIV(I) are negative numbers!
1575 DTRMV = 300.0
1576 IF ( ( CTHK1 .GT. 1.0E-10 ) .AND. ( PRCRATE .GT. 1.0E-10 ) ) &
1577 DTRMV = 3.6 * WTAVG * 1000.0 * CTHK1 / PRCRATE ! <<<uma found bug, was .36
1578 DTRMV = MIN( DTRMV, 300.0 )
1579 ITERAT = ITERAT + 1
1581 !...Define the total S(iv) available for oxidation
1583 TSIV = PSO20 * ONE_OVER_XL
1585 !...Calculate sulfur iv oxidation rate due to H2O2
1587 !KW DSIVDT( 1 ) = -RH2O2 * H2O2L * SO2L / ( 0.1 + AC )
1588 !KW based on CMAQv5.0
1589 DSIVDT( 1 ) = -RH2O2 * H2O2L * HSO3 * AC / ( 0.1 + 13.0 * AC )
1591 TOTOX = PH2O20 * ONE_OVER_XL
1592 IF ( ( DSIVDT( 1 ) .EQ. 0.0 ) .OR. &
1593 ( TSIV .LE. CONCMIN ) .OR. &
1594 ( TOTOX .LE. CONCMIN ) ) THEN
1595 DTW( 1 ) = DTRMV
1596 ELSE
1597 DTW( 1 ) = -0.05 * MIN( TOTOX, TSIV ) / DSIVDT( 1 )
1598 END IF
1600 !...Calculate sulfur iv oxidation rate due to O3
1602 !KW IF ( BB .GE. 2.7 ) THEN
1603 !KW DSIVDT( 2 ) = -4.19E5 * ( 1.0 + 2.39E-4 / AC ) * O3L * SIV
1604 !KW ELSE
1605 !KW DSIVDT( 2 ) = -1.9E4 * SIV * O3L / SQRT( AC )
1606 !KW END IF
1607 !KW based on CMAQv5.0
1608 DSIVDT( 2 ) = -( 2.4E4 * SO2L + &
1609 3.7E5 * EXP( -18.56 * ( ( 298.0E0 / TEMP ) - 1.0E0 ) ) * HSO3 + &
1610 1.5E9 * EXP( -17.72 * ( ( 298.0E0 / TEMP ) - 1.0E0 ) ) * SO3 ) * O3L
1611 TOTOX = PO30 * ONE_OVER_XL
1612 IF ( ( DSIVDT( 2 ) .EQ. 0.0 ) .OR. &
1613 ( TSIV .LE. CONCMIN ) .OR. &
1614 ( TOTOX .LE. CONCMIN ) ) THEN
1615 DTW( 2 ) = DTRMV
1616 ELSE
1617 DTW( 2 ) = -0.01 * MIN( TOTOX, TSIV ) / DSIVDT( 2 )
1618 END IF
1620 !...Calculate sulfur iv oxidation rate due to 02 catalyzed by Mn++
1621 !... and Fe+++ See Table IV Walcek & Taylor ( 1986)
1623 !KW IF ( BB .GE. 4.0 ) THEN ! 4.0 < pH
1625 ! IF ( SIV .LE. 1.0E-5 ) THEN
1626 ! DSIVDT( 3 ) = -5000.0 * MN * HSO3
1627 ! ELSE IF ( SIV .GT. 1.0E-5 ) THEN
1628 ! DSIVDT( 3 ) = -( 4.7 * MN * MN / AC &
1629 ! + 1.0E7 * FE * SIV * SIV )
1630 ! END IF ! end of first pass through SIV conc.
1632 ! ELSE ! pH , + 4.0
1634 ! IF ( SIV .LE. 1.0E-5 ) THEN
1635 ! DSIVDT( 3 ) = -3.0 * ( 5000.0 * MN * HSO3 &
1636 ! + 0.82 * FE * SIV / AC )
1637 ! ELSE
1638 ! DSIVDT( 3 ) = -( 4.7 * MN * MN / AC &
1639 ! + ( 0.82 * FE * SIV / AC ) &
1640 ! * ( 1.0 + 1.7E3 * MN**1.5 / ( 6.3E-6 + FE ) ) )
1641 ! END IF ! end of second pass through SIV conc.
1643 !KW END IF ! end of pass through pH
1645 !KW based on CMAQv5.0
1646 !...Calculate sulfur iv oxidation rate due to 02 catalyzed by Mn++ and Fe+++
1647 !...(Martin and Goodman, 1991) prescribled 0.01 ug/m3 for FeIII and 0.005 ug/m3 for MnII
1648 DSIVDT( 3 ) = - ( 750.0E0 * MN * SIV + & ! GS 4May2011
1649 2600.0E0 * FE * SIV + & ! GS 4May2011
1650 1.0E10 * MN * FE * SIV ) ! GS 4May2011
1652 IF ( ( DSIVDT( 3 ) .EQ. 0.0 ) .OR. ( TSIV .LE. CONCMIN ) ) THEN
1653 DTW( 3 ) = DTRMV
1654 ELSE
1655 DTW( 3 ) = -0.1 * TSIV / DSIVDT( 3 )
1656 END IF
1658 !...Calculate sulfur oxidation rate due to MHP
1660 DSIVDT( 4 ) = -RMHP * AC * MHPL * HSO3
1661 TOTOX = PMHP0 * ONE_OVER_XL
1662 IF ( ( DSIVDT( 4 ) .EQ. 0.0 ) .OR. &
1663 ( TSIV .LE. CONCMIN ) .OR. &
1664 ( TOTOX .LE. CONCMIN ) ) THEN
1665 DTW( 4 ) = DTRMV
1666 ELSE
1667 DTW( 4 ) = -0.1 * MIN( TOTOX, TSIV ) / DSIVDT( 4 )
1668 END IF
1670 !...Calculate sulfur oxidation due to PAA
1672 !KW DSIVDT( 5 ) = -RPAA * HSO3 * PAAL * ( AC + 1.65E-5 )
1673 !KW based on CMAQv5.0
1674 DSIVDT( 5 ) = -( RPAA * AC + 7.00E2 ) * HSO3 * PAAL
1675 TOTOX = PPAA0 * ONE_OVER_XL
1676 IF ( ( DSIVDT( 5 ) .EQ. 0.0 ) .OR. &
1677 ( TSIV .LE. CONCMIN ) .OR. &
1678 ( TOTOX .LE. CONCMIN ) ) THEN
1679 DTW( 5 ) = DTRMV
1680 ELSE
1681 DTW( 5 ) = -0.1 * MIN( TOTOX, TSIV ) / DSIVDT( 5 )
1682 END IF
1684 !...Calculate total sulfur iv oxidation rate
1686 DSIVDT( 0 ) = 0.0
1687 DO IOX = 1, NUMOX
1688 DSIVDT( 0 ) = DSIVDT( 0 ) + DSIVDT( IOX )
1689 END DO
1691 !...Calculate a minimum time step required
1693 DTW( 0 ) = MIN( DTW( 1 ), DTW( 2 ), DTW( 3 ), &
1694 DTW( 4 ), DTW( 5 ) )
1696 !...check for large time step
1698 IF ( DTW( 0 ) .GT. 8.0E+37 ) THEN
1699 WRITE(6,1001) PRCRATE, DSIVDT(0), TS6, DTW(0), CTHK1, WTAVG
1700 ELSE
1702 !...calculate the change in sulfur iv for this time step
1704 60 DTS6 = ABS( DTW( 0 ) * ( -DSIVDT( 0 ) - TS6 * PRCRATE &
1705 / ( 3600.0 * CTHK1 * WTAVG ) ) )
1707 !...If DSIV(0), sulfur iv oxidized during this time step would be
1708 !... less than 5% of sulfur oxidized since time 0, then double DT
1710 IF ( DTW( 0 ) .LE. TAUCLD ) THEN
1711 IF ( DTS6 .LT. 0.05 * TS6 ) THEN
1712 DTW( 0 ) = DTW( 0 ) * 2.0
1713 GO TO 60
1714 END IF
1715 END IF
1716 END IF
1717 DTW( 0 ) = MIN( DTW( 0 ), DTRMV )
1719 !...Limit the timestep to prevent negative SO2 concentrations and mass creation
1720 !... for sulfate (suggested by Bonyoung Koo)
1722 IF ( DSIVDT( 0 ) .LT. 0.0 ) THEN
1723 DTW( 0 ) = MIN( DTW( 0 ), -TSIV * 1.00001 / DSIVDT( 0 ) )
1724 END IF
1726 !...If the total time after this time increment will be greater than
1727 !... TAUCLD sec., then set DTW(0) so that total time will be TAUCLD
1729 IF ( TIMEW + DTW( 0 ) .GT. TAUCLD ) DTW( 0 ) = TAUCLD - TIMEW
1730 !CC IF ( TS6 .LT. 1.0E-11 ) DTW( 0 ) = TAUCLD - TIMEW
1731 IF ( ITERAT .GT. 100 ) DTW( 0 ) = TAUCLD - TIMEW
1733 !...limit timestep to no more than the washout time
1735 DTW( 0 ) = MIN( DTW( 0 ), TWASH )
1737 !...Set DSIV(I), I = 0,NUMOX, the amount of S(IV) oxidized by each
1738 !... individual oxidizing agent, as well as the total.
1740 DO IOX = 0, NUMOX
1741 DS4( IOX ) = DS4( IOX ) + DTW( 0 ) * DSIVDT( IOX )
1742 END DO
1744 !...Compute depositions and concentrations for each species
1746 WETFAC = PRCRATE * FRACLIQ * DTW( 0 ) * SEC2HR
1747 DO LIQ = 1, NLIQS
1748 WETDEP( LIQ ) = WETDEP( LIQ ) + LIQUID( LIQ ) * WETFAC
1749 END DO
1751 TIMEW = TIMEW + DTW( 0 )
1753 !...Return to make additional calculations
1755 GO TO 20
1756 END IF
1758 !...At this point, TIMEW=TAUCLD
1759 !... compute the scavenging coefficient for SO4 which will be used for
1760 !... scavenging aerosol number in the accumulation mode
1762 DEPSUM = ( WETDEP( LSO4ACCL ) + WETDEP( LHSO4ACCL ) ) * XC1
1764 IF ( ( TS6ACCA + TS6AKNA - DS4( 0 ) ) .NE. 0.0 ) THEN
1765 BETASO4 = DEPSUM / ( ( TS6ACCA + TS6AKNA - DS4( 0 ) ) * TAUCLD )
1766 ELSE
1767 BETASO4 = 0.0
1768 END IF
1770 EBETASO4T = EXP( -BETASO4 * TAUCLD )
1771 EALFA0T = EXP( -ALFA0 * TAUCLD )
1772 EALFA2T = EXP( -ALFA2 * TAUCLD )
1773 EALFA3T = EXP( -ALFA3 * TAUCLD )
1775 !...Compute the output concentrations and wet deposition amounts
1777 TOTAMM = ( PNH3F + ( NH4 + NH3L ) * XL ) * RECIPAP1
1778 TOTNIT = ( PHNO3F + ( NO3ACC + HNO3L ) * XL ) * RECIPAP1
1780 !...gas-phase species wet deposition (mm mol/lit)
1782 GASWDEP( LSO2 ) = WETDEP( LSO3L ) + WETDEP( LHSO3L ) &
1783 + WETDEP( LSO2L )
1784 GASWDEP( LNH3 ) = WETDEP( LNH3L )
1785 GASWDEP( LH2O2 ) = WETDEP( LH2O2L )
1786 GASWDEP( LO3 ) = WETDEP( LO3L )
1787 GASWDEP( LCO2 ) = WETDEP( LCO3L ) + WETDEP( LHCO3L ) &
1788 + WETDEP( LCO2L )
1789 GASWDEP( LFOA ) = WETDEP( LFOAL ) + WETDEP( LHCO2L )
1790 GASWDEP( LMHP ) = WETDEP( LMHPL )
1791 GASWDEP( LPAA ) = WETDEP( LPAAL )
1792 GASWDEP( LHCL ) = WETDEP( LHCLL )
1793 GASWDEP( LHNO3 ) = WETDEP( LHNO3L )
1794 GASWDEP( LN2O5 ) = 0.0
1795 GASWDEP( LH2SO4 ) = 0.0
1797 !...gas concentrations (mol/molV)
1799 GAS( LSO2 ) = ( PSO2F + XL * SIV ) * RECIPAP1
1800 GAS( LH2O2 ) = ( PH2O2F + XL * H2O2L ) * RECIPAP1
1801 GAS( LO3 ) = ( PO3F + XL * O3L ) * RECIPAP1
1802 GAS( LCO2 ) = ( PCO2F + XL * CO2L ) * RECIPAP1
1803 GAS( LFOA ) = ( PFOAF + XL * ( FOAL + HCO2 ) ) * RECIPAP1
1804 GAS( LMHP ) = ( PMHPF + XL * MHPL ) * RECIPAP1
1805 GAS( LPAA ) = ( PPAAF + XL * PAAL ) * RECIPAP1
1806 GAS( LHCL ) = ( PHCLF + XL * HCLL ) * RECIPAP1
1808 GAS( LNH3 ) = FNH3 * TOTAMM
1809 GAS( LHNO3 ) = FHNO3 * TOTNIT
1810 GAS( LN2O5 ) = 0.0 ! assume all into aerosol
1811 GAS( LH2SO4 ) = 0.0 ! assume all into aerosol
1813 !...aerosol species wet deposition (mm mol/lit)
1814 !... there is no wet deposition of aitken particles, they attached
1815 !... to the accumulation mode particles
1817 AERWDEP( LSO4AKN ) = 0.0
1818 AERWDEP( LNH4AKN ) = 0.0
1819 AERWDEP( LNO3AKN ) = 0.0
1820 AERWDEP( LECAKN ) = 0.0
1821 AERWDEP( LPRIAKN ) = 0.0
1823 AERWDEP( LORGAAKN ) = 0.0
1824 AERWDEP( LORGPAKN ) = 0.0
1825 AERWDEP( LORGBAKN ) = 0.0
1827 AERWDEP( LSO4ACC ) = WETDEP( LSO4ACCL ) + WETDEP( LHSO4ACCL )
1828 AERWDEP( LNH4ACC ) = WETDEP( LNH4L )
1829 AERWDEP( LNO3ACC ) = WETDEP( LNO3ACCL )
1830 AERWDEP( LECACC ) = WETDEP( LECL )
1831 AERWDEP( LPRIACC ) = WETDEP( LPRIML )
1833 AERWDEP( LORGAACC ) = WETDEP( LORGAL )
1834 AERWDEP( LORGPACC ) = WETDEP( LORGPL )
1835 AERWDEP( LORGBACC ) = WETDEP( LORGBL )
1837 AERWDEP( LSO4COR ) = WETDEP( LTS6CORL )
1838 AERWDEP( LNO3COR ) = WETDEP( LNO3CORL )
1839 AERWDEP( LPRICOR ) = WETDEP( LPRIMCORL )
1841 IF ( AE_VRSN .EQ. 'AE3' ) THEN
1842 AERWDEP( LNACL ) = WETDEP( LNACORL )
1843 ELSE
1844 AERWDEP( LNAAKN ) = 0.0
1845 AERWDEP( LCLAKN ) = 0.0
1846 AERWDEP( LNAACC ) = WETDEP( LNAACCL )
1847 AERWDEP( LCLACC ) = WETDEP( LCLACCL )
1848 AERWDEP( LNACOR ) = WETDEP( LNACORL )
1849 AERWDEP( LCLCOR ) = WETDEP( LCLCORL )
1850 END IF
1852 AERWDEP( LK ) = WETDEP( LKL )
1853 AERWDEP( LA3FE ) = WETDEP( LFEL )
1854 AERWDEP( LB2MN ) = WETDEP( LMNL )
1855 AERWDEP( LCACO3 ) = WETDEP( LCAL )
1856 AERWDEP( LMGCO3 ) = WETDEP( LMGL )
1858 AERWDEP( LNUMAKN ) = 0.0
1859 AERWDEP( LNUMACC ) = 0.0
1860 AERWDEP( LNUMCOR ) = 0.0
1861 AERWDEP( LSRFAKN ) = 0.0
1862 AERWDEP( LSRFACC ) = 0.0
1864 !...aerosol concentrations (mol/molV)
1866 AEROSOL( LSO4AKN ) = AEROSOL( LSO4AKN ) * EALFA3T
1867 AEROSOL( LNH4AKN ) = AEROSOL( LNH4AKN ) * EALFA3T
1868 AEROSOL( LNO3AKN ) = AEROSOL( LNO3AKN ) * EALFA3T
1869 AEROSOL( LECAKN ) = AEROSOL( LECAKN ) * EALFA3T
1870 AEROSOL( LPRIAKN ) = AEROSOL( LPRIAKN ) * EALFA3T
1872 AEROSOL( LORGAAKN ) = AEROSOL( LORGAAKN ) * EALFA3T
1873 AEROSOL( LORGPAKN ) = AEROSOL( LORGPAKN ) * EALFA3T
1874 AEROSOL( LORGBAKN ) = AEROSOL( LORGBAKN ) * EALFA3T
1876 AEROSOL( LSO4ACC ) = TS6ACC * XL * RECIPAP1
1877 AEROSOL( LECACC ) = EC * XL * RECIPAP1
1878 AEROSOL( LPRIACC ) = PRIM * XL * RECIPAP1
1880 AEROSOL( LORGAACC ) = ORGA * XL * RECIPAP1
1881 AEROSOL( LORGPACC ) = ORGP * XL * RECIPAP1
1882 AEROSOL( LORGBACC ) = ORGB * XL * RECIPAP1
1884 AEROSOL( LNH4ACC ) = FNH4ACC * TOTAMM
1885 AEROSOL( LNO3ACC ) = FNO3ACC * TOTNIT
1887 AEROSOL( LSO4COR ) = TS6COR * XL * RECIPAP1
1888 AEROSOL( LNO3COR ) = NO3COR * XL * RECIPAP1
1889 AEROSOL( LPRICOR ) = PRIMCOR* XL * RECIPAP1
1890 AEROSOL( LK ) = K * XL * RECIPAP1
1891 AEROSOL( LA3FE ) = FE * XL * RECIPAP1
1892 AEROSOL( LB2MN ) = MN * XL * RECIPAP1
1893 AEROSOL( LCACO3 ) = CA * XL * RECIPAP1
1894 AEROSOL( LMGCO3 ) = MG * XL * RECIPAP1
1896 IF ( AE_VRSN .EQ. 'AE3' ) THEN
1897 AEROSOL( LNACL ) = NACOR * XL * RECIPAP1
1898 ELSE
1899 AEROSOL( LNAAKN ) = AEROSOL( LNAAKN ) * EALFA3T
1900 AEROSOL( LCLAKN ) = AEROSOL( LCLAKN ) * EALFA3T
1901 AEROSOL( LNAACC ) = NAACC * XL * RECIPAP1
1902 AEROSOL( LCLACC ) = CLACC * XL * RECIPAP1
1903 AEROSOL( LNACOR ) = NACOR * XL * RECIPAP1
1904 AEROSOL( LCLCOR ) = CLCOR * XL * RECIPAP1
1905 END IF
1907 AEROSOL( LNUMAKN ) = AEROSOL( LNUMAKN ) * EALFA0T
1908 AEROSOL( LNUMACC ) = AEROSOL( LNUMACC ) * EBETASO4T
1909 AEROSOL( LNUMCOR ) = NUMCOR * XL * RECIPAP1
1911 !...compute the final accumulation aerosol 3rd moment
1913 M3NEW = ( AEROSOL( LSO4ACC ) * SGRAERMW( LSO4ACC ) / 1.8e6 &
1914 + AEROSOL( LNH4ACC ) * SGRAERMW( LNH4ACC ) / 1.8e6 &
1915 + AEROSOL( LNO3ACC ) * SGRAERMW( LNO3ACC ) / 1.8e6 &
1916 + AEROSOL( LORGPACC ) * SGRAERMW( LORGPACC ) / 2.0e6 &
1917 + AEROSOL( LECACC ) * SGRAERMW( LECACC ) / 2.2e6 &
1918 + AEROSOL( LPRIACC ) * SGRAERMW( LPRIACC ) / 2.2e6 &
1919 + AEROSOL( LNAACC ) * SGRAERMW( LNAACC ) / 2.2e6 &
1920 + AEROSOL( LCLACC ) * SGRAERMW( LCLACC ) / 2.2e6 )
1921 !CC & * 6.0 / PI ! cancels out in division below
1923 AEROSOL( LSRFAKN ) = AEROSOL( LSRFAKN ) * EALFA2T
1924 AEROSOL( LSRFACC ) = AEROSOL( LSRFACC ) &
1925 * ( EXP( -BETASO4 * TAUCLD * ONETHIRD ) ) &
1926 * ( M3NEW / MAX( M3OLD, CONCMIN) ) ** TWOTHIRDS
1928 !...store the amount of hydrogen deposition
1930 HPWDEP = WETDEP( LACL )
1932 RETURN
1934 !...formats
1936 1001 FORMAT (1X,'STORM RATE=', F6.3, 'DSIVDT(0) =', F10.5, &
1937 'TS6=', F10.5, 'DTW(0)=', F10.5, 'CTHK1=', F10.5, &
1938 'WTAVG=', F10.5)
1940 END SUBROUTINE AQCHEM
1942 INTEGER FUNCTION TRIMLEN ( STRING )
1944 !***********************************************************************
1945 ! function body starts at line 43
1946 !
1947 ! FUNCTION: return the effective length of argument CHARACTER*(*) STRING,
1948 ! after trailing blanks have been trimmed.
1949 !
1950 ! PRECONDITIONS REQUIRED: none
1951 !
1952 ! SUBROUTINES AND FUNCTIONS CALLED: none
1953 !
1954 ! REVISION HISTORY:
1955 ! Prototype 8/91 by CJC
1956 ! Version 2/93 for CRAY by CJC
1957 !
1958 !***********************************************************************
1960 IMPLICIT NONE
1963 !........... ARGUMENTS and their descriptions:
1965 CHARACTER*(*) STRING
1968 !........... SCRATCH LOCAL VARIABLES and their descriptions:
1970 INTEGER L, K
1973 !***********************************************************************
1974 ! begin body of function TRIMLEN
1976 L = LEN( STRING )
1977 DO 11 K = L, 1, -1
1978 IF ( STRING( K:K ) .NE. ' ' ) THEN
1979 GO TO 12
1980 END IF
1981 11 CONTINUE
1983 K = 1
1985 12 CONTINUE
1987 TRIMLEN = K
1989 ! RETURN
1991 END FUNCTION TRIMLEN
1994 !***********************************************************************
1995 ! Portions of Models-3/CMAQ software were developed or based on *
1996 ! information from various groups: Federal Government employees, *
1997 ! contractors working on a United States Government contract, and *
1998 ! non-Federal sources (including research institutions). These *
1999 ! research institutions have given the Government permission to *
2000 ! use, prepare derivative works, and distribute copies of their *
2001 ! work in Models-3/CMAQ to the public and to permit others to do *
2002 ! so. EPA therefore grants similar permissions for use of the *
2003 ! Models-3/CMAQ software, but users are requested to provide copies *
2004 ! of derivative works to the Government without restrictions as to *
2005 ! use by others. Users are responsible for acquiring their own *
2006 ! copies of commercial software associated with Models-3/CMAQ and *
2007 ! for complying with vendor requirements. Software copyrights by *
2008 ! the MCNC Environmental Modeling Center are used with their *
2009 ! permissions subject to the above restrictions. *
2010 !***********************************************************************
2012 ! RCS file, release, date & time of last delta, author, state, [and locker]
2013 ! $Header: /project/work/rep/CCTM/src/cloud/cloud_acm/hlconst.F,v 1.15 2008/05/21 12:34:14 sjr Exp $
2015 ! what(1) key, module and SID; SCCS file; date and time of last delta:
2016 ! %W% %P% %G% %U%
2018 REAL FUNCTION HLCONST ( CNAME, TEMP, EFFECTIVE, HPLUS )
2020 !-----------------------------------------------------------------------
2021 !
2022 ! FUNCTION: return the Henry's law constant for the specified substance
2023 ! at the given temperature
2024 !
2025 ! revision history:
2026 ! who when what
2027 ! --------- -------- -------------------------------------
2028 ! S.Roselle 08/15/97 code written for Models-3
2029 ! J.Gipson 06/18/01 added Henry's Law constants 50-55 for saprc99
2030 ! W.Hutzell 07/03/01 added Henry's Law constants 56-57 for Atrazine
2031 ! and the daughter products from Atrazine and OH
2032 ! reactions.
2033 ! J.Gipson. 09/06/02 added Henry's Law constants 59-73 for toxics
2034 ! S.Roselle 11/07/02 added capability for calculating the effective
2035 ! Henry's law constant and updated coefficients
2036 ! in Henry's law constant table
2037 ! J.Gipson 08/06/03 added Henry's Law constants 77-79
2038 ! G.Sarwar 11/21/04 added constants for chlorine chemistry (Henry's
2039 ! law constants 80-85 and dissociation constants
2040 ! 14-16
2041 ! R.Bullock 07/05/05 added Henry's Law constants 86-87 for mercury
2042 ! with enthalpy calculated from cited laboratory
2043 ! data fit to an Arrhenius equation
2044 ! W.Hutzell 02/14/06 added HLC 88 to 116, dissociation constant for
2045 ! 17 (hydrazine)
2046 ! A.Carlton 09/20/06 updated Henry's Law constants for 1,7,19,20,21,30
2047 ! O3, NO3, hexane, octane, nonane, methanol and
2048 ! isoprene reference
2049 ! S.Roselle 10/10/07 changed pointers to parameters; reformatted
2050 ! variable declarations
2051 !-----------------------------------------------------------------------
2053 IMPLICIT NONE
2055 !...........INCLUDES and their descriptions
2057 ! INCLUDE SUBST_IODECL ! I/O definitions and declarations
2058 ! INCLUDE SUBST_IOPARMS ! I/O parameters definitions
2060 !...........PARAMETERS and their descriptions:
2062 INTEGER, PARAMETER :: MXSPCS = 116 ! Number of substances
2063 INTEGER, PARAMETER :: MXDSPCS = 17 ! Number of dissociating species
2065 !...pointers for the dissociation constants (array B and D)
2067 INTEGER, PARAMETER :: LSO2 = 1 ! SO2
2068 INTEGER, PARAMETER :: LHSO3 = 2 ! HSO3
2069 INTEGER, PARAMETER :: LHNO2 = 3 ! HNO3
2070 INTEGER, PARAMETER :: LHNO3 = 4 ! HNO3
2071 INTEGER, PARAMETER :: LCO2 = 5 ! CO2
2072 INTEGER, PARAMETER :: LHCO3 = 6 ! HCO3
2073 INTEGER, PARAMETER :: LH2O2 = 7 ! H2O2
2074 INTEGER, PARAMETER :: LHCHO = 8 ! HCHO
2075 INTEGER, PARAMETER :: LHCOOH = 9 ! HCOOH
2076 INTEGER, PARAMETER :: LHO2 = 10 ! HO2
2077 INTEGER, PARAMETER :: LNH4OH = 11 ! NH4OH
2078 INTEGER, PARAMETER :: LH2O = 12 ! H2O
2079 INTEGER, PARAMETER :: LATRA = 13 ! Atrazine
2080 INTEGER, PARAMETER :: LCL2 = 14 ! CL2
2081 INTEGER, PARAMETER :: LHOCL = 15 ! HOCL
2082 INTEGER, PARAMETER :: LHCL = 16 ! HCL
2083 INTEGER, PARAMETER :: LHYDRAZINE = 17 ! Hydrazine
2085 !...........ARGUMENTS and their descriptions
2087 CHARACTER*(*) CNAME ! name of substance
2088 REAL TEMP ! temperature (K)
2089 LOGICAL EFFECTIVE ! true=compute the effective henry's law constant
2090 REAL HPLUS ! hydrogen ion concentration (mol/l)
2092 !...........SCRATCH LOCAL VARIABLES and their descriptions:
2094 CHARACTER( 7 ), SAVE :: PNAME = 'HLCONST' ! program name
2095 CHARACTER( 16 ), SAVE :: SUBNAME( MXSPCS ) ! list of substance names
2097 CHARACTER( 120 ) :: XMSG = ' ' ! exit status message string
2099 INTEGER SPC ! species index
2101 REAL HPLUSI ! 1 / HPLUS
2102 REAL HPLUS2I ! 1 / HPLUS**2
2103 REAL CLMINUS ! chlorine ion conc [CL-]
2104 REAL CLMINUSI ! 1 / CLMINUS
2105 REAL TFAC ! (298-T)/(T*298)
2106 REAL AKEQ1 ! temp var for dissociation constant
2107 REAL AKEQ2 ! temp var for dissociation constant
2108 REAL OHION ! OH ion concentration
2109 REAL KH ! temp var for henry's law constant
2111 !...Henry's law constant data taken mostly from Rolf Sanders' Compilation of
2112 !... Henry's Law Constants for Inorganic and Organic Species of Potential
2113 !... Importance in Environment Chemistry 1999
2115 REAL, SAVE :: A( MXSPCS ) ! Henry's law constants at 298.15K (M/atm)
2116 REAL, SAVE :: E( MXSPCS ) ! enthalpy (like activation energy) (K)
2118 !...dissociation constant data taken mostly from 6.A.1 of Seinfeld and Pandis
2119 !... Atmospheric Chemistry and Physics, 1997
2121 REAL, SAVE :: B( MXDSPCS ) ! dissociation constant at 298.15K (M or M2)
2122 REAL, SAVE :: D( MXDSPCS ) ! -dH/R (K)
2124 DATA SUBNAME( 1), A( 1), E( 1) / 'O3 ', 1.14E-02, 2.3E+03 / ! Kosak 1983
2125 DATA SUBNAME( 2), A( 2), E( 2) / 'HO2 ', 4.0E+03, 5.9E+03 / ! Hanson et al. 1992
2126 DATA SUBNAME( 3), A( 3), E( 3) / 'H2O2 ', 8.3E+04, 7.4E+03 / ! O'Sullivan et al. 1996
2127 DATA SUBNAME( 4), A( 4), E( 4) / 'NH3 ', 6.1E+01, 4.2E+03 / ! Clegg and Brimblecombe 1989
2128 DATA SUBNAME( 5), A( 5), E( 5) / 'NO ', 1.9E-03, 1.4E+03 / ! Lide and Frederikse 1995
2129 DATA SUBNAME( 6), A( 6), E( 6) / 'NO2 ', 1.2E-02, 2.5E+03 / ! Chameides 1984
2130 DATA SUBNAME( 7), A( 7), E( 7) / 'NO3 ', 0.6E+00, 0.0E+00 / ! Rudich, Talukdar et al.1996
2131 DATA SUBNAME( 8), A( 8), E( 8) / 'N2O5 ', 1.0E+30, 0.0E+00 / ! "inf" Sander and Crutzen 1996
2132 DATA SUBNAME( 9), A( 9), E( 9) / 'HNO2 ', 5.0E+01, 4.9E+03 / ! Becker et al. 1996
2133 DATA SUBNAME( 10), A( 10), E( 10) / 'HNO3 ', 2.1E+05, 8.7E+03 / ! Leieveld and Crutzen 1991
2134 DATA SUBNAME( 11), A( 11), E( 11) / 'HNO4 ', 1.2E+04, 6.9E+03 / ! Regimbal and Mozurkewich 1997
2135 DATA SUBNAME( 12), A( 12), E( 12) / 'SO2 ', 1.4E+00, 2.9E+03 / ! Linde and Frederikse 1995
2136 DATA SUBNAME( 13), A( 13), E( 13) / 'H2SO4 ', 1.0E+30, 0.0E+00 / ! infinity
2137 DATA SUBNAME( 14), A( 14), E( 14) / 'METHANE ', 1.4E-03, 1.6E+03 / ! Linde and Frederikse 1995
2138 DATA SUBNAME( 15), A( 15), E( 15) / 'ETHANE ', 1.9E-03, 2.3E+03 / ! Linde and Frederikse 1995
2139 DATA SUBNAME( 16), A( 16), E( 16) / 'PROPANE ', 1.5E-03, 2.7E+03 / ! Linde and Frederikse 1995
2140 DATA SUBNAME( 17), A( 17), E( 17) / 'BUTANE ', 1.1E-03, 0.0E+00 / ! Mackay and Shiu 1981
2141 DATA SUBNAME( 18), A( 18), E( 18) / 'PENTANE ', 8.1E-04, 0.0E+00 / ! Mackay and Shiu 1981
2142 DATA SUBNAME( 19), A( 19), E( 19) / 'HEXANE ', 0.1E-03, 7.5E+03 / ! Ashworth, Howe et al 1988
2143 DATA SUBNAME( 20), A( 20), E( 20) / 'OCTANE ', 2.9E-03, 7.8E+03 / ! Hansen et al. 1993
2144 DATA SUBNAME( 21), A( 21), E( 21) / 'NONANE ', 2.4E-03, 2.1E+02 / ! Ashworth, Howe et al 1988
2145 DATA SUBNAME( 22), A( 22), E( 22) / 'DECANE ', 1.4E-04, 0.0E+00 / ! Mackay and Shiu 1981
2146 DATA SUBNAME( 23), A( 23), E( 23) / 'ETHENE ', 4.7E-03, 0.0E+00 / ! Mackay and Shiu 1981
2147 DATA SUBNAME( 24), A( 24), E( 24) / 'PROPENE ', 4.8E-03, 0.0E+00 / ! Mackay and Shiu 1981
2148 DATA SUBNAME( 25), A( 25), E( 25) / 'ISOPRENE ', 2.8E-02, 0.0E+00 / ! Karl, Lindinger et al 2003
2149 DATA SUBNAME( 26), A( 26), E( 26) / 'ACETYLENE ', 4.1E-02, 1.8E+03 / ! Wilhelm et al. 1977
2150 DATA SUBNAME( 27), A( 27), E( 27) / 'BENZENE ', 1.6E-01, 4.1E+03 / ! Staudinger and Roberts 1996
2151 DATA SUBNAME( 28), A( 28), E( 28) / 'TOLUENE ', 1.5E-01, 4.0E+03 / ! Staudinger and Roberts 1996
2152 DATA SUBNAME( 29), A( 29), E( 29) / 'O-XYLENE ', 1.9E-01, 4.0E+03 / ! Staudinger and Roberts 1996
2153 DATA SUBNAME( 30), A( 30), E( 30) / 'METHANOL ', 2.2E+02, 5.2E+03 / ! Snider and Dawson 1985
2154 DATA SUBNAME( 31), A( 31), E( 31) / 'ETHANOL ', 1.9E+02, 6.6E+03 / ! Snider and Dawson 1985
2155 DATA SUBNAME( 32), A( 32), E( 32) / '2-CRESOL ', 8.2E+02, 0.0E+00 / ! Betterton 1992
2156 DATA SUBNAME( 33), A( 33), E( 33) / '4-CRESOL ', 1.3E+02, 0.0E+00 / ! Betterton 1992
2157 DATA SUBNAME( 34), A( 34), E( 34) / 'METHYLHYDROPEROX', 3.1E+02, 5.2E+03 / ! O'Sullivan et al. 1996
2158 DATA SUBNAME( 35), A( 35), E( 35) / 'FORMALDEHYDE ', 3.2E+03, 6.8E+03 / ! Staudinger and Roberts 1996
2159 DATA SUBNAME( 36), A( 36), E( 36) / 'ACETALDEHYDE ', 1.4E+01, 5.6E+03 / ! Staudinger and Roberts 1996
2160 DATA SUBNAME( 37), A( 37), E( 37) / 'GENERIC_ALDEHYDE', 4.2E+03, 0.0E+00 / ! Graedel and Goldberg 1983
2161 DATA SUBNAME( 38), A( 38), E( 38) / 'GLYOXAL ', 3.6E+05, 0.0E+00 / ! Zhou and Mopper 1990
2162 DATA SUBNAME( 39), A( 39), E( 39) / 'ACETONE ', 3.0E+01, 4.6E+03 / ! Staudinger and Roberts 1996
2163 DATA SUBNAME( 40), A( 40), E( 40) / 'FORMIC_ACID ', 8.9E+03, 6.1E+03 / ! Johnson et al. 1996
2164 DATA SUBNAME( 41), A( 41), E( 41) / 'ACETIC_ACID ', 4.1E+03, 6.3E+03 / ! Johnson et al. 1996
2165 DATA SUBNAME( 42), A( 42), E( 42) / 'METHYL_GLYOXAL ', 3.2E+04, 0.0E+00 / ! Zhou and Mopper 1990
2166 DATA SUBNAME( 43), A( 43), E( 43) / 'CO ', 9.9E-04, 1.3E+03 / ! Linde and Frederikse 1995
2167 DATA SUBNAME( 44), A( 44), E( 44) / 'CO2 ', 3.6E-02, 2.2E+03 / ! Zheng et al. 1997
2168 DATA SUBNAME( 45), A( 45), E( 45) / 'PAN ', 2.8E+00, 6.5E+03 / ! Kames et al. 1991
2169 DATA SUBNAME( 46), A( 46), E( 46) / 'MPAN ', 1.7E+00, 0.0E+00 / ! Kames and Schurath 1995
2170 DATA SUBNAME( 47), A( 47), E( 47) / 'OH ', 3.0E+01, 4.5E+03 / ! Hanson et al. 1992
2171 DATA SUBNAME( 48), A( 48), E( 48) / 'METHYLPEROXY_RAD', 2.0E+03, 6.6E+03 / ! Lelieveld and Crutzen 1991
2172 DATA SUBNAME( 49), A( 49), E( 49) / 'PEROXYACETIC_ACI', 8.4E+02, 5.3E+03 / ! O'Sullivan et al. 1996
2173 DATA SUBNAME( 50), A( 50), E( 50) / 'PROPANOIC_ACID ', 5.7E+03, 0.0E+00 / ! Kahn et al. 1995
2174 DATA SUBNAME( 51), A( 51), E( 51) / '2-NITROPHENOL ', 7.0E+01, 4.6E+03 / ! USEPA 1982
2175 DATA SUBNAME( 52), A( 52), E( 52) / 'PHENOL ', 1.9E+03, 7.3E+03 / ! USEPA 1982
2176 DATA SUBNAME( 53), A( 53), E( 53) / 'BIACETYL ', 7.4E+01, 5.7E+03 / ! Betteron 1991
2177 DATA SUBNAME( 54), A( 54), E( 54) / 'BENZALDEHYDE ', 3.9E+01, 4.8E+03 / ! Staudinger and Roberts 1996
2178 DATA SUBNAME( 55), A( 55), E( 55) / 'PINENE ', 4.9E-02, 0.0E+00 / ! Karl and Lindinger 1997
2179 DATA SUBNAME( 56), A( 56), E( 56) / 'ATRA ', 4.1E+05, 6.0E+03 / ! CIBA Corp (1989) and Scholtz (1999)
2180 DATA SUBNAME( 57), A( 57), E( 57) / 'DATRA ', 4.1E+05, 6.0E+03 / ! assumed same as Atrazine
2181 DATA SUBNAME( 58), A( 58), E( 58) / 'ADIPIC_ACID ', 2.0E+08, 0.0E+00 / ! Saxena and Hildemann (1996)
2182 DATA SUBNAME( 59), A( 59), E( 59) / 'ACROLEIN ', 8.2E+00, 0.0E+00 / ! Meylan and Howard (1991)
2183 DATA SUBNAME( 60), A( 60), E( 60) / '1,3-BUTADIENE ', 1.4E-02, 0.0E+00 / ! Mackay and Shiu (1981)
2184 DATA SUBNAME( 61), A( 61), E( 61) / 'ACRYLONITRILE ', 7.3E+00, 0.0E+00 / ! Meylan and Howard (1991)
2185 DATA SUBNAME( 62), A( 62), E( 62) / 'CARBONTETRACHLOR', 3.4E-02, 4.2E+03 / ! Staudinger and Roberts (1996)
2186 DATA SUBNAME( 63), A( 63), E( 63) / 'PROPYLENE_DICHLO', 3.4E-01, 4.3E+03 / ! Staudinger and Roberts (1996)
2187 DATA SUBNAME( 64), A( 64), E( 64) / '1,3DICHLORPROPEN', 6.5E-01, 4.2E+03 / ! Wright et al (1992b)
2188 DATA SUBNAME( 65), A( 65), E( 65) / '1,1,2,2-CL4ETHAN', 2.4E+00, 3.2E+03 / ! Staudinger and Roberts (1996)
2189 DATA SUBNAME( 66), A( 66), E( 66) / 'CHLOROFORM ', 2.5E-01, 4.5E+03 / ! Staudinger and Roberts (1996)
2190 DATA SUBNAME( 67), A( 67), E( 67) / '1,2DIBROMOETHANE', 1.5E+00, 3.9E+03 / ! Ashworth et al (1988)
2191 DATA SUBNAME( 68), A( 68), E( 68) / '1,2DICHLOROETHAN', 7.3E-01, 4.2E+03 / ! Staudinger and Roberts (1996)
2192 DATA SUBNAME( 69), A( 69), E( 69) / 'METHYLENE_CHLORI', 3.6E-01, 4.1E+03 / ! Staudinger and Roberts (1996)
2193 DATA SUBNAME( 70), A( 70), E( 70) / 'PERCHLOROETHYLEN', 5.9E-02, 4.8E+03 / ! Staudinger and Roberts (1996)
2194 DATA SUBNAME( 71), A( 71), E( 71) / 'TRICHLOROETHENE ', 1.0E-01, 4.6E+03 / ! Staudinger and Roberts (1996)
2195 DATA SUBNAME( 72), A( 72), E( 72) / 'VINYL_CHLORIDE ', 3.9E-02, 3.1E+03 / ! Staudinger and Roberts (1996)
2196 DATA SUBNAME( 73), A( 73), E( 73) / 'ETHYLENE_OXIDE ', 8.4E+00, 0.0E+00 / ! CRC
2197 DATA SUBNAME( 74), A( 74), E( 74) / 'PPN ', 2.9E+00, 0.0E+00 / ! Kames and Schurath (1995)
2198 DATA SUBNAME( 75), A( 75), E( 75) / 'NAPHTHALENE ', 2.0E+00, 3.6E+03 / ! USEPA 1982
2199 DATA SUBNAME( 76), A( 76), E( 76) / 'QUINOLINE ', 3.7E+03, 5.4E+03 / ! USEPA 1982
2200 DATA SUBNAME( 77), A( 77), E( 77) / 'MEK ', 2.0E+01, 5.0E+03 / ! Zhou and Mopper 1990
2201 DATA SUBNAME( 78), A( 78), E( 78) / 'MVK ', 4.1E+01, 0.0E+00 / ! Iraci et al. 1998
2202 DATA SUBNAME( 79), A( 79), E( 79) / 'METHACROLEIN ', 6.5E+00, 0.0E+00 / ! Iraci et al. 1998
2203 DATA SUBNAME( 80), A( 80), E( 80) / 'CL2 ', 8.6E-02, 2.0E+03 / ! ROLF SANDERS COMPILATION (1999)/KAVANAUGH AND TRUSSELL (1980)
2204 DATA SUBNAME( 81), A( 81), E( 81) / 'HOCL ', 6.6E+02, 5.9E+03 / ! ROLF SANDERS COMPILATION (1999)/HUTHWELKER ET AL (1995)
2205 DATA SUBNAME( 82), A( 82), E( 82) / 'HCL ', 1.9E+01, 6.0E+02 / ! ROLF SANDERS COMPILATION (1999)/DEAN (1992)
2206 DATA SUBNAME( 83), A( 83), E( 83) / 'FMCL ', 1.1E+00, 0.0E+00 / ! EPA SUITE PROGRAM/UNIT CONVERTED TO MATCH THE DEFINITION BY ROLF SANDERS.
2207 DATA SUBNAME( 84), A( 84), E( 84) / 'ICL1 ', 6.9E+01, 0.0E+00 / ! EPA SUITE PROGRAM/UNIT CONVERTED TO MATCH THE DEFINITION BY ROLF SANDERS.
2208 DATA SUBNAME( 85), A( 85), E( 85) / 'ICL2 ', 6.9E+01, 0.0E+00 / ! EPA SUITE PROGRAM/ASSUMED EQUAL TO THAT OF ICL1
2209 DATA SUBNAME( 86), A( 86), E( 86) / 'HG ', 1.11E-01, 4.97E+03 /! Elemental Mercury from Clever et al. (1985)
2210 DATA SUBNAME( 87), A( 87), E( 87) / 'HGIIGAS ', 1.41E+06, 5.26E+03 /! Hg(II) gas as mercuric chloride from Lindqvist and Rodhe (1985)
2211 DATA SUBNAME( 88), A( 88), E( 88) / 'TECDD_2378 ', 5.1E+00, 3.6E+03 / ! Paasivirta et al. (1999)
2212 DATA SUBNAME( 89), A( 89), E( 89) / 'PECDD_12378 ', 4.6E+00, 3.2E+03 / ! Paasivirta et al. (1999)
2213 DATA SUBNAME( 90), A( 90), E( 90) / 'HXCDD_123478 ', 8.1E+00, 2.9E+03 / ! Paasivirta et al. (1999)
2214 DATA SUBNAME( 91), A( 91), E( 91) / 'HXCDD_123678 ', 2.9E+00, 2.8E+03 / ! Paasivirta et al. (1999)
2215 DATA SUBNAME( 92), A( 92), E( 92) / 'HXCDD_123789 ', 6.5E+00, 2.7E+03 / ! Paasivirta et al. (1999)
2216 DATA SUBNAME( 93), A( 93), E( 93) / 'HPCDD_1234678 ', 1.2E+01, 2.4E+03 / ! Paasivirta et al. (1999)
2217 DATA SUBNAME( 94), A( 94), E( 94) / 'OTCDD ', 9.8E+00, 2.3E+03 / ! Paasivirta et al. (1999)
2218 DATA SUBNAME( 95), A( 95), E( 95) / 'TECDF_2378 ', 8.5E+01, 3.7E+03 / ! Paasivirta et al. (1999)
2219 DATA SUBNAME( 96), A( 96), E( 96) / 'PECDF_12378 ', 5.2E+01, 2.9E+03 / ! Paasivirta et al. (1999)
2220 DATA SUBNAME( 97), A( 97), E( 97) / 'PECDF_23478 ', 1.8E+02, 3.0E+03 / ! Paasivirta et al. (1999)
2221 DATA SUBNAME( 98), A( 98), E( 98) / 'HXCDF_123478 ', 3.8E+01, 2.4E+03 / ! Paasivirta et al. (1999)
2222 DATA SUBNAME( 99), A( 99), E( 99) / 'HXCDF_123678 ', 9.0E+01, 2.9E+03 / ! Paasivirta et al. (1999)
2223 DATA SUBNAME(100), A(100), E(100) / 'HXCDF_234678 ', 1.0E+02, 2.6E+03 / ! Paasivirta et al. (1999)
2224 DATA SUBNAME(101), A(101), E(101) / 'HXCDF_123789 ', 5.6E+01, 2.6E+03 / ! Paasivirta et al. (1999)
2225 DATA SUBNAME(102), A(102), E(102) / 'HPCDF_1234678 ', 2.8E+01, 1.6E+03 / ! Paasivirta et al. (1999)
2226 DATA SUBNAME(103), A(103), E(103) / 'HPCDF_1234789 ', 8.0E+01, 2.1E+03 / ! Paasivirta et al. (1999)
2227 DATA SUBNAME(104), A(104), E(104) / 'OTCDF ', 7.6E+01, 2.4E+03 / ! Paasivirta et al. (1999)
2228 DATA SUBNAME(105), A(105), E(105) / 'NAPHTHOL ', 3.60E+03, 0.0E+00 / ! Eabraham et al. (1994)
2229 DATA SUBNAME(106), A(106), E(106) / '1NITRONAPHTHALEN', 5.68E+02, 0.0E+00 / ! Altschuh et al. (1999)
2230 DATA SUBNAME(107), A(107), E(107) / '2NITRONAPHTHALEN', 6.42E+02, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991)
2231 DATA SUBNAME(108), A(108), E(108) / '14NAPHTHOQUINONE', 5.08E+05, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991)
2232 DATA SUBNAME(109), A(109), E(109) / '2,4-TOLUENE_DIIS', 7.25E+00, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991)
2233 DATA SUBNAME(110), A(110), E(110) / 'HEXAMETHYLE_DIIS', 2.08E+01, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991)
2234 DATA SUBNAME(111), A(111), E(111) / 'HYDRAZINE ', 1.14E+03, 0.0E+00 / ! Daubert and Danner (1989), and Amoore and Hautala (1983)
2235 DATA SUBNAME(112), A(112), E(112) / 'MALEIC_ANHYDRIDE', 2.54E+02, 0.0E+00 / ! HENRYWIN v3.10 (Meylan and Howard, 1991)
2236 DATA SUBNAME(113), A(113), E(113) / 'TRIETHYLAMINE ', 6.71E+00, 0.0E+00 / ! Yalkowsky and Dannenfelser (1992), and Riddick et al. (1986)
2237 DATA SUBNAME(114), A(114), E(114) / 'P_DICHLOROBENZEN', 2.38E+00, 0.0E+00 / ! MacKay and Shiu (1981), measured
2238 DATA SUBNAME(115), A(115), E(115) / 'M-XYLENE ', 1.43E-01, 3.9E+03 / ! Staudinger and Roberts (2001)
2239 DATA SUBNAME(116), A(116), E(116) / 'P-XYLENE ', 1.35E-01, 3.7E+03 / ! Staudinger and Roberts (2001)
2241 DATA B( LSO2 ), D( LSO2 ) / 1.30E-02, 1.96E+03 / ! SO2*H2O<=>HSO3+H : Smith and Martell (1976)
2242 DATA B( LHSO3 ), D( LHSO3 ) / 6.60E-08, 1.50E+03 / ! HSO3<=>SO3+H : Smith and Martell (1976)
2243 DATA B( LHNO2 ), D( LHNO2 ) / 5.10E-04, -1.26E+03 / ! HNO2(aq)<=>NO2+H : Schwartz and White (1981)
2244 DATA B( LHNO3 ), D( LHNO3 ) / 1.54E+01, 8.70E+03 / ! HNO3(aq)<=>NO3+H : Schwartz (1984)
2245 DATA B( LCO2 ), D( LCO2 ) / 4.30E-07, -1.00E+03 / ! CO2*H2O<=>HCO3+H : Smith and Martell (1976)
2246 DATA B( LHCO3 ), D( LHCO3 ) / 4.68E-11, -1.76E+03 / ! HCO3<=>CO3+H : Smith and Martell (1976)
2247 DATA B( LH2O2 ), D( LH2O2 ) / 2.20E-12, -3.73E+03 / ! H2O2(aq)<=>HO2+H : Smith and Martell (1976)
2248 DATA B( LHCHO ), D( LHCHO ) / 2.53E+03, 4.02E+03 / ! HCHO(aq)<=>H2C(OH)2 : Le Hanaf (1968)
2249 DATA B( LHCOOH ), D( LHCOOH ) / 1.80E-04, -2.00E+01 / ! HCOOH(aq)<=>HCOO+H : Martell and Smith (1977)
2250 DATA B( LHO2 ), D( LHO2 ) / 3.50E-05, 0.00E+00 / ! HO2(aq)<=>H+O2 : Perrin (1982)
2251 DATA B( LNH4OH ), D( LNH4OH ) / 1.70E-05, -4.50E+02 / ! NH4*OH<=>NH4+OH : Smith and Martell (1976)
2252 DATA B( LH2O ), D( LH2O ) / 1.00E-14, -6.71E+03 / ! H2O<=>H+OH : Smith and Martell (1976)
2253 DATA B( LATRA ), D( LATRA ) / 2.09E-02, 0.00E+00 / ! C8H14ClN5<=>C8H13ClN5+H : Weber (1970)
2254 DATA B( LCL2 ), D( LCL2 ) / 5.01E-04, 0.00E+00 / ! CL2*H2O <=> HOCL + H + CL : LIN AND PEHKONEN, JGR, 103, D21, 28093-28102, NOVEMBER 20, 1998. ALSO SEE NOTE BELOW
2255 DATA B( LHOCL ), D( LHOCL ) / 3.16E-08, 0.00E+00 / ! HOCL <=>H + OCL : LIN AND PEHKONEN, JGR, 103, D21, 28093-28102, NOVEMBER 20, 1998
2256 DATA B( LHCL ), D( LHCL ) / 1.74E+06, 6.90E+03 / ! HCL <=> H + CL : Marsh and McElroy (1985)
2257 DATA B( LHYDRAZINE), D( LHYDRAZINE) / 1.11E-08, 0.00E+00 / ! HYDRAZINE <=> HYDRAZINE+ + OH- : Moliner and Street (1989)
2258 !-------------------------------------------------------------------------------
2259 ! Note for dissociation constant for equation 14: CL2*H2O <=> HOCL + H + CL
2260 ! Need aqueous [CL-] concentration to calculate effective henry's law coefficient
2261 ! Used a value of 2.0 mM following Lin and Pehkonen, JGR, 103, D21, 28093-28102, November 20, 1998
2262 !-------------------------------------------------------------------------------
2264 !...........EXTERNAL FUNCTIONS and their descriptions:
2266 ! INTEGER, EXTERNAL :: INDEX1 ! array position for string matching
2267 ! INTEGER, EXTERNAL :: TRIMLEN ! string length, excl. trailing blanks
2269 !-----------------------------------------------------------------------
2270 ! begin body of subroutine HLCONST
2272 SPC = INDEX1( CNAME, MXSPCS, SUBNAME )
2274 !...error if species not found in table
2276 IF ( SPC .LE. 0 ) THEN
2277 XMSG = CNAME( 1:TRIMLEN( CNAME ) ) // ' not found in Henry''s Law Constant table, aborting.'
2278 ! CALL M3EXIT ( PNAME, 0, 0, XMSG, XSTAT2 )
2279 write(0,*) ''
2280 write(0,*) PNAME,' : ',XMSG
2281 stop
2282 END IF
2284 !...compute the Henry's Law Constant
2286 TFAC = ( 298.0 - TEMP) / ( 298.0 * TEMP )
2287 KH = A( SPC ) * EXP( E( SPC ) * TFAC )
2288 HLCONST = KH
2290 !...compute the effective Henry's law constants
2292 IF ( EFFECTIVE ) THEN
2294 IF ( HPLUS .LE. 0.0 ) THEN
2295 XMSG = 'Negative or Zero [H+] concentration specified, aborting.'
2296 ! CALL M3EXIT ( PNAME, JDATE, JTIME, XMSG, XSTAT2 )
2297 write(0,*) ''
2298 write(0,*) PNAME,' : ',XMSG
2299 stop
2300 END IF
2302 HPLUSI = 1.0 / HPLUS
2303 HPLUS2I = HPLUSI * HPLUSI
2305 !...assign a value for clminus. use 2.0 mM based on Lin and Pehkonene, 1998, JGR
2307 CLMINUS = 2.0E-03 ! chlorine ion conc [CL-]
2308 CLMINUSI = 1.0 / CLMINUS ! 1 / CLMINUS
2310 CHECK_NAME: SELECT CASE ( CNAME( 1:TRIMLEN( CNAME ) ) )
2312 CASE ('SO2') ! SO2H2O <=> HSO3- + H+
2313 ! & HSO3- <=> SO3= + H+
2315 AKEQ1 = B( LSO2 ) * EXP( D( LSO2 ) * TFAC )
2316 AKEQ2 = B( LHSO3 ) * EXP( D( LHSO3 ) * TFAC )
2317 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I )
2319 CASE ('HNO2') ! HNO2(aq) <=> NO2- + H+
2321 AKEQ1 = B( LHNO2 ) * EXP( D( LHNO2 ) * TFAC )
2322 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2324 CASE ('HNO3') ! HNO3(aq) <=> NO3- + H+
2326 AKEQ1 = B( LHNO3 ) * EXP( D( LHNO3 ) * TFAC )
2327 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2329 CASE ('CO2') ! CO2H2O <=> HCO3- + H+
2330 ! & HCO3- <=> CO3= + H+
2332 AKEQ1 = B( LCO2 ) * EXP( D( LCO2 ) * TFAC )
2333 AKEQ2 = B( LHCO3 ) * EXP( D( LHCO3 ) * TFAC )
2334 HLCONST = KH &
2335 * ( 1.0 + AKEQ1 * HPLUSI + AKEQ1 * AKEQ2 * HPLUS2I )
2337 CASE ('H2O2') ! H2O2(aq) <=> HO2- + H+
2339 AKEQ1 = B( LH2O2 ) * EXP( D( LH2O2 ) * TFAC )
2340 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2342 CASE ('FORMALDEHYDE') ! HCHO(aq) <=> H2C(OH)2(aq)
2344 AKEQ1 = B( LHCHO ) * EXP( D( LHCHO ) * TFAC )
2345 HLCONST = KH * ( 1.0 + AKEQ1 )
2347 CASE ('FORMIC_ACID') ! HCOOH(aq) <=> HCOO- + H+
2349 AKEQ1 = B( LHCOOH ) * EXP( D( LHCOOH ) * TFAC )
2350 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2352 CASE ('HO2') ! HO2(aq) <=> H+ + O2-
2354 AKEQ1 = B( LHO2 ) * EXP( D( LHO2 ) * TFAC )
2355 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2357 CASE ('NH3') ! NH4OH <=> NH4+ + OH-
2359 AKEQ1 = B( LNH4OH ) * EXP( D( LNH4OH ) * TFAC )
2360 AKEQ2 = B( LH2O ) * EXP( D( LH2O ) * TFAC )
2361 OHION = AKEQ2 * HPLUSI
2362 HLCONST = KH * ( 1.0 + AKEQ1 / OHION )
2364 CASE ('HYDRAZINE') ! HYDRAZINE <=> HYDRAZINE+ + OH-
2366 AKEQ1 = B( LHYDRAZINE ) * EXP( D( LHYDRAZINE ) * TFAC )
2367 AKEQ2 = B( LH2O ) * EXP( D( LH2O ) * TFAC )
2368 OHION = AKEQ2 * HPLUSI
2369 HLCONST = KH * ( 1.0 + AKEQ1 / OHION )
2371 CASE ('ATRA', 'DATRA') ! ATRA(aq) <=> ATRA- + H
2372 ! or DATRA(aq) <=> DATRA- + H
2374 AKEQ1 = B( LATRA ) * EXP( D( LATRA ) * TFAC )
2375 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2377 CASE ( 'CL2' ) ! CL2*H2O <=> HOCL + H + CL
2378 ! HOCL <=>H + OCL
2380 AKEQ1 = B( LCL2 ) * EXP( D( LCL2 ) * TFAC )
2381 AKEQ2 = B( LHOCL ) * EXP( D( LHOCL ) * TFAC )
2382 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI * CLMINUSI &
2383 + AKEQ1 * AKEQ2 * HPLUS2I * CLMINUSI )
2385 CASE ( 'HCL' ) ! HCL <=> H+ + CL-
2387 AKEQ1 = B( LHCL ) * EXP( D( LHCL ) * TFAC )
2388 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2390 CASE ( 'HOCL' ) ! HOCL <=> H+ + OCL-
2392 AKEQ1 = B( LHOCL ) * EXP( D( LHOCL ) * TFAC )
2393 HLCONST = KH * ( 1.0 + AKEQ1 * HPLUSI )
2395 END SELECT CHECK_NAME
2397 END IF
2399 RETURN
2400 END FUNCTION HLCONST
2402 !.........................................................................
2403 ! Version "@(#)$Header: /env/proj/archive/cvs/ioapi/./ioapi/src/index1.f,v 1.2 2000/11/28 21:22:49 smith_w Exp $"
2404 ! EDSS/Models-3 I/O API. Copyright (C) 1992-1999 MCNC
2405 ! Distributed under the GNU LESSER GENERAL PUBLIC LICENSE version 2.1
2406 ! See file "LGPL.txt" for conditions of use.
2407 !.........................................................................
2409 INTEGER FUNCTION INDEX1 (NAME, N, NLIST)
2411 !***********************************************************************
2412 ! subroutine body starts at line 46
2413 !
2414 ! FUNCTION:
2415 !
2416 ! Searches for NAME in list NLIST and returns the subscript
2417 ! (1...N) at which it is found, or returns 0 when NAME not
2418 ! found in NLIST
2419 !
2420 ! PRECONDITIONS REQUIRED: none
2421 !
2422 ! SUBROUTINES AND FUNCTIONS CALLED: none
2423 !
2424 ! REVISION HISTORY:
2425 !
2426 ! 5/88 Modified for ROMNET
2427 ! 9/94 Modified for Models-3 by CJC
2428 !
2429 !***********************************************************************
2431 IMPLICIT NONE
2433 !....... Arguments and their descriptions:
2435 CHARACTER*(*) NAME ! Character string being searched for
2436 INTEGER N ! Length of array to be searched
2437 CHARACTER*(*) NLIST(*) ! array to be searched
2439 !....... Local variable:
2441 INTEGER I ! loop counter
2443 !.....................................................................
2444 !....... begin body of INDEX1()
2446 DO 100 I = 1, N
2448 IF ( NAME .EQ. NLIST( I ) ) THEN ! Found NAME in NLIST
2449 INDEX1 = I
2450 RETURN
2451 ENDIF
2453 100 CONTINUE
2455 INDEX1 = 0 ! not found
2456 RETURN
2458 END FUNCTION INDEX1
2459 #endif
2460 END MODULE module_ctrans_aqchem