module_mosaic_therm.F
References to this file elsewhere.
1 !**********************************************************************************
2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
6 !
7 ! MOSAIC module: see module_mosaic_driver.F for information and terms of use
8 !**********************************************************************************
9 module module_mosaic_therm
10
11
12
13 use module_data_mosaic_therm
14 use module_peg_util
15
16
17
18 implicit none
19
20
21
22 contains
23
24
25
26 ! zz01aerchemistry.f (mosaic.14.3)
27 ! 28-apr-05 raz - reversed calls to form_cacl2 and form_nacl
28 ! fixed caco3 error in subr. electrolytes_to_ions
29 ! renamed dens_aer to dens_aer_mac; mw_aer to mw_aer_mac
30 ! 27-apr-05 raz - updated dry_mass calculation approach in mesa_convergence
31 ! 22-apr-05 raz - fixed caso4 mass balance problem and updated algorithm to
32 ! calculate phi_volatile for nh3, hno3, and hcl.
33 ! 20-apr-05 raz - updated asceem
34 ! 19-apr-05 raz - updated the algorithm to constrain the nh4 concentration
35 ! during simultaneous nh3, hno3, and hcl integration such
36 ! that it does not exceed the max possible value for a given bin
37 ! 14-apr-05 raz - fixed asteem_flux_wet_case3 and asteem_flux_dry_case3c
38 ! 11-jan-05 raz - major updates to many subroutines
39 ! 18-nov-04 rce - make sure that acos argument is between +/-1.0
40 ! 28-jan-04 rce - added subr aerchem_boxtest_output;
41 ! eliminated some unnecessary "include v33com-"
42 ! 01-dec-03 rce - added "implicit none" to many routines;
43 ! eliminated some unnecessary "include v33com-"
44 ! 05-oct-03 raz - added hysteresis treatment
45 ! 02-sep-03 raz - implemented asteem
46 ! 10-jul-03 raz - changed ix to ixd in interp. subrs fast*_up and fast*_lo
47 ! 08-jul-03 raz - implemented asteem (adaptive step time-split
48 ! explicit euler method)
49 ! 26-jun-03 raz - updated almost all the subrs. this version contains
50 ! options for rigorous and fast solvers (including lsode solver)
51 !
52 ! 07-oct-02 raz - made zx and zm integers in activity coeff subs.
53 ! 16-sep-02 raz - updated many subrs to treat calcium salts
54 ! 19-aug-02 raz - inlcude v33com9a in subr aerosolmtc
55 ! 14-aug-02 rce - "(msectional.eq.0)" changed to "(msectional.le.0)"
56 ! 07-aug-02 rce - this is rahul's latest version from freshair
57 ! after adding "real mean_molecular_speed" wherever it is used
58 ! 01-apr-02 raz - made final tests and gave the code to jerome
59 !
60 ! 04--14-dec-01 rce - several minor changes during initial testing/debug
61 ! in 3d los angeles simulation
62 ! (see earlier versions for details about these changes)
63 !-----------------------------------------------------------------------
64 !23456789012345678901234567890123456789012345678901234567890123456789012
65
66 !***********************************************************************
67 ! interface to mosaic
68 !
69 ! author: rahul a. zaveri
70 ! update: jan 2005
71 !-----------------------------------------------------------------------
72 subroutine aerchemistry( iclm, jclm, kclm_calcbgn, kclm_calcend, &
73 dtchem, idiagaa )
74
75 use module_data_mosaic_asect
76 use module_data_mosaic_other
77 use module_mosaic_movesect, only: move_sections
78
79 ! implicit none
80 ! include 'v33com'
81 ! include 'v33com2'
82 ! include 'v33com3'
83 ! include 'mosaic.h'
84 ! subr arguments
85 integer iclm, jclm, kclm_calcbgn, kclm_calcend, idiagaa
86 real dtchem
87 ! local variables
88 integer istat_mosaic, k, m
89
90
91
92
93
94 lunerr_aer = lunerr
95 ncorecnt_aer = ncorecnt
96
97 ! special output for solver testing
98 call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
99
100 iclm_aer = iclm
101 jclm_aer = jclm
102 kclm_aer_calcbgn = kclm_calcbgn
103 kclm_aer_calcend = kclm_calcend
104
105
106 do 200 m = 1, nsubareas
107 mclm_aer = m
108
109 do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
110
111 kclm_aer = k
112 if (afracsubarea(k,m) .lt. 1.e-4) goto 100
113
114 call print_mosaic_stats_bb( 0 )
115
116 call mosaic( k, m, dtchem, istat_mosaic )
117
118 call print_mosaic_stats_bb( 1 )
119 if (istat_mosaic .lt. 0) goto 100
120
121 call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
122 call move_sections( 1, iclm, jclm, k, m)
123 call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
124
125 100 continue ! k levels
126
127 200 continue ! subareas
128
129
130 ! special output for solver testing
131 call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
132
133 return
134 end subroutine aerchemistry
135
136
137
138
139
140
141
142
143
144
145 !***********************************************************************
146 ! mosaic (model for simulating aerosol interactions and chemistry)
147 !
148 ! author: rahul a. zaveri
149 ! update: dec 2004
150 !-----------------------------------------------------------------------
151 subroutine mosaic( k, m, dtchem, istat_mosaic )
152
153 use module_data_mosaic_asect
154 use module_data_mosaic_other
155
156 ! implicit none
157 ! include 'v33com'
158 ! include 'v33com3'
159 ! include 'mosaic.h'
160 ! subr arguments
161 integer istat_mosaic, k, m
162 real dtchem
163 ! local variables
164 real yh2o
165
166
167 istat_mosaic = 0
168
169 ! overwrite inputs
170 if(1.eq.0)then
171 call hijack_input(k,m)
172 endif
173
174
175 t_k = rsub(ktemp,k,m) ! update temperature = k
176 p_atm = ptotclm(k) /1.032e6 ! update pressure = atm
177 yh2o = rsub(kh2o,k,m) ! mol(h2o)/mol(air)
178 rh_pc = 100.*relhumclm(k) ! rh (%)
179 ah2o = relhumclm(k) ! fractional rh
180
181
182 call load_mosaic_parameters ! sets up indices and other stuff once per simulation
183
184 call update_thermodynamic_constants ! update temperature dependent constants
185
186 call initialize_mosaic_variables
187
188 call map_mosaic_species(k, m, 0)
189
190 call mosaic_dynamic_solver( dtchem, istat_mosaic )
191 if (istat_mosaic .lt. 0) return
192
193 call map_mosaic_species(k, m, 1)
194
195 ! write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
196
197 return
198 end subroutine mosaic
199
200
201
202
203 subroutine hijack_input(k, m)
204
205 use module_data_mosaic_asect
206 use module_data_mosaic_other
207
208 ! implicit none
209 ! include 'v33com'
210 ! include 'v33com3'
211 ! include 'v33com9a'
212 ! include 'v33com9b'
213 ! include 'mosaic.h'
214 ! subr arguments
215 integer k, m
216 ! local variables
217 integer ibin, igas, iphase, isize, itype
218 real t_kdum, p_atmdum, rhdum, cairclmdum
219 real gasdum(4), aerdum(14,8)
220
221
222
223
224 ! read inputs----------------
225 open(92, file = 'box.txt')
226
227 read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
228 do igas = 1, 4
229 read(92,*)gasdum(igas)
230 enddo
231
232 do ibin = 1, nbin_a
233 read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin), &
234 aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin), &
235 aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin), &
236 aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin), &
237 aerdum(13,ibin),aerdum(14,ibin)
238 enddo
239
240 close(92)
241 !----------------------------
242
243
244
245 rsub(ktemp,k,m) = t_kdum ! update temperature = k
246 ptotclm(k) = p_atmdum*1.032e6 ! update pressure = atm
247 relhumclm(k) = rhdum/100.0 ! fractional rh
248 cairclm(k) = cairclmdum ! mol/cc
249
250
251 ! 3-d
252 ! calculate air conc in mol/m^3
253 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
254 cair_mol_cc = cairclm(k)
255
256 ! 3-d
257 ! define conversion factors
258 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
259 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
260 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
261 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
262
263
264 ! read rsub (mol/mol(air))
265 ! gas
266 rsub(kh2so4,k,m) = gasdum(1)
267 rsub(khno3,k,m) = gasdum(2)
268 rsub(khcl,k,m) = gasdum(3)
269 rsub(knh3,k,m) = gasdum(4)
270
271
272 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
273 iphase = ai_phase
274 ibin = 0
275 do 10 itype = 1, ntype_aer
276 do 10 isize = 1, nsize_aer(itype)
277 ibin = ibin + 1
278
279 rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
280 rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
281 rsub(lptr_cl_aer(isize,itype,iphase),k,m) = aerdum(3,ibin)
282 rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
283 rsub(lptr_oc_aer(isize,itype,iphase),k,m) = aerdum(5,ibin)
284 rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
285 rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
286 rsub(lptr_bc_aer(isize,itype,iphase),k,m) = aerdum(8,ibin)
287 rsub(lptr_na_aer(isize,itype,iphase),k,m) = aerdum(9,ibin)
288 rsub(lptr_ca_aer(isize,itype,iphase),k,m) = aerdum(10,ibin)
289 rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
290
291 rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
292 rsub(waterptr_aer(isize,itype),k,m) = aerdum(13,ibin) ! kg/m^3(air)
293 rsub(numptr_aer(isize,itype,iphase),k,m) = aerdum(14,ibin) ! num_a is in #/cc
294 10 continue
295
296 return
297 end subroutine hijack_input
298
299
300
301
302
303 !***********************************************************************
304 ! intializes all the mosaic variables to zero or their default values.
305 !
306 ! author: rahul a. zaveri
307 ! update: jun 2003
308 !-----------------------------------------------------------------------
309 subroutine initialize_mosaic_variables
310 ! implicit none
311 ! include 'mosaic.h'
312 ! local variables
313 integer iaer, ibin, iv, ja, jc, je
314
315
316
317 do ibin = 1, nbin_a
318 ah2o_a(ibin) = ah2o ! initialize
319 enddo
320
321 if(mactivity_coeff .eq. mmtem)then
322 call mtem_compute_log_gamz ! this is done only once every transport time step (function of ah2o)
323 endif
324
325
326 do iv = 1, naer_vol
327 gas(iv) = 0.0
328 ctot_a(iv) = 0.0
329 volatile_a(iv) = 0.0
330 enddo
331
332 ! initialize to zero
333 do ibin = 1, nbin_a
334
335 num_a(ibin) = 0.0
336 mass_dry_a(ibin) = 0.0
337 mass_soluble_a(ibin) = 0.0
338
339 do iaer = 1, naer
340 aer(iaer,jtotal,ibin) = 0.0
341 aer(iaer,jsolid,ibin) = 0.0
342 aer(iaer,jliquid,ibin) = 0.0
343 enddo
344
345 do je = 1, nelectrolyte
346 electrolyte(je,jtotal,ibin) = 0.0
347 electrolyte(je,jsolid,ibin) = 0.0
348 electrolyte(je,jliquid,ibin) = 0.0
349 activity(je,ibin) = 0.0
350 gam(je,ibin) = 0.0
351 enddo
352
353 gam_ratio(ibin) = 0.0
354
355 do iv = 1, naer_vol
356 flux(iv,ibin) = 0.0
357 kg(iv,ibin) = 0.0
358 phi_volatile(iv,ibin) = 0.0
359 df_gas(iv,ibin) = 0.0
360 enddo
361
362
363 jaerosolstate(ibin) = -1 ! initialize to default value
364 jphase(ibin) = 0
365
366 do jc = 1, ncation
367 mc(jc,ibin) = 0.0
368 gam_cation(jc,ibin) = 0.0
369 enddo
370
371 do ja = 1, nanion
372 ma(ja,ibin) = 0.0
373 gam_anion(ja,ibin) = 0.0
374 enddo
375
376 enddo ! ibin
377
378
379 return
380 end subroutine initialize_mosaic_variables
381
382
383
384
385
386
387 !***********************************************************************
388 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
389 !
390 ! author: rahul a. zaveri
391 ! update: nov 2001
392 !-------------------------------------------------------------------------
393 subroutine map_mosaic_species(k, m, imap)
394
395 use module_data_mosaic_asect
396 use module_data_mosaic_other
397 use module_state_description, only: param_first_scalar
398
399 ! implicit none
400
401 ! include 'v33com'
402 ! include 'v33com3'
403 ! include 'v33com9a'
404 ! include 'v33com9b'
405
406 ! subr arguments
407 integer k, m, imap
408 ! local variables
409 integer ibin, iphase, isize, itype, l, p1st
410
411
412 ! if a species index is less than this value, then the species is not defined
413 p1st = param_first_scalar
414
415 ! 3-d
416 ! calculate air conc in mol/m^3
417 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
418 cair_mol_cc = cairclm(k)
419
420 ! 3-d
421 ! define conversion factors
422 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
423 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
424 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
425 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
426
427
428 ! box
429 ! conv1 = 1.e15/avogad ! converts (molec/cc) to (nmol/m^3)
430 ! conv2 = 1./conv1 ! converts (nmol/m^3) to (molec/cc)
431 ! kaerstart = ngas_max
432
433
434 if(imap.eq.0)then ! map rsub (mol/mol(air)) into aer (nmol/m^3)
435 ! gas
436 if (kh2so4 .ge. p1st) then
437 gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a ! nmol/m^3
438 else
439 gas(ih2so4_g) = 0.0
440 end if
441 if (khno3 .ge. p1st) then
442 gas(ihno3_g) = rsub(khno3,k,m)*conv1a
443 else
444 gas(ihno3_g) = 0.0
445 end if
446 if (khcl .ge. p1st) then
447 gas(ihcl_g) = rsub(khcl,k,m)*conv1a
448 else
449 gas(ihcl_g) = 0.0
450 end if
451 if (knh3 .ge. p1st) then
452 gas(inh3_g) = rsub(knh3,k,m)*conv1a
453 else
454 gas(inh3_g) = 0.0
455 end if
456
457 ! aerosol
458 iphase = ai_phase
459 ibin = 0
460 do 10 itype = 1, ntype_aer
461 do 10 isize = 1, nsize_aer(itype)
462 ibin = ibin + 1
463
464 ! aer array units are nmol/(m^3 air)
465
466 ! rce 18-nov-2004 - always map so4 and number,
467 ! but only map other species when (lptr_xxx .ge. p1st)
468 l = lptr_so4_aer(isize,itype,iphase)
469 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
470
471 l = lptr_no3_aer(isize,itype,iphase)
472 if (l .ge. p1st) then
473 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
474 else
475 aer(ino3_a,jtotal,ibin)=0.0
476 end if
477
478 l = lptr_cl_aer(isize,itype,iphase)
479 if (l .ge. p1st) then
480 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
481 else
482 aer(icl_a,jtotal,ibin)=0.0
483 end if
484
485 l = lptr_nh4_aer(isize,itype,iphase)
486 if (l .ge. p1st) then
487 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
488 else
489 aer(inh4_a,jtotal,ibin)=0.0
490 end if
491
492 l = lptr_oc_aer(isize,itype,iphase)
493 if (l .ge. p1st) then
494 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
495 else
496 aer(ioc_a,jtotal,ibin)=0.0
497 end if
498
499 l = lptr_bc_aer(isize,itype,iphase)
500 if (l .ge. p1st) then
501 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
502 else
503 aer(ibc_a,jtotal,ibin)=0.0
504 end if
505
506 l = lptr_na_aer(isize,itype,iphase)
507 if (l .ge. p1st) then
508 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
509 else
510 aer(ina_a,jtotal,ibin)=0.0
511 end if
512
513 l = lptr_oin_aer(isize,itype,iphase)
514 if (l .ge. p1st) then
515 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
516 else
517 aer(ioin_a,jtotal,ibin)=0.0
518 end if
519
520 l = lptr_msa_aer(isize,itype,iphase)
521 if (l .ge. p1st) then
522 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
523 else
524 aer(imsa_a,jtotal,ibin)=0.0
525 end if
526
527 l = lptr_co3_aer(isize,itype,iphase)
528 if (l .ge. p1st) then
529 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
530 else
531 aer(ico3_a,jtotal,ibin)=0.0
532 end if
533
534 l = lptr_ca_aer(isize,itype,iphase)
535 if (l .ge. p1st) then
536 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
537 else
538 aer(ica_a,jtotal,ibin)=0.0
539 end if
540
541 ! water_a and water_a_hyst units are kg/(m^3 air)
542 l = hyswptr_aer(isize,itype)
543 if (l .ge. p1st) then
544 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
545 else
546 water_a_hyst(ibin)=0.0
547 end if
548
549 ! water_a units are kg/(m^3 air)
550 l = waterptr_aer(isize,itype)
551 if (l .ge. p1st) then
552 water_a(ibin)=rsub(l,k,m)*conv2a
553 else
554 water_a(ibin)=0.0
555 end if
556
557 ! num_a units are #/(cm^3 air)
558 l = numptr_aer(isize,itype,iphase)
559 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
560
561 ! other bin parameters (fixed for now)
562 sigmag_a(ibin) = 1.02
563
564 10 continue
565
566
567
568 ! save input overall (all bins combined) mass
569 call overall_massbal_in
570
571 iprint_input = mYES ! reset to default
572
573
574 !---------------------------------------------------------------------
575
576
577 else ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
578
579
580 ! check exit overall (all bins combined) mass balance
581 call overall_massbal_out(k,m)
582
583 ! gas
584 if (kh2so4 .ge. p1st) &
585 rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
586 if (khno3 .ge. p1st) &
587 rsub(khno3,k,m) = gas(ihno3_g)*conv1b
588 if (khcl .ge. p1st) &
589 rsub(khcl,k,m) = gas(ihcl_g)*conv1b
590 if (knh3 .ge. p1st) &
591 rsub(knh3,k,m) = gas(inh3_g)*conv1b
592
593 ! aerosol
594 iphase = ai_phase
595 ibin = 0
596 do 20 itype = 1, ntype_aer
597 do 20 isize = 1, nsize_aer(itype)
598 ibin = ibin + 1
599
600
601 ! rce 18-nov-2004 - always map so4 and number,
602 ! but only map other species when (lptr_xxx .ge. p1st)
603 l = lptr_so4_aer(isize,itype,iphase)
604 rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
605
606 l = lptr_no3_aer(isize,itype,iphase)
607 if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
608
609 l = lptr_cl_aer(isize,itype,iphase)
610 if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
611
612 l = lptr_nh4_aer(isize,itype,iphase)
613 if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
614
615 l = lptr_oc_aer(isize,itype,iphase)
616 if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
617
618 l = lptr_bc_aer(isize,itype,iphase)
619 if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
620
621 l = lptr_na_aer(isize,itype,iphase)
622 if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
623
624 l = lptr_oin_aer(isize,itype,iphase)
625 if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
626
627 l = lptr_msa_aer(isize,itype,iphase)
628 if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
629
630 l = lptr_co3_aer(isize,itype,iphase)
631 if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
632
633 l = lptr_ca_aer(isize,itype,iphase)
634 if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
635
636 l = hyswptr_aer(isize,itype)
637 if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
638
639 l = waterptr_aer(isize,itype)
640 if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
641
642 l = numptr_aer(isize,itype,iphase)
643 if (l .ge. p1st) rsub(l,k,m) = num_a(ibin)/cair_mol_cc
644
645
646 drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
647 if(jaerosolstate(ibin) .eq. no_aerosol) then
648 drydens_aftgrow(isize,itype) = -1.
649 else
650 drydens_aftgrow(isize,itype) = dens_dry_a(ibin) ! g/cc
651 end if
652
653 20 continue
654
655 endif
656
657 return
658 end subroutine map_mosaic_species
659
660
661
662
663
664 subroutine isize_itype_from_ibin( ibin, isize, itype )
665 !
666 ! inside of mosaic, the "2d" (isize,itype) indexing is replaced
667 ! by "1d" (ibin) indexing
668 ! this routine gives (isize,itype) corresponding to (ibin)
669 !
670 use module_data_mosaic_asect
671 use module_data_mosaic_other, only: lunerr
672 ! implicit none
673
674 ! subr arguments
675 integer ibin, isize, itype
676 ! local variables
677 integer jdum_bin, jdum_size, jdum_type
678 character*80 msg
679
680 isize = -999888777
681 itype = -999888777
682
683 jdum_bin = 0
684 do jdum_type = 1, ntype_aer
685 do jdum_size = 1, nsize_aer(jdum_type)
686 jdum_bin = jdum_bin + 1
687 if (ibin .eq. jdum_bin) then
688 isize = jdum_size
689 itype = jdum_type
690 end if
691 end do
692 end do
693
694 if (isize .le. 0) then
695 write(msg,'(a,1x,i5)') &
696 '*** subr isize_itype_from_ibin - bad ibin =', ibin
697 call peg_error_fatal( lunerr, msg )
698 end if
699
700 return
701 end subroutine isize_itype_from_ibin
702
703
704
705
706 subroutine overall_massbal_in
707
708 use module_data_mosaic_asect
709 use module_data_mosaic_other
710
711 ! implicit none
712 ! include 'mosaic.h'
713 integer ibin
714
715 tot_so4_in = gas(ih2so4_g)
716 tot_no3_in = gas(ihno3_g)
717 tot_cl_in = gas(ihcl_g)
718 tot_nh4_in = gas(inh3_g)
719 tot_na_in = 0.0
720 tot_ca_in = 0.0
721
722
723 do ibin = 1, nbin_a
724 tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
725 tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
726 tot_cl_in = tot_cl_in + aer(icl_a, jtotal,ibin)
727 tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
728 tot_na_in = tot_na_in + aer(ina_a,jtotal,ibin)
729 tot_ca_in = tot_ca_in + aer(ica_a,jtotal,ibin)
730 enddo
731
732
733 return
734 end subroutine overall_massbal_in
735
736
737
738 subroutine overall_massbal_out(k,m)
739 ! implicit none
740 ! include 'v33com'
741 ! include 'v33com3'
742 ! include 'v33com9a'
743 ! include 'v33com9b'
744 ! include 'mosaic.h'
745 ! subr arguments
746 integer k, m
747 ! local variables
748 integer ibin
749
750 k = kclm_aer
751 m = mclm_aer
752
753
754 tot_so4_out = gas(ih2so4_g)
755 tot_no3_out = gas(ihno3_g)
756 tot_cl_out = gas(ihcl_g)
757 tot_nh4_out = gas(inh3_g)
758 tot_na_out = 0.0
759 tot_ca_out = 0.0
760
761 do ibin = 1, nbin_a
762 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
763 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
764 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
765 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
766 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
767 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
768 enddo
769
770 diff_so4 = tot_so4_out - tot_so4_in
771 diff_no3 = tot_no3_out - tot_no3_in
772 diff_cl = tot_cl_out - tot_cl_in
773 diff_nh4 = tot_nh4_out - tot_nh4_in
774 diff_na = tot_na_out - tot_na_in
775 diff_ca = tot_ca_out - tot_ca_in
776
777
778 reldiff_so4 = 0.0
779 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
780 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
781 endif
782
783 reldiff_no3 = 0.0
784 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
785 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
786 endif
787
788 reldiff_cl = 0.0
789 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
790 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
791 endif
792
793 reldiff_nh4 = 0.0
794 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
795 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
796 endif
797
798 reldiff_na = 0.0
799 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
800 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
801 endif
802
803 reldiff_ca = 0.0
804 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
805 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
806 endif
807
808
809
810 if(abs(reldiff_so4) .gt. 1.e-4 .or. &
811 abs(reldiff_no3) .gt. 1.e-4 .or. &
812 abs(reldiff_nh4) .gt. 1.e-4 .or. &
813 abs(reldiff_na) .gt. 1.e-4 .or. &
814 abs(reldiff_ca) .gt. 1.e-4)then
815
816
817 if(iprint_input .eq. myes)then
818 write(6,*) 'mosaic aerchem overall_massbal_out error'
819 call print_input(k, m)
820 iprint_input = mno
821 endif
822
823 endif
824
825
826 return
827 end subroutine overall_massbal_out
828
829
830
831
832 subroutine print_input(k,m)
833
834 use module_data_mosaic_asect
835 use module_data_mosaic_other
836
837 ! implicit none
838 ! include 'v33com'
839 ! include 'v33com3'
840 ! include 'v33com9a'
841 ! include 'v33com9b'
842 ! include 'mosaic.h'
843 ! subr arguments
844 integer k, m
845 ! local variables
846 integer ibin, iphase, isize, itype
847
848 k = kclm_aer
849 m = mclm_aer
850
851
852
853 tot_so4_out = gas(ih2so4_g)
854 tot_no3_out = gas(ihno3_g)
855 tot_cl_out = gas(ihcl_g)
856 tot_nh4_out = gas(inh3_g)
857 tot_na_out = 0.0
858 tot_ca_out = 0.0
859
860 do ibin = 1, nbin_a
861 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
862 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
863 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
864 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
865 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
866 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
867 enddo
868
869 diff_so4 = tot_so4_out - tot_so4_in
870 diff_no3 = tot_no3_out - tot_no3_in
871 diff_cl = tot_cl_out - tot_cl_in
872 diff_nh4 = tot_nh4_out - tot_nh4_in
873 diff_na = tot_na_out - tot_na_in
874 diff_ca = tot_ca_out - tot_ca_in
875
876
877 reldiff_so4 = 0.0
878 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
879 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
880 endif
881
882 reldiff_no3 = 0.0
883 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
884 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
885 endif
886
887 reldiff_cl = 0.0
888 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
889 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
890 endif
891
892 reldiff_nh4 = 0.0
893 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
894 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
895 endif
896
897 reldiff_na = 0.0
898 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
899 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
900 endif
901
902 reldiff_ca = 0.0
903 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
904 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
905 endif
906
907
908 ! write to monitor screen
909 write(6,*) 'mosaic aerchem print_input'
910 write(6,*)'+++++++++++++++++++++++++++++++++++++++++'
911 write(6,*)'i j k = ', iclm_aer, jclm_aer, kclm_aer
912 write(6,*)'ncorecnt = ', ncorecnt_aer
913 write(6,*)'relative so4 mass bal = ', reldiff_so4
914 write(6,*)'relative no3 mass bal = ', reldiff_no3
915 write(6,*)'relative cl mass bal = ', reldiff_cl
916 write(6,*)'relative nh4 mass bal = ', reldiff_nh4
917 write(6,*)'relative na mass bal = ', reldiff_na
918 write(6,*)'relative ca mass bal = ', reldiff_ca
919 write(6,*)'inputs:'
920 write(6,*)'t (k) = ',t_k,' p (atm) = ',p_atm,' rh = ',rh_pc
921 write(6,*)'cairclm (mol/cc) = ', cairclm(k)
922 write(6,*)'gas h2so4(ppb) = ', rsub(kh2so4,k,m)
923 write(6,*)'gas hno3 (ppb) = ', rsub(khno3,k,m)
924 write(6,*)'gas hcl (ppb) = ', rsub(khcl,k,m)
925 write(6,*)'gas nh3 (ppb) = ', rsub(knh3,k,m)
926
927 iphase = ai_phase
928 ibin = 0
929 do itype = 1, ntype_aer
930 do isize = 1, nsize_aer(itype)
931 ibin = ibin + 1
932 write(6,44) &
933 rsub(lptr_so4_aer(isize,itype,iphase),k,m), &
934 rsub(lptr_no3_aer(isize,itype,iphase),k,m), &
935 rsub(lptr_cl_aer(isize,itype,iphase),k,m), &
936 rsub(lptr_nh4_aer(isize,itype,iphase),k,m), &
937 rsub(lptr_oc_aer(isize,itype,iphase),k,m), & ! ng/m^3(air)
938 rsub(lptr_co3_aer(isize,itype,iphase),k,m), &
939 rsub(lptr_msa_aer(isize,itype,iphase),k,m), &
940 rsub(lptr_bc_aer(isize,itype,iphase),k,m), & ! ng/m^3(air)
941 rsub(lptr_na_aer(isize,itype,iphase),k,m), &
942 rsub(lptr_ca_aer(isize,itype,iphase),k,m), &
943 rsub(lptr_oin_aer(isize,itype,iphase),k,m), &
944 rsub(hyswptr_aer(isize,itype),k,m), &
945 rsub(waterptr_aer(isize,itype),k,m), &
946 rsub(numptr_aer(isize,itype,iphase),k,m)
947 enddo
948 enddo
949
950 write(6,*)'+++++++++++++++++++++++++++++++++++++++++'
951
952
953
954
955 ! do this in pegasus but not in wrf-chem
956 ! write to fort.67
957 ! write(67,*)'+++++++++++++++++++++++++++++++++++++++++'
958 ! write(67,*)'i j k = ', iclm_aer, jclm_aer, kclm_aer
959 ! write(67,*)'ncorecnt = ', ncorecnt_aer
960 ! write(67,*)'relative so4 mass bal = ', reldiff_so4
961 ! write(67,*)'relative no3 mass bal = ', reldiff_no3
962 ! write(67,*)'relative cl mass bal = ', reldiff_cl
963 ! write(67,*)'relative nh4 mass bal = ', reldiff_nh4
964 ! write(67,*)'relative na mass bal = ', reldiff_na
965 ! write(67,*)'relative ca mass bal = ', reldiff_ca
966 ! write(67,*)'inputs:'
967 ! write(67,*)'t (k) =',t_k,' p (atm) =',p_atm,' rh =',rh_pc, &
968 ! 'cairclm (mol/cc) = ', cairclm(k)
969 ! write(67,*)'gas h2so4 = ', rsub(kh2so4,k,m)
970 ! write(67,*)'gas hno3 = ', rsub(khno3,k,m)
971 ! write(67,*)'gas hcl = ', rsub(khcl,k,m)
972 ! write(67,*)'gas nh3 = ', rsub(knh3,k,m)
973 !
974 ! iphase = ai_phase
975 ! ibin = 0
976 ! do itype = 1, ntype_aer
977 ! do isize = 1, nsize_aer(itype)
978 ! ibin = ibin + 1
979 ! write(67,44) &
980 ! rsub(lptr_so4_aer(isize,itype,iphase),k,m), &
981 ! rsub(lptr_no3_aer(isize,itype,iphase),k,m), &
982 ! rsub(lptr_cl_aer(isize,itype,iphase),k,m), &
983 ! rsub(lptr_nh4_aer(isize,itype,iphase),k,m), &
984 ! rsub(lptr_oc_aer(isize,itype,iphase),k,m), & ! ng/m^3(air)
985 ! rsub(lptr_co3_aer(isize,itype,iphase),k,m), &
986 ! rsub(lptr_msa_aer(isize,itype,iphase),k,m), &
987 ! rsub(lptr_bc_aer(isize,itype,iphase),k,m), & ! ng/m^3(air)
988 ! rsub(lptr_na_aer(isize,itype,iphase),k,m), &
989 ! rsub(lptr_ca_aer(isize,itype,iphase),k,m), &
990 ! rsub(lptr_oin_aer(isize,itype,iphase),k,m), &
991 ! rsub(hyswptr_aer(isize,itype),k,m), &
992 ! rsub(waterptr_aer(isize,itype),k,m), &
993 ! rsub(numptr_aer(isize,itype,iphase),k,m)
994 ! enddo
995 ! enddo
996 !
997 ! write(67,*)'+++++++++++++++++++++++++++++++++++++++++'
998
999
1000
1001 44 format(14(e18.10,2x))
1002
1003
1004 return
1005 end subroutine print_input
1006
1007
1008
1009
1010
1011
1012 !***********************************************************************
1013 ! interface to asceem and asteem dynamic gas-particle exchange solvers
1014 !
1015 ! author: rahul a. zaveri
1016 ! update: jan 2005
1017 !-----------------------------------------------------------------------
1018 subroutine mosaic_dynamic_solver( dtchem, istat_mosaic )
1019 ! implicit none
1020 ! include 'v33com'
1021 ! include 'mosaic.h'
1022 ! subr arguments
1023 integer istat_mosaic
1024 real dtchem
1025 ! local variables
1026 integer ibin, istat_asteem, iv, k, m
1027 real xt, dumdum
1028 ! real aerosol_water_up ! mosaic func
1029
1030
1031 istat_mosaic = 0
1032
1033 if(iclm_aer .eq. 35 .and. &
1034 jclm_aer .eq. 14 .and. &
1035 kclm_aer .eq. 1 .and. &
1036 ncorecnt_aer .eq. 1)then
1037 dumdum = 0.0
1038 endif
1039
1040
1041 do 500 ibin = 1, nbin_a
1042
1043 call check_aerosol_mass(ibin)
1044 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
1045
1046 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
1047
1048 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
1049 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
1050
1051 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
1052
1053
1054 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
1055
1056 do iv = 1, naer_vol
1057 ctot_a(iv) = ctot_a(iv) + aer(iv,jtotal,ibin)
1058 enddo
1059
1060 500 continue
1061
1062 do iv = 1, naer_vol
1063 ctot_a(iv) = ctot_a(iv) + gas(iv)
1064 enddo
1065
1066
1067 ! box
1068 ! call initial_aer_print_box ! box
1069
1070 call save_pregrow_props
1071
1072 call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77, &
1073 'after_conform' )
1074 !
1075 !-------------------------------------
1076 ! do dynamic gas-aerosol mass transfer
1077
1078 ! call overall_massbal_out(k ,m)
1079
1080 if(mdynamic_solver.eq.masceem .and.mgas_aer_xfer.eq.mon)then
1081 call asceem(dtchem)
1082 elseif(mdynamic_solver.eq.masteem.and.mgas_aer_xfer.eq.mon)then
1083 call asteem( dtchem, istat_asteem )
1084 istat_mosaic = istat_asteem
1085 endif
1086 if (istat_mosaic .lt. 0) return
1087
1088 ! call overall_massbal_out(k ,m)
1089
1090 !-------------------------------------
1091 ! box
1092 ! grows or shrinks size depending on mass increase or decrease
1093 !
1094 ! do ibin = 1, nbin_a
1095 ! if(jaerosolstate(ibin) .ne. no_aerosol)then
1096 ! call conform_particle_size(ibin) ! box
1097 ! endif
1098 ! enddo
1099
1100
1101
1102 do 600 ibin = 1, nbin_a
1103 if(jaerosolstate(ibin).eq.no_aerosol) goto 600
1104
1105 if(jhyst_leg(ibin) .eq. jhyst_lo)then
1106 water_a_hyst(ibin) = 0.0
1107 elseif(jhyst_leg(ibin) .eq. jhyst_up)then
1108 water_a_up(ibin) = aerosol_water_up(ibin) ! at 60% rh
1109 water_a_hyst(ibin) = water_a_up(ibin)
1110 endif
1111
1112 call calc_dry_n_wet_aerosol_props(ibin) ! compute final mass and density
1113 600 continue
1114
1115 return
1116 end subroutine mosaic_dynamic_solver
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132 !***********************************************************************
1133 ! checks if aerosol mass is too low to be of any significance
1134 ! and determine jaerosolstate
1135 !
1136 ! author: rahul a. zaveri
1137 ! update: jan 2005
1138 !-----------------------------------------------------------------------
1139 subroutine check_aerosol_mass(ibin)
1140 ! implicit none
1141 ! include 'mosaic.h'
1142 ! subr arguments
1143 integer ibin
1144
1145
1146
1147
1148 mass_dry_a(ibin) = aer(iso4_a,jtotal,ibin)*mw_aer_mac(iso4_a) + & ! ng/m^3(air)
1149 aer(ino3_a,jtotal,ibin)*mw_aer_mac(ino3_a) + &
1150 aer(icl_a, jtotal,ibin)*mw_aer_mac(icl_a) + &
1151 aer(inh4_a,jtotal,ibin)*mw_aer_mac(inh4_a) + &
1152 aer(imsa_a,jtotal,ibin)*mw_aer_mac(imsa_a) + &
1153 aer(ico3_a,jtotal,ibin)*mw_aer_mac(ico3_a) + &
1154 aer(ina_a, jtotal,ibin)*mw_aer_mac(ina_a) + &
1155 aer(ica_a, jtotal,ibin)*mw_aer_mac(ica_a) + &
1156 aer(ioin_a,jtotal,ibin) + &
1157 aer(ioc_a, jtotal,ibin) + &
1158 aer(ibc_a, jtotal,ibin)
1159
1160
1161 if(mass_dry_a(ibin) .lt. mass_cutoff)then
1162 jaerosolstate(ibin) = no_aerosol
1163 jphase(ibin) = 0
1164 if(mass_dry_a(ibin) .eq. 0.)num_a(ibin) = 0.0
1165 endif
1166
1167 return
1168 end subroutine check_aerosol_mass
1169
1170
1171
1172
1173
1174 !***********************************************************************
1175 ! checks and conforms number according to the mass and bin size range
1176 !
1177 ! author: rahul a. zaveri
1178 ! update: jan 2005
1179 !-----------------------------------------------------------------------
1180 subroutine conform_aerosol_number(ibin)
1181
1182 use module_data_mosaic_asect
1183
1184 ! implicit none
1185 ! include 'v33com9a'
1186 ! include 'mosaic.h'
1187 ! subr arguments
1188 integer ibin
1189 ! local variables
1190 integer isize, itype, je
1191 real num_at_dlo, num_at_dhi
1192
1193
1194
1195
1196
1197 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
1198
1199 if(jaerosolstate(ibin) .eq. no_aerosol) return
1200
1201
1202 ! 1st add all electrolytes
1203 do je = 1, nelectrolyte
1204 vol_dry_a(ibin) = vol_dry_a(ibin) + & ! cc(aer)/cc(air)
1205 electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15/ &
1206 dens_electrolyte(je)
1207 enddo
1208
1209 ! next add all other aerosol species
1210 vol_dry_a(ibin) = vol_dry_a(ibin) + & ! cc/cc(air)
1211 aer(ioc_a,jtotal,ibin)*1.e-15/dens_aer_mac(ioc_a) + &
1212 aer(ibc_a,jtotal,ibin)*1.e-15/dens_aer_mac(ibc_a) + &
1213 aer(ioin_a,jtotal,ibin)*1.e-15/dens_aer_mac(ioin_a)
1214
1215
1216 ! conform number
1217 call isize_itype_from_ibin( ibin, isize, itype )
1218 num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
1219 num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
1220
1221 num_a(ibin) = min(num_a(ibin), num_at_dlo)
1222 num_a(ibin) = max(num_a(ibin), num_at_dhi)
1223
1224
1225
1226 return
1227 end subroutine conform_aerosol_number
1228
1229
1230
1231
1232
1233
1234
1235 !***********************************************************************
1236 ! determines phase state of an aerosol bin. includes kelvin effect.
1237 !
1238 ! author: rahul a. zaveri
1239 ! update: jan 2005
1240 !-----------------------------------------------------------------------
1241 subroutine aerosol_phase_state(ibin)
1242 ! implicit none
1243 ! include 'mosaic.h'
1244 ! subr arguments
1245 integer ibin
1246 ! local variables
1247 integer js
1248 real ah2o_a_new, rel_err
1249 ! real aerosol_water_up ! mosaic func
1250
1251
1252
1253
1254 ah2o_a(ibin) = ah2o
1255 kelvin(ibin) = 1.0
1256
1257 total_dry_mass(ibin) = 0.0
1258 dry_vol(ibin) = 0.0
1259 do js = 1, nelectrolyte
1260 total_dry_mass(ibin) = total_dry_mass(ibin) + &
1261 electrolyte(js,jtotal,ibin)*mw_electrolyte(js)*1.e-9 ! [g/m^3(air)]
1262
1263 dry_vol(ibin) = dry_vol(ibin) + &
1264 electrolyte(js,jtotal,ibin)*mw_electrolyte(js)*1.e-15/ & ! [m^3/m^3(air)]
1265 dens_comp_a(js)
1266 enddo
1267
1268 total_dry_mass(ibin) = total_dry_mass(ibin) + & ! [g/m^3(air)]
1269 aer(ioc_a,jtotal,ibin)*1.e-9 + &
1270 aer(ibc_a,jtotal,ibin)*1.e-9 + &
1271 aer(ioin_a,jtotal,ibin)*1.e-9
1272
1273 dry_vol(ibin) = dry_vol(ibin) + & ! [m^3/m^3(air)]
1274 aer(ioc_a,jtotal,ibin)*1.e-15/dens_comp_a(joc) + &
1275 aer(ibc_a,jtotal,ibin)*1.e-15/dens_comp_a(jbc) + &
1276 aer(ioin_a,jtotal,ibin)*1.e-15/dens_comp_a(join)
1277
1278
1279 water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
1280
1281
1282 10 call phase_equilibrium(ibin)
1283
1284 call calculate_kelvin(ibin)
1285
1286 ah2o_a_new = ah2o/kelvin(ibin)
1287
1288 rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
1289
1290 if(rel_err .gt. 1.e-2)then
1291 ah2o_a(ibin) = ah2o_a_new
1292 goto 10
1293 endif
1294
1295
1296 ! phase determination is done
1297 ! now adjust the aerosol and update the appropriate aer(jphase) and aer(jtotal)
1298
1299 ! remove if not needed
1300 if(jaerosolstate(ibin) .eq. all_solid)then
1301 call adjust_solid_aerosol(ibin)
1302 elseif(jaerosolstate(ibin) .eq. all_liquid)then
1303 call adjust_liquid_aerosol(ibin)
1304 elseif(jaerosolstate(ibin) .eq. mixed)then
1305 jphase(ibin) = jliquid
1306 jhyst_leg(ibin) = jhyst_lo
1307 else
1308 write(6,*)' error in deciding aerosol state'
1309 write(6,*)' stopping in subr. aerosol_phase_state'
1310 ! stop
1311 call peg_error_fatal( lunerr_aer, &
1312 ' stopping in subr. aerosol_phase_state' )
1313 endif
1314
1315
1316 return
1317 end subroutine aerosol_phase_state
1318
1319
1320
1321
1322
1323
1324 !***********************************************************************
1325 ! computes kelvin effect term (kelvin => 1.0)
1326 !
1327 ! author: rahul a. zaveri
1328 ! update: jan 2005
1329 !-----------------------------------------------------------------------
1330 subroutine calculate_kelvin(ibin)
1331 ! implicit none
1332 ! include 'mosaic.h'
1333 ! subr arguments
1334 integer ibin
1335 ! local variables
1336 real term
1337
1338
1339
1340 sigma_water = 71.9759e-3 ! n/m
1341 volume_a(ibin) = water_a(ibin)/1000. + dry_vol(ibin) ! [m^3/m^3(air)]
1342 dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.) ! [m]
1343 sigma_soln(ibin) = sigma_water + 0.049*(1. - ah2o_a(ibin)) ! [n/m]
1344 term = 72.*sigma_soln(ibin)/(8314.0*t_k*1000.*dpmv(ibin)) ! [-]
1345 kelvin(ibin) = exp(term)
1346
1347
1348 return
1349 end subroutine calculate_kelvin
1350
1351
1352
1353
1354
1355
1356
1357 !***********************************************************************
1358 ! called when aerosol bin is completely solid.
1359 !
1360 ! author: rahul a. zaveri
1361 ! update: jan 2005
1362 !-----------------------------------------------------------------------
1363 subroutine adjust_solid_aerosol(ibin)
1364 ! implicit none
1365 ! include 'mosaic.h'
1366 ! subr arguments
1367 integer ibin
1368 ! local variables
1369 integer iaer, je
1370
1371
1372
1373
1374 jphase(ibin) = jsolid
1375
1376 jhyst_leg(ibin) = jhyst_lo ! lower curve
1377 water_a(ibin) = 0.0
1378
1379 ! transfer aer(jtotal) to aer(jsolid)
1380 do iaer = 1, naer
1381 aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
1382 aer(iaer, jliquid,ibin) = 0.0
1383 enddo
1384
1385 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
1386 do je = 1, nelectrolyte
1387 electrolyte(je,jliquid,ibin) = 0.0
1388 epercent(je,jliquid,ibin) = 0.0
1389 electrolyte(je,jsolid,ibin) = electrolyte(je,jtotal,ibin)
1390 epercent(je,jsolid,ibin) = epercent(je,jtotal,ibin)
1391 enddo
1392
1393 ! degas volatile nh4no3 and nh4cl if they are less than smallp %
1394 if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0 .and. &
1395 epercent(jnh4no3,jsolid,ibin) .le. smallp .and. &
1396 gas(inh3_g)*gas(ihno3_g) .lt. keq_sg(1) )then
1397
1398 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4no3,jsolid,ibin)
1399 gas(ihno3_g)= gas(ihno3_g)+ electrolyte(jnh4no3,jsolid,ibin)
1400 aer(inh4_a,jsolid,ibin) = real( &
1401 dble(aer(inh4_a,jsolid,ibin)) - &
1402 dble(electrolyte(jnh4no3,jsolid,ibin)) )
1403 aer(ino3_a,jsolid,ibin) = real( &
1404 dble(aer(ino3_a,jsolid,ibin)) - &
1405 dble(electrolyte(jnh4no3,jsolid,ibin)) )
1406 electrolyte(jnh4no3,jsolid,ibin) = 0.0
1407 epercent(jnh4no3,jsolid,ibin) = 0.0
1408
1409 endif
1410
1411 if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0 .and. &
1412 epercent(jnh4cl,jsolid,ibin) .le. smallp .and. &
1413 gas(inh3_g)*gas(ihcl_g) .lt. keq_sg(2) )then
1414
1415 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jsolid,ibin)
1416 gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jsolid,ibin)
1417 aer(inh4_a,jsolid,ibin) = real( &
1418 dble(aer(inh4_a,jsolid,ibin)) - &
1419 dble(electrolyte(jnh4cl,jsolid,ibin)) )
1420 aer(icl_a,jsolid,ibin) = real( &
1421 dble(aer(icl_a,jsolid,ibin)) - &
1422 dble(electrolyte(jnh4cl,jsolid,ibin)) )
1423 electrolyte(jnh4cl,jsolid,ibin) = 0.0
1424 epercent(jnh4cl,jsolid,ibin) = 0.0
1425
1426 endif
1427
1428 ! update aer(jtotal) that may have been affected above
1429 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
1430 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
1431 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin)
1432
1433 ! update electrolyte(jtotal)
1434 do je = 1, nelectrolyte
1435 electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
1436 epercent(je,jtotal,ibin) = epercent(je,jsolid,ibin)
1437 enddo
1438
1439 return
1440 end subroutine adjust_solid_aerosol
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450 !***********************************************************************
1451 ! called when aerosol bin is completely liquid.
1452 !
1453 ! author: rahul a. zaveri
1454 ! update: jan 2005
1455 !-----------------------------------------------------------------------
1456 subroutine adjust_liquid_aerosol(ibin)
1457 ! implicit none
1458 ! include 'mosaic.h'
1459 ! subr arguments
1460 integer ibin
1461 ! local variables
1462 integer je
1463
1464
1465
1466
1467 jphase(ibin) = jliquid
1468 jhyst_leg(ibin) = jhyst_up ! upper curve
1469
1470 ! partition all electrolytes into liquid phase
1471 do je = 1, nelectrolyte
1472 electrolyte(je,jsolid,ibin) = 0.0
1473 epercent(je,jsolid,ibin) = 0.0
1474 electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
1475 epercent(je,jliquid,ibin) = epercent(je,jtotal,ibin)
1476 enddo
1477 ! except these electrolytes, which always remain in the solid phase
1478 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1479 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1480 epercent(jcaco3,jsolid,ibin) = epercent(jcaco3,jtotal,ibin)
1481 epercent(jcaso4,jsolid,ibin) = epercent(jcaso4,jtotal,ibin)
1482 electrolyte(jcaco3,jliquid,ibin)= 0.0
1483 electrolyte(jcaso4,jliquid,ibin)= 0.0
1484 epercent(jcaco3,jliquid,ibin) = 0.0
1485 epercent(jcaso4,jliquid,ibin) = 0.0
1486
1487
1488 ! partition all the aer species into
1489 ! solid phase
1490 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1491 aer(ino3_a,jsolid,ibin) = 0.0
1492 aer(icl_a, jsolid,ibin) = 0.0
1493 aer(inh4_a,jsolid,ibin) = 0.0
1494 aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1495 aer(imsa_a,jsolid,ibin) = 0.0
1496 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1497 aer(ina_a, jsolid,ibin) = 0.0
1498 aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
1499 electrolyte(jcaso4,jsolid,ibin)
1500 aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1501 aer(ioin_a, jsolid,ibin)= aer(ioin_a,jtotal,ibin)
1502
1503 ! liquid-phase
1504 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
1505 electrolyte(jcaso4,jsolid,ibin)
1506 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1507 aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1508 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1509 aer(ioc_a, jliquid,ibin) = 0.0
1510 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1511 aer(ico3_a,jliquid,ibin) = 0.0
1512 aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1513 aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) + &
1514 electrolyte(jcacl2,jtotal,ibin)
1515 aer(ibc_a, jliquid,ibin) = 0.0
1516 aer(ioin_a, jliquid,ibin)= 0.0
1517
1518 return
1519 end subroutine adjust_liquid_aerosol
1520
1521
1522 !--------------------------------------------------------------------
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536 !***********************************************************************
1537 ! computes phase equilibrium and interfaces mesa
1538 !
1539 ! author: rahul a. zaveri
1540 ! update: jan 2005
1541 !-----------------------------------------------------------------------
1542 subroutine phase_equilibrium(ibin)
1543 ! implicit none
1544 ! include 'mosaic.h'
1545 ! subr arguments
1546 integer ibin
1547
1548 ! local variables
1549 integer idissolved, j_index, jdum, js
1550 real crh, solids, sum_soluble, sum_insoluble, xt
1551 ! real aerosol_water ! mosaic func
1552 ! real drh_mutual ! mosaic func
1553
1554
1555
1556 call calculate_xt(ibin,jtotal,xt)
1557
1558 crh = 0.1
1559
1560 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
1561 if(ah2o.lt.crh .and. (xt.gt.1.0 .or. xt.lt.0.))then
1562 jaerosolstate(ibin) = all_solid
1563 jphase(ibin) = jsolid
1564 jhyst_leg(ibin) = jhyst_lo
1565 call adjust_solid_aerosol(ibin)
1566 return
1567 endif
1568
1569
1570 ! step 2: check for supersaturation/metastable state
1571 if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin))then
1572
1573 call do_full_deliquescence(ibin)
1574 sum_soluble = 0.0
1575 do js = 1, nsoluble
1576 sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
1577 enddo
1578
1579 solids = electrolyte(jcaso4,jtotal,ibin) + &
1580 electrolyte(jcaco3,jtotal,ibin) + &
1581 aer(ioin_a,jtotal,ibin) + &
1582 aer(ibc_a,jtotal,ibin) + &
1583 aer(ioc_a,jtotal,ibin)
1584
1585
1586 if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
1587
1588 jaerosolstate(ibin) = all_solid ! no soluble material present
1589 jphase(ibin) = jsolid
1590 call adjust_solid_aerosol(ibin)
1591
1592 elseif(sum_soluble .gt. 0.0)then
1593
1594 jaerosolstate(ibin) = all_liquid
1595 jphase(ibin) = jliquid
1596 water_a(ibin) = aerosol_water(jtotal,ibin)
1597
1598 if(water_a(ibin) .lt. 0.0)then
1599 jaerosolstate(ibin) = all_solid ! no soluble material present
1600 jphase(ibin) = jsolid
1601 jhyst_leg(ibin) = jhyst_lo
1602 call adjust_solid_aerosol(ibin)
1603 else
1604 call adjust_liquid_aerosol(ibin)
1605 call compute_activities(ibin)
1606 endif
1607
1608 endif
1609
1610 return
1611 endif
1612
1613
1614
1615
1616 ! step 3: diagnose mdrh
1617 if(xt .lt. 1. .and. xt .gt. 0. )goto 10 ! excess sulfate domain - no mdrh exists
1618
1619 jdum = 0
1620 do js = 1, nsalt
1621 jsalt_present(js) = 0 ! default value - salt absent
1622
1623 if(epercent(js,jtotal,ibin) .gt. 1.0)then
1624 jsalt_present(js) = 1 ! salt present
1625 jdum = jdum + jsalt_index(js)
1626 endif
1627 enddo
1628
1629 if(jdum .eq. 0)then
1630 jaerosolstate(ibin) = all_solid ! no significant soluble material present
1631 jphase(ibin) = jsolid
1632 call adjust_solid_aerosol(ibin)
1633 return
1634 endif
1635
1636 if(xt .ge. 2.0 .or. xt .lt. 0.0)then
1637 j_index = jsulf_poor(jdum)
1638 else
1639 j_index = jsulf_rich(jdum)
1640 endif
1641
1642 mdrh(ibin) = drh_mutual(j_index) + 1.0
1643
1644 if(ah2o*100. .lt. mdrh(ibin)) then
1645 jaerosolstate(ibin) = all_solid
1646 jphase(ibin) = jsolid
1647 call adjust_solid_aerosol(ibin)
1648 return
1649 endif
1650
1651
1652 ! step 4: none of the above means it must be sub-saturated or mixed-phase
1653 10 call do_full_deliquescence(ibin)
1654
1655 call mesa(ibin) ! determines jaerosolstate(ibin)
1656
1657
1658
1659 return
1660 end subroutine phase_equilibrium
1661
1662
1663
1664
1665
1666
1667
1668
1669 !***********************************************************************
1670 ! this subroutine completely deliquesces an aerosol and partitions
1671 ! all the soluble electrolytes into the liquid phase and insoluble
1672 ! ones into the solid phase. it also calculates the corresponding
1673 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
1674 ! concentrations
1675 !
1676 ! author: rahul a. zaveri
1677 ! update: jan 2005
1678 !-----------------------------------------------------------------------
1679 subroutine do_full_deliquescence(ibin)
1680 ! implicit none
1681 ! include 'mosaic.h'
1682 ! subr arguments
1683 integer ibin
1684 ! local variables
1685 integer js
1686
1687
1688
1689
1690 ! partition all electrolytes into liquid phase
1691 do js = 1, nelectrolyte
1692 electrolyte(js,jsolid,ibin) = 0.0
1693 electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
1694 enddo
1695 !
1696 ! except these electrolytes, which always remain in the solid phase
1697 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1698 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1699 electrolyte(jcaco3,jliquid,ibin)= 0.0
1700 electrolyte(jcaso4,jliquid,ibin)= 0.0
1701
1702
1703 ! partition all the generic aer species into solid and liquid phases
1704 ! solid phase
1705 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1706 aer(ino3_a,jsolid,ibin) = 0.0
1707 aer(icl_a, jsolid,ibin) = 0.0
1708 aer(inh4_a,jsolid,ibin) = 0.0
1709 aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1710 aer(imsa_a,jsolid,ibin) = 0.0
1711 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1712 aer(ina_a, jsolid,ibin) = 0.0
1713 aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
1714 electrolyte(jcaso4,jsolid,ibin)
1715 aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1716 aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
1717
1718 ! liquid-phase
1719 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
1720 electrolyte(jcaso4,jsolid,ibin)
1721 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1722 aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1723 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1724 aer(ioc_a, jliquid,ibin) = 0.0
1725 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1726 aer(ico3_a,jliquid,ibin) = 0.0
1727 aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1728 aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) + &
1729 electrolyte(jcacl2,jtotal,ibin)
1730 aer(ibc_a, jliquid,ibin) = 0.0
1731 aer(ioin_a,jliquid,ibin) = 0.0
1732
1733 return
1734 end subroutine do_full_deliquescence
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757 !***********************************************************************
1758 ! mesa: multicomponent equilibrium solver for aerosol-phase
1759 ! computes equilibrum solid and liquid phases by integrating
1760 ! pseudo-transient dissolution and precipitation reactions
1761 !
1762 ! author: rahul a. zaveri
1763 ! update: jan 2005
1764 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
1765 !-----------------------------------------------------------------------
1766 subroutine mesa(ibin)
1767 ! implicit none
1768 ! include 'mosaic.h'
1769 ! subr arguments
1770 integer ibin
1771 ! local variables
1772 integer nmax_mesa
1773 parameter(nmax_mesa = 100)
1774 integer iaer, iconverge, iconverge_flux, iconverge_mass, &
1775 itdum, js, je, iflux(nsalt,nmax_mesa), &
1776 iprod1, iprod2, iprod3, ioscillation, mdissolved
1777 real tau_p(nsalt), tau_d(nsalt)
1778 real frac_solid, sumflux, hsalt_min, alpha, xt, dumdum, &
1779 p_mesa_fails
1780 ! function
1781 ! real aerosol_water
1782
1783
1784
1785 ! if(mod(jmesa_call,10000).eq.0)then
1786 ! p_mesa_fails = 100.*float(jmesa_fail)/
1787 ! & max(float(jmesa_call),1.0)
1788 ! write(6,*)'total number of calls to mesa =', jmesa_call
1789 ! write(6,*)'cumulative avg mesa iteration =', iter_mesa_avg
1790 ! write(6,*)'percent mesa convergence fails =', p_mesa_fails
1791 ! endif
1792
1793
1794 ! initialize
1795 itdum = 0 ! initialize time
1796 hsalt_max = 1.e25
1797
1798
1799 do js = 1, nsalt
1800 hsalt(js) = 0.0
1801 sat_ratio(js) = 0.0
1802 phi_salt(js) = 0.0
1803 flux_sl(js) = 0.0
1804 enddo
1805
1806
1807
1808 total_dry_mass(ibin) = 0.0
1809 do iaer = 1, naer
1810 total_dry_mass(ibin) = total_dry_mass(ibin) + &
1811 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)*1.e-9 ! [g/m^3(air)]
1812 enddo
1813
1814 total_dry_mass(ibin) = total_dry_mass(ibin) + & ! [g/m^3(air)]
1815 aer(ioc_a,jtotal,ibin)*1.e-9 + &
1816 aer(ibc_a,jtotal,ibin)*1.e-9 + &
1817 aer(ioin_a,jtotal,ibin)*1.e-9
1818
1819
1820
1821 call mesa_check_complete_dissolution(ibin, mdissolved)
1822 if(mdissolved .eq. myes)return
1823
1824 jmesa_call = jmesa_call + 1
1825 jmesa_call_tot = jmesa_call_tot + 1
1826
1827
1828 !----begin pseudo time continuation loop-------------------------------
1829
1830 do 500 itdum = 1, nmax_mesa
1831
1832
1833 if(itdum .gt. 50)then
1834 dumdum = 0.0
1835 endif
1836
1837 ! compute new salt fluxes
1838 call mesa_flux_salt(ibin)
1839
1840
1841 ! check convergence
1842 call mesa_convergence_criterion(itdum, ibin, &
1843 iconverge_mass, &
1844 iconverge_flux)
1845
1846 if(iconverge_mass .eq. 1)then
1847 jaerosolstate(ibin) = all_solid
1848 call adjust_solid_aerosol(ibin)
1849 iter_mesa = iter_mesa + float(itdum)
1850 return
1851 elseif(iconverge_flux .eq. 1)then
1852 iter_mesa = iter_mesa + itdum
1853 jaerosolstate(ibin) = mixed
1854 jhyst_leg(ibin) = jhyst_lo
1855 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
1856 return
1857 endif
1858
1859
1860 ! check for oscillating fluxes
1861 do js = 1, nsalt
1862 if(flux_sl(js) .lt. 0)then
1863 iflux(js,itdum) = -1
1864 elseif(flux_sl(js) .gt. 0)then
1865 iflux(js,itdum) = 1
1866 else
1867 iflux(js,itdum) = 0
1868 endif
1869 enddo
1870
1871
1872 ioscillation = mno
1873 if(itdum.gt.5) then
1874 do js = 1, nsalt
1875 iprod1 = iflux(js,itdum-3)*iflux(js,itdum-2)
1876 iprod2 = iflux(js,itdum-2)*iflux(js,itdum-1)
1877 iprod3 = iflux(js,itdum-1)*iflux(js,itdum)
1878
1879 if(iprod1.lt.0 .and. iprod2.lt.0 .and. iprod3.lt.0)then
1880 ioscillation = myes
1881 endif
1882
1883 enddo
1884 endif
1885
1886
1887 ! calculate hsalt(js) ! time step
1888 hsalt_min = 1.e25
1889 do js = 1, nsalt
1890
1891 alpha = min(abs(phi_salt(js)), 0.5)
1892
1893 if(ioscillation .eq. myes)then
1894 alpha = alpha/3.0
1895 endif
1896
1897
1898 if(flux_sl(js) .gt. 0.)then
1899
1900 tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
1901 if(tau_p(js) .eq. 0.0)then
1902 hsalt(js) = 1.e25
1903 flux_sl(js) = 0.0
1904 phi_salt(js)= 0.0
1905 else
1906 hsalt(js) = alpha*tau_p(js)
1907 endif
1908
1909 elseif(flux_sl(js) .lt. 0.)then
1910
1911 tau_p(js) = -eleliquid(js)/flux_sl(js) ! precipitation time scale
1912 tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
1913 if(tau_p(js) .eq. 0.0)then
1914 hsalt(js) = alpha*tau_d(js)
1915 else
1916 hsalt(js) = alpha*min(tau_p(js),tau_d(js))
1917 endif
1918
1919 else
1920
1921 hsalt(js) = 1.e25
1922
1923 endif
1924
1925 hsalt_min = min(hsalt(js), hsalt_min)
1926
1927 enddo
1928
1929 !---------------------------------
1930
1931 ! integrate electrolyte(solid)
1932 do js = 1, nsalt
1933 electrolyte(js,jsolid,ibin) = real( &
1934 dble(electrolyte(js,jsolid,ibin)) + &
1935 dble(hsalt(js)) * dble(flux_sl(js)) )
1936 enddo
1937
1938 call electrolytes_to_ions(jsolid,ibin) ! computes aer(solid) from electrolyte(solid)
1939
1940
1941 ! compute new electrolyte(liquid) from mass balance
1942 do iaer = 1, naer
1943 aer(iaer,jliquid,ibin) = real( dble(aer(iaer,jtotal,ibin)) - &
1944 dble(aer(iaer,jsolid,ibin)) )
1945 enddo
1946
1947 !---------------------------------
1948
1949
1950
1951 500 continue ! end of time continuation loop
1952 !--------------------------------------------------------------------
1953
1954 jmesa_fail = jmesa_fail + 1
1955 iter_mesa = iter_mesa + float(itdum)
1956
1957
1958 ! write(6,66)ibin, iclm_aer, jclm_aer, kclm_aer, jmesa_call,
1959 ! & jmesa_fail
1960 !66 format('mixed-phase did not converge at ibin ijk jmesa_call =',
1961 ! & i3, 2x, 3(i5,2x), i10, x, i10)
1962
1963
1964
1965 ! determine jaerosolstate from the last estimate of frac_solid
1966 dry_mass(ibin) = 0.0
1967 do iaer = 1, naer
1968 dry_mass(ibin) = dry_mass(ibin) + &
1969 aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-9
1970 enddo
1971 dry_mass(ibin) = dry_mass(ibin) + & ! [g/m^3(air)]
1972 aer(ioc_a,jtotal,ibin)*1.e-9 + &
1973 aer(ibc_a,jtotal,ibin)*1.e-9 + &
1974 aer(ioin_a,jtotal,ibin)*1.e-9
1975
1976 frac_solid = dry_mass(ibin)/total_dry_mass(ibin)
1977
1978 if(frac_solid.ge.0.97)then
1979 jaerosolstate(ibin) = all_solid
1980 call adjust_solid_aerosol(ibin)
1981 elseif(frac_solid.lt.0.03)then
1982 jaerosolstate(ibin) = all_liquid
1983 call adjust_liquid_aerosol(ibin)
1984 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
1985 elseif(frac_solid.gt.0.0)then
1986 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
1987 jaerosolstate(ibin) = mixed
1988 jhyst_leg(ibin) = jhyst_lo
1989 endif
1990
1991
1992
1993 return
1994 end subroutine mesa
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005 !***********************************************************************
2006 ! part of mesa: checks if particle is completely deliquesced at the
2007 ! current rh
2008 !
2009 ! author: rahul a. zaveri
2010 ! update: feb 2005
2011 !-----------------------------------------------------------------------
2012 subroutine mesa_check_complete_dissolution(ibin, mdissolved)
2013 ! implicit none
2014 ! include 'mosaic.h'
2015 ! subr arguments
2016 integer ibin, mdissolved, je, js, iaer
2017 ! local variables
2018 real sumflux, aer_sav(naer,3,nbin_a), &
2019 electrolyte_sav(nelectrolyte,3,nbin_a)
2020
2021
2022 ! save current solid-liquid arrays
2023 do je = 1, nelectrolyte
2024 electrolyte_sav(je,jsolid,ibin) =electrolyte(je,jsolid,ibin)
2025 electrolyte_sav(je,jliquid,ibin)=electrolyte(je,jliquid,ibin)
2026 enddo
2027
2028 do iaer = 1, naer
2029 aer_sav(iaer,jsolid,ibin) =aer(iaer,jsolid,ibin)
2030 aer_sav(iaer,jliquid,ibin)=aer(iaer,jliquid,ibin)
2031 enddo
2032
2033 call do_full_deliquescence(ibin)
2034
2035 do js = 1, nsalt
2036 sat_ratio(js) = 0.0
2037 phi_salt(js) = 0.0
2038 flux_sl(js) = 0.0
2039 enddo
2040
2041
2042 ! compute new salt fluxes
2043 call mesa_flux_salt(ibin)
2044
2045
2046 ! check if all the fluxes are zero
2047 sumflux = 0.0
2048 do js = 1, nsalt
2049 sumflux = sumflux + abs(flux_sl(js))
2050 enddo
2051
2052 if(sumflux .eq. 0.0)then ! it is completely dissolved
2053
2054 jaerosolstate(ibin) = all_liquid
2055 jhyst_leg(ibin) = jhyst_up ! upper curve
2056 jphase(ibin) = jliquid
2057 call adjust_liquid_aerosol(ibin)
2058 mdissolved = myes
2059
2060 else ! restore saved solid-liquid arrays
2061
2062 do je = 1, nelectrolyte
2063 electrolyte(je,jsolid,ibin) =electrolyte_sav(je,jsolid,ibin)
2064 electrolyte(je,jliquid,ibin)=electrolyte_sav(je,jliquid,ibin)
2065 enddo
2066 do iaer = 1, naer
2067 aer(iaer,jsolid,ibin) =aer_sav(iaer,jsolid,ibin)
2068 aer(iaer,jliquid,ibin)=aer_sav(iaer,jliquid,ibin)
2069 enddo
2070 mdissolved = mno
2071
2072 endif
2073
2074
2075 return
2076 end subroutine mesa_check_complete_dissolution
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092 !***********************************************************************
2093 ! part of mesa: calculates solid-liquid fluxes of soluble salts
2094 !
2095 ! author: rahul a. zaveri
2096 ! update: jan 2005
2097 !-----------------------------------------------------------------------
2098 subroutine mesa_flux_salt(ibin)
2099 ! implicit none
2100 ! include 'mosaic.h'
2101 ! subr arguments
2102 integer ibin
2103 ! local variables
2104 integer js
2105 real xt, calcium, sum_salt
2106
2107
2108 ! compute activities and water content
2109 call ions_to_electrolytes(jliquid,ibin,xt)
2110 call compute_activities(ibin)
2111 activity(jna3hso4,ibin) = 0.0
2112
2113 if(water_a(ibin) .le. 0.0)then
2114 do js = 1, nsalt
2115 flux_sl(js) = 0.0
2116 enddo
2117 return
2118 endif
2119
2120
2121 call mesa_estimate_eleliquid(ibin,xt)
2122
2123 calcium = aer(ica_a,jliquid,ibin)
2124
2125 do js = 1, nsalt
2126 jsalt_present(js) = 0 ! default value - salt absent
2127 if(epercent(js,jtotal,ibin) .gt. 1.0)then
2128 jsalt_present(js) = 1 ! salt present
2129 endif
2130 enddo
2131
2132
2133 ! calculate % electrolyte composition in the solid and liquid phases
2134 sum_salt = 0.0
2135 do js = 1, nsalt
2136 sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
2137 enddo
2138 electrolyte_sum(jsolid,ibin) = sum_salt
2139 if(sum_salt .eq. 0.0)sum_salt = 1.0
2140 do js = 1, nsalt
2141 frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
2142 frac_salt_liq(js) = epercent(js,jliquid,ibin)/100.
2143 enddo
2144
2145
2146
2147 ! compute salt fluxes
2148 do js = 1, nsalt ! soluble solid salts
2149
2150 ! compute new saturation ratio
2151 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2152 ! compute relative driving force
2153 phi_salt(js) = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0)
2154
2155 ! check if too little solid-phase salt is trying to dissolve
2156 if(sat_ratio(js) .lt. 1.00 .and. &
2157 frac_salt_solid(js) .lt. 0.01 .and. &
2158 frac_salt_solid(js) .gt. 0.0)then
2159 call mesa_dissolve_small_salt(ibin,js)
2160 call mesa_estimate_eleliquid(ibin,xt)
2161 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2162 endif
2163
2164 ! compute flux
2165 flux_sl(js) = sat_ratio(js) - 1.0
2166
2167 ! apply heaviside function
2168 if( (sat_ratio(js) .lt. 1.0 .and. &
2169 electrolyte(js,jsolid,ibin) .eq. 0.0) .or. &
2170 (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
2171 flux_sl(js) = 0.0
2172 phi_salt(js)= 0.0
2173 endif
2174
2175 enddo
2176
2177 ! force cacl2 and cano3 fluxes to zero
2178 sat_ratio(jcano3) = 1.0
2179 phi_salt(jcano3) = 0.0
2180 flux_sl(jcano3) = 0.0
2181
2182 sat_ratio(jcacl2) = 1.0
2183 phi_salt(jcacl2) = 0.0
2184 flux_sl(jcacl2) = 0.0
2185
2186
2187 return
2188 end subroutine mesa_flux_salt
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201 !***********************************************************************
2202 ! part of mesa: calculates liquid electrolytes from ions
2203 !
2204 ! notes:
2205 ! - this subroutine is to be used for liquid-phase or total-phase only
2206 ! - this sub transfers caso4 and caco3 from liquid to solid phase
2207 !
2208 ! author: rahul a. zaveri
2209 ! update: jan 2005
2210 !-----------------------------------------------------------------------
2211 subroutine mesa_estimate_eleliquid(ibin,xt)
2212 ! implicit none
2213 ! include 'mosaic.h'
2214 ! subr arguments
2215 integer ibin, jp
2216 real xt
2217 ! local variables
2218 integer iaer, je, jc, ja, icase
2219 real store(naer), thesum, sum_naza, sum_nczc, sum_na_nh4, &
2220 f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d, &
2221 xdum, dum, cat_net
2222 real nc(ncation), na(nanion)
2223 real dum_ca, dum_no3, dum_cl, cano3, cacl2
2224
2225
2226
2227
2228
2229
2230
2231 ! remove negative concentrations, if any
2232 do iaer = 1, naer
2233 aer(iaer,jliquid,ibin) = max(0.0, aer(iaer,jliquid,ibin))
2234 enddo
2235
2236
2237 ! calculate sulfate ratio
2238 call calculate_xt(ibin,jliquid,xt)
2239
2240 if(xt .ge. 2.0 .or. xt.lt.0.)then
2241 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
2242 else
2243 icase = 2 ! acidic (acidity is caused by excess so4)
2244 endif
2245
2246
2247 ! initialize to zero
2248 do je = 1, nelectrolyte
2249 eleliquid(je) = 0.0
2250 enddo
2251 !
2252 !---------------------------------------------------------
2253 ! initialize moles of ions depending on the sulfate domain
2254
2255 jp = jliquid
2256
2257 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
2258
2259 dum_ca = aer(ica_a,jp,ibin)
2260 dum_no3 = aer(ino3_a,jp,ibin)
2261 dum_cl = aer(icl_a,jp,ibin)
2262
2263 cano3 = min(dum_ca, 0.5*dum_no3)
2264 dum_ca = max(0., dum_ca - cano3)
2265 dum_no3 = max(0., dum_no3 - 2.*cano3)
2266
2267 cacl2 = min(dum_ca, 0.5*dum_cl)
2268 dum_ca = max(0., dum_ca - cacl2)
2269 dum_cl = max(0., dum_cl - 2.*cacl2)
2270
2271 na(ja_hso4)= 0.0
2272 na(ja_so4) = aer(iso4_a,jp,ibin)
2273 na(ja_no3) = aer(ino3_a,jp,ibin)
2274 na(ja_cl) = aer(icl_a, jp,ibin)
2275
2276 nc(jc_ca) = aer(ica_a, jp,ibin)
2277 nc(jc_na) = aer(ina_a, jp,ibin)
2278 nc(jc_nh4) = aer(inh4_a,jp,ibin)
2279
2280 cat_net = real( dble(2.*na(ja_so4)+na(ja_no3)+na(ja_cl)) - &
2281 dble(nc(jc_h)+2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na)) )
2282
2283 if(cat_net .lt. 0.0)then
2284
2285 ! if(aer(inh4_a,jp,ibin) .gt. abs(cat_net))then ! degas excess nh3
2286 ! aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) + cat_net
2287 ! gas(inh3_g) = gas(inh3_g) - cat_net
2288 ! endif
2289
2290 nc(jc_h) = 0.0
2291
2292 else ! cat_net must be 0.0 or positive
2293
2294 nc(jc_h) = cat_net
2295
2296 endif
2297
2298
2299 ! now compute equivalent fractions
2300 sum_naza = 0.0
2301 do ja = 1, nanion
2302 sum_naza = sum_naza + na(ja)*za(ja)
2303 enddo
2304
2305 sum_nczc = 0.0
2306 do jc = 1, ncation
2307 sum_nczc = sum_nczc + nc(jc)*zc(jc)
2308 enddo
2309
2310 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
2311 write(6,*)'ionic concentrations are zero'
2312 write(6,*)'sum_naza = ', sum_naza
2313 write(6,*)'sum_nczc = ', sum_nczc
2314 return
2315 endif
2316
2317 do ja = 1, nanion
2318 xeq_a(ja) = na(ja)*za(ja)/sum_naza
2319 enddo
2320
2321 do jc = 1, ncation
2322 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2323 enddo
2324
2325 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
2326 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
2327 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
2328 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
2329
2330 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
2331 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
2332 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
2333 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
2334
2335
2336 ! now compute electrolyte moles
2337 eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) + &
2338 xeq_a(ja_so4)*nc_mc(jc_na))/ &
2339 mw_electrolyte(jna2so4)
2340
2341 eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) + &
2342 xeq_a(ja_hso4)*nc_mc(jc_na))/ &
2343 mw_electrolyte(jnahso4)
2344
2345 eleliquid(jnano3) = (xeq_c(jc_na) *na_ma(ja_no3) + &
2346 xeq_a(ja_no3)*nc_mc(jc_na))/ &
2347 mw_electrolyte(jnano3)
2348
2349 eleliquid(jnacl) = (xeq_c(jc_na) *na_ma(ja_cl) + &
2350 xeq_a(ja_cl) *nc_mc(jc_na))/ &
2351 mw_electrolyte(jnacl)
2352
2353 eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
2354 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
2355 mw_electrolyte(jnh4so4)
2356
2357 eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) + &
2358 xeq_a(ja_hso4)*nc_mc(jc_nh4))/ &
2359 mw_electrolyte(jnh4hso4)
2360
2361 eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
2362 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
2363 mw_electrolyte(jnh4no3)
2364
2365 eleliquid(jnh4cl) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
2366 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
2367 mw_electrolyte(jnh4cl)
2368
2369 eleliquid(jcano3) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
2370 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
2371 mw_electrolyte(jcano3)
2372
2373 eleliquid(jcacl2) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
2374 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
2375 mw_electrolyte(jcacl2)
2376
2377 eleliquid(jh2so4) = (xeq_c(jc_h) *na_ma(ja_hso4) + &
2378 xeq_a(ja_hso4)*nc_mc(jc_h))/ &
2379 mw_electrolyte(jh2so4)
2380
2381 eleliquid(jhno3) = (xeq_c(jc_h) *na_ma(ja_no3) + &
2382 xeq_a(ja_no3)*nc_mc(jc_h))/ &
2383 mw_electrolyte(jhno3)
2384
2385 eleliquid(jhcl) = (xeq_c(jc_h) *na_ma(ja_cl) + &
2386 xeq_a(ja_cl)*nc_mc(jc_h))/ &
2387 mw_electrolyte(jhcl)
2388
2389 !--------------------------------------------------------------------
2390
2391 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
2392
2393 jp = jliquid
2394 xt_d = xt
2395 xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
2396 xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
2397
2398 dum = real( dble(2.*aer(iso4_a,jp,ibin)) - &
2399 dble(aer(ina_a,jp,ibin)) )
2400 if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
2401 xnh4_d = 2.*aer(inh4_a,jp,ibin)/ &
2402 (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
2403 else
2404 xnh4_d = 0.0
2405 endif
2406
2407
2408 if(aer(inh4_a,jp,ibin) .gt. 0.0)then
2409
2410
2411 if(xt_d .ge. xna_d)then
2412 eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
2413
2414 if(xnh4_d .ge. 5./3.)then
2415 eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin) &
2416 - 3.*xdum - aer(inh4_a,jp,ibin)
2417 eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin) &
2418 - aer(ina_a,jp,ibin)
2419 elseif(xnh4_d .ge. 1.5)then
2420 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
2421 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
2422 elseif(xnh4_d .ge. 1.0)then
2423 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2424 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2425 eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
2426 endif
2427
2428 elseif(xt_d .gt. 1.0)then
2429 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2430 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2431 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
2432 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/3.
2433 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/3.
2434 elseif(xt_d .le. 1.0)then
2435 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2436 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2437 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2438 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
2439 endif
2440
2441 else
2442
2443 if(xt_d .gt. 1.0)then
2444 eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
2445 eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) - &
2446 aer(ina_a,jp,ibin)
2447 else
2448 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2449 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2450 endif
2451
2452
2453 endif
2454
2455
2456
2457 endif
2458 !---------------------------------------------------------
2459 !
2460 ! calculate % composition
2461 thesum = 0.0
2462 do je = 1, nelectrolyte
2463 thesum = thesum + eleliquid(je)
2464 enddo
2465
2466 electrolyte_sum(jp,ibin) = thesum
2467
2468 if(thesum .eq. 0.)thesum = 1.0
2469 do je = 1, nelectrolyte
2470 epercent(je,jp,ibin) = 100.*eleliquid(je)/thesum
2471 enddo
2472
2473
2474 return
2475 end subroutine mesa_estimate_eleliquid
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486 !***********************************************************************
2487 ! part of mesa: completely dissolves small amounts of soluble salts
2488 !
2489 ! author: rahul a. zaveri
2490 ! update: jan 2005
2491 !-----------------------------------------------------------------------
2492 subroutine mesa_dissolve_small_salt(ibin,js)
2493 ! implicit none
2494 ! include 'mosaic.h'
2495 ! subr arguments
2496 integer ibin, js
2497
2498
2499
2500 if(js .eq. jnh4so4)then
2501 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2502 2.*electrolyte(js,jsolid,ibin)
2503 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2504 electrolyte(js,jsolid,ibin)
2505 electrolyte(js,jsolid,ibin) = 0.0
2506 return
2507 endif
2508
2509
2510 if(js .eq. jlvcite)then
2511 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2512 3.*electrolyte(js,jsolid,ibin)
2513 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2514 2.*electrolyte(js,jsolid,ibin)
2515 electrolyte(js,jsolid,ibin) = 0.0
2516 return
2517 endif
2518
2519
2520 if(js .eq. jnh4hso4)then
2521 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2522 electrolyte(js,jsolid,ibin)
2523 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2524 electrolyte(js,jsolid,ibin)
2525 electrolyte(js,jsolid,ibin) = 0.0
2526 return
2527 endif
2528
2529
2530 if(js .eq. jna2so4)then
2531 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2532 2.*electrolyte(js,jsolid,ibin)
2533 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2534 electrolyte(js,jsolid,ibin)
2535 electrolyte(js,jsolid,ibin) = 0.0
2536 return
2537 endif
2538
2539
2540 if(js .eq. jna3hso4)then
2541 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2542 3.*electrolyte(js,jsolid,ibin)
2543 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2544 2.*electrolyte(js,jsolid,ibin)
2545 electrolyte(js,jsolid,ibin) = 0.0
2546 return
2547 endif
2548
2549
2550 if(js .eq. jnahso4)then
2551 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2552 electrolyte(js,jsolid,ibin)
2553 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2554 electrolyte(js,jsolid,ibin)
2555 electrolyte(js,jsolid,ibin) = 0.0
2556 return
2557 endif
2558
2559
2560 if(js .eq. jnh4no3)then
2561 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2562 electrolyte(js,jsolid,ibin)
2563 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2564 electrolyte(js,jsolid,ibin)
2565 electrolyte(js,jsolid,ibin) = 0.0
2566 return
2567 endif
2568
2569
2570 if(js .eq. jnh4cl)then
2571 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2572 electrolyte(js,jsolid,ibin)
2573 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2574 electrolyte(js,jsolid,ibin)
2575 electrolyte(js,jsolid,ibin) = 0.0
2576 return
2577 endif
2578
2579
2580 if(js .eq. jnano3)then
2581 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2582 electrolyte(js,jsolid,ibin)
2583 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2584 electrolyte(js,jsolid,ibin)
2585 electrolyte(js,jsolid,ibin) = 0.0
2586 return
2587 endif
2588
2589
2590 if(js .eq. jnacl)then
2591 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2592 electrolyte(js,jsolid,ibin)
2593 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2594 electrolyte(js,jsolid,ibin)
2595 electrolyte(js,jsolid,ibin) = 0.0
2596 return
2597 endif
2598
2599
2600 if(js .eq. jcano3)then
2601 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2602 electrolyte(js,jsolid,ibin)
2603 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2604 2.*electrolyte(js,jsolid,ibin)
2605 electrolyte(js,jsolid,ibin) = 0.0
2606 return
2607 endif
2608
2609
2610 if(js .eq. jcacl2)then
2611 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2612 electrolyte(js,jsolid,ibin)
2613 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2614 2.*electrolyte(js,jsolid,ibin)
2615 electrolyte(js,jsolid,ibin) = 0.0
2616 return
2617 endif
2618
2619
2620
2621 return
2622 end subroutine mesa_dissolve_small_salt
2623
2624
2625
2626
2627
2628
2629 !***********************************************************************
2630 ! part of mesa: checks mesa convergence
2631 !
2632 ! author: rahul a. zaveri
2633 ! update: jan 2005
2634 !-----------------------------------------------------------------------
2635 subroutine mesa_convergence_criterion(itdum, ibin, &
2636 iconverge_mass, &
2637 iconverge_flux)
2638 ! implicit none
2639 ! include 'mosaic.h'
2640 ! subr arguments
2641 integer itdum, ibin, iconverge_mass, iconverge_flux
2642 ! local variables
2643 integer je, js, iaer
2644 real frac_solid, xt
2645
2646
2647
2648 ! check mass convergence
2649 iconverge_mass = 0 ! default value = no convergence
2650
2651 call electrolytes_to_ions(jsolid,ibin)
2652
2653 dry_mass(ibin) = 0.0
2654 do iaer = 1, naer
2655 dry_mass(ibin) = dry_mass(ibin) + &
2656 aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-9
2657 enddo
2658 dry_mass(ibin) = dry_mass(ibin) + & ! [g/m^3(air)]
2659 aer(ioc_a,jtotal,ibin)*1.e-9 + &
2660 aer(ibc_a,jtotal,ibin)*1.e-9 + &
2661 aer(ioin_a,jtotal,ibin)*1.e-9
2662
2663 frac_solid = dry_mass(ibin)/total_dry_mass(ibin)
2664
2665 if(frac_solid .ge. 0.98)then
2666
2667 iconverge_mass = 1
2668
2669 endif
2670
2671
2672
2673 ! check relative driving force convergence
2674 iconverge_flux = 1
2675 do js = 1, nsalt
2676 ! if(flux_sl(js).ne.0.0 .and. abs(phi_salt(js)).gt.0.01)then
2677 if(abs(phi_salt(js)).gt.0.02)then
2678 iconverge_flux = 0
2679 endif
2680 enddo
2681
2682
2683 return
2684 end subroutine mesa_convergence_criterion
2685
2686
2687
2688 ! end of mesa package
2689 !=======================================================================
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719 !***********************************************************************
2720 ! asceem: adaptive step coupled explicit euler method
2721 !
2722 ! author: rahul a. zaveri
2723 ! update: apr 2005
2724 !-----------------------------------------------------------------------
2725 subroutine asceem(dtchem)
2726 ! implicit none
2727 ! include 'mosaic.h'
2728 ! subr arguments
2729 real dtchem
2730 ! local variables
2731 integer ibin, iv, jp, isteps, nsteps_asceem, jcall, &
2732 ieqblm
2733 real dtmax, t_in, t_new, t_old, t_out, delta_aer, xt, &
2734 avg_asceem_steps
2735
2736
2737 t_in = 0.0
2738 t_out = dtchem
2739 t_old = t_in
2740
2741 jcall = jcall + 1
2742
2743 isteps = 0
2744
2745 ! set default alpha_gas and alpha_aer, and phi_volatile
2746 do iv = 1, naer_vol
2747
2748 do ibin = 1, nbin_a
2749 phi_volatile(iv,ibin) = 0.0
2750 phi_nh4no3(ibin) = 0.0
2751 phi_nh4cl(ibin) = 0.0
2752 enddo
2753
2754 enddo
2755
2756
2757
2758
2759
2760
2761 ! compute aerosol phase state before starting integration
2762 do ibin = 1, nbin_a
2763 if(jaerosolstate(ibin) .ne. no_aerosol)then
2764 call aerosol_phase_state(ibin)
2765 endif
2766 enddo
2767
2768
2769
2770 ! compute new gas-aerosol mass transfer coefficients
2771 call aerosolmtc
2772
2773
2774
2775
2776 ! begin integration over transport time-step
2777 !======================================================
2778 ! calculate fluxes
2779 10 do 501 ibin = 1, nbin_a
2780
2781 mxfer_massbal(ibin) = mno
2782
2783 if(jphase(ibin) .eq. jsolid)then
2784 call asceem_flux_dry(ibin)
2785 elseif(jphase(ibin) .eq. jliquid)then
2786 call asceem_flux_wet(ibin)
2787 endif
2788
2789 501 continue
2790
2791
2792
2793 !-------------------------
2794 ! check if all the bins have reached equilibrium
2795 ieqblm = myes ! initalize to default (eqblm)
2796
2797 do ibin = 1, nbin_a
2798
2799 do iv = 1, naer_vol
2800 if(flux(iv, ibin) .ne. 0.0)then
2801 ieqblm = mno ! non-eqblm
2802 endif
2803 enddo
2804
2805 enddo
2806
2807
2808 if(ieqblm .eq. myes)then
2809 do 502 ibin = 1, nbin_a
2810 if(jaerosolstate(ibin) .eq. no_aerosol)goto 502
2811
2812 do iv = 1, naer_vol
2813 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
2814 enddo
2815
2816 mxfer_massbal(ibin) = myes ! always yes in asceem
2817 if(mxfer_massbal(ibin) .eq. myes)then
2818 call conform_electrolytes(jtotal,ibin,xt) ! xfer_massbal + mdrh diagnosis
2819 else
2820 call form_electrolytes(jtotal,ibin,xt) ! for mdrh diagnosis
2821 endif
2822
2823
2824 if(jhyst_leg(ibin) .eq. jhyst_lo)then
2825 call asteem_update_phase_eqblm(ibin)
2826 else
2827 call do_full_deliquescence(ibin) ! simply do liquid <-- total
2828 endif
2829
2830 call monitor_massbalance_out(ibin, isteps)
2831
2832 502 continue
2833 endif
2834 !-------------------------
2835
2836
2837
2838
2839 ! calculate maximum possible internal time-step
2840 call asceem_calculate_dtmax(dtchem, dtmax)
2841 t_new = t_old + dtmax ! update time
2842 if(t_new .gt. t_out)then ! check if the new time step is too large
2843 dtmax = t_out - t_old
2844 t_new = t_out
2845 endif
2846
2847
2848
2849
2850 isteps = isteps + 1
2851
2852
2853
2854
2855 ! do internal time-step integration--------------
2856
2857 do 40 ibin = 1, nbin_a
2858 if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
2859
2860 jp = jphase(ibin)
2861
2862 do 20 iv = 1, naer_vol
2863
2864 delta_aer = dtmax*flux(iv,ibin)
2865
2866 aer(iv,jp,ibin)=real(dble(aer(iv,jp,ibin)) + dble(delta_aer))
2867 gas(iv) =real( dble(gas(iv)) - dble(delta_aer) )
2868
2869 aer(iv,jp,ibin)=max(aer(iv,jp,ibin), 0.0)
2870 gas(iv) =max(gas(iv), 0.0)
2871
2872 20 continue
2873
2874 ! degas excess nh3 (if present)
2875 call form_electrolytes(jp,ibin,xt)
2876
2877 ! update jtotal
2878 do iv = 1, naer_vol
2879 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
2880 enddo
2881
2882 if(mxfer_massbal(ibin) .eq. myes)then
2883 call conform_electrolytes(jtotal,ibin,xt) ! xfer_massbal + mdrh diagnosis
2884 else
2885 call form_electrolytes(jtotal,ibin,xt) ! for mdrh diagnosis
2886 endif
2887
2888 40 continue
2889 ! end internal time-step integration-------------
2890
2891
2892 do 50 ibin = 1, nbin_a
2893
2894 if(jaerosolstate(ibin) .eq. no_aerosol)goto 50
2895
2896 if(jhyst_leg(ibin) .eq. jhyst_lo)then
2897 call asteem_update_phase_eqblm(ibin)
2898 else
2899 call do_full_deliquescence(ibin) ! simply do liquid <-- total
2900 endif
2901
2902 50 continue
2903
2904
2905
2906 ! update time
2907 t_old = t_new
2908
2909 if(t_new .lt. 0.9999*t_out) goto 10
2910 !================================================
2911 ! end of integration over the transport time-step
2912
2913
2914 nsteps_asceem = nsteps_asceem + isteps
2915
2916 avg_asceem_steps = float(nsteps_asceem)/float(jcall)
2917
2918 if(mod(jcall,1).eq.0)then
2919 write(6,*)'avg asceem steps =',avg_asceem_steps
2920 endif
2921
2922
2923
2924
2925 return
2926 end subroutine asceem
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941 !***********************************************************************
2942 ! part of asceem: computes max time step for gas-aerosol integration
2943 !
2944 ! author: rahul a. zaveri
2945 ! update: jan 2005
2946 !-----------------------------------------------------------------------
2947 subroutine asceem_calculate_dtmax(dtchem, dtmax)
2948 ! implicit none
2949 ! include 'mosaic.h'
2950 ! subr arguments
2951 real dtchem, dtmax
2952 ! local variables
2953 integer ibin, iv
2954 real alpha, h_aer, h_gas, h_max, &
2955 h_gas_i(naer_vol), &
2956 h_aer_i_m(naer_vol, nbin_a), &
2957 h_aer_m(nbin_a)
2958
2959
2960
2961
2962
2963 ! set alpha_gas and alpha_aer
2964 do ibin = 1, nbin_a
2965 do iv = 1, naer_vol
2966
2967 alpha_gas(iv) = alpha_asteem
2968
2969 if(madapt_alpha .eq. mon)then
2970 alpha_aer(iv,ibin) = max(abs(phi_volatile(iv,ibin)), &
2971 alpha_asteem)
2972 alpha_aer(iv,ibin) = min(alpha_aer(iv,ibin), 10.0)
2973
2974 else
2975 alpha_aer(iv,ibin) = alpha_asteem ! fixed alpha_aer
2976
2977 endif
2978
2979 enddo
2980 enddo
2981
2982
2983
2984
2985
2986 ! gas-side
2987 ! calculate h_gas_i and h_gas
2988
2989 h_gas = 2.e16
2990 do 5 ibin = 1, nbin_a
2991 do iv = 1, naer_vol
2992
2993 h_gas_i(iv) = 1.e16
2994 if(flux(iv,ibin) .gt. 0.0)then
2995 h_gas_i(iv) = alpha_gas(iv)/kg(iv,ibin)
2996 h_gas = min(h_gas, h_gas_i(iv))
2997 endif
2998
2999 enddo
3000 5 continue
3001
3002
3003 ! aerosol-side
3004 ! calculate h_aer_i_m, h_aer_m, h_aer
3005 h_aer = 1.e16
3006
3007 do 20 ibin = 1, nbin_a
3008 h_aer_m(ibin) = 4.e15 ! initialize
3009
3010 if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
3011
3012 call make_volatile_a(ibin)
3013
3014
3015 ! solid
3016 if(jphase(ibin) .eq. jsolid)then ! solid aerosol
3017
3018 do 10 iv = 1, naer_vol
3019 h_aer_i_m(iv,ibin) = 2.e15 ! initialize
3020
3021 if(flux(iv,ibin).lt.0.)then ! aer -> gas
3022 alpha = min(alpha_aer(iv,ibin),0.5)
3023 h_aer_i_m(iv,ibin) = -alpha*volatile_a(iv)/flux(iv,ibin) ! degas completely
3024 endif
3025
3026 h_aer_m(ibin) = min(h_aer_m(ibin),h_aer_i_m(iv,ibin))
3027 h_aer = min(h_aer, h_aer_i_m(iv,ibin))
3028 10 continue
3029
3030
3031
3032
3033
3034 ! liquid or mixed-phase
3035 elseif(jphase(ibin) .eq. jliquid)then
3036
3037 do 11 iv = 1, naer_vol
3038 h_aer_i_m(iv,ibin) = 2.e15 ! initialize
3039
3040 if(flux(iv,ibin).gt.0. .and. & ! gas -> aer
3041 electrolyte(jcaco3,jsolid,ibin) .eq. 0.)then
3042
3043 if(aer(iv,jliquid,ibin) .gt. 0.0)then
3044 h_aer_i_m(iv,ibin)=alpha_aer(iv,ibin)*aer(iv,jliquid,ibin)/ & ! aer(i,jliquid) =< aer(i,jtotal)
3045 flux(iv,ibin)
3046 endif
3047
3048 elseif(flux(iv,ibin).lt.0. .and. volatile_a(iv).gt.0.0)then ! aer -> gas
3049 alpha = min(alpha_aer(iv,ibin), 0.5)
3050 h_aer_i_m(iv,ibin)=-alpha*volatile_a(iv)/flux(iv,ibin)
3051 endif
3052
3053 h_aer_m(ibin) = min(h_aer_m(ibin),h_aer_i_m(iv,ibin))
3054 h_aer = min(h_aer, h_aer_i_m(iv,ibin))
3055 11 continue
3056
3057 endif
3058
3059
3060
3061
3062
3063 20 continue
3064
3065
3066 h_max = min(h_aer, h_gas)
3067
3068 dtmax = min(dtchem, h_max)
3069 h_max = dtmax
3070
3071
3072 if(dtmax .le. 1.0e-10)then
3073 write(6,*)' dtmax = ', dtmax
3074 endif
3075
3076 return
3077 end subroutine asceem_calculate_dtmax
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096 !***********************************************************************
3097 ! part of asceem: computes gas-aerosol fluxes over dry aerosols.
3098 !
3099 ! author: rahul a. zaveri
3100 ! update: jan 2005
3101 !-----------------------------------------------------------------------
3102 subroutine asceem_flux_dry(ibin)
3103 ! implicit none
3104 ! include 'mosaic.h'
3105 ! subr arguments
3106 integer ibin
3107 ! local variables
3108 integer iv
3109 real xt, xnh4, g_nh3_hno3, g_nh3_hcl, &
3110 a_nh4_no3, a_nh4_cl, &
3111 prod_nh4no3, prod_nh4cl, &
3112 volatile_cl, volatile_no3
3113
3114
3115
3116
3117
3118 call calculate_xt(ibin,jsolid,xt)
3119
3120 ! h2so4
3121 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3122 phi_volatile(ih2so4_g,ibin) = 1.0
3123
3124 !-----------------------------------------------------------------
3125 ! case 1: sulfate-rich domain
3126
3127 if(xt.lt.2.0 .and. xt.ge.0.)then ! excess sulfate (acidic)
3128
3129 call asceem_flux_dry_case1(ibin)
3130
3131 return
3132 endif
3133
3134 !-----------------------------------------------------------------
3135 ! case 2: caco3 > 0 absorb all acids (and indirectly degas co2)
3136
3137 if(electrolyte(jcaco3,jtotal,ibin) .gt. 0.0)then
3138
3139 call asceem_flux_dry_case2(ibin)
3140
3141 return
3142 endif
3143
3144 !-----------------------------------------------------------------
3145 ! case 3: hno3 and hcl exchange may happen here
3146
3147 volatile_cl = electrolyte(jnacl,jsolid,ibin) + &
3148 electrolyte(jcacl2,jsolid,ibin)
3149
3150
3151 if(volatile_cl .gt. 0.0 .and. &
3152 gas(ihno3_g).gt. 0.0 )then
3153
3154 call asceem_flux_dry_case3(ibin)
3155
3156 return
3157 endif
3158
3159 !-----------------------------------------------------------------
3160 ! case 4: nh4no3 or nh4cl or both may be active
3161
3162 prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-keq_sg(1)), 0.0) + &
3163 epercent(jnh4no3,jsolid,ibin)
3164 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g) -keq_sg(2)), 0.0) + &
3165 epercent(jnh4cl,jsolid,ibin)
3166
3167 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
3168 call asceem_flux_dry_case4(ibin)
3169 return
3170 endif
3171
3172 !-----------------------------------------------------------------
3173 ! case 5: condense h2so4 and degas hno3
3174 volatile_no3 = epercent(jnano3,jsolid,ibin) + &
3175 epercent(jcano3,jsolid,ibin)
3176
3177 if(volatile_no3 .gt. 0.0 .and. &
3178 gas(ih2so4_g).gt. 0.0 )then
3179
3180 call asceem_flux_dry_case5(ibin)
3181
3182 return
3183 endif
3184
3185 !-------------------------------------------------------------------
3186 ! case 6: probably pure (nh4)2so4 particle.
3187 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3188 flux(ihno3_g,ibin) = 0.0
3189 flux(ihcl_g,ibin) = 0.0
3190 flux(inh3_g,ibin) = min( kg(inh3_g,ibin)*gas(inh3_g), &
3191 2.*flux(ih2so4_g,ibin) )
3192 return
3193
3194 end subroutine asceem_flux_dry
3195
3196 !----------------------------------------------------------------------
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209 !***********************************************************************
3210 ! part of asceem: subroutines for various flux_dry cases
3211 !
3212 ! author: rahul a. zaveri
3213 ! update: jan 2005
3214 !-----------------------------------------------------------------------
3215 !
3216 !
3217 ! case 1: sulfate-rich domain
3218 !
3219 subroutine asceem_flux_dry_case1(ibin)
3220 ! implicit none
3221 ! include 'mosaic.h'
3222 ! subr arguments
3223 integer ibin
3224
3225
3226
3227 sfc_a(ih2so4_g)= 0.0
3228 sfc_a(ihno3_g) = gas(ihno3_g)
3229 sfc_a(ihcl_g) = gas(ihcl_g)
3230 sfc_a(inh3_g) = 0
3231
3232 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
3233 df_gas(ihno3_g,ibin) = 0.0
3234 df_gas(ihcl_g,ibin) = 0.0
3235 df_gas(inh3_g,ibin) = gas(inh3_g)
3236
3237 phi_volatile(ihno3_g,ibin) = 0.0
3238 phi_volatile(ihcl_g,ibin) = 0.0
3239 phi_volatile(inh3_g,ibin) = 1.0
3240
3241 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3242 flux(ihno3_g,ibin) = 0.0
3243 flux(ihcl_g,ibin) = 0.0
3244 flux(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
3245
3246
3247 return
3248 end subroutine asceem_flux_dry_case1
3249
3250
3251
3252
3253
3254
3255 ! case 2: caco3 > 0 absorb all acids (and indirectly degas co2)
3256 !
3257 subroutine asceem_flux_dry_case2(ibin)
3258 ! implicit none
3259 ! include 'mosaic.h'
3260 ! subr arguments
3261 integer ibin
3262
3263
3264 mxfer_massbal(ibin) = myes ! degas co2 via mass bal
3265
3266 sfc_a(ih2so4_g)= 0.0
3267 sfc_a(ihno3_g) = 0.0
3268 sfc_a(ihcl_g) = 0.0
3269 sfc_a(inh3_g) = gas(inh3_g)
3270
3271 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
3272 df_gas(ihno3_g,ibin) = gas(ihno3_g)
3273 df_gas(ihcl_g,ibin) = gas(ihcl_g)
3274 df_gas(inh3_g,ibin) = 0.0
3275
3276 phi_volatile(ih2so4_g,ibin)= 1.0
3277 phi_volatile(ihno3_g,ibin) = 1.0
3278 phi_volatile(ihcl_g,ibin) = 1.0
3279 phi_volatile(inh3_g,ibin) = 0.0
3280
3281 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
3282 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
3283 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*gas(ihcl_g)
3284 flux(inh3_g,ibin) = 0.0
3285
3286
3287 return
3288 end subroutine asceem_flux_dry_case2
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299 ! case 3: hno3 and hcl exchange may happen here
3300 !
3301 subroutine asceem_flux_dry_case3(ibin)
3302 ! implicit none
3303 ! include 'mosaic.h'
3304 ! subr arguments
3305 integer ibin
3306
3307
3308 ! just degas hcl from nacl or cacl2 by flux balance with 2 h2so4 and hno3
3309 mxfer_massbal(ibin) = myes
3310
3311 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
3312 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
3313 flux(ihcl_g,ibin) = 0.0 ! degas via mass bal
3314 flux(inh3_g,ibin) = 0.0
3315
3316
3317 return
3318 end subroutine asceem_flux_dry_case3
3319
3320
3321
3322
3323
3324
3325 ! case 4: nh4no3 and/or nh4cl may be active
3326 subroutine asceem_flux_dry_case4(ibin)
3327
3328 ! implicit none
3329 ! include 'mosaic.h'
3330 ! subr arguments
3331 integer ibin
3332 ! local variables
3333 integer iactive_nh4no3, iactive_nh4cl, iactive
3334 real gnh3_hno3, gnh3_hcl, pcnt_nh4no3, pcnt_nh4cl, &
3335 a, b, c, ratio_flux, &
3336 flux_nh3_max, flux_nh3_est, &
3337 flux_nh3_max_d, flux_nh3_est_d
3338 ! function
3339 ! real quadratic
3340
3341
3342 !-------------------
3343 ! set default values for flags
3344 iactive_nh4no3 = 1
3345 iactive_nh4cl = 2
3346
3347 !-------------------
3348 ! compute diagnostic products and ratios
3349 gnh3_hno3 = gas(inh3_g)*gas(ihno3_g)
3350 gnh3_hcl = gas(inh3_g)*gas(ihcl_g)
3351
3352 phi_nh4no3(ibin) = abs(keq_sg(1) - gnh3_hno3)/ &
3353 max(keq_sg(1), gnh3_hno3)
3354 phi_nh4cl(ibin) = abs(keq_sg(2) - gnh3_hcl)/ &
3355 max(keq_sg(2), gnh3_hcl)
3356
3357 pcnt_nh4no3 = epercent(jnh4no3,jsolid,ibin)
3358 pcnt_nh4cl = epercent(jnh4cl, jsolid,ibin)
3359
3360
3361 !-------------------
3362 ! now determine if nh4no3 and/or nh4cl are active or significant
3363
3364 ! nh4no3
3365 if( phi_nh4no3(ibin) .lt. 0.02 )then
3366 iactive_nh4no3 = 0
3367 elseif(gnh3_hno3.lt.keq_sg(1) .and. pcnt_nh4no3.lt.1.0)then
3368 iactive_nh4no3 = 0
3369 call degas_solid_nh4no3(ibin)
3370 endif
3371
3372 ! nh4cl
3373 if( phi_nh4cl(ibin) .lt. 0.02 )then
3374 iactive_nh4cl = 0
3375 elseif(gnh3_hcl.lt.keq_sg(2) .and. pcnt_nh4cl.lt.1.0)then
3376 iactive_nh4cl = 0
3377 call degas_solid_nh4cl(ibin)
3378 endif
3379
3380
3381 iactive = iactive_nh4no3 + iactive_nh4cl
3382
3383 ! check the outcome
3384 if(iactive .eq. 0)then
3385 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
3386 flux(ihno3_g,ibin) = 0.0
3387 flux(ihcl_g,ibin) = 0.0
3388 flux(inh3_g,ibin) = 0.0
3389 return
3390 endif
3391
3392 goto (1,2,3),iactive
3393
3394 !---------------------------------
3395 ! only nh4no3 is active
3396 1 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3397 flux(ihcl_g,ibin) = 0.0
3398
3399 a = kg(inh3_g,ibin)
3400 b = - kg(inh3_g,ibin)*gas(inh3_g) &
3401 + kg(ihno3_g,ibin)*gas(ihno3_g) &
3402 + 2.0*flux(ih2so4_g,ibin)
3403 c = -(kg(ihno3_g,ibin)*keq_sg(1))
3404
3405 sfc_a(inh3_g) = quadratic(a,b,c)
3406 sfc_a(ihno3_g) = keq_sg(1)/sfc_a(inh3_g)
3407 sfc_a(ihcl_g) = gas(ihcl_g)
3408
3409 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
3410 df_gas(ihcl_g,ibin) = 0.0
3411 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3412
3413
3414 phi_volatile(ihno3_g,ibin)= df_gas(ihno3_g,ibin)/ &
3415 max(sfc_a(ihno3_g), 1.e-10)
3416 phi_volatile(ihcl_g,ibin) = 0.0
3417 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
3418 max(sfc_a(inh3_g), 1.e-10)
3419
3420
3421 if(gnh3_hno3 .gt. keq_sg(1) .and. &
3422 sfc_a(ihno3_g) .gt. gas(ihno3_g) )then ! degas hno3 via mass bal
3423 mxfer_massbal(ibin) = myes
3424 phi_volatile(ihno3_g,ibin)= 0.0
3425 df_gas(ihno3_g,ibin) = 0.0
3426 flux(ihno3_g,ibin) = 0.0
3427 else
3428 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
3429 endif
3430
3431
3432 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
3433 flux(ihno3_g,ibin) + &
3434 flux(ihcl_g,ibin)
3435
3436 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
3437
3438
3439 if(flux_nh3_est .le. flux_nh3_max)then
3440
3441 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
3442 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
3443 flux(inh3_g,ibin)/kg(inh3_g,ibin)
3444 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3445 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
3446 max(sfc_a(inh3_g), 1.e-10)
3447
3448 else ! reduce hno3 flux as necessary
3449
3450 flux(inh3_g,ibin) = flux_nh3_max
3451 flux(ihno3_g,ibin) = max(flux_nh3_max-flux(ih2so4_g,ibin),0.0)
3452
3453 sfc_a(inh3_g) = 0.0
3454 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
3455 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
3456
3457 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3458 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
3459
3460 phi_volatile(inh3_g,ibin) = 10.0
3461 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ & ! recompute phi_volatile(ihno3_g,ibin)
3462 max(sfc_a(ihno3_g), 1.e-10)
3463 endif
3464
3465 return
3466
3467 !-----------------
3468 ! only nh4cl is active
3469 2 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3470 flux(ihno3_g,ibin) = 0.0
3471
3472 a = kg(inh3_g,ibin)
3473 b = - kg(inh3_g,ibin)*gas(inh3_g) &
3474 + kg(ihcl_g,ibin)*gas(ihcl_g) &
3475 + 2.0*flux(ih2so4_g,ibin)
3476 c = -(kg(ihcl_g,ibin)*keq_sg(2))
3477
3478 sfc_a(inh3_g) = quadratic(a,b,c)
3479 sfc_a(ihcl_g ) = keq_sg(2)/sfc_a(inh3_g)
3480 sfc_a(ihno3_g) = gas(ihno3_g)
3481
3482
3483 df_gas(ihno3_g,ibin) = 0.0
3484 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
3485 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3486
3487
3488 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ &
3489 max(sfc_a(ihcl_g), 1.e-10)
3490 phi_volatile(ihno3_g,ibin)= 0.0
3491 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
3492 max(sfc_a(inh3_g), 1.e-10)
3493
3494
3495 if(gnh3_hcl .gt. keq_sg(2) .and. &
3496 sfc_a(ihcl_g) .gt. gas(ihcl_g) )then ! degas hcl via mass bal
3497 mxfer_massbal(ibin) = myes
3498 phi_volatile(ihcl_g,ibin) = 0.0
3499 df_gas(ihcl_g,ibin) = 0.0
3500 flux(ihcl_g,ibin) = 0.0
3501 else
3502 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
3503 endif
3504
3505 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
3506 flux(ihno3_g,ibin) + &
3507 flux(ihcl_g,ibin)
3508
3509 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
3510
3511
3512 if(flux_nh3_est .le. flux_nh3_max)then
3513
3514 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
3515 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
3516 flux(inh3_g,ibin)/kg(inh3_g,ibin)
3517 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3518 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
3519 max(sfc_a(inh3_g), 1.e-10)
3520
3521 else ! reduce hcl flux as necessary
3522
3523 flux(inh3_g,ibin) = flux_nh3_max
3524 flux(ihcl_g,ibin) = max(flux_nh3_max-flux(ih2so4_g,ibin),0.0)
3525
3526 sfc_a(inh3_g) = 0.0
3527 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
3528 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
3529
3530 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3531 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
3532
3533 phi_volatile(inh3_g,ibin) = 10.0
3534 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ & ! recompute phi_volatile(ihcl_g,ibin)
3535 max(sfc_a(ihcl_g), 1.e-10)
3536
3537 endif
3538
3539 return
3540
3541 !-----------------
3542 ! both nh4no3 and nh4cl are active
3543 3 continue
3544
3545 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
3546
3547 a = kg(inh3_g,ibin)
3548 b = - kg(inh3_g,ibin)*gas(inh3_g) &
3549 + kg(ihno3_g,ibin)*gas(ihno3_g) &
3550 + kg(ihcl_g,ibin)*gas(ihcl_g) &
3551 + 2.0*flux(ih2so4_g,ibin)
3552 c = -( kg(ihno3_g,ibin)*keq_sg(1) + kg(ihcl_g,ibin)*keq_sg(2) )
3553
3554 sfc_a(inh3_g) = quadratic(a,b,c)
3555 sfc_a(ihno3_g) = keq_sg(1)/sfc_a(inh3_g)
3556 sfc_a(ihcl_g) = keq_sg(2)/sfc_a(inh3_g)
3557 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
3558 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
3559 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3560
3561 if(gnh3_hno3 .gt. keq_sg(1) .and. &
3562 sfc_a(ihno3_g) .gt. gas(ihno3_g) )then ! degas hno3 via mass bal
3563 mxfer_massbal(ibin) = myes
3564 phi_volatile(ihno3_g,ibin)= 0.0
3565 df_gas(ihno3_g,ibin) = 0.0
3566 flux(ihno3_g,ibin) = 0.0
3567 else
3568 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
3569 endif
3570
3571
3572 if(gnh3_hcl .gt. keq_sg(2) .and. &
3573 sfc_a(ihcl_g) .gt. gas(ihcl_g) )then ! degas hcl via mass bal
3574 mxfer_massbal(ibin) = myes
3575 phi_volatile(ihcl_g,ibin) = 0.0
3576 df_gas(ihcl_g,ibin) = 0.0
3577 flux(ihcl_g,ibin) = 0.0
3578 else
3579 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
3580 endif
3581
3582
3583 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
3584 flux(ihno3_g,ibin) + &
3585 flux(ihcl_g,ibin)
3586
3587 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
3588
3589
3590 if(flux_nh3_est .le. flux_nh3_max)then
3591
3592 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
3593 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
3594 flux(inh3_g,ibin)/kg(inh3_g,ibin)
3595 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3596 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
3597 max(sfc_a(inh3_g), 1.e-10)
3598
3599 else ! reduce hno3 and hcl fluxes as necessary so that nh3 flux = flux_nh3_max
3600
3601 flux_nh3_est_d = max(flux_nh3_est-flux(ih2so4_g,ibin), 0.0)
3602 flux_nh3_max_d = max(flux_nh3_max-flux(ih2so4_g,ibin), 0.0)
3603
3604 if(flux_nh3_max_d .eq. 0.0)then
3605 ratio_flux = 0.0
3606 else
3607 ratio_flux = flux_nh3_max_d/flux_nh3_est_d
3608 endif
3609
3610 flux(inh3_g,ibin) = flux_nh3_max
3611 flux(ihno3_g,ibin) = flux(ihno3_g,ibin)*ratio_flux
3612 flux(ihcl_g, ibin) = flux(ihcl_g,ibin) *ratio_flux
3613
3614 sfc_a(inh3_g) = 0.0
3615 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
3616 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
3617 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
3618 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
3619
3620 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3621 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
3622 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
3623
3624 phi_volatile(inh3_g,ibin) = 10.0
3625 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ & ! recompute phi_volatile(ihno3_g,ibin)
3626 max(sfc_a(ihno3_g), 1.e-10)
3627 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ & ! recompute phi_volatile(ihcl_g,ibin)
3628 max(sfc_a(ihcl_g), 1.e-10)
3629
3630 endif
3631
3632
3633
3634 return
3635 end subroutine asceem_flux_dry_case4
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655 subroutine asceem_flux_dry_case5(ibin)
3656 ! implicit none
3657 ! include 'mosaic.h'
3658 ! subr arguments
3659 integer ibin
3660
3661
3662 ! just degas hno3 from nano3 or cano3 by flux balance with h2so4
3663 mxfer_massbal(ibin) = myes
3664
3665 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3666 flux(ihno3_g,ibin) = 0.0
3667 flux(ihcl_g,ibin) = 0.0
3668 flux(inh3_g,ibin) = 0.0
3669
3670
3671 return
3672 end subroutine asceem_flux_dry_case5
3673
3674 !----------------------------------------------------------------------
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712 !***********************************************************************
3713 ! part of asceem: computes gas-aerosol fluxes over wet aerosols
3714 !
3715 ! author: rahul a. zaveri
3716 ! update: jan 2005
3717 !-----------------------------------------------------------------------
3718 subroutine asceem_flux_wet(ibin)
3719 ! implicit none
3720 ! include 'mosaic.h'
3721 ! subr arguments
3722 integer ibin
3723 ! local variables
3724 integer iv, iadjust, iadjust_intermed, icontinue_case4
3725 real xt, xnh4, g_nh3_hno3, g_nh3_hcl, &
3726 a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
3727 prod_nh4no3, prod_nh4cl
3728
3729
3730
3731 !c call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
3732 !c call degas_acids(jliquid,ibin,xt)
3733 call ions_to_electrolytes(jliquid,ibin,xt) ! for water content calculation
3734 call compute_activities(ibin)
3735
3736 if(water_a(ibin) .eq. 0.0)then
3737 write(6,*)'water is zero in liquid phase'
3738 write(6,*)'stopping in asceem_flux_wet'
3739 ! stop
3740 call peg_error_fatal( lunerr_aer, &
3741 'stopping in asceem_flux_wet' )
3742 endif
3743
3744 call calculate_xt(ibin,jliquid,xt)
3745
3746 ! calculate xnh4
3747 if(aer(iso4_a,jliquid,ibin).gt.0.0)then
3748 xnh4 = aer(inh4_a,jliquid,ibin)/aer(iso4_a,jliquid,ibin)
3749 else
3750 xnh4 = -1.0
3751 endif
3752
3753
3754 ! h2so4
3755 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
3756 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
3757 phi_volatile(ih2so4_g,ibin) = 1.0
3758
3759
3760 !-------------------------------------------------------------------
3761 ! case 1: sulfate-rich domain
3762
3763 if(xt.lt.2.0 .and. xt.ge.0.)then
3764 call asceem_flux_wet_case1(ibin)
3765 return
3766 endif
3767
3768 !-------------------------------------------------------------------
3769 ! case 2: caco3 > 0 absorb acids (and indirectly degas co2)
3770
3771 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
3772 call asceem_flux_wet_case2(ibin)
3773 return
3774 endif
3775
3776 !-------------------------------------------------------------------
3777 ! do some small adjustments before deciding case 3
3778 !
3779 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
3780 iadjust = mno ! default
3781 iadjust_intermed = mno ! default
3782
3783 ! nh4no3
3784 g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
3785 a_nh4_no3 = epercent(jnh4no3,jliquid,ibin)
3786
3787 if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .lt. 0.1)then
3788 call absorb_tiny_nh4no3(ibin)
3789 iadjust = myes
3790 iadjust_intermed = myes
3791 elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
3792 call degas_tiny_nh4no3(ibin)
3793 iadjust = myes
3794 iadjust_intermed = myes
3795 endif
3796
3797 if(iadjust_intermed .eq. myes)then
3798 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
3799 iadjust_intermed = mno ! reset
3800 endif
3801
3802 ! nh4cl
3803 g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
3804 a_nh4_cl = epercent(jnh4cl,jliquid,ibin)
3805
3806 if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .lt. 0.1)then
3807 call absorb_tiny_nh4cl(ibin)
3808 iadjust = myes
3809 iadjust_intermed = myes
3810 elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
3811 call degas_tiny_nh4cl(ibin)
3812 iadjust = myes
3813 iadjust_intermed = myes
3814 endif
3815
3816 if(iadjust_intermed .eq. myes)then
3817 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
3818 iadjust_intermed = mno ! reset
3819 endif
3820
3821 ! hno3
3822 a_no3 = aer_percent(ino3_a,jliquid,ibin)
3823 if(gas(ihno3_g).gt.0. .and. a_no3 .lt. 0.1 .and. &
3824 aer(icl_a,jliquid,ibin) .gt. 0.0)then
3825 call absorb_tiny_hno3(ibin) ! and degas tiny hcl
3826 iadjust = myes
3827 iadjust_intermed = myes
3828 endif
3829
3830
3831 ! hcl
3832 a_cl = aer_percent(icl_a,jliquid,ibin)
3833 if(gas(ihcl_g).gt.0. .and. a_cl .lt. 0.1 .and. &
3834 aer(ino3_a,jliquid,ibin) .gt. 0.0)then
3835 call absorb_tiny_hcl(ibin) ! and degas tiny hno3
3836 iadjust = myes
3837 iadjust_intermed = myes
3838 endif
3839
3840
3841 if(iadjust_intermed .eq. myes)then
3842 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
3843 endif
3844
3845 if(iadjust .eq. myes)then
3846 call compute_activities(ibin) ! update after adjustments
3847 endif
3848
3849
3850 ! all adjustments done...
3851
3852 !--------
3853 prod_nh4no3 = gas(inh3_g)*gas(ihno3_g) + activity(jnh4no3,ibin)
3854 prod_nh4cl = gas(inh3_g)*gas(ihcl_g) + activity(jnh4cl,ibin)
3855 !
3856 ! case 3: nh4no3 and/or nh4cl maybe active
3857 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
3858 call asceem_flux_wet_case3(ibin, icontinue_case4)
3859 if(icontinue_case4 .eq. mno)return
3860 endif
3861
3862 !-------------------------------------------------------------------
3863 ! case 4: nh3 & nh4 ~ 0 (in gas and aerosol). hno3 and hcl exchange may happen here
3864
3865 if(ma(ja_no3,ibin)*ma(ja_cl,ibin) .gt. 0.0)then ! nh3 & nh4 ~ 0
3866 call asceem_flux_wet_case4(ibin)
3867 return
3868 endif
3869
3870 !-------------------------------------------------------------------
3871 ! case 5: default (may degas nh3)
3872
3873 call asceem_flux_wet_case5(ibin)
3874 return
3875
3876 end subroutine asceem_flux_wet
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895 !***********************************************************************
3896 ! part of asceem: subroutines for various flux_wet cases
3897 !
3898 ! author: rahul a. zaveri
3899 ! update: jan 2005
3900 !-----------------------------------------------------------------------
3901 !
3902 !
3903 ! case 1: sulfate-rich domain
3904 !
3905 subroutine asceem_flux_wet_case1(ibin)
3906 ! implicit none
3907 ! include 'mosaic.h'
3908 ! subr arguments
3909 integer ibin
3910
3911
3912
3913 if(aer(inh4_a,jliquid,ibin) .eq. 0. .and. gas(inh3_g) .gt. 0.)then
3914 call absorb_tiny_nh3(ibin)
3915 endif
3916
3917 call equilibrate_acids(ibin) ! updates aer(icl_a, ino3_a, jtotal), activity(jhcl,jhno3)
3918
3919 sfc_a(ihno3_g) = gas(ihno3_g)
3920 sfc_a(ihcl_g) = gas(ihcl_g)
3921 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
3922 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
3923
3924 df_gas(ihno3_g,ibin) = 0.0
3925 df_gas(ihcl_g,ibin) = 0.0
3926 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
3927
3928 phi_volatile(ihno3_g,ibin) = 0.0
3929 phi_volatile(ihcl_g,ibin) = 0.0
3930 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
3931 max(sfc_a(inh3_g), 1.e-10)
3932
3933 flux(ihno3_g,ibin) = 0.0
3934 flux(ihcl_g,ibin) = 0.0
3935
3936 ! check for equilibrium
3937 if(phi_volatile(inh3_g,ibin) .lt. 0.01 .and. &
3938 flux(ih2so4_g,ibin) .eq. 0.0)then
3939 flux(inh3_g,ibin) = 0.0
3940 else
3941 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
3942 endif
3943
3944
3945 return
3946 end subroutine asceem_flux_wet_case1
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958 ! case 2: caco3 > 0
3959 !
3960 subroutine asceem_flux_wet_case2(ibin)
3961 ! implicit none
3962 ! include 'mosaic.h'
3963 ! subr arguments
3964 integer ibin, iv
3965
3966
3967 mxfer_massbal(ibin) = myes
3968
3969 sfc_a(ih2so4_g)= 0.0
3970 sfc_a(ihno3_g) = 0.0
3971 sfc_a(ihcl_g) = 0.0
3972 sfc_a(inh3_g) = gas(inh3_g)
3973
3974 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
3975 df_gas(ihno3_g,ibin) = gas(ihno3_g)
3976 df_gas(ihcl_g,ibin) = gas(ihcl_g)
3977 df_gas(inh3_g,ibin) = 0.0
3978
3979 phi_volatile(ih2so4_g,ibin)= 1.0
3980 phi_volatile(ihno3_g,ibin) = 1.0
3981 phi_volatile(ihcl_g,ibin) = 1.0
3982 phi_volatile(inh3_g,ibin) = 0.0
3983
3984 do iv = 1, naer_vol
3985 flux(iv,ibin) = kg(iv,ibin)*df_gas(iv,ibin)
3986 enddo
3987
3988 mc(jc_h,ibin) = sqrt(keq_ll(3))
3989 ph(ibin) = -alog10(mc(jc_h,ibin))
3990 ph_est(ibin) = -alog10(mc(jc_h,ibin))
3991
3992 return
3993 end subroutine asceem_flux_wet_case2
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007 ! case 3: both mh4no3 and/or nh4cl may be active
4008 subroutine asceem_flux_wet_case3(ibin, icontinue_case4)
4009 ! implicit none
4010 ! include 'mosaic.h'
4011 ! subr arguments
4012 integer ibin, icontinue_case4
4013 ! local variables
4014 integer iv, iactive_nh4no3, iactive_nh4cl, iactive
4015 real gnh3_hno3, gnh3_hcl, beta_nh4no3, beta_nh4cl, &
4016 keq_nh4no3, keq_nh4cl, pcnt_nh4no3, pcnt_nh4cl, &
4017 ratio_flux,a, b, c, hplus1, hplus2, &
4018 flux_nh3_max, flux_nh3_est, &
4019 flux_nh3_max_d, flux_nh3_est_d, &
4020 xt
4021 ! function
4022 ! real quadratic
4023
4024
4025
4026 !-------------------
4027 ! set default values for flags
4028 iactive_nh4no3 = 1
4029 iactive_nh4cl = 2
4030 icontinue_case4 = mno ! default
4031
4032 !-------------------
4033 ! compute diagnostic products and ratios
4034 gnh3_hno3 = gas(inh3_g)*gas(ihno3_g)
4035 gnh3_hcl = gas(inh3_g)*gas(ihcl_g)
4036
4037 keq_nh4no3 = activity(jnh4no3,ibin)*kp_nh4no3 ! = [nh3]s * [hno3]s
4038 keq_nh4cl = activity(jnh4cl,ibin)*kp_nh4cl ! = [nh3]s * [hcl]s
4039
4040 beta_nh4no3 = gas(inh3_g)*gas(ihno3_g)/keq_nh4no3_0
4041 beta_nh4cl = gas(inh3_g)*gas(ihcl_g)/keq_nh4cl_0
4042
4043 if(gnh3_hno3 .gt. 0. .or. keq_nh4no3 .gt. 0.)then
4044 phi_nh4no3(ibin) = (gnh3_hno3 - keq_nh4no3)/ &
4045 max(gnh3_hno3, keq_nh4no3)
4046 else
4047 phi_nh4no3(ibin) = 0.0
4048 endif
4049
4050 if(gnh3_hcl .gt. 0. .or. keq_nh4cl .gt. 0.)then
4051 phi_nh4cl(ibin) = (gnh3_hcl - keq_nh4cl)/ &
4052 max(gnh3_hcl, keq_nh4cl)
4053 else
4054 phi_nh4cl(ibin) = 0.0
4055 endif
4056
4057
4058 !
4059 ! the following checks are order sensitive
4060 !-------------------
4061 ! first check if the bin has reached equilibrium
4062 if(abs(phi_nh4no3(ibin)).lt.0.02 .and. &
4063 abs(phi_nh4cl(ibin)) .lt.0.02)then
4064 iactive_nh4no3 = 0
4065 iactive_nh4cl = 0
4066 iactive = 0
4067 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
4068 flux(ihno3_g,ibin) = 0.0
4069 flux(ihcl_g,ibin) = 0.0
4070 flux(inh3_g,ibin) = 0.0
4071 return ! yes, the bin has reached equilibrium. quit
4072 endif
4073
4074
4075 !------------------
4076 ! now check if nh4no3 and/or nh4cl want to evaporate completely
4077 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
4078 pcnt_nh4no3 = epercent(jnh4no3,jliquid,ibin)
4079 pcnt_nh4cl = epercent(jnh4cl, jliquid,ibin)
4080
4081 if( (gnh3_hno3.le.keq_nh4no3 .and. pcnt_nh4no3.lt.1.0) .and. &
4082 (gnh3_hcl .le.keq_nh4cl .and. pcnt_nh4cl .lt.1.0) )then
4083 if(electrolyte(jnh4so4,jliquid,ibin) .gt. 0.0)then
4084 call evaporate_nh4no3_nh4cl(ibin)
4085 return
4086 else
4087 icontinue_case4 = myes ! its a nacl/nano3/cacl2/cano3 particle with negligible nh3, nh4
4088 return
4089 endif
4090 endif
4091
4092 !--------------------
4093 ! now determine if nh4no3 and/or nh4cl are active or significant
4094
4095 ! nh4no3
4096 if( (gnh3_hno3.gt.keq_nh4no3 .and. beta_nh4no3.lt.0.03) .or. &
4097 (abs(phi_nh4no3(ibin)) .lt. 0.02) )then
4098 iactive_nh4no3 = 0
4099 elseif(gnh3_hno3.lt.keq_nh4no3 .and. pcnt_nh4no3.lt.1.0)then
4100 iactive_nh4no3 = 0
4101 if(pcnt_nh4no3 .gt. 0.5)call evaporate_half_nh4no3(ibin)
4102 endif
4103
4104 ! nh4cl
4105 if( (gnh3_hcl.gt.keq_nh4cl .and. beta_nh4cl.lt.0.03) .or. &
4106 (abs(phi_nh4cl(ibin)) .lt. 0.02) )then
4107 iactive_nh4cl = 0
4108 elseif(gnh3_hcl.lt.keq_nh4cl .and. pcnt_nh4cl.lt.1.0)then
4109 iactive_nh4cl = 0
4110 if(pcnt_nh4cl .gt. 0.5)call evaporate_half_nh4cl(ibin)
4111 endif
4112
4113 iactive = iactive_nh4no3 + iactive_nh4cl
4114
4115 ! check the outcome
4116 if(iactive .eq. 0 .and. &
4117 phi_nh4no3(ibin) .gt. 0.0 .and. &
4118 phi_nh4cl(ibin) .gt. 0.0 )then
4119 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
4120 flux(ihno3_g,ibin) = 0.0
4121 flux(ihcl_g,ibin) = 0.0
4122 flux(inh3_g,ibin) = 0.0
4123 return
4124 elseif(iactive .eq. 0 .and. &
4125 abs(phi_nh4no3(ibin)) .gt. 0.02 .and. &
4126 abs(phi_nh4cl(ibin)) .gt. 0.02 .and. &
4127 aer_percent(inh4_a,jliquid,ibin) .lt. 1.0 .and. &
4128 (aer_percent(icl_a,jliquid,ibin) .gt. 1.0 .or. &
4129 aer_percent(ino3_a,jliquid,ibin).gt. 1.0) )then
4130 icontinue_case4 = myes ! nh3 and nh4 seems to be insignificant
4131 return ! therefore continue with case 4
4132 elseif(iactive .eq. 0)then
4133 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
4134 flux(ihno3_g,ibin) = 0.0
4135 flux(ihcl_g,ibin) = 0.0
4136 flux(inh3_g,ibin) = 0.0
4137 return
4138 endif
4139
4140 goto (1,2,3),iactive
4141
4142 !---------------------------------
4143 ! only nh4no3 is active
4144 1 flux(ihcl_g,ibin) = 0.0
4145
4146 a = kg(inh3_g,ibin)
4147 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4148 + kg(ihno3_g,ibin)*gas(ihno3_g) &
4149 + 2.0*flux(ih2so4_g,ibin)
4150 c = -(kg(ihno3_g,ibin)*keq_nh4no3)
4151
4152 sfc_a(inh3_g) = quadratic(a,b,c)
4153 sfc_a(ihno3_g) = keq_nh4no3/sfc_a(inh3_g)
4154 sfc_a(ihcl_g) = gas(ihcl_g)
4155
4156
4157 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4158 df_gas(ihcl_g,ibin) = 0.0
4159 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4160
4161
4162 phi_volatile(ihno3_g,ibin)= df_gas(ihno3_g,ibin)/ &
4163 max(sfc_a(ihno3_g), 1.e-10)
4164 phi_volatile(ihcl_g,ibin) = 0.0
4165 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
4166 max(sfc_a(inh3_g), 1.e-10)
4167
4168
4169 if(gnh3_hno3 .gt. keq_nh4no3 .and. &
4170 sfc_a(ihno3_g) .gt. gas(ihno3_g) )then ! degas hno3 via mass bal
4171 mxfer_massbal(ibin) = myes
4172 phi_volatile(ihno3_g,ibin)= 0.0
4173 df_gas(ihno3_g,ibin) = 0.0
4174 flux(ihno3_g,ibin) = 0.0
4175 else
4176 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
4177 endif
4178
4179
4180 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
4181 flux(ihno3_g,ibin) + &
4182 flux(ihcl_g,ibin)
4183
4184 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
4185
4186
4187 if(flux_nh3_est .le. flux_nh3_max)then
4188
4189 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
4190 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
4191 flux(inh3_g,ibin)/kg(inh3_g,ibin)
4192 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4193 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
4194 max(sfc_a(inh3_g), 1.e-10)
4195
4196 else ! reduce hno3 flux as necessary
4197
4198 flux(inh3_g,ibin) = flux_nh3_max
4199 flux(ihno3_g,ibin) = max(flux_nh3_max-flux(ih2so4_g,ibin),0.0)
4200
4201 sfc_a(inh3_g) = 0.0
4202 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
4203 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
4204
4205 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4206 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
4207
4208 phi_volatile(inh3_g,ibin) = 10.0
4209 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ & ! recompute phi_volatile(ihno3_g,ibin)
4210 max(sfc_a(ihno3_g), 1.e-10)
4211 endif
4212
4213
4214 mc(jc_h,ibin) = keq_gl(3)*sfc_a(ihno3_g)/ &
4215 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4216
4217 ph(ibin) = -alog10(mc(jc_h,ibin))
4218 ph_est(ibin) = -alog10(mc(jc_h,ibin))
4219
4220 return
4221
4222 !-----------------
4223 ! only nh4cl is active
4224 2 flux(ihno3_g,ibin) = 0.0
4225
4226 a = kg(inh3_g,ibin)
4227 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4228 + kg(ihcl_g,ibin)*gas(ihcl_g)
4229 c = -(kg(ihcl_g,ibin)*keq_nh4cl)
4230
4231 sfc_a(inh3_g) = quadratic(a,b,c)
4232 sfc_a(ihcl_g) = keq_nh4cl /sfc_a(inh3_g)
4233 sfc_a(ihno3_g) = gas(ihno3_g)
4234
4235
4236 df_gas(ihno3_g,ibin) = 0.0
4237 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4238 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4239
4240
4241 phi_volatile(ihno3_g,ibin)= 0.0
4242 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ &
4243 max(sfc_a(ihcl_g), 1.e-10)
4244 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
4245 max(sfc_a(inh3_g), 1.e-10)
4246
4247
4248 if(gnh3_hcl .gt. keq_nh4cl .and. &
4249 sfc_a(ihcl_g) .gt. gas(ihcl_g) )then ! degas hcl via mass bal
4250 mxfer_massbal(ibin) = myes
4251 phi_volatile(ihcl_g,ibin) = 0.0
4252 df_gas(ihcl_g,ibin) = 0.0
4253 flux(ihcl_g,ibin) = 0.0
4254 else
4255 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
4256 endif
4257
4258 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
4259 flux(ihno3_g,ibin) + &
4260 flux(ihcl_g,ibin)
4261
4262 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
4263
4264
4265 if(flux_nh3_est .le. flux_nh3_max)then
4266
4267 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
4268 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
4269 flux(inh3_g,ibin)/kg(inh3_g,ibin)
4270 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4271 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
4272 max(sfc_a(inh3_g), 1.e-10)
4273
4274 else ! reduce hcl flux as necessary
4275
4276 flux(inh3_g,ibin) = flux_nh3_max
4277 flux(ihcl_g,ibin) = max(flux_nh3_max-flux(ih2so4_g,ibin),0.0)
4278
4279 sfc_a(inh3_g) = 0.0
4280 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
4281 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
4282
4283 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4284 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4285
4286 phi_volatile(inh3_g,ibin) = 10.0
4287 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ & ! recompute phi_volatile(ihcl_g,ibin)
4288 max(sfc_a(ihcl_g), 1.e-10)
4289
4290 endif
4291
4292
4293 mc(jc_h,ibin) = keq_gl(4)*sfc_a(ihcl_g)/ &
4294 (gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4295
4296 ph(ibin) = -alog10(mc(jc_h,ibin))
4297 ph_est(ibin) = -alog10(mc(jc_h,ibin))
4298
4299 return
4300
4301 !-----------------
4302 ! both nh4no3 and nh4cl are active
4303 3 continue
4304
4305 a = kg(inh3_g,ibin)
4306 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4307 + kg(ihno3_g,ibin)*gas(ihno3_g) &
4308 + kg(ihcl_g,ibin)*gas(ihcl_g) &
4309 + 2.0*flux(ih2so4_g,ibin)
4310 c = -( kg(ihno3_g,ibin)*keq_nh4no3 + kg(ihcl_g,ibin)*keq_nh4cl )
4311
4312 sfc_a(inh3_g) = quadratic(a,b,c)
4313 sfc_a(ihno3_g) = keq_nh4no3/sfc_a(inh3_g)
4314 sfc_a(ihcl_g) = keq_nh4cl/sfc_a(inh3_g)
4315 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
4316 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4317 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4318
4319
4320 if(gnh3_hno3 .gt. keq_nh4no3 .and. &
4321 sfc_a(ihno3_g) .gt. gas(ihno3_g) )then ! degas hno3 via mass bal
4322 mxfer_massbal(ibin) = myes
4323 phi_volatile(ihno3_g,ibin)= 0.0
4324 df_gas(ihno3_g,ibin) = 0.0
4325 flux(ihno3_g,ibin) = 0.0
4326 hplus1 = sqrt(keq_ll(3))
4327 else
4328 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
4329 hplus1 = keq_gl(3)*sfc_a(ihno3_g)/ &
4330 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4331 endif
4332
4333
4334 if(gnh3_hcl .gt. keq_nh4cl .and. &
4335 sfc_a(ihcl_g) .gt. gas(ihcl_g) )then ! degas hcl via mass bal
4336 mxfer_massbal(ibin) = myes
4337 phi_volatile(ihcl_g,ibin) = 0.0
4338 df_gas(ihcl_g,ibin) = 0.0
4339 flux(ihcl_g,ibin) = 0.0
4340 hplus2 = sqrt(keq_ll(3))
4341 else
4342 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
4343 hplus2 = keq_gl(4)*sfc_a(ihcl_g)/ &
4344 (gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4345 endif
4346
4347
4348
4349 flux_nh3_est = 2.*flux(ih2so4_g,ibin) + &
4350 flux(ihno3_g,ibin) + &
4351 flux(ihcl_g,ibin)
4352
4353 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
4354
4355
4356 if(flux_nh3_est .le. flux_nh3_max)then
4357
4358 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
4359 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
4360 flux(inh3_g,ibin)/kg(inh3_g,ibin)
4361 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4362 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ & ! recompute phi_volatile(inh3_g,ibin)
4363 max(sfc_a(inh3_g), 1.e-10)
4364
4365 else ! reduce hno3 and hcl fluxes as necessary so that nh3 flux = flux_nh3_max
4366
4367 flux_nh3_est_d = max(flux_nh3_est-flux(ih2so4_g,ibin), 0.0)
4368 flux_nh3_max_d = max(flux_nh3_max-flux(ih2so4_g,ibin), 0.0)
4369
4370 if(flux_nh3_max_d .eq. 0.0)then
4371 ratio_flux = 0.0
4372 else
4373 ratio_flux = flux_nh3_max_d/flux_nh3_est_d
4374 endif
4375
4376 flux(inh3_g,ibin) = flux_nh3_max
4377 flux(ihno3_g,ibin) = flux(ihno3_g,ibin)*ratio_flux
4378 flux(ihcl_g, ibin) = flux(ihcl_g,ibin) *ratio_flux
4379
4380 sfc_a(inh3_g) = 0.0
4381 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
4382 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
4383 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
4384 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
4385
4386 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4387 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
4388 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4389
4390 phi_volatile(inh3_g,ibin) = 10.0
4391 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ & ! recompute phi_volatile(ihno3_g,ibin)
4392 max(sfc_a(ihno3_g), 1.e-10)
4393 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ & ! recompute phi_volatile(ihcl_g,ibin)
4394 max(sfc_a(ihcl_g), 1.e-10)
4395
4396 endif
4397
4398
4399 mc(jc_h,ibin) = max(hplus1, hplus2)
4400
4401 ph(ibin) = -alog10(mc(jc_h,ibin))
4402 ph_est(ibin) = -alog10(mc(jc_h,ibin))
4403
4404
4405 return
4406 end subroutine asceem_flux_wet_case3
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423 ! case 4: nh3 = 0 (in gas and aerosol) ! may have trouble
4424 !
4425 subroutine asceem_flux_wet_case4(ibin)
4426 ! implicit none
4427 ! include 'mosaic.h'
4428 ! subr arguments
4429 integer ibin
4430 ! local variables
4431 real gas_eqb_ratio, gas_act_ratio, phi_ratio
4432
4433
4434
4435 ! now diagnose the situation
4436
4437 gas_eqb_ratio = (keq_gl(4)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2)/ & ! ce,hno3/ce,hcl
4438 (keq_gl(3)*ma(ja_cl ,ibin)*gam(jhcl,ibin)**2)
4439
4440 gas_act_ratio = gas(ihno3_g)/gas(ihcl_g)
4441
4442 phi_ratio = abs(gas_eqb_ratio - gas_act_ratio)/ &
4443 max(gas_eqb_ratio , gas_act_ratio)
4444
4445
4446 ! check if equilibrium reached...
4447 if(phi_ratio .lt. 0.01)then
4448 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
4449 flux(ihno3_g,ibin) = 0.0
4450 flux(ihcl_g,ibin) = 0.0
4451 flux(inh3_g,ibin) = 0.0
4452 return
4453 endif
4454
4455
4456 ! compute equilibrium surface concentrations
4457 flux(ih2so4_g,ibin)= kg(ih2so4_g,ibin)*gas(ih2so4_g)
4458
4459 sfc_a(ihcl_g) = (2.*flux(ih2so4_g,ibin) + &
4460 kg(ihno3_g,ibin)*gas(ihno3_g) + &
4461 kg(ihcl_g,ibin) *gas(ihcl_g))/ &
4462 (kg(ihcl_g,ibin)+gas_eqb_ratio*kg(ihno3_g,ibin))
4463
4464 sfc_a(ihno3_g) = gas_eqb_ratio*sfc_a(ihcl_g)
4465
4466 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4467 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4468
4469 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ &
4470 max(sfc_a(ihno3_g), 1.e-10)
4471 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ &
4472 max(sfc_a(ihcl_g), 1.e-10)
4473
4474
4475 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
4476 flux(ihcl_g,ibin) = kg(ihcl_g,ibin) *df_gas(ihcl_g, ibin)
4477 flux(inh3_g,ibin) = 0.0
4478
4479
4480
4481 ! check if degassing species is less than 1% of the total particle moles
4482 if(flux(ihcl_g,ibin) .lt. 0.0 .and. &
4483 aer_percent(icl_a,jliquid,ibin) .lt. 1.0)then
4484 flux(ihcl_g,ibin) = 0.0
4485 flux(ihno3_g,ibin) = -2.0*flux(ih2so4_g,ibin)
4486 endif
4487
4488 if(flux(ihno3_g,ibin) .lt. 0.0 .and. &
4489 aer_percent(ino3_a,jliquid,ibin) .lt. 1.0)then
4490 flux(ihno3_g,ibin) = 0.0
4491 flux(ihcl_g,ibin) = -2.0*flux(ih2so4_g,ibin)
4492 endif
4493
4494 ! check hcl again
4495 if(flux(ihcl_g,ibin) .lt. 0.0 .and. &
4496 aer_percent(icl_a,jliquid,ibin) .lt. 1.0)then
4497 flux(ihcl_g,ibin) = 0.0
4498 mxfer_massbal(ibin) = myes
4499 endif
4500
4501
4502
4503 ph(ibin) = -alog10(mc(jc_h,ibin))
4504 ph_est(ibin) = -alog10(mc(jc_h,ibin))
4505
4506 return
4507 end subroutine asceem_flux_wet_case4
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518 ! case 5
4519 subroutine asceem_flux_wet_case5(ibin)
4520 ! implicit none
4521 ! include 'mosaic.h'
4522 ! subr arguments
4523 integer ibin
4524
4525
4526 call equilibrate_acids(ibin) ! hno3/hcl may be > 0 in the gas phase
4527
4528 mc(jc_h,ibin) = max(sqrt(keq_ll(3)), mc(jc_h,ibin))
4529
4530 sfc_a(ih2so4_g)= 0.0
4531 sfc_a(ihno3_g) = gas(ihno3_g)
4532 sfc_a(ihcl_g) = gas(ihcl_g)
4533 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
4534 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
4535
4536 df_gas(ih2so4_g,ibin)= gas(ih2so4_g)
4537 df_gas(ihno3_g,ibin) = 0.0
4538 df_gas(ihcl_g,ibin) = 0.0
4539 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4540
4541
4542 phi_volatile(ihno3_g,ibin) = 0.0
4543 phi_volatile(ihcl_g,ibin) = 0.0
4544 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
4545 max(sfc_a(inh3_g), 1.e-10)
4546
4547
4548 if(abs(phi_volatile(inh3_g,ibin)) .lt. 0.01)then
4549 df_gas(inh3_g,ibin) = 0.0
4550 endif
4551
4552 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*gas(ih2so4_g)
4553 flux(ihno3_g,ibin) = 0.0
4554 flux(ihcl_g,ibin) = 0.0
4555 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
4556
4557 ph(ibin) = -alog10(mc(jc_h,ibin))
4558 ph_est(ibin) = -alog10(mc(jc_h,ibin))
4559
4560 return
4561 end subroutine asceem_flux_wet_case5
4562
4563 !**********************************************************************
4564 ! end of asceem
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592 !***********************************************************************
4593 ! asteem: adaptive step time-split explicit euler method
4594 !
4595 ! author: rahul a. zaveri
4596 ! update: jan 2005
4597 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr (2005c)
4598 !-----------------------------------------------------------------------
4599 subroutine asteem( dtchem, istat_asteem )
4600 ! implicit none
4601 ! include 'v33com'
4602 ! include 'mosaic.h'
4603 ! subr arguments
4604 integer istat_asteem
4605 real dtchem
4606 ! local variables
4607 integer ibin, iv, itsi, ntsi, jcall, k, m, isteps
4608 integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
4609 real tsi, dumdum, p_mesa_fails
4610
4611 data iclm_debug /28/
4612 data jclm_debug /13/
4613 data kclm_debug /11/
4614 data ncnt_debug /0/
4615
4616
4617
4618
4619
4620 istat_asteem = 0
4621
4622 if(iclm_aer .eq. iclm_debug .and. &
4623 jclm_aer .eq. jclm_debug .and. &
4624 kclm_aer .eq. kclm_debug .and. &
4625 ncorecnt_aer .eq. ncnt_debug)then
4626 dumdum = 0.0
4627 endif
4628
4629
4630
4631
4632
4633 ! calculate water content and wet size for computing mass transfer coefficients
4634 do ibin = 1, nbin_a
4635 if(jaerosolstate(ibin) .ne. no_aerosol)then
4636 call aerosol_phase_state(ibin)
4637 endif
4638 enddo
4639
4640 call aerosolmtc
4641 call asteem_calculate_tsi(dtchem, tsi, ntsi) ! do this here. kg(nh3_g) may go to zero after consdense_non_volatiles
4642
4643
4644 ! now condense non-volatiles only for dtchem [s]
4645 call asteem_condense_non_volatiles(dtchem)
4646
4647
4648 ! recompute phase equilibrium
4649 do ibin = 1, nbin_a
4650 if(jaerosolstate(ibin) .ne. no_aerosol)then
4651 call aerosol_phase_state(ibin)
4652 endif
4653 enddo
4654
4655
4656
4657 if(ntsi .lt. 0)return ! mass transfer rates = 0
4658
4659
4660
4661 ! integrate each bin separately over tsi (time-split interval)
4662 ! using alternate direction implicit (adi) technique
4663 do 10 itsi = 1, ntsi/2
4664
4665 ! first in forward order
4666 do ibin = 1, nbin_a
4667
4668 if(jaerosolstate(ibin) .ne. no_aerosol)then
4669
4670 call asteem_condense_semi_volatiles( ibin, tsi, istat_asteem )
4671 if (istat_asteem .lt. 0) goto 80
4672
4673 endif
4674
4675 enddo
4676
4677
4678 ! then in reverse order
4679 do ibin = nbin_a, 1, -1
4680
4681 if(jaerosolstate(ibin) .ne. no_aerosol)then
4682
4683 call asteem_condense_semi_volatiles( ibin, tsi, istat_asteem )
4684 if (istat_asteem .lt. 0) goto 80
4685
4686 endif
4687
4688 enddo
4689
4690
4691 10 continue
4692
4693
4694 ! update asteem call counter
4695 80 continue
4696 jasteem_call = jasteem_call + 1
4697
4698
4699
4700
4701
4702 return
4703 end subroutine asteem
4704
4705
4706
4707
4708
4709 subroutine print_mosaic_stats( iflag1 )
4710 ! implicit none
4711 ! include 'mosaic.h'
4712 ! subr arguments
4713 integer iflag1
4714 ! local variables
4715 integer ibin
4716 real p_mesa_fails
4717
4718
4719 if (iflag1 .le. 0) goto 2000
4720
4721 p_mesa_fails = 100.*float(jmesa_fail)/ &
4722 max(float(jmesa_call_tot),1.0)
4723 iter_mesa_avg = iter_mesa/max(float(jmesa_call),1.0)
4724
4725 do ibin = 1, nbin_a
4726 steps_asteem_avg(ibin) = steps_asteem(ibin)/ &
4727 float(jasteem_call)
4728 enddo
4729
4730 write(6,*)'------------------------------------------------'
4731 write(6,*)' asteem performance statistics'
4732 write(6,*)'number asteem calls =', jasteem_call
4733 write(6,*)'total asteem fails =', jasteem_fail
4734 write(6,40)(steps_asteem_avg(ibin), ibin=1,nbin_a)
4735 write(6,41)(steps_asteem_max(ibin), ibin=1,nbin_a)
4736 write(6,*)' mesa performance statistics'
4737 write(6,*)'number of mesa calls =', jmesa_call
4738 write(6,*)'avg mesa iterations =', iter_mesa_avg
4739 write(6,*)'total mesa fails =', jmesa_fail
4740 write(6,*)'percent mesa fails =', p_mesa_fails
4741 write(6,*)' '
4742
4743 2000 continue
4744 jasteem_call = 0 ! reset
4745 jmesa_call = 0 ! reset
4746 iter_mesa = 0.0 ! reset
4747 do ibin = 1, nbin_a
4748 steps_asteem(ibin) = 0.0 ! reset
4749 steps_asteem_max(ibin) = 0.0 ! reset
4750 enddo
4751
4752
4753 40 format(' avg asteem steps/bin =', 8(f8.1,x))
4754 41 format(' max asteem steps/bin =', 8(f8.1,x))
4755
4756 return
4757 end subroutine print_mosaic_stats
4758
4759
4760
4761
4762
4763 !-----------------------------------------------------------------------
4764 subroutine print_mosaic_stats_bb( iflag1 )
4765
4766 ! include 'mosaic.h'
4767
4768 ! subr arguments
4769 integer iflag1
4770
4771 ! local variables
4772 integer ibin, ndum
4773
4774
4775 if (iflag1 .gt. 0) goto 2000
4776
4777 ! iflag1 .le. 0 -- start of current gridpt calcs initialization
4778 1000 continue
4779 do ibin = 1, nbin_a
4780 masbalout_err_count(ibin) = 0
4781 masbalout_maxreldiff_so4(ibin) = 0
4782 masbalout_maxreldiff_nh4(ibin) = 0
4783 masbalout_maxreldiff_no3(ibin) = 0
4784 masbalout_maxreldiff_cl(ibin) = 0
4785 masbalout_maxreldiff_na(ibin) = 0
4786 masbalout_maxreldiff_ca(ibin) = 0
4787 end do
4788
4789 return
4790
4791
4792 ! iflag1 .gt. 0 -- end of current gridpt calcs
4793 2000 continue
4794
4795 ! output of masbalout_err_count
4796 ndum = 0
4797 do ibin = 1, nbin_a
4798 if (masbalout_err_count(ibin) .gt. 1) ndum = ndum + 1
4799 end do
4800 if (ndum .gt. 0) then
4801 write(6,9310) &
4802 'mosaic aerchem monitor_masbal_out - ijk', &
4803 iclm_aer, jclm_aer, kclm_aer
4804 write(6,9300) &
4805 'err_counts / maxreldiff_so4 / nh4 / no3 / cl / na / ca'
4806 write(6,9320) (masbalout_err_count(ibin), ibin=1,nbin_a)
4807 write(6,9330) (masbalout_maxreldiff_so4(ibin), ibin=1,nbin_a)
4808 write(6,9330) (masbalout_maxreldiff_nh4(ibin), ibin=1,nbin_a)
4809 write(6,9330) (masbalout_maxreldiff_no3(ibin), ibin=1,nbin_a)
4810 write(6,9330) (masbalout_maxreldiff_cl(ibin), ibin=1,nbin_a)
4811 write(6,9330) (masbalout_maxreldiff_na(ibin), ibin=1,nbin_a)
4812 write(6,9330) (masbalout_maxreldiff_ca(ibin), ibin=1,nbin_a)
4813 end if
4814 9300 format( 10a )
4815 9310 format( a, 3i5 )
4816 9320 format( 8( 1x, i8 ) )
4817 9330 format( 8( 1pe9.1 ) )
4818
4819 return
4820
4821 end subroutine print_mosaic_stats_bb
4822
4823
4824
4825
4826
4827
4828
4829 !***********************************************************************
4830 ! part of asteem: computes time splitting interval (tsi)
4831 !
4832 ! author: rahul a. zaveri
4833 ! update: jan 2005
4834 !-----------------------------------------------------------------------
4835 subroutine asteem_calculate_tsi(dtchem, tsi, ntsi)
4836 ! implicit none
4837 ! include 'mosaic.h'
4838 ! subr arguments
4839 real tsi, dtchem
4840 ! local variables
4841 integer ibin, ntsi
4842 real gnh3_ghcl, gnh3_ghno3, sumkg, tau_gas_tot, tau_g_min
4843 real tau_gas_bin(nbin_a)
4844
4845
4846
4847
4848 tau_g_min = 1.e20
4849
4850 sumkg = 0.0
4851 do 50 ibin = 1, nbin_a
4852
4853 if(jaerosolstate(ibin) .ne. no_aerosol)then
4854 sumkg = sumkg + kg(inh3_g,ibin)
4855 tau_gas_bin(ibin) = 1./kg(inh3_g,ibin)
4856 tau_g_min = min(tau_g_min, tau_gas_bin(ibin))
4857 endif
4858
4859 50 continue
4860
4861
4862 if(sumkg .gt. 0.)then
4863 tau_gas_tot = 1./sumkg
4864 else
4865 tsi = -99.0
4866 ntsi = -99
4867 return
4868 endif
4869
4870
4871
4872 tsi = 0.1*tau_gas_tot
4873
4874
4875
4876 if(tsi .lt. dtchem)then
4877
4878 ntsi = int(dtchem/tsi) + 1
4879 ntsi = (ntsi/2)*2 ! even number
4880 tsi = dtchem/float(ntsi)
4881
4882 else
4883
4884 tsi = dtchem/2.0
4885 ntsi = 2
4886
4887 endif
4888
4889
4890 return
4891 end subroutine asteem_calculate_tsi
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905 !***********************************************************************
4906 ! part of asteem: condenses non-volatiles
4907 !
4908 ! author: rahul a. zaveri
4909 ! update: jan 2005
4910 !-----------------------------------------------------------------------
4911 subroutine asteem_condense_non_volatiles(dtchem)
4912 ! implicit none
4913 ! include 'mosaic.h'
4914 ! subr arguments
4915 real dtchem
4916 ! local variables
4917 integer iaer, ibin, icallpt, je
4918 real xt
4919
4920
4921
4922
4923
4924 if(gas(inh3_g) .eq. 0.0)then
4925 call asteem_condense_only_h2so4(dtchem)
4926 else
4927 call asteem_condense_nh3_h2so4(dtchem)
4928 endif
4929
4930
4931 do ibin = 1, nbin_a
4932
4933 if(jaerosolstate(ibin) .ne. no_aerosol)then
4934 call conform_electrolytes(jtotal,ibin,xt)
4935 endif
4936
4937 enddo
4938
4939
4940 return
4941 end subroutine asteem_condense_non_volatiles
4942
4943
4944
4945
4946
4947
4948
4949 !***********************************************************************
4950 ! part of asteem: condenses h2so4 only analytically
4951 !
4952 ! author: rahul a. zaveri
4953 ! update: jan 2005
4954 !-----------------------------------------------------------------------
4955 subroutine asteem_condense_only_h2so4(dtchem)
4956 ! implicit none
4957 ! include 'mosaic.h'
4958 ! subr arguments
4959 real dtchem
4960 ! local variables
4961 integer ibin
4962 real sumkg, decay, delta_h2so4
4963
4964
4965 sumkg = 0.0
4966 do 50 ibin = 1, nbin_a
4967 sumkg = sumkg + kg(ih2so4_g,ibin)
4968 50 continue
4969
4970
4971 if(sumkg*dtchem .lt. 1.e-9)return
4972
4973
4974 ! integrate gas-phase analytically
4975 decay = exp(-sumkg*dtchem)
4976 delta_h2so4 = gas(ih2so4_g)*(1.0 - decay)
4977 gas(ih2so4_g) = gas(ih2so4_g)*decay
4978
4979 ! distribute the difference by mtc weights
4980 do 60 ibin = 1, nbin_a
4981 aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
4982 delta_h2so4*kg(ih2so4_g,ibin)/sumkg
4983
4984 60 continue
4985
4986 return
4987 end subroutine asteem_condense_only_h2so4
4988
4989
4990
4991
4992
4993
4994 !***********************************************************************
4995 ! part of asteem: condenses nh3 and h2so4 using explicit euler method
4996 !
4997 ! author: rahul a. zaveri
4998 ! update: jan 2005
4999 !-----------------------------------------------------------------------
5000 subroutine asteem_condense_nh3_h2so4(dtchem)
5001 ! implicit none
5002 ! include 'mosaic.h'
5003 ! subr arguments
5004 real dtchem
5005 ! local variables
5006 integer ibin
5007 real delta_nh4, delta_so4, dtmax, &
5008 t_new, t_old, t_out, xt
5009 real sumkg(naer_vol)
5010
5011
5012
5013
5014
5015 t_old = 0.0
5016 t_out = dtchem
5017
5018
5019
5020
5021 ! calculate maximum possible internal time-step
5022 sumkg(inh3_g) = 0.0
5023 do ibin = 1, nbin_a
5024 sumkg(inh3_g) = sumkg(inh3_g) + kg(inh3_g,ibin)
5025 enddo
5026
5027
5028 ! compute max possible nh4 condensation for each bin
5029 if(sumkg(inh3_g) .gt. 0.0)then
5030 do ibin = 1, nbin_a
5031 aer_nh4_max(ibin) = aer(inh4_a,jtotal,ibin) + &
5032 gas(inh3_g)*(1.0 - exp(-sumkg(inh3_g)*dtchem))* &
5033 kg(inh3_g,ibin)/sumkg(inh3_g)
5034 enddo
5035 endif
5036
5037
5038 if(sumkg(inh3_g) .gt. 0.0)then
5039 dtmax = alpha_asteem/sumkg(inh3_g)
5040 else
5041 dtmax = dtchem ! mass transfer rates = 0
5042 return
5043 endif
5044
5045
5046 ! begin integration over transport time-step
5047 !======================================================
5048
5049 ! calculate fluxes
5050 10 do 501 ibin = 1, nbin_a
5051 if(jaerosolstate(ibin) .ne. no_aerosol)then
5052 call asteem_flux_nh3_h2so4(ibin)
5053 endif
5054 501 continue
5055
5056
5057
5058
5059 t_new = t_old + dtmax ! update time
5060 if(t_new .gt. t_out)then ! check if the new time step is too large
5061 dtmax = t_out - t_old
5062 t_new = t_out
5063 endif
5064
5065
5066
5067 ! integrate
5068
5069 do ibin = 1, nbin_a
5070 if(jaerosolstate(ibin) .ne. no_aerosol)then
5071
5072 delta_so4 = dtmax*flux(ih2so4_g,ibin)
5073 aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + delta_so4
5074 gas(ih2so4_g) = gas(ih2so4_g) - delta_so4
5075
5076 delta_nh4 = dtmax*flux(inh3_g,ibin)
5077 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) + delta_nh4
5078 gas(inh3_g) = gas(inh3_g) - delta_nh4
5079
5080 endif
5081 enddo
5082
5083
5084 do ibin = 1, nbin_a
5085 if(jaerosolstate(ibin) .ne. no_aerosol)then
5086 call conform_electrolytes(jtotal,ibin,xt)
5087 endif
5088 enddo
5089
5090
5091 ! update time
5092 t_old = t_new
5093
5094 if(t_new .lt. 0.9999*t_out) goto 10
5095 !================================================
5096 ! end of integration over the transport time-step
5097
5098
5099
5100 return
5101 end subroutine asteem_condense_nh3_h2so4
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114 !***********************************************************************
5115 ! part of asteem: computes fluxes of h2so4 and nh3 over dry or wet aerosols
5116 !
5117 ! author: rahul a. zaveri
5118 ! update: jan 2005
5119 !-----------------------------------------------------------------------
5120 subroutine asteem_flux_nh3_h2so4(ibin)
5121 ! implicit none
5122 ! include 'mosaic.h'
5123 ! subr arguments
5124 integer ibin
5125
5126
5127
5128 if(epercent(jnacl,jtotal,ibin) .gt. smallp .or. &
5129 epercent(jcacl2,jtotal,ibin) .gt. smallp .or. &
5130 epercent(jnano3,jtotal,ibin) .gt. smallp .or. &
5131 epercent(jcano3,jtotal,ibin) .gt. smallp .or. &
5132 epercent(jcaco3,jtotal,ibin) .gt. 0.0)then
5133
5134 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
5135 df_gas(inh3_g,ibin) = 0.0
5136
5137 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*df_gas(ih2so4_g,ibin)
5138 flux(inh3_g,ibin) = 0.0
5139
5140
5141 else ! sulfate rich or sulfate poor ammonium sulfate aerosol
5142
5143
5144 df_gas(ih2so4_g,ibin) = gas(ih2so4_g)
5145 df_gas(inh3_g,ibin) = gas(inh3_g)
5146
5147 flux(ih2so4_g,ibin) = kg(ih2so4_g,ibin)*df_gas(ih2so4_g,ibin)
5148 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
5149
5150 flux(inh3_g,ibin) = min(2.*flux(ih2so4_g,ibin), &
5151 flux(inh3_g,ibin))
5152
5153 endif
5154
5155
5156 return
5157 end subroutine asteem_flux_nh3_h2so4
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171 !***********************************************************************
5172 ! part of asteem: condenses semi-volatiles over tsi time interval
5173 !
5174 ! author: rahul a. zaveri
5175 ! update: jan 2005
5176 !-----------------------------------------------------------------------
5177 subroutine asteem_condense_semi_volatiles( &
5178 ibin, tsi, istat_asteem )
5179 ! implicit none
5180 ! include 'v33com'
5181 ! include 'mosaic.h'
5182 ! subr arguments
5183 integer ibin, istat_asteem
5184 real tsi
5185 ! local variables
5186 integer isteps, iv, jp, nsteps_max, kdum, mdum
5187 parameter(nsteps_max = 400)
5188 real delta_aer, dtmax, dum, t_new, t_old, t_out, xt
5189 real dumdum
5190
5191 integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug, ibin_debug
5192 data iclm_debug /4/
5193 data jclm_debug /1/
5194 data kclm_debug /15/
5195 data ncnt_debug /270/
5196 data ibin_debug /2/
5197
5198
5199 istat_asteem = 0
5200 kdum = kclm_aer
5201 mdum = mclm_aer
5202
5203
5204 t_old = 0.0
5205 t_out = tsi
5206
5207 if(iclm_aer .eq. iclm_debug .and. &
5208 jclm_aer .eq. jclm_debug .and. &
5209 kclm_aer .eq. kclm_debug .and. &
5210 ncorecnt_aer .eq. ncnt_debug .and. &
5211 ibin .eq. ibin_debug)then
5212 dumdum = 0.0
5213 endif
5214
5215
5216 call monitor_massbalance_in(ibin)
5217
5218
5219 isteps = 0
5220
5221 ! integrate ibin over tsi time interval
5222 !
5223 ! calculate fluxes
5224 10 isteps = isteps + 1
5225 mxfer_massbal(ibin) = mno
5226
5227
5228 if(jaerosolstate(ibin) .eq. all_solid)then
5229 jphase(ibin) = jsolid
5230 call asteem_flux_dry(ibin)
5231 elseif(jaerosolstate(ibin) .eq. all_liquid .or. &
5232 jaerosolstate(ibin) .eq. mixed)then
5233 jphase(ibin) = jliquid
5234 call asteem_flux_wet(ibin)
5235 call degas_acids(jliquid,ibin,xt) ! degases equilibrated acids (if present) and also updates jtotal
5236 endif
5237
5238
5239
5240
5241
5242 ! check if the bin has reached equilibrium
5243 ieqblm_bin(ibin) = myes ! initalize to default (eqblm)
5244 do iv = 1, naer_vol
5245 if(flux(iv, ibin) .ne. 0.0)then
5246 ieqblm_bin(ibin) = mno ! non-eqblm
5247 endif
5248 enddo
5249
5250 if(ieqblm_bin(ibin) .eq. myes)then
5251
5252 ! update jtotal
5253 do iv = 1, naer_vol
5254 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
5255 enddo
5256
5257 if(mxfer_massbal(ibin) .eq. myes)then
5258 call conform_electrolytes(jtotal,ibin,xt) ! xfer_massbal + mdrh diagnosis
5259 else
5260 call form_electrolytes(jtotal,ibin,xt) ! for mdrh diagnosis
5261 endif
5262
5263
5264 if(jhyst_leg(ibin) .eq. jhyst_lo)then
5265 call asteem_update_phase_eqblm(ibin)
5266 else
5267 call do_full_deliquescence(ibin) ! simply do liquid <-- total
5268 endif
5269
5270 steps_asteem(ibin) = steps_asteem(ibin) + float(isteps)
5271 steps_asteem_max(ibin) = max(steps_asteem_max(ibin), &
5272 float(isteps))
5273
5274 return ! the bin has reached equilibrium
5275 endif
5276
5277
5278
5279
5280
5281 ! calculate maximum possible internal time-step
5282 call asteem_calculate_dtmax(ibin, tsi, dtmax)
5283 t_new = t_old + dtmax ! update time
5284 if(t_new .gt. t_out)then ! check if the new time step is too large
5285 dtmax = t_out - t_old
5286 t_new = t_out
5287 endif
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297 ! integrate
5298 jp = jphase(ibin)
5299
5300 do 20 iv = 1, naer_vol
5301
5302 delta_aer = dtmax*flux(iv,ibin)
5303
5304 aer(iv,jp,ibin)=real(dble(aer(iv,jp,ibin)) + dble(delta_aer))
5305 gas(iv) =real(dble(gas(iv)) - dble(delta_aer))
5306
5307 aer(iv,jp,ibin)=max(aer(iv,jp,ibin), 0.0)
5308 gas(iv) =max(gas(iv), 0.0)
5309
5310 20 continue
5311
5312
5313 ! degas excess nh3 (if present)
5314 call form_electrolytes(jp,ibin,xt)
5315
5316 ! update jtotal
5317 do iv = 1, naer_vol
5318 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
5319 enddo
5320
5321
5322 if(mxfer_massbal(ibin) .eq. myes)then
5323 call conform_electrolytes(jtotal,ibin,xt) ! xfer_massbal + mdrh diagnosis
5324 else
5325 call form_electrolytes(jtotal,ibin,xt) ! for mdrh diagnosis
5326 endif
5327
5328
5329 if(jhyst_leg(ibin) .eq. jhyst_lo)then
5330 call asteem_update_phase_eqblm(ibin)
5331 else
5332 call do_full_deliquescence(ibin) ! simply do liquid <-- total
5333 endif
5334
5335
5336 call monitor_massbalance_out(ibin, isteps)
5337
5338
5339 ! update time
5340 t_old = t_new
5341
5342 if(isteps .ge. nsteps_max)then
5343 istat_asteem = -10
5344 jasteem_fail = jasteem_fail + 1
5345 write(6,*) 'mosaic aerchem asteem nsteps_max exceeded', &
5346 nsteps_max
5347 if(iprint_input .eq. myes)then
5348 call print_input(kdum,mdum)
5349 iprint_input = mno
5350 endif
5351 goto 30
5352 elseif(t_new .lt. 0.9999*t_out)then
5353 goto 10
5354 endif
5355 !================================================
5356 ! end of integration over the time split interval
5357
5358
5359 30 steps_asteem(ibin) = steps_asteem(ibin) + float(isteps)
5360 steps_asteem_max(ibin) = max(steps_asteem_max(ibin), &
5361 float(isteps))
5362
5363
5364 return
5365 end subroutine asteem_condense_semi_volatiles
5366
5367
5368
5369
5370
5371
5372
5373
5374 subroutine monitor_massbalance_in(ibin)
5375 ! implicit none
5376 ! include 'mosaic.h'
5377 ! subr arguments
5378 integer ibin
5379 ! local variables
5380 integer iv, iaer
5381
5382 total_so4_in = gas(ih2so4_g)+ aer(iso4_a,jtotal,ibin)
5383 total_no3_in = gas(ihno3_g) + aer(ino3_a,jtotal,ibin)
5384 total_cl_in = gas(ihcl_g) + aer(icl_a,jtotal,ibin)
5385 total_nh4_in = gas(inh3_g) + aer(inh4_a,jtotal,ibin)
5386 total_na_in = aer(ina_a,jtotal,ibin)
5387 total_ca_in = aer(ica_a,jtotal,ibin)
5388
5389
5390 do iv = 1, naer_vol
5391 gassav(iv) = gas(iv)
5392 enddo
5393
5394 do iaer = 1, naer
5395 aersav(iaer) = aer(iaer,jtotal,ibin)
5396 enddo
5397
5398
5399 return
5400 end subroutine monitor_massbalance_in
5401
5402
5403
5404
5405 subroutine monitor_massbalance_out(ibin, isteps)
5406 ! implicit none
5407 ! include 'v33com'
5408 ! include 'v33com3'
5409 ! include 'v33com9a'
5410 ! include 'v33com9b'
5411 ! include 'mosaic.h'
5412 ! subr arguments
5413 integer ibin, isteps
5414 ! local variables
5415 integer kdum, mdum
5416
5417 integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug, ibin_debug
5418 data iclm_debug /4/
5419 data jclm_debug /1/
5420 data kclm_debug /15/
5421 data ncnt_debug /270/
5422 data ibin_debug /2/
5423
5424 kdum = kclm_aer
5425 mdum = mclm_aer
5426
5427
5428
5429 total_so4 = gas(ih2so4_g)+ aer(iso4_a,jtotal,ibin)
5430 total_no3 = gas(ihno3_g) + aer(ino3_a,jtotal,ibin)
5431 total_cl = gas(ihcl_g) + aer(icl_a,jtotal,ibin)
5432 total_nh4 = gas(inh3_g) + aer(inh4_a,jtotal,ibin)
5433 total_na = aer(ina_a,jtotal,ibin)
5434 total_ca = aer(ica_a,jtotal,ibin)
5435
5436
5437 if(total_so4_in .gt. 1.e-25 .or. total_so4 .gt. 1.e-25)then
5438 rel_diff_so4 = (total_so4 - total_so4_in)/ &
5439 max(total_so4, total_so4_in)
5440 else
5441 rel_diff_so4 = 0.0
5442 endif
5443
5444 if(total_no3_in .gt. 1.e-25 .or. total_no3 .gt. 1.e-25)then
5445 rel_diff_no3 = (total_no3 - total_no3_in)/ &
5446 max(total_no3, total_no3_in)
5447 else
5448 rel_diff_no3 = 0.0
5449 endif
5450
5451 if(total_cl_in .gt. 1.e-25 .or. total_cl .gt. 1.e-25)then
5452 rel_diff_cl = (total_cl - total_cl_in)/ &
5453 max(total_cl, total_cl_in)
5454 else
5455 rel_diff_cl = 0.0
5456 endif
5457
5458 if(total_nh4_in .gt. 1.e-25 .or. total_nh4 .gt. 1.e-25)then
5459 rel_diff_nh4 = (total_nh4 - total_nh4_in)/ &
5460 max(total_nh4, total_nh4_in)
5461 else
5462 rel_diff_nh4 = 0.0
5463 endif
5464
5465 if(total_na_in .gt. 1.e-25 .or. total_na .gt. 1.e-25)then
5466 rel_diff_na = (total_na - total_na_in)/ &
5467 max(total_na, total_na_in)
5468 else
5469 rel_diff_na = 0.0
5470 endif
5471
5472
5473 if(total_ca_in .gt. 1.e-25 .or. total_ca .gt. 1.e-25)then
5474 rel_diff_ca = (total_ca - total_ca_in)/ &
5475 max(total_ca, total_ca_in)
5476 else
5477 rel_diff_ca = 0.0
5478 endif
5479
5480
5481 if(abs(rel_diff_so4).gt.1.e-4 .or. &
5482 abs(rel_diff_no3).gt.1.e-4 .or. &
5483 abs(rel_diff_nh4).gt.1.e-4 .or. &
5484 abs(rel_diff_na) .gt.1.e-4 .or. &
5485 abs(rel_diff_ca) .gt.1.e-4)then
5486
5487 masbalout_err_count(ibin) = masbalout_err_count(ibin) + 1
5488 masbalout_maxreldiff_so4(ibin) = max( &
5489 masbalout_maxreldiff_so4(ibin), abs(rel_diff_so4) )
5490 masbalout_maxreldiff_nh4(ibin) = max( &
5491 masbalout_maxreldiff_nh4(ibin), abs(rel_diff_nh4) )
5492 masbalout_maxreldiff_no3(ibin) = max( &
5493 masbalout_maxreldiff_no3(ibin), abs(rel_diff_no3) )
5494 masbalout_maxreldiff_cl(ibin) = max( &
5495 masbalout_maxreldiff_cl(ibin), abs(rel_diff_cl) )
5496 masbalout_maxreldiff_na(ibin) = max( &
5497 masbalout_maxreldiff_na(ibin), abs(rel_diff_na) )
5498 masbalout_maxreldiff_ca(ibin) = max( &
5499 masbalout_maxreldiff_ca(ibin), abs(rel_diff_ca) )
5500
5501 if(iprint_input .eq. myes)then
5502 write(6,*) 'mosaic aerchem monitor_massbalance_out failure'
5503 call print_input(kdum, mdum)
5504 iprint_input = mno
5505 endif
5506
5507 endif
5508
5509
5510 return
5511 end subroutine monitor_massbalance_out
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523 !***********************************************************************
5524 ! part of asteem: updates solid-liquid partitioning after each gas-aerosol
5525 ! mass transfer step
5526 !
5527 ! author: rahul a. zaveri
5528 ! update: jan 2005
5529 !-----------------------------------------------------------------------
5530 subroutine asteem_update_phase_eqblm(ibin)
5531 ! implicit none
5532 ! include 'mosaic.h'
5533 ! subr arguments
5534 integer ibin
5535 ! local variables
5536 integer jdum, js, j_index, mdissolved
5537 real xt
5538 ! function
5539 ! real drh_mutual, dum
5540
5541
5542
5543 ! calculate overall sulfate ratio
5544 call calculate_xt(ibin,jtotal,xt) ! calc updated xt
5545
5546 ! now diagnose mdrh
5547 if(xt .lt. 1. .and. xt .gt. 0. )goto 10 ! excess sulfate domain - no mdrh exists
5548
5549 jdum = 0
5550 do js = 1, nsalt
5551 jsalt_present(js) = 0 ! default value - salt absent
5552
5553 if(epercent(js,jtotal,ibin) .gt. 1.0)then
5554 jsalt_present(js) = 1 ! salt present
5555 jdum = jdum + jsalt_index(js)
5556 endif
5557 enddo
5558
5559 if(jdum .eq. 0)then
5560 jaerosolstate(ibin) = all_solid ! no significant soluble material present
5561 jphase(ibin) = jsolid
5562 call adjust_solid_aerosol(ibin)
5563 return
5564 endif
5565
5566 if(xt .ge. 2.0 .or. xt .lt. 0.0)then
5567 j_index = jsulf_poor(jdum)
5568 else
5569 j_index = jsulf_rich(jdum)
5570 endif
5571
5572 mdrh(ibin) = drh_mutual(j_index) + 1.0
5573
5574 if(ah2o*100. .lt. mdrh(ibin)) then
5575 jaerosolstate(ibin) = all_solid
5576 jphase(ibin) = jsolid
5577 call adjust_solid_aerosol(ibin)
5578 return
5579 endif
5580
5581
5582 ! none of the above means it must be sub-saturated or mixed-phase
5583 10 if(mxfer_massbal(ibin).eq.myes .or. jphase(ibin).eq.jsolid)then
5584 call do_full_deliquescence(ibin)
5585 call mesa(ibin)
5586 else
5587 call mesa(ibin)
5588 endif
5589
5590
5591
5592 return
5593 end subroutine asteem_update_phase_eqblm
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618 !***********************************************************************
5619 ! part of asteem: computes max time step for gas-aerosol integration
5620 !
5621 ! author: rahul a. zaveri
5622 ! update: jan 2005
5623 !-----------------------------------------------------------------------
5624 subroutine asteem_calculate_dtmax(ibin, tsi, dtmax)
5625 ! implicit none
5626 ! include 'mosaic.h'
5627 ! subr arguments
5628 integer ibin
5629 real tsi, dtmax
5630 ! local variables
5631 integer iv
5632 real alpha, h_aer, h_gas, h_max, &
5633 h_gas_i(naer_vol), h_nh3_max, &
5634 h_aer_i_m(naer_vol, nbin_a), &
5635 h_aer_m(nbin_a)
5636
5637
5638
5639
5640 ! set alpha_gas and alpha_aer
5641 do iv = 1, naer_vol
5642
5643 alpha_gas(iv) = alpha_asteem
5644
5645 if(madapt_alpha .eq. mon)then
5646 alpha_aer(iv,ibin) = max(abs(phi_volatile(iv,ibin)), &
5647 alpha_asteem)
5648 alpha_aer(iv,ibin) = min(alpha_aer(iv,ibin), 10.0)
5649
5650 else
5651 alpha_aer(iv,ibin) = alpha_asteem ! fixed alpha_aer
5652
5653 endif
5654
5655 enddo
5656
5657
5658
5659
5660
5661 ! gas-side
5662 ! calculate h_gas_i and h_gas
5663
5664 h_gas = 2.e16
5665
5666 do iv = 2, naer_vol
5667
5668 h_gas_i(iv) = 1.e16
5669 if(flux(iv,ibin) .gt. 0.0)then
5670
5671 h_gas_i(iv) = alpha_gas(iv)/kg(iv,ibin)
5672 h_gas = min(h_gas, h_gas_i(iv))
5673
5674 endif
5675
5676 enddo
5677
5678 ! restrict gas-side time step so that max allowable nh3 concentration is not exceeded
5679 if(flux(inh3_g,ibin) .gt. 0.0)then
5680 h_nh3_max = (aer_nh4_max(ibin)-aer(inh4_a,jtotal,ibin))/ &
5681 flux(inh3_g,ibin)
5682 h_gas = min(h_gas, h_nh3_max)
5683 endif
5684
5685
5686 !
5687 ! aerosol-side
5688 ! calculate h_aer_i_m, h_aer_m, h_aer
5689 h_aer = 1.e16
5690 h_aer_m(ibin) = 4.e15 ! initialize
5691
5692 call make_volatile_a(ibin)
5693
5694
5695 ! solid aerosol
5696 if(jphase(ibin) .eq. jsolid)then ! solid aerosol
5697
5698 do 10 iv = 2, naer_vol
5699 h_aer_i_m(iv,ibin) = 2.e15 ! initialize
5700
5701 if(flux(iv,ibin).lt.0.)then ! aer -> gas
5702 alpha = min(alpha_aer(iv,ibin),0.5)
5703 h_aer_i_m(iv,ibin) = -alpha*volatile_a(iv)/flux(iv,ibin)
5704 endif
5705
5706 h_aer_m(ibin) = min(h_aer_m(ibin),h_aer_i_m(iv,ibin))
5707 h_aer = min(h_aer, h_aer_i_m(iv,ibin))
5708 10 continue
5709
5710 goto 100
5711
5712 endif
5713
5714
5715
5716
5717
5718
5719 ! liquid or mixed-phase aerosol
5720 if(jphase(ibin) .eq. jliquid)then
5721
5722 do 11 iv = 2, naer_vol
5723 h_aer_i_m(iv,ibin) = 2.e15 ! initialize
5724
5725 if(flux(iv,ibin).gt.0. .and. & ! gas -> aer
5726 electrolyte(jcaco3,jtotal,ibin) .eq. 0.)then
5727
5728 if(aer(iv,jliquid,ibin) .gt. 0.0)then
5729 h_aer_i_m(iv,ibin)=alpha_aer(iv,ibin)*aer(iv,jliquid,ibin)/ & ! aer(i,jliquid) =< aer(i,jtotal)
5730 flux(iv,ibin)
5731 endif
5732
5733 elseif(flux(iv,ibin).lt.0. .and. volatile_a(iv).gt.0.0)then ! aer -> gas
5734 alpha = min(alpha_aer(iv,ibin), 0.5)
5735 h_aer_i_m(iv,ibin)=-alpha*volatile_a(iv)/flux(iv,ibin)
5736
5737 endif
5738
5739
5740 h_aer_m(ibin) = min(h_aer_m(ibin),h_aer_i_m(iv,ibin))
5741 h_aer = min(h_aer, h_aer_i_m(iv,ibin))
5742 11 continue
5743
5744 endif
5745
5746
5747
5748
5749 100 h_max = min(h_aer, h_gas)
5750
5751 dtmax = min(tsi, h_max)
5752 h_max = dtmax
5753
5754
5755 if(dtmax .le. 1.0e-5)then
5756 write(6,*)' dtmax = ', dtmax
5757 endif
5758
5759
5760
5761 if(dtmax .eq. 0.0)then
5762
5763 write(6,*)'iclm jclm kclm = ',iclm_aer, jclm_aer, kclm_aer
5764 write(6,*)'ibin= ',ibin,' jaerosolstate= ',jaerosolstate(ibin)
5765 write(6,*)'aerso4 = ', aer(iso4_a,jphase(ibin),ibin)
5766 write(6,*)'aerno3 = ', aer(ino3_a,jphase(ibin),ibin)
5767 write(6,*)'aercl = ', aer(icl_a,jphase(ibin),ibin)
5768 write(6,*)'aernh3 = ', aer(inh4_a,jphase(ibin),ibin)
5769 write(6,*)' '
5770 write(6,*)'h_gas = ', h_gas, ' h_aer =', h_aer
5771 write(6,*)'iv gas volatile flux'
5772 write(6,*)'hno3 ',gas(ihno3_g),volatile_a(ihno3_g), &
5773 flux(ihno3_g,ibin)
5774 write(6,*)'hcl ',gas(ihcl_g), volatile_a(ihcl_g), &
5775 flux(ihcl_g,ibin)
5776 write(6,*)'nh3 ',gas(inh3_g), volatile_a(inh3_g), &
5777 flux(inh3_g,ibin)
5778
5779
5780 dtmax = tsi
5781 do iv = 1, naer_vol
5782 flux(iv,ibin) = 0.0
5783 enddo
5784 endif
5785
5786
5787 return
5788 end subroutine asteem_calculate_dtmax
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813 !***********************************************************************
5814 ! part of asteem and asceem: computes volatile species concentration
5815 !
5816 ! author: rahul a. zaveri
5817 ! update: jan 2005
5818 !-----------------------------------------------------------------------
5819 subroutine make_volatile_a(ibin)
5820 ! implicit none
5821 ! include 'v33com'
5822 ! include 'mosaic.h'
5823 ! subr arguments
5824 integer ibin
5825
5826
5827
5828 if(jaerosolstate(ibin) .eq. all_solid)then
5829
5830 volatile_a(iso4_a) = 0.0
5831 volatile_a(ino3_a) = aer(ino3_a,jsolid,ibin)
5832 volatile_a(icl_a) = aer(icl_a,jsolid,ibin)
5833 volatile_a(inh4_a) = electrolyte(jnh4cl,jsolid,ibin) + &
5834 electrolyte(jnh4no3,jsolid,ibin)
5835
5836 elseif(jaerosolstate(ibin) .eq. all_liquid)then
5837
5838 volatile_a(iso4_a) = 0.0
5839 volatile_a(ino3_a) = aer(ino3_a,jliquid,ibin)- &
5840 electrolyte(jhno3,jliquid,ibin)
5841 volatile_a(icl_a) = aer(icl_a,jliquid,ibin) - &
5842 electrolyte(jhcl,jliquid,ibin)
5843 volatile_a(inh4_a) = aer(inh4_a,jliquid,ibin)
5844
5845 elseif(jaerosolstate(ibin) .eq. mixed)then
5846
5847 volatile_a(iso4_a) = 0.0
5848 volatile_a(ino3_a) = aer(ino3_a,jliquid,ibin)- &
5849 electrolyte(jhno3,jliquid,ibin)
5850 volatile_a(icl_a) = aer(icl_a,jliquid,ibin) - &
5851 electrolyte(jhcl,jliquid,ibin)
5852 volatile_a(inh4_a) = aer(inh4_a,jliquid,ibin) ! different
5853
5854 else
5855
5856 write(6,*)'bad jaerosolstate in subr. make_volatile_a'
5857 write(6,*)'ibin =',ibin,'jaerosolstate =',jaerosolstate(ibin)
5858 write(6,*)'i j k = ', iclm_aer, jclm_aer, kclm_aer
5859 write(6,*)'ncorecnt = ', ncorecnt_aer
5860 write(6,*)'stopping in subroutine make_volatile_a'
5861 ! stop
5862 call peg_error_fatal( lunerr_aer, &
5863 'stopping in subroutine make_volatile_a' )
5864
5865 endif
5866
5867
5868 return
5869 end subroutine make_volatile_a
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886 !***********************************************************************
5887 ! part of asteem: computes gas-aerosol fluxes over dry aerosols
5888 !
5889 ! author: rahul a. zaveri
5890 ! update: jan 2005
5891 !-----------------------------------------------------------------------
5892 subroutine asteem_flux_dry(ibin)
5893 ! implicit none
5894 ! include 'mosaic.h'
5895 ! subr arguments
5896 integer ibin
5897 ! local variables
5898 real xt, prod_nh4no3, prod_nh4cl, volatile_cl
5899
5900
5901
5902
5903 call calculate_xt(ibin,jsolid,xt)
5904
5905 flux(ih2so4_g,ibin) = 0.0
5906
5907 !-----------------------------------------------------------------
5908 ! case 1: sulfate-rich domain
5909
5910 if(xt.lt.2.0 .and. xt.ge.0.)then ! excess sulfate (acidic)
5911
5912 ! call asteem_flux_dry_case1(ibin)
5913
5914 flux(ihno3_g,ibin) = 0.0
5915 flux(ihcl_g,ibin) = 0.0
5916 flux(inh3_g,ibin) = 0.0
5917
5918 return
5919 endif
5920
5921 !-----------------------------------------------------------------
5922 ! case 2: caco3 > 0 absorb all acids (and indirectly degas co2)
5923
5924 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
5925
5926 call asteem_flux_dry_case2(ibin)
5927
5928 return
5929 endif
5930
5931 !-------------------------------------------------------------------
5932 ! case 3: hno3 and hcl exchange may happen here
5933
5934 volatile_cl = electrolyte(jnacl,jsolid,ibin) + &
5935 electrolyte(jcacl2,jsolid,ibin)
5936
5937
5938 if(volatile_cl .gt. 0.0 .and. &
5939 gas(ihno3_g).gt. 0.0 )then
5940
5941 call asteem_flux_dry_case3(ibin)
5942
5943 return
5944 endif
5945
5946 !-----------------------------------------------------------------
5947 ! case 4: nh4no3 or nh4cl or both may be active
5948
5949 prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-keq_sg(1)), 0.0) + &
5950 epercent(jnh4no3,jsolid,ibin)
5951 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g) -keq_sg(2)), 0.0) + &
5952 epercent(jnh4cl, jsolid,ibin)
5953
5954 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
5955 call asteem_flux_dry_case4(ibin)
5956 return
5957 endif
5958
5959 !-----------------------------------------------------------------
5960 ! case 5: default
5961
5962 call asteem_flux_dry_case5(ibin)
5963 return
5964
5965
5966 end subroutine asteem_flux_dry
5967
5968 !----------------------------------------------------------------------
5969
5970
5971
5972
5973
5974
5975
5976
5977 !***********************************************************************
5978 ! part of asteem: subroutines for flux_dry cases
5979 !
5980 ! author: rahul a. zaveri
5981 ! update: jan 2005
5982 !-----------------------------------------------------------------------
5983 !
5984 !
5985 !
5986 ! case 1: sulfate-rich domain
5987 !
5988 subroutine asteem_flux_dry_case1(ibin)
5989 ! implicit none
5990 ! include 'mosaic.h'
5991 ! subr arguments
5992 integer ibin
5993
5994
5995
5996 sfc_a(ih2so4_g)= 0.0
5997 sfc_a(ihno3_g) = gas(ihno3_g)
5998 sfc_a(ihcl_g) = gas(ihcl_g)
5999 sfc_a(inh3_g) = 0
6000
6001 df_gas(ih2so4_g,ibin) = 0.0
6002 df_gas(ihno3_g,ibin) = 0.0
6003 df_gas(ihcl_g,ibin) = 0.0
6004 df_gas(inh3_g,ibin) = gas(inh3_g)
6005
6006 phi_volatile(ihno3_g,ibin) = 0.0
6007 phi_volatile(ihcl_g,ibin) = 0.0
6008 phi_volatile(inh3_g,ibin) = 1.0
6009
6010 flux(ihno3_g,ibin) = 0.0
6011 flux(ihcl_g,ibin) = 0.0
6012 flux(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
6013
6014
6015 return
6016 end subroutine asteem_flux_dry_case1
6017
6018
6019
6020
6021 ! case 2: caco3 > 0 absorb all acids (and indirectly degas co2)
6022 !
6023 subroutine asteem_flux_dry_case2(ibin)
6024 ! implicit none
6025 ! include 'mosaic.h'
6026 ! subr arguments
6027 integer ibin
6028
6029
6030 mxfer_massbal(ibin) = myes
6031
6032 sfc_a(ih2so4_g) = 0.0
6033 sfc_a(ihno3_g) = 0.0
6034 sfc_a(ihcl_g) = 0.0
6035 sfc_a(inh3_g) = gas(inh3_g)
6036
6037 df_gas(ih2so4_g,ibin) = 0.0
6038 df_gas(ihno3_g,ibin) = gas(ihno3_g)
6039 df_gas(ihcl_g,ibin) = gas(ihcl_g)
6040 df_gas(inh3_g,ibin) = 0.0
6041
6042 phi_volatile(ihno3_g,ibin) = 1.0
6043 phi_volatile(ihcl_g,ibin) = 1.0
6044 phi_volatile(inh3_g,ibin) = 0.0
6045
6046 flux(ih2so4_g,ibin) = 0.0
6047 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
6048 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*gas(ihcl_g)
6049 flux(inh3_g,ibin) = 0.0
6050
6051
6052 return
6053 end subroutine asteem_flux_dry_case2
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065 ! case 3: hno3 and hcl exchange may happen here
6066 !
6067 subroutine asteem_flux_dry_case3(ibin)
6068 ! implicit none
6069 ! include 'mosaic.h'
6070 ! subr arguments
6071 integer ibin
6072
6073
6074 ! just degas hcl from nacl or cacl2 by flux balance with hno3
6075 mxfer_massbal(ibin) = myes
6076
6077 flux(ih2so4_g,ibin)= 0.0
6078 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
6079 flux(ihcl_g,ibin) = 0.0 ! degas in conformaerosol or formelectrolytes
6080 flux(inh3_g,ibin) = 0.0
6081
6082
6083
6084 return
6085 end subroutine asteem_flux_dry_case3
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096 ! case 4: nh4no3 and/or nh4cl may be active
6097 subroutine asteem_flux_dry_case4(ibin)
6098 ! implicit none
6099 ! include 'mosaic.h'
6100 ! subr arguments
6101 integer ibin
6102 ! local variables
6103 integer iv, iactive_nh4no3, iactive_nh4cl, iactive
6104 real gnh3_hno3, gnh3_hcl, pcnt_nh4no3, pcnt_nh4cl, &
6105 beta_nh4, &
6106 a, b, c, sfc_nh3_1, sfc_nh3_2, phi_nh3_1, phi_nh3_2, &
6107 flux_nh3_est, flux_nh3_max, ratio_flux
6108 ! function
6109 ! real quadratic
6110
6111
6112 !-------------------
6113 ! set default values for flags
6114 iactive_nh4no3 = 1
6115 iactive_nh4cl = 2
6116
6117 !-------------------
6118 ! compute diagnostic products and ratios
6119 gnh3_hno3 = gas(inh3_g)*gas(ihno3_g)
6120 gnh3_hcl = gas(inh3_g)*gas(ihcl_g)
6121
6122 beta_nh4 = aer(inh4_a,jtotal,ibin)/aer_nh4_max(ibin)
6123
6124 phi_nh4no3(ibin) = (gnh3_hno3 - keq_sg(1))/ &
6125 keq_sg(1)
6126 phi_nh4cl(ibin) = (gnh3_hcl - keq_sg(2))/ &
6127 keq_sg(2)
6128
6129 pcnt_nh4no3 = epercent(jnh4no3,jsolid,ibin)
6130 pcnt_nh4cl = epercent(jnh4cl, jsolid,ibin)
6131
6132
6133 !-------------------
6134 ! now determine if nh4no3 and/or nh4cl are active or significant
6135
6136 ! nh4no3
6137 if( (gnh3_hno3.gt.keq_sg(1) .and. beta_nh4 .gt.0.99) .or. &
6138 (abs(phi_nh4no3(ibin)) .lt. 0.02) )then
6139 iactive_nh4no3 = 0
6140 elseif(gnh3_hno3.lt.keq_sg(1) .and. pcnt_nh4no3.lt.1.0)then
6141 iactive_nh4no3 = 0
6142 call degas_solid_nh4no3(ibin)
6143 endif
6144
6145 ! nh4cl
6146 if( (gnh3_hcl.gt.keq_sg(2) .and. beta_nh4 .gt.0.99) .or. &
6147 abs(phi_nh4cl(ibin)) .lt. 0.02 )then
6148 iactive_nh4cl = 0
6149 elseif(gnh3_hcl.lt.keq_sg(2) .and. pcnt_nh4cl.lt.1.0)then
6150 iactive_nh4cl = 0
6151 call degas_solid_nh4cl(ibin)
6152 endif
6153
6154
6155 iactive = iactive_nh4no3 + iactive_nh4cl
6156
6157 ! check the outcome
6158 if(iactive .eq. 0)then
6159 flux(ihno3_g,ibin) = 0.0
6160 flux(ihcl_g,ibin) = 0.0
6161 flux(inh3_g,ibin) = 0.0
6162 return
6163 endif
6164
6165 goto (1,2,3),iactive
6166
6167 !---------------------------------
6168 ! only nh4no3 is active
6169 1 continue
6170
6171 a = kg(inh3_g,ibin)
6172 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6173 + kg(ihno3_g,ibin)*gas(ihno3_g)
6174 c = -(kg(ihno3_g,ibin)*keq_sg(1))
6175
6176 sfc_a(inh3_g) = quadratic(a,b,c)
6177 sfc_a(ihno3_g) = keq_sg(1)/sfc_a(inh3_g)
6178 sfc_a(ihcl_g) = gas(ihcl_g)
6179
6180
6181 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6182 df_gas(ihcl_g,ibin) = 0.0
6183 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6184
6185
6186 phi_volatile(ihno3_g,ibin)= phi_nh4no3(ibin)
6187 phi_volatile(ihcl_g,ibin) = 0.0
6188 phi_volatile(inh3_g,ibin) = phi_nh4no3(ibin)
6189
6190
6191 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
6192 flux(ihno3_g,ibin) = flux(inh3_g,ibin)
6193 flux(ihcl_g,ibin) = 0.0
6194
6195 return
6196
6197
6198
6199 !-----------------
6200 ! only nh4cl is active
6201 2 continue
6202
6203 a = kg(inh3_g,ibin)
6204 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6205 + kg(ihcl_g,ibin)*gas(ihcl_g)
6206 c = -(kg(ihcl_g,ibin)*keq_sg(2))
6207
6208 sfc_a(inh3_g) = quadratic(a,b,c)
6209 sfc_a(ihcl_g) = keq_sg(2) /sfc_a(inh3_g)
6210 sfc_a(ihno3_g) = gas(ihno3_g)
6211
6212
6213 df_gas(ihno3_g,ibin) = 0.0
6214 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6215 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6216
6217
6218 phi_volatile(ihno3_g,ibin)= 0.0
6219 phi_volatile(ihcl_g,ibin) = phi_nh4cl(ibin)
6220 phi_volatile(inh3_g,ibin) = phi_nh4cl(ibin)
6221
6222
6223 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
6224 flux(ihcl_g,ibin) = flux(inh3_g,ibin)
6225 flux(ihno3_g,ibin) = 0.0
6226
6227 return
6228
6229
6230 !-----------------
6231 ! both nh4no3 and nh4cl are active
6232 3 continue
6233
6234 ! nh4no3
6235 a = kg(inh3_g,ibin)
6236 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6237 + kg(ihno3_g,ibin)*gas(ihno3_g)
6238 c = -(kg(ihno3_g,ibin)*keq_sg(1))
6239
6240 sfc_nh3_1 = quadratic(a,b,c)
6241 sfc_a(inh3_g) = sfc_nh3_1
6242 sfc_a(ihno3_g) = keq_sg(1)/sfc_a(inh3_g)
6243 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6244 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
6245 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
6246 phi_volatile(ihno3_g,ibin) = phi_nh4no3(ibin)
6247
6248
6249 ! nh4cl
6250 a = kg(inh3_g,ibin)
6251 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6252 + kg(ihcl_g,ibin)*gas(ihcl_g)
6253 c = -(kg(ihcl_g,ibin)*keq_sg(2))
6254
6255 sfc_nh3_2 = quadratic(a,b,c)
6256 sfc_a(inh3_g) = sfc_nh3_2
6257 sfc_a(ihcl_g) = keq_sg(2)/sfc_a(inh3_g)
6258 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6259 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6260 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
6261 phi_volatile(ihcl_g,ibin) = phi_nh4cl(ibin)
6262
6263 ! nh3
6264 phi_volatile(inh3_g,ibin) = max( abs(phi_nh4no3(ibin)), &
6265 abs(phi_nh4cl(ibin)) )
6266
6267
6268 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
6269
6270 flux_nh3_est = flux(ihno3_g,ibin) + flux(ihcl_g,ibin)
6271 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
6272
6273
6274 if(flux_nh3_est .le. flux_nh3_max)then
6275
6276 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
6277 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
6278 flux(inh3_g,ibin)/kg(inh3_g,ibin)
6279 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6280
6281 else ! reduce hno3 and hcl fluxes as necessary so that nh3 flux = flux_nh3_max
6282
6283 ratio_flux = flux_nh3_max/flux_nh3_est
6284 flux(inh3_g,ibin) = flux_nh3_max
6285 flux(ihno3_g,ibin) = flux(ihno3_g,ibin)*ratio_flux
6286 flux(ihcl_g, ibin) = flux(ihcl_g,ibin) *ratio_flux
6287
6288 sfc_a(inh3_g) = 0.0
6289 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
6290 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
6291 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
6292 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
6293
6294 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6295 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
6296 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6297
6298 endif
6299
6300
6301
6302
6303 return
6304 end subroutine asteem_flux_dry_case4
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314 subroutine asteem_flux_dry_case5(ibin)
6315 ! implicit none
6316 ! include 'mosaic.h'
6317 ! subr arguments
6318 integer ibin
6319
6320 flux(ih2so4_g,ibin) = 0.0
6321 flux(ihno3_g,ibin) = 0.0
6322 flux(ihcl_g,ibin) = 0.0
6323 flux(inh3_g,ibin) = 0.0
6324
6325
6326 return
6327 end subroutine asteem_flux_dry_case5
6328
6329
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352 !***********************************************************************
6353 ! part of asteem: computes fluxes over wet aerosols
6354 !
6355 ! author: rahul a. zaveri
6356 ! update: jan 2005
6357 !-----------------------------------------------------------------------
6358 subroutine asteem_flux_wet(ibin)
6359 ! implicit none
6360 ! include 'mosaic.h'
6361 ! subr arguments
6362 integer ibin
6363 ! local variables
6364 integer iv, iadjust, iadjust_intermed, icontinue_case4
6365 real xt, xnh4, g_nh3_hno3, g_nh3_hcl, &
6366 a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
6367 prod_nh4no3, prod_nh4cl
6368
6369
6370
6371 ! check
6372 !c call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
6373 !c call degas_acids(jliquid,ibin,xt)
6374 call ions_to_electrolytes(jliquid,ibin,xt) ! for water content calculation
6375 call compute_activities(ibin)
6376
6377 if(water_a(ibin) .eq. 0.0)then
6378 write(6,*)'water is zero in liquid phase'
6379 write(6,*)'stopping in asteem_flux_wet'
6380 ! stop
6381 call peg_error_fatal( lunerr_aer, &
6382 'stopping in asteem_flux_wet' )
6383 endif
6384
6385
6386 ! calculate xnh4
6387 if(aer(iso4_a,jliquid,ibin).gt.0.0)then
6388 xnh4 = aer(inh4_a,jliquid,ibin)/aer(iso4_a,jliquid,ibin)
6389 else
6390 xnh4 = -1.0
6391 endif
6392
6393
6394 ! h2so4
6395 sfc_a(ih2so4_g) = 0.0
6396 df_gas(ih2so4_g,ibin) = 0.0
6397 flux(ih2so4_g,ibin) = 0.0
6398 phi_volatile(ih2so4_g,ibin) = 0.0
6399
6400
6401 !-------------------------------------------------------------------
6402 ! case 1: sulfate-rich domain
6403
6404 if(xt.lt.2.0 .and. xt.ge.0.)then
6405 call asteem_flux_wet_case1(ibin)
6406 return
6407 endif
6408
6409 !-------------------------------------------------------------------
6410 ! case 2: caco3 > 0 absorb acids (and indirectly degas co2)
6411
6412 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
6413 call asteem_flux_wet_case2(ibin)
6414 return
6415 endif
6416
6417 !-------------------------------------------------------------------
6418 ! do some small adjustments before deciding case 3
6419 !
6420 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
6421 iadjust = mno ! default
6422 iadjust_intermed = mno ! default
6423
6424 ! nh4no3
6425 g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
6426 a_nh4_no3 = epercent(jnh4no3,jliquid,ibin)
6427
6428 if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .lt. 0.1)then
6429 call absorb_tiny_nh4no3(ibin)
6430 iadjust = myes
6431 iadjust_intermed = myes
6432 elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
6433 call degas_tiny_nh4no3(ibin)
6434 iadjust = myes
6435 iadjust_intermed = myes
6436 endif
6437
6438 if(iadjust_intermed .eq. myes)then
6439 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
6440 iadjust_intermed = mno ! reset
6441 endif
6442
6443 ! nh4cl
6444 g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
6445 a_nh4_cl = epercent(jnh4cl,jliquid,ibin)
6446
6447 if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .lt. 0.1)then
6448 call absorb_tiny_nh4cl(ibin)
6449 iadjust = myes
6450 iadjust_intermed = myes
6451 elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
6452 call degas_tiny_nh4cl(ibin)
6453 iadjust = myes
6454 iadjust_intermed = myes
6455 endif
6456
6457 if(iadjust_intermed .eq. myes)then
6458 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
6459 iadjust_intermed = mno ! reset
6460 endif
6461
6462 ! hno3
6463 a_no3 = aer_percent(ino3_a,jliquid,ibin)
6464 if(gas(ihno3_g).gt.0. .and. a_no3 .lt. 0.1 .and. &
6465 aer(icl_a,jliquid,ibin) .gt. 0.0)then
6466 call absorb_tiny_hno3(ibin) ! and degas tiny hcl
6467 iadjust = myes
6468 iadjust_intermed = myes
6469 endif
6470
6471
6472 ! hcl
6473 a_cl = aer_percent(icl_a,jliquid,ibin)
6474 if(gas(ihcl_g).gt.0. .and. a_cl .lt. 0.1 .and. &
6475 aer(ino3_a,jliquid,ibin) .gt. 0.0)then
6476 call absorb_tiny_hcl(ibin) ! and degas tiny hno3
6477 iadjust = myes
6478 iadjust_intermed = myes
6479 endif
6480
6481
6482 if(iadjust_intermed .eq. myes)then
6483 call ions_to_electrolytes(jliquid,ibin,xt) ! update after adjustments
6484 endif
6485
6486 if(iadjust .eq. myes)then
6487 call compute_activities(ibin) ! update after adjustments
6488 endif
6489
6490
6491 ! all adjustments done...
6492
6493 !--------
6494 prod_nh4no3 = gas(inh3_g)*gas(ihno3_g) + activity(jnh4no3,ibin)
6495 prod_nh4cl = gas(inh3_g)*gas(ihcl_g) + activity(jnh4cl,ibin)
6496 !
6497 ! case 3: nh4no3 and/or nh4cl maybe active
6498 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
6499 call asteem_flux_wet_case3(ibin, icontinue_case4)
6500 if(icontinue_case4 .eq. mno)return
6501 endif
6502
6503 !-------------------------------------------------------------------
6504 ! case 4: nh3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
6505
6506 if(ma(ja_no3,ibin)*ma(ja_cl,ibin) .gt. 0.0)then
6507 call asteem_flux_wet_case4(ibin)
6508 return
6509 endif
6510
6511 !-------------------------------------------------------------------
6512 ! case 5: default (may degas nh3)
6513
6514 call asteem_flux_wet_case5(ibin)
6515 return
6516
6517 end subroutine asteem_flux_wet
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537 !***********************************************************************
6538 ! part of asteem: subroutines for flux_wet cases
6539 !
6540 ! author: rahul a. zaveri
6541 ! update: jan 2005
6542 !-----------------------------------------------------------------------
6543 !
6544 !
6545 !
6546 ! case 1: sulfate-rich domain
6547 !
6548 subroutine asteem_flux_wet_case1(ibin)
6549 ! implicit none
6550 ! include 'mosaic.h'
6551 ! subr arguments
6552 integer ibin
6553 real xnh4
6554
6555
6556
6557 if(aer(inh4_a,jliquid,ibin) .eq. 0. .and. gas(inh3_g) .gt. 0.)then
6558 call absorb_tiny_nh3(ibin)
6559 endif
6560
6561 ! calculate xnh4
6562 xnh4 = aer(inh4_a,jliquid,ibin)/aer(iso4_a,jliquid,ibin)
6563
6564 if(xnh4 .eq. 0.0)return ! no nh3 or nh4+ present - so skip
6565
6566 call equilibrate_acids(ibin) ! updates aer(icl_a, ino3_a, jtotal), activity(jhcl,jhno3)
6567
6568 sfc_a(ih2so4_g)= 0.0
6569 sfc_a(ihno3_g) = gas(ihno3_g)
6570 sfc_a(ihcl_g) = gas(ihcl_g)
6571 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
6572 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
6573
6574 df_gas(ih2so4_g,ibin) = 0.0
6575 df_gas(ihno3_g,ibin) = 0.0
6576 df_gas(ihcl_g,ibin) = 0.0
6577 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6578
6579 phi_volatile(ihno3_g,ibin) = 0.0
6580 phi_volatile(ihcl_g,ibin) = 0.0
6581 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
6582 max(sfc_a(inh3_g), 1.e-10)
6583
6584 flux(ih2so4_g,ibin) = 0.0
6585 flux(ihno3_g,ibin) = 0.0
6586 flux(ihcl_g,ibin) = 0.0
6587
6588 if(df_gas(inh3_g,ibin) .gt. 0.0)then
6589 df_gas(inh3_g,ibin) = 0.0 ! only degassing is allowed here
6590 flux(inh3_g,ibin) = 0.0
6591 phi_volatile(inh3_g,ibin) = 0.0
6592 return
6593 endif
6594
6595 ! check for equilibrium
6596 if(abs(phi_volatile(inh3_g,ibin)) .lt. 0.01)then
6597 flux(inh3_g,ibin) = 0.0
6598 else
6599 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
6600 endif
6601
6602
6603 return
6604 end subroutine asteem_flux_wet_case1
6605
6606
6607
6608
6609
6610
6611 ! case 2: caco3 > 0 absorb all acids (and indirectly degas co2)
6612 !
6613 subroutine asteem_flux_wet_case2(ibin)
6614 ! implicit none
6615 ! include 'mosaic.h'
6616 ! subr arguments
6617 integer ibin
6618 ! local variables
6619 integer iv
6620
6621
6622 mxfer_massbal(ibin) = myes
6623
6624 sfc_a(ihno3_g) = 0.0
6625 sfc_a(ihcl_g) = 0.0
6626 sfc_a(inh3_g) = gas(inh3_g)
6627
6628 df_gas(ih2so4_g,ibin) = 0.0
6629 df_gas(ihno3_g,ibin) = gas(ihno3_g)
6630 df_gas(ihcl_g,ibin) = gas(ihcl_g)
6631 df_gas(inh3_g,ibin) = 0.0
6632
6633 phi_volatile(ihno3_g,ibin) = 1.0
6634 phi_volatile(ihcl_g,ibin) = 1.0
6635 phi_volatile(inh3_g,ibin) = 0.0
6636
6637 do iv = 1, naer_vol
6638 flux(iv,ibin) = kg(iv,ibin)*df_gas(iv,ibin)
6639 enddo
6640
6641
6642 mc(jc_h,ibin) = sqrt(keq_ll(3))
6643 ph(ibin) = -alog10(mc(jc_h,ibin))
6644 ph_est(ibin) = -alog10(mc(jc_h,ibin))
6645
6646
6647 return
6648 end subroutine asteem_flux_wet_case2
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658 ! case 3:
6659 ! case 3: nh4no3 and/or nh4cl may be active
6660 subroutine asteem_flux_wet_case3(ibin, icontinue_case4)
6661 ! implicit none
6662 ! include 'mosaic.h'
6663 ! subr arguments
6664 integer ibin, icontinue_case4
6665 ! local variables
6666 integer iv, iactive_nh4no3, iactive_nh4cl, iactive
6667 real xt, gnh3_hno3, gnh3_hcl, beta_nh4no3, beta_nh4cl, &
6668 beta_nh4, &
6669 keq_nh4no3, keq_nh4cl, pcnt_nh4no3, pcnt_nh4cl, &
6670 ratio_flux, a, b, c, sfc_nh3_1, sfc_nh3_2, &
6671 phi_nh3_1, phi_nh3_2, flux_nh3_est, flux_nh3_max
6672 ! function
6673 ! real quadratic
6674
6675
6676 !-------------------
6677 ! set default values for flags
6678 iactive_nh4no3 = 1
6679 iactive_nh4cl = 2
6680 icontinue_case4 = mno ! default
6681
6682 !-------------------
6683 ! compute diagnostic products and ratios
6684 gnh3_hno3 = gas(inh3_g)*gas(ihno3_g)
6685 gnh3_hcl = gas(inh3_g)*gas(ihcl_g)
6686
6687 keq_nh4no3 = activity(jnh4no3,ibin)*kp_nh4no3 ! = [nh3]s * [hno3]s
6688 keq_nh4cl = activity(jnh4cl,ibin)*kp_nh4cl ! = [nh3]s * [hcl]s
6689
6690 beta_nh4no3 = gnh3_hno3/keq_nh4no3_0
6691 beta_nh4cl = gnh3_hcl/keq_nh4cl_0
6692
6693 beta_nh4 = aer(inh4_a,jtotal,ibin)/aer_nh4_max(ibin)
6694
6695 if(keq_nh4no3 .gt. 0.)then
6696 phi_nh4no3(ibin) = (gnh3_hno3 - keq_nh4no3)/ &
6697 keq_nh4no3
6698 else
6699 phi_nh4no3(ibin) = 0.0
6700 endif
6701
6702 if(keq_nh4cl .gt. 0.)then
6703 phi_nh4cl(ibin) = (gnh3_hcl - keq_nh4cl)/ &
6704 keq_nh4cl
6705 else
6706 phi_nh4cl(ibin) = 0.0
6707 endif
6708
6709
6710 !
6711 ! the following checks are order sensitive
6712 !-------------------
6713 ! first check if the bin has reached equilibrium
6714 if(abs(phi_nh4no3(ibin)).lt.0.02 .and. &
6715 abs(phi_nh4cl(ibin)) .lt.0.02)then
6716 iactive_nh4no3 = 0
6717 iactive_nh4cl = 0
6718 iactive = 0
6719 flux(ihno3_g,ibin) = 0.0
6720 flux(ihcl_g,ibin) = 0.0
6721 flux(inh3_g,ibin) = 0.0
6722 return ! yes, the bin has reached equilibrium. quit
6723 endif
6724
6725
6726 !------------------
6727 ! now check if nh4no3 and/or nh4cl want to evaporate completely
6728 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt)
6729 pcnt_nh4no3 = epercent(jnh4no3,jliquid,ibin)
6730 pcnt_nh4cl = epercent(jnh4cl, jliquid,ibin)
6731
6732 if( (gnh3_hno3.le.keq_nh4no3 .and. pcnt_nh4no3.lt.1.0) .and. &
6733 (gnh3_hcl .le.keq_nh4cl .and. pcnt_nh4cl .lt.1.0) )then
6734 if(electrolyte(jnh4so4,jliquid,ibin) .gt. 0.0)then
6735 call evaporate_nh4no3_nh4cl(ibin)
6736 return
6737 else
6738 icontinue_case4 = myes ! its a nacl/nano3/cacl2/cano3 particle with negligible nh3, nh4
6739 return
6740 endif
6741 endif
6742
6743 !--------------------
6744 ! now determine if nh4no3 and/or nh4cl are active or significant
6745
6746 ! nh4no3
6747 if( (gnh3_hno3.gt.keq_nh4no3 .and. beta_nh4no3.lt.0.03) .or. &
6748 (gnh3_hno3.gt.keq_nh4no3 .and. beta_nh4 .gt.0.99) .or. &
6749 (abs(phi_nh4no3(ibin)) .lt. 0.02) )then
6750 iactive_nh4no3 = 0
6751 elseif(gnh3_hno3.lt.keq_nh4no3 .and. pcnt_nh4no3.lt.1.0)then
6752 iactive_nh4no3 = 0
6753 if(pcnt_nh4no3 .gt. 0.5)call evaporate_half_nh4no3(ibin)
6754 endif
6755
6756 ! nh4cl
6757 if( (gnh3_hcl.gt.keq_nh4cl .and. beta_nh4cl.lt.0.03) .or. &
6758 (gnh3_hcl.gt.keq_nh4cl .and. beta_nh4 .gt.0.99) .or. &
6759 (abs(phi_nh4cl(ibin)) .lt. 0.02) )then
6760 iactive_nh4cl = 0
6761 elseif(gnh3_hcl.lt.keq_nh4cl .and. pcnt_nh4cl.lt.1.0)then
6762 iactive_nh4cl = 0
6763 if(pcnt_nh4cl .gt. 0.5)call evaporate_half_nh4cl(ibin)
6764 endif
6765
6766 iactive = iactive_nh4no3 + iactive_nh4cl
6767
6768 ! check the outcome
6769 if(iactive .eq. 0 .and. &
6770 phi_nh4no3(ibin) .gt. 0.0 .and. &
6771 phi_nh4cl(ibin) .gt. 0.0 )then
6772 flux(ihno3_g,ibin) = 0.0
6773 flux(ihcl_g,ibin) = 0.0
6774 flux(inh3_g,ibin) = 0.0
6775 return
6776 elseif(iactive .eq. 0 .and. &
6777 abs(phi_nh4no3(ibin)) .gt. 0.02 .and. &
6778 abs(phi_nh4cl(ibin)) .gt. 0.02 .and. &
6779 aer_percent(inh4_a,jliquid,ibin) .lt. 1.0 .and. &
6780 (aer_percent(icl_a,jliquid,ibin) .gt. 1.0 .or. &
6781 aer_percent(ino3_a,jliquid,ibin).gt. 1.0) )then
6782 icontinue_case4 = myes ! nh3 and nh4 seems to be insignificant
6783 return ! therefore continue with case 4
6784 elseif(iactive .eq. 0)then
6785 flux(ihno3_g,ibin) = 0.0
6786 flux(ihcl_g,ibin) = 0.0
6787 flux(inh3_g,ibin) = 0.0
6788 return
6789 endif
6790
6791 goto (1,2,3),iactive
6792
6793 !---------------------------------
6794 ! only nh4no3 is active
6795 1 continue
6796
6797 a = kg(inh3_g,ibin)
6798 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6799 + kg(ihno3_g,ibin)*gas(ihno3_g)
6800 c = -(kg(ihno3_g,ibin)*keq_nh4no3)
6801
6802 sfc_a(inh3_g) = quadratic(a,b,c)
6803 sfc_a(ihno3_g) = keq_nh4no3/sfc_a(inh3_g)
6804 sfc_a(ihcl_g) = gas(ihcl_g)
6805
6806
6807 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6808 df_gas(ihcl_g,ibin) = 0.0
6809 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6810
6811
6812 phi_volatile(ihno3_g,ibin)= phi_nh4no3(ibin)
6813 phi_volatile(ihcl_g,ibin) = 0.0
6814 phi_volatile(inh3_g,ibin) = phi_nh4no3(ibin)
6815
6816
6817 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
6818 flux(ihno3_g,ibin) = flux(inh3_g,ibin)
6819 flux(ihcl_g,ibin) = 0.0
6820
6821 mc(jc_h,ibin) = keq_gl(3)*sfc_a(ihno3_g)/ &
6822 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6823
6824 ph(ibin) = -alog10(mc(jc_h,ibin))
6825 ph_est(ibin) = -alog10(mc(jc_h,ibin))
6826
6827 return
6828
6829
6830
6831 !-----------------
6832 ! only nh4cl is active
6833 2 continue
6834
6835 a = kg(inh3_g,ibin)
6836 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6837 + kg(ihcl_g,ibin)*gas(ihcl_g)
6838 c = -(kg(ihcl_g,ibin)*keq_nh4cl)
6839
6840 sfc_a(inh3_g) = quadratic(a,b,c)
6841 sfc_a(ihcl_g) = keq_nh4cl /sfc_a(inh3_g)
6842 sfc_a(ihno3_g) = gas(ihno3_g)
6843
6844
6845 df_gas(ihno3_g,ibin) = 0.0
6846 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6847 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6848
6849
6850 phi_volatile(ihno3_g,ibin)= 0.0
6851 phi_volatile(ihcl_g,ibin) = phi_nh4cl(ibin)
6852 phi_volatile(inh3_g,ibin) = phi_nh4cl(ibin)
6853
6854
6855 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
6856 flux(ihcl_g,ibin) = flux(inh3_g,ibin)
6857 flux(ihno3_g,ibin) = 0.0
6858
6859 mc(jc_h,ibin) = keq_gl(4)*sfc_a(ihcl_g)/ &
6860 (gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6861
6862 ph(ibin) = -alog10(mc(jc_h,ibin))
6863 ph_est(ibin) = -alog10(mc(jc_h,ibin))
6864
6865 return
6866
6867
6868 !-----------------
6869 ! both hno3 and hcl are active
6870 3 continue
6871
6872 ! nh4no3
6873 a = kg(inh3_g,ibin)
6874 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6875 + kg(ihno3_g,ibin)*gas(ihno3_g)
6876 c = -(kg(ihno3_g,ibin)*keq_nh4no3)
6877
6878 sfc_nh3_1 = quadratic(a,b,c)
6879 sfc_a(inh3_g) = sfc_nh3_1
6880 sfc_a(ihno3_g) = keq_nh4no3/sfc_a(inh3_g)
6881 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6882 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
6883 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
6884 phi_volatile(ihno3_g,ibin) = phi_nh4no3(ibin)
6885
6886
6887 ! nh4cl
6888 a = kg(inh3_g,ibin)
6889 b = - kg(inh3_g,ibin)*gas(inh3_g) &
6890 + kg(ihcl_g,ibin)*gas(ihcl_g)
6891 c = -(kg(ihcl_g,ibin)*keq_nh4cl)
6892
6893 sfc_nh3_2 = quadratic(a,b,c)
6894 sfc_a(inh3_g) = sfc_nh3_2
6895 sfc_a(ihcl_g) = keq_nh4cl /sfc_a(inh3_g)
6896 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6897 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6898 flux(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas(ihcl_g,ibin)
6899 phi_volatile(ihcl_g,ibin) = phi_nh4cl(ibin)
6900
6901 ! nh3
6902 phi_volatile(inh3_g,ibin) = max( abs(phi_nh4cl(ibin)), &
6903 abs(phi_nh4no3(ibin)) )
6904
6905
6906 ! now compute nh3 flux and adjust hno3 and/or hcl if necessary
6907
6908 flux_nh3_est = flux(ihno3_g,ibin) + flux(ihcl_g,ibin)
6909 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
6910
6911 if(flux_nh3_est .le. flux_nh3_max)then
6912 flux(inh3_g,ibin) = flux_nh3_est ! all ok - no flux adjustments needed
6913 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(inh3_g)
6914 flux(inh3_g,ibin)/kg(inh3_g,ibin)
6915 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6916 mc(jc_h,ibin) = keq_gl(3)*sfc_a(ihno3_g)/ &
6917 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6918
6919 else ! reduce hno3 and hcl fluxes as necessary so that nh3 flux = flux_nh3_max
6920
6921 ratio_flux = flux_nh3_max/flux_nh3_est
6922 flux(inh3_g,ibin) = flux_nh3_max
6923 flux(ihno3_g,ibin) = flux(ihno3_g,ibin)*ratio_flux
6924 flux(ihcl_g, ibin) = flux(ihcl_g,ibin) *ratio_flux
6925
6926 sfc_a(inh3_g) = 0.0
6927 sfc_a(ihno3_g) = gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
6928 flux(ihno3_g,ibin)/kg(ihno3_g,ibin)
6929 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
6930 flux(ihcl_g,ibin)/kg(ihcl_g,ibin)
6931
6932 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
6933 df_gas(ihno3_g,ibin) = gas(ihno3_g)- sfc_a(ihno3_g)
6934 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
6935
6936 mc(jc_h,ibin) = keq_gl(3)*sfc_a(ihno3_g)/ &
6937 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6938 endif
6939
6940
6941 ph(ibin) = -alog10(mc(jc_h,ibin))
6942 ph_est(ibin) = -alog10(mc(jc_h,ibin))
6943
6944
6945 return
6946 end subroutine asteem_flux_wet_case3
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963 ! case 4: nh3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
6964 subroutine asteem_flux_wet_case4(ibin)
6965 ! implicit none
6966 ! include 'mosaic.h'
6967 ! subr arguments
6968 integer ibin
6969 ! local variables
6970 real gas_eqb_ratio, gas_act_ratio, phi_ratio
6971
6972
6973
6974
6975 ! now diagnose the situation
6976
6977 gas_eqb_ratio = (keq_gl(4)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2)/ & ! ce,hno3/ce,hcl
6978 (keq_gl(3)*ma(ja_cl ,ibin)*gam(jhcl,ibin)**2)
6979
6980 gas_act_ratio = gas(ihno3_g)/gas(ihcl_g)
6981
6982 phi_ratio = abs(gas_eqb_ratio - gas_act_ratio)/ &
6983 max(gas_eqb_ratio , gas_act_ratio)
6984
6985
6986 ! check if equilibrium reached...
6987 if(phi_ratio .lt. 0.01)then
6988 flux(ihno3_g,ibin) = 0.0
6989 flux(ihcl_g,ibin) = 0.0
6990 flux(inh3_g,ibin) = 0.0
6991 return
6992 endif
6993
6994
6995 ! compute equilibrium surface concentrations
6996 sfc_a(ihcl_g) = &
6997 (kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g))/ &
6998 (kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin))
6999 sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
7000
7001 df_gas(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
7002 df_gas(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
7003
7004 phi_volatile(ihno3_g,ibin) = df_gas(ihno3_g,ibin)/ &
7005 max(sfc_a(ihno3_g), 1.e-10)
7006 phi_volatile(ihcl_g,ibin) = df_gas(ihcl_g,ibin)/ &
7007 max(sfc_a(ihcl_g), 1.e-10)
7008
7009
7010 flux(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas(ihno3_g,ibin)
7011 flux(ihcl_g,ibin) = -flux(ihno3_g,ibin) ! kg(ihcl_g,ibin) *df_gas(ihcl_g, ibin)
7012 flux(inh3_g,ibin) = 0.0
7013
7014 mc(jc_h,ibin) = keq_gl(3)*sfc_a(ihno3_g)/ &
7015 (gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7016
7017 ph(ibin) = -alog10(mc(jc_h,ibin))
7018 ph_est(ibin) = -alog10(mc(jc_h,ibin))
7019
7020 return
7021 end subroutine asteem_flux_wet_case4
7022
7023
7024
7025
7026
7027
7028
7029
7030
7031 ! case 5
7032 subroutine asteem_flux_wet_case5(ibin)
7033 ! implicit none
7034 ! include 'mosaic.h'
7035 ! subr arguments
7036 integer ibin
7037
7038
7039
7040
7041 call equilibrate_acids(ibin) ! hno3 and/or hcl may be > 0 in the gas phase
7042
7043 mc(jc_h,ibin) = max(sqrt(keq_ll(3)), mc(jc_h,ibin))
7044
7045 sfc_a(ih2so4_g)= 0.0
7046 sfc_a(ihno3_g) = gas(ihno3_g)
7047 sfc_a(ihcl_g) = gas(ihcl_g)
7048 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
7049 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
7050
7051 df_gas(ih2so4_g,ibin)= 0.0
7052 df_gas(ihno3_g,ibin) = 0.0
7053 df_gas(ihcl_g,ibin) = 0.0
7054 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
7055
7056
7057 phi_volatile(ihno3_g,ibin) = 0.0
7058 phi_volatile(ihcl_g,ibin) = 0.0
7059 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
7060 max(sfc_a(inh3_g), 1.e-10)
7061
7062
7063 if(abs(phi_volatile(inh3_g,ibin)) .lt. 0.01)then
7064 df_gas(inh3_g,ibin) = 0.0
7065 endif
7066
7067 flux(ih2so4_g,ibin) = 0.0
7068 flux(ihno3_g,ibin) = 0.0
7069 flux(ihcl_g,ibin) = 0.0
7070 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
7071
7072 ph(ibin) = -alog10(mc(jc_h,ibin))
7073 ph_est(ibin) = -alog10(mc(jc_h,ibin))
7074
7075 return
7076 end subroutine asteem_flux_wet_case5
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109 !***********************************************************************
7110 ! computes mass transfer coefficients for each condensing species for
7111 ! all the aerosol bins
7112 !
7113 ! author: rahul a. zaveri
7114 ! update: jan 2005
7115 !-----------------------------------------------------------------------
7116 subroutine aerosolmtc
7117
7118 use module_data_mosaic_asect
7119
7120 ! implicit none
7121 ! include 'v33com9a'
7122 ! include 'mosaic.h'
7123 ! local variables
7124 integer nghq
7125 parameter (nghq = 2) ! gauss-hermite quadrature order
7126 integer ibin, iq, iv
7127 real tworootpi, root2, beta
7128 parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
7129 real cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed, sumghq
7130 real xghq(nghq), wghq(nghq) ! quadrature abscissae and weights
7131 real mw_vol(naer_vol), v_molar(naer_vol) ! mw and molar vols of volatile species
7132 real freepath(naer_vol), accom(naer_vol), dg(naer_vol) ! keep local
7133 ! real fuchs_sutugin ! mosaic func
7134 ! real gas_diffusivity ! mosaic func
7135 ! real mean_molecular_speed ! mosaic func
7136
7137
7138
7139
7140
7141
7142 mw_vol(ih2so4_g) = 98.0
7143 mw_vol(ihno3_g) = 63.0
7144 mw_vol(ihcl_g) = 36.5
7145 mw_vol(inh3_g) = 17.0
7146
7147 v_molar(ih2so4_g)= 42.88
7148 v_molar(ihno3_g) = 24.11
7149 v_molar(ihcl_g) = 21.48
7150 v_molar(inh3_g) = 14.90
7151
7152 accom(ih2so4_g) = 0.1
7153 accom(ihno3_g) = 0.1
7154 accom(ihcl_g) = 0.1
7155 accom(inh3_g) = 0.1
7156
7157 xghq(1) = 0.70710678
7158 xghq(2) = -0.70710678
7159 wghq(1) = 0.88622693
7160 wghq(2) = 0.88622693
7161
7162
7163
7164
7165
7166 ! calculate gas diffusivity and mean free path for condensing gases
7167 do iv = 1, naer_vol
7168 speed = mean_molecular_speed(t_k,mw_vol(iv)) ! cm/s
7169 dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
7170 freepath(iv) = 3.*dg(iv)/speed ! cm
7171 enddo
7172
7173
7174 ! calc mass transfer coefficients for gases over various aerosol bins
7175
7176 if (msize_framework .eq. mmodal) then
7177
7178 ! for modal approach
7179 do 10 ibin = 1, nbin_a
7180
7181 if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
7182 call calc_dry_n_wet_aerosol_props(ibin)
7183
7184 dpgn_a(ibin) = dp_wet_a(ibin) ! cm
7185
7186 lnsg = alog(sigmag_a(ibin))
7187 lndpgn = alog(dpgn_a(ibin))
7188 cdum = tworootpi*num_a(ibin)* &
7189 exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
7190
7191 do 20 iv = 1, naer_vol
7192
7193 sumghq = 0.0
7194 do 30 iq = 1, nghq ! sum over gauss-hermite quadrature points
7195 lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
7196 dp = exp(lndp)
7197 kn = 2.*freepath(iv)/dp
7198 fkn = fuchs_sutugin(kn,accom(iv))
7199 sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
7200 30 continue
7201
7202 kg(iv,ibin) = cdum*dg(iv)*sumghq ! 1/s
7203
7204 20 continue
7205 10 continue
7206
7207 elseif(msize_framework .eq. msection)then
7208
7209 ! for sectional approach
7210 do 11 ibin = 1, nbin_a
7211
7212 if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
7213
7214 call calc_dry_n_wet_aerosol_props(ibin)
7215
7216 dp_avg = dp_wet_a(ibin)
7217 cdum = 6.283185*dp_avg*num_a(ibin)
7218
7219 do 21 iv = 1, naer_vol
7220 kn = 2.*freepath(iv)/dp_avg
7221 fkn = fuchs_sutugin(kn,accom(iv))
7222 kg(iv,ibin) = cdum*dg(iv)*fkn ! 1/s
7223 21 continue
7224
7225 11 continue
7226
7227 else
7228
7229 write(6,*)'error in the choice of msize_framework'
7230 write(6,*)'stopping in subr. aerosolmtc'
7231 ! stop
7232 call peg_error_fatal( lunerr_aer, &
7233 'stopping in subr. aerosolmtc' )
7234
7235 endif
7236
7237
7238 return
7239 end subroutine aerosolmtc
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252 !***********************************************************************
7253 ! calculates dry and wet aerosol properties: density, refractive indices
7254 !
7255 ! author: rahul a. zaveri
7256 ! update: jan 2005
7257 !-----------------------------------------------------------------------
7258 subroutine calc_dry_n_wet_aerosol_props(ibin)
7259
7260 use module_data_mosaic_asect
7261
7262 ! implicit none
7263 ! include 'v33com9a'
7264 ! include 'mosaic.h'
7265 ! subr arguments
7266 integer ibin
7267 ! local variables
7268 integer isize, itype, jc, je
7269 complex ri_dum
7270
7271
7272
7273
7274 if(jaerosolstate(ibin) .ne. no_aerosol)then
7275
7276 ! calculate dry mass and dry volume of a bin
7277 mass_dry_a(ibin) = 0.0 ! initialize to 0.0
7278 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
7279
7280 ! first add all electrolytes
7281 do je = 1, nelectrolyte
7282 comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
7283 mass_dry_a(ibin) = mass_dry_a(ibin) + comp_a(je) ! g/cc(air)
7284
7285 vol_dry_a(ibin) = vol_dry_a(ibin) + comp_a(je)/ & ! cc(aer)/cc(air)
7286 dens_comp_a(je)
7287 enddo
7288
7289 ! next add all other aerosol species except water
7290 comp_a(joc) = aer(ioc_a,jtotal,ibin)*1.e-15 ! g/cc(air)
7291 comp_a(jbc) = aer(ibc_a,jtotal,ibin)*1.e-15 ! g/cc(air)
7292 comp_a(join)= aer(ioin_a,jtotal,ibin)*1.e-15 ! g/cc(air)
7293 comp_a(jh2o)= water_a(ibin)*1.e-3 ! g/cc(air)
7294
7295 mass_dry_a(ibin) = mass_dry_a(ibin) + & ! g/cc(air)
7296 comp_a(joc) + &
7297 comp_a(jbc) + &
7298 comp_a(join)
7299
7300 vol_dry_a(ibin) = vol_dry_a(ibin) + & ! cc(aer)/cc(air)
7301 comp_a(joc)/dens_comp_a(joc) + &
7302 comp_a(jbc)/dens_comp_a(jbc) + &
7303 comp_a(join)/dens_comp_a(join)
7304
7305 ! wet mass and wet volume
7306 mass_wet_a(ibin) = mass_dry_a(ibin) + comp_a(jh2o) ! g/cc(air)
7307
7308 vol_wet_a(ibin) = vol_dry_a(ibin) + & ! cc(aer)/cc(air)
7309 comp_a(jh2o)/dens_comp_a(jh2o)
7310
7311
7312 ! calculate mean dry and wet particle densities
7313 dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
7314 dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
7315
7316
7317 ! calculate mean dry and wet particle diameters
7318 dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
7319 dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
7320
7321
7322 ! calculate volume average refractive index
7323 ri_dum = (0.0,0.0)
7324 do jc = 1, naercomp
7325 ri_dum = ri_dum + ref_index_a(jc)* &
7326 comp_a(jc)/dens_comp_a(jc)
7327 enddo
7328
7329 ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
7330
7331 else ! use defaults
7332
7333 dens_dry_a(ibin) = 1.0 ! g/cc(aerosol)
7334 dens_wet_a(ibin) = 1.0 ! g/cc(aerosol)
7335
7336 call isize_itype_from_ibin( ibin, isize, itype )
7337 dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
7338 dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
7339
7340
7341 ri_avg_a(ibin) = (1.5,0.0)
7342 endif
7343
7344
7345 return
7346 end subroutine calc_dry_n_wet_aerosol_props
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367 !***********************************************************************
7368 ! computes activities
7369 !
7370 ! author: rahul a. zaveri
7371 ! update: jan 2005
7372 !-----------------------------------------------------------------------
7373 subroutine compute_activities(ibin)
7374 ! implicit none
7375 ! include 'mosaic.h'
7376 ! subr arguments
7377 integer ibin
7378 ! local variables
7379 real xt
7380 ! function
7381 ! real aerosol_water
7382
7383
7384 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
7385 if(water_a(ibin) .eq. 0.0)return
7386
7387 call calculate_xt(ibin,jliquid,xt)
7388
7389 if(xt.gt.2.0 .or. xt.lt.0.)then ! check .ge. if that messes up phase calc
7390 call sulfate_poor_activities(ibin) ! fully dissociated electrolytes
7391 else
7392 call sulfate_rich_activities(ibin) ! solve for so4= and hso4- ions
7393 endif
7394
7395
7396 return
7397 end subroutine compute_activities
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408 !***********************************************************************
7409 ! computes activities for sulfate-poor systems
7410 ! all electrolytes in the liquid phase are completely dissociated
7411 !
7412 ! author: rahul a. zaveri
7413 ! update: jan 2005
7414 !-----------------------------------------------------------------------
7415 subroutine sulfate_poor_activities(ibin)
7416 ! implicit none
7417 ! include 'mosaic.h'
7418 ! subr arguments
7419 integer ibin
7420 ! local variables
7421 real equiv_anions, equiv_cations, a_c
7422
7423
7424 ! water molality
7425 mh2o = 55.509 ! 1000 g water / mw(h2o), (mw(h2o) = 18.016)
7426
7427 ! anion molalities (mol/kg water)
7428 ma(ja_so4,ibin) = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
7429 ma(ja_hso4,ibin) = 0.0
7430 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
7431 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
7432 equiv_anions = 2.*ma(ja_so4,ibin) + &
7433 ma(ja_no3,ibin) + &
7434 ma(ja_cl,ibin)
7435
7436 ! cation molalities (mol/kg water)
7437 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
7438 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
7439 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
7440 equiv_cations = mc(jc_nh4,ibin) + &
7441 mc(jc_na,ibin) + &
7442 2.*mc(jc_ca,ibin)
7443
7444 a_c = real(dble(equiv_anions) - dble(equiv_cations))
7445 mc(jc_h,ibin) = 0.5*real( dble(a_c) + &
7446 dble(sqrt(a_c**2 + 4.*keq_ll(3))) )
7447
7448 ! mc(jc_h,ibin) = max( mc(jc_h,ibin), sqrt(keq_ll(3)) )
7449
7450 if(mc(jc_h,ibin) .eq. 0.0)then
7451 mc(jc_h,ibin) = 1.e-10
7452 endif
7453
7454 ph(ibin) = -alog10(mc(jc_h,ibin))
7455
7456 ! compute activity coefficients
7457 if(mactivity_coeff .eq. mmtem)then
7458 call mtem_sulfate_poor(ibin) ! mtem (2004)
7459 elseif(mactivity_coeff .eq. mpsc)then
7460 call psc_sulfate_poor(ibin) ! psc (1992, 1998)
7461 elseif(mactivity_coeff .eq. mkm)then
7462 call km_sulfate_poor(ibin) ! km (1978)
7463 elseif(mactivity_coeff .eq. mbrom)then
7464 call brom_sulfate_poor(ibin) ! bromley (1973)
7465 endif
7466
7467
7468 ! compute activities
7469 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2 * ma(ja_so4,ibin) * &
7470 gam(jnh4so4,ibin)**3
7471
7472 activity(jnh4no3,ibin) = mc(jc_nh4,ibin) * ma(ja_no3,ibin) * &
7473 gam(jnh4no3,ibin)**2
7474
7475 activity(jnh4cl,ibin) = mc(jc_nh4,ibin) * ma(ja_cl,ibin) * &
7476 gam(jnh4cl,ibin)**2
7477
7478 activity(jna2so4,ibin) = mc(jc_na,ibin)**2 * ma(ja_so4,ibin) * &
7479 gam(jna2so4,ibin)**3
7480
7481 activity(jnano3,ibin) = mc(jc_na,ibin) * ma(ja_no3,ibin) * &
7482 gam(jnano3,ibin)**2
7483
7484 activity(jnacl,ibin) = mc(jc_na,ibin) * ma(ja_cl,ibin) * &
7485 gam(jnacl,ibin)**2
7486
7487 activity(jcano3,ibin) = mc(jc_ca,ibin) * ma(ja_no3,ibin)**2 * &
7488 gam(jcano3,ibin)**3
7489
7490 activity(jcacl2,ibin) = mc(jc_ca,ibin) * ma(ja_cl,ibin)**2 * &
7491 gam(jcacl2,ibin)**3
7492
7493 activity(jhno3,ibin) = mc(jc_h,ibin) * ma(ja_no3,ibin) * &
7494 gam(jhno3,ibin)**2
7495
7496 activity(jhcl,ibin) = mc(jc_h,ibin) * ma(ja_cl,ibin) * &
7497 gam(jhcl,ibin)**2
7498
7499 !
7500 activity(jlvcite,ibin) = 0.0
7501
7502 activity(jnh4hso4,ibin)= 0.0
7503
7504 activity(jnahso4,ibin) = 0.0
7505
7506 activity(jna3hso4,ibin)= 0.0
7507
7508 return
7509 end subroutine sulfate_poor_activities
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525 !***********************************************************************
7526 ! pitzer-simonson-clegg (psc) model for multicomponent activity coefficients
7527 !
7528 ! author: rahul a. zaveri
7529 ! update: jan 2005
7530 ! reference: j. phys. chem. a 1998, 102, 2155-2171
7531 !-----------------------------------------------------------------------
7532 subroutine psc_sulfate_poor(ibin)
7533 ! implicit none
7534 ! include 'mosaic.h'
7535 ! subr arguments
7536 integer ibin
7537 ! local variables
7538 integer jx, jm, ja, jc, izi, izj
7539 real mtot, mion, mcation, manion, ix_c, ix_a, &
7540 sum_xczc, sum_xaza, dum
7541 ! function
7542 ! real fn_thetahoe, fn_dthetahoe, fm, fx, fn
7543
7544
7545
7546 ! calculate mol fractions
7547
7548 mh2o = 55.509 ! molality of water
7549
7550 mcation = 0.0
7551 do jc = 1, ncation
7552 mcation = mcation + mc(jc,ibin)
7553 enddo
7554
7555 manion = 0.0
7556 do ja = 1, nanion
7557 manion = manion + ma(ja,ibin)
7558 enddo
7559
7560 mion = mcation + manion
7561
7562 mtot = mh2o + mion
7563
7564 do jc = 1, ncation
7565 xc(jc) = mc(jc,ibin)/mtot
7566 enddo
7567
7568 do ja = 1, nanion
7569 xa(ja) = ma(ja,ibin)/mtot
7570 enddo
7571
7572 xh2o = mh2o/mtot
7573 !
7574 ! calculate variables for mol-fraction
7575 ! scale activity coefficient model
7576
7577 sum_xczc = 0.0
7578 ix_c = 0.0
7579 do jc = 1, ncation
7580 sum_xczc = sum_xczc + xc(jc)*zc(jc)
7581 ix_c = ix_c + 0.5*xc(jc)*zc(jc)**2
7582 enddo
7583
7584 sum_xaza = 0.0
7585 ix_a = 0.0
7586 do ja = 1, nanion
7587 sum_xaza = sum_xaza + xa(ja)*za(ja)
7588 ix_a = ix_a + 0.5*xa(ja)*za(ja)**2
7589 enddo
7590
7591 ix = ix_c + ix_a ! mole fraction ionic strength
7592 ff = 2./(sum_xczc + sum_xaza)
7593 !
7594 ! equivalent cation fractions
7595 do jc = 1, ncation
7596 ec(jc)= xc(jc)*zc(jc)/sum_xczc
7597 enddo
7598
7599 ! differentials
7600 do jm = 1, ncation
7601 do jc = 1, ncation
7602 if(jm.eq.jc)then
7603 emc(jm,jc) = (zc(jm)/sum_xczc) * (1 - ec(jm))
7604 else
7605 emc(jm,jc) = -zc(jm)*ec(jc)/sum_xczc
7606 endif
7607 enddo
7608 enddo
7609
7610 ! equivalent anion fractions
7611 do ja = 1, nanion
7612 ea(ja)= xa(ja)*za(ja)/sum_xaza
7613 enddo
7614
7615 ! differentials
7616 do jx = 1, nanion
7617 do ja = 1, nanion
7618 if(jx.eq.ja)then
7619 exa(jx,ja) = (za(jx)/sum_xaza) * (1 - ea(jx))
7620 else
7621 exa(jx,ja) = -za(jx)*ea(ja)/sum_xaza
7622 endif
7623 enddo
7624 enddo
7625
7626
7627 do izi = 1, 2
7628 do izj = 1, 2
7629
7630 thetahoe(izi,izj) = fn_thetahoe(izi,izj)
7631 dthetahoe(izi,izj) = fn_dthetahoe(izi,izj)
7632
7633 enddo
7634 enddo
7635
7636 !
7637 !
7638 ! mole fraction-scale activity coefficients
7639 fh2o = fn(1) ! neutral species (h2o)
7640
7641 do jm = 1, ncation_clegg
7642 fc(jm,ibin) = fm(jm) ! cations
7643 enddo
7644
7645
7646 do jx = 1, nanion_clegg
7647 fa(jx,ibin) = fx(jx) ! anions
7648 enddo
7649
7650
7651 !
7652 ! molality-scale activity coefficients
7653 dum = (1. + mion/mh2o)
7654
7655 do jc = 1, ncation_clegg
7656 gam_cation(jc,ibin) = fc(jc,ibin)/dum
7657 enddo
7658
7659 do ja = 1, nanion_clegg
7660 gam_anion(ja,ibin) = fa(ja,ibin)/dum
7661 enddo
7662
7663
7664 gam(jnh4no3,ibin) = (gam_cation(jc_nh4,ibin)* &
7665 gam_anion(ja_no3,ibin))**0.5
7666 gam(jnh4cl,ibin) = (gam_cation(jc_nh4,ibin)* &
7667 gam_anion(ja_cl,ibin))**0.5
7668 gam(jnh4so4,ibin) = (gam_cation(jc_nh4,ibin)**2 * &
7669 gam_anion(ja_so4,ibin))**(1./3.)
7670 gam(jnacl,ibin) = (gam_cation(jc_na,ibin)* &
7671 gam_anion(ja_cl,ibin))**0.5
7672 gam(jnano3,ibin) = (gam_cation(jc_na,ibin)* &
7673 gam_anion(ja_no3,ibin))**0.5
7674 gam(jna2so4,ibin) = (gam_cation(jc_na,ibin)**2 * &
7675 gam_anion(ja_so4,ibin))**(1./3.)
7676 gam(jhno3,ibin) = (gam_cation(jc_h,ibin)* &
7677 gam_anion(ja_no3,ibin))**0.5
7678 gam(jhcl,ibin) = (gam_cation(jc_h,ibin)* &
7679 gam_anion(ja_cl,ibin))**0.5
7680 gam(jcacl2,ibin) = (gam_cation(jc_ca,ibin)* &
7681 gam_anion(ja_cl,ibin)**2)**(1./3.)
7682 gam(jcano3,ibin) = (gam_cation(jc_ca,ibin)* &
7683 gam_anion(ja_no3,ibin)**2)**(1./3.)
7684
7685 gam_ratio(ibin) = gam_cation(jc_nh4,ibin)/gam_cation(jc_h,ibin)
7686
7687 !----
7688 gam(jlvcite,ibin) = (gam_cation(jc_nh4,ibin)**3 * &
7689 gam_anion(ja_hso4,ibin) * &
7690 gam_anion(ja_so4,ibin))**(1./5.)
7691
7692 gam(jnh4hso4,ibin)= (gam_cation(jc_nh4,ibin) * &
7693 gam_anion(ja_hso4,ibin))**(1./2.)
7694
7695 gam(jnahso4,ibin) = (gam_cation(jc_na,ibin) * &
7696 gam_anion(ja_hso4,ibin))**(1./2.)
7697
7698 gam(jna3hso4,ibin) = (gam_cation(jc_na,ibin)**3 * &
7699 gam_anion(ja_hso4,ibin) * &
7700 gam_anion(ja_so4,ibin))**(1./5.)
7701
7702 gam(jh2so4,ibin) = (gam_cation(jc_h,ibin)**2 * &
7703 gam_anion(ja_so4,ibin))**(1./3.)
7704
7705 gam(jhhso4,ibin) = (gam_cation(jc_h,ibin) * &
7706 gam_anion(ja_hso4,ibin))**(1./2.)
7707
7708
7709 return
7710 end subroutine psc_sulfate_poor
7711
7712
7713
7714
7715
7716 !***********************************************************************
7717 ! kusik and meissner's method for multicomponent activity coefficients
7718 !
7719 ! author: rahul a. zaveri
7720 ! update: jan 2005
7721 ! reference: aiche j., 1978
7722 !-----------------------------------------------------------------------
7723 subroutine km_sulfate_poor(ibin)
7724 ! implicit none
7725 ! include 'mosaic.h'
7726 ! subr arguments
7727 integer ibin
7728 ! local variables
7729 integer jc, ja
7730 real im_c, im_a, x
7731 ! functions
7732 ! real fnlog_gam0
7733
7734
7735 ! compute molality-scale ionic strength
7736 im_c = 0.0
7737 do jc = 1, ncation
7738 im_c = im_c + 0.5*mc(jc,ibin)*zc(jc)**2
7739 enddo
7740
7741 im_a = 0.0
7742 do ja = 1, nanion
7743 im_a = im_a + 0.5*ma(ja,ibin)*za(ja)**2
7744 enddo
7745
7746 im(ibin) = im_c + im_a ! molality ionic strength
7747 x = im(ibin)
7748
7749 log_gam0(jnh4so4) = fnlog_gam0(jnh4so4,im(ibin))
7750 log_gam0(jnh4no3) = fnlog_gam0(jnh4no3,im(ibin))
7751 log_gam0(jnh4cl) = fnlog_gam0(jnh4cl,im(ibin))
7752 log_gam0(jnacl) = fnlog_gam0(jnacl,im(ibin))
7753 log_gam0(jnano3) = fnlog_gam0(jnano3,im(ibin))
7754 log_gam0(jna2so4) = fnlog_gam0(jna2so4,im(ibin))
7755 log_gam0(jcacl2) = fnlog_gam0(jcacl2,im(ibin))
7756 log_gam0(jcano3) = fnlog_gam0(jcano3,im(ibin))
7757 log_gam0(jhno3) = fnlog_gam0(jhno3,im(ibin))
7758 log_gam0(jhcl) = fnlog_gam0(jhcl,im(ibin))
7759 log_gam0(jh2so4) = fnlog_gam0(jh2so4,im(ibin))
7760 log_gam0(jhhso4) = fnlog_gam0(jhhso4,im(ibin))
7761
7762
7763 ! nh4no3
7764 log_gam(jnh4no3) = (0.5/im(ibin))* &
7765 ( ma(ja_no3,ibin)*log_gam0(jnh4no3) + &
7766 ma(ja_cl,ibin) *log_gam0(jnh4cl) + &
7767 2.25*ma(ja_so4,ibin)*log_gam0(jnh4so4) ) + &
7768 (0.5/im(ibin))* &
7769 ( mc(jc_nh4,ibin)*log_gam0(jnh4no3) + &
7770 mc(jc_na,ibin) *log_gam0(jnano3) + &
7771 2.25*mc(jc_ca,ibin) *log_gam0(jcano3) + &
7772 mc(jc_h,ibin) *log_gam0(jhno3) )
7773 gam(jnh4no3,ibin) = 10.**log_gam(jnh4no3)
7774
7775
7776
7777 ! nh4cl
7778 log_gam(jnh4cl) = (0.5/im(ibin))* &
7779 ( ma(ja_no3,ibin)*log_gam0(jnh4no3) + &
7780 ma(ja_cl,ibin) *log_gam0(jnh4cl) + &
7781 2.25*ma(ja_so4,ibin)*log_gam0(jnh4so4) ) + &
7782 (0.5/im(ibin))* &
7783 ( mc(jc_nh4,ibin)*log_gam0(jnh4cl) + &
7784 mc(jc_na,ibin) *log_gam0(jnacl) + &
7785 2.25*mc(jc_ca,ibin) *log_gam0(jcacl2) + &
7786 mc(jc_h,ibin) *log_gam0(jhcl) )
7787 gam(jnh4cl,ibin) = 10.**log_gam(jnh4cl)
7788
7789
7790
7791 ! (nh4)2so4
7792 log_gam(jnh4so4) = (0.666666667/im(ibin))* &
7793 ( ma(ja_no3,ibin)*log_gam0(jnh4no3) + &
7794 ma(ja_cl,ibin) *log_gam0(jnh4cl) + &
7795 2.25*ma(ja_so4,ibin)*log_gam0(jnh4so4) ) + &
7796 (0.333333333/im(ibin))* &
7797 ( 2.25*mc(jc_nh4,ibin)*log_gam0(jnh4so4) + &
7798 2.25*mc(jc_na,ibin) *log_gam0(jna2so4) )
7799 gam(jnh4so4,ibin) = 10.**log_gam(jnh4so4)
7800
7801
7802
7803 ! nacl
7804 log_gam(jnacl) = (0.5/im(ibin))* &
7805 ( ma(ja_no3,ibin)*log_gam0(jnano3) + &
7806 ma(ja_cl,ibin) *log_gam0(jnacl) + &
7807 2.25*ma(ja_so4,ibin)*log_gam0(jna2so4) ) + &
7808 (0.5/im(ibin))* &
7809 ( mc(jc_nh4,ibin)*log_gam0(jnh4cl) + &
7810 mc(jc_na,ibin) *log_gam0(jnacl) + &
7811 2.25*mc(jc_ca,ibin) *log_gam0(jcacl2) + &
7812 mc(jc_h,ibin) *log_gam0(jhcl) )
7813 gam(jnacl,ibin) = 10.**log_gam(jnacl)
7814
7815
7816
7817 ! nano3
7818 log_gam(jnano3) = (0.5/im(ibin))* &
7819 ( ma(ja_no3,ibin)*log_gam0(jnano3) + &
7820 ma(ja_cl,ibin) *log_gam0(jnacl) + &
7821 2.25*ma(ja_so4,ibin)*log_gam0(jna2so4) ) + &
7822 (0.5/im(ibin))* &
7823 ( mc(jc_nh4,ibin)*log_gam0(jnh4no3) + &
7824 mc(jc_na,ibin) *log_gam0(jnano3) + &
7825 2.25*mc(jc_ca,ibin) *log_gam0(jcano3) + &
7826 mc(jc_h,ibin) *log_gam0(jhno3) )
7827 gam(jnano3,ibin) = 10.**log_gam(jnano3)
7828
7829
7830
7831 ! na2so4
7832 log_gam(jna2so4) = (0.666666667/im(ibin))* &
7833 ( ma(ja_no3,ibin)*log_gam0(jnano3) + &
7834 ma(ja_cl,ibin) *log_gam0(jnacl) + &
7835 2.25*ma(ja_so4,ibin)*log_gam0(jna2so4) ) + &
7836 (0.333333333/im(ibin))* &
7837 ( 2.25*mc(jc_nh4,ibin)*log_gam0(jnh4so4) + &
7838 2.25*mc(jc_na,ibin) *log_gam0(jna2so4) )
7839 gam(jna2so4,ibin) = 10.**log_gam(jna2so4)
7840
7841
7842 ! ca(no3)2
7843 log_gam(jcano3) = (0.333333333/im(ibin))* &
7844 ( 2.25*ma(ja_no3,ibin)*log_gam0(jcano3) + &
7845 2.25*ma(ja_cl,ibin) *log_gam0(jcacl2) ) + &
7846 (0.666666666/im(ibin))* &
7847 ( mc(jc_nh4,ibin)*log_gam0(jnh4no3) + &
7848 mc(jc_na,ibin) *log_gam0(jnano3) + &
7849 2.25*mc(jc_ca,ibin) *log_gam0(jcano3) + &
7850 mc(jc_h,ibin) *log_gam0(jhno3) )
7851 gam(jcano3,ibin) = 10.**log_gam(jcano3)
7852
7853
7854 ! cacl2
7855 log_gam(jcacl2) = (0.333333333/im(ibin))* &
7856 ( 2.25*ma(ja_no3,ibin)*log_gam0(jcano3) + &
7857 2.25*ma(ja_cl,ibin) *log_gam0(jcacl2) ) + &
7858 (0.666666666/im(ibin))* &
7859 ( mc(jc_nh4,ibin)*log_gam0(jnh4cl) + &
7860 mc(jc_na,ibin) *log_gam0(jnacl) + &
7861 2.25*mc(jc_ca,ibin) *log_gam0(jcacl2) + &
7862 mc(jc_h,ibin) *log_gam0(jhcl) )
7863 gam(jcacl2,ibin) = 10.**log_gam(jcacl2)
7864
7865
7866 ! hno3
7867 log_gam(jhno3) = (0.5/im(ibin))* &
7868 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
7869 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
7870 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
7871 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
7872 (0.5/im(ibin))* &
7873 ( mc(jc_nh4,ibin)*log_gam0(jnh4no3) + &
7874 mc(jc_na,ibin) *log_gam0(jnano3) + &
7875 2.25*mc(jc_ca,ibin) *log_gam0(jcano3) + &
7876 mc(jc_h,ibin) *log_gam0(jhno3) )
7877 gam(jhno3,ibin) = 10.**log_gam(jhno3)
7878
7879
7880 ! hcl
7881 log_gam(jhcl) = (0.5/im(ibin))* &
7882 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
7883 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
7884 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
7885 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
7886 (0.5/im(ibin))* &
7887 ( mc(jc_nh4,ibin)*log_gam0(jnh4cl) + &
7888 mc(jc_na,ibin) *log_gam0(jnacl) + &
7889 2.25*mc(jc_ca,ibin) *log_gam0(jcacl2) + &
7890 mc(jc_h,ibin) *log_gam0(jhcl) )
7891 gam(jhcl,ibin) = 10.**log_gam(jhcl)
7892
7893 !----
7894 gam(jlvcite,ibin) = 1.0
7895
7896 gam(jnh4hso4,ibin)= 1.0
7897
7898 gam(jnahso4,ibin) = 1.0
7899
7900 gam(jna3hso4,ibin) = 1.0
7901
7902 gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
7903
7904 return
7905 end subroutine km_sulfate_poor
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916 !***********************************************************************
7917 ! bromley method for multicomponent activity coefficients
7918 !
7919 ! author: rahul a. zaveri
7920 ! update: jan 2005
7921 ! reference: aiche j., 1973
7922 !-----------------------------------------------------------------------
7923 subroutine brom_sulfate_poor(ibin)
7924 ! implicit none
7925 ! include 'mosaic.h'
7926 ! subr arguments
7927 integer ibin
7928 ! local variables
7929 integer jc, ja
7930 real im_c, im_a, x, aterm, agam, sqim, &
7931 z_nh4, z_na, z_ca, z_h, &
7932 z_so4, z_no3, z_cl, &
7933 y_so4_nh4, y_so4_na, y_so4_h, &
7934 y_no3_nh4, y_no3_na, y_no3_ca, y_no3_h, &
7935 y_cl_nh4, y_cl_na, y_cl_ca, y_cl_h, &
7936 x_nh4_so4, x_na_so4, x_h_so4, x_nh4_no3, &
7937 x_na_no3, x_ca_no3, x_h_no3, &
7938 x_nh4_cl, x_na_cl, x_ca_cl, x_h_cl, &
7939 f_nh4, f_na, f_ca, f_h, &
7940 f_no3, f_cl, f_so4
7941 ! function
7942 ! real fnlog_gam0
7943
7944
7945 ! compute molality-scale ionic strength
7946 im_c = 0.0
7947 do jc = 1, ncation
7948 im_c = im_c + 0.5*mc(jc,ibin)*zc(jc)**2
7949 enddo
7950
7951 im_a = 0.0
7952 do ja = 1, nanion
7953 im_a = im_a + 0.5*ma(ja,ibin)*za(ja)**2
7954 enddo
7955
7956 im(ibin) = im_c + im_a ! molality ionic strength
7957 x = im(ibin)
7958
7959 log_gam0(jnh4so4) = fnlog_gam0(jnh4so4,im(ibin))
7960 log_gam0(jnh4no3) = fnlog_gam0(jnh4no3,im(ibin))
7961 log_gam0(jnh4cl) = fnlog_gam0(jnh4cl,im(ibin))
7962 log_gam0(jnacl) = fnlog_gam0(jnacl,im(ibin))
7963 log_gam0(jnano3) = fnlog_gam0(jnano3,im(ibin))
7964 log_gam0(jna2so4) = fnlog_gam0(jna2so4,im(ibin))
7965 log_gam0(jcacl2) = fnlog_gam0(jcacl2,im(ibin))
7966 log_gam0(jcano3) = fnlog_gam0(jcano3,im(ibin))
7967 log_gam0(jhno3) = fnlog_gam0(jhno3,im(ibin))
7968 log_gam0(jhcl) = fnlog_gam0(jhcl,im(ibin))
7969 log_gam0(jh2so4) = fnlog_gam0(jh2so4,im(ibin))
7970 log_gam0(jhhso4) = fnlog_gam0(jhhso4,im(ibin))
7971
7972
7973 agam = 0.511 ! (kg/mol)^0.5
7974 sqim = sqrt(im(ibin))
7975
7976 aterm = agam*sqim/(1. + sqim)
7977
7978 z_nh4 = 1.0
7979 z_na = 1.0
7980 z_ca = 2.0
7981 z_h = 1.0
7982
7983 z_so4 = 2.0
7984 z_no3 = 1.0
7985 z_cl = 1.0
7986
7987 ! y
7988 y_so4_nh4 = ((z_nh4+z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
7989 y_so4_na = ((z_na +z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
7990 y_so4_h = ((z_h +z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
7991
7992 y_no3_nh4 = ((z_nh4+z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
7993 y_no3_na = ((z_na +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
7994 y_no3_ca = ((z_ca +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
7995 y_no3_h = ((z_h +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
7996
7997 y_cl_nh4 = ((z_nh4+z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
7998 y_cl_na = ((z_na +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
7999 y_cl_ca = ((z_ca +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
8000 y_cl_h = ((z_h +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
8001
8002 ! x
8003 x_nh4_so4 = ((z_nh4+z_so4)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
8004 x_na_so4 = ((z_na +z_so4)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
8005 x_h_so4 = ((z_h +z_so4)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
8006
8007 x_nh4_no3 = ((z_nh4+z_no3)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
8008 x_na_no3 = ((z_na +z_no3)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
8009 x_ca_no3 = ((z_ca +z_no3)/2.0)**2.0*mc(jc_ca,ibin)/im(ibin)
8010 x_h_no3 = ((z_h +z_no3)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
8011
8012 x_nh4_cl = ((z_nh4+z_cl)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
8013 x_na_cl = ((z_na +z_cl)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
8014 x_ca_cl = ((z_ca +z_cl)/2.0)**2.0*mc(jc_ca,ibin)/im(ibin)
8015 x_h_cl = ((z_h +z_cl)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
8016
8017
8018
8019 f_nh4 = y_no3_nh4*log_gam0(jnh4no3) + &
8020 y_so4_nh4*log_gam0(jnh4so4) + &
8021 y_cl_nh4 *log_gam0(jnh4cl) + &
8022 aterm*(z_nh4*z_no3*y_no3_nh4 + &
8023 z_nh4*z_so4*y_so4_nh4 + &
8024 z_nh4*z_cl *y_cl_nh4)
8025
8026 f_na = y_no3_na*log_gam0(jnano3) + &
8027 y_so4_na*log_gam0(jna2so4) + &
8028 y_cl_na *log_gam0(jnacl) + &
8029 aterm*(z_na*z_no3*y_no3_na + &
8030 z_na*z_so4*y_so4_na + &
8031 z_na*z_cl *y_cl_na)
8032
8033 f_ca = y_no3_ca*log_gam0(jcano3) + &
8034 y_cl_ca *log_gam0(jcacl2) + &
8035 aterm*(z_ca*z_no3*y_no3_ca + &
8036 z_ca*z_cl *y_cl_ca)
8037
8038 f_h = y_so4_h*log_gam0(jh2so4) + &
8039 y_no3_h*log_gam0(jhno3) + &
8040 y_cl_h *log_gam0(jhcl) + &
8041 aterm*(z_h*z_so4*y_so4_h + &
8042 z_h*z_no3*y_no3_h + &
8043 z_h*z_cl *y_cl_h)
8044
8045
8046 f_no3 = x_nh4_no3*log_gam0(jnh4no3) + &
8047 x_na_no3 *log_gam0(jnano3) + &
8048 x_ca_no3 *log_gam0(jcano3) + &
8049 x_h_no3 *log_gam0(jhno3) + &
8050 aterm*(z_nh4*z_no3*x_nh4_no3 + &
8051 z_na *z_no3*x_na_no3 + &
8052 z_ca *z_no3*x_ca_no3 + &
8053 z_h *z_no3*x_h_no3)
8054
8055 f_cl = x_nh4_cl*log_gam0(jnh4cl) + &
8056 x_na_cl *log_gam0(jnacl) + &
8057 x_ca_cl *log_gam0(jcacl2) + &
8058 x_h_cl *log_gam0(jhcl) + &
8059 aterm*(z_nh4*z_cl*x_nh4_cl + &
8060 z_na *z_cl*x_na_cl + &
8061 z_ca *z_cl*x_ca_cl + &
8062 z_h *z_cl*x_h_cl)
8063
8064 f_so4 = x_nh4_so4*log_gam0(jnh4so4) + &
8065 x_na_so4 *log_gam0(jna2so4) + &
8066 x_h_so4 *log_gam0(jh2so4) + &
8067 aterm*(z_nh4*z_so4*x_nh4_so4 + &
8068 z_na *z_so4*x_na_so4 + &
8069 z_h *z_so4*x_h_so4)
8070
8071
8072 ! nh4no3
8073 log_gam(jnh4no3) = -z_nh4*z_no3*aterm + &
8074 z_nh4*z_no3/(z_nh4+z_no3)*(f_nh4/z_nh4 + f_no3/z_no3)
8075 gam(jnh4no3,ibin) = 10.**log_gam(jnh4no3)
8076
8077
8078 ! nh4cl
8079 log_gam(jnh4cl) = -z_nh4*z_cl*aterm + &
8080 z_nh4*z_cl/(z_nh4+z_cl)*(f_nh4/z_nh4 + f_cl/z_cl)
8081 gam(jnh4cl,ibin) = 10.**log_gam(jnh4cl)
8082
8083
8084 ! (nh4)2so4
8085 log_gam(jnh4so4) = -z_nh4*z_so4*aterm + &
8086 z_nh4*z_so4/(z_nh4+z_so4)*(f_nh4/z_nh4 + f_so4/z_so4)
8087 gam(jnh4so4,ibin) = 10.**log_gam(jnh4so4)
8088
8089 ! nacl
8090 log_gam(jnacl) = -z_na*z_cl*aterm + &
8091 z_na*z_cl/(z_na+z_cl)*(f_na/z_na + f_cl/z_cl)
8092 gam(jnacl,ibin) = 10.**log_gam(jnacl)
8093
8094 ! nano3
8095 log_gam(jnano3) = -z_na*z_no3*aterm + &
8096 z_na*z_no3/(z_na+z_no3)*(f_na/z_na + f_no3/z_no3)
8097 gam(jnano3,ibin) = 10.**log_gam(jnano3)
8098
8099 ! na2so4
8100 log_gam(jna2so4) = -z_na*z_so4*aterm + &
8101 z_na*z_so4/(z_na+z_so4)*(f_na/z_na + f_so4/z_so4)
8102 gam(jna2so4,ibin) = 10.**log_gam(jna2so4)
8103
8104
8105 ! ca(no3)2
8106 log_gam(jcano3) = -z_ca*z_no3*aterm + &
8107 z_ca*z_no3/(z_ca+z_no3)*(f_ca/z_ca + f_no3/z_no3)
8108 gam(jcano3,ibin) = 10.**log_gam(jcano3)
8109
8110
8111 ! cacl2
8112 log_gam(jcacl2) = -z_ca*z_cl*aterm + &
8113 z_ca*z_cl/(z_ca+z_cl)*(f_ca/z_ca + f_cl/z_cl)
8114 gam(jcacl2,ibin) = 10.**log_gam(jcacl2)
8115
8116
8117 ! hno3
8118 log_gam(jhno3) = -z_h*z_no3*aterm + &
8119 z_h*z_no3/(z_h+z_no3)*(f_h/z_h + f_no3/z_no3)
8120 gam(jhno3,ibin) = 10.**log_gam(jhno3)
8121
8122
8123 ! hcl
8124 log_gam(jhcl) = -z_h*z_cl*aterm + &
8125 z_h*z_cl/(z_h+z_cl)*(f_h/z_h + f_cl/z_cl)
8126 gam(jhcl,ibin) = 10.**log_gam(jhcl)
8127
8128 !----
8129 gam(jlvcite,ibin) = 1.0
8130
8131 gam(jnh4hso4,ibin)= 1.0
8132
8133 gam(jnahso4,ibin) = 1.0
8134
8135 gam(jna3hso4,ibin) = 1.0
8136
8137 gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
8138
8139
8140
8141 return
8142 end subroutine brom_sulfate_poor
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152 !***********************************************************************
8153 ! multicomponent taylor expansion method (mtem)
8154 !
8155 ! author: rahul a. zaveri
8156 ! update: jan 2005
8157 ! reference: zaveri et al., jgr 2005
8158 !-----------------------------------------------------------------------
8159 subroutine mtem_sulfate_poor(ibin)
8160 ! implicit none
8161 ! include 'mosaic.h'
8162 ! subr arguments
8163 integer ibin
8164 ! local variables
8165 integer jp, ja
8166 real xmol(nelectrolyte), sum_elec
8167
8168
8169
8170
8171 jp = jliquid
8172
8173
8174 sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) + &
8175 2.*electrolyte(jnh4cl,jp,ibin) + &
8176 3.*electrolyte(jnh4so4,jp,ibin) + &
8177 3.*electrolyte(jna2so4,jp,ibin) + &
8178 2.*electrolyte(jnano3,jp,ibin) + &
8179 2.*electrolyte(jnacl,jp,ibin) + &
8180 3.*electrolyte(jcano3,jp,ibin) + &
8181 3.*electrolyte(jcacl2,jp,ibin) + &
8182 2.*electrolyte(jhno3,jp,ibin) + &
8183 2.*electrolyte(jhcl,jp,ibin)
8184
8185
8186 ! ionic mole fractions
8187 xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
8188 xmol(jnh4cl) = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
8189 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
8190 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
8191 xmol(jnano3) = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
8192 xmol(jnacl) = 2.*electrolyte(jnacl,jp,ibin) /sum_elec
8193 xmol(jcano3) = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
8194 xmol(jcacl2) = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
8195 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin) /sum_elec
8196 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin) /sum_elec
8197
8198
8199 ja = jnh4so4
8200 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8201 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8202 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8203 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8204 xmol(jnano3) *log_gamz(ja,jnano3) + &
8205 xmol(jnacl) *log_gamz(ja,jnacl) + &
8206 xmol(jcano3) *log_gamz(ja,jcano3) + &
8207 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8208 xmol(jhno3) *log_gamz(ja,jhno3) + &
8209 xmol(jhcl) *log_gamz(ja,jhcl)
8210 gam(ja,ibin) = 10.**log_gam(ja)
8211
8212
8213
8214 ja = jnh4no3
8215 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8216 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8217 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8218 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8219 xmol(jnano3) *log_gamz(ja,jnano3) + &
8220 xmol(jnacl) *log_gamz(ja,jnacl) + &
8221 xmol(jcano3) *log_gamz(ja,jcano3) + &
8222 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8223 xmol(jhno3) *log_gamz(ja,jhno3) + &
8224 xmol(jhcl) *log_gamz(ja,jhcl)
8225 gam(ja,ibin) = 10.**log_gam(ja)
8226
8227
8228 ja = jnh4cl
8229 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8230 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8231 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8232 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8233 xmol(jnano3) *log_gamz(ja,jnano3) + &
8234 xmol(jnacl) *log_gamz(ja,jnacl) + &
8235 xmol(jcano3) *log_gamz(ja,jcano3) + &
8236 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8237 xmol(jhno3) *log_gamz(ja,jhno3) + &
8238 xmol(jhcl) *log_gamz(ja,jhcl)
8239 gam(ja,ibin) = 10.**log_gam(ja)
8240
8241
8242 ja = jna2so4
8243 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8244 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8245 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8246 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8247 xmol(jnano3) *log_gamz(ja,jnano3) + &
8248 xmol(jnacl) *log_gamz(ja,jnacl) + &
8249 xmol(jcano3) *log_gamz(ja,jcano3) + &
8250 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8251 xmol(jhno3) *log_gamz(ja,jhno3) + &
8252 xmol(jhcl) *log_gamz(ja,jhcl)
8253 gam(ja,ibin) = 10.**log_gam(ja)
8254
8255
8256 ja = jnano3
8257 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8258 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8259 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8260 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8261 xmol(jnano3) *log_gamz(ja,jnano3) + &
8262 xmol(jnacl) *log_gamz(ja,jnacl) + &
8263 xmol(jcano3) *log_gamz(ja,jcano3) + &
8264 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8265 xmol(jhno3) *log_gamz(ja,jhno3) + &
8266 xmol(jhcl) *log_gamz(ja,jhcl)
8267 gam(ja,ibin) = 10.**log_gam(ja)
8268
8269
8270 ja = jnacl
8271 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8272 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8273 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8274 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8275 xmol(jnano3) *log_gamz(ja,jnano3) + &
8276 xmol(jnacl) *log_gamz(ja,jnacl) + &
8277 xmol(jcano3) *log_gamz(ja,jcano3) + &
8278 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8279 xmol(jhno3) *log_gamz(ja,jhno3) + &
8280 xmol(jhcl) *log_gamz(ja,jhcl)
8281 gam(ja,ibin) = 10.**log_gam(ja)
8282
8283
8284 ja = jcano3
8285 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8286 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8287 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8288 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8289 xmol(jnano3) *log_gamz(ja,jnano3) + &
8290 xmol(jnacl) *log_gamz(ja,jnacl) + &
8291 xmol(jcano3) *log_gamz(ja,jcano3) + &
8292 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8293 xmol(jhno3) *log_gamz(ja,jhno3) + &
8294 xmol(jhcl) *log_gamz(ja,jhcl)
8295 gam(ja,ibin) = 10.**log_gam(ja)
8296
8297
8298
8299 ja = jcacl2
8300 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8301 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8302 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8303 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8304 xmol(jnano3) *log_gamz(ja,jnano3) + &
8305 xmol(jnacl) *log_gamz(ja,jnacl) + &
8306 xmol(jcano3) *log_gamz(ja,jcano3) + &
8307 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8308 xmol(jhno3) *log_gamz(ja,jhno3) + &
8309 xmol(jhcl) *log_gamz(ja,jhcl)
8310 gam(ja,ibin) = 10.**log_gam(ja)
8311
8312
8313 ja = jhno3
8314 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8315 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8316 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8317 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8318 xmol(jnano3) *log_gamz(ja,jnano3) + &
8319 xmol(jnacl) *log_gamz(ja,jnacl) + &
8320 xmol(jcano3) *log_gamz(ja,jcano3) + &
8321 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8322 xmol(jhno3) *log_gamz(ja,jhno3) + &
8323 xmol(jhcl) *log_gamz(ja,jhcl)
8324 gam(ja,ibin) = 10.**log_gam(ja)
8325
8326
8327 ja = jhcl
8328 log_gam(ja) = xmol(jnh4no3)*log_gamz(ja,jnh4no3) + &
8329 xmol(jnh4cl) *log_gamz(ja,jnh4cl) + &
8330 xmol(jnh4so4)*log_gamz(ja,jnh4so4) + &
8331 xmol(jna2so4)*log_gamz(ja,jna2so4) + &
8332 xmol(jnano3) *log_gamz(ja,jnano3) + &
8333 xmol(jnacl) *log_gamz(ja,jnacl) + &
8334 xmol(jcano3) *log_gamz(ja,jcano3) + &
8335 xmol(jcacl2) *log_gamz(ja,jcacl2) + &
8336 xmol(jhno3) *log_gamz(ja,jhno3) + &
8337 xmol(jhcl) *log_gamz(ja,jhcl)
8338 gam(ja,ibin) = 10.**log_gam(ja)
8339
8340 !----
8341 gam(jlvcite,ibin) = 1.0
8342
8343 gam(jnh4hso4,ibin)= 1.0
8344
8345 gam(jnahso4,ibin) = 1.0
8346
8347 gam(jna3hso4,ibin) = 1.0
8348
8349 gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
8350
8351 ! gam_ratio(ibin) = max( gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2,
8352 ! & gam(jnh4cl,ibin)**2/gam(jhcl,ibin)**2 )
8353
8354 return
8355 end subroutine mtem_sulfate_poor
8356
8357
8358
8359
8360
8361
8362
8363
8364 !***********************************************************************
8365 ! computes activity coefficients for sulfate-rich systems
8366 !
8367 ! author: rahul a. zaveri
8368 ! update: jan 2005
8369 !-----------------------------------------------------------------------
8370 subroutine sulfate_rich_activities(ibin) ! rigorous method: psc model
8371 ! implicit none
8372 ! include 'mosaic.h'
8373 ! subr arguments
8374 integer ibin
8375
8376
8377
8378
8379
8380 ! compute activity coefficients
8381 if(mactivity_coeff .eq. mmtem)then
8382 call mtem_sulfate_rich(ibin) ! mtem (2004)
8383 elseif(mactivity_coeff .eq. mpsc .or. & ! psc (1992, 1998)
8384 mactivity_coeff .eq. mkm .or. & ! km (1978)
8385 mactivity_coeff .eq. mbrom)then ! bromley (1973)
8386 call sulfate_rich_iterations(ibin)
8387 endif
8388
8389
8390 ! compute activities
8391 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2 * ma(ja_so4,ibin) * &
8392 gam(jnh4so4,ibin)**3
8393
8394 activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3 * ma(ja_hso4,ibin) * &
8395 ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
8396
8397 activity(jnh4hso4,ibin)= mc(jc_nh4,ibin) * ma(ja_hso4,ibin) * &
8398 gam(jnh4hso4,ibin)**2
8399
8400 activity(jna2so4,ibin) = mc(jc_na,ibin)**2 * ma(ja_so4,ibin) * &
8401 gam(jna2so4,ibin)**3
8402
8403 activity(jnahso4,ibin) = mc(jc_na,ibin) * ma(ja_hso4,ibin) * &
8404 gam(jnahso4,ibin)**2
8405
8406 activity(jna3hso4,ibin)= mc(jc_na,ibin)**3 * ma(ja_hso4,ibin) * &
8407 ma(ja_so4,ibin) * gam(jna3hso4,ibin)**5
8408
8409 activity(jhno3,ibin) = mc(jc_h,ibin) * ma(ja_no3,ibin) * &
8410 gam(jhno3,ibin)**2
8411
8412 activity(jhcl,ibin) = mc(jc_h,ibin) * ma(ja_cl,ibin) * &
8413 gam(jhcl,ibin)**2
8414
8415
8416 ! sulfate-poor species
8417 activity(jnh4no3,ibin) = mc(jc_nh4,ibin) * ma(ja_no3,ibin) * &
8418 gam(jnh4no3,ibin)**2
8419
8420 activity(jnh4cl,ibin) = mc(jc_nh4,ibin) * ma(ja_cl,ibin) * &
8421 gam(jnh4cl,ibin)**2
8422
8423 activity(jnano3,ibin) = mc(jc_na,ibin) * ma(ja_no3,ibin) * &
8424 gam(jnano3,ibin)**2
8425
8426 activity(jnacl,ibin) = mc(jc_na,ibin) * ma(ja_cl,ibin) * &
8427 gam(jnacl,ibin)**2
8428
8429 activity(jcano3,ibin) = mc(jc_ca,ibin) * ma(ja_no3,ibin)**2 * &
8430 gam(jcano3,ibin)**3
8431
8432 activity(jcacl2,ibin) = mc(jc_ca,ibin) * ma(ja_cl,ibin)**2 * &
8433 gam(jcacl2,ibin)**3
8434
8435 return
8436 end subroutine sulfate_rich_activities
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447 !***********************************************************************
8448 ! performs iterations for solving equilibrium h+ ion in sulfate-rich systems
8449 !
8450 ! author: rahul a. zaveri
8451 ! update: jan 2005
8452 !-----------------------------------------------------------------------
8453 subroutine sulfate_rich_iterations(ibin) ! rigorous method: psc model
8454 ! implicit none
8455 ! include 'mosaic.h'
8456 ! subr arguments
8457 integer ibin
8458 ! local variables
8459 integer ja, jc, idum, k1, k2, k3
8460 real mh, mh0, mh1, mh_neutral, & ! mol/kg water
8461 c_plus, c_minus, c_bal, q, q0, q1, &
8462 charge_c, charge_a, charge_net
8463 ! function
8464 ! real fzero
8465
8466
8467
8468 ! all strong electrolytes are completely dissociated
8469 !
8470 !
8471 ! water molality
8472 mh2o = 55.509 ! 1000 g water / mw(h2o), (mw(h2o) = 18.016)
8473
8474 ! cation molalities (mol/kg water)
8475 mc(jc_ca,ibin) = 0.0 ! aqueous ca never exists in sulfate rich cases
8476 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8477 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8478
8479 !
8480 ! anion molalities (mol/kg water)
8481 msulf = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
8482 ma(ja_hso4,ibin) = 0.0
8483 ma(ja_so4,ibin) = 0.0
8484 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8485 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8486
8487
8488 c_plus = mc(jc_nh4,ibin) + mc(jc_na,ibin) + 2.*mc(jc_ca,ibin)
8489 c_minus= ma(ja_no3,ibin) + ma(ja_cl,ibin)
8490 c_bal = real( dble(msulf + c_minus) - dble(c_plus) )
8491
8492
8493 !----------------------------------------------------------
8494 ! inital guesses
8495
8496 mh_neutral = sqrt(keq_ll(3))
8497
8498 ! lower limit
8499 mh0 = c_bal
8500
8501 if(mh0 .le. 0.)then
8502 mh0 = mh_neutral
8503 endif
8504
8505 ! upper limit
8506 mh1 = real( dble(msulf) + dble(c_bal) )
8507
8508 if(mh1 .lt. mh_neutral)then
8509 mh = mh_neutral
8510 mc(jc_h,ibin) = mh
8511 call gamma_a(ibin)
8512
8513 ph(ibin) = -alog10(mc(jc_h,ibin))
8514
8515 ! solve for moles----------------------------------------
8516 charge_c = 0.0
8517 do jc = 1, ncation
8518 charge_c = charge_c + zc(jc)*mc(jc,ibin)
8519 enddo
8520
8521 charge_a = 0.0
8522 do ja = 1, nanion
8523 if(ja .ne. ja_hso4 .and. ja .ne. ja_so4)then
8524 charge_a = charge_a + za(ja)*ma(ja,ibin)
8525 endif
8526 enddo
8527
8528 charge_net = real( dble(charge_c) - dble(charge_a) )
8529
8530 ma(ja_hso4,ibin)= max(real(dble(2.*msulf)-dble(charge_net)),0.0)
8531 ma(ja_so4,ibin) = max(real(dble(charge_net) - dble(msulf)), 0.0)
8532
8533 return
8534 endif
8535
8536
8537 !--------------------------------------------------------------
8538 ! narrowing the search to within a decade
8539
8540
8541 do idum = 1, 10
8542
8543 mh = mh0*10.
8544
8545 q = fzero(mh, ibin)
8546
8547 if(q.gt.0.)then
8548 mh0 = mh
8549 else
8550 goto 41
8551 endif
8552
8553 enddo
8554
8555 41 continue
8556 !-----------------------------------------------------
8557 ! bisection method'
8558 ! q0 = fzero(mh0, ibin)
8559 ! q1 = fzero(mh1, ibin)
8560
8561 k1 = 0
8562 k2 = 0
8563 k3 = 0
8564
8565 ! iteration loop
8566 do k1 = 1, 20
8567
8568 mh = 0.5*(mh0 + mh1) ! bisect mh
8569
8570 if(abs(mh0-mh)/mh .lt. 1.e-3)goto 20
8571
8572 q = fzero(mh, ibin)
8573
8574 if(q.gt.0)then
8575 mh0 = mh
8576 q0 = q
8577 else
8578 mh1 = mh
8579 q1 = q
8580 endif
8581 enddo
8582
8583 !--------------------------------------------------------------
8584 42 continue
8585
8586 ! secant method
8587 ! q0 = azero(mh0, ibin)
8588 ! q1 = azero(mh1, ibin)
8589
8590 ! iteration loop
8591 do k2 =1,5
8592
8593 if(abs(mh1-mh0)/mh0.lt.1.e-3 .or. &
8594 abs(q1-q0).eq.0.0) goto 20
8595
8596 mh = mh1 - q1*(mh1 - mh0)/(q1 - q0)
8597
8598 if(abs(mh-mh0)/mh .lt. 1.e-2)goto 20
8599
8600 mh0 = mh
8601 q = fzero(mh, ibin)
8602 q0 = q
8603
8604 enddo
8605
8606 !--------------------------------------------------------------
8607 43 continue
8608
8609 ! bisection method
8610 !
8611 ! iteration loop
8612 do k3 = 1,100
8613
8614 mh = 0.5*(mh0 + mh1) ! bisect mh
8615
8616 if(abs(mh0-mh)/mh.lt.1.e-3)goto 20
8617
8618 q = fzero(mh, ibin)
8619
8620 ! if(mh .lt. 1.e-7)goto 20
8621
8622 if(q.gt.0)then
8623 mh0 = mh
8624 else
8625 mh1 = mh
8626 endif
8627 enddo
8628
8629
8630 20 continue ! mh converged
8631 ! write(6,*)'k1 k2 k3 ktot = ', k1, k2, k3, (k1+k2+k3)
8632 mc(jc_h,ibin) = mh
8633
8634 ph(ibin) = -alog10(mc(jc_h,ibin))
8635 ph_est(ibin) = -alog10(mc(jc_h,ibin))
8636
8637 if(mactivity_coeff .eq. mpsc)then ! psc
8638 gam_ratio(ibin) = gam_cation(jc_nh4,ibin)/gam_cation(jc_h,ibin)
8639 else ! km or bromley
8640 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
8641 endif
8642
8643
8644 return
8645 end subroutine sulfate_rich_iterations
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655 real function fzero(mh, ibin)
8656 ! implicit none
8657 ! include 'mosaic.h'
8658 ! func arguments
8659 integer ibin
8660 real mh
8661
8662
8663
8664
8665 mc(jc_h,ibin) = mh
8666
8667 if(mactivity_coeff .eq. mpsc)then
8668
8669 call psc_sulfate_rich(ibin)
8670 fzero = keq_ll(1)*gam_anion(ja_hso4,ibin)*ma(ja_hso4,ibin) - &
8671 gam_cation(jc_h,ibin)*mc(jc_h,ibin)* &
8672 gam_anion(ja_so4,ibin)*ma(ja_so4,ibin)
8673
8674 elseif(mactivity_coeff .eq. mkm)then
8675
8676 call km_sulfate_rich(ibin)
8677 fzero = keq_ll(1)*ma(ja_hso4,ibin) - &
8678 gam(jh2so4,ibin)**3/gam(jhhso4,ibin)**2 * &
8679 mc(jc_h,ibin)*ma(ja_so4,ibin)
8680
8681 elseif(mactivity_coeff .eq. mbrom)then
8682
8683 call brom_sulfate_rich(ibin)
8684 fzero = keq_ll(1)*ma(ja_hso4,ibin) - &
8685 gam(jh2so4,ibin)**3/gam(jhhso4,ibin)**2 * &
8686 mc(jc_h,ibin)*ma(ja_so4,ibin)
8687
8688 endif
8689
8690 return
8691 end function fzero
8692
8693
8694
8695
8696
8697
8698
8699 subroutine gamma_a(ibin)
8700
8701 ! implicit none
8702 ! include 'mosaic.h'
8703 ! subr arguments
8704 integer ibin
8705
8706
8707
8708
8709 if(mactivity_coeff .eq. mpsc)then
8710 call psc_sulfate_rich(ibin)
8711 elseif(mactivity_coeff .eq. mkm)then
8712 call km_sulfate_rich(ibin)
8713 elseif(mactivity_coeff .eq. mbrom)then
8714 call brom_sulfate_rich(ibin)
8715 endif
8716
8717 return
8718 end subroutine gamma_a
8719
8720
8721
8722
8723
8724 !***********************************************************************
8725 ! pitzer-simonson-clegg (psc) model
8726 !
8727 ! author: rahul a. zaveri
8728 ! update: jan 2005
8729 ! references: clegg et al., 1992, 1998
8730 !-----------------------------------------------------------------------
8731 subroutine psc_sulfate_rich(ibin)
8732 ! implicit none
8733 ! include 'mosaic.h'
8734 ! subr arguments
8735 integer ibin
8736 ! local variables
8737 integer jx, jm, ja, jc, izi, izj
8738 real mtot, mion, mcation, manion, ix_c, ix_a, &
8739 im_c, im_a, charge_net, charge_c, charge_a, &
8740 sum_xczc, sum_xaza, dum
8741 ! functions
8742 ! real fn_thetahoe, fn_dthetahoe, fn, fm, fx
8743
8744
8745
8746 ! solve for moles----------------------------------------
8747 charge_c = 0.0
8748 do jc = 1, ncation
8749 charge_c = charge_c + zc(jc)*mc(jc,ibin)
8750 enddo
8751
8752 charge_a = 0.0
8753 do ja = 1, nanion
8754 if(ja .ne. ja_hso4 .and. ja .ne. ja_so4)then
8755 charge_a = charge_a + za(ja)*ma(ja,ibin)
8756 endif
8757 enddo
8758
8759 charge_net = real( dble(charge_c) - dble(charge_a) )
8760
8761 ma(ja_hso4,ibin)= max(real(dble(2.*msulf)-dble(charge_net)),0.0)
8762 ma(ja_so4,ibin) = max(real(dble(charge_net) - dble(msulf)), 0.0)
8763 !
8764 !
8765 ! calculate mol fractions -------------------------------
8766
8767 mcation = 0.0
8768 do jc = 1, ncation
8769 mcation = mcation + mc(jc,ibin)
8770 enddo
8771
8772 manion = 0.0
8773 do ja = 1, nanion
8774 manion = manion + ma(ja,ibin)
8775 enddo
8776
8777 mion = mcation + manion
8778
8779 mtot = mh2o + mion
8780
8781
8782 ! compute molality-scale ionic strength
8783 im_c = 0.0
8784 do jc = 1, ncation
8785 im_c = im_c + 0.5*mc(jc,ibin)*zc(jc)**2
8786 enddo
8787
8788 im_a = 0.0
8789 do ja = 1, nanion
8790 im_a = im_a + 0.5*ma(ja,ibin)*za(ja)**2
8791 enddo
8792
8793 im(ibin) = im_c + im_a ! molality ionic strength
8794
8795
8796
8797 do jc = 1, ncation
8798 xc(jc) = mc(jc,ibin)/mtot
8799 enddo
8800
8801 do ja = 1, nanion
8802 xa(ja) = ma(ja,ibin)/mtot
8803 enddo
8804
8805 xh2o = mh2o/mtot
8806
8807 !
8808 ! calculate variables for mol-fraction------------------
8809 ! scale activity coefficient model
8810
8811 sum_xczc = 0.0
8812 ix_c = 0.0
8813 do jc = 1, ncation
8814 sum_xczc = sum_xczc + xc(jc)*zc(jc)
8815 ix_c = ix_c + xc(jc)*zc(jc)**2
8816 enddo
8817
8818 sum_xaza = 0.0
8819 ix_a = 0.0
8820 do ja = 1, nanion
8821 sum_xaza = sum_xaza + xa(ja)*za(ja)
8822 ix_a = ix_a + xa(ja)*za(ja)**2
8823 enddo
8824
8825 ix = 0.5*(ix_c + ix_a) ! mole fraction ionic strength
8826 ff = 2./(sum_xczc + sum_xaza)
8827 !
8828 ! equivalent cation fractions
8829 do jc = 1, ncation
8830 ec(jc)= xc(jc)*zc(jc)/sum_xczc
8831 enddo
8832
8833 ! differentials
8834 do jm = 1, ncation
8835 do jc = 1, ncation
8836 if(jm.eq.jc)then
8837 emc(jm,jc) = (zc(jm)/sum_xczc) * (1 - ec(jm))
8838 else
8839 emc(jm,jc) = -zc(jm)*ec(jc)/sum_xczc
8840 endif
8841 enddo
8842 enddo
8843
8844 ! equivalent anion fractions
8845 do ja = 1, nanion
8846 ea(ja)= xa(ja)*za(ja)/sum_xaza
8847 enddo
8848
8849 ! differentials
8850 do jx = 1, nanion
8851 do ja = 1, nanion
8852 if(jx.eq.ja)then
8853 exa(jx,ja) = (za(jx)/sum_xaza) * (1 - ea(jx))
8854 else
8855 exa(jx,ja) = -za(jx)*ea(ja)/sum_xaza
8856 endif
8857 enddo
8858 enddo
8859
8860 do izi = 1, 2
8861 do izj = 1, 2
8862
8863 thetahoe(izi,izj) = fn_thetahoe(izi,izj)
8864 dthetahoe(izi,izj) = fn_dthetahoe(izi,izj)
8865
8866 enddo
8867 enddo
8868
8869
8870 ! mole fraction-scale activity coefficients
8871 fh2o = fn(1) ! neutral species (h2o)
8872
8873 do jm = 1, ncation_clegg
8874 fc(jm,ibin) = fm(jm) ! cations
8875 enddo
8876
8877 do jx = 1, nanion_clegg
8878 fa(jx,ibin) = fx(jx) ! anions
8879 enddo
8880 !
8881 !
8882 ! molality-scale activity coefficients
8883 10 dum = (1. + mion/mh2o)
8884
8885 do jc = 1, ncation_clegg
8886 gam_cation(jc,ibin) = fc(jc,ibin)/dum
8887 enddo
8888
8889 do ja = 1, nanion_clegg
8890 gam_anion(ja,ibin) = fa(ja,ibin)/dum
8891 enddo
8892
8893
8894 ! compute mean electrolyte activity coefficients
8895 gam(jnh4so4,ibin) = (gam_cation(jc_nh4,ibin)**2 * &
8896 gam_anion(ja_so4,ibin))**(1./3.)
8897
8898 gam(jlvcite,ibin) = (gam_cation(jc_nh4,ibin)**3 * &
8899 gam_anion(ja_hso4,ibin) * &
8900 gam_anion(ja_so4,ibin))**(1./5.)
8901
8902 gam(jnh4hso4,ibin)= (gam_cation(jc_nh4,ibin) * &
8903 gam_anion(ja_hso4,ibin))**(1./2.)
8904
8905 gam(jna2so4,ibin) = (gam_cation(jc_na,ibin)**2 * &
8906 gam_anion(ja_so4,ibin))**(1./3.)
8907
8908 gam(jnahso4,ibin) = (gam_cation(jc_na,ibin) * &
8909 gam_anion(ja_hso4,ibin))**(1./2.)
8910
8911 gam(jna3hso4,ibin) = (gam_cation(jc_na,ibin)**3 * &
8912 gam_anion(ja_hso4,ibin) * &
8913 gam_anion(ja_so4,ibin))**(1./5.)
8914
8915 gam(jh2so4,ibin) = (gam_cation(jc_h,ibin)**2 * &
8916 gam_anion(ja_so4,ibin))**(1./3.)
8917
8918 gam(jhhso4,ibin) = (gam_cation(jc_h,ibin) * &
8919 gam_anion(ja_hso4,ibin))**(1./2.)
8920
8921 gam(jhno3,ibin) = (gam_cation(jc_h,ibin) * &
8922 gam_anion(ja_no3,ibin))**0.5
8923
8924 gam(jhcl,ibin) = (gam_cation(jc_h,ibin) * &
8925 gam_anion(ja_cl,ibin))**0.5
8926
8927
8928
8929 gam_ratio(ibin) = gam_cation(jc_nh4,ibin)/gam_cation(jc_h,ibin)
8930
8931
8932
8933 gam(jnh4no3,ibin) = (gam_cation(jc_nh4,ibin)* &
8934 gam_anion(ja_no3,ibin))**0.5
8935 gam(jnh4cl,ibin) = (gam_cation(jc_nh4,ibin)* &
8936 gam_anion(ja_cl,ibin))**0.5
8937 gam(jnacl,ibin) = (gam_cation(jc_na,ibin)* &
8938 gam_anion(ja_cl,ibin))**0.5
8939 gam(jnano3,ibin) = (gam_cation(jc_na,ibin)* &
8940 gam_anion(ja_no3,ibin))**0.5
8941 gam(jcacl2,ibin) = (gam_cation(jc_ca,ibin)* &
8942 gam_anion(ja_cl,ibin)**2)**(1./3.)
8943 gam(jcano3,ibin) = (gam_cation(jc_ca,ibin)* &
8944 gam_anion(ja_no3,ibin)**2)**(1./3.)
8945
8946
8947 return
8948 end subroutine psc_sulfate_rich
8949
8950
8951
8952
8953
8954
8955 !***********************************************************************
8956 ! kusik and meissner mixing rule for sulfate-rich systems
8957 !
8958 ! author: rahul a. zaveri
8959 ! update: jan 2005
8960 !-----------------------------------------------------------------------
8961 subroutine km_sulfate_rich(ibin)
8962 ! implicit none
8963 ! include 'mosaic.h'
8964 ! subr arguments
8965 integer ibin
8966 ! local variables
8967 integer jc, ja
8968 real im_c, im_a, charge_a, charge_c, charge_net
8969 ! function
8970 ! real fnlog_gam0
8971
8972
8973 ! solve for moles----------------------------------------
8974 charge_c = 0.0
8975 do jc = 1, ncation
8976 charge_c = charge_c + zc(jc)*mc(jc,ibin)
8977 enddo
8978
8979 charge_a = 0.0
8980 do ja = 1, nanion
8981 if(ja .ne. ja_hso4 .and. ja .ne. ja_so4)then
8982 charge_a = charge_a + za(ja)*ma(ja,ibin)
8983 endif
8984 enddo
8985
8986 charge_net = real( dble(charge_c) - dble(charge_a) )
8987
8988 ma(ja_hso4,ibin)= max(real(dble(2.*msulf)-dble(charge_net)),0.0)
8989 ma(ja_so4,ibin) = max(real(dble(charge_net) - dble(msulf)), 0.0)
8990
8991
8992
8993 ! compute molality-scale ionic strength
8994 im_c = 0.0
8995 do jc = 1, ncation
8996 im_c = im_c + 0.5*mc(jc,ibin)*zc(jc)**2
8997 enddo
8998
8999 im_a = 0.0
9000 do ja = 1, nanion
9001 im_a = im_a + 0.5*ma(ja,ibin)*za(ja)**2
9002 enddo
9003
9004 im(ibin) = im_c + im_a ! molality ionic strength
9005
9006 log_gam0(jnh4so4) = fnlog_gam0(jnh4so4,im(ibin))
9007 log_gam0(jnh4no3) = fnlog_gam0(jnh4no3,im(ibin))
9008 log_gam0(jnh4cl) = fnlog_gam0(jnh4cl,im(ibin))
9009 log_gam0(jnacl) = fnlog_gam0(jnacl,im(ibin))
9010 log_gam0(jnano3) = fnlog_gam0(jnano3,im(ibin))
9011 log_gam0(jna2so4) = fnlog_gam0(jna2so4,im(ibin))
9012 log_gam0(jcacl2) = fnlog_gam0(jcacl2,im(ibin))
9013 log_gam0(jcano3) = fnlog_gam0(jcano3,im(ibin))
9014 log_gam0(jhno3) = fnlog_gam0(jhno3,im(ibin))
9015 log_gam0(jhcl) = fnlog_gam0(jhcl,im(ibin))
9016 log_gam0(jh2so4) = fnlog_gam0(jh2so4,im(ibin))
9017 log_gam0(jhhso4) = fnlog_gam0(jhhso4,im(ibin))
9018 log_gam0(jnh4hso4)= fnlog_gam0(jnh4hso4,im(ibin))
9019 ! log_gam0(jlvcite) = fnlog_gam0(jlvcite,im(ibin))
9020 log_gam0(jnahso4) = fnlog_gam0(jnahso4,im(ibin))
9021 ! log_gam0(jna3hso4)= fnlog_gam0(jna3hso4,im(ibin))
9022
9023
9024 ! km
9025 ! (nh4)2so4
9026 log_gam(jnh4so4) = (0.666666667/im(ibin))* &
9027 ( ma(ja_no3,ibin)*log_gam0(jnh4no3) + &
9028 ma(ja_cl,ibin) *log_gam0(jnh4cl) + &
9029 ma(ja_hso4,ibin)*log_gam0(jnh4hso4) + &
9030 2.25*ma(ja_so4,ibin)*log_gam0(jnh4so4) ) + &
9031 (0.333333333/im(ibin))* &
9032 ( 2.25*mc(jc_nh4,ibin)*log_gam0(jnh4so4) + &
9033 2.25*mc(jc_h,ibin) *log_gam0(jh2so4) + &
9034 2.25*mc(jc_na,ibin) *log_gam0(jna2so4) )
9035 gam(jnh4so4,ibin) = 10.**log_gam(jnh4so4)
9036
9037
9038 ! na2so4
9039 log_gam(jna2so4) = (0.666666667/im(ibin))* &
9040 ( ma(ja_no3,ibin)*log_gam0(jnano3) + &
9041 ma(ja_cl,ibin) *log_gam0(jnacl) + &
9042 ma(ja_hso4,ibin)*log_gam0(jnahso4) + &
9043 2.25*ma(ja_so4,ibin)*log_gam0(jna2so4) ) + &
9044 (0.333333333/im(ibin))* &
9045 ( 2.25*mc(jc_nh4,ibin)*log_gam0(jnh4so4) + &
9046 2.25*mc(jc_h,ibin) *log_gam0(jh2so4) + &
9047 2.25*mc(jc_na,ibin) *log_gam0(jna2so4) )
9048 gam(jna2so4,ibin) = 10.**log_gam(jna2so4)
9049
9050
9051 ! hno3
9052 log_gam(jhno3) = (0.5/im(ibin))* &
9053 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
9054 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
9055 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
9056 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
9057 (0.5/im(ibin))* &
9058 ( mc(jc_nh4,ibin)*log_gam0(jnh4no3) + &
9059 mc(jc_na,ibin) *log_gam0(jnano3) + &
9060 2.25*mc(jc_ca,ibin) *log_gam0(jcano3) + &
9061 mc(jc_h,ibin) *log_gam0(jhno3) )
9062 gam(jhno3,ibin) = 10.**log_gam(jhno3)
9063
9064
9065 ! hcl
9066 log_gam(jhcl) = (0.5/im(ibin))* &
9067 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
9068 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
9069 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
9070 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
9071 (0.5/im(ibin))* &
9072 ( mc(jc_nh4,ibin)*log_gam0(jnh4cl) + &
9073 mc(jc_na,ibin) *log_gam0(jnacl) + &
9074 2.25*mc(jc_ca,ibin) *log_gam0(jcacl2) + &
9075 mc(jc_h,ibin) *log_gam0(jhcl) )
9076 gam(jhcl,ibin) = 10.**log_gam(jhcl)
9077
9078
9079 ! h2so4
9080 log_gam(jh2so4) = (0.666666667/im(ibin))* &
9081 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
9082 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
9083 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
9084 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
9085 (0.333333333/im(ibin))* &
9086 ( 2.25*mc(jc_nh4,ibin)*log_gam0(jnh4so4) + &
9087 2.25*mc(jc_h,ibin) *log_gam0(jh2so4) + &
9088 2.25*mc(jc_na,ibin) *log_gam0(jna2so4) )
9089 gam(jh2so4,ibin) = 10.**log_gam(jh2so4)
9090
9091
9092 ! hhso4
9093 log_gam(jhhso4) = (0.5/im(ibin))* &
9094 ( ma(ja_no3,ibin) *log_gam0(jhno3) + &
9095 2.25*ma(ja_so4,ibin) *log_gam0(jh2so4) + &
9096 ma(ja_hso4,ibin)*log_gam0(jhhso4) + &
9097 ma(ja_cl,ibin) *log_gam0(jhcl) ) + &
9098 (0.5/im(ibin))* &
9099 ( mc(jc_nh4,ibin)*log_gam0(jnh4hso4) + &
9100 mc(jc_h,ibin) *log_gam0(jhhso4) + &
9101 mc(jc_na,ibin) *log_gam0(jnahso4) )
9102 gam(jhhso4,ibin) = 10.**log_gam(jhhso4)
9103
9104
9105 ! nh4hso4
9106 gam(jnh4hso4,ibin)= (0.5/im(ibin))* &
9107 ( ma(ja_no3,ibin)*log_gam0(jnh4no3) + &
9108 ma(ja_cl,ibin) *log_gam0(jnh4cl) + &
9109 ma(ja_hso4,ibin)*log_gam0(jnh4hso4) + &
9110 2.25*ma(ja_so4,ibin)*log_gam0(jnh4so4) ) + &
9111 (0.5/im(ibin))* &
9112 ( mc(jc_nh4,ibin)*log_gam0(jnh4hso4) + &
9113 mc(jc_h,ibin) *log_gam0(jhhso4) + &
9114 mc(jc_na,ibin) *log_gam0(jnahso4) )
9115 gam(jnh4hso4,ibin) = 10.**log_gam(jnh4hso4)
9116
9117
9118 ! nahso4
9119 gam(jnahso4,ibin) = (0.5/im(ibin))* &
9120 ( ma(ja_no3,ibin)*log_gam0(jnano3) + &
9121 ma(ja_cl,ibin) *log_gam0(jnacl) + &
9122 ma(ja_hso4,ibin)*log_gam0(jnahso4) + &
9123 2.25*ma(ja_so4,ibin)*log_gam0(jna2so4) ) + &
9124 (0.5/im(ibin))* &
9125 ( mc(jc_nh4,ibin)*log_gam0(jnh4hso4) + &
9126 mc(jc_h,ibin) *log_gam0(jhhso4) + &
9127 mc(jc_na,ibin) *log_gam0(jnahso4) )
9128 gam(jnahso4,ibin) = 10.**log_gam(jnahso4)
9129
9130
9131 ! derived quantities common to both km and bromley...
9132
9133
9134 gam(jlvcite,ibin) = (gam(jnh4so4,ibin)**3 * &
9135 gam(jnh4hso4,ibin)**2 )**0.2
9136
9137 gam(jna3hso4,ibin)= (gam(jna2so4,ibin)**3 * &
9138 gam(jnahso4,ibin)**2 )**0.2
9139
9140 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
9141
9142 return
9143 end subroutine km_sulfate_rich
9144
9145
9146
9147
9148
9149
9150
9151 !***********************************************************************
9152 ! bromley mixing rule for sulfate-rich systems
9153 !
9154 ! author: rahul a. zaveri
9155 ! update: jan 2005
9156 ! references: clegg et al., 1992, 1998
9157 !-----------------------------------------------------------------------
9158 subroutine brom_sulfate_rich(ibin)
9159 ! implicit none
9160 ! include 'mosaic.h'
9161 ! subr arguments
9162 integer ibin
9163 ! local variables
9164 integer jc, ja
9165 real im_c, im_a, x, aterm, agam, sqim, &
9166 charge_a, charge_c, charge_net, &
9167 z_nh4, z_na, z_ca, z_h, &
9168 z_so4, z_hso4, z_no3, z_cl, &
9169 y_so4_nh4, y_so4_na, y_so4_h, &
9170 y_hso4_nh4, y_hso4_na, y_hso4_h, &
9171 y_no3_nh4, y_no3_na, y_no3_ca, y_no3_h, &
9172 y_cl_nh4, y_cl_na, y_cl_ca, y_cl_h, &
9173 x_nh4_so4, x_na_so4, x_h_so4, &
9174 x_nh4_hso4, x_na_hso4, x_h_hso4, &
9175 x_nh4_no3, x_na_no3, x_ca_no3, x_h_no3, &
9176 x_nh4_cl, x_na_cl, x_ca_cl, x_h_cl, &
9177 f_nh4, f_na, f_ca, f_h, &
9178 f_no3, f_cl, f_so4, f_hso4
9179 ! function
9180 ! real fnlog_gam0
9181
9182
9183
9184 ! solve for moles----------------------------------------
9185 charge_c = 0.0
9186 do jc = 1, ncation
9187 charge_c = charge_c + zc(jc)*mc(jc,ibin)
9188 enddo
9189
9190 charge_a = 0.0
9191 do ja = 1, nanion
9192 if(ja .ne. ja_hso4 .and. ja .ne. ja_so4)then
9193 charge_a = charge_a + za(ja)*ma(ja,ibin)
9194 endif
9195 enddo
9196
9197 charge_net = real( dble(charge_c) - dble(charge_a) )
9198
9199 ma(ja_hso4,ibin)= max(real(dble(2.*msulf)-dble(charge_net)),0.0)
9200 ma(ja_so4,ibin) = max(real(dble(charge_net) - dble(msulf)), 0.0)
9201
9202
9203
9204 ! compute molality-scale ionic strength
9205 im_c = 0.0
9206 do jc = 1, ncation
9207 im_c = im_c + 0.5*mc(jc,ibin)*zc(jc)**2
9208 enddo
9209
9210 im_a = 0.0
9211 do ja = 1, nanion
9212 im_a = im_a + 0.5*ma(ja,ibin)*za(ja)**2
9213 enddo
9214
9215 im(ibin) = im_c + im_a ! molality ionic strength
9216
9217 log_gam0(jnh4so4) = fnlog_gam0(jnh4so4,im(ibin))
9218 log_gam0(jnh4no3) = fnlog_gam0(jnh4no3,im(ibin))
9219 log_gam0(jnh4cl) = fnlog_gam0(jnh4cl,im(ibin))
9220 log_gam0(jnacl) = fnlog_gam0(jnacl,im(ibin))
9221 log_gam0(jnano3) = fnlog_gam0(jnano3,im(ibin))
9222 log_gam0(jna2so4) = fnlog_gam0(jna2so4,im(ibin))
9223 log_gam0(jcacl2) = fnlog_gam0(jcacl2,im(ibin))
9224 log_gam0(jcano3) = fnlog_gam0(jcano3,im(ibin))
9225 log_gam0(jhno3) = fnlog_gam0(jhno3,im(ibin))
9226 log_gam0(jhcl) = fnlog_gam0(jhcl,im(ibin))
9227 log_gam0(jh2so4) = fnlog_gam0(jh2so4,im(ibin))
9228 log_gam0(jhhso4) = fnlog_gam0(jhhso4,im(ibin))
9229 log_gam0(jnh4hso4)= fnlog_gam0(jnh4hso4,im(ibin))
9230 ! log_gam0(jlvcite) = fnlog_gam0(jlvcite,im(ibin))
9231 log_gam0(jnahso4) = fnlog_gam0(jnahso4,im(ibin))
9232 ! log_gam0(jna3hso4)= fnlog_gam0(jna3hso4,im(ibin))
9233 !-------------------------------------------------------------------
9234
9235 agam = 0.511 ! (kg/mol)^0.5
9236 sqim = sqrt(im(ibin))
9237
9238 aterm = agam*sqim/(1. + sqim)
9239
9240 z_nh4 = 1.0
9241 z_na = 1.0
9242 z_ca = 2.0
9243 z_h = 1.0
9244
9245 z_so4 = 2.0
9246 z_hso4= 1.0
9247 z_no3 = 1.0
9248 z_cl = 1.0
9249
9250 ! y
9251 y_so4_nh4 = ((z_nh4+z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
9252 y_so4_na = ((z_na +z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
9253 y_so4_h = ((z_h +z_so4)/2.0)**2.0*ma(ja_so4,ibin)/im(ibin)
9254
9255 y_hso4_nh4= ((z_nh4+z_hso4)/2.0)**2.0*ma(ja_hso4,ibin)/im(ibin)
9256 y_hso4_na = ((z_na +z_hso4)/2.0)**2.0*ma(ja_hso4,ibin)/im(ibin)
9257 y_hso4_h = ((z_h +z_hso4)/2.0)**2.0*ma(ja_hso4,ibin)/im(ibin)
9258
9259 y_no3_nh4 = ((z_nh4+z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
9260 y_no3_na = ((z_na +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
9261 y_no3_ca = ((z_ca +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
9262 y_no3_h = ((z_h +z_no3)/2.0)**2.0*ma(ja_no3,ibin)/im(ibin)
9263
9264 y_cl_nh4 = ((z_nh4+z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
9265 y_cl_na = ((z_na +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
9266 y_cl_ca = ((z_ca +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
9267 y_cl_h = ((z_h +z_cl)/2.0)**2.0*ma(ja_cl,ibin)/im(ibin)
9268
9269 ! x
9270 x_nh4_so4 = ((z_nh4+z_so4)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
9271 x_na_so4 = ((z_na +z_so4)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
9272 x_h_so4 = ((z_h +z_so4)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
9273
9274 x_nh4_hso4= ((z_nh4+z_hso4)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
9275 x_na_hso4 = ((z_na +z_hso4)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
9276 x_h_hso4 = ((z_h +z_hso4)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
9277
9278 x_nh4_no3 = ((z_nh4+z_no3)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
9279 x_na_no3 = ((z_na +z_no3)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
9280 x_ca_no3 = ((z_ca +z_no3)/2.0)**2.0*mc(jc_ca,ibin)/im(ibin)
9281 x_h_no3 = ((z_h +z_no3)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
9282
9283 x_nh4_cl = ((z_nh4+z_cl)/2.0)**2.0*mc(jc_nh4,ibin)/im(ibin)
9284 x_na_cl = ((z_na +z_cl)/2.0)**2.0*mc(jc_na,ibin)/im(ibin)
9285 x_ca_cl = ((z_ca +z_cl)/2.0)**2.0*mc(jc_ca,ibin)/im(ibin)
9286 x_h_cl = ((z_h +z_cl)/2.0)**2.0*mc(jc_h,ibin)/im(ibin)
9287
9288
9289
9290 f_nh4 = y_so4_nh4 *log_gam0(jnh4so4) + &
9291 y_hso4_nh4*log_gam0(jnh4hso4)+ &
9292 y_no3_nh4*log_gam0(jnh4no3) + &
9293 y_cl_nh4 *log_gam0(jnh4cl) + &
9294 aterm*(z_nh4*z_so4 *y_so4_nh4 + &
9295 z_nh4*z_hso4*y_hso4_nh4 + &
9296 z_nh4*z_no3*y_no3_nh4 + &
9297 z_nh4*z_cl *y_cl_nh4)
9298
9299 f_na = y_so4_na *log_gam0(jna2so4) + &
9300 y_hso4_na*log_gam0(jnahso4) + &
9301 y_no3_na*log_gam0(jnano3) + &
9302 y_cl_na *log_gam0(jnacl) + &
9303 aterm*(z_na*z_so4 *y_so4_na + &
9304 z_na*z_hso4*y_hso4_na + &
9305 z_na*z_no3*y_no3_na + &
9306 z_na*z_cl *y_cl_na)
9307
9308 f_h = y_so4_h *log_gam0(jh2so4) + &
9309 y_hso4_h*log_gam0(jhhso4) + &
9310 y_no3_h *log_gam0(jhno3) + &
9311 y_cl_h *log_gam0(jhcl) + &
9312 aterm*(z_h*z_so4* y_so4_h + &
9313 z_h*z_hso4*y_hso4_h + &
9314 z_h*z_no3* y_no3_h + &
9315 z_h*z_cl * y_cl_h)
9316
9317
9318 f_no3 = x_nh4_no3*log_gam0(jnh4no3) + &
9319 x_na_no3 *log_gam0(jnano3) + &
9320 x_ca_no3 *log_gam0(jcano3) + &
9321 x_h_no3 *log_gam0(jhno3) + &
9322 aterm*(z_nh4*z_no3*x_nh4_no3 + &
9323 z_na *z_no3*x_na_no3 + &
9324 z_ca *z_no3*x_ca_no3 + &
9325 z_h *z_no3*x_h_no3)
9326
9327 f_cl = x_nh4_cl*log_gam0(jnh4cl) + &
9328 x_na_cl *log_gam0(jnacl) + &
9329 x_ca_cl *log_gam0(jcacl2) + &
9330 x_h_cl *log_gam0(jhcl) + &
9331 aterm*(z_nh4*z_cl*x_nh4_cl + &
9332 z_na *z_cl*x_na_cl + &
9333 z_ca *z_cl*x_ca_cl + &
9334 z_h *z_cl*x_h_cl)
9335
9336 f_so4 = x_nh4_so4*log_gam0(jnh4so4) + &
9337 x_na_so4 *log_gam0(jna2so4) + &
9338 x_h_so4 *log_gam0(jh2so4) + &
9339 aterm*(z_nh4*z_so4*x_nh4_so4 + &
9340 z_na *z_so4*x_na_so4 + &
9341 z_h *z_so4*x_h_so4)
9342
9343 f_hso4= x_nh4_hso4*log_gam0(jnh4hso4) + &
9344 x_na_hso4 *log_gam0(jnahso4) + &
9345 x_h_hso4 *log_gam0(jhhso4) + &
9346 aterm*(z_nh4*z_hso4*x_nh4_hso4 + &
9347 z_na *z_hso4*x_na_hso4 + &
9348 z_h *z_hso4*x_h_hso4)
9349
9350
9351
9352 ! (nh4)2so4
9353 log_gam(jnh4so4) = -z_nh4*z_so4*aterm + &
9354 z_nh4*z_so4/(z_nh4+z_so4)*(f_nh4/z_nh4 + f_so4/z_so4)
9355 gam(jnh4so4,ibin) = 10.**log_gam(jnh4so4)
9356
9357 ! nh4hso4
9358 log_gam(jnh4hso4)= -z_nh4*z_hso4*aterm + &
9359 z_nh4*z_hso4/(z_nh4+z_hso4)*(f_nh4/z_nh4 + f_hso4/z_hso4)
9360 gam(jnh4hso4,ibin) = 10.**log_gam(jnh4hso4)
9361
9362 ! na2so4
9363 log_gam(jna2so4) = -z_na*z_so4*aterm + &
9364 z_na*z_so4/(z_na+z_so4)*(f_na/z_na + f_so4/z_so4)
9365 gam(jna2so4,ibin) = 10.**log_gam(jna2so4)
9366
9367 ! nahso4
9368 log_gam(jnahso4) = -z_na*z_hso4*aterm + &
9369 z_na*z_hso4/(z_na+z_hso4)*(f_na/z_na + f_hso4/z_hso4)
9370 gam(jnahso4,ibin) = 10.**log_gam(jnahso4)
9371
9372 ! h2so4
9373 log_gam(jh2so4) = -z_h*z_so4*aterm + &
9374 z_h*z_so4/(z_h+z_so4)*(f_h/z_h + f_so4/z_so4)
9375 gam(jh2so4,ibin) = 10.**log_gam(jh2so4)
9376
9377
9378 ! hhso4
9379 log_gam(jhhso4) = -z_h*z_hso4*aterm + &
9380 z_h*z_hso4/(z_h+z_hso4)*(f_h/z_h + f_hso4/z_hso4)
9381 gam(jhhso4,ibin) = 10.**log_gam(jhhso4)
9382
9383
9384 ! hno3
9385 log_gam(jhno3) = -z_h*z_no3*aterm + &
9386 z_h*z_no3/(z_h+z_no3)*(f_h/z_h + f_no3/z_no3)
9387 gam(jhno3,ibin) = 10.**log_gam(jhno3)
9388
9389
9390 ! hcl
9391 log_gam(jhcl) = -z_h*z_cl*aterm + &
9392 z_h*z_cl/(z_h+z_cl)*(f_h/z_h + f_cl/z_cl)
9393 gam(jhcl,ibin) = 10.**log_gam(jhcl)
9394
9395 !-------------------------------------------------------------------
9396
9397
9398 ! derived quantities common to both km and bromley...
9399
9400
9401 gam(jlvcite,ibin) = (gam(jnh4so4,ibin)**3 * &
9402 gam(jnh4hso4,ibin)**2 )**0.2
9403
9404 gam(jna3hso4,ibin)= (gam(jna2so4,ibin)**3 * &
9405 gam(jnahso4,ibin)**2 )**0.2
9406
9407 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
9408
9409 return
9410 end subroutine brom_sulfate_rich
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421 !***********************************************************************
9422 ! multicomponent taylor expansion method (mtem)
9423 !
9424 ! author: rahul a. zaveri
9425 ! update: jan 2005
9426 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
9427 ! a new method for multicomponent activity coefficients of electrolytes
9428 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
9429 !-----------------------------------------------------------------------
9430 subroutine mtem_sulfate_rich(ibin)
9431 ! implicit none
9432 ! include 'mosaic.h'
9433 ! subr arguments
9434 integer ibin
9435 ! local variables
9436 integer jp, ja
9437 real xmol(nelectrolyte), sum_elec, dumk, &
9438 c_bal, a, b, c
9439 ! function
9440 ! real quadratic
9441
9442
9443 jp = jliquid
9444
9445 sum_elec = 3.*electrolyte(jh2so4,jp,ibin) + &
9446 2.*electrolyte(jnh4hso4,jp,ibin) + &
9447 5.*electrolyte(jlvcite,jp,ibin) + &
9448 3.*electrolyte(jnh4so4,jp,ibin) + &
9449 2.*electrolyte(jnahso4,jp,ibin) + &
9450 5.*electrolyte(jna3hso4,jp,ibin) + &
9451 3.*electrolyte(jna2so4,jp,ibin) + &
9452 2.*electrolyte(jhno3,jp,ibin) + &
9453 2.*electrolyte(jhcl,jp,ibin)
9454
9455
9456 xmol(jh2so4) = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
9457 xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
9458 xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
9459 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
9460 xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
9461 xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
9462 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
9463 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
9464 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
9465
9466
9467 ! 2h.so4
9468 ja = jh2so4
9469 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9470 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9471 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9472 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9473 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9474 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9475 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9476 xmol(jhno3) *log_gamz(ja,jhno3) + &
9477 xmol(jhcl) *log_gamz(ja,jhcl)
9478 gam(ja,ibin) = 10.**log_gam(ja)
9479
9480
9481 ! h.hso4
9482 ja = jhhso4
9483 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9484 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9485 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9486 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9487 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9488 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9489 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9490 xmol(jhno3) *log_gamz(ja,jhno3) + &
9491 xmol(jhcl) *log_gamz(ja,jhcl)
9492 gam(ja,ibin) = 10.**log_gam(ja)
9493
9494
9495 ! nh4hso4
9496 ja = jnh4hso4
9497 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9498 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9499 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9500 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9501 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9502 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9503 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9504 xmol(jhno3) *log_gamz(ja,jhno3) + &
9505 xmol(jhcl) *log_gamz(ja,jhcl)
9506 gam(ja,ibin) = 10.**log_gam(ja)
9507
9508
9509 ! letovicite
9510 ja = jlvcite
9511 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9512 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9513 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9514 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9515 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9516 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9517 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9518 xmol(jhno3) *log_gamz(ja,jhno3) + &
9519 xmol(jhcl) *log_gamz(ja,jhcl)
9520 gam(ja,ibin) = 10.**log_gam(ja)
9521
9522
9523 ! (nh4)2so4
9524 ja = jnh4so4
9525 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9526 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9527 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9528 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9529 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9530 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9531 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9532 xmol(jhno3) *log_gamz(ja,jhno3) + &
9533 xmol(jhcl) *log_gamz(ja,jhcl)
9534 gam(ja,ibin) = 10.**log_gam(ja)
9535
9536
9537 ! nahso4
9538 ja = jnahso4
9539 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9540 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9541 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9542 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9543 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9544 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9545 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9546 xmol(jhno3) *log_gamz(ja,jhno3) + &
9547 xmol(jhcl) *log_gamz(ja,jhcl)
9548 gam(ja,ibin) = 10.**log_gam(ja)
9549
9550
9551 ! na3h(so4)2
9552 ja = jna3hso4
9553 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9554 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9555 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9556 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9557 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9558 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9559 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9560 xmol(jhno3) *log_gamz(ja,jhno3) + &
9561 xmol(jhcl) *log_gamz(ja,jhcl)
9562 gam(ja,ibin) = 10.**log_gam(ja)
9563
9564
9565 ! na2so4
9566 ja = jna2so4
9567 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9568 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9569 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9570 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9571 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9572 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9573 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9574 xmol(jhno3) *log_gamz(ja,jhno3) + &
9575 xmol(jhcl) *log_gamz(ja,jhcl)
9576 gam(ja,ibin) = 10.**log_gam(ja)
9577
9578
9579 ! hno3
9580 ja = jhno3
9581 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9582 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9583 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9584 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9585 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9586 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9587 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9588 xmol(jhno3) *log_gamz(ja,jhno3) + &
9589 xmol(jhcl) *log_gamz(ja,jhcl)
9590 gam(ja,ibin) = 10.**log_gam(ja)
9591
9592
9593 ! hcl
9594 ja = jhcl
9595 log_gam(ja) = xmol(jh2so4) *log_gamz(ja,jh2so4) + &
9596 xmol(jnh4hso4)*log_gamz(ja,jnh4hso4)+ &
9597 xmol(jlvcite) *log_gamz(ja,jlvcite) + &
9598 xmol(jnh4so4) *log_gamz(ja,jnh4so4) + &
9599 xmol(jnahso4) *log_gamz(ja,jnahso4) + &
9600 xmol(jna3hso4)*log_gamz(ja,jna3hso4)+ &
9601 xmol(jna2so4) *log_gamz(ja,jna2so4) + &
9602 xmol(jhno3) *log_gamz(ja,jhno3) + &
9603 xmol(jhcl) *log_gamz(ja,jhcl)
9604 gam(ja,ibin) = 10.**log_gam(ja)
9605
9606
9607 gam(jnh4no3,ibin) = 1.0
9608 gam(jnh4cl,ibin) = 1.0
9609 gam(jnano3,ibin) = 1.0
9610 gam(jnacl,ibin) = 1.0
9611 gam(jcano3,ibin) = 1.0
9612 gam(jcacl2,ibin) = 1.0
9613
9614
9615 ! compute equilibrium ph
9616 ! cation molalities (mol/kg water)
9617 mc(jc_ca,ibin) = 0.0 ! aqueous ca never exists in sulfate rich cases
9618 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
9619 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
9620
9621 ! anion molalities (mol/kg water)
9622 msulf = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
9623 ma(ja_hso4,ibin) = 0.0
9624 ma(ja_so4,ibin) = 0.0
9625 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
9626 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
9627
9628 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
9629 dumk = keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
9630
9631 c_bal = mc(jc_nh4,ibin) + mc(jc_na,ibin) &
9632 - ma(ja_no3,ibin) - ma(ja_cl,ibin) - msulf
9633
9634 a = 1.0
9635 b = dumk + c_bal
9636 c = dumk*(c_bal - msulf)
9637 mc(jc_h,ibin) = quadratic(a,b,c)
9638
9639 mc(jc_h,ibin) = max(sqrt(keq_ll(3)), mc(jc_h,ibin))
9640
9641 ph(ibin) = -alog10(mc(jc_h,ibin))
9642 ph_est(ibin) = -alog10(mc(jc_h,ibin))
9643
9644
9645 ma(ja_so4,ibin) = msulf*dumk/(mc(jc_h,ibin) + dumk)
9646 ma(ja_hso4,ibin)= real( dble(msulf) - dble(ma(ja_so4,ibin)) )
9647
9648
9649
9650 return
9651 end subroutine mtem_sulfate_rich
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662 !***********************************************************************
9663 ! computes mtem ternary parameters only once per transport time-step
9664 ! for a given ah2o (= rh)
9665 !
9666 ! author: rahul a. zaveri
9667 ! update: jan 2005
9668 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
9669 ! a new method for multicomponent activity coefficients of electrolytes
9670 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
9671 !-----------------------------------------------------------------------
9672 subroutine mtem_compute_log_gamz
9673 ! implicit none
9674 ! include 'mosaic.h'
9675 ! local variables
9676 integer ja
9677 ! functions
9678 ! real fnlog_gamz, bin_molality
9679
9680
9681 ! sulfate-poor species
9682 ja = jhno3
9683 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9684 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9685 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9686 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9687 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9688 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9689 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9690 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9691 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9692 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9693 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9694 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9695 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9696 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9697 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9698
9699
9700 ja = jhcl
9701 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9702 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9703 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9704 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9705 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9706 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9707 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9708 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9709 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9710 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9711 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9712 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9713 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9714 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9715 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9716
9717
9718 ja = jnh4so4
9719 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9720 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9721 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9722 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9723 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9724 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9725 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9726 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9727 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9728 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9729 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9730 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9731 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9732 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9733 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9734
9735
9736 ja = jnh4no3
9737 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9738 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9739 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9740 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9741 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9742 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9743 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9744 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9745 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9746 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9747
9748 gam_nh4no3_0 = 10.**log_gamz(ja, jnh4no3)
9749 keq_nh4no3_0 = (bin_molality(ja,1)*gam_nh4no3_0)**2 *keq_ll(3)/ & ! = [nh3]0s * [hno3]0s
9750 (keq_ll(2)*keq_gl(2)*keq_gl(3))
9751
9752
9753 ja = jnh4cl
9754 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9755 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9756 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9757 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9758 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9759 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9760 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9761 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9762 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9763 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9764
9765 gam_nh4cl_0 = 10.**log_gamz(ja, jnh4cl)
9766 keq_nh4cl_0 = (bin_molality(ja,1)*gam_nh4cl_0)**2 *keq_ll(3)/ & ! = [nh3]0s * [hcl]0s
9767 (keq_ll(2)*keq_gl(2)*keq_gl(4))
9768
9769
9770 ja = jna2so4
9771 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9772 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9773 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9774 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9775 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9776 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9777 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9778 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9779 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9780 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9781 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9782 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9783 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9784 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9785 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9786
9787
9788 ja = jnano3
9789 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9790 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9791 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9792 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9793 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9794 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9795 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9796 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9797 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9798 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9799
9800
9801 ja = jnacl
9802 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9803 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9804 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9805 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9806 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9807 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9808 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9809 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9810 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9811 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9812
9813
9814 ja = jcano3
9815 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9816 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9817 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9818 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9819 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9820 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9821 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9822 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9823 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9824 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9825
9826
9827 ja = jcacl2
9828 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9829 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9830 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
9831 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9832 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
9833 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
9834 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
9835 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
9836 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9837 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9838
9839
9840 ! sulfate-rich species
9841 ja = jh2so4
9842 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9843 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9844 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9845 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9846 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9847 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9848 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9849 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9850 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9851
9852
9853 ja = jhhso4
9854 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9855 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9856 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9857 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9858 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9859 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9860 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9861 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9862 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9863
9864
9865 ja = jnh4hso4
9866 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9867 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9868 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9869 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9870 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9871 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9872 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9873 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9874 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9875
9876
9877 ja = jlvcite
9878 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9879 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9880 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9881 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9882 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9883 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9884 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9885 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9886 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9887
9888
9889 ja = jnahso4
9890 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9891 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9892 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9893 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9894 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9895 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9896 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9897 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9898 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9899
9900
9901 ja = jna3hso4
9902 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
9903 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9904 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9905 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9906 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9907 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9908 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9909 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
9910 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
9911
9912 return
9913 end subroutine mtem_compute_log_gamz
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
9930
9931
9932
9933
9934
9935
9936
9937
9938
9939
9940
9941
9942 !***********************************************************************
9943 ! computes sulfate ratio
9944 !
9945 ! author: rahul a. zaveri
9946 ! update: dec 1999
9947 !-----------------------------------------------------------------------
9948 subroutine calculate_xt(ibin,jp,xt)
9949 ! implicit none
9950 ! include 'mosaic.h'
9951 ! subr arguments
9952 integer ibin, jp
9953 real xt
9954
9955
9956 if(aer(iso4_a,jp,ibin).gt.0.0)then
9957 xt = ( aer(inh4_a,jp,ibin) + &
9958 aer(ina_a,jp,ibin) + &
9959 2.*aer(ica_a,jp,ibin) )/ &
9960 aer(iso4_a,jp,ibin)
9961 else
9962 xt = -1.0
9963 endif
9964
9965
9966 return
9967 end subroutine calculate_xt
9968
9969
9970
9971
9972
9973 !***********************************************************************
9974 ! computes ions from electrolytes
9975 !
9976 ! author: rahul a. zaveri
9977 ! update: jan 2005
9978 !-----------------------------------------------------------------------
9979 subroutine electrolytes_to_ions(jp,ibin)
9980 ! implicit none
9981 ! include 'mosaic.h'
9982 ! subr arguments
9983 integer jp, ibin
9984 ! local variables
9985 real thesum
9986
9987
9988 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
9989 electrolyte(jna2so4,jp,ibin) + &
9990 2.*electrolyte(jna3hso4,jp,ibin)+ &
9991 electrolyte(jnahso4,jp,ibin) + &
9992 electrolyte(jnh4so4,jp,ibin) + &
9993 2.*electrolyte(jlvcite,jp,ibin) + &
9994 electrolyte(jnh4hso4,jp,ibin)+ &
9995 electrolyte(jh2so4,jp,ibin)
9996
9997 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
9998 2.*electrolyte(jcano3,jp,ibin) + &
9999 electrolyte(jnh4no3,jp,ibin) + &
10000 electrolyte(jhno3,jp,ibin)
10001
10002 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
10003 2.*electrolyte(jcacl2,jp,ibin) + &
10004 electrolyte(jnh4cl,jp,ibin) + &
10005 electrolyte(jhcl,jp,ibin)
10006
10007 aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
10008
10009 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
10010 electrolyte(jcano3,jp,ibin) + &
10011 electrolyte(jcacl2,jp,ibin) + &
10012 electrolyte(jcaco3,jp,ibin)
10013
10014 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
10015 electrolyte(jnacl,jp,ibin) + &
10016 2.*electrolyte(jna2so4,jp,ibin) + &
10017 3.*electrolyte(jna3hso4,jp,ibin)+ &
10018 electrolyte(jnahso4,jp,ibin)
10019
10020 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
10021 electrolyte(jnh4cl,jp,ibin) + &
10022 2.*electrolyte(jnh4so4,jp,ibin) + &
10023 3.*electrolyte(jlvcite,jp,ibin) + &
10024 electrolyte(jnh4hso4,jp,ibin)
10025
10026
10027 thesum = aer(ica_a,jp,ibin) + &
10028 aer(ina_a,jp,ibin) + &
10029 aer(inh4_a,jp,ibin)+ &
10030 aer(iso4_a,jp,ibin)+ &
10031 aer(ino3_a,jp,ibin)+ &
10032 aer(icl_a,jp,ibin) + &
10033 aer(ico3_a,jp,ibin)
10034
10035 if(thesum .eq. 0.)thesum = 1.0
10036
10037 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/thesum
10038 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/thesum
10039 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/thesum
10040 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/thesum
10041 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/thesum
10042 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/thesum
10043 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/thesum
10044
10045
10046 return
10047 end subroutine electrolytes_to_ions
10048
10049
10050
10051
10052
10053
10054
10055
10056
10057
10058 !***********************************************************************
10059 ! combinatorial method for computing electrolytes from ions
10060 !
10061 ! notes:
10062 ! - to be used for liquid-phase or total-phase only
10063 ! - transfers caso4 and caco3 from liquid to solid phase
10064 !
10065 ! author: rahul a. zaveri (based on code provided by a.s. wexler
10066 ! update: apr 2005
10067 !-----------------------------------------------------------------------
10068 subroutine ions_to_electrolytes(jp,ibin,xt)
10069 ! implicit none
10070 ! include 'mosaic.h'
10071 ! subr arguments
10072 integer ibin, jp
10073 real xt
10074 ! local variables
10075 integer iaer, je, jc, ja, icase
10076 real store(naer), thesum, sum_naza, sum_nczc, sum_na_nh4, &
10077 f_nh4, f_na, xh, xb, xl, xs, cat_net
10078 real nc(ncation), na(nanion)
10079
10080
10081
10082
10083 if(jp .ne. jliquid)then
10084 write(6,*)' jp must be jliquid'
10085 write(6,*)' in ions_to_electrolytes sub'
10086 write(6,*)' wrong jp = ', jp
10087 ! stop
10088 call peg_error_fatal( lunerr_aer, &
10089 'stopping in ions_to_electrolytes' )
10090 endif
10091
10092 ! remove negative concentrations, if any
10093 do iaer = 1, naer
10094 aer(iaer,jp,ibin) = max(0.0, aer(iaer,jp,ibin))
10095 enddo
10096
10097
10098 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
10099 store(ica_a) = aer(ica_a, jp,ibin)
10100 store(iso4_a) = aer(iso4_a,jp,ibin)
10101
10102 call form_caso4(store,jp,ibin)
10103
10104 if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
10105 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) - &
10106 electrolyte(jcaso4,jliquid,ibin)
10107
10108 aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)- &
10109 electrolyte(jcaso4,jliquid,ibin)
10110
10111 aer(ica_a,jsolid,ibin) = aer(ica_a,jsolid,ibin) + &
10112 electrolyte(jcaso4,jliquid,ibin)
10113
10114 aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) + &
10115 electrolyte(jcaso4,jliquid,ibin)
10116
10117 electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
10118 +electrolyte(jcaso4,jliquid,ibin)
10119 electrolyte(jcaso4,jliquid,ibin)= 0.0
10120 endif
10121
10122
10123 ! calculate sulfate ratio
10124 call calculate_xt(ibin,jp,xt)
10125
10126 if(xt .ge. 2.0 .or. xt.lt.0.)then
10127 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
10128 else
10129 icase = 2 ! acidic (acidity is caused by excess so4)
10130 endif
10131
10132
10133 ! initialize to zero
10134 do je = 1, nelectrolyte
10135 electrolyte(je,jp,ibin) = 0.0
10136 enddo
10137 !
10138 !---------------------------------------------------------
10139 ! initialize moles of ions depending on the sulfate domain
10140
10141 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
10142
10143 na(ja_hso4)= 0.0
10144 na(ja_so4) = aer(iso4_a,jp,ibin)
10145 na(ja_no3) = aer(ino3_a,jp,ibin)
10146 na(ja_cl) = aer(icl_a, jp,ibin)
10147
10148 nc(jc_ca) = aer(ica_a, jp,ibin)
10149 nc(jc_na) = aer(ina_a, jp,ibin)
10150 nc(jc_nh4) = aer(inh4_a,jp,ibin)
10151
10152 cat_net = real( dble(2.*na(ja_so4)+na(ja_no3)+na(ja_cl)) - &
10153 dble(2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na)) )
10154
10155 if(cat_net .lt. 0.0)then
10156
10157 ! if(aer(inh4_a,jp,ibin) .gt. abs(cat_net))then ! degas excess nh3
10158 ! aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) + cat_net
10159 ! aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin)+cat_net
10160 ! gas(inh3_g) = gas(inh3_g) - cat_net
10161 ! endif
10162
10163 nc(jc_h) = 0.0
10164
10165 else ! cat_net must be 0.0 or positive
10166
10167 nc(jc_h) = cat_net
10168
10169 endif
10170
10171
10172 ! now compute equivalent fractions
10173 sum_naza = 0.0
10174 do ja = 1, nanion
10175 sum_naza = sum_naza + na(ja)*za(ja)
10176 enddo
10177
10178 sum_nczc = 0.0
10179 do jc = 1, ncation
10180 sum_nczc = sum_nczc + nc(jc)*zc(jc)
10181 enddo
10182
10183 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
10184 write(6,*)'ionic concentrations are zero'
10185 write(6,*)'sum_naza = ', sum_naza
10186 write(6,*)'sum_nczc = ', sum_nczc
10187 return
10188 endif
10189
10190 do ja = 1, nanion
10191 xeq_a(ja) = na(ja)*za(ja)/sum_naza
10192 enddo
10193
10194 do jc = 1, ncation
10195 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
10196 enddo
10197
10198 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
10199 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
10200 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
10201 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
10202
10203 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
10204 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
10205 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
10206 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
10207
10208
10209 ! now compute electrolyte moles
10210 electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
10211 xeq_a(ja_so4)*nc_mc(jc_na))/ &
10212 mw_electrolyte(jna2so4)
10213
10214 electrolyte(jnahso4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_hso4) + &
10215 xeq_a(ja_hso4)*nc_mc(jc_na))/ &
10216 mw_electrolyte(jnahso4)
10217
10218 electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
10219 xeq_a(ja_no3)*nc_mc(jc_na))/ &
10220 mw_electrolyte(jnano3)
10221
10222 electrolyte(jnacl, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) + &
10223 xeq_a(ja_cl) *nc_mc(jc_na))/ &
10224 mw_electrolyte(jnacl)
10225
10226 electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
10227 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
10228 mw_electrolyte(jnh4so4)
10229
10230 electrolyte(jnh4hso4,jp,ibin)= (xeq_c(jc_nh4)*na_ma(ja_hso4) + &
10231 xeq_a(ja_hso4)*nc_mc(jc_nh4))/ &
10232 mw_electrolyte(jnh4hso4)
10233
10234 electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
10235 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
10236 mw_electrolyte(jnh4no3)
10237
10238 electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
10239 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
10240 mw_electrolyte(jnh4cl)
10241
10242 electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
10243 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
10244 mw_electrolyte(jcano3)
10245
10246 electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
10247 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
10248 mw_electrolyte(jcacl2)
10249
10250 electrolyte(jh2so4, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_hso4) + &
10251 xeq_a(ja_hso4)*nc_mc(jc_h))/ &
10252 mw_electrolyte(jh2so4)
10253
10254 electrolyte(jhno3, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_no3) + &
10255 xeq_a(ja_no3)*nc_mc(jc_h))/ &
10256 mw_electrolyte(jhno3)
10257
10258 electrolyte(jhcl, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) + &
10259 xeq_a(ja_cl)*nc_mc(jc_h))/ &
10260 mw_electrolyte(jhcl)
10261
10262 !--------------------------------------------------------------------
10263
10264 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
10265
10266 sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
10267 if(sum_na_nh4 .gt. 0.0)then
10268 f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
10269 f_na = aer(ina_a,jp,ibin)/sum_na_nh4
10270 else
10271 f_nh4 = 0.0
10272 f_na = 0.0
10273 endif
10274
10275 if(xt .le. 1.0)then ! h2so4 + bisulfate
10276 xh = (1.0 - xt)
10277 xb = xt
10278 electrolyte(jh2so4,jp,ibin) = xh*aer(iso4_a,jp,ibin)
10279 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10280 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
10281 elseif(xt .le. 1.5)then ! bisulfate + letovicite
10282 xb = 3.0 - 2.0*xt
10283 xl = xt - 1.0
10284 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10285 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
10286 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
10287 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10288 else ! letovicite + sulfate
10289 xl = 2.0 - xt
10290 xs = 2.0*xt - 3.0
10291 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
10292 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10293 electrolyte(jnh4so4,jp,ibin) = xs*f_nh4*aer(iso4_a,jp,ibin)
10294 electrolyte(jna2so4,jp,ibin) = xs*f_na *aer(iso4_a,jp,ibin)
10295 endif
10296
10297 electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
10298 electrolyte(jhcl,jp,ibin) = aer(icl_a,jp,ibin)
10299
10300 endif
10301 !---------------------------------------------------------
10302 !
10303 ! calculate % composition
10304 thesum = 0.0
10305 do je = 1, nelectrolyte
10306 thesum = thesum + electrolyte(je,jp,ibin)
10307 enddo
10308
10309 electrolyte_sum(jp,ibin) = thesum
10310
10311 if(thesum .eq. 0.)thesum = 1.0
10312 do je = 1, nelectrolyte
10313 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/thesum
10314 enddo
10315
10316
10317
10318 thesum = aer(ica_a,jp,ibin) + &
10319 aer(ina_a,jp,ibin) + &
10320 aer(inh4_a,jp,ibin)+ &
10321 aer(iso4_a,jp,ibin)+ &
10322 aer(ino3_a,jp,ibin)+ &
10323 aer(icl_a,jp,ibin) + &
10324 aer(ico3_a,jp,ibin)
10325
10326 if(thesum .eq. 0.)thesum = 1.0
10327
10328 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/thesum
10329 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/thesum
10330 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/thesum
10331 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/thesum
10332 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/thesum
10333 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/thesum
10334 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/thesum
10335
10336
10337
10338 return
10339 end subroutine ions_to_electrolytes
10340
10341
10342
10343
10344
10345
10346
10347
10348
10349
10350
10351
10352
10353
10354
10355
10356
10357
10358
10359
10360
10361
10362
10363
10364
10365
10366
10367 !***********************************************************************
10368 ! conforms aerosol generic species to a valid electrolyte composition
10369 !
10370 ! author: rahul a. zaveri
10371 ! update: june 2000
10372 !-----------------------------------------------------------------------
10373 subroutine conform_electrolytes(jp,ibin,xt)
10374 ! implicit none
10375 ! include 'mosaic.h'
10376 ! subr arguments
10377 integer ibin, jp
10378 real xt
10379 ! local variables
10380 integer i, ixt_case, je
10381 real thesum, xna_prime, xnh4_prime, xt_prime
10382 real store(naer)
10383
10384 ! remove negative concentrations, if any
10385 do i=1,naer
10386 aer(i,jp,ibin) = max(0.0, aer(i,jp,ibin))
10387 enddo
10388
10389
10390 call calculate_xt(ibin,jp,xt)
10391
10392 if(xt .ge. 2.0 .or. xt.lt.0.)then
10393 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
10394 else
10395 ixt_case = 2 ! acidic (acidity is caused by excess so4)
10396 endif
10397
10398 ! initialize
10399 !
10400 ! put total aer(*) into store(*)
10401 store(iso4_a) = aer(iso4_a,jp,ibin)
10402 store(ino3_a) = aer(ino3_a,jp,ibin)
10403 store(icl_a) = aer(icl_a, jp,ibin)
10404 store(ico3_a) = aer(ico3_a,jp,ibin)
10405 store(inh4_a) = aer(inh4_a,jp,ibin)
10406 store(ina_a) = aer(ina_a, jp,ibin)
10407 store(ica_a) = aer(ica_a, jp,ibin)
10408 !
10409 do je=1,nelectrolyte
10410 electrolyte(je,jp,ibin) = 0.0
10411 enddo
10412 !
10413 !---------------------------------------------------------
10414 !
10415 if(ixt_case.eq.1)then
10416
10417 ! xt >= 2 : sulfate deficient
10418
10419 call form_caso4(store,jp,ibin)
10420 call form_na2so4(store,jp,ibin)
10421 call form_cano3(store,jp,ibin)
10422 call form_nano3(store,jp,ibin)
10423 call conform_nacl(store,jp,ibin)
10424 call form_cacl2(store,jp,ibin)
10425 call form_caco3(store,jp,ibin)
10426 call form_nh4so4(store,jp,ibin)
10427 call form_nh4no3(store,jp,ibin)
10428 call form_nh4cl(store,jp,ibin)
10429 call degas_hno3(store,jp,ibin)
10430 call degas_hcl(store,jp,ibin)
10431 call degas_nh3(store,jp,ibin)
10432
10433 elseif(ixt_case.eq.2)then
10434
10435 ! xt < 2 : sulfate enough or sulfate excess
10436
10437 call form_caso4(store,jp,ibin)
10438
10439 xt_prime =(store(ina_a)+store(inh4_a))/ &
10440 store(iso4_a)
10441 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10442
10443 if(xt_prime.ge.xna_prime)then
10444 call form_na2so4(store,jp,ibin)
10445 xnh4_prime = 0.0
10446 if(store(iso4_a).gt.1.e-15)then
10447 xnh4_prime = store(inh4_a)/store(iso4_a)
10448 endif
10449
10450 if(xnh4_prime .ge. 1.5)then
10451 call form_nh4so4_lvcite(store,jp,ibin)
10452 else
10453 call form_lvcite_nh4hso4(store,jp,ibin)
10454 endif
10455
10456 elseif(xt_prime.ge.1.)then
10457 call form_nh4hso4(store,jp,ibin)
10458 call form_na2so4_nahso4(store,jp,ibin)
10459 elseif(xt_prime.lt.1.)then
10460 call form_nahso4(store,jp,ibin)
10461 call form_nh4hso4(store,jp,ibin)
10462 call form_h2so4(store,jp,ibin)
10463 endif
10464
10465 call degas_hno3(store,jp,ibin)
10466 call degas_hcl(store,jp,ibin)
10467 call degas_nh3(store,jp,ibin)
10468
10469 endif ! case 1, 2
10470 !---------------------------------------------------------
10471 !
10472 ! calculate % composition
10473 thesum = 0.0
10474 do je = 1, nelectrolyte
10475 electrolyte(je,jp,ibin) = max(0.,electrolyte(je,jp,ibin)) ! remove -ve
10476 thesum = thesum + electrolyte(je,jp,ibin)
10477 enddo
10478
10479 electrolyte_sum(jp,ibin) = thesum
10480
10481 if(thesum .eq. 0.)thesum = 1.0
10482 do je = 1, nelectrolyte
10483 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/thesum
10484 enddo
10485
10486
10487 thesum = aer(ica_a,jp,ibin) + &
10488 aer(ina_a,jp,ibin) + &
10489 aer(inh4_a,jp,ibin)+ &
10490 aer(iso4_a,jp,ibin)+ &
10491 aer(ino3_a,jp,ibin)+ &
10492 aer(icl_a,jp,ibin) + &
10493 aer(ico3_a,jp,ibin)
10494
10495 if(thesum .eq. 0.)thesum = 1.0
10496
10497 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/thesum
10498 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/thesum
10499 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/thesum
10500 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/thesum
10501 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/thesum
10502 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/thesum
10503 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/thesum
10504
10505 return
10506 end subroutine conform_electrolytes
10507
10508
10509
10510
10511
10512
10513
10514
10515
10516
10517
10518 !***********************************************************************
10519 ! forms electrolytes from ions
10520 !
10521 ! author: rahul a. zaveri
10522 ! update: june 2000
10523 !-----------------------------------------------------------------------
10524 subroutine form_electrolytes(jp,ibin,xt)
10525 ! implicit none
10526 ! include 'mosaic.h'
10527 ! subr arguments
10528 integer ibin, jp
10529 real xt
10530 ! local variables
10531 integer i, ixt_case, j, je
10532 real thesum, xna_prime, xnh4_prime, xt_prime
10533 real store(naer)
10534
10535 ! remove negative concentrations, if any
10536 do i=1,naer
10537 aer(i,jp,ibin) = max(0.0, aer(i,jp,ibin))
10538 enddo
10539
10540
10541 call calculate_xt(ibin,jp,xt)
10542
10543 if(xt .ge. 2.0 .or. xt.lt.0.)then
10544 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
10545 else
10546 ixt_case = 2 ! acidic (acidity is caused by excess so4)
10547 endif
10548
10549 ! initialize
10550 !
10551 ! put total aer(*) into store(*)
10552 store(iso4_a) = aer(iso4_a,jp,ibin)
10553 store(ino3_a) = aer(ino3_a,jp,ibin)
10554 store(icl_a) = aer(icl_a, jp,ibin)
10555 store(ico3_a) = aer(ico3_a,jp,ibin)
10556 store(inh4_a) = aer(inh4_a,jp,ibin)
10557 store(ina_a) = aer(ina_a, jp,ibin)
10558 store(ica_a) = aer(ica_a, jp,ibin)
10559 !
10560 do j=1,nelectrolyte
10561 electrolyte(j,jp,ibin) = 0.0
10562 enddo
10563 !
10564 !---------------------------------------------------------
10565 !
10566 if(ixt_case.eq.1)then
10567
10568 ! xt >= 2 : sulfate deficient
10569 call form_caso4(store,jp,ibin)
10570 call form_na2so4(store,jp,ibin)
10571 call form_cano3(store,jp,ibin)
10572 call form_nano3(store,jp,ibin)
10573 call form_nacl(store,jp,ibin)
10574 call form_cacl2(store,jp,ibin)
10575 call form_caco3(store,jp,ibin)
10576 call form_nh4so4(store,jp,ibin)
10577 call form_nh4no3(store,jp,ibin)
10578 call form_nh4cl(store,jp,ibin)
10579
10580 if(jp .eq. jsolid)then
10581 call degas_hno3(store,jp,ibin)
10582 call degas_hcl(store,jp,ibin)
10583 call degas_nh3(store,jp,ibin)
10584 else
10585 call form_hno3(store,jp,ibin)
10586 call form_hcl(store,jp,ibin)
10587 call degas_nh3(store,jp,ibin)
10588 endif
10589
10590
10591
10592 elseif(ixt_case.eq.2)then
10593
10594 ! xt < 2 : sulfate enough or sulfate excess
10595
10596 call form_caso4(store,jp,ibin)
10597
10598 xt_prime =(store(ina_a)+store(inh4_a))/ &
10599 store(iso4_a)
10600 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10601
10602 if(xt_prime.ge.xna_prime)then
10603 call form_na2so4(store,jp,ibin)
10604 xnh4_prime = 0.0
10605 if(store(iso4_a).gt.1.e-15)then
10606 xnh4_prime = store(inh4_a)/store(iso4_a)
10607 endif
10608
10609 if(xnh4_prime .ge. 1.5)then
10610 call form_nh4so4_lvcite(store,jp,ibin)
10611 else
10612 call form_lvcite_nh4hso4(store,jp,ibin)
10613 endif
10614
10615 elseif(xt_prime.ge.1.)then
10616 call form_nh4hso4(store,jp,ibin)
10617 call form_na2so4_nahso4(store,jp,ibin)
10618 elseif(xt_prime.lt.1.)then
10619 call form_nahso4(store,jp,ibin)
10620 call form_nh4hso4(store,jp,ibin)
10621 call form_h2so4(store,jp,ibin)
10622 endif
10623
10624 if(jp .eq. jsolid)then
10625 call degas_hno3(store,jp,ibin)
10626 call degas_hcl(store,jp,ibin)
10627 call degas_nh3(store,jp,ibin)
10628 else
10629 call form_hno3(store,jp,ibin)
10630 call form_hcl(store,jp,ibin)
10631 call degas_nh3(store,jp,ibin)
10632 endif
10633
10634 endif ! case 1, 2
10635 !---------------------------------------------------------
10636 !
10637 ! calculate % composition
10638 thesum = 0.0
10639 do je = 1, nelectrolyte
10640 electrolyte(je,jp,ibin) = max(0.,electrolyte(je,jp,ibin)) ! remove -ve
10641 thesum = thesum + electrolyte(je,jp,ibin)
10642 enddo
10643
10644 electrolyte_sum(jp,ibin) = thesum
10645
10646 if(thesum .eq. 0.)thesum = 1.0
10647 do je = 1, nelectrolyte
10648 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/thesum
10649 enddo
10650
10651
10652 thesum = aer(ica_a,jp,ibin) + &
10653 aer(ina_a,jp,ibin) + &
10654 aer(inh4_a,jp,ibin)+ &
10655 aer(iso4_a,jp,ibin)+ &
10656 aer(ino3_a,jp,ibin)+ &
10657 aer(icl_a,jp,ibin) + &
10658 aer(ico3_a,jp,ibin)
10659
10660 if(thesum .eq. 0.)thesum = 1.0
10661
10662 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/thesum
10663 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/thesum
10664 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/thesum
10665 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/thesum
10666 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/thesum
10667 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/thesum
10668 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/thesum
10669
10670
10671 return
10672 end subroutine form_electrolytes
10673
10674
10675
10676
10677
10678
10679
10680
10681
10682
10683
10684
10685
10686 !***********************************************************************
10687 ! part of asteem: does arbitrary electrolyte formation for non-volatiles and
10688 ! uses wexler's algorithm for nh4no3, nh4cl, hno3, and hcl
10689 !
10690 ! notes:
10691 ! - to be used for liquid-phase or total-phase only
10692 ! - transfers caso4 and caco3 from liquid to solid phase
10693 ! - may transfer excess nh3 in the liquid phase to gas, but does not update aer(jtotal)
10694 !
10695 ! author: rahul a. zaveri
10696 ! update: oct 2004
10697 !-----------------------------------------------------------------------
10698 subroutine asteem_formelectrolytes_hybrid(jp,ibin,xt)
10699 ! implicit none
10700 ! include 'mosaic.h'
10701 ! subr arguments
10702 integer ibin, jp
10703 real xt
10704 ! local variables
10705 integer iaer, icase, je, ja, jc
10706 real thesum, xna_prime, xnh4_prime, xt_prime
10707 real store(naer), nc(ncation), na(nanion)
10708 real sum_naza, sum_nczc, sum_na_nh4, f_nh4, f_na, &
10709 xh, xb, xs, xl, cat_net
10710
10711
10712
10713
10714
10715 if(jp .ne. jliquid)then
10716 write(6,*)' jp must be jliquid'
10717 write(6,*)' in ions_to_electrolytes sub'
10718 write(6,*)' wrong jp = ', jp
10719 ! stop
10720 call peg_error_fatal( lunerr_aer, &
10721 'stopping asteem_formelectrolytes_hybrid' )
10722 endif
10723
10724 ! remove negative concentrations, if any
10725 do iaer = 1, naer
10726 aer(iaer,jp,ibin) = max(0.0, aer(iaer,jp,ibin))
10727 enddo
10728
10729
10730 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
10731 store(ica_a) = aer(ica_a, jp,ibin)
10732 store(iso4_a) = aer(iso4_a,jp,ibin)
10733
10734 call form_caso4(store,jp,ibin)
10735
10736 if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
10737 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) - &
10738 electrolyte(jcaso4,jliquid,ibin)
10739
10740 aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)- &
10741 electrolyte(jcaso4,jliquid,ibin)
10742
10743 aer(ica_a,jsolid,ibin) = aer(ica_a,jsolid,ibin) + &
10744 electrolyte(jcaso4,jliquid,ibin)
10745
10746 aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) + &
10747 electrolyte(jcaso4,jliquid,ibin)
10748
10749 electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
10750 +electrolyte(jcaso4,jliquid,ibin)
10751 electrolyte(jcaso4,jliquid,ibin)= 0.0
10752 endif
10753
10754 ! calculate sulfate ratio
10755 call calculate_xt(ibin,jp,xt)
10756
10757 if(xt .ge. 2.0 .or. xt.lt.0.)then
10758 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
10759 else
10760 icase = 2 ! acidic (acidity is caused by excess so4)
10761 endif
10762
10763
10764 ! initialize to zero
10765 do je = 1, nelectrolyte
10766 electrolyte(je,jp,ibin) = 0.0
10767 enddo
10768
10769
10770 ! initialize store
10771 !
10772 ! put total aer(*) into store(*)
10773 store(iso4_a) = aer(iso4_a,jp,ibin)
10774 store(ino3_a) = aer(ino3_a,jp,ibin)
10775 store(icl_a) = aer(icl_a, jp,ibin)
10776 store(ico3_a) = aer(ico3_a,jp,ibin)
10777 store(inh4_a) = aer(inh4_a,jp,ibin)
10778 store(ina_a) = aer(ina_a, jp,ibin)
10779 store(ica_a) = aer(ica_a, jp,ibin)
10780
10781 !
10782 !---------------------------------------------------------
10783 ! sulfate-poor domain
10784 if(icase.eq.1)then
10785
10786 call form_na2so4(store,jp,ibin)
10787 call form_nh4so4(store,jp,ibin)
10788 ! call form_cano3(store,jp,ibin)
10789 ! call form_nano3(store,jp,ibin)
10790 ! call form_cacl2(store,jp,ibin)
10791 ! call form_nacl(store,jp,ibin)
10792
10793 ! now use wexler's algorithm
10794 na(ja_hso4)= 0.0 ! = 0 in sulfate-poor domain
10795 na(ja_so4) = 0.0 ! by now store(iso4_a) must be 0
10796 na(ja_no3) = store(ino3_a)
10797 na(ja_cl) = store(icl_a)
10798
10799 nc(jc_ca) = store(ica_a) ! by now store(ica_a) must be 0
10800 nc(jc_na) = store(ina_a) ! by now store(ica_a) must be 0
10801 nc(jc_nh4) = store(inh4_a)
10802
10803 cat_net = real( dble(na(ja_no3)+na(ja_cl)) - &
10804 dble(nc(jc_nh4)+nc(jc_na)+2.*nc(jc_ca)) )
10805
10806 if(cat_net .lt. 0.0)then
10807
10808 ! if(aer(inh4_a,jp,ibin) .gt. abs(cat_net))then ! degas excess nh3
10809 ! aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) + cat_net
10810 ! aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin)+cat_net
10811 ! gas(inh3_g) = gas(inh3_g) - cat_net
10812 ! endif
10813
10814 nc(jc_h) = 0.0
10815
10816 else ! cat_net must be 0.0 or positive
10817
10818 nc(jc_h) = cat_net
10819
10820 endif
10821
10822
10823 ! now compute equivalent fractions
10824 sum_naza = 0.0
10825 do ja = 1, nanion
10826 sum_naza = sum_naza + na(ja)*za(ja)
10827 enddo
10828
10829 sum_nczc = 0.0
10830 do jc = 1, ncation
10831 sum_nczc = sum_nczc + nc(jc)*zc(jc)
10832 enddo
10833
10834 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
10835 ! write(6,*)'ionic concentrations are zero'
10836 ! write(6,*)'sum_naza = ', sum_naza
10837 ! write(6,*)'sum_nczc = ', sum_nczc
10838 return
10839 endif
10840
10841 do ja = 1, nanion
10842 xeq_a(ja) = na(ja)*za(ja)/sum_naza
10843 enddo
10844
10845 do jc = 1, ncation
10846 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
10847 enddo
10848
10849 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
10850 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
10851 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
10852 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
10853
10854 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
10855 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
10856 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
10857 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
10858
10859
10860 ! now compute electrolyte moles
10861
10862 electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
10863 xeq_a(ja_no3)*nc_mc(jc_na))/ &
10864 mw_electrolyte(jnano3)
10865
10866 electrolyte(jnacl, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) + &
10867 xeq_a(ja_cl) *nc_mc(jc_na))/ &
10868 mw_electrolyte(jnacl)
10869
10870 electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
10871 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
10872 mw_electrolyte(jnh4no3)
10873
10874 electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
10875 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
10876 mw_electrolyte(jnh4cl)
10877
10878 electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
10879 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
10880 mw_electrolyte(jcano3)
10881
10882 electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
10883 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
10884 mw_electrolyte(jcacl2)
10885
10886 electrolyte(jhno3, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_no3) + &
10887 xeq_a(ja_no3)*nc_mc(jc_h))/ &
10888 mw_electrolyte(jhno3)
10889
10890 electrolyte(jhcl, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) + &
10891 xeq_a(ja_cl)*nc_mc(jc_h))/ &
10892 mw_electrolyte(jhcl)
10893
10894 !----------------------------------------------------------------
10895 ! sulfate-rich domain
10896 elseif(icase.eq.2)then
10897
10898 sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
10899 if(sum_na_nh4 .gt. 0.0)then
10900 f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
10901 f_na = aer(ina_a,jp,ibin)/sum_na_nh4
10902 else
10903 f_nh4 = 0.0
10904 f_na = 0.0
10905 endif
10906
10907 if(xt .le. 1.0)then ! h2so4 + bisulfate
10908 xh = (1.0 - xt)
10909 xb = xt
10910 electrolyte(jh2so4,jp,ibin) = xh*aer(iso4_a,jp,ibin)
10911 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10912 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
10913 elseif(xt .le. 1.5)then ! bisulfate + letovicite
10914 xb = 3.0 - 2.0*xt
10915 xl = xt - 1.0
10916 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10917 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
10918 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
10919 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10920 else ! letovicite + sulfate
10921 xl = 2.0 - xt
10922 xs = 2.0*xt - 3.0
10923 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
10924 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10925 electrolyte(jnh4so4,jp,ibin) = xs*f_nh4*aer(iso4_a,jp,ibin)
10926 electrolyte(jna2so4,jp,ibin) = xs*f_na *aer(iso4_a,jp,ibin)
10927 endif
10928
10929 electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
10930 electrolyte(jhcl,jp,ibin) = aer(icl_a,jp,ibin)
10931
10932 endif ! case 1, 2
10933 !---------------------------------------------------------
10934 !
10935 ! calculate % composition
10936 thesum = 0.0
10937 do je = 1, nelectrolyte
10938 electrolyte(je,jp,ibin) = max(0.,electrolyte(je,jp,ibin)) ! remove -ve
10939 thesum = thesum + electrolyte(je,jp,ibin)
10940 enddo
10941
10942 electrolyte_sum(jp,ibin) = thesum
10943
10944 if(thesum .eq. 0.)thesum = 1.0
10945 do je = 1, nelectrolyte
10946 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/thesum
10947 enddo
10948
10949
10950
10951 thesum = aer(ica_a,jp,ibin) + &
10952 aer(ina_a,jp,ibin) + &
10953 aer(inh4_a,jp,ibin)+ &
10954 aer(iso4_a,jp,ibin)+ &
10955 aer(ino3_a,jp,ibin)+ &
10956 aer(icl_a,jp,ibin) + &
10957 aer(ico3_a,jp,ibin)
10958
10959 if(thesum .eq. 0.)thesum = 1.0
10960
10961 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/thesum
10962 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/thesum
10963 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/thesum
10964 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/thesum
10965 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/thesum
10966 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/thesum
10967 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/thesum
10968
10969
10970 return
10971 end subroutine asteem_formelectrolytes_hybrid
10972
10973
10974
10975
10976
10977
10978
10979
10980
10981
10982
10983
10984
10985
10986
10987
10988
10989
10990
10991
10992
10993
10994
10995
10996
10997
10998
10999
11000
11001
11002
11003 !***********************************************************************
11004 ! electrolyte formation subroutines
11005 !
11006 ! author: rahul a. zaveri
11007 ! update: june 2000
11008 !-----------------------------------------------------------------------
11009 subroutine form_caso4(store,jp,ibin)
11010 ! implicit none
11011 ! include 'mosaic.h'
11012 ! subr arguments
11013 integer jp, ibin
11014 real store(naer)
11015
11016 electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
11017 store(ica_a) = real( dble(store(ica_a)) - &
11018 dble(electrolyte(jcaso4,jp,ibin)) )
11019 store(iso4_a) = real( dble(store(iso4_a)) - &
11020 dble(electrolyte(jcaso4,jp,ibin)) )
11021 store(ica_a) = max(0., store(ica_a))
11022 store(iso4_a) = max(0., store(iso4_a))
11023
11024 return
11025 end subroutine form_caso4
11026
11027
11028 subroutine form_cano3(store,jp,ibin) ! ca(no3)2
11029 ! implicit none
11030 ! include 'mosaic.h'
11031 ! subr arguments
11032 integer jp, ibin
11033 real store(naer)
11034
11035 electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
11036
11037 store(ica_a) = real( dble(store(ica_a)) - &
11038 dble(electrolyte(jcano3,jp,ibin)) )
11039 store(ino3_a) = real( dble(store(ino3_a)) - &
11040 dble(2.*electrolyte(jcano3,jp,ibin)) )
11041 store(ica_a) = max(0., store(ica_a))
11042 store(ino3_a) = max(0., store(ino3_a))
11043
11044 return
11045 end subroutine form_cano3
11046
11047
11048 subroutine form_cacl2(store,jp,ibin)
11049 ! implicit none
11050 ! include 'mosaic.h'
11051 ! subr arguments
11052 integer jp, ibin
11053 real store(naer)
11054
11055 electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
11056
11057 store(ica_a) = real( dble(store(ica_a)) - &
11058 dble(electrolyte(jcacl2,jp,ibin)) )
11059 store(icl_a) = real( dble(store(icl_a)) - &
11060 dble(2.*electrolyte(jcacl2,jp,ibin)) )
11061 store(ica_a) = max(0., store(ica_a))
11062 store(icl_a) = max(0., store(icl_a))
11063
11064 return
11065 end subroutine form_cacl2
11066
11067
11068 subroutine form_caco3(store,jp,ibin)
11069 ! implicit none
11070 ! include 'mosaic.h'
11071 ! subr arguments
11072 integer jp, ibin
11073 real store(naer)
11074
11075 if(jp.eq.jtotal .or. jp.eq.jsolid)then
11076 electrolyte(jcaco3,jp,ibin) = store(ica_a)
11077
11078 aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin) ! force co3 = caco3
11079
11080 store(ica_a) = 0.0
11081 store(ico3_a)= 0.0
11082 endif
11083
11084 return
11085 end subroutine form_caco3
11086
11087
11088 subroutine form_na2so4(store,jp,ibin)
11089 ! implicit none
11090 ! include 'mosaic.h'
11091 ! subr arguments
11092 integer jp, ibin
11093 real store(naer)
11094
11095 electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a), &
11096 store(iso4_a))
11097 store(ina_a) =real( dble(store(ina_a)) - &
11098 dble(2.*electrolyte(jna2so4,jp,ibin)) )
11099 store(iso4_a)=real( dble(store(iso4_a)) - &
11100 dble(electrolyte(jna2so4,jp,ibin)) )
11101 store(ina_a) =max(0., store(ina_a))
11102 store(iso4_a)=max(0., store(iso4_a))
11103
11104 return
11105 end subroutine form_na2so4
11106
11107
11108
11109 subroutine form_nahso4(store,jp,ibin)
11110 ! implicit none
11111 ! include 'mosaic.h'
11112 ! subr arguments
11113 integer jp, ibin
11114 real store(naer)
11115
11116 electrolyte(jnahso4,jp,ibin) = min(store(ina_a), &
11117 store(iso4_a))
11118 store(ina_a) = real( dble(store(ina_a)) - &
11119 dble(electrolyte(jnahso4,jp,ibin)) )
11120 store(iso4_a) = real( dble(store(iso4_a)) - &
11121 dble(electrolyte(jnahso4,jp,ibin)) )
11122 store(ina_a) = max(0., store(ina_a))
11123 store(iso4_a) = max(0., store(iso4_a))
11124
11125 return
11126 end subroutine form_nahso4
11127
11128
11129
11130 subroutine form_nano3(store,jp,ibin)
11131 ! implicit none
11132 ! include 'mosaic.h'
11133 ! subr arguments
11134 integer jp, ibin
11135 real store(naer)
11136
11137 electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
11138 store(ina_a) = real( dble(store(ina_a)) - &
11139 dble(electrolyte(jnano3,jp,ibin)) )
11140 store(ino3_a) = real( dble(store(ino3_a)) - &
11141 dble(electrolyte(jnano3,jp,ibin)) )
11142 store(ina_a) = max(0., store(ina_a))
11143 store(ino3_a) = max(0., store(ino3_a))
11144
11145 return
11146 end subroutine form_nano3
11147
11148
11149
11150 subroutine form_nacl(store,jp,ibin)
11151 ! implicit none
11152 ! include 'mosaic.h'
11153 ! subr arguments
11154 integer jp, ibin
11155 real store(naer)
11156
11157 electrolyte(jnacl,jp,ibin) = min(store(ina_a),store(icl_a))
11158
11159 store(ina_a) = 0.0
11160 store(icl_a) = real( dble(store(icl_a)) - &
11161 dble(electrolyte(jnacl,jp,ibin)) )
11162 store(icl_a) = max(0., store(icl_a))
11163
11164 return
11165 end subroutine form_nacl
11166
11167
11168
11169 subroutine conform_nacl(store,jp,ibin) ! may artificially produce cl
11170 ! implicit none
11171 ! include 'mosaic.h'
11172 ! subr arguments
11173 integer jp, ibin
11174 real store(naer)
11175
11176 electrolyte(jnacl,jp,ibin) = store(ina_a)
11177
11178 store(ina_a) = 0.0
11179 store(icl_a) = real( dble(store(icl_a)) - &
11180 dble(electrolyte(jnacl,jp,ibin)) )
11181
11182 if(store(icl_a) .lt. 0.)then ! cl deficit in aerosol. take some from gas
11183 aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a) ! update aer(icl_a)
11184
11185 ! also update for jtotal
11186 if(jp .ne. jtotal)then
11187 aer(icl_a,jtotal,ibin)= aer(icl_a,jtotal,ibin)- store(icl_a)
11188 endif
11189 gas(ihcl_g) = gas(ihcl_g) + store(icl_a) ! update gas(ihcl_g)
11190 gas(ihcl_g) = max(0., gas(ihcl_g)) ! restrict gas(ihcl_g) to >= 0.
11191 store(icl_a) = 0. ! force store(icl_a) to 0.
11192 endif
11193
11194 store(icl_a) = max(0., store(icl_a))
11195
11196 return
11197 end subroutine conform_nacl
11198
11199
11200
11201 subroutine form_nh4so4(store,jp,ibin) ! (nh4)2so4
11202 ! implicit none
11203 ! include 'mosaic.h'
11204 ! subr arguments
11205 integer jp, ibin
11206 real store(naer)
11207
11208 electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a), &
11209 store(iso4_a))
11210 store(inh4_a)= real( dble(store(inh4_a)) - &
11211 dble(2.*electrolyte(jnh4so4,jp,ibin)) )
11212 store(iso4_a)= real( dble(store(iso4_a)) - &
11213 dble(electrolyte(jnh4so4,jp,ibin)) )
11214 store(inh4_a) = max(0., store(inh4_a))
11215 store(iso4_a) = max(0., store(iso4_a))
11216
11217 return
11218 end subroutine form_nh4so4
11219
11220
11221
11222 subroutine form_nh4hso4(store,jp,ibin) ! nh4hso4
11223 ! implicit none
11224 ! include 'mosaic.h'
11225 ! subr arguments
11226 integer jp, ibin
11227 real store(naer)
11228
11229 electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a), &
11230 store(iso4_a))
11231 store(inh4_a)= real( dble(store(inh4_a)) - &
11232 dble(electrolyte(jnh4hso4,jp,ibin)) )
11233 store(iso4_a)= real( dble(store(iso4_a)) - &
11234 dble(electrolyte(jnh4hso4,jp,ibin)) )
11235 store(inh4_a) = max(0., store(inh4_a))
11236 store(iso4_a) = max(0., store(iso4_a))
11237
11238 return
11239 end subroutine form_nh4hso4
11240
11241
11242
11243 subroutine form_nh4cl(store,jp,ibin)
11244 ! implicit none
11245 ! include 'mosaic.h'
11246 ! subr arguments
11247 integer jp, ibin
11248 real store(naer)
11249
11250 electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a), &
11251 store(icl_a))
11252 store(inh4_a) = real( dble(store(inh4_a)) - &
11253 dble(electrolyte(jnh4cl,jp,ibin)) )
11254 store(icl_a) = real( dble(store(icl_a)) - &
11255 dble(electrolyte(jnh4cl,jp,ibin)) )
11256 store(inh4_a) = max(0., store(inh4_a))
11257 store(icl_a) = max(0., store(icl_a))
11258
11259 return
11260 end subroutine form_nh4cl
11261
11262
11263
11264 subroutine form_nh4no3(store,jp,ibin)
11265 ! implicit none
11266 ! include 'mosaic.h'
11267 ! subr arguments
11268 integer jp, ibin
11269 real store(naer)
11270
11271 electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a), &
11272 store(ino3_a))
11273 store(inh4_a) = real( dble(store(inh4_a)) - &
11274 dble(electrolyte(jnh4no3,jp,ibin)) )
11275 store(ino3_a) = real( dble(store(ino3_a)) - &
11276 dble(electrolyte(jnh4no3,jp,ibin)) )
11277 store(inh4_a) = max(0., store(inh4_a))
11278 store(ino3_a) = max(0., store(ino3_a))
11279
11280 return
11281 end subroutine form_nh4no3
11282
11283
11284
11285 subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
11286 ! implicit none
11287 ! include 'mosaic.h'
11288 ! subr arguments
11289 integer jp, ibin
11290 real store(naer)
11291
11292 electrolyte(jnh4so4,jp,ibin)= real( dble(2.*store(inh4_a)) - &
11293 dble(3.*store(iso4_a)) )
11294 electrolyte(jlvcite,jp,ibin)= real( dble(2.*store(iso4_a)) - &
11295 dble(store(inh4_a)) )
11296 electrolyte(jnh4so4,jp,ibin)= max(0., &
11297 electrolyte(jnh4so4,jp,ibin))
11298 electrolyte(jlvcite,jp,ibin)= max(0., &
11299 electrolyte(jlvcite,jp,ibin))
11300 store(inh4_a) = 0.
11301 store(iso4_a) = 0.
11302
11303 return
11304 end subroutine form_nh4so4_lvcite
11305
11306
11307
11308 subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
11309 ! implicit none
11310 ! include 'mosaic.h'
11311 ! subr arguments
11312 integer jp, ibin
11313 real store(naer)
11314
11315 electrolyte(jlvcite,jp,ibin) = real( dble(store(inh4_a)) - &
11316 dble(store(iso4_a)) )
11317 electrolyte(jnh4hso4,jp,ibin)= real( dble(3.*store(iso4_a)) - &
11318 dble(2.*store(inh4_a)) )
11319 electrolyte(jlvcite,jp,ibin) = max(0., &
11320 electrolyte(jlvcite,jp,ibin))
11321 electrolyte(jnh4hso4,jp,ibin)= max(0., &
11322 electrolyte(jnh4hso4,jp,ibin))
11323 store(inh4_a) = 0.
11324 store(iso4_a) = 0.
11325
11326 return
11327 end subroutine form_lvcite_nh4hso4
11328
11329
11330
11331 subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
11332 ! implicit none
11333 ! include 'mosaic.h'
11334 ! subr arguments
11335 integer jp, ibin
11336 real store(naer)
11337
11338 electrolyte(jna2so4,jp,ibin)= real( dble(store(ina_a)) - &
11339 dble(store(iso4_a)) )
11340 electrolyte(jnahso4,jp,ibin)= real( dble(2.*store(iso4_a))- &
11341 dble(store(ina_a)) )
11342 electrolyte(jna2so4,jp,ibin)= max(0., &
11343 electrolyte(jna2so4,jp,ibin))
11344 electrolyte(jnahso4,jp,ibin)= max(0., &
11345 electrolyte(jnahso4,jp,ibin))
11346 store(ina_a) = 0.
11347 store(iso4_a) = 0.
11348
11349 ! write(6,*)'na2so4 + nahso4'
11350
11351 return
11352 end subroutine form_na2so4_nahso4
11353
11354
11355
11356
11357 subroutine form_h2so4(store,jp,ibin)
11358 ! implicit none
11359 ! include 'mosaic.h'
11360 ! subr arguments
11361 integer jp, ibin
11362 real store(naer)
11363
11364 electrolyte(jh2so4,jp,ibin) = max(0.0, store(iso4_a))
11365 store(iso4_a) = 0.0
11366
11367 return
11368 end subroutine form_h2so4
11369
11370
11371
11372
11373 subroutine form_hno3(store,jp,ibin)
11374 ! implicit none
11375 ! include 'mosaic.h'
11376 ! subr arguments
11377 integer jp, ibin
11378 real store(naer)
11379
11380 electrolyte(jhno3,jp,ibin) = max(0.0, store(ino3_a))
11381 store(ino3_a) = 0.0
11382
11383 return
11384 end subroutine form_hno3
11385
11386
11387
11388
11389 subroutine form_hcl(store,jp,ibin)
11390 ! implicit none
11391 ! include 'mosaic.h'
11392 ! subr arguments
11393 integer jp, ibin
11394 real store(naer)
11395
11396 electrolyte(jhcl,jp,ibin) = max(0.0, store(icl_a))
11397 store(icl_a) = 0.0
11398
11399 return
11400 end subroutine form_hcl
11401
11402
11403
11404
11405 subroutine degas_hno3(store,jp,ibin)
11406 ! implicit none
11407 ! include 'mosaic.h'
11408 ! subr arguments
11409 integer jp, ibin
11410 real store(naer)
11411
11412 store(ino3_a) = max(0.0, store(ino3_a))
11413 gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
11414 aer(ino3_a,jp,ibin) = real( dble(aer(ino3_a,jp,ibin)) - &
11415 dble(store(ino3_a)) )
11416 aer(ino3_a,jp,ibin) = max(0.0,aer(ino3_a,jp,ibin))
11417
11418 ! also do it for jtotal
11419 if(jp .ne. jtotal)then
11420 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) + &
11421 aer(ino3_a,jliquid,ibin)
11422 endif
11423
11424 electrolyte(jhno3,jp,ibin) = 0.0
11425 store(ino3_a) = 0.0
11426
11427 return
11428 end subroutine degas_hno3
11429
11430
11431
11432 subroutine degas_hcl(store,jp,ibin)
11433 ! implicit none
11434 ! include 'mosaic.h'
11435 ! subr arguments
11436 integer jp, ibin
11437 real store(naer)
11438
11439 store(icl_a) = max(0.0, store(icl_a))
11440 gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
11441 aer(icl_a,jp,ibin) = real( dble(aer(icl_a,jp,ibin)) - &
11442 dble(store(icl_a)) )
11443 aer(icl_a,jp,ibin) = max(0.0,aer(icl_a,jp,ibin))
11444
11445 ! also do it for jtotal
11446 if(jp .ne. jtotal)then
11447 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) + &
11448 aer(icl_a,jliquid,ibin)
11449 endif
11450
11451 electrolyte(jhcl,jp,ibin) = 0.0
11452 store(icl_a) = 0.0
11453
11454 return
11455 end subroutine degas_hcl
11456
11457
11458
11459 subroutine degas_nh3(store,jp,ibin)
11460 ! implicit none
11461 ! include 'mosaic.h'
11462 ! subr arguments
11463 integer jp, ibin
11464 real store(naer)
11465
11466 store(inh4_a) = max(0.0, store(inh4_a))
11467 gas(inh3_g) = gas(inh3_g) + store(inh4_a)
11468 aer(inh4_a,jp,ibin) = real( dble(aer(inh4_a,jp,ibin)) - &
11469 dble(store(inh4_a)) )
11470 aer(inh4_a,jp,ibin) = max(0.0,aer(inh4_a,jp,ibin))
11471
11472 ! also do it for jtotal
11473 if(jp .ne. jtotal)then
11474 aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) + &
11475 aer(inh4_a,jliquid,ibin)
11476 endif
11477
11478 store(inh4_a) = 0.0
11479
11480 return
11481 end subroutine degas_nh3
11482
11483
11484
11485
11486
11487
11488
11489
11490
11491 subroutine degas_acids(jp,ibin,xt)
11492 ! implicit none
11493 ! include 'mosaic.h'
11494 ! subr arguments
11495 integer jp, ibin
11496 real xt
11497 ! local variables
11498 real ehno3, ehcl
11499
11500
11501
11502 if(jp .ne. jliquid)then
11503 write(6,*)'error in degas_acids'
11504 write(6,*)'wrong jp'
11505 endif
11506
11507 ehno3 = electrolyte(jhno3,jp,ibin)
11508 ehcl = electrolyte(jhcl,jp,ibin)
11509
11510 ! add to gas
11511 gas(ihno3_g) = gas(ihno3_g) + ehno3
11512 gas(ihcl_g) = gas(ihcl_g) + ehcl
11513
11514 ! remove from aer
11515 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
11516 aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
11517
11518 ! update jtotal
11519 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
11520 aer(ino3_a,jsolid, ibin)
11521
11522 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
11523 aer(icl_a,jsolid, ibin)
11524
11525 electrolyte(jhno3,jp,ibin) = 0.0
11526 electrolyte(jhcl,jp,ibin) = 0.0
11527
11528
11529 return
11530 end subroutine degas_acids
11531
11532
11533
11534
11535
11536
11537
11538
11539
11540
11541
11542 !***********************************************************************
11543 ! subroutines to evaporate volatile species by half
11544 !
11545 ! author: rahul a. zaveri
11546 ! update: jan 2004
11547 !-----------------------------------------------------------------------
11548 subroutine evaporate_half_nh4no3(ibin) ! so that epercent(jnh4no3) remains below 1.0
11549 ! implicit none
11550 ! include 'mosaic.h'
11551 ! subr arguments
11552 integer ibin
11553 ! local variables
11554 real x
11555
11556
11557 x = 0.5*min(aer(ino3_a,jliquid,ibin), &
11558 aer(inh4_a,jliquid,ibin))
11559
11560 ! update gas and aer(jliquid)
11561 gas(ihno3_g) = gas(ihno3_g) + x
11562 gas(inh3_g) = gas(inh3_g) + x
11563 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - x
11564 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - x
11565
11566 ! also update jtotal
11567 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
11568 aer(ino3_a,jsolid, ibin)
11569 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jliquid,ibin) + &
11570 aer(inh4_a,jsolid, ibin)
11571
11572 return
11573 end subroutine evaporate_half_nh4no3
11574
11575
11576 subroutine evaporate_half_nh4cl(ibin) ! so that epercent(jnh4cl) remains below 1.0
11577 ! implicit none
11578 ! include 'mosaic.h'
11579 ! subr arguments
11580 integer ibin
11581 ! local variables
11582 real x
11583
11584
11585 x = 0.5*min(aer(icl_a,jliquid,ibin), &
11586 aer(inh4_a,jliquid,ibin))
11587
11588 ! update gas and aer(jliquid)
11589 gas(ihcl_g) = gas(ihcl_g) + x
11590 gas(inh3_g) = gas(inh3_g) + x
11591 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - x
11592 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - x
11593
11594 ! also update jtotal
11595 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
11596 aer(icl_a,jsolid, ibin)
11597 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jliquid,ibin) + &
11598 aer(inh4_a,jsolid, ibin)
11599
11600 return
11601 end subroutine evaporate_half_nh4cl
11602
11603
11604
11605
11606
11607
11608
11609
11610
11611
11612
11613
11614
11615
11616
11617
11618
11619
11620
11621
11622
11623 !***********************************************************************
11624 ! subroutines to evaporate volatile species close to sulfate domain change
11625 !
11626 ! author: rahul a. zaveri
11627 ! update: jan 2004
11628 !-----------------------------------------------------------------------
11629 subroutine evaporate_nh4no3(ibin)
11630 ! implicit none
11631 ! include 'mosaic.h'
11632 ! subr arguments
11633 integer ibin
11634 ! local variables
11635 real acl_l, anh4_l, ano3_l, ghcl, ghno3, gnh3, &
11636 enh4no3, gnh3_ghno3, xt, keq_nh4no3
11637
11638
11639 if(electrolyte(jnh4so4,jliquid,ibin) .gt. 0.0)then
11640
11641 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt) ! may also changes aer(inh4_a,jtotal,ibin) if excess nh3 is degassed
11642 ghno3 = gas(ihno3_g)
11643 ghcl = gas(ihcl_g)
11644 gnh3 = gas(inh3_g)
11645
11646 ano3_l = aer(ino3_a,jliquid,ibin)
11647 acl_l = aer(icl_a,jliquid,ibin)
11648 anh4_l = aer(inh4_a,jliquid,ibin)
11649
11650 enh4no3 = electrolyte(jnh4no3,jliquid,ibin)
11651
11652 ! completely evaporate nh4no3
11653 gas(ihno3_g) = ghno3 + enh4no3
11654 gas(inh3_g) = gnh3 + enh4no3
11655 aer(ino3_a,jliquid,ibin) = max(ano3_l - enh4no3, 0.0)
11656 aer(inh4_a,jliquid,ibin) = max(anh4_l - enh4no3, 0.0)
11657
11658 call ions_to_electrolytes(jliquid,ibin,xt)
11659 call compute_activities(ibin)
11660
11661 call equilibrate_acids(ibin)
11662 gnh3_ghno3 = gas(inh3_g)*gas(ihno3_g)
11663 keq_nh4no3 = activity(jnh4no3,ibin)*kp_nh4no3
11664
11665 if(gnh3_ghno3 .lt. keq_nh4no3)then ! evaporate only nh3
11666
11667 sfc_a(ih2so4_g)= 0.0
11668 sfc_a(ihno3_g) = gas(ihno3_g)
11669 sfc_a(ihcl_g) = gas(ihcl_g)
11670 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
11671 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
11672
11673 df_gas(ihno3_g,ibin) = 0.0
11674 df_gas(ihcl_g,ibin) = 0.0
11675 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
11676
11677 phi_volatile(ihno3_g,ibin) = 0.0
11678 phi_volatile(ihcl_g,ibin) = 0.0
11679 phi_volatile(inh3_g,ibin) = abs(df_gas(inh3_g,ibin))/ &
11680 max(gas(inh3_g), sfc_a(inh3_g))
11681
11682 flux(ihno3_g,ibin) = 0.0
11683 flux(ihcl_g,ibin) = 0.0
11684
11685 ! check for equilibrium
11686 if(phi_volatile(inh3_g,ibin) .lt. 0.01)then
11687 flux(inh3_g,ibin) = 0.0
11688 else
11689 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
11690 endif
11691
11692 else ! restore original values and ignore evaporation of nh4no3
11693
11694 gas(ihno3_g) = ghno3
11695 gas(ihcl_g) = ghcl
11696 gas(inh3_g) = gnh3
11697
11698 aer(ino3_a,jliquid,ibin) = ano3_l
11699 aer(icl_a,jliquid,ibin) = acl_l
11700 aer(inh4_a,jliquid,ibin) = anh4_l
11701
11702
11703 flux(ihno3_g,ibin) = 0.0
11704 flux(inh3_g,ibin) = 0.0
11705 call ions_to_electrolytes(jliquid,ibin,xt)
11706 endif
11707
11708 else ! na and/or ca salts are present
11709
11710 ! call equilibrate_tiny_nh4no3(ibin)
11711 flux(ihno3_g,ibin) = 0.0
11712 flux(ihcl_g,ibin) = 0.0
11713 flux(inh3_g,ibin) = 0.0
11714
11715 endif
11716
11717
11718 ! update jtotal
11719 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
11720 aer(inh4_a,jliquid,ibin)
11721 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
11722 aer(ino3_a,jliquid,ibin)
11723 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
11724 aer(icl_a,jliquid,ibin)
11725
11726
11727 return
11728 end subroutine evaporate_nh4no3
11729
11730
11731
11732
11733
11734
11735
11736
11737
11738
11739
11740
11741 subroutine evaporate_nh4cl(ibin)
11742 ! implicit none
11743 ! include 'mosaic.h'
11744 ! subr arguments
11745 integer ibin
11746 ! local variables
11747 real acl_l, anh4_l, ano3_l, ghcl, ghno3, gnh3, &
11748 enh4cl, enh4no3, gnh3_ghcl, xt, keq_nh4cl
11749
11750
11751 if(electrolyte(jnh4so4,jliquid,ibin) .gt. 0.0)then
11752
11753 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt) ! may also changes aer(inh4_a,jtotal,ibin) if excess nh3 is degassed
11754 ghno3 = gas(ihno3_g)
11755 ghcl = gas(ihcl_g)
11756 gnh3 = gas(inh3_g)
11757
11758 ano3_l = aer(ino3_a,jliquid,ibin)
11759 acl_l = aer(icl_a,jliquid,ibin)
11760 anh4_l = aer(inh4_a,jliquid,ibin)
11761
11762 enh4cl = electrolyte(jnh4cl,jliquid,ibin)
11763
11764 ! completely evaporate nh4cl
11765 gas(ihcl_g) = ghcl + enh4cl
11766 gas(inh3_g) = gnh3 + enh4cl
11767 aer(icl_a,jliquid,ibin) = max(acl_l - enh4cl, 0.0)
11768 aer(inh4_a,jliquid,ibin) = max(anh4_l - enh4cl, 0.0)
11769
11770 call ions_to_electrolytes(jliquid,ibin,xt)
11771 call compute_activities(ibin)
11772
11773 call equilibrate_acids(ibin)
11774 gnh3_ghcl = gas(inh3_g)*gas(ihcl_g)
11775 keq_nh4cl = activity(jnh4cl,ibin)*kp_nh4cl
11776
11777 if(gnh3_ghcl .lt. keq_nh4cl)then ! evaporate only nh3
11778
11779 sfc_a(ih2so4_g)= 0.0
11780 sfc_a(ihno3_g) = gas(ihno3_g)
11781 sfc_a(ihcl_g) = gas(ihcl_g)
11782 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
11783 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
11784
11785 df_gas(ihno3_g,ibin) = 0.0
11786 df_gas(ihcl_g,ibin) = 0.0
11787 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
11788
11789 phi_volatile(ihno3_g,ibin) = 0.0
11790 phi_volatile(ihcl_g,ibin) = 0.0
11791 phi_volatile(inh3_g,ibin) = abs(df_gas(inh3_g,ibin))/ &
11792 max(gas(inh3_g), sfc_a(inh3_g))
11793
11794 flux(ihno3_g,ibin) = 0.0
11795 flux(ihcl_g,ibin) = 0.0
11796
11797 ! check for equilibrium
11798 if(phi_volatile(inh3_g,ibin) .lt. 0.01)then
11799 flux(inh3_g,ibin) = 0.0
11800 else
11801 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
11802 endif
11803
11804 else ! restore original values and ignore evaporation of nh4cl
11805
11806 gas(ihno3_g) = ghno3
11807 gas(ihcl_g) = ghcl
11808 gas(inh3_g) = gnh3
11809
11810 aer(ino3_a,jliquid,ibin) = ano3_l
11811 aer(icl_a,jliquid,ibin) = acl_l
11812 aer(inh4_a,jliquid,ibin) = anh4_l
11813
11814 flux(ihcl_g,ibin) = 0.0
11815 flux(inh3_g,ibin) = 0.0
11816 call ions_to_electrolytes(jliquid,ibin,xt)
11817
11818 endif
11819
11820 else ! na and/or ca salts are present
11821
11822 ! call equilibrate_tiny_nh4cl(ibin)
11823 flux(ihno3_g,ibin) = 0.0
11824 flux(ihcl_g,ibin) = 0.0
11825 flux(inh3_g,ibin) = 0.0
11826
11827 endif
11828
11829
11830 ! update jtotal
11831 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
11832 aer(inh4_a,jliquid,ibin)
11833 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
11834 aer(ino3_a,jliquid,ibin)
11835 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
11836 aer(icl_a,jliquid,ibin)
11837
11838
11839 return
11840 end subroutine evaporate_nh4cl
11841
11842
11843
11844
11845
11846
11847
11848
11849
11850
11851 subroutine evaporate_nh4no3_nh4cl(ibin)
11852 ! implicit none
11853 ! include 'mosaic.h'
11854 ! subr arguments
11855 integer ibin
11856 ! local variables
11857 real acl_l, anh4_l, ano3_l, ghcl, ghno3, gnh3, &
11858 enh4cl, enh4no3, gnh3_ghcl, gnh3_ghno3, xt, &
11859 keq_nh4no3, keq_nh4cl
11860
11861
11862 ghno3 = gas(ihno3_g)
11863 ghcl = gas(ihcl_g)
11864 gnh3 = gas(inh3_g)
11865
11866 ano3_l = aer(ino3_a,jliquid,ibin)
11867 acl_l = aer(icl_a,jliquid,ibin)
11868 anh4_l = aer(inh4_a,jliquid,ibin)
11869
11870 enh4no3 = electrolyte(jnh4no3,jliquid,ibin)
11871 enh4cl = electrolyte(jnh4cl,jliquid,ibin)
11872
11873 ! completely evaporate nh4no3 and nh4cl
11874 gas(ihno3_g) = ghno3 + ano3_l
11875 gas(ihcl_g) = ghcl + acl_l
11876 gas(inh3_g) = gnh3 + ano3_l + acl_l
11877 aer(ino3_a,jliquid,ibin) = 0.0
11878 aer(icl_a,jliquid,ibin) = 0.0
11879 aer(inh4_a,jliquid,ibin) = max(anh4_l-(ano3_l+acl_l), 0.0)
11880
11881 call ions_to_electrolytes(jliquid,ibin,xt)
11882 call compute_activities(ibin)
11883
11884 call equilibrate_acids(ibin)
11885 gnh3_ghcl = gas(inh3_g)*gas(ihcl_g)
11886 gnh3_ghno3 = gas(inh3_g)*gas(ihno3_g)
11887 keq_nh4no3 = activity(jnh4no3,ibin)*kp_nh4no3
11888 keq_nh4cl = activity(jnh4cl,ibin) *kp_nh4cl
11889
11890
11891 ! now check what to do further
11892 if(gnh3_ghno3 .le. keq_nh4no3 .and. &
11893 gnh3_ghcl .le. keq_nh4cl)then ! evaporate only nh3
11894
11895 sfc_a(ih2so4_g)= 0.0
11896 sfc_a(ihno3_g) = gas(ihno3_g)
11897 sfc_a(ihcl_g) = gas(ihcl_g)
11898 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
11899 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
11900
11901 df_gas(ihno3_g,ibin) = 0.0
11902 df_gas(ihcl_g,ibin) = 0.0
11903 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
11904
11905 phi_volatile(ihno3_g,ibin) = 0.0
11906 phi_volatile(ihcl_g,ibin) = 0.0
11907 phi_volatile(inh3_g,ibin) = df_gas(inh3_g,ibin)/ &
11908 max(gas(inh3_g), sfc_a(inh3_g))
11909
11910 flux(ihno3_g,ibin) = 0.0
11911 flux(ihcl_g,ibin) = 0.0
11912
11913 ! check for equilibrium
11914 if(abs(phi_volatile(inh3_g,ibin)) .lt. 0.01)then
11915 flux(inh3_g,ibin) = 0.0
11916 else
11917 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
11918 endif
11919
11920 else ! restore original values and ignore evaporation of nh4no3
11921
11922 gas(ihno3_g) = ghno3
11923 gas(ihcl_g) = ghcl
11924 gas(inh3_g) = gnh3
11925
11926 aer(ino3_a,jliquid,ibin) = ano3_l
11927 aer(icl_a,jliquid,ibin) = acl_l
11928 aer(inh4_a,jliquid,ibin) = anh4_l
11929
11930 flux(ihno3_g,ibin) = 0.0
11931 flux(ihcl_g,ibin) = 0.0
11932 flux(inh3_g,ibin) = 0.0
11933 call ions_to_electrolytes(jliquid,ibin,xt)
11934 endif
11935
11936
11937 ! update jtotal
11938 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
11939 aer(inh4_a,jliquid,ibin)
11940 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
11941 aer(ino3_a,jliquid,ibin)
11942 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
11943 aer(icl_a,jliquid,ibin)
11944
11945
11946 return
11947 end subroutine evaporate_nh4no3_nh4cl
11948
11949
11950
11951
11952
11953
11954
11955
11956
11957
11958 subroutine evaporate_nh4no3_nh4cl_old(ibin)
11959 ! implicit none
11960 ! include 'mosaic.h'
11961 ! subr arguments
11962 integer ibin
11963 ! local variables
11964 real acl_l, anh4_l, ano3_l, ghcl, ghno3, gnh3, &
11965 enh4cl, enh4no3, gnh3_ghcl, gnh3_ghno3, xt, &
11966 keq_nh4no3, keq_nh4cl
11967
11968
11969 if(electrolyte(jnh4so4,jliquid,ibin) .gt. 0.0)then
11970
11971 call asteem_formelectrolytes_hybrid(jliquid,ibin,xt) ! may also changes aer(inh4_a,jtotal,ibin) if excess nh3 is degassed
11972 ghno3 = gas(ihno3_g)
11973 ghcl = gas(ihcl_g)
11974 gnh3 = gas(inh3_g)
11975
11976 ano3_l = aer(ino3_a,jliquid,ibin)
11977 acl_l = aer(icl_a,jliquid,ibin)
11978 anh4_l = aer(inh4_a,jliquid,ibin)
11979
11980 enh4no3 = electrolyte(jnh4no3,jliquid,ibin)
11981 enh4cl = electrolyte(jnh4cl,jliquid,ibin)
11982
11983 ! completely evaporate nh4no3 and nh4cl
11984 gas(ihno3_g) = ghno3 + enh4no3
11985 gas(ihcl_g) = ghcl + enh4cl
11986 gas(inh3_g) = gnh3 + enh4no3 + enh4cl
11987 aer(ino3_a,jliquid,ibin) = max(ano3_l - enh4no3, 0.0)
11988 aer(icl_a,jliquid,ibin) = max(acl_l - enh4cl, 0.0)
11989 aer(inh4_a,jliquid,ibin) = max(anh4_l - enh4no3-enh4cl, 0.0)
11990
11991 call ions_to_electrolytes(jliquid,ibin,xt)
11992 call compute_activities(ibin)
11993
11994 call equilibrate_acids(ibin)
11995 gnh3_ghcl = gas(inh3_g)*gas(ihcl_g)
11996 gnh3_ghno3 = gas(inh3_g)*gas(ihno3_g)
11997 keq_nh4no3 = activity(jnh4no3,ibin)*kp_nh4no3
11998 keq_nh4cl = activity(jnh4cl,ibin) *kp_nh4cl
11999
12000 if(gnh3_ghno3 .lt. keq_nh4no3 .and. &
12001 gnh3_ghcl .lt. keq_nh4cl)then ! evaporate only nh3
12002
12003 sfc_a(ih2so4_g)= 0.0
12004 sfc_a(ihno3_g) = gas(ihno3_g)
12005 sfc_a(ihcl_g) = gas(ihcl_g)
12006 sfc_a(inh3_g) = gam_ratio(ibin)*mc(jc_nh4,ibin)*keq_ll(3)/ &
12007 (mc(jc_h,ibin)*keq_ll(2)*keq_gl(2))
12008
12009 df_gas(ihno3_g,ibin) = 0.0
12010 df_gas(ihcl_g,ibin) = 0.0
12011 df_gas(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
12012
12013 phi_volatile(ihno3_g,ibin) = 0.0
12014 phi_volatile(ihcl_g,ibin) = 0.0
12015 phi_volatile(inh3_g,ibin) = abs(df_gas(inh3_g,ibin))/ &
12016 max(gas(inh3_g), sfc_a(inh3_g))
12017
12018 flux(ihno3_g,ibin) = 0.0
12019 flux(ihcl_g,ibin) = 0.0
12020
12021 ! check for equilibrium
12022 if(phi_volatile(inh3_g,ibin) .lt. 0.01)then
12023 flux(inh3_g,ibin) = 0.0
12024 else
12025 flux(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas(inh3_g,ibin)
12026 endif
12027
12028 else ! restore original values and ignore evaporation of nh4no3
12029
12030 gas(ihno3_g) = ghno3
12031 gas(ihcl_g) = ghcl
12032 gas(inh3_g) = gnh3
12033
12034 aer(ino3_a,jliquid,ibin) = ano3_l
12035 aer(icl_a,jliquid,ibin) = acl_l
12036 aer(inh4_a,jliquid,ibin) = anh4_l
12037
12038 flux(ihno3_g,ibin) = 0.0
12039 flux(ihcl_g,ibin) = 0.0
12040 flux(inh3_g,ibin) = 0.0
12041 call ions_to_electrolytes(jliquid,ibin,xt)
12042 endif
12043
12044 else ! na and/or ca salts are probably present
12045
12046 flux(ihcl_g,ibin) = 0.0
12047 flux(ihno3_g,ibin) = 0.0
12048 flux(inh3_g,ibin) = 0.0
12049
12050 endif
12051
12052
12053 ! update jtotal
12054 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12055 aer(inh4_a,jliquid,ibin)
12056 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12057 aer(ino3_a,jliquid,ibin)
12058 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12059 aer(icl_a,jliquid,ibin)
12060
12061
12062
12063 return
12064 end subroutine evaporate_nh4no3_nh4cl_old
12065
12066
12067
12068
12069
12070
12071
12072
12073
12074
12075
12076
12077
12078
12079
12080
12081
12082
12083
12084
12085
12086
12087
12088 !***********************************************************************
12089 ! subroutines to evaporate solid volatile species
12090 !
12091 ! author: rahul a. zaveri
12092 ! update: sep 2004
12093 !-----------------------------------------------------------------------
12094 !
12095 ! only nh4no3
12096 subroutine degas_solid_nh4no3(ibin)
12097 ! implicit none
12098 ! include 'mosaic.h'
12099 ! subr arguments
12100 integer ibin
12101 ! local variables
12102 integer jp
12103 real a, b, c, xgas
12104 ! real quadratic ! mosaic func
12105
12106
12107 jp = jsolid
12108
12109 a = 1.0
12110 b = gas(inh3_g) + gas(ihno3_g)
12111 c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
12112 xgas = quadratic(a,b,c)
12113
12114 if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
12115
12116 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4no3,jp,ibin)
12117 gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
12118 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
12119 electrolyte(jnh4no3,jp,ibin)
12120 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - &
12121 electrolyte(jnh4no3,jp,ibin)
12122 electrolyte(jnh4no3,jp,ibin) = 0.0
12123 epercent(jnh4no3,jp,ibin) = 0.0
12124
12125 else ! degas only xgas amount of nh4no3
12126
12127 gas(inh3_g) = gas(inh3_g) + xgas
12128 gas(ihno3_g)= gas(ihno3_g) + xgas
12129 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
12130 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
12131
12132 endif
12133
12134
12135 ! update jtotal
12136 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12137 aer(inh4_a,jliquid,ibin)
12138 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12139 aer(ino3_a,jliquid,ibin)
12140
12141
12142 return
12143 end subroutine degas_solid_nh4no3
12144
12145
12146
12147
12148
12149
12150 ! only nh4cl
12151 subroutine degas_solid_nh4cl(ibin)
12152 ! implicit none
12153 ! include 'mosaic.h'
12154 ! subr arguments
12155 integer ibin
12156 ! local variables
12157 integer jp
12158 real a, b, c, xgas
12159 ! real quadratic ! mosaic func
12160
12161
12162 jp = jsolid
12163
12164 a = 1.0
12165 b = gas(inh3_g) + gas(ihcl_g)
12166 c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
12167 xgas = quadratic(a,b,c)
12168
12169 if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
12170
12171 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
12172 gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
12173 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
12174 electrolyte(jnh4cl,jp,ibin)
12175 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - &
12176 electrolyte(jnh4cl,jp,ibin)
12177 electrolyte(jnh4cl,jsolid,ibin) = 0.0
12178 epercent(jnh4cl,jsolid,ibin) = 0.0
12179
12180 else ! degas only xgas amount of nh4cl
12181
12182 gas(inh3_g) = gas(inh3_g) + xgas
12183 gas(ihcl_g) = gas(ihcl_g) + xgas
12184 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
12185 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - xgas
12186
12187 endif
12188
12189
12190 ! update jtotal
12191 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12192 aer(inh4_a,jliquid,ibin)
12193 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12194 aer(icl_a,jliquid,ibin)
12195
12196
12197 return
12198 end subroutine degas_solid_nh4cl
12199
12200
12201
12202
12203
12204
12205
12206
12207 ! both nh4no3 and nh4cl
12208 subroutine degas_solid_volatiles(ibin)
12209 ! implicit none
12210 ! include 'mosaic.h'
12211 ! subr arguments
12212 integer ibin
12213 ! local variables
12214 integer jp
12215 real a, b, c, xgas
12216 ! real quadratic ! mosaic func
12217
12218
12219 jp = jsolid
12220
12221 if(epercent(jnh4no3,jp,ibin) .gt. 0. .and. &
12222 gas(inh3_g)*gas(ihno3_g) .lt. keq_sg(1) )then
12223
12224 a = 1.0
12225 b = gas(inh3_g) + gas(ihno3_g)
12226 c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
12227 xgas = quadratic(a,b,c)
12228
12229 if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
12230
12231 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4no3,jp,ibin)
12232 gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
12233 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
12234 electrolyte(jnh4no3,jp,ibin)
12235 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - &
12236 electrolyte(jnh4no3,jp,ibin)
12237 electrolyte(jnh4no3,jp,ibin) = 0.0
12238 epercent(jnh4no3,jp,ibin) = 0.0
12239
12240 else ! degas only xgas amount of nh4no3
12241
12242 gas(inh3_g) = gas(inh3_g) + xgas
12243 gas(ihno3_g)= gas(ihno3_g) + xgas
12244 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
12245 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
12246
12247 endif
12248
12249 endif
12250
12251
12252
12253 if(epercent(jnh4cl,jp,ibin) .gt. 0. .and. &
12254 gas(inh3_g)*gas(ihcl_g) .lt. keq_sg(2) )then
12255
12256 a = 1.0
12257 b = gas(inh3_g) + gas(ihcl_g)
12258 c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
12259 xgas = quadratic(a,b,c)
12260
12261 if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
12262
12263 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
12264 gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
12265 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
12266 electrolyte(jnh4cl,jp,ibin)
12267 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - &
12268 electrolyte(jnh4cl,jp,ibin)
12269 electrolyte(jnh4cl,jp,ibin) = 0.0
12270 epercent(jnh4cl,jp,ibin) = 0.0
12271
12272 else ! degas only xgas amount of nh4cl
12273
12274 gas(inh3_g) = gas(inh3_g) + xgas
12275 gas(ihcl_g) = gas(ihcl_g) + xgas
12276 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
12277 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - xgas
12278
12279 endif
12280
12281 endif
12282
12283
12284 ! update jtotal
12285 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12286 aer(inh4_a,jliquid,ibin)
12287 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12288 aer(ino3_a,jliquid,ibin)
12289 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12290 aer(icl_a,jliquid,ibin)
12291
12292 return
12293 end subroutine degas_solid_volatiles
12294
12295
12296
12297
12298
12299
12300
12301 !***********************************************************************
12302 ! subroutines to equilibrate volatile acids
12303 !
12304 ! author: rahul a. zaveri
12305 ! update: may 2002
12306 !-----------------------------------------------------------------------
12307 subroutine equilibrate_acids(ibin)
12308 ! implicit none
12309 ! include 'mosaic.h'
12310 ! subr arguments
12311 integer ibin
12312 ! local variables
12313 real salts_cl, salts_no3, sum_salts
12314
12315
12316
12317 if(electrolyte(jcaco3,jliquid,ibin) .gt. 0.0 .or. &
12318 water_a(ibin) .eq. 0.0)return
12319
12320 salts_cl = electrolyte(jnacl,jliquid,ibin) + &
12321 electrolyte(jcacl2,jliquid,ibin) + &
12322 electrolyte(jnh4cl,jliquid,ibin)
12323
12324 salts_no3 = electrolyte(jnano3,jliquid,ibin) + &
12325 electrolyte(jcano3,jliquid,ibin) + &
12326 electrolyte(jnh4no3,jliquid,ibin)
12327
12328 sum_salts = salts_cl + salts_no3
12329
12330
12331 if(gas(ihcl_g)*sum_salts.gt.0.)then
12332 call equilibrate_hcl(ibin)
12333 elseif(gas(ihno3_g)*salts_no3.gt.0. .and. salts_cl.eq.0.)then
12334 call equilibrate_hno3(ibin)
12335 elseif(gas(ihcl_g)*gas(ihno3_g).gt.0. .and. sum_salts.eq.0.)then
12336 call equilibrate_hcl_and_hno3(ibin)
12337 elseif(gas(ihcl_g).gt.0. .and. sum_salts.eq.0.)then
12338 call equilibrate_hcl(ibin)
12339 elseif(gas(ihno3_g).gt.0. .and. sum_salts.eq.0.)then
12340 call equilibrate_hno3(ibin)
12341 endif
12342
12343 return
12344 end subroutine equilibrate_acids
12345
12346
12347
12348
12349
12350
12351
12352
12353 ! only hcl
12354 subroutine equilibrate_hcl(ibin)
12355 ! implicit none
12356 ! include 'mosaic.h'
12357 ! subr arguments
12358 integer ibin
12359 ! local variables
12360 real a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl, &
12361 w, xt, z
12362 ! real quadratic ! mosaic func
12363
12364 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
12365 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
12366
12367 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
12368 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12369 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
12370 aer(inh4_a,jliquid,ibin) + &
12371 2.*aer(ica_a, jliquid,ibin) ) - &
12372 (2.*aerso4 + &
12373 aerhso4 + &
12374 aer(ino3_a,jliquid,ibin) )
12375
12376
12377 w = water_a(ibin) ! kg/m^3(air)
12378
12379 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12380 a = 1.0
12381 b = real(dble(kdash_hcl*w) + dble(z/w))*1.e-9
12382 c = kdash_hcl*(z - tcl)*1.e-18
12383
12384
12385 dum = real(dble(b*b)-dble(4.*a*c))
12386 if (dum .lt. 0.) return ! no real root
12387
12388
12389 if(c .lt. 0.)then
12390 mh = quadratic(a,b,c) ! mol/kg(water)
12391 aerh = mh*w*1.e+9
12392 aer(icl_a,jliquid,ibin) = real(dble(aerh) + dble(z))
12393 else
12394 mh = sqrt(keq_ll(3))
12395 endif
12396
12397 call form_electrolytes(jliquid,ibin,xt)
12398
12399 ! update gas phase concentration
12400 gas(ihcl_g) = real( dble(tcl) - dble(aer(icl_a,jliquid,ibin)) )
12401
12402
12403 ! update the following molalities
12404 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
12405 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
12406 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
12407 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
12408
12409 mc(jc_h,ibin) = mh
12410 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
12411 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
12412 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
12413
12414
12415 ! update the following activities
12416 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
12417 gam(jhcl,ibin)**2
12418
12419 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
12420 gam(jhno3,ibin)**2
12421
12422 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
12423 gam(jnh4cl,ibin)**2
12424
12425
12426 ! also update xyz(jtotal)
12427 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
12428 aer(icl_a,jsolid,ibin)
12429
12430 electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
12431
12432 ph(ibin) = -alog10(mc(jc_h,ibin))
12433
12434 return
12435 end subroutine equilibrate_hcl
12436
12437
12438
12439
12440 ! only hno3
12441 subroutine equilibrate_hno3(ibin)
12442 ! implicit none
12443 ! include 'mosaic.h'
12444 ! subr arguments
12445 integer ibin
12446 ! local variables
12447 real a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh, &
12448 tno3, w, xt, z
12449 ! real quadratic ! mosaic func
12450
12451 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
12452 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
12453
12454 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
12455 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12456 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
12457 aer(inh4_a,jliquid,ibin) + &
12458 2.*aer(ica_a, jliquid,ibin) ) - &
12459 (2.*aerso4 + &
12460 aerhso4 + &
12461 aer(icl_a,jliquid,ibin) )
12462
12463
12464 w = water_a(ibin) ! kg/m^3(air)
12465
12466 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12467 a = 1.0
12468 b = real(dble(kdash_hno3*w) + dble(z/w))*1.e-9
12469 c = kdash_hno3*(z - tno3)*1.e-18
12470
12471 dum = real(dble(b*b)-dble(4.*a*c))
12472 if (dum .lt. 0.) return ! no real root
12473
12474
12475
12476 if(c .lt. 0.)then
12477 mh = quadratic(a,b,c) ! mol/kg(water)
12478 aerh = mh*w*1.e+9
12479 aer(ino3_a,jliquid,ibin) = real(dble(aerh) + dble(z))
12480 else
12481 mh = sqrt(keq_ll(3))
12482 endif
12483
12484 call form_electrolytes(jliquid,ibin,xt)
12485
12486 ! update gas phase concentration
12487 gas(ihno3_g)= real( dble(tno3) - dble(aer(ino3_a,jliquid,ibin)) )
12488
12489
12490 ! update the following molalities
12491 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
12492 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
12493 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
12494 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
12495
12496 mc(jc_h,ibin) = mh
12497 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
12498 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
12499 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
12500
12501
12502 ! update the following activities
12503 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
12504 gam(jhcl,ibin)**2
12505
12506 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
12507 gam(jhno3,ibin)**2
12508
12509 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) * &
12510 gam(jnh4no3,ibin)**2
12511
12512
12513 ! also update xyz(jtotal)
12514 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
12515 aer(ino3_a,jsolid,ibin)
12516
12517 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
12518
12519 ph(ibin) = -alog10(mc(jc_h,ibin))
12520
12521 return
12522 end subroutine equilibrate_hno3
12523
12524
12525
12526
12527
12528
12529
12530
12531
12532
12533 ! both hcl and hno3
12534 subroutine equilibrate_hcl_and_hno3(ibin)
12535 ! implicit none
12536 ! include 'mosaic.h'
12537 ! subr arguments
12538 integer ibin
12539 ! local variables
12540 real aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3, &
12541 mh, p, q, r, tcl, tno3, w, xt, z
12542 ! real cubic ! mosaic func
12543
12544
12545 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
12546 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
12547
12548 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
12549 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
12550
12551 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12552 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12553
12554 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
12555 aer(inh4_a,jliquid,ibin) + &
12556 2.*aer(ica_a, jliquid,ibin) ) - &
12557 (2.*aerso4 + aerhso4 )
12558
12559
12560 w = water_a(ibin)
12561
12562 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12563 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
12564
12565 p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
12566
12567 q = 1.e-18*kdash_hcl*kdash_hno3*w**2 + &
12568 1.e-18*z*(kdash_hcl + kdash_hno3) - &
12569 1.e-18*kdash_hcl*tcl - &
12570 1.e-18*kdash_hno3*tno3
12571
12572 r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
12573
12574 mh = cubic(p,q,r)
12575
12576 if(mh .gt. 0.0)then
12577 aerh = mh*w*1.e+9
12578 aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/ &
12579 (aerh + kdash_hno3*w*w)
12580 aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/ &
12581 (aerh + kdash_hcl*w*w)
12582 else
12583 mh = sqrt(keq_ll(3))
12584 endif
12585
12586 call form_electrolytes(jliquid,ibin,xt)
12587
12588 ! update gas phase concentration
12589 gas(ihno3_g)= real( dble(tno3) - dble(aer(ino3_a,jliquid,ibin)) )
12590 gas(ihcl_g) = real( dble(tcl) - dble(aer(icl_a,jliquid,ibin)) )
12591
12592
12593 ! update the following molalities
12594 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
12595 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
12596 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
12597 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
12598
12599 mc(jc_h,ibin) = mh
12600 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
12601 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
12602 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
12603
12604
12605 ! update the following activities
12606 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin) * &
12607 gam(jhcl,ibin)**2
12608
12609 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin) * &
12610 gam(jhno3,ibin)**2
12611
12612 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
12613 gam(jnh4no3,ibin)**2
12614
12615 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
12616 gam(jnh4cl,ibin)**2
12617
12618
12619 ! also update xyz(jtotal)
12620 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
12621 aer(icl_a,jsolid,ibin)
12622
12623 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
12624 aer(ino3_a,jsolid,ibin)
12625
12626 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
12627 electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
12628
12629 ph(ibin) = -alog10(mc(jc_h,ibin))
12630
12631 return
12632 end subroutine equilibrate_hcl_and_hno3
12633
12634
12635
12636
12637
12638
12639
12640
12641
12642
12643
12644
12645
12646
12647 !***********************************************************************
12648 ! subroutines to absorb and degas small amounts of volatile species
12649 !
12650 ! author: rahul a. zaveri
12651 ! update: jun 2002
12652 !-----------------------------------------------------------------------
12653 !
12654 ! nh3
12655 subroutine absorb_tiny_nh3(ibin)
12656 ! implicit none
12657 ! include 'mosaic.h'
12658 ! subr arguments
12659 integer ibin
12660 ! local variables
12661 real small_aer, small_amt, small_gas
12662
12663 small_gas = 0.02 * gas(inh3_g)
12664 small_aer = 0.05 * aer(iso4_a,jliquid,ibin)
12665
12666 small_amt = min(small_gas, small_aer)
12667
12668 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
12669
12670 ! update jtotal
12671 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12672 aer(inh4_a,jliquid,ibin)
12673
12674 ! update gas
12675 gas(inh3_g) = gas(inh3_g) - small_amt
12676
12677 return
12678 end subroutine absorb_tiny_nh3
12679
12680
12681
12682 ! hcl
12683 subroutine absorb_tiny_hcl(ibin) ! and degas tiny hno3
12684 ! implicit none
12685 ! include 'mosaic.h'
12686 ! subr arguments
12687 integer ibin
12688 ! local variables
12689 real small_aer, small_amt, small_gas
12690
12691 small_gas = 0.01 * gas(ihcl_g)
12692 small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
12693
12694 small_amt = min(small_gas, small_aer)
12695
12696 ! absorb tiny hcl
12697 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + small_amt
12698 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12699 aer(icl_a,jliquid,ibin)
12700 gas(ihcl_g) = gas(ihcl_g) - small_amt
12701
12702 ! degas tiny hno3
12703 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
12704 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12705 aer(ino3_a,jliquid,ibin)
12706
12707 ! update gas
12708 gas(ihno3_g) = gas(ihno3_g) + small_amt
12709
12710 return
12711 end subroutine absorb_tiny_hcl
12712
12713
12714
12715
12716 ! hno3
12717 subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
12718 ! implicit none
12719 ! include 'mosaic.h'
12720 ! subr arguments
12721 integer ibin
12722 ! local variables
12723 real small_aer, small_amt, small_gas
12724
12725 small_gas = 0.01 * gas(ihno3_g)
12726 small_aer = 0.01 * aer(icl_a,jliquid,ibin)
12727
12728 small_amt = min(small_gas, small_aer)
12729
12730 ! absorb tiny hno3
12731 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
12732 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12733 aer(ino3_a,jliquid,ibin)
12734 gas(ihno3_g) = gas(ihno3_g) - small_amt
12735
12736 ! degas tiny hcl
12737 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
12738 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12739 aer(icl_a,jliquid,ibin)
12740
12741 ! update gas
12742 gas(ihcl_g) = gas(ihcl_g) + small_amt
12743
12744 return
12745 end subroutine absorb_tiny_hno3
12746
12747
12748
12749
12750 ! nh4cl
12751 subroutine absorb_tiny_nh4cl(ibin)
12752 ! implicit none
12753 ! include 'mosaic.h'
12754 ! subr arguments
12755 integer ibin
12756 ! local variables
12757 real small_aer, small_amt, small_gas
12758
12759 small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
12760 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
12761 if(small_aer .eq. 0.0)small_aer = small_gas
12762
12763 small_amt = min(small_gas, small_aer)
12764
12765 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
12766 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + small_amt
12767
12768 ! update jtotal
12769 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12770 aer(inh4_a,jliquid,ibin)
12771 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12772 aer(icl_a,jliquid,ibin)
12773
12774 ! update gas
12775 gas(inh3_g) = gas(inh3_g) - small_amt
12776 gas(ihcl_g) = gas(ihcl_g) - small_amt
12777
12778 return
12779 end subroutine absorb_tiny_nh4cl
12780
12781
12782
12783
12784 ! both nh4no3
12785 subroutine absorb_tiny_nh4no3(ibin)
12786 ! implicit none
12787 ! include 'mosaic.h'
12788 ! subr arguments
12789 integer ibin
12790 ! local variables
12791 real small_aer, small_amt, small_gas
12792
12793 small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
12794 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
12795
12796 small_amt = min(small_gas, small_aer)
12797
12798 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
12799 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
12800
12801 ! update jtotal
12802 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12803 aer(inh4_a,jliquid,ibin)
12804 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12805 aer(ino3_a,jliquid,ibin)
12806
12807 ! update gas
12808 gas(inh3_g) = gas(inh3_g) - small_amt
12809 gas(ihno3_g) = gas(ihno3_g) - small_amt
12810
12811 return
12812 end subroutine absorb_tiny_nh4no3
12813
12814
12815
12816
12817
12818
12819
12820 ! nh4cl
12821 subroutine degas_tiny_nh4cl(ibin)
12822 ! implicit none
12823 ! include 'mosaic.h'
12824 ! subr arguments
12825 integer ibin
12826 ! local variables
12827 real small_amt
12828
12829
12830 small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
12831
12832 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
12833 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
12834
12835 ! update jtotal
12836 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12837 aer(inh4_a,jliquid,ibin)
12838 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
12839 aer(icl_a,jliquid,ibin)
12840
12841 ! update gas
12842 gas(inh3_g) = gas(inh3_g) + small_amt
12843 gas(ihcl_g) = gas(ihcl_g) + small_amt
12844
12845 return
12846 end subroutine degas_tiny_nh4cl
12847
12848
12849
12850
12851
12852
12853
12854
12855 ! nh4no3
12856 subroutine degas_tiny_nh4no3(ibin)
12857 ! implicit none
12858 ! include 'mosaic.h'
12859 ! subr arguments
12860 integer ibin
12861 ! local variables
12862 real small_amt
12863
12864 small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
12865
12866 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
12867 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
12868
12869 ! update jtotal
12870 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
12871 aer(inh4_a,jliquid,ibin)
12872 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
12873 aer(ino3_a,jliquid,ibin)
12874
12875 ! update gas
12876 gas(inh3_g) = gas(inh3_g) + small_amt
12877 gas(ihno3_g) = gas(ihno3_g) + small_amt
12878
12879 return
12880 end subroutine degas_tiny_nh4no3
12881
12882
12883
12884
12885
12886
12887
12888
12889
12890
12891
12892
12893 !***********************************************************************
12894 ! functions used in psc model
12895 !
12896 ! author: rahul a. zaveri
12897 ! update: aug 1999
12898 !-----------------------------------------------------------------------
12899
12900 !===========================================================================
12901 !
12902 ! neutral species activity coefficient
12903 !
12904 !===========================================================================
12905 real function fn(jn)
12906 ! implicit none
12907 ! include 'mosaic.h'
12908 ! func arguments
12909 integer jn
12910 ! local variables
12911 integer jc, ja, jcp, jap
12912 real term1, term2, term3, term4, term5, term6, term7, term8, &
12913 term9, sumover_c_a, sumover_c_cp, sumover_a_ap, sumover_a, &
12914 sumover_c, lnf, lnf_s, lnf_dh, lnf_hoe, six
12915
12916
12917
12918
12919
12920 six = sqrt(ix)
12921 !
12922 ! short-range contributions
12923 !
12924 !--term1------------------------
12925 sumover_c_a = 0.0
12926 do jc = 1, ncation
12927 do ja = 1, nanion
12928 sumover_c_a = sumover_c_a + xc(jc)*xa(ja) * &
12929 ((zc(jc)+za(ja))**2)/(zc(jc)*za(ja)) * &
12930 (u1_c_a(jc,ja) - 2.*xh2o*u1_c_a(jc,ja))
12931 enddo
12932 enddo
12933
12934 term1 = sumover_c_a
12935
12936 !--term2------------------------
12937 sumover_c_a = 0.0
12938 do jc = 1, ncation
12939 do ja = 1, nanion
12940 sumover_c_a = sumover_c_a + xc(jc)*xa(ja) * &
12941 (2.*xh2o*v1_c_a(jc,ja) - 3.*(xh2o**2)*v1_c_a(jc,ja))
12942 enddo
12943 enddo
12944
12945 term2 = 4.*sumover_c_a
12946
12947 !--term3------------------------
12948 sumover_c_a = 0.0
12949 do jc = 1, ncation
12950 do ja = 1, nanion
12951 sumover_c_a = sumover_c_a + ec(jc)*ea(ja) * &
12952 (zc(jc)+za(ja))/(zc(jc)*za(ja)) * &
12953 (w1_c_a(jc,ja) - xh2o*w1_c_a(jc,ja))
12954 enddo
12955 enddo
12956
12957 term3 = (1./ff)*sumover_c_a
12958
12959 !--term4------------------------
12960 sumover_a = 0.0
12961 do ja = 1, nanion
12962
12963 sumover_c_cp = 0.0
12964 do jc = 1, ncation
12965 do jcp = jc+1, ncation
12966 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
12967 (xc(jc)/xnuc(jc,ja) - xc(jcp)/xnuc(jcp,ja))* &
12968 uc_cp_a(jc,jcp,ja)
12969 enddo
12970 enddo
12971
12972 sumover_a = sumover_a + ea(ja)*sumover_c_cp
12973 enddo
12974
12975 term4 = -4.*sumover_a
12976
12977 !--term5------------------------
12978 sumover_c = 0.0
12979 do jc = 1, ncation
12980
12981 sumover_a_ap = 0.0
12982 do ja = 1, nanion
12983 do jap = ja+1, nanion
12984 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
12985 (xa(ja)/xnua(ja,jc) - xa(jap)/xnua(jap,jc))* &
12986 ua_ap_c(ja,jap,jc)
12987 enddo
12988 enddo
12989
12990 sumover_c = sumover_c + ec(jc)*sumover_a_ap
12991 enddo
12992
12993 term5 = -4.*sumover_c
12994
12995 !--term6------------------------
12996 sumover_a = 0.0
12997 do ja = 1, nanion
12998
12999 sumover_c_cp = 0.0
13000 do jc = 1, ncation
13001 do jcp = jc+1, ncation
13002 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
13003 wc_cp_a(jc,jcp,ja)
13004 enddo
13005 enddo
13006
13007 sumover_a = sumover_a + ea(ja)*sumover_c_cp
13008 enddo
13009
13010 term6 = -2.*sumover_a
13011
13012 !--term7------------------------
13013 sumover_c = 0.0
13014 do jc = 1, ncation
13015
13016 sumover_a_ap = 0.0
13017 do ja = 1, nanion
13018 do jap = ja+1, nanion
13019 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13020 wa_ap_c(ja,jap,jc)
13021 enddo
13022 enddo
13023
13024 sumover_c = sumover_c + ec(jc)*sumover_a_ap
13025 enddo
13026
13027 term7 = -2.*sumover_c
13028
13029 !--term8------------------------
13030 sumover_a = 0.0
13031 do ja = 1, nanion
13032
13033 sumover_c_cp = 0.0
13034 do jc = 1, ncation
13035 do jcp = jc+1, ncation
13036 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
13037 q1_c_cp_a(jc,jcp,ja)*(1 - 2.*xh2o)
13038 enddo
13039 enddo
13040
13041 sumover_a = sumover_a + ea(ja)*sumover_c_cp
13042 enddo
13043
13044 term8 = 4.*sumover_a
13045
13046 !--term9------------------------
13047 sumover_c = 0.0
13048 do jc = 1, ncation
13049
13050 sumover_a_ap = 0.0
13051 do ja = 1, nanion
13052 do jap = ja+1, nanion
13053 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13054 q1_a_ap_c(ja,jap,jc)*(1 - 2.*xh2o)
13055 enddo
13056 enddo
13057
13058 sumover_c = sumover_c + ec(jc)*sumover_a_ap
13059 enddo
13060
13061 term9 = 4.*sumover_c
13062
13063 !-------------------------------
13064 lnf_s = term1 + term2 + term3 + term4 + term5 + &
13065 term6 + term7 + term8 + term9
13066
13067
13068 ! long-range contributions (debye-huckel)
13069
13070 !--term1------------------------
13071 term1 = 2.*ax*(ix**1.5)/(1.+rho*six)
13072
13073 !--term2 & term3----------------
13074 term2 = 0.0
13075 term3 = 0.0
13076 do jc = 1, ncation
13077 do ja = 1, nanion
13078 term2 = term2 + xc(jc)*xa(ja)*bc_a(jc,ja)* &
13079 exp(-alpha_c_a(jc,ja)*six)
13080 term3 = term3 + xc(jc)*xa(ja)*b1_c_a(jc,ja)* &
13081 exp(-alpha1_c_a(jc,ja)*six)
13082
13083 enddo
13084 enddo
13085
13086 term2 = -term2
13087 term3 = -term3
13088
13089 !-------------------------------
13090 lnf_dh = term1 + term2 + term3
13091
13092
13093
13094 ! long-range contributions (higher order electrostatic)
13095
13096 !--term1------------------------
13097 sumover_c_cp = 0.0
13098 do jc = 1, ncation
13099 do jcp = jc+1, ncation
13100 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
13101 ( thetahoe(izc(jc),izc(jcp)) + &
13102 ix*dthetahoe(izc(jc),izc(jcp)) )
13103 enddo
13104 enddo
13105
13106 term1 = -2.*sumover_c_cp
13107
13108 !--term2------------------------
13109 sumover_a_ap = 0.0
13110 do ja = 1, nanion
13111 do jap = ja+1, nanion
13112 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13113 ( thetahoe(iza(ja),iza(jap)) + &
13114 ix*dthetahoe(iza(ja),iza(jap)) )
13115 enddo
13116 enddo
13117
13118 term2 = -2.*sumover_a_ap
13119
13120 !-------------------------------
13121 lnf_hoe = term1 + term2
13122
13123 !================================
13124 lnf = lnf_s + lnf_dh + lnf_hoe
13125 fn = exp(lnf)
13126
13127 return
13128 end function fn
13129 !
13130 !
13131 !
13132 !===========================================================================
13133 !
13134 ! cation activity coefficient
13135 !
13136 !===========================================================================
13137
13138 real function fm(jm)
13139 ! implicit none
13140 ! include 'mosaic.h'
13141 ! func arguments
13142 integer jm
13143 ! local variables
13144 integer jc, ja, jcp, jap, izm
13145 real term1, term2, term3, term4, term5, term6, term7, term8, &
13146 term9, term10, sumover_c_a, sumover_c_cp, sumover_a_ap, &
13147 sumover_a, sumover_c, sumoverp_a, sumoverp_c, &
13148 sumoverp_c_cp, lnf, lnf_s, lnf_dh, lnf_hoe, six, zm, zm2
13149 ! functions
13150 ! real gg
13151
13152
13153 ! short-range contributions
13154 zm = zc(jm)
13155 izm = izc(jm)
13156
13157 !--term1------------------------
13158 sumover_a = 0.0
13159 do ja = 1, nanion
13160
13161 sumover_c = 0.0
13162 do jc = 1, ncation
13163 sumover_c = sumover_c + xc(jc)* &
13164 (zc(jc)+za(ja))**2/(zc(jc)*za(ja))*u1_c_a(jc,ja)
13165 enddo
13166
13167 sumover_a = sumover_a + xa(ja)* &
13168 ( (zm + za(ja))**2/(zm*za(ja))*u1_c_a(jm,ja) &
13169 -2.*sumover_c )
13170 enddo
13171
13172 term1 = xh2o*sumover_a
13173
13174 !--term2------------------------
13175 sumover_a = 0.0
13176 do ja = 1, nanion
13177
13178 sumover_c = 0.0
13179 do jc = 1, ncation
13180 sumover_c = sumover_c + xc(jc)*v1_c_a(jc,ja)
13181 enddo
13182
13183 sumover_a = sumover_a + xa(ja)* &
13184 ( v1_c_a(jm,ja) - 3.*sumover_c )
13185 enddo
13186
13187 term2 = 4.*xh2o**2 * sumover_a
13188
13189 !--term3------------------------
13190 sumover_a = 0.0
13191 do ja = 1, nanion
13192
13193 sumover_c = 0.0
13194 do jc = 1, ncation
13195 sumover_c = sumover_c + &
13196 ec(jc)*(zc(jc)+za(ja))/(zc(jc)*za(ja))*w1_c_a(jc,ja)
13197 enddo
13198
13199 sumover_a = sumover_a + ea(ja)* &
13200 ( (zm+za(ja))/za(ja)*w1_c_a(jm,ja) &
13201 -(zm/2. + 1/ff)*sumover_c )
13202 enddo
13203
13204 term3 = xh2o*sumover_a
13205
13206 !--term4-------------------------
13207 sumover_a = 0.0
13208 do ja = 1, nanion
13209
13210 sumoverp_c = 0.0
13211 do jc = 1, ncation
13212 if(jc.ne.jm)then
13213 sumoverp_c = sumoverp_c + ec(jc)* &
13214 (zc(jc)+za(ja))/(zc(jc)*za(ja))*w1_c_a(jc,ja)
13215
13216 endif
13217 enddo
13218
13219 sumover_a = sumover_a + ea(ja)* &
13220 ( (1-ec(jm)/2.)*(zm+za(ja))/za(ja)*w1_c_a(jm,ja) &
13221 -zm/2.*sumoverp_c )
13222
13223 enddo
13224
13225 term4 = -sumover_a
13226
13227 !--term5-------------------------
13228 sumover_a = 0.0
13229 do ja = 1, nanion
13230
13231 sumoverp_c = 0.0
13232 sumover_c_cp = 0.0
13233
13234 do jc = 1, ncation
13235 if(jc.ne.jm)then
13236 sumoverp_c = sumoverp_c + xc(jc)* &
13237 (2.*xc(jm)/xnuc(jm,ja) - xc(jc)/xnuc(jc,ja))* &
13238 uc_cp_a(jm,jc,ja)
13239 endif
13240
13241 do jcp = jc+1, ncation
13242 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
13243 (xc(jc)/xnuc(jc,ja) - xc(jcp)/xnuc(jcp,ja))* &
13244 uc_cp_a(jc,jcp,ja)
13245 enddo
13246
13247 enddo
13248
13249 sumover_a = sumover_a + sumoverp_c - 2.*sumover_c_cp
13250
13251 enddo
13252
13253 term5 = 2*sumover_a
13254
13255 !--term6-------------------------
13256 sumover_c = 0.0
13257 do jc = 1, ncation
13258
13259 sumover_a_ap = 0.0
13260 do ja = 1, nanion
13261 do jap = ja+1, nanion
13262
13263 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13264 ( xa(ja)/xnua(ja,jc) - xa(jap)/xnua(jap,jc) )* &
13265 ua_ap_c(ja,jap,jc)
13266
13267 enddo
13268 enddo
13269
13270 sumover_c = sumover_c + (2.*ec(jc) - emc(jm,jc))*sumover_a_ap
13271
13272 enddo
13273
13274 term6 = -2.*sumover_c
13275
13276 !--term7-------------------------
13277 sumover_a = 0.0
13278 do ja = 1, nanion
13279
13280 sumoverp_c = 0.0
13281 sumover_c_cp = 0.0
13282
13283 do jc = 1, ncation
13284 if(jm.ne.jc)then
13285 sumoverp_c = sumoverp_c + xc(jc)*wc_cp_a(jm,jc,ja)
13286 endif
13287
13288 do jcp = jc+1, ncation
13289 sumover_c_cp = sumover_c_cp + &
13290 xc(jc)*xc(jcp)*wc_cp_a(jc,jcp,ja)
13291 enddo
13292 enddo
13293
13294 sumover_a = sumover_a + ea(ja)*(sumoverp_c - sumover_c_cp)
13295
13296 enddo
13297
13298 term7 = 2.*sumover_a
13299
13300 !--term8-------------------------
13301 sumover_c = 0.0
13302 do jc = 1, ncation
13303
13304 sumover_a_ap = 0.0
13305 do ja = 1, nanion
13306 do jap = ja+1, nanion
13307
13308 sumover_a_ap = sumover_a_ap + &
13309 xa(ja)*xa(jap)*wa_ap_c(ja,jap,jc)
13310
13311 enddo
13312 enddo
13313
13314 sumover_c = sumover_c + (ec(jc) - emc(jm,jc))*sumover_a_ap
13315
13316 enddo
13317
13318 term8 = -2.*sumover_c
13319
13320 !--term9-------------------------
13321 sumover_a = 0.0
13322 do ja = 1, nanion
13323
13324 sumoverp_c = 0.0
13325 sumover_c_cp = 0.0
13326
13327 do jc = 1, ncation
13328 if(jm.ne.jc)then
13329 sumoverp_c = sumoverp_c + xc(jc)*q1_c_cp_a(jm,jc,ja)
13330 endif
13331
13332 do jcp = jc+1, ncation
13333 sumover_c_cp = sumover_c_cp + &
13334 xc(jc)*xc(jcp)*q1_c_cp_a(jc,jcp,ja)
13335 enddo
13336 enddo
13337
13338 sumover_a = sumover_a + ea(ja)*(sumoverp_c - 2.*sumover_c_cp)
13339
13340 enddo
13341
13342 term9 = 4.*xh2o*sumover_a
13343
13344 !--term10------------------------
13345 sumover_c = 0.0
13346 do jc = 1, ncation
13347
13348 sumover_a_ap = 0.0
13349
13350 do ja = 1, nanion
13351 do jap = ja+1, nanion
13352 sumover_a_ap = sumover_a_ap + &
13353 xa(ja)*xa(jap)*q1_a_ap_c(ja,jap,jc)
13354 enddo
13355 enddo
13356
13357 sumover_c = sumover_c + &
13358 (2.*ec(jc) - emc(jm,jc))*sumover_a_ap
13359
13360 enddo
13361
13362 term10 = -4.*xh2o*sumover_c
13363
13364 !--------------------------------
13365 lnf_s = term1 + term2 + term3 + term4 + term5 + &
13366 term6 + term7 + term8 + term9 + term10
13367
13368
13369
13370 ! long-range contributions (debye-huckel)
13371 zm2 = zc(jm)**2
13372 six = sqrt(ix)
13373
13374 !--term1-------------------------
13375 term1 = - zm2*ax*(2./rho*alog(1.+rho*six) + &
13376 six*(1.-2.*ix/zm2)/(1.+rho*six))
13377
13378 !--term2 & term3-----------------
13379 term2 = 0.0
13380 term3 = 0.0
13381 do jc = 1, ncation
13382 do ja = 1, nanion
13383 term2 = term2 + xc(jc)*xa(ja)*bc_a(jc,ja)* &
13384 ( zm2*gg(alpha_c_a(jc,ja)*six)/(2.*ix) + &
13385 (1-zm2/(2.*ix))*exp(-alpha_c_a(jc,ja)*six) )
13386
13387 term3 = term3 + xc(jc)*xa(ja)*b1_c_a(jc,ja)* &
13388 ( zm2*gg(alpha1_c_a(jc,ja)*six)/(2.*ix) + &
13389 (1-zm2/(2.*ix))*exp(-alpha1_c_a(jc,ja)*six) )
13390 enddo
13391 enddo
13392
13393 term2 = -term2
13394 term3 = -term3
13395
13396 !--term4 & term5-----------------
13397 term4 = 0.0
13398 term5 = 0.0
13399 do ja = 1, nanion
13400 term4=term4+xa(ja)*bc_a(jm,ja)*gg(alpha_c_a(jm,ja)*six)
13401 term5=term5+xa(ja)*b1_c_a(jm,ja)*gg(alpha1_c_a(jm,ja)*six)
13402 enddo
13403
13404 lnf_dh = term1 + term2 + term3 + term4 + term5
13405
13406
13407
13408 ! long-range contributions (higher order electrostatic)
13409
13410 !--term1-------------------------
13411 sumoverp_c = 0.0
13412 do jc = 1, ncation
13413 if(jc.ne.jm)then
13414 sumoverp_c = sumoverp_c + xc(jc)*( thetahoe(izm,izc(jc)) &
13415 - xc(jm)*(thetahoe(izm,izc(jc)) + &
13416 dthetahoe(izm,izc(jc))*(ix - zm2/2.)) )
13417 endif
13418 enddo
13419 term1 = 2.*sumoverp_c
13420
13421 !--term2-------------------------
13422 sumoverp_c_cp = 0.0
13423 do jc = 1, ncation
13424 if(jc.ne.jm)then
13425 do jcp = jc+1, ncation
13426 if(jcp.ne.jm)then
13427 sumoverp_c_cp = sumoverp_c_cp + xc(jc)*xc(jcp)* &
13428 ( thetahoe(izc(jc),izc(jcp)) + &
13429 dthetahoe(izc(jc),izc(jcp))*(ix-zm2/2.) )
13430 endif
13431 enddo
13432 endif
13433 enddo
13434 term2 = -2.*sumoverp_c_cp
13435
13436 !--term3-------------------------
13437 sumover_a_ap = 0.0
13438 do ja = 1, nanion
13439 do jap = ja+1, nanion
13440 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13441 ( thetahoe(iza(ja),iza(jap)) + &
13442 dthetahoe(iza(ja),iza(jap))*(ix-zm2/2.) )
13443 enddo
13444 enddo
13445 term3 = -2.*sumover_a_ap
13446
13447 !--------------------------------
13448 lnf_hoe = term1 + term2 + term3
13449
13450
13451
13452 !================================
13453 lnf = lnf_s + lnf_dh + lnf_hoe
13454 fm = exp(lnf)
13455
13456
13457 return
13458 end function fm
13459 !
13460 !
13461 !
13462 !===========================================================================
13463 !
13464 ! anion activity coefficient
13465 !
13466 !===========================================================================
13467 real function fx(jx)
13468 ! implicit none
13469 ! include 'mosaic.h'
13470 ! func arguments
13471 integer jx
13472 ! local variables
13473 integer jc, ja, jcp, jap, izx
13474 real term1, term2, term3, term4, term5, term6, term7, term8, &
13475 term9, term10, sumover_c_a, sumover_c_cp, sumover_a_ap, &
13476 sumover_a, sumover_c, sumoverp_a, sumoverp_c, &
13477 sumoverp_c_cp, lnf, lnf_s, lnf_dh, lnf_hoe, six, zx, zx2
13478 ! functions
13479 ! real gg
13480
13481
13482 ! short-range contributions
13483 zx = za(jx)
13484 izx = iza(jx)
13485
13486 !--term1------------------------ done
13487 sumover_c = 0.0
13488 do jc = 1, ncation
13489
13490 sumover_a = 0.0
13491 do ja = 1, nanion
13492 sumover_a = sumover_a + xa(ja)* &
13493 (za(ja)+zc(jc))**2/(za(ja)*zc(jc))*u1_c_a(jc,ja)
13494 enddo
13495
13496 sumover_c = sumover_c + xc(jc)* &
13497 ( (zx + zc(jc))**2/(zx*zc(jc))*u1_c_a(jc,jx) &
13498 -2.*sumover_a )
13499 enddo
13500
13501 term1 = xh2o*sumover_c
13502
13503 !--term2------------------------ done
13504 sumover_c = 0.0
13505 do jc = 1, ncation
13506
13507 sumover_a = 0.0
13508 do ja = 1, nanion
13509 sumover_a = sumover_a + xa(ja)*v1_c_a(jc,ja)
13510 enddo
13511
13512 sumover_c = sumover_c + xc(jc)* &
13513 ( v1_c_a(jc,jx) - 3.*sumover_a )
13514 enddo
13515
13516 term2 = 4.*xh2o**2 * sumover_c
13517
13518 !--term3------------------------ done
13519 sumover_c = 0.0
13520 do jc = 1, ncation
13521
13522 sumover_a = 0.0
13523 do ja = 1, nanion
13524 sumover_a = sumover_a + &
13525 ea(ja)*(za(ja)+zc(jc))/(za(ja)*zc(jc))*w1_c_a(jc,ja)
13526 enddo
13527
13528 sumover_c = sumover_c + ec(jc)* &
13529 ( (zx+zc(jc))/zc(jc)*w1_c_a(jc,jx) &
13530 -(zx/2. + 1/ff)*sumover_a )
13531 enddo
13532
13533 term3 = xh2o*sumover_c
13534
13535 !--term4------------------------- done
13536 sumover_c = 0.0
13537 do jc = 1, ncation
13538
13539 sumoverp_a = 0.0
13540 do ja = 1, nanion
13541 if(ja.ne.jx)then
13542 sumoverp_a = sumoverp_a + ea(ja)* &
13543 (za(ja)+zc(jc))/(za(ja)*zc(jc))*w1_c_a(jc,ja)
13544
13545 endif
13546 enddo
13547
13548 sumover_c = sumover_c + ec(jc)* &
13549 ( (1-ea(jx)/2.)*(zx+zc(jc))/zc(jc)*w1_c_a(jc,jx) &
13550 -zx/2.*sumoverp_a )
13551
13552 enddo
13553
13554 term4 = -sumover_c
13555
13556 !--term5------------------------- done
13557 sumover_c = 0.0
13558 do jc = 1, ncation
13559
13560 sumoverp_a = 0.0
13561 sumover_a_ap = 0.0
13562
13563 do ja = 1, nanion
13564 if(ja.ne.jx)then
13565 sumoverp_a = sumoverp_a + xa(ja)* &
13566 (2.*xa(jx)/xnua(jx,jc) - xa(ja)/xnua(ja,jc))* &
13567 ua_ap_c(jx,ja,jc)
13568 endif
13569
13570 do jap = ja+1, nanion
13571 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13572 (xa(ja)/xnua(ja,jc) - xa(jap)/xnua(jap,jc))* &
13573 ua_ap_c(ja,jap,jc)
13574 enddo
13575
13576 enddo
13577
13578 sumover_c = sumover_c + sumoverp_a - 2.*sumover_a_ap
13579
13580 enddo
13581
13582 term5 = 2.*sumover_c
13583
13584 !--term6------------------------- done
13585 sumover_a = 0.0
13586 do ja = 1, nanion
13587
13588 sumover_c_cp = 0.0
13589 do jc = 1, ncation
13590 do jcp = jc+1, ncation
13591
13592 sumover_c_cp = sumover_c_cp + xc(jc)*xc(jcp)* &
13593 ( xc(jc)/xnuc(jc,ja) - xc(jcp)/xnuc(jcp,ja) )* &
13594 uc_cp_a(jc,jcp,ja)
13595
13596 enddo
13597 enddo
13598
13599 sumover_a = sumover_a + (2.*ea(ja) - exa(jx,ja))*sumover_c_cp
13600
13601 enddo
13602
13603 term6 = -2.*sumover_a
13604
13605 !--term7------------------------- done
13606 sumover_c = 0.0
13607 do jc = 1, ncation
13608
13609 sumoverp_a = 0.0
13610 sumover_a_ap = 0.0
13611
13612 do ja = 1, nanion
13613 if(ja.ne.jx)then
13614 sumoverp_a = sumoverp_a + xa(ja)*wa_ap_c(jx,ja,jc)
13615 endif
13616
13617 do jap = ja+1, nanion
13618 sumover_a_ap = sumover_a_ap + &
13619 xa(ja)*xa(jap)*wa_ap_c(ja,jap,jc)
13620 enddo
13621 enddo
13622
13623 sumover_c = sumover_c + ec(jc)*(sumoverp_a - sumover_a_ap)
13624
13625 enddo
13626
13627 term7 = 2.*sumover_c
13628
13629 !--term8------------------------- done
13630 sumover_a = 0.0
13631 do ja = 1, nanion
13632
13633 sumover_c_cp = 0.0
13634 do jc = 1, ncation
13635 do jcp = jc+1, ncation
13636
13637 sumover_c_cp = sumover_c_cp + &
13638 xc(jc)*xc(jcp)*wc_cp_a(jc,jcp,ja)
13639
13640 enddo
13641 enddo
13642
13643 sumover_a = sumover_a + (ea(ja) - exa(jx,ja))*sumover_c_cp
13644
13645 enddo
13646
13647 term8 = -2.*sumover_a
13648
13649 !--term9------------------------- done
13650 sumover_c = 0.0
13651 do jc = 1, ncation
13652
13653 sumoverp_a = 0.0
13654 sumover_a_ap = 0.0
13655
13656 do ja = 1, nanion
13657 if(ja.ne.jx)then
13658 sumoverp_a = sumoverp_a + xa(ja)*q1_a_ap_c(jx,ja,jc)
13659 endif
13660
13661 do jap = ja+1, nanion
13662 sumover_a_ap = sumover_a_ap + &
13663 xa(ja)*xa(jap)*q1_a_ap_c(ja,jap,jc)
13664 enddo
13665 enddo
13666
13667 sumover_c = sumover_c + ec(jc)*(sumoverp_a - 2.*sumover_a_ap)
13668
13669 enddo
13670
13671 term9 = 4.*xh2o*sumover_c
13672
13673 !--term10------------------------ done
13674 sumover_a = 0.0
13675 do ja = 1, nanion
13676
13677 sumover_c_cp = 0.0
13678
13679 do jc = 1, ncation
13680 do jcp = jc+1, ncation
13681 sumover_c_cp = sumover_c_cp + &
13682 xc(jc)*xc(jcp)*q1_c_cp_a(jc,jcp,ja)
13683 enddo
13684 enddo
13685
13686 sumover_a = sumover_a + &
13687 (2.*ea(ja) - exa(jx,ja))*sumover_c_cp
13688
13689 enddo
13690
13691 term10 = -4.*xh2o*sumover_a
13692
13693 !--------------------------------
13694 lnf_s = term1 + term2 + term3 + term4 + term5 + &
13695 term6 + term7 + term8 + term9 + term10
13696
13697
13698 ! long-range contributions (debye-huckel)
13699 zx2 = za(jx)**2
13700 six = sqrt(ix)
13701
13702 !--term1-------------------------
13703 term1 = - zx2*ax*(2./rho*alog(1.+rho*six) + &
13704 six*(1.-2.*ix/zx2)/(1.+rho*six))
13705
13706 !--term2 & term3----------------- done
13707 term2 = 0.0
13708 term3 = 0.0
13709 do jc = 1, ncation
13710 do ja = 1, nanion
13711 term2 = term2 + xc(jc)*xa(ja)*bc_a(jc,ja)* &
13712 ( zx2*gg(alpha_c_a(jc,ja)*six)/(2.*ix) + &
13713 (1-zx2/(2.*ix))*exp(-alpha_c_a(jc,ja)*six) )
13714
13715 term3 = term3 + xc(jc)*xa(ja)*b1_c_a(jc,ja)* &
13716 ( zx2*gg(alpha1_c_a(jc,ja)*six)/(2.*ix) + &
13717 (1-zx2/(2.*ix))*exp(-alpha1_c_a(jc,ja)*six) )
13718 enddo
13719 enddo
13720
13721 term2 = -term2
13722 term3 = -term3
13723
13724 !--term4 & term5----------------- done
13725 term4 = 0.0
13726 term5 = 0.0
13727 do jc = 1, ncation
13728 term4=term4+xc(jc)*bc_a(jc,jx)*gg(alpha_c_a(jc,jx)*six)
13729 term5=term5+xc(jc)*b1_c_a(jc,jx)*gg(alpha1_c_a(jc,jx)*six)
13730 enddo
13731
13732 lnf_dh = term1 + term2 + term3 + term4 + term5
13733
13734
13735 ! long-range contributions (higher order electrostatic)
13736
13737 !--term1------------------------- done
13738 sumoverp_a = 0.0
13739 do ja = 1, nanion
13740 if(ja.ne.jx)then
13741 sumoverp_a = sumoverp_a + xa(ja)*( thetahoe(izx,iza(ja)) &
13742 - xa(jx)*(thetahoe(izx,iza(ja)) + &
13743 dthetahoe(izx,iza(ja))*(ix - zx2/2.)) )
13744 endif
13745 enddo
13746 term1 = 2.*sumoverp_a
13747
13748 !--term2-------------------------
13749 sumoverp_c_cp = 0.0
13750 do jc = 1, ncation
13751 do jcp = jc+1, ncation
13752 sumoverp_c_cp = sumoverp_c_cp + xc(jc)*xc(jcp)* &
13753 ( thetahoe(izc(jc),izc(jcp)) + &
13754 dthetahoe(izc(jc),izc(jcp))*(ix-zx2/2.) )
13755 enddo
13756 enddo
13757 term2 = -2.*sumoverp_c_cp
13758
13759 !--term3-------------------------
13760 sumover_a_ap = 0.0
13761 do ja = 1, nanion
13762 if(ja.ne.jx)then
13763 do jap = ja+1, nanion
13764 if(jap.ne.jx)then
13765 sumover_a_ap = sumover_a_ap + xa(ja)*xa(jap)* &
13766 ( thetahoe(iza(ja),iza(jap)) + &
13767 dthetahoe(iza(ja),iza(jap))*(ix-zx2/2.) )
13768 endif
13769 enddo
13770 endif
13771 enddo
13772 term3 = -2.*sumover_a_ap
13773
13774 !--------------------------------
13775 lnf_hoe = term1 + term2 + term3
13776
13777
13778 !================================
13779 lnf = lnf_s + lnf_dh + lnf_hoe
13780 fx = exp(lnf)
13781
13782 return
13783 end function fx
13784 !
13785 !
13786 !
13787 !===========================================================================
13788 !
13789 ! miscellaneous functions used in psc
13790 !
13791 !===========================================================================
13792
13793 real function gg(x)
13794 ! implicit none
13795 real x
13796
13797 if(x.ne.0.)then
13798 gg = 2.*(1. - (1.+x)*exp(-x))/x**2
13799 endif
13800 return
13801 end function gg
13802 !
13803 !
13804 !
13805 !-----------------------------
13806 real function fn_thetahoe(izi,izj)
13807 ! implicit none
13808 ! include 'mosaic.h'
13809 ! func arguments
13810 integer izi, izj
13811 ! local variables
13812 real zi, zj, dum, xij, xii, xjj
13813 ! functions
13814 ! real xj
13815
13816
13817 if(izi.eq.izj)then
13818 fn_thetahoe = 0.0
13819 else
13820 zi = float(izi)
13821 zj = float(izj)
13822 dum = 6.*ax*sqrt(ix)
13823 xij = zi*zj*dum
13824 xii = zi*zi*dum
13825 xjj = zj*zj*dum
13826 fn_thetahoe=(zi*zj/(4.*ix))*(xj(xij) - .5*xj(xii) - .5*xj(xjj))
13827 endif
13828
13829 return
13830 end function fn_thetahoe
13831 !
13832 !
13833 !
13834 !-----------------------------
13835 real function fn_dthetahoe(izi,izj)
13836 ! implicit none
13837 ! include 'mosaic.h'
13838 ! func arguments
13839 integer izi, izj
13840 ! local variables
13841 real zi, zj, dum, xij, xii, xjj
13842 ! functions
13843 ! real xj1
13844
13845
13846 if(izi.eq.izj)then
13847 fn_dthetahoe = 0.0
13848 else
13849 zi = float(izi)
13850 zj = float(izj)
13851 dum = 6.*ax*sqrt(ix)
13852 xij = zi*zj*dum
13853 xii = zi*zi*dum
13854 xjj = zj*zj*dum
13855 fn_dthetahoe = -thetahoe(izi,izj)/ix + (zi*zj/(8.*ix**2))* &
13856 (xij*xj1(xij) -.5*xii*xj1(xii) -.5*xjj*xj1(xjj))
13857 endif
13858
13859 return
13860 end function fn_dthetahoe
13861 !
13862 !
13863 !
13864 !-----------------------------
13865 real function xj(x)
13866 ! implicit none
13867 ! func arguments
13868 real x
13869 ! local variables
13870 real c1, c2, c3, c4
13871
13872 c1 = 4.581
13873 c2 = -0.7237
13874 c3 = -0.0120
13875 c4 = 0.528
13876 xj = x/(4. + (c1*x**c2) * exp(c3*x**c4))
13877
13878 return
13879 end function xj
13880 !
13881 !
13882 !
13883 !-----------------------------
13884 real function xj1(x)
13885 ! implicit none
13886 ! func arguments
13887 real x
13888 ! local variables
13889 real c1, c2, c3, c4
13890
13891 c1 = 4.581
13892 c2 = -0.7237
13893 c3 = -0.0120
13894 c4 = 0.528
13895 xj1 = 1./(4. + c1*exp(c3*x**c4)*x**c2) - &
13896 c1*exp(c3*x**c4)*x**c2*(c2 + c3*c4*x**c4)/ &
13897 (4. + c1*exp(c3*x**c4)*x**c2)**2
13898
13899 return
13900 end function xj1
13901 !======================================================================
13902
13903
13904
13905
13906
13907
13908
13909 !***********************************************************************
13910 ! called only once per entire simulation to load gas and aerosol
13911 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
13912 !
13913 ! author: rahul a. zaveri
13914 ! update: jan 2005
13915 !-----------------------------------------------------------------------
13916 subroutine load_mosaic_parameters
13917 ! implicit none
13918 ! include 'v33com2'
13919 ! include 'mosaic.h'
13920 ! local variables
13921 integer je, ja, jc, j_index, ibin
13922 real tt, tdum
13923 logical first
13924 save first
13925 data first/.true./
13926
13927
13928
13929
13930
13931
13932 if(first)then
13933 first=.false.
13934
13935 !----------------------------------------------------------------
13936 ! control settings
13937 alpha_asteem = 0.03 ! choose a value between 0.01 and 0.05
13938 msize_framework = msection ! mmodal or msection
13939 mactivity_coeff = mmtem ! mmtem, mpsc, mkm, mbrom
13940 mdynamic_solver = masteem ! masteem, masceem
13941 mgas_aer_xfer = mon ! mon, moff
13942 madapt_alpha = mon ! mon, moff
13943 !----------------------------------------------------------------
13944 !
13945 !
13946 jasteem_call = 0 ! reset
13947 jmesa_call = 0 ! reset
13948 iter_mesa = 0.0 ! reset
13949 do ibin = 1, nbin_a
13950 steps_asteem(ibin) = 0.0 ! reset
13951 steps_asteem_max(ibin) = 0.0 ! reset
13952 enddo
13953
13954 ! set gas and aerosol indices
13955 !
13956 ! gas
13957 ih2so4_g = 1
13958 ihno3_g = 2
13959 ihcl_g = 3
13960 inh3_g = 4
13961 ! isoa_g = 5 ! currently not used
13962 ! imsa_g = 6 ! currently not used
13963 ! ico2_g = 7 ! currently not used
13964 !
13965 ! aerosol (local): used for total species
13966 iso4_a = 1 ! <-> ih2so4_g
13967 ino3_a = 2 ! <-> ihno3_g
13968 icl_a = 3 ! <-> ihcl_g
13969 inh4_a = 4 ! <-> inh3_g
13970 ioc_a = 5 ! <-> isoa
13971 imsa_a = 6 ! <-> imsa
13972 ico3_a = 7 ! <-> ico2
13973 ina_a = 8
13974 ica_a = 9
13975 ibc_a = 10
13976 ioin_a = 11
13977 !
13978 ! electrolyte indices (used for water content calculations)
13979 ! these indices are order sensitive
13980 jnh4so4 = 1 ! soluble
13981 jlvcite = 2 ! soluble
13982 jnh4hso4 = 3 ! soluble
13983 jnh4no3 = 4 ! soluble
13984 jnh4cl = 5 ! soluble
13985 jna2so4 = 6 ! soluble
13986 jna3hso4 = 7 ! soluble
13987 jnahso4 = 8 ! soluble
13988 jnano3 = 9 ! soluble
13989 jnacl = 10 ! soluble
13990 jcano3 = 11 ! soluble
13991 jcacl2 = 12 ! soluble nsalt
13992 jh2so4 = 13 ! soluble
13993 jhno3 = 14 ! soluble
13994 jhcl = 15 ! soluble
13995 jhhso4 = 16 ! soluble
13996 jcaso4 = 17 ! insoluble
13997 jcaco3 = 18 ! insoluble
13998 joc = 19 ! insoluble - part of naercomp
13999 jbc = 20 ! insoluble - part of naercomp
14000 join = 21 ! insoluble - part of naercomp
14001 jh2o = 22 ! water - part of naercomp
14002
14003
14004 ! local aerosol ions
14005 ! cations
14006 jc_h = 1
14007 jc_nh4 = 2
14008 jc_na = 3
14009 jc_ca = 4
14010 !
14011 ! anions
14012 ja_hso4 = 1
14013 ja_so4 = 2
14014 ja_no3 = 3
14015 ja_cl = 4
14016 ! ja_co3 = 5
14017
14018 !--------------------------------------------------------------------
14019 ! names of aer species
14020 aer_name(iso4_a) = "so4"
14021 aer_name(ino3_a) = "no3"
14022 aer_name(icl_a) = "cl "
14023 aer_name(inh4_a) = "nh4"
14024 aer_name(ioc_a) = "oc "
14025 aer_name(imsa_a) = "msa"
14026 aer_name(ico3_a) = "co3"
14027 aer_name(ina_a) = "na "
14028 aer_name(ica_a) = "ca "
14029 aer_name(ibc_a) = "bc "
14030 aer_name(ioin_a) = "oin"
14031
14032 ! names of gas species
14033 gas_name(1) = "h2so4"
14034 gas_name(2) = "hno3 "
14035 gas_name(3) = "hcl "
14036 gas_name(4) = "nh3 "
14037
14038 ! names of electrolytes
14039 ename(jnh4so4) = "amso4"
14040 ename(jlvcite) = "(nh4)3h(so4)2"
14041 ename(jnh4hso4)= "nh4hso4"
14042 ename(jnh4no3) = "nh4no3"
14043 ename(jnh4cl) = "nh4cl"
14044 ename(jnacl) = "nacl"
14045 ename(jnano3) = "nano3"
14046 ename(jna2so4) = "na2so4"
14047 ename(jna3hso4)= "na3h(so4)2"
14048 ename(jnahso4) = "nahso4"
14049 ename(jcaso4) = "caso4"
14050 ename(jcano3) = "ca(no3)2"
14051 ename(jcacl2) = "cacl2"
14052 ename(jcaco3) = "caco3"
14053 ename(jh2so4) = "h2so4"
14054 ename(jhhso4) = "hhso4"
14055 ename(jhno3) = "hno3"
14056 ename(jhcl) = "hcl"
14057
14058 ! molecular weights of electrolytes
14059 mw_electrolyte(jnh4so4) = 132.0
14060 mw_electrolyte(jlvcite) = 247.0
14061 mw_electrolyte(jnh4hso4)= 115.0
14062 mw_electrolyte(jnh4no3) = 80.0
14063 mw_electrolyte(jnh4cl) = 53.5
14064 mw_electrolyte(jnacl) = 58.5
14065 mw_electrolyte(jnano3) = 85.0
14066 mw_electrolyte(jna2so4) = 142.0
14067 mw_electrolyte(jna3hso4)= 262.0
14068 mw_electrolyte(jnahso4) = 120.0
14069 mw_electrolyte(jcaso4) = 136.0
14070 mw_electrolyte(jcano3) = 164.0
14071 mw_electrolyte(jcacl2) = 111.0
14072 mw_electrolyte(jcaco3) = 100.0
14073 mw_electrolyte(jh2so4) = 98.0
14074 mw_electrolyte(jhno3) = 63.0
14075 mw_electrolyte(jhcl) = 36.5
14076
14077
14078 ! molecular weights of ions [g/mol]
14079 mw_c(jc_h) = 1.0
14080 mw_c(jc_nh4)= 18.0
14081 mw_c(jc_na) = 23.0
14082 mw_c(jc_ca) = 40.0
14083
14084 mw_a(ja_so4) = 96.0
14085 mw_a(ja_hso4)= 97.0
14086 mw_a(ja_no3) = 62.0
14087 mw_a(ja_cl) = 35.5
14088
14089
14090 ! densities of pure electrolytes in g/cc
14091 dens_electrolyte(jnh4so4) = 1.77
14092 dens_electrolyte(jlvcite) = 1.77
14093 dens_electrolyte(jnh4hso4) = 1.78
14094 dens_electrolyte(jnh4no3) = 1.72
14095 dens_electrolyte(jnh4cl) = 1.53
14096 dens_electrolyte(jnacl) = 2.17
14097 dens_electrolyte(jnano3) = 2.26
14098 dens_electrolyte(jna2so4) = 2.68
14099 dens_electrolyte(jna3hso4) = 2.50
14100 dens_electrolyte(jnahso4) = 2.43
14101 dens_electrolyte(jcaso4) = 2.61
14102 dens_electrolyte(jcano3) = 2.50
14103 dens_electrolyte(jcacl2) = 2.15
14104 dens_electrolyte(jcaco3) = 2.80
14105 dens_electrolyte(jh2so4) = 1.84
14106 dens_electrolyte(jhhso4) = 1.84
14107 dens_electrolyte(jhno3) = 1.50
14108 dens_electrolyte(jhcl) = 1.19
14109
14110 do je = 1, nelectrolyte
14111 dens_electrolyte(je) = 1.8
14112 enddo
14113
14114 ! densities of compounds in g/cc
14115 dens_comp_a(jnh4so4) = 1.77
14116 dens_comp_a(jlvcite) = 1.77
14117 dens_comp_a(jnh4hso4) = 1.78
14118 dens_comp_a(jnh4no3) = 1.72
14119 dens_comp_a(jnh4cl) = 1.53
14120 dens_comp_a(jnacl) = 2.17
14121 dens_comp_a(jnano3) = 2.26
14122 dens_comp_a(jna2so4) = 2.68
14123 dens_comp_a(jna3hso4) = 2.50
14124 dens_comp_a(jnahso4) = 2.43
14125 dens_comp_a(jcaso4) = 2.61
14126 dens_comp_a(jcano3) = 2.50
14127 dens_comp_a(jcacl2) = 2.15
14128 dens_comp_a(jcaco3) = 2.80
14129 dens_comp_a(jh2so4) = 1.84
14130 dens_comp_a(jhhso4) = 1.84
14131 dens_comp_a(jhno3) = 1.50
14132 dens_comp_a(jhcl) = 1.19
14133 dens_comp_a(joc) = 1.00
14134 dens_comp_a(jbc) = 1.70
14135 dens_comp_a(join) = 2.60
14136 dens_comp_a(jh2o) = 1.00
14137
14138 do je = 1, naercomp
14139 dens_comp_a(je) = 1.8
14140 enddo
14141
14142 ! molecular weights of generic aerosol species
14143 mw_aer_mac(iso4_a) = 96.0
14144 mw_aer_mac(ino3_a) = 62.0
14145 mw_aer_mac(icl_a) = 35.5
14146 mw_aer_mac(imsa_a) = 96.0
14147 mw_aer_mac(ico3_a) = 60.0
14148 mw_aer_mac(inh4_a) = 18.0
14149 mw_aer_mac(ina_a) = 23.0
14150 mw_aer_mac(ica_a) = 40.0
14151 mw_aer_mac(ioin_a) = 1.0 ! not used
14152 mw_aer_mac(ioc_a) = 1.0 ! not used
14153 mw_aer_mac(ibc_a) = 1.0 ! not used
14154
14155 ! molecular weights of compounds
14156 mw_comp_a(jnh4so4) = 132.0
14157 mw_comp_a(jlvcite) = 247.0
14158 mw_comp_a(jnh4hso4)= 115.0
14159 mw_comp_a(jnh4no3) = 80.0
14160 mw_comp_a(jnh4cl) = 53.5
14161 mw_comp_a(jnacl) = 58.5
14162 mw_comp_a(jnano3) = 85.0
14163 mw_comp_a(jna2so4) = 142.0
14164 mw_comp_a(jna3hso4)= 262.0
14165 mw_comp_a(jnahso4) = 120.0
14166 mw_comp_a(jcaso4) = 136.0
14167 mw_comp_a(jcano3) = 164.0
14168 mw_comp_a(jcacl2) = 111.0
14169 mw_comp_a(jcaco3) = 100.0
14170 mw_comp_a(jh2so4) = 98.0
14171 mw_comp_a(jhhso4) = 98.0
14172 mw_comp_a(jhno3) = 63.0
14173 mw_comp_a(jhcl) = 36.5
14174 mw_comp_a(joc) = 1.0
14175 mw_comp_a(jbc) = 1.0
14176 mw_comp_a(join) = 1.0
14177 mw_comp_a(jh2o) = 18.0
14178
14179 ! densities of generic aerosol species
14180 dens_aer_mac(iso4_a) = 1.0 ! not used
14181 dens_aer_mac(ino3_a) = 1.0 ! not used
14182 dens_aer_mac(icl_a) = 1.0 ! not used
14183 dens_aer_mac(imsa_a) = 1.0 ! not used
14184 dens_aer_mac(ico3_a) = 1.0 ! not used
14185 dens_aer_mac(inh4_a) = 1.0 ! not used
14186 dens_aer_mac(ina_a) = 1.0 ! not used
14187 dens_aer_mac(ica_a) = 1.0 ! not used
14188 dens_aer_mac(ioin_a) = 2.6 ! used
14189 dens_aer_mac(ioc_a) = 1.0 ! used
14190 dens_aer_mac(ibc_a) = 1.7 ! used
14191
14192 ! refractive index
14193 ref_index_a(jnh4so4) = cmplx(1.52,0.)
14194 ref_index_a(jlvcite) = cmplx(1.50,0.)
14195 ref_index_a(jnh4hso4)= cmplx(1.47,0.)
14196 ref_index_a(jnh4no3) = cmplx(1.50,0.)
14197 ref_index_a(jnh4cl) = cmplx(1.50,0.)
14198 ref_index_a(jnacl) = cmplx(1.45,0.)
14199 ref_index_a(jnano3) = cmplx(1.50,0.)
14200 ref_index_a(jna2so4) = cmplx(1.50,0.)
14201 ref_index_a(jna3hso4)= cmplx(1.50,0.)
14202 ref_index_a(jnahso4) = cmplx(1.50,0.)
14203 ref_index_a(jcaso4) = cmplx(1.56,0.006)
14204 ref_index_a(jcano3) = cmplx(1.56,0.006)
14205 ref_index_a(jcacl2) = cmplx(1.52,0.006)
14206 ref_index_a(jcaco3) = cmplx(1.68,0.006)
14207 ref_index_a(jh2so4) = cmplx(1.43,0.)
14208 ref_index_a(jhhso4) = cmplx(1.43,0.)
14209 ref_index_a(jhno3) = cmplx(1.50,0.)
14210 ref_index_a(jhcl) = cmplx(1.50,0.)
14211 ref_index_a(joc) = cmplx(1.45,0.)
14212 ref_index_a(jbc) = cmplx(1.82,0.74)
14213 ref_index_a(join) = cmplx(1.55,0.006)
14214 ref_index_a(jh2o) = cmplx(1.33,0.)
14215
14216 ! jsalt_index
14217 jsalt_index(jnh4so4) = 5 ! as
14218 jsalt_index(jlvcite) = 2 ! lv
14219 jsalt_index(jnh4hso4)= 1 ! ab
14220 jsalt_index(jnh4no3) = 2 ! an
14221 jsalt_index(jnh4cl) = 1 ! ac
14222 jsalt_index(jna2so4) = 60 ! ss
14223 jsalt_index(jnahso4) = 10 ! sb
14224 jsalt_index(jnano3) = 40 ! sn
14225 jsalt_index(jnacl) = 10 ! sc
14226 jsalt_index(jcano3) = 120 ! cn
14227 jsalt_index(jcacl2) = 80 ! cc
14228
14229 ! aerosol indices
14230 ! ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
14231 ! ab = 1, lv = 2, sb = 10
14232 !
14233 ! sulfate-poor domain
14234 jsulf_poor(1) = 1 ! ac
14235 jsulf_poor(2) = 2 ! an
14236 jsulf_poor(5) = 3 ! as
14237 jsulf_poor(10) = 4 ! sc
14238 jsulf_poor(40) = 5 ! sn
14239 jsulf_poor(60) = 6 ! ss
14240 jsulf_poor(80) = 7 ! cc
14241 jsulf_poor(120) = 8 ! cn
14242 jsulf_poor(3) = 9 ! an + ac
14243 jsulf_poor(6) = 10 ! as + ac
14244 jsulf_poor(7) = 11 ! as + an
14245 jsulf_poor(8) = 12 ! as + an + ac
14246 jsulf_poor(11) = 13 ! sc + ac
14247 jsulf_poor(41) = 14 ! sn + ac
14248 jsulf_poor(42) = 15 ! sn + an
14249 jsulf_poor(43) = 16 ! sn + an + ac
14250 jsulf_poor(50) = 17 ! sn + sc
14251 jsulf_poor(51) = 18 ! sn + sc + ac
14252 jsulf_poor(61) = 19 ! ss + ac
14253 jsulf_poor(62) = 20 ! ss + an
14254 jsulf_poor(63) = 21 ! ss + an + ac
14255 jsulf_poor(65) = 22 ! ss + as
14256 jsulf_poor(66) = 23 ! ss + as + ac
14257 jsulf_poor(67) = 24 ! ss + as + an
14258 jsulf_poor(68) = 25 ! ss + as + an + ac
14259 jsulf_poor(70) = 26 ! ss + sc
14260 jsulf_poor(71) = 27 ! ss + sc + ac
14261 jsulf_poor(100) = 28 ! ss + sn
14262 jsulf_poor(101) = 29 ! ss + sn + ac
14263 jsulf_poor(102) = 30 ! ss + sn + an
14264 jsulf_poor(103) = 31 ! ss + sn + an + ac
14265 jsulf_poor(110) = 32 ! ss + sn + sc
14266 jsulf_poor(111) = 33 ! ss + sn + sc + ac
14267 jsulf_poor(81) = 34 ! cc + ac
14268 jsulf_poor(90) = 35 ! cc + sc
14269 jsulf_poor(91) = 36 ! cc + sc + ac
14270 jsulf_poor(121) = 37 ! cn + ac
14271 jsulf_poor(122) = 38 ! cn + an
14272 jsulf_poor(123) = 39 ! cn + an + ac
14273 jsulf_poor(130) = 40 ! cn + sc
14274 jsulf_poor(131) = 41 ! cn + sc + ac
14275 jsulf_poor(160) = 42 ! cn + sn
14276 jsulf_poor(161) = 43 ! cn + sn + ac
14277 jsulf_poor(162) = 44 ! cn + sn + an
14278 jsulf_poor(163) = 45 ! cn + sn + an + ac
14279 jsulf_poor(170) = 46 ! cn + sn + sc
14280 jsulf_poor(171) = 47 ! cn + sn + sc + ac
14281 jsulf_poor(200) = 48 ! cn + cc
14282 jsulf_poor(201) = 49 ! cn + cc + ac
14283 jsulf_poor(210) = 50 ! cn + cc + sc
14284 jsulf_poor(211) = 51 ! cn + cc + sc + ac
14285 !
14286 ! sulfate-rich domain
14287 jsulf_rich(1) = 52 ! ab
14288 jsulf_rich(2) = 53 ! lv
14289 jsulf_rich(10) = 54 ! sb
14290 jsulf_rich(3) = 55 ! ab + lv
14291 jsulf_rich(7) = 56 ! as + lv
14292 jsulf_rich(70) = 57 ! ss + sb
14293 jsulf_rich(62) = 58 ! ss + lv
14294 jsulf_rich(67) = 59 ! ss + as + lv
14295 jsulf_rich(61) = 60 ! ss + ab
14296 jsulf_rich(63) = 61 ! ss + lv + ab
14297 jsulf_rich(11) = 62 ! sb + ab
14298 jsulf_rich(71) = 63 ! ss + sb + ab
14299 jsulf_rich(5) = 3 ! as
14300 jsulf_rich(60) = 6 ! ss
14301 jsulf_rich(65) = 22 ! ss + as
14302
14303
14304
14305 !
14306 ! polynomial coefficients for binary molality (used in zsr equation)
14307 !
14308 !
14309 ! a_zsr for aw < 0.97
14310 !
14311 ! (nh4)2so4
14312 je = jnh4so4
14313 a_zsr(1,je) = 1.30894
14314 a_zsr(2,je) = -7.09922
14315 a_zsr(3,je) = 20.62831
14316 a_zsr(4,je) = -32.19965
14317 a_zsr(5,je) = 25.17026
14318 a_zsr(6,je) = -7.81632
14319 aw_min(je) = 0.1
14320 !
14321 ! (nh4)3h(so4)2
14322 je = jlvcite
14323 a_zsr(1,je) = 1.10725
14324 a_zsr(2,je) = -5.17978
14325 a_zsr(3,je) = 12.29534
14326 a_zsr(4,je) = -16.32545
14327 a_zsr(5,je) = 11.29274
14328 a_zsr(6,je) = -3.19164
14329 aw_min(je) = 0.1
14330 !
14331 ! nh4hso4
14332 je = jnh4hso4
14333 a_zsr(1,je) = 1.15510
14334 a_zsr(2,je) = -3.20815
14335 a_zsr(3,je) = 2.71141
14336 a_zsr(4,je) = 2.01155
14337 a_zsr(5,je) = -4.71014
14338 a_zsr(6,je) = 2.04616
14339 aw_min(je) = 0.1
14340 !
14341 ! nh4no3
14342 je = jnh4no3
14343 a_zsr(1,je) = 0.43507
14344 a_zsr(2,je) = 6.38220
14345 a_zsr(3,je) = -30.19797
14346 a_zsr(4,je) = 53.36470
14347 a_zsr(5,je) = -43.44203
14348 a_zsr(6,je) = 13.46158
14349 aw_min(je) = 0.1
14350 !
14351 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
14352 je = jnh4cl
14353 a_zsr(1,je) = 0.45309
14354 a_zsr(2,je) = 2.65606
14355 a_zsr(3,je) = -14.7730
14356 a_zsr(4,je) = 26.2936
14357 a_zsr(5,je) = -20.5735
14358 a_zsr(6,je) = 5.94255
14359 aw_min(je) = 0.1
14360 !
14361 ! nacl
14362 je = jnacl
14363 a_zsr(1,je) = 0.42922
14364 a_zsr(2,je) = -1.17718
14365 a_zsr(3,je) = 2.80208
14366 a_zsr(4,je) = -4.51097
14367 a_zsr(5,je) = 3.76963
14368 a_zsr(6,je) = -1.31359
14369 aw_min(je) = 0.1
14370 !
14371 ! nano3
14372 je = jnano3
14373 a_zsr(1,je) = 1.34966
14374 a_zsr(2,je) = -5.20116
14375 a_zsr(3,je) = 11.49011
14376 a_zsr(4,je) = -14.41380
14377 a_zsr(5,je) = 9.07037
14378 a_zsr(6,je) = -2.29769
14379 aw_min(je) = 0.1
14380 !
14381 ! na2so4
14382 je = jna2so4
14383 a_zsr(1,je) = 0.39888
14384 a_zsr(2,je) = -1.27150
14385 a_zsr(3,je) = 3.42792
14386 a_zsr(4,je) = -5.92632
14387 a_zsr(5,je) = 5.33351
14388 a_zsr(6,je) = -1.96541
14389 aw_min(je) = 0.1
14390 !
14391 ! na3h(so4)2 added on 1/14/2004
14392 je = jna3hso4
14393 a_zsr(1,je) = 0.31480
14394 a_zsr(2,je) = -1.01087
14395 a_zsr(3,je) = 2.44029
14396 a_zsr(4,je) = -3.66095
14397 a_zsr(5,je) = 2.77632
14398 a_zsr(6,je) = -0.86058
14399 aw_min(je) = 0.1
14400 !
14401 ! nahso4
14402 je = jnahso4
14403 a_zsr(1,je) = 0.62764
14404 a_zsr(2,je) = -1.63520
14405 a_zsr(3,je) = 4.62531
14406 a_zsr(4,je) = -10.06925
14407 a_zsr(5,je) = 10.33547
14408 a_zsr(6,je) = -3.88729
14409 aw_min(je) = 0.1
14410 !
14411 ! ca(no3)2
14412 je = jcano3
14413 a_zsr(1,je) = 0.38895
14414 a_zsr(2,je) = -1.16013
14415 a_zsr(3,je) = 2.16819
14416 a_zsr(4,je) = -2.23079
14417 a_zsr(5,je) = 1.00268
14418 a_zsr(6,je) = -0.16923
14419 aw_min(je) = 0.1
14420 !
14421 ! cacl2: kim and seinfeld
14422 je = jcacl2
14423 a_zsr(1,je) = 0.29891
14424 a_zsr(2,je) = -1.31104
14425 a_zsr(3,je) = 3.68759
14426 a_zsr(4,je) = -5.81708
14427 a_zsr(5,je) = 4.67520
14428 a_zsr(6,je) = -1.53223
14429 aw_min(je) = 0.1
14430 !
14431 ! h2so4
14432 je = jh2so4
14433 a_zsr(1,je) = 0.32751
14434 a_zsr(2,je) = -1.00692
14435 a_zsr(3,je) = 2.59750
14436 a_zsr(4,je) = -4.40014
14437 a_zsr(5,je) = 3.88212
14438 a_zsr(6,je) = -1.39916
14439 aw_min(je) = 0.1
14440 !
14441 ! hhso4
14442 je = jhhso4
14443 a_zsr(1,je) = 0.32751
14444 a_zsr(2,je) = -1.00692
14445 a_zsr(3,je) = 2.59750
14446 a_zsr(4,je) = -4.40014
14447 a_zsr(5,je) = 3.88212
14448 a_zsr(6,je) = -1.39916
14449 aw_min(je) = 1.0
14450 !
14451 ! hno3
14452 je = jhno3
14453 a_zsr(1,je) = 0.75876
14454 a_zsr(2,je) = -3.31529
14455 a_zsr(3,je) = 9.26392
14456 a_zsr(4,je) = -14.89799
14457 a_zsr(5,je) = 12.08781
14458 a_zsr(6,je) = -3.89958
14459 aw_min(je) = 0.1
14460 !
14461 ! hcl
14462 je = jhcl
14463 a_zsr(1,je) = 0.31133
14464 a_zsr(2,je) = -0.79688
14465 a_zsr(3,je) = 1.93995
14466 a_zsr(4,je) = -3.31582
14467 a_zsr(5,je) = 2.93513
14468 a_zsr(6,je) = -1.07268
14469 aw_min(je) = 0.1
14470 !
14471 ! caso4
14472 je = jcaso4
14473 a_zsr(1,je) = 0.0
14474 a_zsr(2,je) = 0.0
14475 a_zsr(3,je) = 0.0
14476 a_zsr(4,je) = 0.0
14477 a_zsr(5,je) = 0.0
14478 a_zsr(6,je) = 0.0
14479 aw_min(je) = 1.0
14480 !
14481 ! caco3
14482 je = jcaco3
14483 a_zsr(1,je) = 0.0
14484 a_zsr(2,je) = 0.0
14485 a_zsr(3,je) = 0.0
14486 a_zsr(4,je) = 0.0
14487 a_zsr(5,je) = 0.0
14488 a_zsr(6,je) = 0.0
14489 aw_min(je) = 1.0
14490
14491
14492
14493 !-------------------------------------------
14494 ! b_zsr for aw => 0.97 to 0.99999
14495 !
14496 ! (nh4)2so4
14497 b_zsr(jnh4so4) = 28.0811
14498 !
14499 ! (nh4)3h(so4)2
14500 b_zsr(jlvcite) = 14.7178
14501 !
14502 ! nh4hso4
14503 b_zsr(jnh4hso4) = 29.4779
14504 !
14505 ! nh4no3
14506 b_zsr(jnh4no3) = 33.4049
14507 !
14508 ! nh4cl
14509 b_zsr(jnh4cl) = 30.8888
14510 !
14511 ! nacl
14512 b_zsr(jnacl) = 29.8375
14513 !
14514 ! nano3
14515 b_zsr(jnano3) = 32.2756
14516 !
14517 ! na2so4
14518 b_zsr(jna2so4) = 27.6889
14519 !
14520 ! na3h(so4)2
14521 b_zsr(jna3hso4) = 14.2184
14522 !
14523 ! nahso4
14524 b_zsr(jnahso4) = 28.3367
14525 !
14526 ! ca(no3)2
14527 b_zsr(jcano3) = 18.3661
14528 !
14529 ! cacl2
14530 b_zsr(jcacl2) = 20.8792
14531 !
14532 ! h2so4
14533 b_zsr(jh2so4) = 26.7347
14534 !
14535 ! hhso4
14536 b_zsr(jhhso4) = 26.7347
14537 !
14538 ! hno3
14539 b_zsr(jhno3) = 28.8257
14540 !
14541 ! hcl
14542 b_zsr(jhcl) = 27.7108
14543 !
14544 ! caso4
14545 b_zsr(jcaso4) = 0.0
14546 !
14547 ! caco3
14548 b_zsr(jcaco3) = 0.0
14549
14550
14551
14552
14553
14554
14555 !-----------------------------------------------------------
14556 ! coefficients for activity coefficient polynomials (kusik and meissner)
14557 !
14558 ! log(gamma0) = b1*im^0.5 + b2*im + b3*im^2 + b4*im^3 + b5*im^4
14559 !
14560 ! revised coefficients on nov 14, 2003.
14561 !
14562 !-----------------------------------------------------------
14563 ! nh4no3
14564 je = jnh4no3
14565 b_km(1,je) = -0.267009
14566 b_km(2,je) = 0.0202668
14567 b_km(3,je) = -0.0000942908
14568 b_km(4,je) = 3.07824e-07
14569 b_km(5,je) = -3.73474e-10
14570 im_max(je)= 356.62
14571 !
14572 ! nh4cl
14573 je = jnh4cl
14574 b_km(1,je) = -0.266786
14575 b_km(2,je) = 0.0777832
14576 b_km(3,je) = -0.00217383
14577 b_km(4,je) = 3.16802e-05
14578 b_km(5,je) = -1.69576e-07
14579 im_max(je)= 74.4
14580 !
14581 ! (nh4)2so4
14582 je = jnh4so4
14583 b_km(1,je) = -0.519781
14584 b_km(2,je) = 0.0804842
14585 b_km(3,je) = -0.00072761
14586 b_km(4,je) = 4.27569e-06
14587 b_km(5,je) = -9.84832e-09
14588 im_max(je)= 162.84
14589 !
14590 ! nacl
14591 je = jnacl
14592 b_km(1,je) = -0.319457
14593 b_km(2,je) = 0.140217
14594 b_km(3,je) = -0.00171166
14595 b_km(4,je) = -5.85982e-06
14596 b_km(5,je) = 2.88269e-07
14597 im_max(je)= 28.01
14598 !
14599 ! nano3
14600 je = jnano3
14601 b_km(1,je) = -0.290263
14602 b_km(2,je) = 0.0493945
14603 b_km(3,je) = -0.000741747
14604 b_km(4,je) = 6.81616e-06
14605 b_km(5,je) = -2.38311e-08
14606 im_max(je)= 111.43
14607 !
14608 ! na2so4
14609 je = jna2so4
14610 b_km(1,je) = -0.58568
14611 b_km(2,je) = 0.107867
14612 b_km(3,je) = -0.000900192
14613 b_km(4,je) = 7.4922e-06
14614 b_km(5,je) = -4.72199e-08
14615 im_max(je)= 53.22
14616 !
14617 ! cacl2 (psc92: revised on 11/27/2003)
14618 je = jcacl2
14619 b_km(1,je) = -0.531123
14620 b_km(2,je) = 0.206408
14621 b_km(3,je) = -0.00109233
14622 b_km(4,je) = -2.62e-06
14623 b_km(5,je) = -2.95e-07
14624 im_max(je)= 28.16
14625 !
14626 ! ca(no3)2
14627 je = jcano3
14628 b_km(1,je) = -0.522974
14629 b_km(2,je) = 0.15075
14630 b_km(3,je) = -0.00298182
14631 b_km(4,je) = 5.01151e-05
14632 b_km(5,je) = -3.82811e-07
14633 im_max(je)= 49.01
14634 !
14635 ! hno3
14636 je = jhno3
14637 b_km(1,je) = -0.318267
14638 b_km(2,je) = 0.187029
14639 b_km(3,je) = -0.00815311
14640 b_km(4,je) = 0.000218321
14641 b_km(5,je) = -2.41756e-06
14642 im_max(je)= 31.93
14643 !
14644 ! hcl
14645 je = jhcl
14646 b_km(1,je) = -0.323059
14647 b_km(2,je) = 0.235552
14648 b_km(3,je) = -0.00350478
14649 b_km(4,je) = 6.42091e-05
14650 b_km(5,je) = -1.48899e-06
14651 im_max(je)= 18.3
14652 !
14653 ! h2so4
14654 je = jh2so4
14655 b_km(1,je) = -0.7185
14656 b_km(2,je) = 0.1962
14657 b_km(3,je) = 2.5783e-3
14658 b_km(4,je) = -2.1450e-4
14659 b_km(5,je) = 2.7901e-6
14660 im_max(je)= 22.91
14661 !
14662 ! hhso4
14663 je = jhhso4
14664 b_km(1,je) = -0.2312
14665 b_km(2,je) = 0.1321
14666 b_km(3,je) = 4.9554e-3
14667 b_km(4,je) = -2.7074e-4
14668 b_km(5,je) = 3.1003e-6
14669 im_max(je)= 22.91
14670 !
14671 ! nh4hso4
14672 je = jnh4hso4
14673 b_km(1,je) = -0.1976
14674 b_km(2,je) = 0.0445
14675 b_km(3,je) = -7.8636e-4
14676 b_km(4,je) = 6.6343e-6
14677 b_km(5,je) = -1.9562e-8
14678 im_max(je)= 146.5
14679 !
14680 ! (nh4)3h(so4)2
14681 je = jlvcite
14682 b_km(1,je) = -0.3935
14683 b_km(2,je) = 0.0591
14684 b_km(3,je) = -5.5720e-4
14685 b_km(4,je) = 3.1519e-6
14686 b_km(5,je) = -6.6097e-9
14687 im_max(je)= 197.0
14688 !
14689 ! nahso4
14690 je = jnahso4
14691 b_km(1,je) = -0.2961
14692 b_km(2,je) = 0.1238
14693 b_km(3,je) = -5.1698e-3
14694 b_km(4,je) = 1.2267e-4
14695 b_km(5,je) = -1.0722e-6
14696 im_max(je)= 43.59
14697 !
14698 ! na3h(so4)2
14699 je = jna3hso4
14700 b_km(1,je) = -0.4688
14701 b_km(2,je) = 0.1020
14702 b_km(3,je) = -1.7013e-3
14703 b_km(4,je) = 2.9740e-5
14704 b_km(5,je) = -2.3703e-7
14705 im_max(je)= 50.44
14706
14707
14708 !----------------------------------------------------------------
14709 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
14710 ! log_gamz(ja,je) a in e
14711 !----------------------------------------------------------------
14712 !
14713 ! (nh4)2so4 in e
14714 ja = jnh4so4
14715
14716 ! in (nh4)2so4
14717 je = jnh4so4
14718 b_mtem(1,ja,je) = -2.94685
14719 b_mtem(2,ja,je) = 17.3328
14720 b_mtem(3,ja,je) = -64.8441
14721 b_mtem(4,ja,je) = 122.7070
14722 b_mtem(5,ja,je) = -114.4373
14723 b_mtem(6,ja,je) = 41.6811
14724
14725 ! in nh4no3
14726 je = jnh4no3
14727 b_mtem(1,ja,je) = -2.7503
14728 b_mtem(2,ja,je) = 4.3806
14729 b_mtem(3,ja,je) = -1.1110
14730 b_mtem(4,ja,je) = -1.7005
14731 b_mtem(5,ja,je) = -4.4207
14732 b_mtem(6,ja,je) = 5.1990
14733
14734 ! in nh4cl (revised on 11/15/2003)
14735 je = jnh4cl
14736 b_mtem(1,ja,je) = -2.06952
14737 b_mtem(2,ja,je) = 7.1240
14738 b_mtem(3,ja,je) = -24.4274
14739 b_mtem(4,ja,je) = 51.1458
14740 b_mtem(5,ja,je) = -54.2056
14741 b_mtem(6,ja,je) = 22.0606
14742
14743 ! in na2so4
14744 je = jna2so4
14745 b_mtem(1,ja,je) = -2.17361
14746 b_mtem(2,ja,je) = 15.9919
14747 b_mtem(3,ja,je) = -69.0952
14748 b_mtem(4,ja,je) = 139.8860
14749 b_mtem(5,ja,je) = -134.9890
14750 b_mtem(6,ja,je) = 49.8877
14751
14752 ! in nano3
14753 je = jnano3
14754 b_mtem(1,ja,je) = -4.4370
14755 b_mtem(2,ja,je) = 24.0243
14756 b_mtem(3,ja,je) = -76.2437
14757 b_mtem(4,ja,je) = 128.6660
14758 b_mtem(5,ja,je) = -110.0900
14759 b_mtem(6,ja,je) = 37.7414
14760
14761 ! in nacl
14762 je = jnacl
14763 b_mtem(1,ja,je) = -1.5394
14764 b_mtem(2,ja,je) = 5.8671
14765 b_mtem(3,ja,je) = -22.7726
14766 b_mtem(4,ja,je) = 47.0547
14767 b_mtem(5,ja,je) = -47.8266
14768 b_mtem(6,ja,je) = 18.8489
14769
14770 ! in hno3
14771 je = jhno3
14772 b_mtem(1,ja,je) = -0.35750
14773 b_mtem(2,ja,je) = -3.82466
14774 b_mtem(3,ja,je) = 4.55462
14775 b_mtem(4,ja,je) = 5.05402
14776 b_mtem(5,ja,je) = -14.7476
14777 b_mtem(6,ja,je) = 8.8009
14778
14779 ! in hcl
14780 je = jhcl
14781 b_mtem(1,ja,je) = -2.15146
14782 b_mtem(2,ja,je) = 5.50205
14783 b_mtem(3,ja,je) = -19.1476
14784 b_mtem(4,ja,je) = 39.1880
14785 b_mtem(5,ja,je) = -39.9460
14786 b_mtem(6,ja,je) = 16.0700
14787
14788 ! in h2so4
14789 je = jh2so4
14790 b_mtem(1,ja,je) = -2.52604
14791 b_mtem(2,ja,je) = 9.76022
14792 b_mtem(3,ja,je) = -35.2540
14793 b_mtem(4,ja,je) = 71.2981
14794 b_mtem(5,ja,je) = -71.8207
14795 b_mtem(6,ja,je) = 28.0758
14796
14797 !
14798 ! in nh4hso4
14799 je = jnh4hso4
14800 b_mtem(1,ja,je) = -4.13219
14801 b_mtem(2,ja,je) = 13.8863
14802 b_mtem(3,ja,je) = -34.5387
14803 b_mtem(4,ja,je) = 56.5012
14804 b_mtem(5,ja,je) = -51.8702
14805 b_mtem(6,ja,je) = 19.6232
14806
14807 !
14808 ! in (nh4)3h(so4)2
14809 je = jlvcite
14810 b_mtem(1,ja,je) = -2.53482
14811 b_mtem(2,ja,je) = 12.3333
14812 b_mtem(3,ja,je) = -46.1020
14813 b_mtem(4,ja,je) = 90.4775
14814 b_mtem(5,ja,je) = -88.1254
14815 b_mtem(6,ja,je) = 33.4715
14816
14817 !
14818 ! in nahso4
14819 je = jnahso4
14820 b_mtem(1,ja,je) = -3.23425
14821 b_mtem(2,ja,je) = 18.7842
14822 b_mtem(3,ja,je) = -78.7807
14823 b_mtem(4,ja,je) = 161.517
14824 b_mtem(5,ja,je) = -154.940
14825 b_mtem(6,ja,je) = 56.2252
14826
14827 !
14828 ! in na3h(so4)2
14829 je = jna3hso4
14830 b_mtem(1,ja,je) = -1.25316
14831 b_mtem(2,ja,je) = 7.40960
14832 b_mtem(3,ja,je) = -34.8929
14833 b_mtem(4,ja,je) = 72.8853
14834 b_mtem(5,ja,je) = -72.4503
14835 b_mtem(6,ja,je) = 27.7706
14836
14837
14838 !-----------------
14839 ! nh4no3 in e
14840 ja = jnh4no3
14841
14842 ! in (nh4)2so4
14843 je = jnh4so4
14844 b_mtem(1,ja,je) = -3.5201
14845 b_mtem(2,ja,je) = 21.6584
14846 b_mtem(3,ja,je) = -72.1499
14847 b_mtem(4,ja,je) = 126.7000
14848 b_mtem(5,ja,je) = -111.4550
14849 b_mtem(6,ja,je) = 38.5677
14850
14851 ! in nh4no3
14852 je = jnh4no3
14853 b_mtem(1,ja,je) = -2.2630
14854 b_mtem(2,ja,je) = -0.1518
14855 b_mtem(3,ja,je) = 17.0898
14856 b_mtem(4,ja,je) = -36.7832
14857 b_mtem(5,ja,je) = 29.8407
14858 b_mtem(6,ja,je) = -7.9314
14859
14860 ! in nh4cl (revised on 11/15/2003)
14861 je = jnh4cl
14862 b_mtem(1,ja,je) = -1.3851
14863 b_mtem(2,ja,je) = -0.4462
14864 b_mtem(3,ja,je) = 8.4567
14865 b_mtem(4,ja,je) = -11.5988
14866 b_mtem(5,ja,je) = 2.9802
14867 b_mtem(6,ja,je) = 1.8132
14868
14869 ! in na2so4
14870 je = jna2so4
14871 b_mtem(1,ja,je) = -1.7602
14872 b_mtem(2,ja,je) = 10.4044
14873 b_mtem(3,ja,je) = -35.5894
14874 b_mtem(4,ja,je) = 64.3584
14875 b_mtem(5,ja,je) = -57.8931
14876 b_mtem(6,ja,je) = 20.2141
14877
14878 ! in nano3
14879 je = jnano3
14880 b_mtem(1,ja,je) = -3.24346
14881 b_mtem(2,ja,je) = 16.2794
14882 b_mtem(3,ja,je) = -48.7601
14883 b_mtem(4,ja,je) = 79.2246
14884 b_mtem(5,ja,je) = -65.8169
14885 b_mtem(6,ja,je) = 22.1500
14886
14887 ! in nacl
14888 je = jnacl
14889 b_mtem(1,ja,je) = -1.75658
14890 b_mtem(2,ja,je) = 7.71384
14891 b_mtem(3,ja,je) = -22.7984
14892 b_mtem(4,ja,je) = 39.1532
14893 b_mtem(5,ja,je) = -34.6165
14894 b_mtem(6,ja,je) = 12.1283
14895
14896 ! in ca(no3)2
14897 je = jcano3
14898 b_mtem(1,ja,je) = -0.97178
14899 b_mtem(2,ja,je) = 6.61964
14900 b_mtem(3,ja,je) = -26.2353
14901 b_mtem(4,ja,je) = 50.5259
14902 b_mtem(5,ja,je) = -47.6586
14903 b_mtem(6,ja,je) = 17.5074
14904
14905 ! in cacl2 added on 12/22/2003
14906 je = jcacl2
14907 b_mtem(1,ja,je) = -0.41515
14908 b_mtem(2,ja,je) = 6.44101
14909 b_mtem(3,ja,je) = -26.4473
14910 b_mtem(4,ja,je) = 49.0718
14911 b_mtem(5,ja,je) = -44.2631
14912 b_mtem(6,ja,je) = 15.3771
14913
14914 ! in hno3
14915 je = jhno3
14916 b_mtem(1,ja,je) = -1.20644
14917 b_mtem(2,ja,je) = 5.70117
14918 b_mtem(3,ja,je) = -18.2783
14919 b_mtem(4,ja,je) = 31.7199
14920 b_mtem(5,ja,je) = -27.8703
14921 b_mtem(6,ja,je) = 9.7299
14922
14923 ! in hcl
14924 je = jhcl
14925 b_mtem(1,ja,je) = -0.680862
14926 b_mtem(2,ja,je) = 3.59456
14927 b_mtem(3,ja,je) = -10.7969
14928 b_mtem(4,ja,je) = 17.8434
14929 b_mtem(5,ja,je) = -15.3165
14930 b_mtem(6,ja,je) = 5.17123
14931
14932
14933 !----------
14934 ! nh4cl in e
14935 ja = jnh4cl
14936
14937 ! in (nh4)2so4
14938 je = jnh4so4
14939 b_mtem(1,ja,je) = -2.8850
14940 b_mtem(2,ja,je) = 20.6970
14941 b_mtem(3,ja,je) = -70.6810
14942 b_mtem(4,ja,je) = 124.3690
14943 b_mtem(5,ja,je) = -109.2880
14944 b_mtem(6,ja,je) = 37.5831
14945
14946 ! in nh4no3
14947 je = jnh4no3
14948 b_mtem(1,ja,je) = -1.9386
14949 b_mtem(2,ja,je) = 1.3238
14950 b_mtem(3,ja,je) = 11.8500
14951 b_mtem(4,ja,je) = -28.1168
14952 b_mtem(5,ja,je) = 21.8543
14953 b_mtem(6,ja,je) = -5.1671
14954
14955 ! in nh4cl (revised on 11/15/2003)
14956 je = jnh4cl
14957 b_mtem(1,ja,je) = -0.9559
14958 b_mtem(2,ja,je) = 0.8121
14959 b_mtem(3,ja,je) = 4.3644
14960 b_mtem(4,ja,je) = -8.9258
14961 b_mtem(5,ja,je) = 4.2362
14962 b_mtem(6,ja,je) = 0.2891
14963
14964 ! in na2so4
14965 je = jna2so4
14966 b_mtem(1,ja,je) = 0.0377
14967 b_mtem(2,ja,je) = 6.0752
14968 b_mtem(3,ja,je) = -30.8641
14969 b_mtem(4,ja,je) = 63.3095
14970 b_mtem(5,ja,je) = -61.0070
14971 b_mtem(6,ja,je) = 22.1734
14972
14973 ! in nano3
14974 je = jnano3
14975 b_mtem(1,ja,je) = -1.8336
14976 b_mtem(2,ja,je) = 12.8160
14977 b_mtem(3,ja,je) = -42.3388
14978 b_mtem(4,ja,je) = 71.1816
14979 b_mtem(5,ja,je) = -60.5708
14980 b_mtem(6,ja,je) = 20.5853
14981
14982 ! in nacl
14983 je = jnacl
14984 b_mtem(1,ja,je) = -0.1429
14985 b_mtem(2,ja,je) = 2.3561
14986 b_mtem(3,ja,je) = -10.4425
14987 b_mtem(4,ja,je) = 20.8951
14988 b_mtem(5,ja,je) = -20.7739
14989 b_mtem(6,ja,je) = 7.9355
14990
14991 ! in ca(no3)2
14992 je = jcano3
14993 b_mtem(1,ja,je) = 0.76235
14994 b_mtem(2,ja,je) = 3.08323
14995 b_mtem(3,ja,je) = -23.6772
14996 b_mtem(4,ja,je) = 53.7415
14997 b_mtem(5,ja,je) = -55.4043
14998 b_mtem(6,ja,je) = 21.2944
14999
15000 ! in cacl2 (revised on 11/27/2003)
15001 je = jcacl2
15002 b_mtem(1,ja,je) = 1.13864
15003 b_mtem(2,ja,je) = -0.340539
15004 b_mtem(3,ja,je) = -8.67025
15005 b_mtem(4,ja,je) = 22.8008
15006 b_mtem(5,ja,je) = -24.5181
15007 b_mtem(6,ja,je) = 9.3663
15008
15009 ! in hno3
15010 je = jhno3
15011 b_mtem(1,ja,je) = 2.42532
15012 b_mtem(2,ja,je) = -14.1755
15013 b_mtem(3,ja,je) = 38.804
15014 b_mtem(4,ja,je) = -58.2437
15015 b_mtem(5,ja,je) = 43.5431
15016 b_mtem(6,ja,je) = -12.5824
15017
15018 ! in hcl
15019 je = jhcl
15020 b_mtem(1,ja,je) = 0.330337
15021 b_mtem(2,ja,je) = 0.0778934
15022 b_mtem(3,ja,je) = -2.30492
15023 b_mtem(4,ja,je) = 4.73003
15024 b_mtem(5,ja,je) = -4.80849
15025 b_mtem(6,ja,je) = 1.78866
15026
15027
15028 !----------
15029 ! na2so4 in e
15030 ja = jna2so4
15031
15032 ! in (nh4)2so4
15033 je = jnh4so4
15034 b_mtem(1,ja,je) = -2.6982
15035 b_mtem(2,ja,je) = 22.9875
15036 b_mtem(3,ja,je) = -98.9840
15037 b_mtem(4,ja,je) = 198.0180
15038 b_mtem(5,ja,je) = -188.7270
15039 b_mtem(6,ja,je) = 69.0548
15040
15041 ! in nh4no3
15042 je = jnh4no3
15043 b_mtem(1,ja,je) = -2.4844
15044 b_mtem(2,ja,je) = 6.5420
15045 b_mtem(3,ja,je) = -9.8998
15046 b_mtem(4,ja,je) = 11.3884
15047 b_mtem(5,ja,je) = -13.6842
15048 b_mtem(6,ja,je) = 7.7411
15049
15050 ! in nh4cl (revised on 11/15/2003)
15051 je = jnh4cl
15052 b_mtem(1,ja,je) = -1.3325
15053 b_mtem(2,ja,je) = 13.0406
15054 b_mtem(3,ja,je) = -56.1935
15055 b_mtem(4,ja,je) = 107.1170
15056 b_mtem(5,ja,je) = -97.3721
15057 b_mtem(6,ja,je) = 34.3763
15058
15059 ! in na2so4
15060 je = jna2so4
15061 b_mtem(1,ja,je) = -1.2832
15062 b_mtem(2,ja,je) = 12.8526
15063 b_mtem(3,ja,je) = -62.2087
15064 b_mtem(4,ja,je) = 130.3876
15065 b_mtem(5,ja,je) = -128.2627
15066 b_mtem(6,ja,je) = 48.0340
15067
15068 ! in nano3
15069 je = jnano3
15070 b_mtem(1,ja,je) = -3.5384
15071 b_mtem(2,ja,je) = 21.3758
15072 b_mtem(3,ja,je) = -70.7638
15073 b_mtem(4,ja,je) = 121.1580
15074 b_mtem(5,ja,je) = -104.6230
15075 b_mtem(6,ja,je) = 36.0557
15076
15077 ! in nacl
15078 je = jnacl
15079 b_mtem(1,ja,je) = 0.2175
15080 b_mtem(2,ja,je) = -0.5648
15081 b_mtem(3,ja,je) = -8.0288
15082 b_mtem(4,ja,je) = 25.9734
15083 b_mtem(5,ja,je) = -32.3577
15084 b_mtem(6,ja,je) = 14.3924
15085
15086 ! in hno3
15087 je = jhno3
15088 b_mtem(1,ja,je) = -0.309617
15089 b_mtem(2,ja,je) = -1.82899
15090 b_mtem(3,ja,je) = -1.5505
15091 b_mtem(4,ja,je) = 13.3847
15092 b_mtem(5,ja,je) = -20.1284
15093 b_mtem(6,ja,je) = 9.93163
15094
15095 ! in hcl
15096 je = jhcl
15097 b_mtem(1,ja,je) = -0.259455
15098 b_mtem(2,ja,je) = -0.819366
15099 b_mtem(3,ja,je) = -4.28964
15100 b_mtem(4,ja,je) = 16.4305
15101 b_mtem(5,ja,je) = -21.8546
15102 b_mtem(6,ja,je) = 10.3044
15103
15104 ! in h2so4
15105 je = jh2so4
15106 b_mtem(1,ja,je) = -1.84257
15107 b_mtem(2,ja,je) = 7.85788
15108 b_mtem(3,ja,je) = -29.9275
15109 b_mtem(4,ja,je) = 61.7515
15110 b_mtem(5,ja,je) = -63.2308
15111 b_mtem(6,ja,je) = 24.9542
15112
15113 ! in nh4hso4
15114 je = jnh4hso4
15115 b_mtem(1,ja,je) = -1.05891
15116 b_mtem(2,ja,je) = 2.84831
15117 b_mtem(3,ja,je) = -21.1827
15118 b_mtem(4,ja,je) = 57.5175
15119 b_mtem(5,ja,je) = -64.8120
15120 b_mtem(6,ja,je) = 26.1986
15121
15122 ! in (nh4)3h(so4)2
15123 je = jlvcite
15124 b_mtem(1,ja,je) = -1.16584
15125 b_mtem(2,ja,je) = 8.50075
15126 b_mtem(3,ja,je) = -44.3420
15127 b_mtem(4,ja,je) = 97.3974
15128 b_mtem(5,ja,je) = -98.4549
15129 b_mtem(6,ja,je) = 37.6104
15130
15131 ! in nahso4
15132 je = jnahso4
15133 b_mtem(1,ja,je) = -1.95805
15134 b_mtem(2,ja,je) = 6.62417
15135 b_mtem(3,ja,je) = -31.8072
15136 b_mtem(4,ja,je) = 77.8603
15137 b_mtem(5,ja,je) = -84.6458
15138 b_mtem(6,ja,je) = 33.4963
15139
15140 ! in na3h(so4)2
15141 je = jna3hso4
15142 b_mtem(1,ja,je) = -0.36045
15143 b_mtem(2,ja,je) = 3.55223
15144 b_mtem(3,ja,je) = -24.0327
15145 b_mtem(4,ja,je) = 54.4879
15146 b_mtem(5,ja,je) = -56.6531
15147 b_mtem(6,ja,je) = 22.4956
15148
15149
15150 !----------
15151 ! nano3 in e
15152 ja = jnano3
15153
15154 ! in (nh4)2so4
15155 je = jnh4so4
15156 b_mtem(1,ja,je) = -2.5888
15157 b_mtem(2,ja,je) = 17.6192
15158 b_mtem(3,ja,je) = -63.2183
15159 b_mtem(4,ja,je) = 115.3520
15160 b_mtem(5,ja,je) = -104.0860
15161 b_mtem(6,ja,je) = 36.7390
15162
15163 ! in nh4no3
15164 je = jnh4no3
15165 b_mtem(1,ja,je) = -2.0669
15166 b_mtem(2,ja,je) = 1.4792
15167 b_mtem(3,ja,je) = 10.5261
15168 b_mtem(4,ja,je) = -27.0987
15169 b_mtem(5,ja,je) = 23.0591
15170 b_mtem(6,ja,je) = -6.0938
15171
15172 ! in nh4cl (revised on 11/15/2003)
15173 je = jnh4cl
15174 b_mtem(1,ja,je) = -0.8325
15175 b_mtem(2,ja,je) = 3.9933
15176 b_mtem(3,ja,je) = -15.3789
15177 b_mtem(4,ja,je) = 30.4050
15178 b_mtem(5,ja,je) = -29.4204
15179 b_mtem(6,ja,je) = 11.0597
15180
15181 ! in na2so4
15182 je = jna2so4
15183 b_mtem(1,ja,je) = -1.1233
15184 b_mtem(2,ja,je) = 8.3998
15185 b_mtem(3,ja,je) = -31.9002
15186 b_mtem(4,ja,je) = 60.1450
15187 b_mtem(5,ja,je) = -55.5503
15188 b_mtem(6,ja,je) = 19.7757
15189
15190 ! in nano3
15191 je = jnano3
15192 b_mtem(1,ja,je) = -2.5386
15193 b_mtem(2,ja,je) = 13.9039
15194 b_mtem(3,ja,je) = -42.8467
15195 b_mtem(4,ja,je) = 69.7442
15196 b_mtem(5,ja,je) = -57.8988
15197 b_mtem(6,ja,je) = 19.4635
15198
15199 ! in nacl
15200 je = jnacl
15201 b_mtem(1,ja,je) = -0.4351
15202 b_mtem(2,ja,je) = 2.8311
15203 b_mtem(3,ja,je) = -11.4485
15204 b_mtem(4,ja,je) = 22.7201
15205 b_mtem(5,ja,je) = -22.4228
15206 b_mtem(6,ja,je) = 8.5792
15207
15208 ! in ca(no3)2
15209 je = jcano3
15210 b_mtem(1,ja,je) = -0.72060
15211 b_mtem(2,ja,je) = 5.64915
15212 b_mtem(3,ja,je) = -23.5020
15213 b_mtem(4,ja,je) = 46.0078
15214 b_mtem(5,ja,je) = -43.8075
15215 b_mtem(6,ja,je) = 16.1652
15216
15217 ! in cacl2
15218 je = jcacl2
15219 b_mtem(1,ja,je) = 0.003928
15220 b_mtem(2,ja,je) = 3.54724
15221 b_mtem(3,ja,je) = -18.6057
15222 b_mtem(4,ja,je) = 38.1445
15223 b_mtem(5,ja,je) = -36.7745
15224 b_mtem(6,ja,je) = 13.4529
15225
15226 ! in hno3
15227 je = jhno3
15228 b_mtem(1,ja,je) = -1.1712
15229 b_mtem(2,ja,je) = 7.20907
15230 b_mtem(3,ja,je) = -22.9215
15231 b_mtem(4,ja,je) = 38.1257
15232 b_mtem(5,ja,je) = -32.0759
15233 b_mtem(6,ja,je) = 10.6443
15234
15235 ! in hcl
15236 je = jhcl
15237 b_mtem(1,ja,je) = 0.738022
15238 b_mtem(2,ja,je) = -1.14313
15239 b_mtem(3,ja,je) = 0.32251
15240 b_mtem(4,ja,je) = 0.838679
15241 b_mtem(5,ja,je) = -1.81747
15242 b_mtem(6,ja,je) = 0.873986
15243
15244
15245 !----------
15246 ! nacl in e
15247 ja = jnacl
15248
15249 ! in (nh4)2so4
15250 je = jnh4so4
15251 b_mtem(1,ja,je) = -1.9525
15252 b_mtem(2,ja,je) = 16.6433
15253 b_mtem(3,ja,je) = -61.7090
15254 b_mtem(4,ja,je) = 112.9910
15255 b_mtem(5,ja,je) = -101.9370
15256 b_mtem(6,ja,je) = 35.7760
15257
15258 ! in nh4no3
15259 je = jnh4no3
15260 b_mtem(1,ja,je) = -1.7525
15261 b_mtem(2,ja,je) = 3.0713
15262 b_mtem(3,ja,je) = 4.8063
15263 b_mtem(4,ja,je) = -17.5334
15264 b_mtem(5,ja,je) = 14.2872
15265 b_mtem(6,ja,je) = -3.0690
15266
15267 ! in nh4cl (revised on 11/15/2003)
15268 je = jnh4cl
15269 b_mtem(1,ja,je) = -0.4021
15270 b_mtem(2,ja,je) = 5.2399
15271 b_mtem(3,ja,je) = -19.4278
15272 b_mtem(4,ja,je) = 33.0027
15273 b_mtem(5,ja,je) = -28.1020
15274 b_mtem(6,ja,je) = 9.5159
15275
15276 ! in na2so4
15277 je = jna2so4
15278 b_mtem(1,ja,je) = 0.6692
15279 b_mtem(2,ja,je) = 4.1207
15280 b_mtem(3,ja,je) = -27.3314
15281 b_mtem(4,ja,je) = 59.3112
15282 b_mtem(5,ja,je) = -58.7998
15283 b_mtem(6,ja,je) = 21.7674
15284
15285 ! in nano3
15286 je = jnano3
15287 b_mtem(1,ja,je) = -1.17444
15288 b_mtem(2,ja,je) = 10.9927
15289 b_mtem(3,ja,je) = -38.9013
15290 b_mtem(4,ja,je) = 66.8521
15291 b_mtem(5,ja,je) = -57.6564
15292 b_mtem(6,ja,je) = 19.7296
15293
15294 ! in nacl
15295 je = jnacl
15296 b_mtem(1,ja,je) = 1.17679
15297 b_mtem(2,ja,je) = -2.5061
15298 b_mtem(3,ja,je) = 0.8508
15299 b_mtem(4,ja,je) = 4.4802
15300 b_mtem(5,ja,je) = -8.4945
15301 b_mtem(6,ja,je) = 4.3182
15302
15303 ! in ca(no3)2
15304 je = jcano3
15305 b_mtem(1,ja,je) = 1.01450
15306 b_mtem(2,ja,je) = 2.10260
15307 b_mtem(3,ja,je) = -20.9036
15308 b_mtem(4,ja,je) = 49.1481
15309 b_mtem(5,ja,je) = -51.4867
15310 b_mtem(6,ja,je) = 19.9301
15311
15312 ! in cacl2 (psc92: revised on 11/27/2003)
15313 je = jcacl2
15314 b_mtem(1,ja,je) = 1.55463
15315 b_mtem(2,ja,je) = -3.20122
15316 b_mtem(3,ja,je) = -0.957075
15317 b_mtem(4,ja,je) = 12.103
15318 b_mtem(5,ja,je) = -17.221
15319 b_mtem(6,ja,je) = 7.50264
15320
15321 ! in hno3
15322 je = jhno3
15323 b_mtem(1,ja,je) = 2.46187
15324 b_mtem(2,ja,je) = -12.6845
15325 b_mtem(3,ja,je) = 34.2383
15326 b_mtem(4,ja,je) = -51.9992
15327 b_mtem(5,ja,je) = 39.4934
15328 b_mtem(6,ja,je) = -11.7247
15329
15330 ! in hcl
15331 je = jhcl
15332 b_mtem(1,ja,je) = 1.74915
15333 b_mtem(2,ja,je) = -4.65768
15334 b_mtem(3,ja,je) = 8.80287
15335 b_mtem(4,ja,je) = -12.2503
15336 b_mtem(5,ja,je) = 8.668751
15337 b_mtem(6,ja,je) = -2.50158
15338
15339
15340 !----------
15341 ! ca(no3)2 in e
15342 ja = jcano3
15343
15344 ! in nh4no3
15345 je = jnh4no3
15346 b_mtem(1,ja,je) = -1.86260
15347 b_mtem(2,ja,je) = 11.6178
15348 b_mtem(3,ja,je) = -30.9069
15349 b_mtem(4,ja,je) = 41.7578
15350 b_mtem(5,ja,je) = -33.7338
15351 b_mtem(6,ja,je) = 12.7541
15352
15353 ! in nh4cl (revised on 11/15/2003)
15354 je = jnh4cl
15355 b_mtem(1,ja,je) = -1.1798
15356 b_mtem(2,ja,je) = 25.9608
15357 b_mtem(3,ja,je) = -98.9373
15358 b_mtem(4,ja,je) = 160.2300
15359 b_mtem(5,ja,je) = -125.9540
15360 b_mtem(6,ja,je) = 39.5130
15361
15362 ! in nano3
15363 je = jnano3
15364 b_mtem(1,ja,je) = -1.44384
15365 b_mtem(2,ja,je) = 13.6044
15366 b_mtem(3,ja,je) = -54.4300
15367 b_mtem(4,ja,je) = 100.582
15368 b_mtem(5,ja,je) = -91.2364
15369 b_mtem(6,ja,je) = 32.5970
15370
15371 ! in nacl
15372 je = jnacl
15373 b_mtem(1,ja,je) = -0.099114
15374 b_mtem(2,ja,je) = 2.84091
15375 b_mtem(3,ja,je) = -16.9229
15376 b_mtem(4,ja,je) = 37.4839
15377 b_mtem(5,ja,je) = -39.5132
15378 b_mtem(6,ja,je) = 15.8564
15379
15380 ! in ca(no3)2
15381 je = jcano3
15382 b_mtem(1,ja,je) = 0.055116
15383 b_mtem(2,ja,je) = 4.58610
15384 b_mtem(3,ja,je) = -27.6629
15385 b_mtem(4,ja,je) = 60.8288
15386 b_mtem(5,ja,je) = -61.4988
15387 b_mtem(6,ja,je) = 23.3136
15388
15389 ! in cacl2 (psc92: revised on 11/27/2003)
15390 je = jcacl2
15391 b_mtem(1,ja,je) = 1.57155
15392 b_mtem(2,ja,je) = -3.18486
15393 b_mtem(3,ja,je) = -3.35758
15394 b_mtem(4,ja,je) = 18.7501
15395 b_mtem(5,ja,je) = -24.5604
15396 b_mtem(6,ja,je) = 10.3798
15397
15398 ! in hno3
15399 je = jhno3
15400 b_mtem(1,ja,je) = 1.04446
15401 b_mtem(2,ja,je) = -3.19066
15402 b_mtem(3,ja,je) = 2.44714
15403 b_mtem(4,ja,je) = 2.07218
15404 b_mtem(5,ja,je) = -6.43949
15405 b_mtem(6,ja,je) = 3.66471
15406
15407 ! in hcl
15408 je = jhcl
15409 b_mtem(1,ja,je) = 1.05723
15410 b_mtem(2,ja,je) = -1.46826
15411 b_mtem(3,ja,je) = -1.0713
15412 b_mtem(4,ja,je) = 4.64439
15413 b_mtem(5,ja,je) = -6.32402
15414 b_mtem(6,ja,je) = 2.78202
15415
15416
15417 !----------
15418 ! cacl2 in e
15419 ja = jcacl2
15420
15421 ! in nh4no3 (psc92: revised on 12/22/2003)
15422 je = jnh4no3
15423 b_mtem(1,ja,je) = -1.43626
15424 b_mtem(2,ja,je) = 13.6598
15425 b_mtem(3,ja,je) = -38.2068
15426 b_mtem(4,ja,je) = 53.9057
15427 b_mtem(5,ja,je) = -44.9018
15428 b_mtem(6,ja,je) = 16.6120
15429
15430 ! in nh4cl (psc92: revised on 11/27/2003)
15431 je = jnh4cl
15432 b_mtem(1,ja,je) = -0.603965
15433 b_mtem(2,ja,je) = 27.6027
15434 b_mtem(3,ja,je) = -104.258
15435 b_mtem(4,ja,je) = 163.553
15436 b_mtem(5,ja,je) = -124.076
15437 b_mtem(6,ja,je) = 37.4153
15438
15439 ! in nano3 (psc92: revised on 12/22/2003)
15440 je = jnano3
15441 b_mtem(1,ja,je) = 0.44648
15442 b_mtem(2,ja,je) = 8.8850
15443 b_mtem(3,ja,je) = -45.5232
15444 b_mtem(4,ja,je) = 89.3263
15445 b_mtem(5,ja,je) = -83.8604
15446 b_mtem(6,ja,je) = 30.4069
15447
15448 ! in nacl (psc92: revised on 11/27/2003)
15449 je = jnacl
15450 b_mtem(1,ja,je) = 1.61927
15451 b_mtem(2,ja,je) = 0.247547
15452 b_mtem(3,ja,je) = -18.1252
15453 b_mtem(4,ja,je) = 45.2479
15454 b_mtem(5,ja,je) = -48.6072
15455 b_mtem(6,ja,je) = 19.2784
15456
15457 ! in ca(no3)2 (psc92: revised on 11/27/2003)
15458 je = jcano3
15459 b_mtem(1,ja,je) = 2.36667
15460 b_mtem(2,ja,je) = -0.123309
15461 b_mtem(3,ja,je) = -24.2723
15462 b_mtem(4,ja,je) = 65.1486
15463 b_mtem(5,ja,je) = -71.8504
15464 b_mtem(6,ja,je) = 28.3696
15465
15466 ! in cacl2 (psc92: revised on 11/27/2003)
15467 je = jcacl2
15468 b_mtem(1,ja,je) = 3.64023
15469 b_mtem(2,ja,je) = -12.1926
15470 b_mtem(3,ja,je) = 20.2028
15471 b_mtem(4,ja,je) = -16.0056
15472 b_mtem(5,ja,je) = 1.52355
15473 b_mtem(6,ja,je) = 2.44709
15474
15475 ! in hno3
15476 je = jhno3
15477 b_mtem(1,ja,je) = 5.88794
15478 b_mtem(2,ja,je) = -29.7083
15479 b_mtem(3,ja,je) = 78.6309
15480 b_mtem(4,ja,je) = -118.037
15481 b_mtem(5,ja,je) = 88.932
15482 b_mtem(6,ja,je) = -26.1407
15483
15484 ! in hcl
15485 je = jhcl
15486 b_mtem(1,ja,je) = 2.40628
15487 b_mtem(2,ja,je) = -6.16566
15488 b_mtem(3,ja,je) = 10.2851
15489 b_mtem(4,ja,je) = -12.9035
15490 b_mtem(5,ja,je) = 7.7441
15491 b_mtem(6,ja,je) = -1.74821
15492
15493
15494 !----------
15495 ! hno3 in e
15496 ja = jhno3
15497
15498 ! in (nh4)2so4
15499 je = jnh4so4
15500 b_mtem(1,ja,je) = -3.57598
15501 b_mtem(2,ja,je) = 21.5469
15502 b_mtem(3,ja,je) = -77.4111
15503 b_mtem(4,ja,je) = 144.136
15504 b_mtem(5,ja,je) = -132.849
15505 b_mtem(6,ja,je) = 47.9412
15506
15507 ! in nh4no3
15508 je = jnh4no3
15509 b_mtem(1,ja,je) = -2.00209
15510 b_mtem(2,ja,je) = -3.48399
15511 b_mtem(3,ja,je) = 34.9906
15512 b_mtem(4,ja,je) = -68.6653
15513 b_mtem(5,ja,je) = 54.0992
15514 b_mtem(6,ja,je) = -15.1343
15515
15516 ! in nh4cl revised on 12/22/2003
15517 je = jnh4cl
15518 b_mtem(1,ja,je) = -0.63790
15519 b_mtem(2,ja,je) = -1.67730
15520 b_mtem(3,ja,je) = 10.1727
15521 b_mtem(4,ja,je) = -14.9097
15522 b_mtem(5,ja,je) = 7.67410
15523 b_mtem(6,ja,je) = -0.79586
15524
15525 ! in nacl
15526 je = jnacl
15527 b_mtem(1,ja,je) = 1.3446
15528 b_mtem(2,ja,je) = -2.5578
15529 b_mtem(3,ja,je) = 1.3464
15530 b_mtem(4,ja,je) = 2.90537
15531 b_mtem(5,ja,je) = -6.53014
15532 b_mtem(6,ja,je) = 3.31339
15533
15534 ! in nano3
15535 je = jnano3
15536 b_mtem(1,ja,je) = -0.546636
15537 b_mtem(2,ja,je) = 10.3127
15538 b_mtem(3,ja,je) = -39.9603
15539 b_mtem(4,ja,je) = 71.4609
15540 b_mtem(5,ja,je) = -63.4958
15541 b_mtem(6,ja,je) = 22.0679
15542
15543 ! in na2so4
15544 je = jna2so4
15545 b_mtem(1,ja,je) = 1.35059
15546 b_mtem(2,ja,je) = 4.34557
15547 b_mtem(3,ja,je) = -35.8425
15548 b_mtem(4,ja,je) = 80.9868
15549 b_mtem(5,ja,je) = -81.6544
15550 b_mtem(6,ja,je) = 30.4841
15551
15552 ! in ca(no3)2
15553 je = jcano3
15554 b_mtem(1,ja,je) = 0.869414
15555 b_mtem(2,ja,je) = 2.98486
15556 b_mtem(3,ja,je) = -22.255
15557 b_mtem(4,ja,je) = 50.1863
15558 b_mtem(5,ja,je) = -51.214
15559 b_mtem(6,ja,je) = 19.2235
15560
15561 ! in cacl2 (km) revised on 12/22/2003
15562 je = jcacl2
15563 b_mtem(1,ja,je) = 1.42800
15564 b_mtem(2,ja,je) = -1.78959
15565 b_mtem(3,ja,je) = -2.49075
15566 b_mtem(4,ja,je) = 10.1877
15567 b_mtem(5,ja,je) = -12.1948
15568 b_mtem(6,ja,je) = 4.64475
15569
15570 ! in hno3 (added on 12/06/2004)
15571 je = jhno3
15572 b_mtem(1,ja,je) = 0.22035
15573 b_mtem(2,ja,je) = 2.94973
15574 b_mtem(3,ja,je) = -12.1469
15575 b_mtem(4,ja,je) = 20.4905
15576 b_mtem(5,ja,je) = -17.3966
15577 b_mtem(6,ja,je) = 5.70779
15578
15579 ! in hcl (added on 12/06/2004)
15580 je = jhcl
15581 b_mtem(1,ja,je) = 1.55503
15582 b_mtem(2,ja,je) = -3.61226
15583 b_mtem(3,ja,je) = 6.28265
15584 b_mtem(4,ja,je) = -8.69575
15585 b_mtem(5,ja,je) = 6.09372
15586 b_mtem(6,ja,je) = -1.80898
15587
15588 ! in h2so4
15589 je = jh2so4
15590 b_mtem(1,ja,je) = 1.10783
15591 b_mtem(2,ja,je) = -1.3363
15592 b_mtem(3,ja,je) = -1.83525
15593 b_mtem(4,ja,je) = 7.47373
15594 b_mtem(5,ja,je) = -9.72954
15595 b_mtem(6,ja,je) = 4.12248
15596
15597 ! in nh4hso4
15598 je = jnh4hso4
15599 b_mtem(1,ja,je) = -0.851026
15600 b_mtem(2,ja,je) = 12.2515
15601 b_mtem(3,ja,je) = -49.788
15602 b_mtem(4,ja,je) = 91.6215
15603 b_mtem(5,ja,je) = -81.4877
15604 b_mtem(6,ja,je) = 28.0002
15605
15606 ! in (nh4)3h(so4)2
15607 je = jlvcite
15608 b_mtem(1,ja,je) = -3.09464
15609 b_mtem(2,ja,je) = 14.9303
15610 b_mtem(3,ja,je) = -43.0454
15611 b_mtem(4,ja,je) = 72.6695
15612 b_mtem(5,ja,je) = -65.2140
15613 b_mtem(6,ja,je) = 23.4814
15614
15615 ! in nahso4
15616 je = jnahso4
15617 b_mtem(1,ja,je) = 1.22973
15618 b_mtem(2,ja,je) = 2.82702
15619 b_mtem(3,ja,je) = -17.5869
15620 b_mtem(4,ja,je) = 28.9564
15621 b_mtem(5,ja,je) = -23.5814
15622 b_mtem(6,ja,je) = 7.91153
15623
15624 ! in na3h(so4)2
15625 je = jna3hso4
15626 b_mtem(1,ja,je) = 1.64773
15627 b_mtem(2,ja,je) = 0.94188
15628 b_mtem(3,ja,je) = -19.1242
15629 b_mtem(4,ja,je) = 46.9887
15630 b_mtem(5,ja,je) = -50.9494
15631 b_mtem(6,ja,je) = 20.2169
15632
15633
15634 !----------
15635 ! hcl in e
15636 ja = jhcl
15637
15638 ! in (nh4)2so4
15639 je = jnh4so4
15640 b_mtem(1,ja,je) = -2.93783
15641 b_mtem(2,ja,je) = 20.5546
15642 b_mtem(3,ja,je) = -75.8548
15643 b_mtem(4,ja,je) = 141.729
15644 b_mtem(5,ja,je) = -130.697
15645 b_mtem(6,ja,je) = 46.9905
15646
15647 ! in nh4no3
15648 je = jnh4no3
15649 b_mtem(1,ja,je) = -1.69063
15650 b_mtem(2,ja,je) = -1.85303
15651 b_mtem(3,ja,je) = 29.0927
15652 b_mtem(4,ja,je) = -58.7401
15653 b_mtem(5,ja,je) = 44.999
15654 b_mtem(6,ja,je) = -11.9988
15655
15656 ! in nh4cl (revised on 11/15/2003)
15657 je = jnh4cl
15658 b_mtem(1,ja,je) = -0.2073
15659 b_mtem(2,ja,je) = -0.4322
15660 b_mtem(3,ja,je) = 6.1271
15661 b_mtem(4,ja,je) = -12.3146
15662 b_mtem(5,ja,je) = 8.9919
15663 b_mtem(6,ja,je) = -2.3388
15664
15665 ! in nacl
15666 je = jnacl
15667 b_mtem(1,ja,je) = 2.95913
15668 b_mtem(2,ja,je) = -7.92254
15669 b_mtem(3,ja,je) = 13.736
15670 b_mtem(4,ja,je) = -15.433
15671 b_mtem(5,ja,je) = 7.40386
15672 b_mtem(6,ja,je) = -0.918641
15673
15674 ! in nano3
15675 je = jnano3
15676 b_mtem(1,ja,je) = 0.893272
15677 b_mtem(2,ja,je) = 6.53768
15678 b_mtem(3,ja,je) = -32.3458
15679 b_mtem(4,ja,je) = 61.2834
15680 b_mtem(5,ja,je) = -56.4446
15681 b_mtem(6,ja,je) = 19.9202
15682
15683 ! in na2so4
15684 je = jna2so4
15685 b_mtem(1,ja,je) = 3.14484
15686 b_mtem(2,ja,je) = 0.077019
15687 b_mtem(3,ja,je) = -31.4199
15688 b_mtem(4,ja,je) = 80.5865
15689 b_mtem(5,ja,je) = -85.392
15690 b_mtem(6,ja,je) = 32.6644
15691
15692 ! in ca(no3)2
15693 je = jcano3
15694 b_mtem(1,ja,je) = 2.60432
15695 b_mtem(2,ja,je) = -0.55909
15696 b_mtem(3,ja,je) = -19.6671
15697 b_mtem(4,ja,je) = 53.3446
15698 b_mtem(5,ja,je) = -58.9076
15699 b_mtem(6,ja,je) = 22.9927
15700
15701 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
15702 je = jcacl2
15703 b_mtem(1,ja,je) = 2.98036
15704 b_mtem(2,ja,je) = -8.55365
15705 b_mtem(3,ja,je) = 15.2108
15706 b_mtem(4,ja,je) = -15.9359
15707 b_mtem(5,ja,je) = 7.41772
15708 b_mtem(6,ja,je) = -1.32143
15709
15710 ! in hno3 (added on 12/06/2004)
15711 je = jhno3
15712 b_mtem(1,ja,je) = 3.8533
15713 b_mtem(2,ja,je) = -16.9427
15714 b_mtem(3,ja,je) = 45.0056
15715 b_mtem(4,ja,je) = -69.6145
15716 b_mtem(5,ja,je) = 54.1491
15717 b_mtem(6,ja,je) = -16.6513
15718
15719 ! in hcl (added on 12/06/2004)
15720 je = jhcl
15721 b_mtem(1,ja,je) = 2.56665
15722 b_mtem(2,ja,je) = -7.13585
15723 b_mtem(3,ja,je) = 14.8103
15724 b_mtem(4,ja,je) = -21.8881
15725 b_mtem(5,ja,je) = 16.6808
15726 b_mtem(6,ja,je) = -5.22091
15727
15728 ! in h2so4
15729 je = jh2so4
15730 b_mtem(1,ja,je) = 2.50179
15731 b_mtem(2,ja,je) = -6.69364
15732 b_mtem(3,ja,je) = 11.6551
15733 b_mtem(4,ja,je) = -13.6897
15734 b_mtem(5,ja,je) = 7.36796
15735 b_mtem(6,ja,je) = -1.33245
15736
15737 ! in nh4hso4
15738 je = jnh4hso4
15739 b_mtem(1,ja,je) = 0.149955
15740 b_mtem(2,ja,je) = 11.8213
15741 b_mtem(3,ja,je) = -53.9164
15742 b_mtem(4,ja,je) = 101.574
15743 b_mtem(5,ja,je) = -91.4123
15744 b_mtem(6,ja,je) = 31.5487
15745
15746 ! in (nh4)3h(so4)2
15747 je = jlvcite
15748 b_mtem(1,ja,je) = -2.36927
15749 b_mtem(2,ja,je) = 14.8359
15750 b_mtem(3,ja,je) = -44.3443
15751 b_mtem(4,ja,je) = 73.6229
15752 b_mtem(5,ja,je) = -65.3366
15753 b_mtem(6,ja,je) = 23.3250
15754
15755 ! in nahso4
15756 je = jnahso4
15757 b_mtem(1,ja,je) = 2.72993
15758 b_mtem(2,ja,je) = -0.23406
15759 b_mtem(3,ja,je) = -10.4103
15760 b_mtem(4,ja,je) = 13.1586
15761 b_mtem(5,ja,je) = -7.79925
15762 b_mtem(6,ja,je) = 2.30843
15763
15764 ! in na3h(so4)2
15765 je = jna3hso4
15766 b_mtem(1,ja,je) = 3.51258
15767 b_mtem(2,ja,je) = -3.95107
15768 b_mtem(3,ja,je) = -11.0175
15769 b_mtem(4,ja,je) = 38.8617
15770 b_mtem(5,ja,je) = -48.1575
15771 b_mtem(6,ja,je) = 20.4717
15772
15773
15774 !----------
15775 ! 2h.so4 in e
15776 ja = jh2so4
15777
15778 ! in h2so4
15779 je = jh2so4
15780 b_mtem(1,ja,je) = 0.76734
15781 b_mtem(2,ja,je) = -1.12263
15782 b_mtem(3,ja,je) = -9.08728
15783 b_mtem(4,ja,je) = 30.3836
15784 b_mtem(5,ja,je) = -38.4133
15785 b_mtem(6,ja,je) = 17.0106
15786
15787 ! in nh4hso4
15788 je = jnh4hso4
15789 b_mtem(1,ja,je) = -2.03879
15790 b_mtem(2,ja,je) = 15.7033
15791 b_mtem(3,ja,je) = -58.7363
15792 b_mtem(4,ja,je) = 109.242
15793 b_mtem(5,ja,je) = -102.237
15794 b_mtem(6,ja,je) = 37.5350
15795
15796 ! in (nh4)3h(so4)2
15797 je = jlvcite
15798 b_mtem(1,ja,je) = -3.10228
15799 b_mtem(2,ja,je) = 16.6920
15800 b_mtem(3,ja,je) = -59.1522
15801 b_mtem(4,ja,je) = 113.487
15802 b_mtem(5,ja,je) = -110.890
15803 b_mtem(6,ja,je) = 42.4578
15804
15805 ! in (nh4)2so4
15806 je = jnh4so4
15807 b_mtem(1,ja,je) = -3.43885
15808 b_mtem(2,ja,je) = 21.0372
15809 b_mtem(3,ja,je) = -84.7026
15810 b_mtem(4,ja,je) = 165.324
15811 b_mtem(5,ja,je) = -156.101
15812 b_mtem(6,ja,je) = 57.3101
15813
15814 ! in nahso4
15815 je = jnahso4
15816 b_mtem(1,ja,je) = 0.33164
15817 b_mtem(2,ja,je) = 6.55864
15818 b_mtem(3,ja,je) = -33.5876
15819 b_mtem(4,ja,je) = 65.1798
15820 b_mtem(5,ja,je) = -63.2046
15821 b_mtem(6,ja,je) = 24.1783
15822
15823 ! in na3h(so4)2
15824 je = jna3hso4
15825 b_mtem(1,ja,je) = 3.06830
15826 b_mtem(2,ja,je) = -3.18408
15827 b_mtem(3,ja,je) = -19.6332
15828 b_mtem(4,ja,je) = 61.3657
15829 b_mtem(5,ja,je) = -73.4438
15830 b_mtem(6,ja,je) = 31.2334
15831
15832 ! in na2so4
15833 je = jna2so4
15834 b_mtem(1,ja,je) = 2.58649
15835 b_mtem(2,ja,je) = 0.87921
15836 b_mtem(3,ja,je) = -39.3023
15837 b_mtem(4,ja,je) = 101.603
15838 b_mtem(5,ja,je) = -109.469
15839 b_mtem(6,ja,je) = 43.0188
15840
15841 ! in hno3
15842 je = jhno3
15843 b_mtem(1,ja,je) = 1.54587
15844 b_mtem(2,ja,je) = -7.50976
15845 b_mtem(3,ja,je) = 12.8237
15846 b_mtem(4,ja,je) = -10.1452
15847 b_mtem(5,ja,je) = -0.541956
15848 b_mtem(6,ja,je) = 3.34536
15849
15850 ! in hcl
15851 je = jhcl
15852 b_mtem(1,ja,je) = 0.829757
15853 b_mtem(2,ja,je) = -4.11316
15854 b_mtem(3,ja,je) = 3.67111
15855 b_mtem(4,ja,je) = 3.6833
15856 b_mtem(5,ja,je) = -11.2711
15857 b_mtem(6,ja,je) = 6.71421
15858
15859
15860 !----------
15861 ! h.hso4 in e
15862 ja = jhhso4
15863
15864 ! in h2so4
15865 je = jh2so4
15866 b_mtem(1,ja,je) = 2.63953
15867 b_mtem(2,ja,je) = -6.01532
15868 b_mtem(3,ja,je) = 10.0204
15869 b_mtem(4,ja,je) = -12.4840
15870 b_mtem(5,ja,je) = 7.78853
15871 b_mtem(6,ja,je) = -2.12638
15872
15873 ! in nh4hso4
15874 je = jnh4hso4
15875 b_mtem(1,ja,je) = -0.77412
15876 b_mtem(2,ja,je) = 14.1656
15877 b_mtem(3,ja,je) = -53.4087
15878 b_mtem(4,ja,je) = 93.2013
15879 b_mtem(5,ja,je) = -80.5723
15880 b_mtem(6,ja,je) = 27.1577
15881
15882 ! in (nh4)3h(so4)2
15883 je = jlvcite
15884 b_mtem(1,ja,je) = -2.98882
15885 b_mtem(2,ja,je) = 14.4436
15886 b_mtem(3,ja,je) = -40.1774
15887 b_mtem(4,ja,je) = 67.5937
15888 b_mtem(5,ja,je) = -61.5040
15889 b_mtem(6,ja,je) = 22.3695
15890
15891 ! in (nh4)2so4
15892 je = jnh4so4
15893 b_mtem(1,ja,je) = -1.15502
15894 b_mtem(2,ja,je) = 8.12309
15895 b_mtem(3,ja,je) = -38.4726
15896 b_mtem(4,ja,je) = 80.8861
15897 b_mtem(5,ja,je) = -80.1644
15898 b_mtem(6,ja,je) = 30.4717
15899
15900 ! in nahso4
15901 je = jnahso4
15902 b_mtem(1,ja,je) = 1.99641
15903 b_mtem(2,ja,je) = -2.96061
15904 b_mtem(3,ja,je) = 5.54778
15905 b_mtem(4,ja,je) = -14.5488
15906 b_mtem(5,ja,je) = 14.8492
15907 b_mtem(6,ja,je) = -5.1389
15908
15909 ! in na3h(so4)2
15910 je = jna3hso4
15911 b_mtem(1,ja,je) = 2.23816
15912 b_mtem(2,ja,je) = -3.20847
15913 b_mtem(3,ja,je) = -4.82853
15914 b_mtem(4,ja,je) = 20.9192
15915 b_mtem(5,ja,je) = -27.2819
15916 b_mtem(6,ja,je) = 11.8655
15917
15918 ! in na2so4
15919 je = jna2so4
15920 b_mtem(1,ja,je) = 2.56907
15921 b_mtem(2,ja,je) = 1.13444
15922 b_mtem(3,ja,je) = -34.6853
15923 b_mtem(4,ja,je) = 87.9775
15924 b_mtem(5,ja,je) = -93.2330
15925 b_mtem(6,ja,je) = 35.9260
15926
15927 ! in hno3
15928 je = jhno3
15929 b_mtem(1,ja,je) = 2.00024
15930 b_mtem(2,ja,je) = -4.80868
15931 b_mtem(3,ja,je) = 8.29222
15932 b_mtem(4,ja,je) = -11.0849
15933 b_mtem(5,ja,je) = 7.51262
15934 b_mtem(6,ja,je) = -2.07654
15935
15936 ! in hcl
15937 je = jhcl
15938 b_mtem(1,ja,je) = 2.8009
15939 b_mtem(2,ja,je) = -6.98416
15940 b_mtem(3,ja,je) = 14.3146
15941 b_mtem(4,ja,je) = -22.0068
15942 b_mtem(5,ja,je) = 17.5557
15943 b_mtem(6,ja,je) = -5.84917
15944
15945
15946 !----------
15947 ! nh4hso4 in e
15948 ja = jnh4hso4
15949
15950 ! in h2so4
15951 je = jh2so4
15952 b_mtem(1,ja,je) = 0.169160
15953 b_mtem(2,ja,je) = 2.15094
15954 b_mtem(3,ja,je) = -9.62904
15955 b_mtem(4,ja,je) = 18.2631
15956 b_mtem(5,ja,je) = -17.3333
15957 b_mtem(6,ja,je) = 6.19835
15958
15959 ! in nh4hso4
15960 je = jnh4hso4
15961 b_mtem(1,ja,je) = -2.34457
15962 b_mtem(2,ja,je) = 12.8035
15963 b_mtem(3,ja,je) = -35.2513
15964 b_mtem(4,ja,je) = 53.6153
15965 b_mtem(5,ja,je) = -42.7655
15966 b_mtem(6,ja,je) = 13.7129
15967
15968 ! in (nh4)3h(so4)2
15969 je = jlvcite
15970 b_mtem(1,ja,je) = -2.56109
15971 b_mtem(2,ja,je) = 11.1414
15972 b_mtem(3,ja,je) = -30.2361
15973 b_mtem(4,ja,je) = 50.0320
15974 b_mtem(5,ja,je) = -44.1586
15975 b_mtem(6,ja,je) = 15.5393
15976
15977 ! in (nh4)2so4
15978 je = jnh4so4
15979 b_mtem(1,ja,je) = -0.97315
15980 b_mtem(2,ja,je) = 7.06295
15981 b_mtem(3,ja,je) = -29.3032
15982 b_mtem(4,ja,je) = 57.6101
15983 b_mtem(5,ja,je) = -54.9020
15984 b_mtem(6,ja,je) = 20.2222
15985
15986 ! in nahso4
15987 je = jnahso4
15988 b_mtem(1,ja,je) = -0.44450
15989 b_mtem(2,ja,je) = 3.33451
15990 b_mtem(3,ja,je) = -15.2791
15991 b_mtem(4,ja,je) = 30.1413
15992 b_mtem(5,ja,je) = -26.7710
15993 b_mtem(6,ja,je) = 8.78462
15994
15995 ! in na3h(so4)2
15996 je = jna3hso4
15997 b_mtem(1,ja,je) = -0.99780
15998 b_mtem(2,ja,je) = 4.69200
15999 b_mtem(3,ja,je) = -16.1219
16000 b_mtem(4,ja,je) = 29.3100
16001 b_mtem(5,ja,je) = -26.3383
16002 b_mtem(6,ja,je) = 9.20695
16003
16004 ! in na2so4
16005 je = jna2so4
16006 b_mtem(1,ja,je) = -0.52694
16007 b_mtem(2,ja,je) = 7.02684
16008 b_mtem(3,ja,je) = -33.7508
16009 b_mtem(4,ja,je) = 70.0565
16010 b_mtem(5,ja,je) = -68.3226
16011 b_mtem(6,ja,je) = 25.2692
16012
16013 ! in hno3
16014 je = jhno3
16015 b_mtem(1,ja,je) = 0.572926
16016 b_mtem(2,ja,je) = -2.04791
16017 b_mtem(3,ja,je) = 2.1134
16018 b_mtem(4,ja,je) = 0.246654
16019 b_mtem(5,ja,je) = -3.06019
16020 b_mtem(6,ja,je) = 1.98126
16021
16022 ! in hcl
16023 je = jhcl
16024 b_mtem(1,ja,je) = 0.56514
16025 b_mtem(2,ja,je) = 0.22287
16026 b_mtem(3,ja,je) = -2.76973
16027 b_mtem(4,ja,je) = 4.54444
16028 b_mtem(5,ja,je) = -3.86549
16029 b_mtem(6,ja,je) = 1.13441
16030
16031
16032 !----------
16033 ! (nh4)3h(so4)2 in e
16034 ja = jlvcite
16035
16036 ! in h2so4
16037 je = jh2so4
16038 b_mtem(1,ja,je) = -1.44811
16039 b_mtem(2,ja,je) = 6.71815
16040 b_mtem(3,ja,je) = -25.0141
16041 b_mtem(4,ja,je) = 50.1109
16042 b_mtem(5,ja,je) = -50.0561
16043 b_mtem(6,ja,je) = 19.3370
16044
16045 ! in nh4hso4
16046 je = jnh4hso4
16047 b_mtem(1,ja,je) = -3.41707
16048 b_mtem(2,ja,je) = 13.4496
16049 b_mtem(3,ja,je) = -34.8018
16050 b_mtem(4,ja,je) = 55.2987
16051 b_mtem(5,ja,je) = -48.1839
16052 b_mtem(6,ja,je) = 17.2444
16053
16054 ! in (nh4)3h(so4)2
16055 je = jlvcite
16056 b_mtem(1,ja,je) = -2.54479
16057 b_mtem(2,ja,je) = 11.8501
16058 b_mtem(3,ja,je) = -39.7286
16059 b_mtem(4,ja,je) = 74.2479
16060 b_mtem(5,ja,je) = -70.4934
16061 b_mtem(6,ja,je) = 26.2836
16062
16063 ! in (nh4)2so4
16064 je = jnh4so4
16065 b_mtem(1,ja,je) = -2.30561
16066 b_mtem(2,ja,je) = 14.5806
16067 b_mtem(3,ja,je) = -55.1238
16068 b_mtem(4,ja,je) = 103.451
16069 b_mtem(5,ja,je) = -95.2571
16070 b_mtem(6,ja,je) = 34.2218
16071
16072 ! in nahso4
16073 je = jnahso4
16074 b_mtem(1,ja,je) = -2.20809
16075 b_mtem(2,ja,je) = 13.6391
16076 b_mtem(3,ja,je) = -57.8246
16077 b_mtem(4,ja,je) = 117.907
16078 b_mtem(5,ja,je) = -112.154
16079 b_mtem(6,ja,je) = 40.3058
16080
16081 ! in na3h(so4)2
16082 je = jna3hso4
16083 b_mtem(1,ja,je) = -1.15099
16084 b_mtem(2,ja,je) = 6.32269
16085 b_mtem(3,ja,je) = -27.3860
16086 b_mtem(4,ja,je) = 55.4592
16087 b_mtem(5,ja,je) = -54.0100
16088 b_mtem(6,ja,je) = 20.3469
16089
16090 ! in na2so4
16091 je = jna2so4
16092 b_mtem(1,ja,je) = -1.15678
16093 b_mtem(2,ja,je) = 8.28718
16094 b_mtem(3,ja,je) = -37.3231
16095 b_mtem(4,ja,je) = 76.6124
16096 b_mtem(5,ja,je) = -74.9307
16097 b_mtem(6,ja,je) = 28.0559
16098
16099 ! in hno3
16100 je = jhno3
16101 b_mtem(1,ja,je) = 0.01502
16102 b_mtem(2,ja,je) = -3.1197
16103 b_mtem(3,ja,je) = 3.61104
16104 b_mtem(4,ja,je) = 3.05196
16105 b_mtem(5,ja,je) = -9.98957
16106 b_mtem(6,ja,je) = 6.04155
16107
16108 ! in hcl
16109 je = jhcl
16110 b_mtem(1,ja,je) = -1.06477
16111 b_mtem(2,ja,je) = 3.38801
16112 b_mtem(3,ja,je) = -12.5784
16113 b_mtem(4,ja,je) = 25.2823
16114 b_mtem(5,ja,je) = -25.4611
16115 b_mtem(6,ja,je) = 10.0754
16116
16117
16118 !----------
16119 ! nahso4 in e
16120 ja = jnahso4
16121
16122 ! in h2so4
16123 je = jh2so4
16124 b_mtem(1,ja,je) = 0.68259
16125 b_mtem(2,ja,je) = 0.71468
16126 b_mtem(3,ja,je) = -5.59003
16127 b_mtem(4,ja,je) = 11.0089
16128 b_mtem(5,ja,je) = -10.7983
16129 b_mtem(6,ja,je) = 3.82335
16130
16131 ! in nh4hso4
16132 je = jnh4hso4
16133 b_mtem(1,ja,je) = -0.03956
16134 b_mtem(2,ja,je) = 4.52828
16135 b_mtem(3,ja,je) = -25.2557
16136 b_mtem(4,ja,je) = 54.4225
16137 b_mtem(5,ja,je) = -52.5105
16138 b_mtem(6,ja,je) = 18.6562
16139
16140 ! in (nh4)3h(so4)2
16141 je = jlvcite
16142 b_mtem(1,ja,je) = -1.53503
16143 b_mtem(2,ja,je) = 8.27608
16144 b_mtem(3,ja,je) = -28.9539
16145 b_mtem(4,ja,je) = 55.2876
16146 b_mtem(5,ja,je) = -51.9563
16147 b_mtem(6,ja,je) = 18.6576
16148
16149 ! in (nh4)2so4
16150 je = jnh4so4
16151 b_mtem(1,ja,je) = -0.38793
16152 b_mtem(2,ja,je) = 7.14680
16153 b_mtem(3,ja,je) = -38.7201
16154 b_mtem(4,ja,je) = 84.3965
16155 b_mtem(5,ja,je) = -84.7453
16156 b_mtem(6,ja,je) = 32.1283
16157
16158 ! in nahso4
16159 je = jnahso4
16160 b_mtem(1,ja,je) = -0.41982
16161 b_mtem(2,ja,je) = 4.26491
16162 b_mtem(3,ja,je) = -20.2351
16163 b_mtem(4,ja,je) = 42.6764
16164 b_mtem(5,ja,je) = -40.7503
16165 b_mtem(6,ja,je) = 14.2868
16166
16167 ! in na3h(so4)2
16168 je = jna3hso4
16169 b_mtem(1,ja,je) = -0.32912
16170 b_mtem(2,ja,je) = 1.80808
16171 b_mtem(3,ja,je) = -8.01286
16172 b_mtem(4,ja,je) = 15.5791
16173 b_mtem(5,ja,je) = -14.5494
16174 b_mtem(6,ja,je) = 5.27052
16175
16176 ! in na2so4
16177 je = jna2so4
16178 b_mtem(1,ja,je) = 0.10271
16179 b_mtem(2,ja,je) = 5.09559
16180 b_mtem(3,ja,je) = -30.3295
16181 b_mtem(4,ja,je) = 66.2975
16182 b_mtem(5,ja,je) = -66.3458
16183 b_mtem(6,ja,je) = 24.9443
16184
16185 ! in hno3
16186 je = jhno3
16187 b_mtem(1,ja,je) = 0.608309
16188 b_mtem(2,ja,je) = -0.541905
16189 b_mtem(3,ja,je) = -2.52084
16190 b_mtem(4,ja,je) = 6.63297
16191 b_mtem(5,ja,je) = -7.24599
16192 b_mtem(6,ja,je) = 2.88811
16193
16194 ! in hcl
16195 je = jhcl
16196 b_mtem(1,ja,je) = 1.98399
16197 b_mtem(2,ja,je) = -4.51562
16198 b_mtem(3,ja,je) = 8.36059
16199 b_mtem(4,ja,je) = -12.4948
16200 b_mtem(5,ja,je) = 9.67514
16201 b_mtem(6,ja,je) = -3.18004
16202
16203
16204 !----------
16205 ! na3h(so4)2 in e
16206 ja = jna3hso4
16207
16208 ! in h2so4
16209 je = jh2so4
16210 b_mtem(1,ja,je) = -0.83214
16211 b_mtem(2,ja,je) = 4.99572
16212 b_mtem(3,ja,je) = -20.1697
16213 b_mtem(4,ja,je) = 41.4066
16214 b_mtem(5,ja,je) = -42.2119
16215 b_mtem(6,ja,je) = 16.4855
16216
16217 ! in nh4hso4
16218 je = jnh4hso4
16219 b_mtem(1,ja,je) = -0.65139
16220 b_mtem(2,ja,je) = 3.52300
16221 b_mtem(3,ja,je) = -22.8220
16222 b_mtem(4,ja,je) = 56.2956
16223 b_mtem(5,ja,je) = -59.9028
16224 b_mtem(6,ja,je) = 23.1844
16225
16226 ! in (nh4)3h(so4)2
16227 je = jlvcite
16228 b_mtem(1,ja,je) = -1.31331
16229 b_mtem(2,ja,je) = 8.40835
16230 b_mtem(3,ja,je) = -38.1757
16231 b_mtem(4,ja,je) = 80.5312
16232 b_mtem(5,ja,je) = -79.8346
16233 b_mtem(6,ja,je) = 30.0219
16234
16235 ! in (nh4)2so4
16236 je = jnh4so4
16237 b_mtem(1,ja,je) = -1.03054
16238 b_mtem(2,ja,je) = 8.08155
16239 b_mtem(3,ja,je) = -38.1046
16240 b_mtem(4,ja,je) = 78.7168
16241 b_mtem(5,ja,je) = -77.2263
16242 b_mtem(6,ja,je) = 29.1521
16243
16244 ! in nahso4
16245 je = jnahso4
16246 b_mtem(1,ja,je) = -1.90695
16247 b_mtem(2,ja,je) = 11.6241
16248 b_mtem(3,ja,je) = -50.3175
16249 b_mtem(4,ja,je) = 105.884
16250 b_mtem(5,ja,je) = -103.258
16251 b_mtem(6,ja,je) = 37.6588
16252
16253 ! in na3h(so4)2
16254 je = jna3hso4
16255 b_mtem(1,ja,je) = -0.34780
16256 b_mtem(2,ja,je) = 2.85363
16257 b_mtem(3,ja,je) = -17.6224
16258 b_mtem(4,ja,je) = 38.9220
16259 b_mtem(5,ja,je) = -39.8106
16260 b_mtem(6,ja,je) = 15.6055
16261
16262 ! in na2so4
16263 je = jna2so4
16264 b_mtem(1,ja,je) = -0.75230
16265 b_mtem(2,ja,je) = 10.0140
16266 b_mtem(3,ja,je) = -50.5677
16267 b_mtem(4,ja,je) = 106.941
16268 b_mtem(5,ja,je) = -105.534
16269 b_mtem(6,ja,je) = 39.5196
16270
16271 ! in hno3
16272 je = jhno3
16273 b_mtem(1,ja,je) = 0.057456
16274 b_mtem(2,ja,je) = -1.31264
16275 b_mtem(3,ja,je) = -1.94662
16276 b_mtem(4,ja,je) = 10.7024
16277 b_mtem(5,ja,je) = -14.9946
16278 b_mtem(6,ja,je) = 7.12161
16279
16280 ! in hcl
16281 je = jhcl
16282 b_mtem(1,ja,je) = 0.637894
16283 b_mtem(2,ja,je) = -2.29719
16284 b_mtem(3,ja,je) = 0.765361
16285 b_mtem(4,ja,je) = 4.8748
16286 b_mtem(5,ja,je) = -9.25978
16287 b_mtem(6,ja,je) = 4.91773
16288 !
16289 !
16290 !
16291 !----------------------------------------------------------
16292 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3 (t in kelvin)
16293 ! valid temperature range: 240 - 320 k
16294 !----------------------------------------------------------
16295 !
16296 ! sulfate-poor systems
16297 ! ac
16298 j_index = 1
16299 d_mdrh(j_index,1) = -58.00268351
16300 d_mdrh(j_index,2) = 2.031077573
16301 d_mdrh(j_index,3) = -0.008281218
16302 d_mdrh(j_index,4) = 1.00447e-05
16303
16304 ! an
16305 j_index = 2
16306 d_mdrh(j_index,1) = 1039.137773
16307 d_mdrh(j_index,2) = -11.47847095
16308 d_mdrh(j_index,3) = 0.047702786
16309 d_mdrh(j_index,4) = -6.77675e-05
16310
16311 ! as
16312 j_index = 3
16313 d_mdrh(j_index,1) = 115.8366357
16314 d_mdrh(j_index,2) = 0.491881663
16315 d_mdrh(j_index,3) = -0.00422807
16316 d_mdrh(j_index,4) = 7.29274e-06
16317
16318 ! sc
16319 j_index = 4
16320 d_mdrh(j_index,1) = 253.2424151
16321 d_mdrh(j_index,2) = -1.429957864
16322 d_mdrh(j_index,3) = 0.003727554
16323 d_mdrh(j_index,4) = -3.13037e-06
16324
16325 ! sn
16326 j_index = 5
16327 d_mdrh(j_index,1) = -372.4306506
16328 d_mdrh(j_index,2) = 5.3955633
16329 d_mdrh(j_index,3) = -0.019804438
16330 d_mdrh(j_index,4) = 2.25662e-05
16331
16332 ! ss
16333 j_index = 6
16334 d_mdrh(j_index,1) = 286.1271416
16335 d_mdrh(j_index,2) = -1.670787758
16336 d_mdrh(j_index,3) = 0.004431373
16337 d_mdrh(j_index,4) = -3.57757e-06
16338
16339 ! cc
16340 j_index = 7
16341 d_mdrh(j_index,1) = -1124.07059
16342 d_mdrh(j_index,2) = 14.26364209
16343 d_mdrh(j_index,3) = -0.054816822
16344 d_mdrh(j_index,4) = 6.70107e-05
16345
16346 ! cn
16347 j_index = 8
16348 d_mdrh(j_index,1) = 1855.413934
16349 d_mdrh(j_index,2) = -20.29219473
16350 d_mdrh(j_index,3) = 0.07807482
16351 d_mdrh(j_index,4) = -1.017887858e-4
16352
16353 ! an + ac
16354 j_index = 9
16355 d_mdrh(j_index,1) = 1761.176886
16356 d_mdrh(j_index,2) = -19.29811062
16357 d_mdrh(j_index,3) = 0.075676987
16358 d_mdrh(j_index,4) = -1.0116959e-4
16359
16360 ! as + ac
16361 j_index = 10
16362 d_mdrh(j_index,1) = 122.1074303
16363 d_mdrh(j_index,2) = 0.429692122
16364 d_mdrh(j_index,3) = -0.003928277
16365 d_mdrh(j_index,4) = 6.43275e-06
16366
16367 ! as + an
16368 j_index = 11
16369 d_mdrh(j_index,1) = 2424.634678
16370 d_mdrh(j_index,2) = -26.54031307
16371 d_mdrh(j_index,3) = 0.101625387
16372 d_mdrh(j_index,4) = -1.31544547798e-4
16373
16374 ! as + an + ac
16375 j_index = 12
16376 d_mdrh(j_index,1) = 2912.082599
16377 d_mdrh(j_index,2) = -31.8894185
16378 d_mdrh(j_index,3) = 0.121185849
16379 d_mdrh(j_index,4) = -1.556534623e-4
16380
16381 ! sc + ac
16382 j_index = 13
16383 d_mdrh(j_index,1) = 172.2596493
16384 d_mdrh(j_index,2) = -0.511006195
16385 d_mdrh(j_index,3) = 4.27244597e-4
16386 d_mdrh(j_index,4) = 4.12797e-07
16387
16388 ! sn + ac
16389 j_index = 14
16390 d_mdrh(j_index,1) = 1596.184935
16391 d_mdrh(j_index,2) = -16.37945565
16392 d_mdrh(j_index,3) = 0.060281218
16393 d_mdrh(j_index,4) = -7.6161e-05
16394
16395 ! sn + an
16396 j_index = 15
16397 d_mdrh(j_index,1) = 1916.072988
16398 d_mdrh(j_index,2) = -20.85594868
16399 d_mdrh(j_index,3) = 0.081140141
16400 d_mdrh(j_index,4) = -1.07954274796e-4
16401
16402 ! sn + an + ac
16403 j_index = 16
16404 d_mdrh(j_index,1) = 1467.165935
16405 d_mdrh(j_index,2) = -16.01166196
16406 d_mdrh(j_index,3) = 0.063505582
16407 d_mdrh(j_index,4) = -8.66722e-05
16408
16409 ! sn + sc
16410 j_index = 17
16411 d_mdrh(j_index,1) = 158.447059
16412 d_mdrh(j_index,2) = -0.628167358
16413 d_mdrh(j_index,3) = 0.002014448
16414 d_mdrh(j_index,4) = -3.13037e-06
16415
16416 ! sn + sc + ac
16417 j_index = 18
16418 d_mdrh(j_index,1) = 1115.892468
16419 d_mdrh(j_index,2) = -11.76936534
16420 d_mdrh(j_index,3) = 0.045577399
16421 d_mdrh(j_index,4) = -6.05779e-05
16422
16423 ! ss + ac
16424 j_index = 19
16425 d_mdrh(j_index,1) = 269.5432407
16426 d_mdrh(j_index,2) = -1.319963885
16427 d_mdrh(j_index,3) = 0.002592363
16428 d_mdrh(j_index,4) = -1.44479e-06
16429
16430 ! ss + an
16431 j_index = 20
16432 d_mdrh(j_index,1) = 2841.334784
16433 d_mdrh(j_index,2) = -31.1889487
16434 d_mdrh(j_index,3) = 0.118809274
16435 d_mdrh(j_index,4) = -1.53007e-4
16436
16437 ! ss + an + ac
16438 j_index = 21
16439 d_mdrh(j_index,1) = 2199.36914
16440 d_mdrh(j_index,2) = -24.11926569
16441 d_mdrh(j_index,3) = 0.092932361
16442 d_mdrh(j_index,4) = -1.21774e-4
16443
16444 ! ss + as
16445 j_index = 22
16446 d_mdrh(j_index,1) = 395.0051604
16447 d_mdrh(j_index,2) = -2.521101657
16448 d_mdrh(j_index,3) = 0.006139319
16449 d_mdrh(j_index,4) = -4.43756e-06
16450
16451 ! ss + as + ac
16452 j_index = 23
16453 d_mdrh(j_index,1) = 386.5150675
16454 d_mdrh(j_index,2) = -2.4632138
16455 d_mdrh(j_index,3) = 0.006139319
16456 d_mdrh(j_index,4) = -4.98796e-06
16457
16458 ! ss + as + an
16459 j_index = 24
16460 d_mdrh(j_index,1) = 3101.538491
16461 d_mdrh(j_index,2) = -34.19978105
16462 d_mdrh(j_index,3) = 0.130118605
16463 d_mdrh(j_index,4) = -1.66873e-4
16464
16465 ! ss + as + an + ac
16466 j_index = 25
16467 d_mdrh(j_index,1) = 2307.579403
16468 d_mdrh(j_index,2) = -25.43136774
16469 d_mdrh(j_index,3) = 0.098064728
16470 d_mdrh(j_index,4) = -1.28301e-4
16471
16472 ! ss + sc
16473 j_index = 26
16474 d_mdrh(j_index,1) = 291.8309602
16475 d_mdrh(j_index,2) = -1.828912974
16476 d_mdrh(j_index,3) = 0.005053148
16477 d_mdrh(j_index,4) = -4.57516e-06
16478
16479 ! ss + sc + ac
16480 j_index = 27
16481 d_mdrh(j_index,1) = 188.3914345
16482 d_mdrh(j_index,2) = -0.631345031
16483 d_mdrh(j_index,3) = 0.000622807
16484 d_mdrh(j_index,4) = 4.47196e-07
16485
16486 ! ss + sn
16487 j_index = 28
16488 d_mdrh(j_index,1) = -167.1252839
16489 d_mdrh(j_index,2) = 2.969828002
16490 d_mdrh(j_index,3) = -0.010637255
16491 d_mdrh(j_index,4) = 1.13175e-05
16492
16493 ! ss + sn + ac
16494 j_index = 29
16495 d_mdrh(j_index,1) = 1516.782768
16496 d_mdrh(j_index,2) = -15.7922661
16497 d_mdrh(j_index,3) = 0.058942209
16498 d_mdrh(j_index,4) = -7.5301e-05
16499
16500 ! ss + sn + an
16501 j_index = 30
16502 d_mdrh(j_index,1) = 1739.963163
16503 d_mdrh(j_index,2) = -19.06576022
16504 d_mdrh(j_index,3) = 0.07454963
16505 d_mdrh(j_index,4) = -9.94302e-05
16506
16507 ! ss + sn + an + ac
16508 j_index = 31
16509 d_mdrh(j_index,1) = 2152.104877
16510 d_mdrh(j_index,2) = -23.74998008
16511 d_mdrh(j_index,3) = 0.092256654
16512 d_mdrh(j_index,4) = -1.21953e-4
16513
16514 ! ss + sn + sc
16515 j_index = 32
16516 d_mdrh(j_index,1) = 221.9976265
16517 d_mdrh(j_index,2) = -1.311331272
16518 d_mdrh(j_index,3) = 0.004406089
16519 d_mdrh(j_index,4) = -5.88235e-06
16520
16521 ! ss + sn + sc + ac
16522 j_index = 33
16523 d_mdrh(j_index,1) = 1205.645615
16524 d_mdrh(j_index,2) = -12.71353459
16525 d_mdrh(j_index,3) = 0.048803922
16526 d_mdrh(j_index,4) = -6.41899e-05
16527
16528 ! cc + ac
16529 j_index = 34
16530 d_mdrh(j_index,1) = 506.6737879
16531 d_mdrh(j_index,2) = -3.723520818
16532 d_mdrh(j_index,3) = 0.010814242
16533 d_mdrh(j_index,4) = -1.21087e-05
16534
16535 ! cc + sc
16536 j_index = 35
16537 d_mdrh(j_index,1) = -1123.523841
16538 d_mdrh(j_index,2) = 14.08345977
16539 d_mdrh(j_index,3) = -0.053687823
16540 d_mdrh(j_index,4) = 6.52219e-05
16541
16542 ! cc + sc + ac
16543 j_index = 36
16544 d_mdrh(j_index,1) = -1159.98607
16545 d_mdrh(j_index,2) = 14.44309169
16546 d_mdrh(j_index,3) = -0.054841073
16547 d_mdrh(j_index,4) = 6.64259e-05
16548
16549 ! cn + ac
16550 j_index = 37
16551 d_mdrh(j_index,1) = 756.0747916
16552 d_mdrh(j_index,2) = -8.546826257
16553 d_mdrh(j_index,3) = 0.035798677
16554 d_mdrh(j_index,4) = -5.06629e-05
16555
16556 ! cn + an
16557 j_index = 38
16558 d_mdrh(j_index,1) = 338.668191
16559 d_mdrh(j_index,2) = -2.971223403
16560 d_mdrh(j_index,3) = 0.012294866
16561 d_mdrh(j_index,4) = -1.87558e-05
16562
16563 ! cn + an + ac
16564 j_index = 39
16565 d_mdrh(j_index,1) = -53.18033508
16566 d_mdrh(j_index,2) = 0.663911748
16567 d_mdrh(j_index,3) = 9.16326e-4
16568 d_mdrh(j_index,4) = -6.70354e-06
16569
16570 ! cn + sc
16571 j_index = 40
16572 d_mdrh(j_index,1) = 3623.831129
16573 d_mdrh(j_index,2) = -39.27226457
16574 d_mdrh(j_index,3) = 0.144559515
16575 d_mdrh(j_index,4) = -1.78159e-4
16576
16577 ! cn + sc + ac
16578 j_index = 41
16579 d_mdrh(j_index,1) = 3436.656743
16580 d_mdrh(j_index,2) = -37.16192684
16581 d_mdrh(j_index,3) = 0.136641377
16582 d_mdrh(j_index,4) = -1.68262e-4
16583
16584 ! cn + sn
16585 j_index = 42
16586 d_mdrh(j_index,1) = 768.608476
16587 d_mdrh(j_index,2) = -8.051517149
16588 d_mdrh(j_index,3) = 0.032342332
16589 d_mdrh(j_index,4) = -4.52224e-05
16590
16591 ! cn + sn + ac
16592 j_index = 43
16593 d_mdrh(j_index,1) = 33.58027951
16594 d_mdrh(j_index,2) = -0.308772182
16595 d_mdrh(j_index,3) = 0.004713639
16596 d_mdrh(j_index,4) = -1.19658e-05
16597
16598 ! cn + sn + an
16599 j_index = 44
16600 d_mdrh(j_index,1) = 57.80183041
16601 d_mdrh(j_index,2) = 0.215264604
16602 d_mdrh(j_index,3) = 4.11406e-4
16603 d_mdrh(j_index,4) = -4.30702e-06
16604
16605 ! cn + sn + an + ac
16606 j_index = 45
16607 d_mdrh(j_index,1) = -234.368984
16608 d_mdrh(j_index,2) = 2.721045204
16609 d_mdrh(j_index,3) = -0.006688341
16610 d_mdrh(j_index,4) = 2.31729e-06
16611
16612 ! cn + sn + sc
16613 j_index = 46
16614 d_mdrh(j_index,1) = 3879.080557
16615 d_mdrh(j_index,2) = -42.13562874
16616 d_mdrh(j_index,3) = 0.155235005
16617 d_mdrh(j_index,4) = -1.91387e-4
16618
16619 ! cn + sn + sc + ac
16620 j_index = 47
16621 d_mdrh(j_index,1) = 3600.576985
16622 d_mdrh(j_index,2) = -39.0283489
16623 d_mdrh(j_index,3) = 0.143710316
16624 d_mdrh(j_index,4) = -1.77167e-4
16625
16626 ! cn + cc
16627 j_index = 48
16628 d_mdrh(j_index,1) = -1009.729826
16629 d_mdrh(j_index,2) = 12.9145339
16630 d_mdrh(j_index,3) = -0.049811146
16631 d_mdrh(j_index,4) = 6.09563e-05
16632
16633 ! cn + cc + ac
16634 j_index = 49
16635 d_mdrh(j_index,1) = -577.0919514
16636 d_mdrh(j_index,2) = 8.020324227
16637 d_mdrh(j_index,3) = -0.031469556
16638 d_mdrh(j_index,4) = 3.82181e-05
16639
16640 ! cn + cc + sc
16641 j_index = 50
16642 d_mdrh(j_index,1) = -728.9983499
16643 d_mdrh(j_index,2) = 9.849458215
16644 d_mdrh(j_index,3) = -0.03879257
16645 d_mdrh(j_index,4) = 4.78844e-05
16646
16647 ! cn + cc + sc + ac
16648 j_index = 51
16649 d_mdrh(j_index,1) = -803.7026845
16650 d_mdrh(j_index,2) = 10.61881494
16651 d_mdrh(j_index,3) = -0.041402993
16652 d_mdrh(j_index,4) = 5.08084e-05
16653
16654 !
16655 ! sulfate-rich systems
16656 ! ab
16657 j_index = 52
16658 d_mdrh(j_index,1) = -493.6190458
16659 d_mdrh(j_index,2) = 6.747053851
16660 d_mdrh(j_index,3) = -0.026955267
16661 d_mdrh(j_index,4) = 3.45118e-05
16662
16663 ! lv
16664 j_index = 53
16665 d_mdrh(j_index,1) = 53.37874093
16666 d_mdrh(j_index,2) = 1.01368249
16667 d_mdrh(j_index,3) = -0.005887513
16668 d_mdrh(j_index,4) = 8.94393e-06
16669
16670 ! sb
16671 j_index = 54
16672 d_mdrh(j_index,1) = 206.619047
16673 d_mdrh(j_index,2) = -1.342735684
16674 d_mdrh(j_index,3) = 0.003197691
16675 d_mdrh(j_index,4) = -1.93603e-06
16676
16677 ! ab + lv
16678 j_index = 55
16679 d_mdrh(j_index,1) = -493.6190458
16680 d_mdrh(j_index,2) = 6.747053851
16681 d_mdrh(j_index,3) = -0.026955267
16682 d_mdrh(j_index,4) = 3.45118e-05
16683
16684 ! as + lv
16685 j_index = 56
16686 d_mdrh(j_index,1) = 53.37874093
16687 d_mdrh(j_index,2) = 1.01368249
16688 d_mdrh(j_index,3) = -0.005887513
16689 d_mdrh(j_index,4) = 8.94393e-06
16690
16691 ! ss + sb
16692 j_index = 57
16693 d_mdrh(j_index,1) = 206.619047
16694 d_mdrh(j_index,2) = -1.342735684
16695 d_mdrh(j_index,3) = 0.003197691
16696 d_mdrh(j_index,4) = -1.93603e-06
16697
16698 ! ss + lv
16699 j_index = 58
16700 d_mdrh(j_index,1) = 41.7619047
16701 d_mdrh(j_index,2) = 1.303872053
16702 d_mdrh(j_index,3) = -0.007647908
16703 d_mdrh(j_index,4) = 1.17845e-05
16704
16705 ! ss + as + lv
16706 j_index = 59
16707 d_mdrh(j_index,1) = 41.7619047
16708 d_mdrh(j_index,2) = 1.303872053
16709 d_mdrh(j_index,3) = -0.007647908
16710 d_mdrh(j_index,4) = 1.17845e-05
16711
16712 ! ss + ab
16713 j_index = 60
16714 d_mdrh(j_index,1) = -369.7142842
16715 d_mdrh(j_index,2) = 5.512878771
16716 d_mdrh(j_index,3) = -0.02301948
16717 d_mdrh(j_index,4) = 3.0303e-05
16718
16719 ! ss + lv + ab
16720 j_index = 61
16721 d_mdrh(j_index,1) = -369.7142842
16722 d_mdrh(j_index,2) = 5.512878771
16723 d_mdrh(j_index,3) = -0.02301948
16724 d_mdrh(j_index,4) = 3.0303e-05
16725
16726 ! sb + ab
16727 j_index = 62
16728 d_mdrh(j_index,1) = -162.8095232
16729 d_mdrh(j_index,2) = 2.399326592
16730 d_mdrh(j_index,3) = -0.009336219
16731 d_mdrh(j_index,4) = 1.17845e-05
16732
16733 ! ss + sb + ab
16734 j_index = 63
16735 d_mdrh(j_index,1) = -735.4285689
16736 d_mdrh(j_index,2) = 8.885521857
16737 d_mdrh(j_index,3) = -0.033488456
16738 d_mdrh(j_index,4) = 4.12458e-05
16739
16740
16741
16742 !-----------------------------------------------------------------------------
16743 !
16744 ! psc activity coefficient model data
16745 !
16746 !-----------------------------------------------------------------------------
16747 !
16748 ! magnitude of the charges on ions
16749 izc(jc_h) = 1
16750 izc(jc_nh4) = 1
16751 izc(jc_na) = 1
16752 izc(jc_ca) = 2
16753 !
16754 iza(ja_hso4) = 1
16755 iza(ja_so4) = 2
16756 iza(ja_no3) = 1
16757 iza(ja_cl) = 1
16758
16759 do jc = 1, ncation
16760 zc(jc) = float(izc(jc))
16761 enddo
16762
16763 do ja = 1, nanion
16764 za(ja) = float(iza(ja))
16765 enddo
16766
16767
16768 ! model parameters
16769 !
16770 ! fitted binary parameters
16771 !
16772 ! long-range debye-huckel contributions
16773
16774 ax = 2.917 ! debye-huckel parameter (mol fraction basis) @ 298 k
16775 rho = 13.0 ! a constant at all temperatures and pressures.
16776 tdum = 298.15
16777 ! tt = te - 328.15
16778 tt = 298.15 - 328.15
16779
16780 !
16781 !---------------------------
16782 ! (h,a)
16783 bc_a(jc_h,ja_hso4) = 0.178334467e2 + &
16784 tt*(-0.625268629e1 *1.e-1 + &
16785 tt*(0.295714662 *1.e-2 + &
16786 tt*(0.223751841 *1.e-3/6.0 + &
16787 tt*(0.0 *1.e-3/12.0 + &
16788 tt*0.0 *1.e-3/20.0))))
16789 bc_a(jc_h,ja_so4) = -0.982408701e2 + &
16790 tt*(-0.205401806e2 *1.e-1 + &
16791 tt*(-0.103568646e1 *1.e-2 + &
16792 tt*(-0.376521937e-1 *1.e-3/6.0 + &
16793 tt*(-0.139689758e-1 *1.e-3/12.0 + &
16794 tt*0.0 *1.e-3/20.0))))
16795 bc_a(jc_h,ja_no3) = 13.53417796 ! @@@@
16796 bc_a(jc_h,ja_cl) = 17.5347093 ! @@@@
16797
16798 b1_c_a(jc_h,ja_hso4) = 0.0 ! @@@@
16799 b1_c_a(jc_h,ja_so4) = 0.0 ! @@@@
16800 b1_c_a(jc_h,ja_no3) = 0.0 ! @@@@
16801 b1_c_a(jc_h,ja_cl) = 0.0 ! @@@@
16802
16803 alpha_c_a(jc_h,ja_hso4) = 17.0 ! @@@@
16804 alpha_c_a(jc_h,ja_so4) = 9.5 ! @@@@
16805 alpha_c_a(jc_h,ja_no3) = 17.0 ! @@@@
16806 alpha_c_a(jc_h,ja_cl) = 13.0 ! @@@@
16807
16808 alpha1_c_a(jc_h,ja_hso4) = 0.0 ! @@@@
16809 alpha1_c_a(jc_h,ja_so4) = 0.0 ! @@@@
16810 alpha1_c_a(jc_h,ja_no3) = 0.0 ! @@@@
16811 alpha1_c_a(jc_h,ja_cl) = 0.0 ! @@@@
16812 !
16813 ! (nh4,a)
16814 bc_a(jc_nh4,ja_hso4) = 14.2261681 ! @@@@
16815 bc_a(jc_nh4,ja_so4) = -2.858988 ! @@@@
16816 bc_a(jc_nh4,ja_no3) = 24.7529 ! @@@@
16817 bc_a(jc_nh4,ja_cl) = 4.659688 ! @@@@
16818
16819 b1_c_a(jc_nh4,ja_hso4) = 0.0 ! @@@@
16820 b1_c_a(jc_nh4,ja_so4) = 0.0 ! @@@@
16821 b1_c_a(jc_nh4,ja_no3) = -29.9961 ! @@@@
16822 b1_c_a(jc_nh4,ja_cl) = 0.0 ! @@@@
16823
16824 alpha_c_a(jc_nh4,ja_hso4) = 19.0 ! @@@@
16825 alpha_c_a(jc_nh4,ja_so4) = 13.0 ! @@@@
16826 alpha_c_a(jc_nh4,ja_no3) = 7.0 ! @@@@
16827 alpha_c_a(jc_nh4,ja_cl) = 15.0 ! @@@@
16828
16829 alpha1_c_a(jc_nh4,ja_hso4)= 0.0 ! @@@@
16830 alpha1_c_a(jc_nh4,ja_so4) = 1.5 ! @@@@
16831 alpha1_c_a(jc_nh4,ja_no3) = 13.0 ! @@@@
16832 alpha1_c_a(jc_nh4,ja_cl) = 0.0 ! @@@@
16833 !
16834 ! (na,a)
16835 bc_a(jc_na,ja_hso4) = 62.27961 ! @@@@
16836 bc_a(jc_na,ja_so4) = 34.46602 ! @@@@
16837 bc_a(jc_na,ja_no3) = 26.99939 ! @@@@
16838 bc_a(jc_na,ja_cl) = 19.93376 ! @@@@
16839
16840 b1_c_a(jc_na,ja_hso4) = 0.0 ! @@@@
16841 b1_c_a(jc_na,ja_so4) = 0.0 ! @@@@
16842 b1_c_a(jc_na,ja_no3) = -21.6050 ! @@@@
16843 b1_c_a(jc_na,ja_cl) = 0.0 ! @@@@
16844
16845 alpha_c_a(jc_na,ja_hso4) = 19.0 ! @@@@
16846 alpha_c_a(jc_na,ja_so4) = 8.0 ! @@@@
16847 alpha_c_a(jc_na,ja_no3) = 5.0 ! @@@@
16848 alpha_c_a(jc_na,ja_cl) = 5.0 ! @@@@
16849
16850 alpha1_c_a(jc_na,ja_hso4) = 0.0 ! @@@@
16851 alpha1_c_a(jc_na,ja_so4) = 0.0 ! @@@@
16852 alpha1_c_a(jc_na,ja_no3) = 13.0 ! @@@@
16853 alpha1_c_a(jc_na,ja_cl) = 0.0 ! @@@@
16854
16855 !
16856 ! (ca,a) ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16857 bc_a(jc_ca,ja_hso4) = 0.0
16858 bc_a(jc_ca,ja_so4) = 0.0
16859 bc_a(jc_ca,ja_no3) = 33.251 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16860 bc_a(jc_ca,ja_cl) = 55.396 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16861
16862 b1_c_a(jc_ca,ja_hso4) = 0.0
16863 b1_c_a(jc_ca,ja_so4) = 0.0
16864 b1_c_a(jc_ca,ja_no3) = 66.931 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16865 b1_c_a(jc_ca,ja_cl) = 114.47 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16866
16867 alpha_c_a(jc_ca,ja_hso4) = 0.0
16868 alpha_c_a(jc_ca,ja_so4) = 0.0
16869 alpha_c_a(jc_ca,ja_no3) = 13.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16870 alpha_c_a(jc_ca,ja_cl) = 13.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16871
16872 alpha1_c_a(jc_ca,ja_hso4) = 0.0
16873 alpha1_c_a(jc_ca,ja_so4) = 0.0
16874 alpha1_c_a(jc_ca,ja_no3) = 2.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16875 alpha1_c_a(jc_ca,ja_cl) = 2.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16876
16877 !
16878 !
16879 ! short-range contributions
16880 !
16881 ! (h,a)
16882 u1_c_a(jc_h,ja_hso4) = -0.143238371e1 + &
16883 tt*(-0.201636224 *1.e-1 + &
16884 tt*(-0.221902116e-1 *1.e-2 + &
16885 tt*(0.641847819e-2 *1.e-3/6.0 + &
16886 tt*(0.296327801e-3 *1.e-3/12.0 + &
16887 tt*0.0 *1.e-3/20.0))))
16888
16889 u1_c_a(jc_h,ja_so4) = -0.133603464e2 + &
16890 tt*(-0.459479578e1 *1.e-1 + &
16891 tt*(-0.731101730 *1.e-2 + &
16892 tt*(-0.157872023 *1.e-3/6.0 + &
16893 tt*(-0.162230945e-3 *1.e-3/12.0 + &
16894 tt* 0.0 *1.e-3/20.0))))
16895 u1_c_a(jc_h,ja_no3) = 1.965818001 ! @@@@
16896
16897 u1_c_a(jc_h,ja_cl) = -13.7294155 ! @@@@
16898
16899 v1_c_a(jc_h,ja_hso4) = -0.207474566e1 + &
16900 tt*(0.594737744 *1.e-1 + &
16901 tt*(0.337026110e-1 *1.e-2 + &
16902 tt*(0.0 *1.e-3/6.0 + &
16903 tt*(-0.394845016e-3 *1.e-3/12.0 + &
16904 tt*0.d0 *1.e-3/20.0))))
16905
16906 v1_c_a(jc_h,ja_so4) = 0.310121997e1 + &
16907 tt*(0.446189009e1 *1.e-1 + &
16908 tt*(0.487627359 *1.e-2 + &
16909 tt*(0.588748231e-2 *1.e-3/6.0 + &
16910 tt*(-0.901983372e-3 *1.e-3/12.0 + &
16911 tt*0.0 *1.e-3/20.0))))
16912
16913 v1_c_a(jc_h,ja_no3) = -1.411912043 ! @@@@
16914 v1_c_a(jc_h,ja_cl) = 3.20778857 ! @@@@
16915
16916 w1_c_a(jc_h,ja_hso4) = -0.998416390e1 + &
16917 tt*(0.348821776 *1.e-1 + &
16918 tt*(-0.597630850e-2 *1.e-2 + &
16919 tt*(0.909425662e-2 *1.e-3/6.0 + &
16920 tt*(0.149166944e-3 *1.e-3/12.0 + &
16921 tt*0.0 *1.e-3/20.0))))
16922
16923 w1_c_a(jc_h,ja_so4) = -0.107752155e2 + &
16924 tt*(-0.879298257 *1.e-1 + &
16925 tt*(-0.220264243 *1.e-2 + &
16926 tt*(-0.544913927e-1 *1.e-3/6.0 + &
16927 tt*(-0.173541364e-3 *1.e-3/12.0 + &
16928 tt*0.0 *1.e-3/20.0))))
16929
16930 w1_c_a(jc_h,ja_no3) = -3.071864721 ! @@@@
16931 w1_c_a(jc_h,ja_cl) = -14.9654933 ! @@@@
16932 !
16933 ! (nh4,a)
16934 u1_c_a(jc_nh4,ja_hso4) = -0.796273529 ! @@@@
16935 u1_c_a(jc_nh4,ja_so4) = 0.940860 ! @@@@
16936 u1_c_a(jc_nh4,ja_no3) = 0.379736 ! @@@@
16937 u1_c_a(jc_nh4,ja_cl) = 2.072437 ! @@@@
16938
16939 v1_c_a(jc_nh4,ja_hso4) = 0.663584552 ! @@@@
16940 v1_c_a(jc_nh4,ja_so4) = -2.587430 ! @@@@
16941 v1_c_a(jc_nh4,ja_no3) = -1.42646 ! @@@@
16942 v1_c_a(jc_nh4,ja_cl) = -1.25000 ! @@@@
16943
16944 w1_c_a(jc_nh4,ja_hso4) = -2.56359462 ! @@@@
16945 w1_c_a(jc_nh4,ja_so4) = -0.740149 ! @@@@
16946 w1_c_a(jc_nh4,ja_no3) = 0.900729 ! @@@@
16947 w1_c_a(jc_nh4,ja_cl) = -0.5682911 ! @@@@
16948 !
16949 ! (na,a)
16950 u1_c_a(jc_na,ja_hso4) = -4.857197 ! @@@@
16951 u1_c_a(jc_na,ja_so4) = -1.95916 ! @@@@
16952 u1_c_a(jc_na,ja_no3) = 0.2666436 ! @@@@
16953 u1_c_a(jc_na,ja_cl) = -3.609246 ! @@@@
16954
16955 v1_c_a(jc_na,ja_hso4) = 4.888311 ! @@@@
16956 v1_c_a(jc_na,ja_so4) = -4.86057 ! @@@@
16957 v1_c_a(jc_na,ja_no3) = -2.302876 ! @@@@
16958 v1_c_a(jc_na,ja_cl) = -2.459821 ! @@@@
16959
16960 w1_c_a(jc_na,ja_hso4) = -2.932425 ! @@@@
16961 w1_c_a(jc_na,ja_so4) = -3.725962 ! @@@@
16962 w1_c_a(jc_na,ja_no3) = 0.5269081 ! @@@@
16963 w1_c_a(jc_na,ja_cl) = -5.646077 ! @@@@
16964
16965 !
16966 ! (ca,a) ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
16967 u1_c_a(jc_ca,ja_hso4) = 0.0
16968 u1_c_a(jc_ca,ja_so4) = 0.0
16969 u1_c_a(jc_ca,ja_no3) = 0.45953
16970 u1_c_a(jc_ca,ja_cl) = 19.148
16971
16972 v1_c_a(jc_ca,ja_hso4) = 0.0
16973 v1_c_a(jc_ca,ja_so4) = 0.0
16974 v1_c_a(jc_ca,ja_no3) = -8.387
16975 v1_c_a(jc_ca,ja_cl) = -36.497
16976
16977 w1_c_a(jc_ca,ja_hso4) = 0.0
16978 w1_c_a(jc_ca,ja_so4) = 0.0
16979 w1_c_a(jc_ca,ja_no3) = 0.0
16980 w1_c_a(jc_ca,ja_cl) = 0.0
16981
16982 ! fitted ternary parameters (short-range contributions)
16983 !
16984 ! (c,c',hso4)
16985 uc_cp_a(jc_h,jc_nh4,ja_hso4) = 0.0 ! @@@@
16986 uc_cp_a(jc_h,jc_na,ja_hso4) = -2.92819 ! @@@@
16987 uc_cp_a(jc_nh4,jc_na,ja_hso4) = 0.0 ! @@@@
16988
16989 uc_cp_a(jc_nh4,jc_h,ja_hso4) = -uc_cp_a(jc_h,jc_nh4,ja_hso4)
16990 uc_cp_a(jc_na,jc_h,ja_hso4) = -uc_cp_a(jc_h,jc_na,ja_hso4)
16991 uc_cp_a(jc_na,jc_nh4,ja_hso4) = -uc_cp_a(jc_nh4,jc_na,ja_hso4)
16992
16993
16994 wc_cp_a(jc_h,jc_nh4,ja_hso4) = -19.494 ! @@@@
16995 wc_cp_a(jc_h,jc_na,ja_hso4) = -8.96894 ! @@@@
16996 wc_cp_a(jc_nh4,jc_na,ja_hso4) = 0.0 ! @@@@
16997
16998 wc_cp_a(jc_nh4,jc_h,ja_hso4) = wc_cp_a(jc_h,jc_nh4,ja_hso4)
16999 wc_cp_a(jc_na,jc_h,ja_hso4) = wc_cp_a(jc_h,jc_na,ja_hso4)
17000 wc_cp_a(jc_na,jc_nh4,ja_hso4) = wc_cp_a(jc_nh4,jc_na,ja_hso4)
17001
17002
17003 q1_c_cp_a(jc_h,jc_nh4,ja_hso4) = 8.7607 ! @@@@
17004 q1_c_cp_a(jc_h,jc_na,ja_hso4) = 4.16202 ! @@@@
17005 q1_c_cp_a(jc_nh4,jc_na,ja_hso4) = 0.0
17006
17007 q1_c_cp_a(jc_nh4,jc_h,ja_hso4) = 8.7607 ! @@@@
17008 q1_c_cp_a(jc_na,jc_h,ja_hso4) = 4.16202 ! @@@@
17009 q1_c_cp_a(jc_na,jc_nh4,ja_hso4) = 0.0 ! @@@@
17010
17011
17012 ! (c,c',so4)
17013 uc_cp_a(jc_h,jc_nh4,ja_so4) = 6.5216 ! @@@@
17014 uc_cp_a(jc_h,jc_na,ja_so4) = 0.0 ! @@@@
17015 uc_cp_a(jc_nh4,jc_na,ja_so4) = 0.0 ! @@@@
17016
17017 uc_cp_a(jc_nh4,jc_h,ja_so4) = -uc_cp_a(jc_h,jc_nh4,ja_so4)
17018 uc_cp_a(jc_na,jc_h,ja_so4) = -uc_cp_a(jc_h,jc_na,ja_so4)
17019 uc_cp_a(jc_na,jc_nh4,ja_so4) = -uc_cp_a(jc_nh4,jc_na,ja_so4)
17020
17021
17022 wc_cp_a(jc_h,jc_nh4,ja_so4) = -4.3507 ! @@@@
17023 wc_cp_a(jc_h,jc_na,ja_so4) = 15.9075 ! @@@@
17024 wc_cp_a(jc_nh4,jc_na,ja_so4) = -1.4832 ! @@@@
17025
17026 wc_cp_a(jc_nh4,jc_h,ja_so4) = wc_cp_a(jc_h,jc_nh4,ja_so4)
17027 wc_cp_a(jc_na,jc_h,ja_so4) = wc_cp_a(jc_h,jc_na,ja_so4)
17028 wc_cp_a(jc_na,jc_nh4,ja_so4) = wc_cp_a(jc_nh4,jc_na,ja_so4)
17029
17030
17031 q1_c_cp_a(jc_h,jc_nh4,ja_so4) = 0.0 ! @@@@
17032 q1_c_cp_a(jc_h,jc_na,ja_so4) = -8.82425 ! @@@@
17033 q1_c_cp_a(jc_nh4,jc_na,ja_so4) = 0.76211 ! @@@@
17034
17035 q1_c_cp_a(jc_nh4,jc_h,ja_so4) = 0.0 ! @@@@
17036 q1_c_cp_a(jc_na,jc_h,ja_so4) = -8.82425 ! @@@@
17037 q1_c_cp_a(jc_na,jc_nh4,ja_so4) = 0.76211 ! @@@@
17038
17039
17040 ! (c,c',no3)
17041 uc_cp_a(jc_h,jc_nh4,ja_no3) = -0.46338 ! @@@@
17042 uc_cp_a(jc_h,jc_na,ja_no3) = 1.1749 ! @@@@
17043 uc_cp_a(jc_nh4,jc_na,ja_no3) = 0.2130 ! @@@@
17044 uc_cp_a(jc_h,jc_ca,ja_no3) = 0.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17045
17046 uc_cp_a(jc_nh4,jc_h,ja_no3) = -uc_cp_a(jc_h,jc_nh4,ja_no3)
17047 uc_cp_a(jc_na,jc_h,ja_no3) = -uc_cp_a(jc_h,jc_na,ja_no3)
17048 uc_cp_a(jc_na,jc_nh4,ja_no3) = -uc_cp_a(jc_nh4,jc_na,ja_no3)
17049 uc_cp_a(jc_ca,jc_h,ja_no3) = -uc_cp_a(jc_h,jc_ca,ja_no3)
17050
17051
17052 wc_cp_a(jc_h,jc_nh4,ja_no3) = -3.0708 ! @@@@
17053 wc_cp_a(jc_h,jc_na,ja_no3) = 0.46039 ! @@@@
17054 wc_cp_a(jc_nh4,jc_na,ja_no3) = -0.35411 ! @@@@
17055 wc_cp_a(jc_h,jc_ca,ja_no3) = 8.343 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17056
17057 wc_cp_a(jc_nh4,jc_h,ja_no3) = wc_cp_a(jc_h,jc_nh4,ja_no3)
17058 wc_cp_a(jc_na,jc_h,ja_no3) = wc_cp_a(jc_h,jc_na,ja_no3)
17059 wc_cp_a(jc_na,jc_nh4,ja_no3) = wc_cp_a(jc_nh4,jc_na,ja_no3)
17060 wc_cp_a(jc_ca,jc_h,ja_no3) = wc_cp_a(jc_h,jc_ca,ja_no3) ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17061
17062
17063 q1_c_cp_a(jc_h,jc_nh4,ja_no3) = 0.28491 ! @@@@
17064 q1_c_cp_a(jc_h,jc_na,ja_no3) = 0.0 ! @@@@
17065 q1_c_cp_a(jc_nh4,jc_na,ja_no3) = 0.046254 ! @@@@
17066 q1_c_cp_a(jc_h,jc_ca,ja_no3) = -3.678 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17067
17068 q1_c_cp_a(jc_nh4,jc_h,ja_no3) = 0.28491 ! @@@@
17069 q1_c_cp_a(jc_na,jc_h,ja_no3) = 0.0 ! @@@@
17070 q1_c_cp_a(jc_na,jc_nh4,ja_no3) = 0.046254 ! @@@@
17071 q1_c_cp_a(jc_ca,jc_h,ja_no3) = -3.678 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17072
17073
17074 ! (c,c',cl)
17075 uc_cp_a(jc_h,jc_nh4,ja_cl) = 0.0 ! @@@@
17076 uc_cp_a(jc_h,jc_na,ja_cl) = 0.0 ! @@@@
17077 uc_cp_a(jc_nh4,jc_na,ja_cl) = 0.0 ! @@@@
17078 uc_cp_a(jc_h,jc_ca,ja_cl) = 0.0 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17079
17080 uc_cp_a(jc_nh4,jc_h,ja_cl) = -uc_cp_a(jc_h,jc_nh4,ja_cl)
17081 uc_cp_a(jc_na,jc_h,ja_cl) = -uc_cp_a(jc_h,jc_na,ja_cl)
17082 uc_cp_a(jc_na,jc_nh4,ja_cl) = -uc_cp_a(jc_nh4,jc_na,ja_cl)
17083 uc_cp_a(jc_ca,jc_h,ja_cl) = -uc_cp_a(jc_h,jc_ca,ja_cl) ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17084
17085
17086 wc_cp_a(jc_h,jc_nh4,ja_cl) = -19.977 ! @@@@
17087 wc_cp_a(jc_h,jc_na,ja_cl) = 2.2490 ! @@@@
17088 wc_cp_a(jc_nh4,jc_na,ja_cl) = -5.6414 ! @@@@
17089 wc_cp_a(jc_h,jc_ca,ja_cl) = -8.112 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17090
17091 wc_cp_a(jc_nh4,jc_h,ja_cl) = wc_cp_a(jc_h,jc_nh4,ja_cl)
17092 wc_cp_a(jc_na,jc_h,ja_cl) = wc_cp_a(jc_h,jc_na,ja_cl)
17093 wc_cp_a(jc_na,jc_nh4,ja_cl) = wc_cp_a(jc_nh4,jc_na,ja_cl)
17094 wc_cp_a(jc_ca,jc_h,ja_cl) = wc_cp_a(jc_h,jc_ca,ja_cl) ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17095
17096
17097 q1_c_cp_a(jc_h,jc_nh4,ja_cl) = 10.233 ! @@@@
17098 q1_c_cp_a(jc_h,jc_na,ja_cl) = -0.25080 ! @@@@
17099 q1_c_cp_a(jc_nh4,jc_na,ja_cl) = 3.2919 ! @@@@
17100 q1_c_cp_a(jc_h,jc_ca,ja_cl) = 12.67 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17101
17102 q1_c_cp_a(jc_nh4,jc_h,ja_cl) = 10.233 ! @@@@
17103 q1_c_cp_a(jc_na,jc_h,ja_cl) = -0.25080 ! @@@@
17104 q1_c_cp_a(jc_na,jc_nh4,ja_cl) = 3.2919 ! @@@@
17105 q1_c_cp_a(jc_ca,jc_h,ja_cl) = 12.67 ! clegg, pitzer & brimblecombe, j.phys.chem. 1992
17106
17107
17108 ! (a,a',h)
17109 ua_ap_c(ja_hso4,ja_so4,jc_h) = 0.0 ! @@@@
17110 ua_ap_c(ja_hso4,ja_no3,jc_h) =0.201362+0.08483*(tdum-273.15) ! @@@@
17111 ua_ap_c(ja_hso4,ja_cl,jc_h) = 0.0 ! @@@@
17112 ua_ap_c(ja_so4,ja_no3,jc_h) = 0.0 ! @@@@
17113 ua_ap_c(ja_so4,ja_cl,jc_h) = 0.0 ! @@@@
17114 ua_ap_c(ja_no3,ja_cl,jc_h) = 0.0 ! @@@@
17115
17116 ua_ap_c(ja_so4,ja_hso4,jc_h) = -ua_ap_c(ja_hso4,ja_so4,jc_h)
17117 ua_ap_c(ja_no3,ja_hso4,jc_h) = -ua_ap_c(ja_hso4,ja_no3,jc_h)
17118 ua_ap_c(ja_cl,ja_hso4,jc_h) = -ua_ap_c(ja_hso4,ja_cl,jc_h)
17119 ua_ap_c(ja_no3,ja_so4,jc_h) = -ua_ap_c(ja_so4,ja_no3,jc_h)
17120 ua_ap_c(ja_cl,ja_so4,jc_h) = -ua_ap_c(ja_so4,ja_cl,jc_h)
17121 ua_ap_c(ja_cl,ja_no3,jc_h) = -ua_ap_c(ja_no3,ja_cl,jc_h)
17122
17123
17124 wa_ap_c(ja_hso4,ja_so4,jc_h) = 0.0 ! @@@@
17125 wa_ap_c(ja_hso4,ja_no3,jc_h) = -4.280 ! @@@@
17126 wa_ap_c(ja_hso4,ja_cl,jc_h) = 0.0 ! @@@@
17127 wa_ap_c(ja_so4,ja_no3,jc_h) = -0.033291*(tdum-273.15) ! @@@@
17128 wa_ap_c(ja_so4,ja_cl,jc_h) = 0.0 ! @@@@
17129 wa_ap_c(ja_no3,ja_cl,jc_h) = 0.0 ! @@@@
17130
17131 wa_ap_c(ja_so4,ja_hso4,jc_h) = wa_ap_c(ja_hso4,ja_so4,jc_h)
17132 wa_ap_c(ja_no3,ja_hso4,jc_h) = wa_ap_c(ja_hso4,ja_no3,jc_h)
17133 wa_ap_c(ja_cl,ja_hso4,jc_h) = wa_ap_c(ja_hso4,ja_cl,jc_h)
17134 wa_ap_c(ja_no3,ja_so4,jc_h) = wa_ap_c(ja_so4,ja_no3,jc_h)
17135 wa_ap_c(ja_cl,ja_so4,jc_h) = wa_ap_c(ja_so4,ja_cl,jc_h)
17136 wa_ap_c(ja_cl,ja_no3,jc_h) = wa_ap_c(ja_no3,ja_cl,jc_h)
17137
17138
17139 q1_a_ap_c(ja_hso4,ja_so4,jc_h) = 0.0 ! @@@@
17140 q1_a_ap_c(ja_hso4,ja_no3,jc_h) = 0.0 ! @@@@
17141 q1_a_ap_c(ja_hso4,ja_cl,jc_h) = 0.0 ! @@@@
17142 q1_a_ap_c(ja_so4,ja_no3,jc_h) = 0.0 ! @@@@
17143 q1_a_ap_c(ja_so4,ja_cl,jc_h) = 0.0 ! @@@@
17144 q1_a_ap_c(ja_no3,ja_cl,jc_h) = 0.0 ! @@@@
17145
17146 q1_a_ap_c(ja_so4,ja_hso4,jc_h) = 0.0 ! @@@@
17147 q1_a_ap_c(ja_no3,ja_hso4,jc_h) = 0.0 ! @@@@
17148 q1_a_ap_c(ja_cl,ja_hso4,jc_h) = 0.0 ! @@@@
17149 q1_a_ap_c(ja_no3,ja_so4,jc_h) = 0.0 ! @@@@
17150 q1_a_ap_c(ja_cl,ja_so4,jc_h) = 0.0 ! @@@@
17151 q1_a_ap_c(ja_cl,ja_no3,jc_h) = 0.0 ! @@@@
17152
17153
17154 ! (a,a',nh4)
17155 ua_ap_c(ja_hso4,ja_so4,jc_nh4) = -16.317 ! @@@@
17156 ua_ap_c(ja_hso4,ja_no3,jc_nh4) = 0.0 ! @@@@
17157 ua_ap_c(ja_hso4,ja_cl,jc_nh4) = 0.0 ! @@@@
17158 ua_ap_c(ja_so4,ja_no3,jc_nh4) = -1.2163 ! @@@@
17159 ua_ap_c(ja_so4,ja_cl,jc_nh4) = -1.0709 ! @@@@
17160 ua_ap_c(ja_no3,ja_cl,jc_nh4) = 0.0
17161
17162 ua_ap_c(ja_so4,ja_hso4,jc_nh4) = +16.317 ! @@@@
17163 ua_ap_c(ja_no3,ja_hso4,jc_nh4) = 0.0 ! @@@@
17164 ua_ap_c(ja_cl,ja_hso4,jc_nh4) = 0.0 ! @@@@
17165 ua_ap_c(ja_no3,ja_so4,jc_nh4) = +1.2163 ! @@@@
17166 ua_ap_c(ja_cl,ja_so4,jc_nh4) = +1.0709 ! @@@@
17167 ua_ap_c(ja_cl,ja_no3,jc_nh4) = 0.0
17168
17169
17170 wa_ap_c(ja_hso4,ja_so4,jc_nh4) = -14.753 ! @@@@
17171 wa_ap_c(ja_hso4,ja_no3,jc_nh4) = -2.9369 ! @@@@
17172 wa_ap_c(ja_hso4,ja_cl,jc_nh4) = 0.0 ! @@@@
17173 wa_ap_c(ja_so4,ja_no3,jc_nh4) = 0.0 ! @@@@
17174 wa_ap_c(ja_so4,ja_cl,jc_nh4) = 0.0 ! @@@@
17175 wa_ap_c(ja_no3,ja_cl,jc_nh4) = -0.2207 ! @@@@
17176
17177 wa_ap_c(ja_so4,ja_hso4,jc_nh4) = -14.753 ! @@@@
17178 wa_ap_c(ja_no3,ja_hso4,jc_nh4) = -2.9369 ! @@@@
17179 wa_ap_c(ja_cl,ja_hso4,jc_nh4) = 0.0 ! @@@@
17180 wa_ap_c(ja_no3,ja_so4,jc_nh4) = 0.0 ! @@@@
17181 wa_ap_c(ja_cl,ja_so4,jc_nh4) = 0.0 ! @@@@
17182 wa_ap_c(ja_cl,ja_no3,jc_nh4) = -0.2207 ! @@@@
17183
17184
17185 q1_a_ap_c(ja_hso4,ja_so4,jc_nh4) = 4.7204 ! @@@@
17186 q1_a_ap_c(ja_hso4,ja_no3,jc_nh4) = 0.0 ! @@@@
17187 q1_a_ap_c(ja_hso4,ja_cl,jc_nh4) = 0.0 ! @@@@
17188 q1_a_ap_c(ja_so4,ja_no3,jc_nh4) = 2.9795 ! @@@@
17189 q1_a_ap_c(ja_so4,ja_cl,jc_nh4) = 1.0869 ! @@@@
17190 q1_a_ap_c(ja_no3,ja_cl,jc_nh4) = -0.1173 ! @@@@
17191
17192 q1_a_ap_c(ja_so4,ja_hso4,jc_nh4) = 4.7204 ! @@@@
17193 q1_a_ap_c(ja_no3,ja_hso4,jc_nh4) = 0.0 ! @@@@
17194 q1_a_ap_c(ja_cl,ja_hso4,jc_nh4) = 0.0 ! @@@@
17195 q1_a_ap_c(ja_no3,ja_so4,jc_nh4) = 2.9795 ! @@@@
17196 q1_a_ap_c(ja_cl,ja_so4,jc_nh4) = 1.0869 ! @@@@
17197 q1_a_ap_c(ja_cl,ja_no3,jc_nh4) = -0.1173 ! @@@@
17198
17199
17200 ! (a,a',na)
17201 ua_ap_c(ja_hso4,ja_so4,jc_na) = 0.0 ! @@@@
17202 ua_ap_c(ja_hso4,ja_no3,jc_na) = 0.0 ! @@@@
17203 ua_ap_c(ja_hso4,ja_cl,jc_na) = 0.0 ! @@@@
17204 ua_ap_c(ja_so4,ja_no3,jc_na) = 0.0 ! @@@@
17205 ua_ap_c(ja_so4,ja_cl,jc_na) = 0.0 ! @@@@
17206 ua_ap_c(ja_no3,ja_cl,jc_na) = 0.0 ! @@@@
17207
17208 ua_ap_c(ja_so4,ja_hso4,jc_na) = 0.0 ! @@@@
17209 ua_ap_c(ja_no3,ja_hso4,jc_na) = 0.0 ! @@@@
17210 ua_ap_c(ja_cl,ja_hso4,jc_na) = 0.0 ! @@@@
17211 ua_ap_c(ja_no3,ja_so4,jc_na) = 0.0 ! @@@@
17212 ua_ap_c(ja_cl,ja_so4,jc_na) = 0.0 ! @@@@
17213 ua_ap_c(ja_cl,ja_no3,jc_na) = 0.0 ! @@@@
17214
17215
17216 wa_ap_c(ja_hso4,ja_so4,jc_na) = 0.0 ! @@@@
17217 wa_ap_c(ja_hso4,ja_no3,jc_na) = 0.0 ! @@@@
17218 wa_ap_c(ja_hso4,ja_cl,jc_na) = 0.0 ! @@@@
17219 wa_ap_c(ja_so4,ja_no3,jc_na) = -9.498 ! @@@@
17220 wa_ap_c(ja_so4,ja_cl,jc_na) = 4.827 ! @@@@
17221 wa_ap_c(ja_no3,ja_cl,jc_na) = -6.923 ! @@@@
17222
17223 wa_ap_c(ja_so4,ja_hso4,jc_na) = 0.0 ! @@@@
17224 wa_ap_c(ja_no3,ja_hso4,jc_na) = 0.0 ! @@@@
17225 wa_ap_c(ja_cl,ja_hso4,jc_na) = 0.0 ! @@@@
17226 wa_ap_c(ja_no3,ja_so4,jc_na) = -9.498 ! @@@@
17227 wa_ap_c(ja_cl,ja_so4,jc_na) = 4.827 ! @@@@
17228 wa_ap_c(ja_cl,ja_no3,jc_na) = -6.923 ! @@@@
17229
17230
17231 q1_a_ap_c(ja_hso4,ja_so4,jc_na) = -4.68641 ! @@@@
17232 q1_a_ap_c(ja_hso4,ja_no3,jc_na) = 0.0 ! @@@@
17233 q1_a_ap_c(ja_hso4,ja_cl,jc_na) = 0.0 ! @@@@
17234 q1_a_ap_c(ja_so4,ja_no3,jc_na) = 8.528 ! @@@@
17235 q1_a_ap_c(ja_so4,ja_cl,jc_na) = 0.05163 ! @@@@
17236 q1_a_ap_c(ja_no3,ja_cl,jc_na) = 4.181 ! @@@@
17237
17238 q1_a_ap_c(ja_so4,ja_hso4,jc_na) = -4.68641 ! @@@@
17239 q1_a_ap_c(ja_no3,ja_hso4,jc_na) = 0.0 ! @@@@
17240 q1_a_ap_c(ja_cl,ja_hso4,jc_na) = 0.0 ! @@@@
17241 q1_a_ap_c(ja_no3,ja_so4,jc_na) = 8.528 ! @@@@
17242 q1_a_ap_c(ja_cl,ja_so4,jc_na) = 0.05163 ! @@@@
17243 q1_a_ap_c(ja_cl,ja_no3,jc_na) = 4.181 ! @@@@
17244
17245
17246
17247
17248 !--------------
17249
17250 xnuc(jc_h,ja_hso4) = 0.5 ! za(ja_hso4)/(zc(jc_h)+za(ja_hso4))
17251 xnuc(jc_h,ja_so4) = 0.66666667 ! za(ja_so4)/(zc(jc_h)+za(ja_so4))
17252 xnuc(jc_h,ja_no3) = 0.5 ! za(ja_no3)/(zc(jc_h)+za(ja_no3))
17253 xnuc(jc_h,ja_cl) = 0.5 ! za(ja_cl)/(zc(jc_h)+za(ja_cl))
17254
17255 xnuc(jc_nh4,ja_hso4) = 0.5 ! za(ja_hso4)/(zc(jc_nh4)+za(ja_hso4))
17256 xnuc(jc_nh4,ja_so4) = 0.66666667 ! za(ja_so4)/(zc(jc_nh4)+za(ja_so4))
17257 xnuc(jc_nh4,ja_no3) = 0.5 ! za(ja_no3)/(zc(jc_nh4)+za(ja_no3))
17258 xnuc(jc_nh4,ja_cl) = 0.5 ! za(ja_cl)/(zc(jc_nh4)+za(ja_cl))
17259
17260 xnuc(jc_na,ja_hso4) = 0.5 ! za(ja_hso4)/(zc(jc_na)+za(ja_hso4))
17261 xnuc(jc_na,ja_so4) = 0.66666667 ! za(ja_so4)/(zc(jc_na)+za(ja_so4))
17262 xnuc(jc_na,ja_no3) = 0.5 ! za(ja_no3)/(zc(jc_na)+za(ja_no3))
17263 xnuc(jc_na,ja_cl) = 0.5 ! za(ja_cl)/(zc(jc_na)+za(ja_cl))
17264
17265 xnuc(jc_ca,ja_hso4) = 0.33333333 ! za(ja_hso4)/(zc(jc_ca)+za(ja_hso4))
17266 xnuc(jc_ca,ja_so4) = 0.5 ! za(ja_so4)/(zc(jc_ca)+za(ja_so4))
17267 xnuc(jc_ca,ja_no3) = 0.33333333 ! za(ja_no3)/(zc(jc_ca)+za(ja_no3))
17268 xnuc(jc_ca,ja_cl) = 0.33333333 ! za(ja_cl)/(zc(jc_ca)+za(ja_cl))
17269
17270 !-------------
17271
17272 xnua(ja_hso4,jc_h) = 0.5 ! zc(jc_h)/(zc(jc_h)+za(ja_hso4))
17273 xnua(ja_hso4,jc_nh4) = 0.5 ! zc(jc_nh4)/(zc(jc_nh4)+za(ja_hso4))
17274 xnua(ja_hso4,jc_na) = 0.5 ! zc(jc_na)/(zc(jc_na)+za(ja_hso4))
17275 xnua(ja_hso4,jc_ca) = 0.66666667 ! zc(jc_ca)/(zc(jc_ca)+za(ja_hso4))
17276
17277 xnua(ja_so4,jc_h) = 0.33333333 ! zc(jc_h)/(zc(jc_h)+za(ja_so4))
17278 xnua(ja_so4,jc_nh4) = 0.33333333 ! zc(jc_nh4)/(zc(jc_nh4)+za(ja_so4))
17279 xnua(ja_so4,jc_na) = 0.33333333 ! zc(jc_na)/(zc(jc_na)+za(ja_so4))
17280 xnua(ja_so4,jc_ca) = 0.5 ! zc(jc_ca)/(zc(jc_ca)+za(ja_so4))
17281
17282 xnua(ja_no3,jc_h) = 0.5 ! zc(jc_h)/(zc(jc_h)+za(ja_no3))
17283 xnua(ja_no3,jc_nh4) = 0.5 ! zc(jc_nh4)/(zc(jc_nh4)+za(ja_no3))
17284 xnua(ja_no3,jc_na) = 0.5 ! zc(jc_na)/(zc(jc_na)+za(ja_no3))
17285 xnua(ja_no3,jc_ca) = 0.66666667 ! zc(jc_ca)/(zc(jc_ca)+za(ja_no3))
17286
17287 xnua(ja_cl,jc_h) = 0.5 ! zc(jc_h)/(zc(jc_h)+za(ja_cl))
17288 xnua(ja_cl,jc_nh4) = 0.5 ! zc(jc_nh4)/(zc(jc_nh4)+za(ja_cl))
17289 xnua(ja_cl,jc_na) = 0.5 ! zc(jc_na)/(zc(jc_na)+za(ja_cl))
17290 xnua(ja_cl,jc_ca) = 0.66666667 ! zc(jc_ca)/(zc(jc_ca)+za(ja_cl))
17291
17292
17293
17294 endif ! first
17295
17296 return
17297 end subroutine load_mosaic_parameters
17298
17299
17300
17301
17302
17303
17304
17305
17306
17307
17308
17309 !***********************************************************************
17310 ! updates all temperature dependent thermodynamic parameters
17311 !
17312 ! author: rahul a. zaveri
17313 ! update: jan 2005
17314 !-----------------------------------------------------------------------
17315 subroutine update_thermodynamic_constants
17316 ! implicit none
17317 ! include 'mosaic.h'
17318 ! local variables
17319 real tr, rt, term
17320 ! function
17321 ! real fn_keq
17322
17323 !
17324 tr = 298.15 ! reference temperature
17325 !
17326 rt = 82.056*t_k/(1.e9*1.e6) ! [m^3 atm/nmol]
17327
17328 ! gas-liquid
17329 keq_gl(1)= 1.0 ! kelvin effect (default)
17330 keq_gl(2)= fn_keq(57.64 , 13.79, -5.39,t_k)*rt ! nh3(g) <=> nh3(l)
17331 keq_gl(3)= fn_keq(2.63e6, 29.17, 16.83,t_k)*rt ! hno3(g) <=> no3- + h+
17332 keq_gl(4)= fn_keq(2.00e6, 30.20, 19.91,t_k)*rt ! hcl(g) <=> cl- + h+
17333
17334 ! liquid-liquid
17335 keq_ll(1)= fn_keq(1.0502e-2, 8.85, 25.14,t_k) ! hso4- <=> so4= + h+
17336 keq_ll(2)= fn_keq(1.805e-5, -1.50, 26.92,t_k) ! nh3(l) + h2o = nh4+ + oh-
17337 keq_ll(3)= fn_keq(1.01e-14,-22.52, 26.92,t_k) ! h2o(l) <=> h+ + oh-
17338
17339
17340 kp_nh3 = keq_ll(3)/(keq_ll(2)*keq_gl(2))
17341 kp_nh4no3= kp_nh3/keq_gl(3)
17342 kp_nh4cl = kp_nh3/keq_gl(4)
17343
17344
17345 ! solid-gas
17346 keq_sg(1)= fn_keq(4.72e-17,-74.38,6.12,t_k)/rt**2 ! nh4no3<=>nh3(g)+hno3(g)
17347 keq_sg(2)= fn_keq(8.43e-17,-71.00,2.40,t_k)/rt**2 ! nh4cl <=>nh3(g)+hcl(g)
17348
17349 ! solid-liquid
17350 keq_sl(jnh4so4) = fn_keq(1.040,-2.65, 38.57, t_k) ! amso4(s) = 2nh4+ + so4=
17351 keq_sl(jlvcite) = fn_keq(11.8, -5.19, 54.40, t_k) ! lvcite(s)= 3nh4+ + hso4- + so4=
17352 keq_sl(jnh4hso4)= fn_keq(117.0,-2.87, 15.83, t_k) ! amhso4(s)= nh4+ + hso4-
17353 keq_sl(jnh4no3) = fn_keq(12.21,-10.4, 17.56, t_k) ! nh4no3(s)= nh4+ + no3-
17354 keq_sl(jnh4cl) = fn_keq(17.37,-6.03, 16.92, t_k) ! nh4cl(s) = nh4+ + cl-
17355 keq_sl(jna2so4) = fn_keq(0.491, 0.98, 39.75, t_k) ! na2so4(s)= 2na+ + so4=
17356 keq_sl(jnahso4) = fn_keq(313.0, 0.8, 14.79, t_k) ! nahso4(s)= na+ + hso4-
17357 keq_sl(jna3hso4)= 1.e10 ! na3h(so4)2(s) = 2na+ + hso4- + so4=
17358 keq_sl(jnano3) = fn_keq(11.95,-8.22, 16.01, t_k) ! nano3(s) = na+ + no3-
17359 keq_sl(jnacl) = fn_keq(38.28,-1.52, 16.89, t_k) ! nacl(s) = na+ + cl-
17360 keq_sl(jcacl2) = fn_keq(8.0e11,32.84,44.79, t_k)*1.e5 ! cacl2(s) = ca++ + 2cl-
17361 keq_sl(jcano3) = fn_keq(4.31e5, 7.83,42.01, t_k)*1.e5 ! ca(no3)2(s) = ca++ + 2no3-
17362
17363
17364 term = (647.15 - t_k)/647.15
17365 sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
17366
17367
17368 return
17369 end subroutine update_thermodynamic_constants
17370
17371
17372
17373
17374 !***********************************************************************
17375 ! functions used in mosaic
17376 !
17377 ! author: rahul a. zaveri
17378 ! update: jan 2005
17379 !-----------------------------------------------------------------------
17380
17381
17382
17383 !----------------------------------------------------------
17384 real function fn_keq(keq_298, a, b, t)
17385 ! implicit none
17386 ! subr. arguments
17387 real keq_298, a, b, t
17388 ! local variables
17389 real tt
17390
17391
17392 tt = 298.15/t
17393 fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+alog(tt)-tt))
17394
17395 return
17396 end function fn_keq
17397 !----------------------------------------------------------
17398
17399
17400
17401
17402 !----------------------------------------------------------
17403 real function drh_mutual(j_index)
17404 ! implicit none
17405 ! include 'mosaic.h'
17406 ! subr. arguments
17407 integer j_index
17408 ! local variables
17409 integer j
17410
17411
17412 j = j_index
17413
17414 drh_mutual = d_mdrh(j,1) + &
17415 d_mdrh(j,2)*t_k + &
17416 d_mdrh(j,3)*t_k**2 + &
17417 d_mdrh(j,4)*t_k**3
17418
17419
17420 return
17421 end function drh_mutual
17422 !----------------------------------------------------------
17423
17424
17425
17426
17427
17428
17429 !----------------------------------------------------------
17430 ! zsr method at 60% rh
17431 !
17432 real function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
17433 ! implicit none
17434 ! include 'mosaic.h'
17435 ! subr. arguments
17436 integer ibin
17437 ! local variables
17438 integer jp, je
17439 real dum
17440 ! function
17441 ! real bin_molality_60
17442
17443
17444 jp = jtotal
17445 dum = 0.0
17446
17447 do je = 1, 12 ! exclude hno3 and hcl in water calculation
17448 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
17449 enddo
17450
17451 aerosol_water_up = dum
17452
17453 return
17454 end function aerosol_water_up
17455 !----------------------------------------------------------
17456
17457
17458
17459
17460
17461
17462 !----------------------------------------------------------
17463 ! zsr method
17464 real function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
17465 ! implicit none
17466 ! include 'mosaic.h'
17467 ! subr. arguments
17468 integer jp, ibin
17469 ! local variables
17470 integer je
17471 real dum
17472 ! function
17473 ! real bin_molality
17474
17475 dum = 0.0
17476
17477 do je = 1, 15 ! exclude hno3 and hcl in water calculation
17478 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality(je,ibin)
17479 enddo
17480
17481 aerosol_water = dum
17482
17483 if(aerosol_water .le. 0.0)then
17484 write(6,*)'iclm jclm ibin jp = ', &
17485 iclm_aer, jclm_aer, ibin, jp
17486 write(6,*)'ah2o, water = ', ah2o, aerosol_water
17487 write(6,*)'dry mass = ', mass_dry_a(ibin)
17488 write(6,*)'soluble mass = ', mass_soluble_a(ibin)
17489 write(6,*)'number = ', num_a(ibin)
17490 do je = 1, nsoluble
17491 write(6,44)ename(je), electrolyte(je,jp,ibin)
17492 enddo
17493 write(6,*)'error in water calculation'
17494 write(6,*)'water content cannot be negative or zero'
17495 write(6,*)'setting jaerosolstate to all_solid'
17496
17497 jaerosolstate(ibin) = all_solid
17498 jphase(ibin) = jsolid
17499 jhyst_leg(ibin) = jhyst_lo
17500
17501 ! write(6,*)'stopping execution in function aerosol_water'
17502 ! stop
17503 ! call peg_error_fatal( lunerr_aer,
17504 ! & 'stopping execution in function aerosol_water' )
17505 endif
17506
17507 44 format(a7, 2x, e11.3)
17508
17509
17510 return
17511 end function aerosol_water
17512 !----------------------------------------------------------
17513
17514
17515
17516
17517
17518 !----------------------------------------------------------
17519 real function bin_molality(je,ibin)
17520 ! implicit none
17521 ! include 'mosaic.h'
17522 ! subr. arguments
17523 integer je, ibin
17524 ! local variables
17525 real aw, xm
17526
17527
17528 aw = max(ah2o_a(ibin), aw_min(je))
17529 aw = min(aw, 0.99999)
17530
17531
17532 if(aw .lt. 0.97)then
17533
17534 xm = a_zsr(1,je) + &
17535 a_zsr(2,je)*aw + &
17536 a_zsr(3,je)*aw**2 + &
17537 a_zsr(4,je)*aw**3 + &
17538 a_zsr(5,je)*aw**4 + &
17539 a_zsr(6,je)*aw**5
17540
17541 bin_molality = 55.509*xm/(1. - xm)
17542
17543 else
17544
17545 bin_molality = -b_zsr(je)*alog(aw)
17546
17547 endif
17548
17549
17550 return
17551 end function bin_molality
17552 !----------------------------------------------------------
17553
17554
17555
17556
17557
17558 !----------------------------------------------------------
17559 real function bin_molality_60(je)
17560 ! implicit none
17561 ! include 'mosaic.h'
17562 ! subr. arguments
17563 integer je
17564 ! local variables
17565 real aw, xm
17566
17567
17568 aw = 0.6
17569
17570 xm = a_zsr(1,je) + &
17571 a_zsr(2,je)*aw + &
17572 a_zsr(3,je)*aw**2 + &
17573 a_zsr(4,je)*aw**3 + &
17574 a_zsr(5,je)*aw**4 + &
17575 a_zsr(6,je)*aw**5
17576
17577 bin_molality_60 = 55.509*xm/(1. - xm)
17578
17579 return
17580 end function bin_molality_60
17581 !----------------------------------------------------------
17582
17583
17584
17585
17586
17587 !----------------------------------------------------------
17588 real function fnlog_gamz(ja,je) ! ja in je
17589 ! implicit none
17590 ! include 'mosaic.h'
17591 ! subr. arguments
17592 integer ja, je
17593 ! local variables
17594 real aw
17595
17596
17597 aw = max(ah2o, aw_min(je))
17598
17599 fnlog_gamz = b_mtem(1,ja,je) + aw* &
17600 (b_mtem(2,ja,je) + aw* &
17601 (b_mtem(3,ja,je) + aw* &
17602 (b_mtem(4,ja,je) + aw* &
17603 (b_mtem(5,ja,je) + aw* &
17604 b_mtem(6,ja,je) ))))
17605
17606 return
17607 end function fnlog_gamz
17608 !----------------------------------------------------------
17609
17610
17611
17612
17613 !----------------------------------------------------------
17614 real function fnlog_gam0(je,x)
17615 ! implicit none
17616 ! include 'mosaic.h'
17617 ! subr. arguments
17618 integer je
17619 real x
17620 ! local variables
17621 real xi
17622
17623
17624 xi = min(x, im_max(je))
17625 fnlog_gam0 = b_km(1,je)*sqrt(xi) + xi*(b_km(2,je) + &
17626 xi*(b_km(3,je) + xi*(b_km(4,je) + xi* b_km(5,je) )))
17627
17628 return
17629 end function fnlog_gam0
17630 !----------------------------------------------------------
17631
17632
17633
17634
17635 !----------------------------------------------------------
17636 real function mean_molecular_speed(t, mw) ! in cm/s
17637 ! implicit none
17638 ! subr. arguments
17639 real t, mw ! t(k)
17640
17641 mean_molecular_speed = 1.455e4 * sqrt(t/mw)
17642
17643 return
17644 end function mean_molecular_speed
17645 !----------------------------------------------------------
17646
17647
17648
17649
17650 !----------------------------------------------------------
17651 real function gas_diffusivity(t, p, mw, vm) ! in cm^2/s
17652 ! implicit none
17653 ! subr. arguments
17654 real mw, vm, t, p ! t(k), p(atm)
17655
17656
17657 gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/ &
17658 (p * (vm**0.333333 + 2.7189)**2)
17659
17660
17661 return
17662 end function gas_diffusivity
17663 !----------------------------------------------------------
17664
17665
17666
17667
17668 !----------------------------------------------------------
17669 real function fuchs_sutugin(rkn,a)
17670 ! implicit none
17671 ! subr. arguments
17672 real rkn, a
17673 ! local variables
17674 real rnum, denom
17675
17676
17677 rnum = 0.75*a*(1. + rkn)
17678 denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
17679 fuchs_sutugin = rnum/denom
17680
17681 return
17682 end function fuchs_sutugin
17683 !----------------------------------------------------------
17684
17685
17686
17687
17688
17689 !----------------------------------------------------------
17690 real function cubic( psngl, qsngl, rsngl )
17691 ! implicit none
17692 ! subr arguments
17693 real psngl, qsngl, rsngl
17694 ! local variables
17695 double precision p, q, r, a, b, d, m, n, third, y
17696 real k, phi, thesign, x(3), duma
17697 integer icase, kk
17698
17699 third = 1.d0/3.d0
17700
17701 q = dble(qsngl)
17702 p = dble(psngl)
17703 r = dble(rsngl)
17704
17705 a = (1.d0/3.d0)*((3.d0*q) - (p*p))
17706 b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
17707
17708 d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
17709
17710 if(d .gt. 0.)then ! => 1 real and 2 complex roots
17711 icase = 1
17712 elseif(d .eq. 0.)then ! => 3 real roots, atleast 2 identical
17713 icase = 2
17714 else ! d < 0 => 3 distinct real roots
17715 icase = 3
17716 endif
17717
17718
17719 goto (1,2,3), icase
17720
17721 ! case 1: d > 0
17722 1 thesign = 1.
17723 if(b .gt. 0.)then
17724 b = -b
17725 thesign = -1.
17726 endif
17727
17728 m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
17729 n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
17730
17731 cubic = real( (m) + (n) - (p/3.d0) )
17732 return
17733
17734 ! case 2: d = 0
17735 2 thesign = 1.
17736 if(b .gt. 0.)then
17737 b = -b
17738 thesign = -1.
17739 endif
17740
17741 m = thesign*(-b/2.d0)**third
17742 n = m
17743
17744 x(1) = real( (m) + (n) - (p/3.d0) )
17745 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
17746 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
17747
17748 cubic = 0.
17749 do kk = 1, 3
17750 if(x(kk).gt.cubic) cubic = x(kk)
17751 enddo
17752 return
17753
17754 ! case 3: d < 0
17755 3 if(b.gt.0.)then
17756 thesign = -1.
17757 elseif(b.lt.0.)then
17758 thesign = 1.
17759 endif
17760
17761 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
17762 ! phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )) ! radians
17763 duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
17764 duma = min( duma, +1.0 )
17765 duma = max( duma, -1.0 )
17766 phi = acos( duma ) ! radians
17767
17768
17769 cubic = 0.
17770 do kk = 1, 3
17771 k = kk-1
17772 y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
17773 x(kk) = real((y) - (p/3.d0))
17774 if(x(kk).gt.cubic) cubic = x(kk)
17775 enddo
17776 return
17777
17778 end function cubic
17779 !----------------------------------------------------------
17780
17781
17782
17783
17784 !----------------------------------------------------------
17785 real function quadratic(a,b,c)
17786 ! implicit none
17787 ! subr. arguments
17788 real a, b, c
17789 ! local variables
17790 real x, dum
17791
17792
17793 if(b .ne. 0.0)then
17794 x = 4.*(a/b)*(c/b)
17795 else
17796 x = 1.e+6
17797 endif
17798
17799 if(abs(x) .lt. 1.e-6)then
17800 dum = real( dble(0.5*x) + &
17801 dble(0.125*x**2) + &
17802 dble(0.0625*x**3) )
17803
17804 quadratic = (-0.5*b/a)*dum
17805
17806 if(quadratic .lt. 0.)then
17807 quadratic = -b/a - quadratic
17808 endif
17809
17810 else
17811 quadratic = real(dble(-b)+dsqrt(dble(b*b)-dble(4.*a*c)))/ &
17812 (2.*a)
17813 endif
17814
17815 return
17816 end function quadratic
17817 !----------------------------------------------------------
17818
17819
17820 !=====================================================================
17821
17822
17823
17824
17825
17826
17827
17828
17829
17830
17831
17832
17833
17834
17835
17836
17837
17838 !***********************************************************************
17839 ! computes aerosol optical properties
17840 !
17841 ! author: rahul a. zaveri
17842 ! update: jan 2005
17843 !-----------------------------------------------------------------------
17844 subroutine aerosol_optical_properties(iclm, jclm, nz, refindx, &
17845 radius_wet, number_bin)
17846 ! changed to use rsub instead of rclm 7-8-04 egc
17847 use module_data_mosaic_asect
17848 use module_data_mosaic_other
17849 use module_state_description, only: param_first_scalar
17850
17851 ! implicit none
17852
17853 ! subr arguments
17854 integer, intent(in ) :: iclm, jclm, nz
17855 real, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
17856 number_bin, radius_wet
17857 complex, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
17858 refindx
17859
17860 ! local variables
17861 integer iaer, ibin, iphase, isize, itype, je, k, l, m
17862 integer ilaporte, jlaporte
17863 integer p1st
17864 real xt
17865
17866
17867 ! if a species index is less than this value, then the species is not defined
17868 p1st = param_first_scalar
17869
17870 ! fix number of subareas at 1
17871 nsubareas = 1
17872
17873 lunerr_aer = lunerr
17874 ncorecnt_aer = ncorecnt
17875
17876 call load_mosaic_parameters
17877
17878 do 110 m = 1, nsubareas
17879 do 100 k = 1, nz
17880
17881 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
17882 cair_mol_cc = cairclm(k)
17883
17884 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
17885 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
17886 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
17887 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
17888
17889
17890 ! initialize to zero
17891 do ibin = 1, nbin_a
17892 do iaer = 1, naer
17893 aer(iaer,jtotal,ibin) = 0.0
17894 enddo
17895
17896 do je = 1, nelectrolyte
17897 electrolyte(je,jtotal,ibin) = 0.0
17898 enddo
17899
17900 jaerosolstate(ibin) = -1 ! initialize to default value
17901
17902 enddo
17903
17904
17905 ! rce 18-nov-2004 - map (transfer) aerosol mass/water/number from rsub
17906 ! to mosaic arrays (aer, watr_a, num_a)
17907 ! always map so4 and number,
17908 ! but only map other species when (lptr_xxx .ge. p1st)
17909 ! (the mapping is identical to that done in mapgasaerspecies)
17910
17911 iphase = ai_phase
17912 ibin = 0
17913 do 90 itype = 1, ntype_aer
17914 do 90 isize = 1, nsize_aer(itype)
17915 ibin = ibin + 1
17916
17917 ! aer array units are nmol/(m^3 air)
17918 l = lptr_so4_aer(isize,itype,iphase)
17919 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17920
17921 l = lptr_no3_aer(isize,itype,iphase)
17922 if (l .ge. p1st) then
17923 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17924 else
17925 aer(ino3_a,jtotal,ibin)=0.0
17926 end if
17927
17928 l = lptr_cl_aer(isize,itype,iphase)
17929 if (l .ge. p1st) then
17930 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17931 else
17932 aer(icl_a,jtotal,ibin)=0.0
17933 end if
17934
17935 l = lptr_nh4_aer(isize,itype,iphase)
17936 if (l .ge. p1st) then
17937 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17938 else
17939 aer(inh4_a,jtotal,ibin)=0.0
17940 end if
17941
17942 l = lptr_oc_aer(isize,itype,iphase)
17943 if (l .ge. p1st) then
17944 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17945 else
17946 aer(ioc_a,jtotal,ibin)=0.0
17947 end if
17948
17949 l = lptr_bc_aer(isize,itype,iphase)
17950 if (l .ge. p1st) then
17951 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17952 else
17953 aer(ibc_a,jtotal,ibin)=0.0
17954 end if
17955
17956 l = lptr_na_aer(isize,itype,iphase)
17957 if (l .ge. p1st) then
17958 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17959 else
17960 aer(ina_a,jtotal,ibin)=0.0
17961 end if
17962
17963 l = lptr_oin_aer(isize,itype,iphase)
17964 if (l .ge. p1st) then
17965 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17966 else
17967 aer(ioin_a,jtotal,ibin)=0.0
17968 end if
17969
17970 l = lptr_msa_aer(isize,itype,iphase)
17971 if (l .ge. p1st) then
17972 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17973 else
17974 aer(imsa_a,jtotal,ibin)=0.0
17975 end if
17976
17977 l = lptr_co3_aer(isize,itype,iphase)
17978 if (l .ge. p1st) then
17979 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17980 else
17981 aer(ico3_a,jtotal,ibin)=0.0
17982 end if
17983
17984 l = lptr_ca_aer(isize,itype,iphase)
17985 if (l .ge. p1st) then
17986 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
17987 else
17988 aer(ica_a,jtotal,ibin)=0.0
17989 end if
17990
17991 ! water_a and water_a_hyst units are kg/(m^3 air)
17992 l = hyswptr_aer(isize,itype)
17993 if (l .ge. p1st) then
17994 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
17995 else
17996 water_a_hyst(ibin)=0.0
17997 end if
17998
17999 ! water_a units are kg/(m^3 air)
18000 l = waterptr_aer(isize,itype)
18001 if (l .ge. p1st) then
18002 water_a(ibin)=rsub(l,k,m)*conv2a
18003 else
18004 water_a(ibin)=0.0
18005 end if
18006
18007 ! num_a units are #/(cm^3 air)
18008 l = numptr_aer(isize,itype,iphase)
18009 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
18010
18011
18012 call check_aerosol_mass(ibin)
18013 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
18014 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
18015 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
18016 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
18017 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
18018 call calc_dry_n_wet_aerosol_props(ibin) ! calc dp_wet, ref index
18019
18020
18021
18022 refindx(ibin,k) = ri_avg_a(ibin) ! vol avg ref index
18023 radius_wet(ibin,k) = dp_wet_a(ibin)/2.0 ! wet radius (cm)
18024 number_bin(ibin,k) = num_a(ibin) ! #/cc air
18025
18026 90 continue
18027
18028 100 continue ! k levels
18029 110 continue ! m subareas
18030
18031
18032 return
18033 end subroutine aerosol_optical_properties
18034
18035
18036
18037
18038
18039
18040
18041
18042
18043
18044 !***********************************************************************
18045 ! save aerosol drymass and drydens before aerosol mass transfer is
18046 ! calculated this subr is called from within subr mosaic_dynamic_solver,
18047 ! after the initial calls to check_aerosol_mass, conform_electrolytes,
18048 ! conform_aerosol_number, and aerosol_phase_state, but before the mass
18049 ! transfer is calculated
18050 !
18051 ! author: richard c. easter
18052 !-----------------------------------------------------------------------
18053 subroutine save_pregrow_props
18054
18055 use module_data_mosaic_asect, only: drydens_pregrow, drymass_pregrow, &
18056 ntype_aer, nsize_aer
18057 use module_data_mosaic_other, only: cairclm
18058
18059 ! implicit none
18060 ! include 'v33com'
18061 ! include 'v33com9a'
18062 ! include 'v33com9b'
18063 ! include 'mosaic.h'
18064
18065 ! subr arguments (none)
18066
18067 ! local variables
18068 integer ibin, isize, itype
18069
18070
18071 ! air conc in mol/cm^3
18072 cair_mol_cc = cairclm(kclm_aer)
18073
18074 ! compute then save drymass and drydens for each bin
18075 ibin = 0
18076 do itype = 1, ntype_aer
18077 do isize = 1, nsize_aer(itype)
18078 ibin = ibin + 1
18079
18080 call calc_dry_n_wet_aerosol_props( ibin )
18081
18082 drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol(air)
18083 if(jaerosolstate(ibin) .eq. no_aerosol) then
18084 drydens_pregrow(isize,itype) = -1.
18085 else
18086 drydens_pregrow(isize,itype) = dens_dry_a(ibin) ! g/cc
18087 end if
18088
18089 end do
18090 end do
18091
18092 return
18093 end subroutine save_pregrow_props
18094
18095
18096
18097
18098
18099 !***********************************************************************
18100 ! special output
18101 !
18102 ! author: richard c. easter
18103 !-----------------------------------------------------------------------
18104 subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
18105
18106 ! implicit none
18107
18108 integer iclm, jclm, kclm, msub
18109 character*(*) fromwhere
18110
18111 return
18112 end subroutine specialoutaa
18113
18114
18115
18116
18117 !***********************************************************************
18118 ! box model test output
18119 !
18120 ! author: richard c. easter
18121 !-----------------------------------------------------------------------
18122 subroutine aerchem_boxtest_output( &
18123 iflag, iclm, jclm, kclm, msub, dtchem )
18124
18125 use module_data_mosaic_asect
18126 use module_data_mosaic_other
18127 ! implicit none
18128
18129 ! include 'v33com'
18130 ! include 'v33com2'
18131 ! include 'v33com9a'
18132
18133 integer iflag, iclm, jclm, kclm, msub
18134 real dtchem
18135
18136 ! local variables
18137 integer lun
18138 parameter (lun=83)
18139 integer ientryno
18140 save ientryno
18141 integer icomp, iphase, isize, itype, k, l, m, n
18142
18143 real dtchem_sv1
18144 save dtchem_sv1
18145 real rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
18146
18147 data ientryno / -13579 /
18148
18149
18150 ! bypass unless maerchem_boxtest_output > 0
18151 if (maerchem_boxtest_output .le. 0) return
18152
18153
18154
18155 !
18156 ! *** currently this only works for ntype_aer = 1
18157 !
18158 itype = 1
18159 iphase = ai_phase
18160
18161 ! do initial output
18162 if (ientryno .ne. -13579) goto 1000
18163
18164 ientryno = +1
18165 call peg_message( lunerr, '***' )
18166 call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
18167 call peg_message( lunerr, '***' )
18168
18169 write(lun) ltot, ltot2, itot, jtot, ktot
18170 write(lun) (name(l), l=1,ltot2)
18171
18172 write(lun) maerocoag, maerchem, maeroptical
18173 write(lun) msectional, maerosolincw
18174
18175 write(lun) nsize_aer(itype), ntot_mastercomp_aer
18176
18177 do icomp = 1, ntot_mastercomp_aer
18178 write(lun) &
18179 name_mastercomp_aer(icomp)
18180 write(lun) &
18181 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
18182 end do
18183
18184 do isize = 1, nsize_aer(itype)
18185 write(lun) &
18186 ncomp_plustracer_aer(itype), &
18187 ncomp_aer(itype), &
18188 waterptr_aer(isize,itype), &
18189 numptr_aer(isize,itype,iphase), &
18190 mprognum_aer(isize,itype,iphase)
18191 write(lun) &
18192 ( mastercompptr_aer(l,itype), &
18193 massptr_aer(l,isize,itype,iphase), &
18194 l=1,ncomp_plustracer_aer(itype) )
18195 write(lun) &
18196 volumcen_sect(isize,itype), &
18197 volumlo_sect(isize,itype), &
18198 volumhi_sect(isize,itype), &
18199 dcen_sect(isize,itype), &
18200 dlo_sect(isize,itype), &
18201 dhi_sect(isize,itype)
18202 write(lun) &
18203 lptr_so4_aer(isize,itype,iphase), &
18204 lptr_msa_aer(isize,itype,iphase), &
18205 lptr_no3_aer(isize,itype,iphase), &
18206 lptr_cl_aer(isize,itype,iphase), &
18207 lptr_co3_aer(isize,itype,iphase), &
18208 lptr_nh4_aer(isize,itype,iphase), &
18209 lptr_na_aer(isize,itype,iphase), &
18210 lptr_ca_aer(isize,itype,iphase), &
18211 lptr_oin_aer(isize,itype,iphase), &
18212 lptr_oc_aer(isize,itype,iphase), &
18213 lptr_bc_aer(isize,itype,iphase), &
18214 hyswptr_aer(isize,itype)
18215 end do
18216
18217 !
18218 ! test iflag
18219 !
18220 1000 continue
18221 if (iflag .eq. 1) goto 1010
18222 if (iflag .eq. 2) goto 2000
18223 if (iflag .eq. 3) goto 3000
18224 return
18225
18226 !
18227 ! iflag=1 -- save initial values
18228 !
18229 1010 continue
18230 dtchem_sv1 = dtchem
18231 do m = 1, nsubareas
18232 do k = 1, ktot
18233 do l = 1, ltot2
18234 rsub_sv1(l,k,m) = rsub(l,k,m)
18235 end do
18236 end do
18237 end do
18238
18239 return
18240
18241 !
18242 ! iflag=2 -- save intermediate values before doing move_sections
18243 ! (this is deactivated for now)
18244 !
18245 2000 continue
18246 return
18247
18248
18249 !
18250 ! iflag=3 -- do output
18251 !
18252 3000 continue
18253 do m = 1, nsubareas
18254 do k = 1, ktot
18255
18256 write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
18257 write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k), &
18258 ptotclm(k), afracsubarea(k,m)
18259
18260 write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
18261
18262 end do
18263 end do
18264
18265
18266 return
18267 end subroutine aerchem_boxtest_output
18268
18269
18270
18271 !***********************************************************************
18272 ! "debugging" output when mosaic encounters "fatal error" situation
18273 !
18274 ! author: richard c. easter
18275 !-----------------------------------------------------------------------
18276 subroutine mosaic_error_fatal( luna, ibin, msga )
18277 !
18278 ! dumps current column information
18279 ! when a fatal computational error occurs
18280 !
18281 use module_data_mosaic_asect
18282 use module_data_mosaic_other
18283 ! implicit none
18284
18285 ! arguments
18286 integer luna, ibin
18287 character*(*) msga
18288
18289 ! local variables
18290 integer icomp, iphase, isize, itype, k, l, lunb, m, n
18291 real dtchem_sv1
18292
18293
18294 !
18295 ! *** currently this only works for ntype_aer = 1
18296 !
18297 itype = 1
18298
18299
18300 lunb = luna
18301 if (lunb .le. 0) lunb = 6
18302
18303 9000 format( a )
18304 9010 format( 7i10 )
18305 9020 format( 3(1pe19.11) )
18306
18307 write(lunb,9000)
18308 write(lunb,9000) 'mosaic_error_fatal - msga ='
18309 write(lunb,9000) msga
18310 write(lunb,9000) 'i, j, k, msub,ibin ='
18311 write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
18312
18313 write(lunb,9010) ltot, ltot2, itot, jtot, ktot
18314 write(lunb,9000) (name(l), l=1,ltot2)
18315
18316 write(lunb,9010) maerocoag, maerchem, maeroptical
18317 write(lunb,9010) msectional, maerosolincw
18318
18319 write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
18320
18321 do icomp = 1, ntot_mastercomp_aer
18322 write(lunb,9000) &
18323 name_mastercomp_aer(icomp)
18324 write(lunb,9020) &
18325 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
18326 end do
18327
18328 do isize = 1, nsize_aer(itype)
18329 write(lunb,9010) &
18330 ncomp_plustracer_aer(itype), &
18331 ncomp_aer(itype), &
18332 waterptr_aer(isize,itype), &
18333 numptr_aer(isize,itype,iphase), &
18334 mprognum_aer(isize,itype,iphase)
18335 write(lunb,9010) &
18336 ( mastercompptr_aer(l,itype), &
18337 massptr_aer(l,isize,itype,iphase), &
18338 l=1,ncomp_plustracer_aer(itype) )
18339 write(lunb,9020) &
18340 volumcen_sect(isize,itype), &
18341 volumlo_sect(isize,itype), &
18342 volumhi_sect(isize,itype), &
18343 dcen_sect(isize,itype), &
18344 dlo_sect(isize,itype), &
18345 dhi_sect(isize,itype)
18346 write(lunb,9010) &
18347 lptr_so4_aer(isize,itype,iphase), &
18348 lptr_msa_aer(isize,itype,iphase), &
18349 lptr_no3_aer(isize,itype,iphase), &
18350 lptr_cl_aer(isize,itype,iphase), &
18351 lptr_co3_aer(isize,itype,iphase), &
18352 lptr_nh4_aer(isize,itype,iphase), &
18353 lptr_na_aer(isize,itype,iphase), &
18354 lptr_ca_aer(isize,itype,iphase), &
18355 lptr_oin_aer(isize,itype,iphase), &
18356 lptr_oc_aer(isize,itype,iphase), &
18357 lptr_bc_aer(isize,itype,iphase), &
18358 hyswptr_aer(isize,itype)
18359 end do
18360
18361
18362 dtchem_sv1 = -1.0
18363 do m = 1, nsubareas
18364 do k = 1, ktot
18365
18366 write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
18367 write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k), &
18368 ptotclm(k), afracsubarea(k,m)
18369
18370 write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
18371
18372 end do
18373 end do
18374
18375
18376 call peg_error_fatal( luna, msga )
18377
18378 return
18379 end subroutine mosaic_error_fatal
18380 !-----------------------------------------------------------------------
18381
18382
18383
18384 end module module_mosaic_therm