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 intrinsic max, min
21
22 contains
23
24
25
26 ! zz01aerchemistry.f (mosaic.21.0)
27 ! 05-feb-07 wig - converted to double
28 ! 10-jan-07 raz - contains major revisions and updates. new module ASTEM replaces ASTEEM.
29 ! 04-aug-06 raz - fixed bugs in asteem_flux_mix_case3a and asteem_flux_mix_case3b
30 ! revised treatment of kelvin effect.
31 ! 06-jun-06 rce - changed dens_aer_mac(ica_a) & (ico3_a) from 2.5 to 2.6
32 ! 31-may-06 rce - got latest version from
33 ! nirvana:/home/zaveri/rahul/pegasus/pegasus.3.1.1/src
34 ! in subr map_mosaic_species, turned off mapping
35 ! of soa species
36 ! 18-may-06 raz - major revisions in asteem and minor changes in mesa
37 ! 22-jan-06 raz - revised nh4no3 and nh4cl condensation algorithm
38 ! 07-jan-06 raz - improved asteem algorithm
39 ! 28-apr-05 raz - reversed calls to form_cacl2 and form_nacl
40 ! fixed caco3 error in subr. electrolytes_to_ions
41 ! renamed dens_aer to dens_aer_mac; mw_aer to mw_aer_mac
42 ! 27-apr-05 raz - updated dry_mass calculation approach in mesa_convergence
43 ! 22-apr-05 raz - fixed caso4 mass balance problem and updated algorithm to
44 ! calculate phi_volatile for nh3, hno3, and hcl.
45 ! 20-apr-05 raz - updated asceem
46 ! 19-apr-05 raz - updated the algorithm to constrain the nh4 concentration
47 ! during simultaneous nh3, hno3, and hcl integration such
48 ! that it does not exceed the max possible value for a given bin
49 ! 14-apr-05 raz - fixed asteem_flux_wet_case3 and asteem_flux_dry_case3c
50 ! 11-jan-05 raz - major updates to many subroutines
51 ! 18-nov-04 rce - make sure that acos argument is between +/-1.0
52 ! 28-jan-04 rce - added subr aerchem_boxtest_output;
53 ! eliminated some unnecessary 'include v33com-'
54 ! 01-dec-03 rce - added 'implicit none' to many routines;
55 ! eliminated some unnecessary 'include v33com-'
56 ! 05-oct-03 raz - added hysteresis treatment
57 ! 02-sep-03 raz - implemented asteem
58 ! 10-jul-03 raz - changed ix to ixd in interp. subrs fast*_up and fast*_lo
59 ! 08-jul-03 raz - implemented asteem (adaptive step time-split
60 ! explicit euler method)
61 ! 26-jun-03 raz - updated almost all the subrs. this version contains
62 ! options for rigorous and fast solvers (including lsode solver)
63 !
64 ! 07-oct-02 raz - made zx and zm integers in activity coeff subs.
65 ! 16-sep-02 raz - updated many subrs to treat calcium salts
66 ! 19-aug-02 raz - inlcude v33com9a in subr aerosolmtc
67 ! 14-aug-02 rce - '(msectional.eq.0)' changed to '(msectional.le.0)'
68 ! 07-aug-02 rce - this is rahul's latest version from freshair
69 ! after adding 'real mean_molecular_speed' wherever it is used
70 ! 01-apr-02 raz - made final tests and gave the code to jerome
71 !
72 ! 04--14-dec-01 rce - several minor changes during initial testing/debug
73 ! in 3d los angeles simulation
74 ! (see earlier versions for details about these changes)
75 !-----------------------------------------------------------------------
76 !23456789012345678901234567890123456789012345678901234567890123456789012
77
78 !***********************************************************************
79 ! interface to mosaic
80 !
81 ! author: rahul a. zaveri
82 ! update: jan 2005
83 !-----------------------------------------------------------------------
84 subroutine aerchemistry( iclm, jclm, kclm_calcbgn, kclm_calcend, &
85 dtchem_sngl, idiagaa )
86
87 use module_data_mosaic_asect
88 use module_data_mosaic_other
89 use module_mosaic_movesect, only: move_sections
90
91 ! implicit none
92 ! include 'v33com'
93 ! include 'v33com2'
94 ! include 'v33com3'
95 ! include 'mosaic.h'
96 ! subr arguments
97 integer iclm, jclm, kclm_calcbgn, kclm_calcend, idiagaa
98 real dtchem_sngl
99 ! local variables
100 real(kind=8) :: dtchem
101 integer k, m
102
103
104
105 dtchem = dtchem_sngl
106
107 lunerr_aer = lunerr
108 ncorecnt_aer = ncorecnt
109
110 ! special output for solver testing
111 call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
112
113 iclm_aer = iclm
114 jclm_aer = jclm
115 kclm_aer_calcbgn = kclm_calcbgn
116 kclm_aer_calcend = kclm_calcend
117
118
119 do 200 m = 1, nsubareas
120 mclm_aer = m
121
122 do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
123
124 kclm_aer = k
125 if (afracsubarea(k,m) .lt. 1.e-4) goto 100
126
127 istat_mosaic_fe1 = 1
128
129 call mosaic( k, m, dtchem )
130
131 if (istat_mosaic_fe1 .lt. 0) then
132 nfe1_mosaic_cur = nfe1_mosaic_cur + 1
133 nfe1_mosaic_tot = nfe1_mosaic_tot + 1
134 if (iprint_mosaic_fe1 .gt. 0) then
135 write(6,*) 'mosaic aerchemistry fatal error - i/j/k/m =', &
136 iclm_aer, jclm_aer, kclm_aer, mclm_aer
137 call print_input
138 if (iprint_mosaic_fe1 .ge. 10) &
139 call mosaic_aerchem_error_dump( 0, 0, lunerr_aer, &
140 'aerchemistry fatal error' )
141 end if
142 goto 100
143 end if
144
145 call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
146 call move_sections( 1, iclm, jclm, k, m)
147 call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
148
149 100 continue ! k levels
150
151 200 continue ! subareas
152
153
154 ! special output for solver testing
155 call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
156
157 return
158 end subroutine aerchemistry
159
160
161
162
163
164
165
166
167
168
169 !***********************************************************************
170 ! mosaic (model for simulating aerosol interactions and chemistry)
171 !
172 ! author: rahul a. zaveri
173 ! update: dec 2004
174 !-----------------------------------------------------------------------
175 subroutine mosaic(k, m, dtchem)
176
177 use module_data_mosaic_asect
178 use module_data_mosaic_other
179
180 ! implicit none
181 ! include 'v33com'
182 ! include 'v33com3'
183 ! include 'mosaic.h'
184 ! subr arguments
185 integer k, m
186 real(kind=8) dtchem
187 ! local variables
188 real(kind=8) yh2o, dumdum
189 integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
190 ! data iclm_debug /28/
191 ! data jclm_debug /1/
192 ! data kclm_debug /9/
193 ! data ncnt_debug /6/
194 iclm_debug=-28; jclm_debug=1; kclm_debug=9; ncnt_debug=6
195
196
197
198 if(iclm_aer .eq. iclm_debug .and. &
199 jclm_aer .eq. jclm_debug .and. &
200 kclm_aer .eq. kclm_debug .and. &
201 ncorecnt_aer .eq. ncnt_debug)then
202 dumdum = 0.0
203 endif
204
205
206 ! overwrite inputs
207 if(1.eq.0)then
208 call hijack_input(k,m)
209 endif
210
211
212 t_k = rsub(ktemp,k,m) ! update temperature = k
213 p_atm = ptotclm(k) /1.032d6 ! update pressure = atm
214 yh2o = rsub(kh2o,k,m) ! mol(h2o)/mol(air)
215 rh_pc = 100.*relhumclm(k) ! rh (%)
216 ah2o = relhumclm(k) ! fractional rh
217
218
219 call load_mosaic_parameters ! sets up indices and other stuff once per simulation
220
221 call initialize_mosaic_variables
222
223 call update_thermodynamic_constants ! update t and rh dependent constants
224
225 call map_mosaic_species(k, m, 0)
226
227
228 call overall_massbal_in ! save input mass over all bins
229 iprint_input = myes ! reset to default
230
231
232 call mosaic_dynamic_solver( dtchem )
233 if (istat_mosaic_fe1 .lt. 0) return
234
235
236 call overall_massbal_out(0) ! check mass balance after integration
237
238 call map_mosaic_species(k, m, 1)
239
240 ! write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
241
242 return
243 end subroutine mosaic
244
245
246
247
248
249
250
251
252
253
254
255
256 !***********************************************************************
257 ! interface to asceem and asteem dynamic gas-particle exchange solvers
258 !
259 ! author: rahul a. zaveri
260 ! update: jan 2005
261 !-----------------------------------------------------------------------
262 subroutine mosaic_dynamic_solver( dtchem )
263 ! implicit none
264 ! include 'v33com'
265 ! include 'mosaic.h'
266 ! subr arguments
267 real(kind=8) dtchem
268 ! local variables
269 integer ibin, iv, k, m
270 real(kind=8) xt, dumdum
271 ! real(kind=8) aerosol_water_up ! mosaic func
272
273
274 ! if(iclm_aer .eq. 21 .and. &
275 ! jclm_aer .eq. 17 .and. &
276 ! kclm_aer .eq. 3 .and. &
277 ! ncorecnt_aer .eq. 4)then
278 ! dumdum = 0.0
279 ! endif
280
281
282 do 500 ibin = 1, nbin_a
283
284 call check_aerosol_mass(ibin)
285 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
286
287 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
288
289 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
290 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
291
292 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
293
294 500 continue
295
296
297
298 ! box
299 ! call initial_aer_print_box ! box
300
301 call save_pregrow_props
302
303 call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77, &
304 'after_conform' )
305 !
306 !-------------------------------------
307 ! do dynamic gas-aerosol mass transfer
308
309 if(mgas_aer_xfer .eq. mon)then
310
311 call astem(dtchem)
312
313 endif
314
315 !-------------------------------------
316 ! box
317 ! grows or shrinks size depending on mass increase or decrease
318 !
319 ! do ibin = 1, nbin_a
320 ! if(jaerosolstate(ibin) .ne. no_aerosol)then
321 ! call conform_particle_size(ibin) ! box
322 ! endif
323 ! enddo
324
325
326
327 do 600 ibin = 1, nbin_a
328 if(jaerosolstate(ibin).eq.no_aerosol) goto 600
329
330 if(jhyst_leg(ibin) .eq. jhyst_lo)then
331 water_a_hyst(ibin) = 0.0
332 elseif(jhyst_leg(ibin) .eq. jhyst_up)then
333 water_a_up(ibin) = aerosol_water_up(ibin) ! at 60% rh
334 water_a_hyst(ibin) = water_a_up(ibin)
335 endif
336
337 call calc_dry_n_wet_aerosol_props(ibin) ! compute final mass and density
338 600 continue
339
340 return
341 end subroutine mosaic_dynamic_solver
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356 subroutine hijack_input(k, m)
357
358 use module_data_mosaic_asect
359 use module_data_mosaic_other
360
361 ! implicit none
362 ! include 'v33com'
363 ! include 'v33com3'
364 ! include 'v33com9a'
365 ! include 'v33com9b'
366 ! include 'mosaic.h'
367 ! subr arguments
368 integer k, m
369 ! local variables
370 integer ibin, igas, iphase, isize, itype
371 real(kind=8) t_kdum, p_atmdum, rhdum, cairclmdum
372 real(kind=8) gasdum(4), aerdum(14,8)
373
374
375
376
377 ! read inputs----------------
378 open(92, file = 'box.txt')
379
380 read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
381 ! do igas = 1, 4
382 read(92,*)gasdum(1),gasdum(2),gasdum(3),gasdum(4)
383 ! enddo
384
385 do ibin = 1, nbin_a
386 read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin), &
387 aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin), &
388 aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin), &
389 aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin), &
390 aerdum(13,ibin),aerdum(14,ibin)
391 enddo
392
393 close(92)
394 !----------------------------
395
396
397
398 rsub(ktemp,k,m) = t_kdum ! update temperature = k
399 ptotclm(k) = p_atmdum*1.032d6! update pressure = atm
400 relhumclm(k) = rhdum/100.0 ! fractional rh
401 cairclm(k) = cairclmdum ! mol/cc
402
403
404 ! 3-d
405 ! calculate air conc in mol/m^3
406 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
407 cair_mol_cc = cairclm(k)
408
409 ! 3-d
410 ! define conversion factors
411 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
412 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
413 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
414 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
415
416
417 ! read rsub (mol/mol(air))
418 ! gas
419 rsub(kh2so4,k,m) = gasdum(1)
420 rsub(khno3,k,m) = gasdum(2)
421 rsub(khcl,k,m) = gasdum(3)
422 rsub(knh3,k,m) = gasdum(4)
423
424
425 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
426 iphase = ai_phase
427 ibin = 0
428 do 10 itype = 1, ntype_aer
429 do 10 isize = 1, nsize_aer(itype)
430 ibin = ibin + 1
431
432 rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
433 rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
434 rsub(lptr_cl_aer(isize,itype,iphase),k,m) = aerdum(3,ibin)
435 rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
436 rsub(lptr_oc_aer(isize,itype,iphase),k,m) = aerdum(5,ibin)
437 rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
438 rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
439 rsub(lptr_bc_aer(isize,itype,iphase),k,m) = aerdum(8,ibin)
440 rsub(lptr_na_aer(isize,itype,iphase),k,m) = aerdum(9,ibin)
441 rsub(lptr_ca_aer(isize,itype,iphase),k,m) = aerdum(10,ibin)
442 rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
443
444 rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
445 rsub(waterptr_aer(isize,itype),k,m) = aerdum(13,ibin) ! kg/m^3(air)
446 rsub(numptr_aer(isize,itype,iphase),k,m) = aerdum(14,ibin) ! num_a is in #/cc
447 10 continue
448
449 return
450 end subroutine hijack_input
451
452
453
454
455
456 !***********************************************************************
457 ! intializes all the mosaic variables to zero or their default values.
458 !
459 ! author: rahul a. zaveri
460 ! update: jun 2003
461 !-----------------------------------------------------------------------
462 subroutine initialize_mosaic_variables
463 ! implicit none
464 ! include 'mosaic.h'
465 ! local variables
466 integer iaer, ibin, iv, ja, jc, je
467
468
469
470 do iv = 1, ngas_ioa
471 gas(iv) = 0.0
472 enddo
473
474 ! initialize to zero
475 do ibin = 1, nbin_a
476
477 num_a(ibin) = 0.0
478 mass_dry_a(ibin) = 0.0
479 mass_soluble_a(ibin) = 0.0
480
481 do iaer = 1, naer
482 aer(iaer,jtotal,ibin) = 0.0
483 aer(iaer,jsolid,ibin) = 0.0
484 aer(iaer,jliquid,ibin) = 0.0
485 enddo
486
487 do je = 1, nelectrolyte
488 electrolyte(je,jtotal,ibin) = 0.0
489 electrolyte(je,jsolid,ibin) = 0.0
490 electrolyte(je,jliquid,ibin) = 0.0
491 activity(je,ibin) = 0.0
492 gam(je,ibin) = 0.0
493 enddo
494
495 gam_ratio(ibin) = 0.0
496
497 do iv = 1, ngas_ioa
498 flux_s(iv,ibin) = 0.0
499 flux_l(iv,ibin) = 0.0
500 kg(iv,ibin) = 0.0
501 phi_volatile_s(iv,ibin) = 0.0
502 phi_volatile_l(iv,ibin) = 0.0
503 df_gas_s(iv,ibin) = 0.0
504 df_gas_l(iv,ibin) = 0.0
505 volatile_s(iv,ibin) = 0.0
506 enddo
507
508
509 jaerosolstate(ibin) = -1 ! initialize to default value
510 jphase(ibin) = 0
511
512 do jc = 1, ncation
513 mc(jc,ibin) = 0.0
514 enddo
515
516 do ja = 1, nanion
517 ma(ja,ibin) = 0.0
518 enddo
519
520 enddo ! ibin
521
522
523 return
524 end subroutine initialize_mosaic_variables
525
526
527
528
529
530
531 !***********************************************************************
532 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
533 !
534 ! author: rahul a. zaveri
535 ! update: nov 2001
536 !-------------------------------------------------------------------------
537 subroutine map_mosaic_species(k, m, imap)
538
539 use module_data_mosaic_asect
540 use module_data_mosaic_other
541 use module_state_description, only: param_first_scalar
542
543 ! implicit none
544
545 ! include 'v33com'
546 ! include 'v33com3'
547 ! include 'v33com9a'
548 ! include 'v33com9b'
549
550 ! subr arguments
551 integer k, m, imap
552 ! local variables
553 integer ibin, iphase, isize, itsi, itype, l, p1st
554
555
556 ! if a species index is less than this value, then the species is not defined
557 p1st = param_first_scalar
558
559 ! 3-d
560 ! calculate air conc in mol/m^3
561 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
562 cair_mol_cc = cairclm(k)
563
564 ! 3-d
565 ! define conversion factors
566 conv1a = cair_mol_m3*1.d9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
567 conv1b = 1.d0/conv1a ! converts nq/m^3 to q/mol(air)
568 conv2a = cair_mol_m3*18.*1.d-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
569 conv2b = 1.d0/conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
570
571
572 ! box
573 ! conv1 = 1.d15/avogad ! converts (molec/cc) to (nmol/m^3)
574 ! conv2 = 1.d0/conv1 ! converts (nmol/m^3) to (molec/cc)
575 ! kaerstart = ngas_max
576
577
578 if(imap.eq.0)then ! map rsub (mol/mol(air)) into aer (nmol/m^3)
579 ! gas
580 if (kh2so4 .ge. p1st) then
581 gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a ! nmol/m^3
582 else
583 gas(ih2so4_g) = 0.0
584 end if
585 if (khno3 .ge. p1st) then
586 gas(ihno3_g) = rsub(khno3,k,m)*conv1a
587 else
588 gas(ihno3_g) = 0.0
589 end if
590 if (khcl .ge. p1st) then
591 gas(ihcl_g) = rsub(khcl,k,m)*conv1a
592 else
593 gas(ihcl_g) = 0.0
594 end if
595 if (knh3 .ge. p1st) then
596 gas(inh3_g) = rsub(knh3,k,m)*conv1a
597 else
598 gas(inh3_g) = 0.0
599 end if
600
601 ! soa gas-phase species -- currently deactivated
602 ! if (karo1 .ge. p1st) then
603 ! gas(iaro1_g) = rsub(karo1,k,m)*conv1a
604 ! else
605 gas(iaro1_g) = 0.0
606 ! end if
607 ! if (karo2 .ge. p1st) then
608 ! gas(iaro2_g) = rsub(karo2,k,m)*conv1a
609 ! else
610 gas(iaro2_g) = 0.0
611 ! end if
612 ! if (kalk1 .ge. p1st) then
613 ! gas(ialk1_g) = rsub(kalk1,k,m)*conv1a
614 ! else
615 gas(ialk1_g) = 0.0
616 ! end if
617 ! if (kole1 .ge. p1st) then
618 ! gas(iole1_g) = rsub(kole1,k,m)*conv1a
619 ! else
620 gas(iole1_g) = 0.0
621 ! end if
622 ! if (kapi1 .ge. p1st) then
623 ! gas(iapi1_g) = rsub(kapi1,k,m)*conv1a
624 ! else
625 gas(iapi1_g) = 0.0
626 ! end if
627 ! if (kapi2 .ge. p1st) then
628 ! gas(iapi2_g) = rsub(kapi2,k,m)*conv1a
629 ! else
630 gas(iapi2_g) = 0.0
631 ! end if
632 ! if (klim1 .ge. p1st) then
633 ! gas(ilim1_g) = rsub(klim1,k,m)*conv1a
634 ! else
635 gas(ilim1_g) = 0.0
636 ! end if
637 ! if (klim2 .ge. p1st) then
638 ! gas(ilim2_g) = rsub(klim2,k,m)*conv1a
639 ! else
640 gas(ilim2_g) = 0.0
641 ! end if
642
643
644 ! aerosol
645 iphase = ai_phase
646 ibin = 0
647 do 10 itype = 1, ntype_aer
648 do 10 isize = 1, nsize_aer(itype)
649 ibin = ibin + 1
650
651 ! aer array units are nmol/(m^3 air)
652
653 ! rce 18-nov-2004 - always map so4 and number,
654 ! but only map other species when (lptr_xxx .ge. p1st)
655 ! rce 11-may-2006 - so4 mapping now optional
656 l = lptr_so4_aer(isize,itype,iphase)
657 if (l .ge. p1st) then
658 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
659 else
660 aer(iso4_a,jtotal,ibin)=0.0
661 end if
662
663 l = lptr_no3_aer(isize,itype,iphase)
664 if (l .ge. p1st) then
665 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
666 else
667 aer(ino3_a,jtotal,ibin)=0.0
668 end if
669
670 l = lptr_cl_aer(isize,itype,iphase)
671 if (l .ge. p1st) then
672 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
673 else
674 aer(icl_a,jtotal,ibin)=0.0
675 end if
676
677 l = lptr_nh4_aer(isize,itype,iphase)
678 if (l .ge. p1st) then
679 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
680 else
681 aer(inh4_a,jtotal,ibin)=0.0
682 end if
683
684 l = lptr_oc_aer(isize,itype,iphase)
685 if (l .ge. p1st) then
686 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
687 else
688 aer(ioc_a,jtotal,ibin)=0.0
689 end if
690
691 l = lptr_bc_aer(isize,itype,iphase)
692 if (l .ge. p1st) then
693 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
694 else
695 aer(ibc_a,jtotal,ibin)=0.0
696 end if
697
698 l = lptr_na_aer(isize,itype,iphase)
699 if (l .ge. p1st) then
700 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
701 else
702 aer(ina_a,jtotal,ibin)=0.0
703 end if
704
705 l = lptr_oin_aer(isize,itype,iphase)
706 if (l .ge. p1st) then
707 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
708 else
709 aer(ioin_a,jtotal,ibin)=0.0
710 end if
711
712 l = lptr_msa_aer(isize,itype,iphase)
713 if (l .ge. p1st) then
714 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
715 else
716 aer(imsa_a,jtotal,ibin)=0.0
717 end if
718
719 l = lptr_co3_aer(isize,itype,iphase)
720 if (l .ge. p1st) then
721 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
722 else
723 aer(ico3_a,jtotal,ibin)=0.0
724 end if
725
726 l = lptr_ca_aer(isize,itype,iphase)
727 if (l .ge. p1st) then
728 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
729 else
730 aer(ica_a,jtotal,ibin)=0.0
731 end if
732
733 ! soa aerosol-phase species -- currently deactivated
734 ! l = lptr_aro1_aer(isize,itype,iphase)
735 ! if (l .ge. p1st) then
736 ! aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
737 ! else
738 aer(iaro1_a,jtotal,ibin)=0.0
739 ! end if
740
741 ! l = lptr_aro2_aer(isize,itype,iphase)
742 ! if (l .ge. p1st) then
743 ! aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
744 ! else
745 aer(iaro2_a,jtotal,ibin)=0.0
746 ! end if
747
748 ! l = lptr_alk1_aer(isize,itype,iphase)
749 ! if (l .ge. p1st) then
750 ! aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
751 ! else
752 aer(ialk1_a,jtotal,ibin)=0.0
753 ! end if
754
755 ! l = lptr_ole1_aer(isize,itype,iphase)
756 ! if (l .ge. p1st) then
757 ! aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
758 ! else
759 aer(iole1_a,jtotal,ibin)=0.0
760 ! end if
761
762 ! l = lptr_api1_aer(isize,itype,iphase)
763 ! if (l .ge. p1st) then
764 ! aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
765 ! else
766 aer(iapi1_a,jtotal,ibin)=0.0
767 ! end if
768
769 ! l = lptr_api2_aer(isize,itype,iphase)
770 ! if (l .ge. p1st) then
771 ! aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
772 ! else
773 aer(iapi2_a,jtotal,ibin)=0.0
774 ! end if
775
776 ! l = lptr_lim1_aer(isize,itype,iphase)
777 ! if (l .ge. p1st) then
778 ! aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
779 ! else
780 aer(ilim1_a,jtotal,ibin)=0.0
781 ! end if
782
783 ! l = lptr_lim2_aer(isize,itype,iphase)
784 ! if (l .ge. p1st) then
785 ! aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
786 ! else
787 aer(ilim2_a,jtotal,ibin)=0.0
788 ! end if
789
790 ! water_a and water_a_hyst units are kg/(m^3 air)
791 l = hyswptr_aer(isize,itype)
792 if (l .ge. p1st) then
793 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
794 else
795 water_a_hyst(ibin)=0.0
796 end if
797
798 ! water_a units are kg/(m^3 air)
799 l = waterptr_aer(isize,itype)
800 if (l .ge. p1st) then
801 water_a(ibin)=rsub(l,k,m)*conv2a
802 else
803 water_a(ibin)=0.0
804 end if
805
806 ! num_a units are #/(cm^3 air)
807 l = numptr_aer(isize,itype,iphase)
808 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
809
810 ! other bin parameters (fixed for now)
811 sigmag_a(ibin) = 1.02
812
813 10 continue
814
815
816
817
818 !---------------------------------------------------------------------
819
820
821 else ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
822
823
824
825 ! gas
826 if (kh2so4 .ge. p1st) &
827 rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
828 if (khno3 .ge. p1st) &
829 rsub(khno3,k,m) = gas(ihno3_g)*conv1b
830 if (khcl .ge. p1st) &
831 rsub(khcl,k,m) = gas(ihcl_g)*conv1b
832 if (knh3 .ge. p1st) &
833 rsub(knh3,k,m) = gas(inh3_g)*conv1b
834
835 ! soa gas-phase species -- currently deactivated
836 ! if (karo1 .ge. p1st) &
837 ! rsub(karo1,k,m) = gas(iaro1_g)*conv1b
838 ! if (karo2 .ge. p1st) &
839 ! rsub(karo2,k,m) = gas(iaro2_g)*conv1b
840 ! if (kalk1 .ge. p1st) &
841 ! rsub(kalk1,k,m) = gas(ialk1_g)*conv1b
842 ! if (kole1 .ge. p1st) &
843 ! rsub(kole1,k,m) = gas(iole1_g)*conv1b
844 ! if (kapi1 .ge. p1st) &
845 ! rsub(kapi1,k,m) = gas(iapi1_g)*conv1b
846 ! if (kapi2 .ge. p1st) &
847 ! rsub(kapi2,k,m) = gas(iapi2_g)*conv1b
848 ! if (klim1 .ge. p1st) &
849 ! rsub(klim1,k,m) = gas(ilim1_g)*conv1b
850 ! if (klim2 .ge. p1st) &
851 ! rsub(klim2,k,m) = gas(ilim2_g)*conv1b
852
853 ! aerosol
854 iphase = ai_phase
855 ibin = 0
856 do 20 itype = 1, ntype_aer
857 do 20 isize = 1, nsize_aer(itype)
858 ibin = ibin + 1
859
860
861 ! rce 18-nov-2004 - always map so4 and number,
862 ! but only map other species when (lptr_xxx .ge. p1st)
863 l = lptr_so4_aer(isize,itype,iphase)
864 rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
865
866 l = lptr_no3_aer(isize,itype,iphase)
867 if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
868
869 l = lptr_cl_aer(isize,itype,iphase)
870 if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
871
872 l = lptr_nh4_aer(isize,itype,iphase)
873 if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
874
875 l = lptr_oc_aer(isize,itype,iphase)
876 if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
877
878 l = lptr_bc_aer(isize,itype,iphase)
879 if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
880
881 l = lptr_na_aer(isize,itype,iphase)
882 if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
883
884 l = lptr_oin_aer(isize,itype,iphase)
885 if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
886
887 l = lptr_msa_aer(isize,itype,iphase)
888 if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
889
890 l = lptr_co3_aer(isize,itype,iphase)
891 if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
892
893 l = lptr_ca_aer(isize,itype,iphase)
894 if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
895
896 ! soa aerosol-phase species -- currently deactivated
897 ! l = lptr_aro1_aer(isize,itype,iphase)
898 ! if (l .ge. p1st) rsub(l,k,m) = aer(iaro1_a,jtotal,ibin)*conv1b
899
900 ! l = lptr_aro2_aer(isize,itype,iphase)
901 ! if (l .ge. p1st) rsub(l,k,m) = aer(iaro2_a,jtotal,ibin)*conv1b
902
903 ! l = lptr_alk1_aer(isize,itype,iphase)
904 ! if (l .ge. p1st) rsub(l,k,m) = aer(ialk1_a,jtotal,ibin)*conv1b
905
906 ! l = lptr_ole1_aer(isize,itype,iphase)
907 ! if (l .ge. p1st) rsub(l,k,m) = aer(iole1_a,jtotal,ibin)*conv1b
908
909 ! l = lptr_api1_aer(isize,itype,iphase)
910 ! if (l .ge. p1st) rsub(l,k,m) = aer(iapi1_a,jtotal,ibin)*conv1b
911
912 ! l = lptr_api2_aer(isize,itype,iphase)
913 ! if (l .ge. p1st) rsub(l,k,m) = aer(iapi2_a,jtotal,ibin)*conv1b
914
915 ! l = lptr_lim1_aer(isize,itype,iphase)
916 ! if (l .ge. p1st) rsub(l,k,m) = aer(ilim1_a,jtotal,ibin)*conv1b
917
918 ! l = lptr_lim2_aer(isize,itype,iphase)
919 ! if (l .ge. p1st) rsub(l,k,m) = aer(ilim2_a,jtotal,ibin)*conv1b
920
921 l = hyswptr_aer(isize,itype)
922 if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
923
924 l = waterptr_aer(isize,itype)
925 if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
926
927 l = numptr_aer(isize,itype,iphase)
928 if (l .ge. p1st) rsub(l,k,m) = num_a(ibin)/cair_mol_cc
929
930
931 drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
932 if(jaerosolstate(ibin) .eq. no_aerosol) then
933 drydens_aftgrow(isize,itype) = -1.
934 else
935 drydens_aftgrow(isize,itype) = dens_dry_a(ibin) ! g/cc
936 end if
937
938 20 continue
939
940 endif
941
942 return
943 end subroutine map_mosaic_species
944
945
946
947
948
949 subroutine isize_itype_from_ibin( ibin, isize, itype )
950 !
951 ! inside of mosaic, the '2d' (isize,itype) indexing is replaced
952 ! by '1d' (ibin) indexing
953 ! this routine gives (isize,itype) corresponding to (ibin)
954 !
955 use module_data_mosaic_asect
956 use module_data_mosaic_other, only: lunerr
957 ! implicit none
958
959 ! subr arguments
960 integer ibin, isize, itype
961 ! local variables
962 integer jdum_bin, jdum_size, jdum_type
963 character*80 msg
964
965 isize = -999888777
966 itype = -999888777
967
968 jdum_bin = 0
969 do jdum_type = 1, ntype_aer
970 do jdum_size = 1, nsize_aer(jdum_type)
971 jdum_bin = jdum_bin + 1
972 if (ibin .eq. jdum_bin) then
973 isize = jdum_size
974 itype = jdum_type
975 end if
976 end do
977 end do
978
979 if (isize .le. 0) then
980 write(msg,'(a,1x,i5)') &
981 '*** subr isize_itype_from_ibin - bad ibin =', ibin
982 call peg_error_fatal( lunerr, msg )
983 end if
984
985 return
986 end subroutine isize_itype_from_ibin
987
988
989
990
991 subroutine overall_massbal_in
992
993 use module_data_mosaic_asect
994 use module_data_mosaic_other
995
996 ! implicit none
997 ! include 'mosaic.h'
998 integer ibin
999
1000 tot_so4_in = gas(ih2so4_g)
1001 tot_no3_in = gas(ihno3_g)
1002 tot_cl_in = gas(ihcl_g)
1003 tot_nh4_in = gas(inh3_g)
1004 tot_na_in = 0.0
1005 tot_ca_in = 0.0
1006
1007
1008 do ibin = 1, nbin_a
1009 tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
1010 tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
1011 tot_cl_in = tot_cl_in + aer(icl_a, jtotal,ibin)
1012 tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
1013 tot_na_in = tot_na_in + aer(ina_a,jtotal,ibin)
1014 tot_ca_in = tot_ca_in + aer(ica_a,jtotal,ibin)
1015 enddo
1016
1017
1018 total_species(inh3_g) = tot_nh4_in
1019 total_species(ihno3_g)= tot_no3_in
1020 total_species(ihcl_g) = tot_cl_in
1021
1022
1023 return
1024 end subroutine overall_massbal_in
1025
1026
1027
1028 subroutine overall_massbal_out(mbin)
1029 ! implicit none
1030 ! include 'v33com'
1031 ! include 'v33com3'
1032 ! include 'v33com9a'
1033 ! include 'v33com9b'
1034 ! include 'mosaic.h'
1035
1036 ! subr. agrument
1037 integer mbin
1038 ! local variables
1039 integer ibin
1040
1041
1042
1043 tot_so4_out = gas(ih2so4_g)
1044 tot_no3_out = gas(ihno3_g)
1045 tot_cl_out = gas(ihcl_g)
1046 tot_nh4_out = gas(inh3_g)
1047 tot_na_out = 0.0
1048 tot_ca_out = 0.0
1049
1050 do ibin = 1, nbin_a
1051 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1052 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1053 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
1054 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1055 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
1056 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
1057 enddo
1058
1059 diff_so4 = tot_so4_out - tot_so4_in
1060 diff_no3 = tot_no3_out - tot_no3_in
1061 diff_cl = tot_cl_out - tot_cl_in
1062 diff_nh4 = tot_nh4_out - tot_nh4_in
1063 diff_na = tot_na_out - tot_na_in
1064 diff_ca = tot_ca_out - tot_ca_in
1065
1066
1067 reldiff_so4 = 0.0
1068 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1069 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1070 endif
1071
1072 reldiff_no3 = 0.0
1073 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1074 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1075 endif
1076
1077 reldiff_cl = 0.0
1078 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1079 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1080 endif
1081
1082 reldiff_nh4 = 0.0
1083 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1084 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1085 endif
1086
1087 reldiff_na = 0.0
1088 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1089 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1090 endif
1091
1092 reldiff_ca = 0.0
1093 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1094 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1095 endif
1096
1097
1098
1099 if( abs(reldiff_so4) .gt. 1.e-4 .or. &
1100 abs(reldiff_no3) .gt. 1.e-4 .or. &
1101 abs(reldiff_cl) .gt. 1.e-4 .or. &
1102 abs(reldiff_nh4) .gt. 1.e-4 .or. &
1103 abs(reldiff_na) .gt. 1.e-4 .or. &
1104 abs(reldiff_ca) .gt. 1.e-4)then
1105
1106
1107 if (iprint_mosaic_diag1 .gt. 0) then
1108 if (iprint_input .eq. myes) then
1109 write(6,*)'*** mbin = ', mbin, ' isteps = ', isteps_ASTEM
1110 write(6,*)'reldiff_so4 = ', reldiff_so4
1111 write(6,*)'reldiff_no3 = ', reldiff_no3
1112 write(6,*)'reldiff_cl = ', reldiff_cl
1113 write(6,*)'reldiff_nh4 = ', reldiff_nh4
1114 write(6,*)'reldiff_na = ', reldiff_na
1115 write(6,*)'reldiff_ca = ', reldiff_ca
1116 call print_input
1117 iprint_input = mno
1118 endif
1119 endif
1120
1121 endif
1122
1123
1124 return
1125 end subroutine overall_massbal_out
1126
1127
1128
1129
1130
1131
1132
1133 subroutine print_input
1134
1135 use module_data_mosaic_asect
1136 use module_data_mosaic_other
1137
1138 ! implicit none
1139 ! include 'v33com'
1140 ! include 'v33com3'
1141 ! include 'v33com9a'
1142 ! include 'v33com9b'
1143 ! include 'mosaic.h'
1144 ! subr arguments
1145 integer k, m
1146 ! local variables
1147 integer ibin, iphase, isize, itype
1148 integer ipasstmp, luntmp
1149
1150
1151 ! check for print_input allowed and not already done
1152 if (iprint_mosaic_input_ok .le. 0) return
1153 if (iprint_input .ne. myes) return
1154 iprint_input = mno
1155
1156 k = kclm_aer
1157 m = mclm_aer
1158
1159
1160 tot_so4_out = gas(ih2so4_g)
1161 tot_no3_out = gas(ihno3_g)
1162 tot_cl_out = gas(ihcl_g)
1163 tot_nh4_out = gas(inh3_g)
1164 tot_na_out = 0.0
1165 tot_ca_out = 0.0
1166
1167 do ibin = 1, nbin_a
1168 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1169 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1170 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
1171 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1172 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
1173 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
1174 enddo
1175
1176 diff_so4 = tot_so4_out - tot_so4_in
1177 diff_no3 = tot_no3_out - tot_no3_in
1178 diff_cl = tot_cl_out - tot_cl_in
1179 diff_nh4 = tot_nh4_out - tot_nh4_in
1180 diff_na = tot_na_out - tot_na_in
1181 diff_ca = tot_ca_out - tot_ca_in
1182
1183
1184 reldiff_so4 = 0.0
1185 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1186 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1187 endif
1188
1189 reldiff_no3 = 0.0
1190 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1191 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1192 endif
1193
1194 reldiff_cl = 0.0
1195 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1196 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1197 endif
1198
1199 reldiff_nh4 = 0.0
1200 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1201 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1202 endif
1203
1204 reldiff_na = 0.0
1205 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1206 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1207 endif
1208
1209 reldiff_ca = 0.0
1210 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1211 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1212 endif
1213
1214
1215 do 2900 ipasstmp = 1, 2
1216
1217 if (ipasstmp .eq. 1) then
1218 luntmp = 6 ! write to standard output
1219 else
1220 luntmp = 67 ! write to fort.67
1221 ! goto 2900 ! skip this
1222 endif
1223
1224 ! write to monitor screen
1225 write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1226 write(luntmp,*)'i j k n = ', iclm_aer, jclm_aer, kclm_aer, &
1227 ncorecnt_aer
1228 write(luntmp,*)'relative so4 mass bal = ', reldiff_so4
1229 write(luntmp,*)'relative no3 mass bal = ', reldiff_no3
1230 write(luntmp,*)'relative cl mass bal = ', reldiff_cl
1231 write(luntmp,*)'relative nh4 mass bal = ', reldiff_nh4
1232 write(luntmp,*)'relative na mass bal = ', reldiff_na
1233 write(luntmp,*)'relative ca mass bal = ', reldiff_ca
1234 write(luntmp,*)'inputs:'
1235 write(luntmp,*)'t (k), p (atm), rh (%), cair (mol/cc) = '
1236 write(luntmp,44) t_k, p_atm, rh_pc, cairclm(k)
1237 write(luntmp,*)'gas h2so4, hno3, hcl, nh3 (mol/mol)'
1238 write(luntmp,44)rsub(kh2so4,k,m), rsub(khno3,k,m), &
1239 rsub(khcl,k,m), rsub(knh3,k,m)
1240
1241
1242 iphase = ai_phase
1243 ibin = 0
1244 do itype = 1, ntype_aer
1245 do isize = 1, nsize_aer(itype)
1246 ibin = ibin + 1
1247
1248 write(luntmp,44) rsub(lptr_so4_aer(ibin,itype,iphase),k,m), &
1249 rsub(lptr_no3_aer(ibin,itype,iphase),k,m), &
1250 rsub(lptr_cl_aer(ibin,itype,iphase),k,m), &
1251 rsub(lptr_nh4_aer(ibin,itype,iphase),k,m), &
1252 rsub(lptr_oc_aer(ibin,itype,iphase),k,m), & ! ng/m^3(air)
1253 rsub(lptr_co3_aer(ibin,itype,iphase),k,m), &
1254 rsub(lptr_msa_aer(ibin,itype,iphase),k,m), &
1255 rsub(lptr_bc_aer(ibin,itype,iphase),k,m), & ! ng/m^3(air)
1256 rsub(lptr_na_aer(ibin,itype,iphase),k,m), &
1257 rsub(lptr_ca_aer(ibin,itype,iphase),k,m), &
1258 rsub(lptr_oin_aer(ibin,itype,iphase),k,m), &
1259 rsub(hyswptr_aer(ibin,itype),k,m), &
1260 rsub(waterptr_aer(ibin,itype),k,m), &
1261 rsub(numptr_aer(ibin,itype,iphase),k,m)
1262 enddo
1263 enddo
1264
1265 write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1266
1267 2900 continue
1268
1269
1270 44 format(14e20.10)
1271
1272 !c stop
1273
1274 return
1275 end subroutine print_input
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294 !***********************************************************************
1295 ! checks if aerosol mass is too low to be of any significance
1296 ! and determine jaerosolstate
1297 !
1298 ! author: rahul a. zaveri
1299 ! update: jan 2005
1300 !-----------------------------------------------------------------------
1301 subroutine check_aerosol_mass(ibin)
1302 ! implicit none
1303 ! include 'mosaic.h'
1304 ! subr arguments
1305 integer ibin
1306 ! local variables
1307 integer iaer
1308 real(kind=8) drymass, aer_H
1309
1310 mass_dry_a(ibin) = 0.0
1311
1312 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1313 aer(ino3_a,jtotal,ibin) + &
1314 aer(icl_a,jtotal,ibin) + &
1315 aer(imsa_a,jtotal,ibin) + &
1316 2.*aer(ico3_a,jtotal,ibin))- &
1317 (2.*aer(ica_a,jtotal,ibin) + &
1318 aer(ina_a,jtotal,ibin) + &
1319 aer(inh4_a,jtotal,ibin))
1320
1321
1322 do iaer = 1, naer
1323 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1324 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
1325 enddo
1326 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1327
1328 drymass = mass_dry_a(ibin) ! ng/m^3(air)
1329 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
1330
1331 if(drymass .lt. mass_cutoff)then ! bin mass is too small
1332 jaerosolstate(ibin) = no_aerosol
1333 jphase(ibin) = 0
1334 if(drymass .eq. 0.)num_a(ibin) = 0.0
1335 endif
1336
1337 return
1338 end subroutine check_aerosol_mass
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350 !***********************************************************************
1351 ! checks and conforms number according to the mass and bin size range
1352 !
1353 ! author: rahul a. zaveri
1354 ! update: jan 2005
1355 !-----------------------------------------------------------------------
1356 subroutine conform_aerosol_number(ibin)
1357
1358 use module_data_mosaic_asect
1359
1360 ! implicit none
1361 ! include 'v33com'
1362 ! include 'v33com3'
1363 ! include 'v33com9a'
1364 ! include 'mosaic.h'
1365 ! subr arguments
1366 integer ibin
1367 ! local variables
1368 integer je, l, iaer, isize, itype
1369 real(kind=8) num_at_dlo, num_at_dhi, numold
1370 real(kind=8) aer_H
1371
1372 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
1373
1374 if(jaerosolstate(ibin) .eq. no_aerosol) return
1375
1376 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1377 aer(ino3_a,jtotal,ibin) + &
1378 aer(icl_a,jtotal,ibin) + &
1379 aer(imsa_a,jtotal,ibin) + &
1380 2.*aer(ico3_a,jtotal,ibin))- &
1381 (2.*aer(ica_a,jtotal,ibin) + &
1382 aer(ina_a,jtotal,ibin) + &
1383 aer(inh4_a,jtotal,ibin))
1384
1385 do iaer = 1, naer
1386 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1387 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ng/m^3(air)
1388 enddo
1389 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1390
1391 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air)
1392
1393 ! conform number
1394 call isize_itype_from_ibin( ibin, isize, itype )
1395 num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
1396 num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
1397
1398 numold = num_a(ibin)
1399 num_a(ibin) = min(num_a(ibin), num_at_dlo) ! #/cc(air)
1400 num_a(ibin) = max(num_a(ibin), num_at_dhi) ! #/cc(air)
1401
1402 ! if (numold .ne. num_a(ibin)) then
1403 ! write(*,*) 'conform number - i, vol, mass, numold/new', ibin,
1404 ! & vol_dry_a(ibin), mass_dry_temp, numold, num_a(ibin)
1405 ! write(*,*) 'conform i,j,k', iclm_aer, jclm_aer, kclm_aer
1406 ! if (nsubareas .gt. 0) then
1407 ! write(*,'(a,1pe14.4)') (name(l), rsub(l,kclm_aer,1), l=1,ltot2)
1408 ! else
1409 ! write(*,'(a,1pe14.4)') (name(l), rclm(kclm_aer,l), l=1,ltot2)
1410 ! end if
1411 ! stop
1412 ! end if
1413
1414 return
1415 end subroutine conform_aerosol_number
1416
1417
1418
1419
1420
1421 !***********************************************************************
1422 ! determines phase state of an aerosol bin. includes kelvin effect.
1423 !
1424 ! author: rahul a. zaveri
1425 ! update: jan 2005
1426 !-----------------------------------------------------------------------
1427 subroutine aerosol_phase_state(ibin)
1428 ! implicit none
1429 ! include 'mosaic.h'
1430 ! subr arguments
1431 integer ibin
1432 ! local variables
1433 integer js, je, iaer, iv, iter_kelvin
1434 real(kind=8) ah2o_a_new, rel_err
1435 ! real(kind=8) aerosol_water_up, bin_molality ! mosaic func
1436 real(kind=8) kelvin_toler, term
1437 real(kind=8) aer_H
1438
1439
1440 ah2o = rh_pc*0.01
1441 ah2o_a(ibin) = ah2o
1442 kelvin(ibin) = 1.0
1443 do iv = 1, ngas_volatile
1444 kel(iv,ibin) = 1.0
1445 enddo
1446
1447 if(rh_pc .le. 99)then
1448 kelvin_toler = 1.e-2
1449 else
1450 kelvin_toler = 1.e-6
1451 endif
1452
1453 ! calculate dry mass and dry volume of a bin
1454 mass_dry_a(ibin) = 0.0 ! initialize to 0.0
1455 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
1456
1457 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1458 aer(ino3_a,jtotal,ibin) + &
1459 aer(icl_a,jtotal,ibin) + &
1460 aer(imsa_a,jtotal,ibin) + &
1461 2.*aer(ico3_a,jtotal,ibin))- &
1462 (2.*aer(ica_a,jtotal,ibin) + &
1463 aer(ina_a,jtotal,ibin) + &
1464 aer(inh4_a,jtotal,ibin))
1465
1466 do iaer = 1, naer
1467 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1468 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
1469 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1470 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
1471 enddo
1472 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1473 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1474
1475 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
1476 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air) or m^3/m^3(air)
1477
1478 ! wet mass and wet volume
1479 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1480 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1481
1482
1483 water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
1484
1485 iter_kelvin = 0
1486
1487 10 iter_kelvin = iter_kelvin + 1
1488 do je = 1, nelectrolyte
1489 molality0(je) = bin_molality(je,ibin) ! compute ah2o dependent binary molalities
1490 enddo
1491
1492 call mesa(ibin)
1493 if(jaerosolstate(ibin) .eq. all_solid)then
1494 return
1495 endif
1496 if (istat_mosaic_fe1 .lt. 0) return
1497
1498 ! new wet mass and wet volume
1499 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1500 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1501
1502 call calculate_kelvin(ibin)
1503
1504 ah2o_a_new = rh_pc*0.01/kelvin(ibin)
1505
1506 rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
1507
1508 if(rel_err .gt. kelvin_toler .and. iter_kelvin.le.20)then
1509 ah2o_a(ibin) = ah2o_a_new
1510 goto 10
1511 endif
1512
1513 if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
1514
1515 ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
1516 do iv = 1, ngas_volatile
1517 term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/ &
1518 (8.3144e7*T_K*DpmV(ibin))
1519 kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1520 enddo
1521
1522
1523 return
1524 end subroutine aerosol_phase_state
1525
1526
1527
1528
1529
1530
1531 !***********************************************************************
1532 ! computes kelvin effect term (kelvin => 1.0)
1533 !
1534 ! author: rahul a. zaveri
1535 ! update: jan 2005
1536 !-----------------------------------------------------------------------
1537 subroutine calculate_kelvin(ibin)
1538 ! implicit none
1539 ! include 'mosaic.h'
1540 ! subr arguments
1541 integer ibin
1542 ! local variables
1543 real(kind=8) term
1544
1545
1546
1547 volume_a(ibin) = vol_wet_a(ibin) ! [cc/cc(air)]
1548 dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.) ! [cm]
1549 sigma_soln(ibin) = sigma_water + 49.0*(1. - ah2o_a(ibin)) ! [dyn/cm]
1550 term = 72.*sigma_soln(ibin)/(8.3144e7*t_k*dpmv(ibin)) ! [-]
1551 ! kelvin(ibin) = exp(term)
1552 kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1553
1554
1555 return
1556 end subroutine calculate_kelvin
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572 !***********************************************************************
1573 ! mesa: multicomponent equilibrium solver for aerosols.
1574 ! computes equilibrum solid and liquid phases by integrating
1575 ! pseudo-transient dissolution and precipitation reactions
1576 !
1577 ! author: rahul a. zaveri
1578 ! update: jan 2005
1579 !-----------------------------------------------------------------------
1580 subroutine mesa(ibin) ! touch
1581 ! implicit none
1582 ! include 'mosaic.h'
1583 ! subr arguments
1584 integer ibin
1585
1586 ! local variables
1587 integer idissolved, j_index, jdum, js
1588 real(kind=8) crh, solids, sum_soluble, sum_insoluble, xt
1589 ! real(kind=8) aerosol_water ! mosaic func
1590 ! real(kind=8) drh_mutual ! mosaic func
1591 real(kind=8) h_ion
1592
1593
1594 call calculate_xt(ibin,jtotal,xt)
1595
1596 crh = 0.1
1597
1598 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
1599 if(ah2o_a(ibin).lt.crh .and. (xt.gt.1.0 .or. xt.lt.0.))then
1600 jaerosolstate(ibin) = all_solid
1601 jphase(ibin) = jsolid
1602 jhyst_leg(ibin) = jhyst_lo
1603 call adjust_solid_aerosol(ibin)
1604 return
1605 endif
1606
1607
1608 ! step 2: check for supersaturation/metastable state
1609 if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin))then
1610
1611 call do_full_deliquescence(ibin)
1612
1613 sum_soluble = 0.0
1614 do js = 1, nsoluble
1615 sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
1616 enddo
1617
1618 solids = electrolyte(jcaso4,jtotal,ibin) + &
1619 electrolyte(jcaco3,jtotal,ibin) + &
1620 aer(ioin_a ,jtotal,ibin)
1621
1622
1623 if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
1624
1625 jaerosolstate(ibin) = all_solid ! no soluble material present
1626 jphase(ibin) = jsolid
1627 call adjust_solid_aerosol(ibin)
1628
1629 ! new wet mass and wet volume
1630 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1631 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1632 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1633
1634 return
1635
1636 elseif(sum_soluble .gt. 0.0 .and. solids .eq. 0.0)then
1637
1638 jaerosolstate(ibin) = all_liquid
1639 jhyst_leg(ibin) = jhyst_up
1640 jphase(ibin) = jliquid
1641 water_a(ibin) = aerosol_water(jtotal,ibin)
1642
1643 if(water_a(ibin) .lt. 0.0)then
1644 jaerosolstate(ibin) = all_solid ! no soluble material present
1645 jphase(ibin) = jsolid
1646 jhyst_leg(ibin) = jhyst_lo
1647 call adjust_solid_aerosol(ibin)
1648 else
1649 call adjust_liquid_aerosol(ibin)
1650 call compute_activities(ibin)
1651 endif
1652
1653 ! new wet mass and wet volume
1654 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1655 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1656 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1657
1658 return
1659
1660 endif
1661
1662 endif
1663
1664
1665
1666
1667 ! step 3: diagnose mdrh
1668 if(xt .lt. 1. .and. xt .gt. 0. )goto 10 ! excess sulfate domain - no mdrh exists
1669
1670 jdum = 0
1671 do js = 1, nsalt
1672 jsalt_present(js) = 0 ! default value - salt absent
1673
1674 if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
1675 jsalt_present(js) = 1 ! salt present
1676 jdum = jdum + jsalt_index(js)
1677 endif
1678 enddo
1679
1680 if(jdum .eq. 0)then
1681 jaerosolstate(ibin) = all_solid ! no significant soluble material present
1682 jphase(ibin) = jsolid
1683 call adjust_solid_aerosol(ibin)
1684 return
1685 endif
1686
1687 if(xt .ge. 2.0 .or. xt .lt. 0.0)then
1688 j_index = jsulf_poor(jdum)
1689 else
1690 j_index = jsulf_rich(jdum)
1691 endif
1692
1693 mdrh(ibin) = mdrh_t(j_index)
1694
1695 if(ah2o_a(ibin)*100. .lt. mdrh(ibin)) then
1696 jaerosolstate(ibin) = all_solid
1697 jphase(ibin) = jsolid
1698 jhyst_leg(ibin) = jhyst_lo
1699 call adjust_solid_aerosol(ibin)
1700 return
1701 endif
1702
1703
1704 ! step 4: none of the above means it must be sub-saturated or mixed-phase
1705 10 call do_full_deliquescence(ibin)
1706 call mesa_ptc(ibin) ! determines jaerosolstate(ibin)
1707 if (istat_mosaic_fe1 .lt. 0) return
1708
1709
1710
1711 return
1712 end subroutine mesa
1713
1714
1715
1716
1717
1718
1719
1720
1721 !***********************************************************************
1722 ! this subroutine completely deliquesces an aerosol and partitions
1723 ! all the soluble electrolytes into the liquid phase and insoluble
1724 ! ones into the solid phase. it also calculates the corresponding
1725 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
1726 ! concentrations
1727 !
1728 ! author: rahul a. zaveri
1729 ! update: jan 2005
1730 !-----------------------------------------------------------------------
1731 subroutine do_full_deliquescence(ibin) ! touch
1732 ! implicit none
1733 ! include 'mosaic.h'
1734 ! subr arguments
1735 integer ibin
1736 ! local variables
1737 integer js
1738
1739
1740
1741
1742 ! partition all electrolytes into liquid phase
1743 do js = 1, nelectrolyte
1744 electrolyte(js,jsolid,ibin) = 0.0
1745 electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
1746 enddo
1747 !
1748 ! except these electrolytes, which always remain in the solid phase
1749 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1750 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1751 electrolyte(jcaco3,jliquid,ibin)= 0.0
1752 electrolyte(jcaso4,jliquid,ibin)= 0.0
1753
1754
1755 ! partition all the generic aer species into solid and liquid phases
1756 ! solid phase
1757 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1758 aer(ino3_a,jsolid,ibin) = 0.0
1759 aer(icl_a, jsolid,ibin) = 0.0
1760 aer(inh4_a,jsolid,ibin) = 0.0
1761 aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1762 aer(imsa_a,jsolid,ibin) = 0.0
1763 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1764 aer(ina_a, jsolid,ibin) = 0.0
1765 aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
1766 electrolyte(jcaso4,jsolid,ibin)
1767 aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1768 aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
1769 aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
1770 aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
1771 aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
1772 aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
1773 aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
1774 aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
1775 aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
1776 aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
1777
1778 ! liquid-phase
1779 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
1780 electrolyte(jcaso4,jsolid,ibin)
1781 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1782 aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1783 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1784 aer(ioc_a, jliquid,ibin) = 0.0
1785 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1786 aer(ico3_a,jliquid,ibin) = 0.0
1787 aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1788 aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) + &
1789 electrolyte(jcacl2,jtotal,ibin)
1790 aer(ibc_a, jliquid,ibin) = 0.0
1791 aer(ioin_a,jliquid,ibin) = 0.0
1792 aer(iaro1_a,jliquid,ibin)= 0.0
1793 aer(iaro2_a,jliquid,ibin)= 0.0
1794 aer(ialk1_a,jliquid,ibin)= 0.0
1795 aer(iole1_a,jliquid,ibin)= 0.0
1796 aer(iapi1_a,jliquid,ibin)= 0.0
1797 aer(iapi2_a,jliquid,ibin)= 0.0
1798 aer(ilim1_a,jliquid,ibin)= 0.0
1799 aer(ilim2_a,jliquid,ibin)= 0.0
1800
1801 return
1802 end subroutine do_full_deliquescence
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825 !***********************************************************************
1826 ! mesa: multicomponent equilibrium solver for aerosol-phase
1827 ! computes equilibrum solid and liquid phases by integrating
1828 ! pseudo-transient dissolution and precipitation reactions
1829 !
1830 ! author: rahul a. zaveri
1831 ! update: jan 2005
1832 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
1833 !-----------------------------------------------------------------------
1834 subroutine mesa_ptc(ibin) ! touch
1835 ! implicit none
1836 ! include 'mosaic.h'
1837 ! subr arguments
1838 integer ibin
1839 ! local variables
1840 integer iaer, iconverge, iconverge_flux, iconverge_mass, &
1841 idissolved, itdum, js, je, jp
1842 real(kind=8) tau_p(nsalt), tau_d(nsalt)
1843 real(kind=8) frac_solid, sumflux, hsalt_min, alpha, xt, dumdum, &
1844 h_ion
1845 real(kind=8) phi_prod, alpha_fac, sum_dum
1846 real(kind=8) aer_H
1847 ! function
1848 ! real(kind=8) aerosol_water
1849
1850
1851
1852 ! initialize
1853 itdum = 0 ! initialize time
1854 hsalt_max = 1.e25
1855
1856
1857
1858 do js = 1, nsalt
1859 hsalt(js) = 0.0
1860 sat_ratio(js) = 0.0
1861 phi_salt(js) = 0.0
1862 flux_sl(js) = 0.0
1863 enddo
1864
1865
1866 do js = 1, nsalt
1867 jsalt_present(js) = 0 ! default value - salt absent
1868 if(epercent(js,jtotal,ibin) .gt. 1.0)then
1869 jsalt_present(js) = 1 ! salt present
1870 endif
1871 enddo
1872
1873
1874 mass_dry_a(ibin) = 0.0
1875
1876 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1877 aer(ino3_a,jtotal,ibin) + &
1878 aer(icl_a,jtotal,ibin) + &
1879 aer(imsa_a,jtotal,ibin) + &
1880 2.*aer(ico3_a,jtotal,ibin))- &
1881 (2.*aer(ica_a,jtotal,ibin) + &
1882 aer(ina_a,jtotal,ibin) + &
1883 aer(inh4_a,jtotal,ibin))
1884
1885 do iaer = 1, naer
1886 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1887 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! [ng/m^3(air)]
1888 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1889 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
1890 enddo
1891 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1892 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1893
1894 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! [g/cc(air)]
1895 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! [cc(aer)/cc(air)]
1896
1897 mass_dry_salt(ibin) = 0.0 ! soluble salts only
1898 do je = 1, nsalt
1899 mass_dry_salt(ibin) = mass_dry_salt(ibin) + &
1900 electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15 ! g/cc(air)
1901 enddo
1902
1903 ! call mesa_check_complete_dissolution(ibin, &
1904 ! mdissolved, &
1905 ! iconverge_flux)
1906 ! if (istat_mosaic_fe1 .lt. 0) return
1907 ! if(mdissolved .eq. myes .or. iconverge_flux .eq. myes)then
1908 ! return
1909 ! endif
1910
1911
1912 nmesa_call = nmesa_call + 1
1913
1914 !----begin pseudo time continuation loop-------------------------------
1915
1916 do 500 itdum = 1, nmax_mesa
1917
1918
1919 ! compute new salt fluxes
1920 call mesa_flux_salt(ibin)
1921 if (istat_mosaic_fe1 .lt. 0) return
1922
1923
1924 ! check convergence
1925 call mesa_convergence_criterion(ibin, &
1926 iconverge_mass, &
1927 iconverge_flux, &
1928 idissolved)
1929
1930 if(iconverge_mass .eq. myes)then
1931 iter_mesa(ibin) = iter_mesa(ibin) + itdum
1932 niter_mesa = niter_mesa + itdum
1933 niter_mesa_max = max(niter_mesa_max, itdum)
1934 jaerosolstate(ibin) = all_solid
1935 call adjust_solid_aerosol(ibin)
1936 jhyst_leg(ibin) = jhyst_lo
1937 growth_factor(ibin) = 1.0
1938 return
1939 elseif(iconverge_flux .eq. myes)then
1940 iter_mesa(ibin) = iter_mesa(ibin)+ itdum
1941 niter_mesa = niter_mesa + itdum
1942 niter_mesa_max = max(niter_mesa_max, itdum)
1943 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1944 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1945 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1946
1947 if(idissolved .eq. myes)then
1948 jaerosolstate(ibin) = all_liquid
1949 ! jhyst_leg(ibin) = jhyst_up ! do this later (to avoid tripping kelvin iterations)
1950 else
1951 jaerosolstate(ibin) = mixed
1952 jhyst_leg(ibin) = jhyst_lo
1953 endif
1954
1955 ! calculate epercent(jsolid) composition in mixed-phase aerosol
1956 sum_dum = 0.0
1957 jp = jsolid
1958 do je = 1, nelectrolyte
1959 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
1960 sum_dum = sum_dum + electrolyte(je,jp,ibin)
1961 enddo
1962 electrolyte_sum(jp,ibin) = sum_dum
1963 if(sum_dum .eq. 0.)sum_dum = 1.0
1964 do je = 1, nelectrolyte
1965 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
1966 enddo
1967
1968 return
1969 endif
1970
1971
1972 ! calculate hsalt(js) ! time step
1973 hsalt_min = 1.e25
1974 do js = 1, nsalt
1975
1976 phi_prod = phi_salt(js) * phi_salt_old(js)
1977
1978 if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
1979 phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/ &
1980 alpha_salt(js)
1981 else
1982 phi_bar(js) = 0.0 ! oscillating, or phi_salt and/or phi_salt_old may be zero
1983 endif
1984
1985 if(phi_bar(js) .lt. 0.0)then ! good. phi getting lower. maybe able to take bigger alphas
1986 phi_bar(js) = max(phi_bar(js), -10.0D0)
1987 alpha_fac = 3.0*exp(phi_bar(js))
1988 alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9D0)
1989 elseif(phi_bar(js) .gt. 0.0)then ! bad - phi is getting bigger. so be conservative with alpha
1990 alpha_salt(js) = min(abs(phi_salt(js)), 0.5D0)
1991 else ! very bad - phi is oscillating. be very conservative
1992 alpha_salt(js) = min(abs(phi_salt(js))/3.0, 0.5D0)
1993 endif
1994
1995 ! alpha_salt(js) = max(alpha_salt(js), 0.01D0)
1996
1997 phi_salt_old(js) = phi_salt(js) ! update old array
1998
1999
2000 if(flux_sl(js) .gt. 0.)then
2001
2002 tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
2003 if(tau_p(js) .eq. 0.0)then
2004 hsalt(js) = 1.e25
2005 flux_sl(js) = 0.0
2006 phi_salt(js)= 0.0
2007 else
2008 hsalt(js) = alpha_salt(js)*tau_p(js)
2009 endif
2010
2011 elseif(flux_sl(js) .lt. 0.)then
2012
2013 tau_p(js) = -eleliquid(js)/flux_sl(js) ! precipitation time scale
2014 tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
2015 if(tau_p(js) .eq. 0.0)then
2016 hsalt(js) = alpha_salt(js)*tau_d(js)
2017 else
2018 hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
2019 endif
2020
2021 else
2022
2023 hsalt(js) = 1.e25
2024
2025 endif
2026
2027 hsalt_min = min(hsalt(js), hsalt_min)
2028
2029 enddo
2030
2031 !---------------------------------
2032
2033 ! integrate electrolyte(solid)
2034 do js = 1, nsalt
2035 electrolyte(js,jsolid,ibin) = &
2036 electrolyte(js,jsolid,ibin) + &
2037 hsalt(js) * flux_sl(js)
2038 enddo
2039
2040
2041 ! compute aer(solid) from electrolyte(solid)
2042 call electrolytes_to_ions(jsolid,ibin)
2043
2044
2045 ! compute new electrolyte(liquid) from mass balance
2046 do iaer = 1, naer
2047 aer(iaer,jliquid,ibin) = aer(iaer,jtotal,ibin) - &
2048 aer(iaer,jsolid,ibin)
2049 enddo
2050
2051 !---------------------------------
2052
2053
2054
2055 500 continue ! end time continuation loop
2056 !--------------------------------------------------------------------
2057 nmesa_fail = nmesa_fail + 1
2058 iter_mesa(ibin) = iter_mesa(ibin) + itdum
2059 niter_mesa = niter_mesa + itdum
2060 jaerosolstate(ibin) = mixed
2061 jhyst_leg(ibin) = jhyst_lo
2062 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2063 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2064 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2065
2066 return
2067 end subroutine mesa_ptc
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078 !***********************************************************************
2079 ! part of mesa: checks if particle is completely deliquesced at the
2080 ! current rh
2081 !
2082 ! author: rahul a. zaveri
2083 ! update: feb 2005
2084 !-----------------------------------------------------------------------
2085 subroutine mesa_check_complete_dissolution(ibin, &
2086 mdissolved, &
2087 iconverge_flux)
2088 ! implicit none
2089 ! include 'mosaic.h'
2090 ! subr arguments
2091 integer ibin, mdissolved, iconverge_flux, je, js, iaer
2092 ! local variables
2093 real(kind=8) sumflux, aer_sav(naer,3,nbin_a), &
2094 electrolyte_sav(nelectrolyte,3,nbin_a), crustal_solids
2095
2096
2097 ! save current solid-liquid arrays
2098 do je = 1, nelectrolyte
2099 electrolyte_sav(je,jsolid,ibin) =electrolyte(je,jsolid,ibin)
2100 electrolyte_sav(je,jliquid,ibin)=electrolyte(je,jliquid,ibin)
2101 enddo
2102
2103 do iaer = 1, naer
2104 aer_sav(iaer,jsolid,ibin) =aer(iaer,jsolid,ibin)
2105 aer_sav(iaer,jliquid,ibin)=aer(iaer,jliquid,ibin)
2106 enddo
2107
2108 call do_full_deliquescence(ibin)
2109
2110 do js = 1, nsalt
2111 sat_ratio(js) = 0.0
2112 phi_salt(js) = 0.0
2113 flux_sl(js) = 0.0
2114 enddo
2115
2116
2117 ! compute new salt fluxes
2118 call mesa_flux_salt(ibin)
2119 if (istat_mosaic_fe1 .lt. 0) return
2120
2121
2122 ! check if all the fluxes are zero
2123 sumflux = 0.0
2124 do js = 1, nsalt
2125 sumflux = sumflux + abs(flux_sl(js))
2126 enddo
2127
2128 crustal_solids = electrolyte(jcaco3,jsolid,ibin) + &
2129 electrolyte(jcaso4,jsolid,ibin) + &
2130 aer(ioin_a,jsolid,ibin)
2131 if(sumflux .eq. 0.0 .and. crustal_solids.eq.0.)then ! it is completely dissolved
2132
2133 jaerosolstate(ibin) = all_liquid
2134 jphase(ibin) = jliquid
2135 mdissolved = myes
2136 iconverge_flux = myes
2137
2138 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2139 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2140 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2141
2142 elseif(sumflux .eq. 0.0)then
2143
2144 jaerosolstate(ibin) = mixed
2145 jphase(ibin) = jliquid
2146 iconverge_flux = myes
2147 mdissolved = mno
2148 jhyst_leg(ibin) = jhyst_lo
2149 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2150 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2151 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2152
2153 else ! restore saved solid-liquid arrays
2154
2155 do je = 1, nelectrolyte
2156 electrolyte(je,jsolid,ibin) =electrolyte_sav(je,jsolid,ibin)
2157 electrolyte(je,jliquid,ibin)=electrolyte_sav(je,jliquid,ibin)
2158 enddo
2159 do iaer = 1, naer
2160 aer(iaer,jsolid,ibin) =aer_sav(iaer,jsolid,ibin)
2161 aer(iaer,jliquid,ibin)=aer_sav(iaer,jliquid,ibin)
2162 enddo
2163 mdissolved = mno
2164 iconverge_flux = mno
2165
2166 endif
2167
2168
2169 return
2170 end subroutine mesa_check_complete_dissolution
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186 !***********************************************************************
2187 ! part of mesa: calculates solid-liquid fluxes of soluble salts
2188 !
2189 ! author: rahul a. zaveri
2190 ! update: jan 2005
2191 !-----------------------------------------------------------------------
2192 subroutine mesa_flux_salt(ibin) ! touch
2193 ! implicit none
2194 ! include 'mosaic.h'
2195 ! subr arguments
2196 integer ibin
2197 ! local variables
2198 integer js
2199 real(kind=8) xt, calcium, sum_salt
2200
2201
2202 ! compute activities and water content
2203 call ions_to_electrolytes(jliquid,ibin,xt)
2204 if (istat_mosaic_fe1 .lt. 0) return
2205 call compute_activities(ibin)
2206 activity(jna3hso4,ibin) = 0.0
2207
2208 if(water_a(ibin) .le. 0.0)then
2209 do js = 1, nsalt
2210 flux_sl(js) = 0.0
2211 enddo
2212 return
2213 endif
2214
2215
2216 call mesa_estimate_eleliquid(ibin,xt)
2217
2218 calcium = aer(ica_a,jliquid,ibin)
2219
2220
2221 ! calculate % electrolyte composition in the solid and liquid phases
2222 sum_salt = 0.0
2223 do js = 1, nsalt
2224 sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
2225 enddo
2226 electrolyte_sum(jsolid,ibin) = sum_salt
2227 if(sum_salt .eq. 0.0)sum_salt = 1.0
2228 do js = 1, nsalt
2229 frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
2230 frac_salt_liq(js) = epercent(js,jliquid,ibin)/100.
2231 enddo
2232
2233
2234
2235 ! compute salt fluxes
2236 do js = 1, nsalt ! soluble solid salts
2237
2238 ! compute new saturation ratio
2239 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2240 ! compute relative driving force
2241 phi_salt(js) = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0D0)
2242
2243 ! check if too little solid-phase salt is trying to dissolve
2244 if(sat_ratio(js) .lt. 1.00 .and. &
2245 frac_salt_solid(js) .lt. 0.01 .and. &
2246 frac_salt_solid(js) .gt. 0.0)then
2247 call mesa_dissolve_small_salt(ibin,js)
2248 call mesa_estimate_eleliquid(ibin,xt)
2249 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2250 endif
2251
2252 ! compute flux
2253 flux_sl(js) = sat_ratio(js) - 1.0
2254
2255 ! apply heaviside function
2256 if( (sat_ratio(js) .lt. 1.0 .and. &
2257 electrolyte(js,jsolid,ibin) .eq. 0.0) .or. &
2258 (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or. &
2259 (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
2260 flux_sl(js) = 0.0
2261 phi_salt(js)= 0.0
2262 endif
2263
2264 enddo
2265
2266
2267 ! force cacl2 and cano3 fluxes to zero
2268 sat_ratio(jcano3) = 1.0
2269 phi_salt(jcano3) = 0.0
2270 flux_sl(jcano3) = 0.0
2271
2272 sat_ratio(jcacl2) = 1.0
2273 phi_salt(jcacl2) = 0.0
2274 flux_sl(jcacl2) = 0.0
2275
2276
2277 return
2278 end subroutine mesa_flux_salt
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291 !***********************************************************************
2292 ! part of mesa: calculates liquid electrolytes from ions
2293 !
2294 ! notes:
2295 ! - this subroutine is to be used for liquid-phase or total-phase only
2296 ! - this sub transfers caso4 and caco3 from liquid to solid phase
2297 !
2298 ! author: rahul a. zaveri
2299 ! update: jan 2005
2300 !-----------------------------------------------------------------------
2301 subroutine mesa_estimate_eleliquid(ibin,xt) ! touch
2302 ! implicit none
2303 ! include 'mosaic.h'
2304 ! subr arguments
2305 integer ibin, jp
2306 real(kind=8) xt
2307 ! local variables
2308 integer iaer, je, jc, ja, icase
2309 real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4, &
2310 f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d, &
2311 xdum, dum, cat_net
2312 real(kind=8) nc(ncation), na(nanion)
2313 real(kind=8) dum_ca, dum_no3, dum_cl, cano3, cacl2
2314
2315
2316
2317 ! remove negative concentrations, if any
2318 do iaer = 1, naer
2319 aer(iaer,jliquid,ibin) = max(0.0D0, aer(iaer,jliquid,ibin))
2320 enddo
2321
2322
2323 ! calculate sulfate ratio
2324 call calculate_xt(ibin,jliquid,xt)
2325
2326 if(xt .ge. 2.0 .or. xt.lt.0.)then
2327 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
2328 else
2329 icase = 2 ! acidic (acidity is caused by excess so4)
2330 endif
2331
2332
2333 ! initialize to zero
2334 do je = 1, nelectrolyte
2335 eleliquid(je) = 0.0
2336 enddo
2337 !
2338 !---------------------------------------------------------
2339 ! initialize moles of ions depending on the sulfate domain
2340
2341 jp = jliquid
2342
2343 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
2344
2345 dum_ca = aer(ica_a,jp,ibin)
2346 dum_no3 = aer(ino3_a,jp,ibin)
2347 dum_cl = aer(icl_a,jp,ibin)
2348
2349 cano3 = min(dum_ca, 0.5*dum_no3)
2350 dum_ca = max(0.D0, dum_ca - cano3)
2351 dum_no3 = max(0.D0, dum_no3 - 2.*cano3)
2352
2353 cacl2 = min(dum_ca, 0.5*dum_cl)
2354 dum_ca = max(0.D0, dum_ca - cacl2)
2355 dum_cl = max(0.D0, dum_cl - 2.*cacl2)
2356
2357 na(ja_hso4)= 0.0
2358 na(ja_so4) = aer(iso4_a,jp,ibin)
2359 na(ja_no3) = aer(ino3_a,jp,ibin)
2360 na(ja_cl) = aer(icl_a, jp,ibin)
2361 na(ja_msa) = aer(imsa_a,jp,ibin)
2362
2363 nc(jc_ca) = aer(ica_a, jp,ibin)
2364 nc(jc_na) = aer(ina_a, jp,ibin)
2365 nc(jc_nh4) = aer(inh4_a,jp,ibin)
2366
2367 cat_net = &
2368 ( 2.d0*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) ) - &
2369 ( nc(jc_h)+2.d0*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
2370
2371 if(cat_net .lt. 0.0)then
2372
2373 nc(jc_h) = 0.0
2374
2375 else ! cat_net must be 0.0 or positive
2376
2377 nc(jc_h) = cat_net
2378
2379 endif
2380
2381
2382 ! now compute equivalent fractions
2383 sum_naza = 0.0
2384 do ja = 1, nanion
2385 sum_naza = sum_naza + na(ja)*za(ja)
2386 enddo
2387
2388 sum_nczc = 0.0
2389 do jc = 1, ncation
2390 sum_nczc = sum_nczc + nc(jc)*zc(jc)
2391 enddo
2392
2393 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
2394 if (iprint_mosaic_diag1 .gt. 0) then
2395 write(6,*)'subroutine mesa_estimate_eleliquid'
2396 write(6,*)'ionic concentrations are zero'
2397 write(6,*)'sum_naza = ', sum_naza
2398 write(6,*)'sum_nczc = ', sum_nczc
2399 endif
2400 return
2401 endif
2402
2403 do ja = 1, nanion
2404 xeq_a(ja) = na(ja)*za(ja)/sum_naza
2405 enddo
2406
2407 do jc = 1, ncation
2408 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2409 enddo
2410
2411 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
2412 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
2413 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
2414 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
2415 na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
2416
2417 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
2418 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
2419 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
2420 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
2421
2422
2423 ! now compute electrolyte moles
2424 eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) + &
2425 xeq_a(ja_so4)*nc_mc(jc_na))/ &
2426 mw_electrolyte(jna2so4)
2427
2428 eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) + &
2429 xeq_a(ja_hso4)*nc_mc(jc_na))/ &
2430 mw_electrolyte(jnahso4)
2431
2432 eleliquid(jnamsa) = (xeq_c(jc_na) *na_ma(ja_msa) + &
2433 xeq_a(ja_msa)*nc_mc(jc_na))/ &
2434 mw_electrolyte(jnamsa)
2435
2436 eleliquid(jnano3) = (xeq_c(jc_na) *na_ma(ja_no3) + &
2437 xeq_a(ja_no3)*nc_mc(jc_na))/ &
2438 mw_electrolyte(jnano3)
2439
2440 eleliquid(jnacl) = (xeq_c(jc_na) *na_ma(ja_cl) + &
2441 xeq_a(ja_cl) *nc_mc(jc_na))/ &
2442 mw_electrolyte(jnacl)
2443
2444 eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
2445 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
2446 mw_electrolyte(jnh4so4)
2447
2448 eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) + &
2449 xeq_a(ja_hso4)*nc_mc(jc_nh4))/ &
2450 mw_electrolyte(jnh4hso4)
2451
2452 eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_ma(ja_msa) + &
2453 xeq_a(ja_msa)*nc_mc(jc_nh4))/ &
2454 mw_electrolyte(jnh4msa)
2455
2456 eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
2457 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
2458 mw_electrolyte(jnh4no3)
2459
2460 eleliquid(jnh4cl) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
2461 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
2462 mw_electrolyte(jnh4cl)
2463
2464 eleliquid(jcano3) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
2465 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
2466 mw_electrolyte(jcano3)
2467
2468 eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_ma(ja_msa) + &
2469 xeq_a(ja_msa)*nc_mc(jc_ca))/ &
2470 mw_electrolyte(jcamsa2)
2471
2472 eleliquid(jcacl2) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
2473 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
2474 mw_electrolyte(jcacl2)
2475
2476 eleliquid(jh2so4) = (xeq_c(jc_h) *na_ma(ja_hso4) + &
2477 xeq_a(ja_hso4)*nc_mc(jc_h))/ &
2478 mw_electrolyte(jh2so4)
2479
2480 eleliquid(jhno3) = (xeq_c(jc_h) *na_ma(ja_no3) + &
2481 xeq_a(ja_no3)*nc_mc(jc_h))/ &
2482 mw_electrolyte(jhno3)
2483
2484 eleliquid(jhcl) = (xeq_c(jc_h) *na_ma(ja_cl) + &
2485 xeq_a(ja_cl)*nc_mc(jc_h))/ &
2486 mw_electrolyte(jhcl)
2487
2488 eleliquid(jmsa) = (xeq_c(jc_h) *na_ma(ja_msa) + &
2489 xeq_a(ja_msa)*nc_mc(jc_h))/ &
2490 mw_electrolyte(jmsa)
2491
2492 !--------------------------------------------------------------------
2493
2494 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
2495
2496 jp = jliquid
2497
2498 store(iso4_a) = aer(iso4_a,jp,ibin)
2499 store(imsa_a) = aer(imsa_a,jp,ibin)
2500 store(inh4_a) = aer(inh4_a,jp,ibin)
2501 store(ina_a) = aer(ina_a, jp,ibin)
2502 store(ica_a) = aer(ica_a, jp,ibin)
2503
2504 call form_camsa2(store,jp,ibin)
2505
2506 sum_na_nh4 = store(ina_a) + store(inh4_a)
2507 if(sum_na_nh4 .gt. 0.0)then
2508 f_nh4 = store(inh4_a)/sum_na_nh4
2509 f_na = store(ina_a)/sum_na_nh4
2510 else
2511 f_nh4 = 0.0
2512 f_na = 0.0
2513 endif
2514
2515 ! first form msa electrolytes
2516 if(sum_na_nh4 .gt. store(imsa_a))then
2517 eleliquid(jnh4msa) = f_nh4*store(imsa_a)
2518 eleliquid(jnamsa) = f_na *store(imsa_a)
2519 store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
2520 store(ina_a) = store(ina_a) -eleliquid(jnamsa) ! remaining na
2521 else
2522 eleliquid(jnh4msa) = store(inh4_a)
2523 eleliquid(jnamsa) = store(ina_a)
2524 eleliquid(jmsa) = store(imsa_a) - sum_na_nh4
2525 store(inh4_a)= 0.0 ! remaining nh4
2526 store(ina_a) = 0.0 ! remaining na
2527 endif
2528
2529 if(store(iso4_a).eq.0.0)goto 10
2530
2531 xt_d = xt
2532 xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
2533 xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
2534
2535 dum = 2.d0*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin)
2536 if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
2537 xnh4_d = 2.*aer(inh4_a,jp,ibin)/ &
2538 (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
2539 else
2540 xnh4_d = 0.0
2541 endif
2542
2543
2544 if(aer(inh4_a,jp,ibin) .gt. 0.0)then
2545
2546
2547 if(xt_d .ge. xna_d)then
2548 eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
2549
2550 if(xnh4_d .ge. 5./3.)then
2551 eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin) &
2552 - 3.*xdum - aer(inh4_a,jp,ibin)
2553 eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin) &
2554 - aer(ina_a,jp,ibin)
2555 elseif(xnh4_d .ge. 1.5)then
2556 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
2557 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
2558 elseif(xnh4_d .ge. 1.0)then
2559 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2560 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2561 eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
2562 endif
2563
2564 elseif(xt_d .gt. 1.0)then
2565 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2566 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2567 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
2568 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/3.
2569 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/3.
2570 elseif(xt_d .le. 1.0)then
2571 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2572 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2573 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2574 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
2575 endif
2576
2577 else
2578
2579 if(xt_d .gt. 1.0)then
2580 eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
2581 eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) - &
2582 aer(ina_a,jp,ibin)
2583 else
2584 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2585 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2586 endif
2587
2588
2589 endif
2590
2591
2592
2593 endif
2594 !---------------------------------------------------------
2595 !
2596 ! calculate % composition
2597 10 sum_dum = 0.0
2598 do je = 1, nelectrolyte
2599 sum_dum = sum_dum + eleliquid(je)
2600 enddo
2601
2602 electrolyte_sum(jp,ibin) = sum_dum
2603
2604 if(sum_dum .eq. 0.)sum_dum = 1.0
2605 do je = 1, nelectrolyte
2606 epercent(je,jp,ibin) = 100.*eleliquid(je)/sum_dum
2607 enddo
2608
2609
2610 return
2611 end subroutine mesa_estimate_eleliquid
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622 !***********************************************************************
2623 ! part of mesa: completely dissolves small amounts of soluble salts
2624 !
2625 ! author: rahul a. zaveri
2626 ! update: jan 2005
2627 !-----------------------------------------------------------------------
2628 subroutine mesa_dissolve_small_salt(ibin,js)
2629 ! implicit none
2630 ! include 'mosaic.h'
2631 ! subr arguments
2632 integer ibin, js, jp
2633
2634 jp = jsolid
2635
2636
2637 if(js .eq. jnh4so4)then
2638 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2639 2.*electrolyte(js,jsolid,ibin)
2640 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2641 electrolyte(js,jsolid,ibin)
2642
2643 electrolyte(js,jsolid,ibin) = 0.0
2644
2645 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2646 electrolyte(jnh4cl,jp,ibin) + &
2647 2.*electrolyte(jnh4so4,jp,ibin) + &
2648 3.*electrolyte(jlvcite,jp,ibin) + &
2649 electrolyte(jnh4hso4,jp,ibin)+ &
2650 electrolyte(jnh4msa,jp,ibin)
2651
2652 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2653 electrolyte(jna2so4,jp,ibin) + &
2654 2.*electrolyte(jna3hso4,jp,ibin)+ &
2655 electrolyte(jnahso4,jp,ibin) + &
2656 electrolyte(jnh4so4,jp,ibin) + &
2657 2.*electrolyte(jlvcite,jp,ibin) + &
2658 electrolyte(jnh4hso4,jp,ibin)+ &
2659 electrolyte(jh2so4,jp,ibin)
2660 return
2661 endif
2662
2663
2664 if(js .eq. jlvcite)then
2665 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2666 3.*electrolyte(js,jsolid,ibin)
2667 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2668 2.*electrolyte(js,jsolid,ibin)
2669
2670 electrolyte(js,jsolid,ibin) = 0.0
2671
2672 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2673 electrolyte(jnh4cl,jp,ibin) + &
2674 2.*electrolyte(jnh4so4,jp,ibin) + &
2675 3.*electrolyte(jlvcite,jp,ibin) + &
2676 electrolyte(jnh4hso4,jp,ibin)+ &
2677 electrolyte(jnh4msa,jp,ibin)
2678
2679 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2680 electrolyte(jna2so4,jp,ibin) + &
2681 2.*electrolyte(jna3hso4,jp,ibin)+ &
2682 electrolyte(jnahso4,jp,ibin) + &
2683 electrolyte(jnh4so4,jp,ibin) + &
2684 2.*electrolyte(jlvcite,jp,ibin) + &
2685 electrolyte(jnh4hso4,jp,ibin)+ &
2686 electrolyte(jh2so4,jp,ibin)
2687 return
2688 endif
2689
2690
2691 if(js .eq. jnh4hso4)then
2692 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2693 electrolyte(js,jsolid,ibin)
2694 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2695 electrolyte(js,jsolid,ibin)
2696
2697 electrolyte(js,jsolid,ibin) = 0.0
2698
2699 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2700 electrolyte(jnh4cl,jp,ibin) + &
2701 2.*electrolyte(jnh4so4,jp,ibin) + &
2702 3.*electrolyte(jlvcite,jp,ibin) + &
2703 electrolyte(jnh4hso4,jp,ibin)+ &
2704 electrolyte(jnh4msa,jp,ibin)
2705
2706 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2707 electrolyte(jna2so4,jp,ibin) + &
2708 2.*electrolyte(jna3hso4,jp,ibin)+ &
2709 electrolyte(jnahso4,jp,ibin) + &
2710 electrolyte(jnh4so4,jp,ibin) + &
2711 2.*electrolyte(jlvcite,jp,ibin) + &
2712 electrolyte(jnh4hso4,jp,ibin)+ &
2713 electrolyte(jh2so4,jp,ibin)
2714 return
2715 endif
2716
2717
2718 if(js .eq. jna2so4)then
2719 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2720 2.*electrolyte(js,jsolid,ibin)
2721 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2722 electrolyte(js,jsolid,ibin)
2723
2724 electrolyte(js,jsolid,ibin) = 0.0
2725
2726 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2727 electrolyte(jnacl,jp,ibin) + &
2728 2.*electrolyte(jna2so4,jp,ibin) + &
2729 3.*electrolyte(jna3hso4,jp,ibin)+ &
2730 electrolyte(jnahso4,jp,ibin) + &
2731 electrolyte(jnamsa,jp,ibin)
2732
2733 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2734 electrolyte(jna2so4,jp,ibin) + &
2735 2.*electrolyte(jna3hso4,jp,ibin)+ &
2736 electrolyte(jnahso4,jp,ibin) + &
2737 electrolyte(jnh4so4,jp,ibin) + &
2738 2.*electrolyte(jlvcite,jp,ibin) + &
2739 electrolyte(jnh4hso4,jp,ibin)+ &
2740 electrolyte(jh2so4,jp,ibin)
2741 return
2742 endif
2743
2744
2745 if(js .eq. jna3hso4)then
2746 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2747 3.*electrolyte(js,jsolid,ibin)
2748 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2749 2.*electrolyte(js,jsolid,ibin)
2750
2751 electrolyte(js,jsolid,ibin) = 0.0
2752
2753 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2754 electrolyte(jnacl,jp,ibin) + &
2755 2.*electrolyte(jna2so4,jp,ibin) + &
2756 3.*electrolyte(jna3hso4,jp,ibin)+ &
2757 electrolyte(jnahso4,jp,ibin) + &
2758 electrolyte(jnamsa,jp,ibin)
2759
2760 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2761 electrolyte(jna2so4,jp,ibin) + &
2762 2.*electrolyte(jna3hso4,jp,ibin)+ &
2763 electrolyte(jnahso4,jp,ibin) + &
2764 electrolyte(jnh4so4,jp,ibin) + &
2765 2.*electrolyte(jlvcite,jp,ibin) + &
2766 electrolyte(jnh4hso4,jp,ibin)+ &
2767 electrolyte(jh2so4,jp,ibin)
2768 return
2769 endif
2770
2771
2772 if(js .eq. jnahso4)then
2773 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2774 electrolyte(js,jsolid,ibin)
2775 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2776 electrolyte(js,jsolid,ibin)
2777
2778 electrolyte(js,jsolid,ibin) = 0.0
2779
2780 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2781 electrolyte(jnacl,jp,ibin) + &
2782 2.*electrolyte(jna2so4,jp,ibin) + &
2783 3.*electrolyte(jna3hso4,jp,ibin)+ &
2784 electrolyte(jnahso4,jp,ibin) + &
2785 electrolyte(jnamsa,jp,ibin)
2786
2787 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2788 electrolyte(jna2so4,jp,ibin) + &
2789 2.*electrolyte(jna3hso4,jp,ibin)+ &
2790 electrolyte(jnahso4,jp,ibin) + &
2791 electrolyte(jnh4so4,jp,ibin) + &
2792 2.*electrolyte(jlvcite,jp,ibin) + &
2793 electrolyte(jnh4hso4,jp,ibin)+ &
2794 electrolyte(jh2so4,jp,ibin)
2795 return
2796 endif
2797
2798
2799 if(js .eq. jnh4no3)then
2800 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2801 electrolyte(js,jsolid,ibin)
2802 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2803 electrolyte(js,jsolid,ibin)
2804
2805 electrolyte(js,jsolid,ibin) = 0.0
2806
2807 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2808 electrolyte(jnh4cl,jp,ibin) + &
2809 2.*electrolyte(jnh4so4,jp,ibin) + &
2810 3.*electrolyte(jlvcite,jp,ibin) + &
2811 electrolyte(jnh4hso4,jp,ibin)+ &
2812 electrolyte(jnh4msa,jp,ibin)
2813
2814 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2815 2.*electrolyte(jcano3,jp,ibin) + &
2816 electrolyte(jnh4no3,jp,ibin) + &
2817 electrolyte(jhno3,jp,ibin)
2818 return
2819 endif
2820
2821
2822 if(js .eq. jnh4cl)then
2823 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2824 electrolyte(js,jsolid,ibin)
2825 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2826 electrolyte(js,jsolid,ibin)
2827
2828 electrolyte(js,jsolid,ibin) = 0.0
2829
2830 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2831 electrolyte(jnh4cl,jp,ibin) + &
2832 2.*electrolyte(jnh4so4,jp,ibin) + &
2833 3.*electrolyte(jlvcite,jp,ibin) + &
2834 electrolyte(jnh4hso4,jp,ibin)+ &
2835 electrolyte(jnh4msa,jp,ibin)
2836
2837 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2838 2.*electrolyte(jcacl2,jp,ibin) + &
2839 electrolyte(jnh4cl,jp,ibin) + &
2840 electrolyte(jhcl,jp,ibin)
2841 return
2842 endif
2843
2844
2845 if(js .eq. jnano3)then
2846 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2847 electrolyte(js,jsolid,ibin)
2848 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2849 electrolyte(js,jsolid,ibin)
2850
2851 electrolyte(js,jsolid,ibin) = 0.0
2852
2853 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2854 electrolyte(jnacl,jp,ibin) + &
2855 2.*electrolyte(jna2so4,jp,ibin) + &
2856 3.*electrolyte(jna3hso4,jp,ibin)+ &
2857 electrolyte(jnahso4,jp,ibin) + &
2858 electrolyte(jnamsa,jp,ibin)
2859
2860 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2861 2.*electrolyte(jcano3,jp,ibin) + &
2862 electrolyte(jnh4no3,jp,ibin) + &
2863 electrolyte(jhno3,jp,ibin)
2864 return
2865 endif
2866
2867
2868 if(js .eq. jnacl)then
2869 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2870 electrolyte(js,jsolid,ibin)
2871 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2872 electrolyte(js,jsolid,ibin)
2873
2874 electrolyte(js,jsolid,ibin) = 0.0
2875
2876 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2877 electrolyte(jnacl,jp,ibin) + &
2878 2.*electrolyte(jna2so4,jp,ibin) + &
2879 3.*electrolyte(jna3hso4,jp,ibin)+ &
2880 electrolyte(jnahso4,jp,ibin) + &
2881 electrolyte(jnamsa,jp,ibin)
2882
2883 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2884 2.*electrolyte(jcacl2,jp,ibin) + &
2885 electrolyte(jnh4cl,jp,ibin) + &
2886 electrolyte(jhcl,jp,ibin)
2887 return
2888 endif
2889
2890
2891 if(js .eq. jcano3)then
2892 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2893 electrolyte(js,jsolid,ibin)
2894 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2895 2.*electrolyte(js,jsolid,ibin)
2896
2897 electrolyte(js,jsolid,ibin) = 0.0
2898
2899 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2900 electrolyte(jcano3,jp,ibin) + &
2901 electrolyte(jcacl2,jp,ibin) + &
2902 electrolyte(jcaco3,jp,ibin) + &
2903 electrolyte(jcamsa2,jp,ibin)
2904
2905 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2906 2.*electrolyte(jcano3,jp,ibin) + &
2907 electrolyte(jnh4no3,jp,ibin) + &
2908 electrolyte(jhno3,jp,ibin)
2909 return
2910 endif
2911
2912
2913 if(js .eq. jcacl2)then
2914 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2915 electrolyte(js,jsolid,ibin)
2916 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2917 2.*electrolyte(js,jsolid,ibin)
2918
2919 electrolyte(js,jsolid,ibin) = 0.0
2920
2921 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2922 electrolyte(jcano3,jp,ibin) + &
2923 electrolyte(jcacl2,jp,ibin) + &
2924 electrolyte(jcaco3,jp,ibin) + &
2925 electrolyte(jcamsa2,jp,ibin)
2926
2927 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2928 2.*electrolyte(jcacl2,jp,ibin) + &
2929 electrolyte(jnh4cl,jp,ibin) + &
2930 electrolyte(jhcl,jp,ibin)
2931 return
2932 endif
2933
2934
2935
2936 return
2937 end subroutine mesa_dissolve_small_salt
2938
2939
2940
2941
2942
2943
2944 !***********************************************************************
2945 ! part of mesa: checks mesa convergence
2946 !
2947 ! author: rahul a. zaveri
2948 ! update: jan 2005
2949 !-----------------------------------------------------------------------
2950 subroutine mesa_convergence_criterion(ibin, & ! touch
2951 iconverge_mass, &
2952 iconverge_flux, &
2953 idissolved)
2954 ! implicit none
2955 ! include 'mosaic.h'
2956 ! subr arguments
2957 integer ibin, iconverge_mass, iconverge_flux, idissolved
2958 ! local variables
2959 integer je, js, iaer
2960 real(kind=8) mass_solid, mass_solid_salt, frac_solid, xt, h_ion, &
2961 crustal_solids, sumflux
2962
2963
2964 idissolved = mno ! default = not completely dissolved
2965
2966 ! check mass convergence
2967 iconverge_mass = mno ! default value = no convergence
2968
2969 ! call electrolytes_to_ions(jsolid,ibin)
2970 ! mass_solid = 0.0
2971 ! do iaer = 1, naer
2972 ! mass_solid = mass_solid + &
2973 ! aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15 ! g/cc(air)
2974 ! enddo
2975
2976 mass_solid_salt = 0.0
2977 do je = 1, nsalt
2978 mass_solid_salt = mass_solid_salt + &
2979 electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15 ! g/cc(air)
2980 enddo
2981
2982
2983
2984 ! frac_solid = mass_solid/mass_dry_a(ibin)
2985
2986 frac_solid = mass_solid_salt/mass_dry_salt(ibin)
2987
2988 if(frac_solid .ge. 0.98)then
2989 iconverge_mass = myes
2990 return
2991 endif
2992
2993
2994
2995 ! check relative driving force convergence
2996 iconverge_flux = myes
2997 do js = 1, nsalt
2998 if(abs(phi_salt(js)).gt. rtol_mesa)then
2999 iconverge_flux = mno
3000 return
3001 endif
3002 enddo
3003
3004
3005
3006 ! check if all the fluxes are zero
3007
3008 sumflux = 0.0
3009 do js = 1, nsalt
3010 sumflux = sumflux + abs(flux_sl(js))
3011 enddo
3012
3013 crustal_solids = electrolyte(jcaco3,jsolid,ibin) + &
3014 electrolyte(jcaso4,jsolid,ibin) + &
3015 aer(ioin_a,jsolid,ibin)
3016
3017 if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
3018 idissolved = myes
3019 endif
3020
3021
3022
3023 return
3024 end subroutine mesa_convergence_criterion
3025
3026
3027
3028
3029
3030
3031
3032
3033 !***********************************************************************
3034 ! called when aerosol bin is completely solid.
3035 !
3036 ! author: rahul a. zaveri
3037 ! update: jan 2005
3038 !-----------------------------------------------------------------------
3039 subroutine adjust_solid_aerosol(ibin)
3040 ! implicit none
3041 ! include 'mosaic.h'
3042 ! subr arguments
3043 integer ibin
3044 ! local variables
3045 integer iaer, je
3046
3047
3048 jphase(ibin) = jsolid
3049 jhyst_leg(ibin) = jhyst_lo ! lower curve
3050 water_a(ibin) = 0.0
3051
3052 ! transfer aer(jtotal) to aer(jsolid)
3053 do iaer = 1, naer
3054 aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
3055 aer(iaer, jliquid,ibin) = 0.0
3056 enddo
3057
3058 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
3059 do je = 1, nelectrolyte
3060 electrolyte(je,jliquid,ibin) = 0.0
3061 epercent(je,jliquid,ibin) = 0.0
3062 electrolyte(je,jsolid,ibin) = electrolyte(je,jtotal,ibin)
3063 epercent(je,jsolid,ibin) = epercent(je,jtotal,ibin)
3064 enddo
3065
3066 ! update aer(jtotal) that may have been affected above
3067 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
3068 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
3069 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin)
3070
3071 ! update electrolyte(jtotal)
3072 do je = 1, nelectrolyte
3073 electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
3074 epercent(je,jtotal,ibin) = epercent(je,jsolid,ibin)
3075 enddo
3076
3077 return
3078 end subroutine adjust_solid_aerosol
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088 !***********************************************************************
3089 ! called when aerosol bin is completely liquid.
3090 !
3091 ! author: rahul a. zaveri
3092 ! update: jan 2005
3093 !-----------------------------------------------------------------------
3094 subroutine adjust_liquid_aerosol(ibin)
3095 ! implicit none
3096 ! include 'mosaic.h'
3097 ! subr arguments
3098 integer ibin
3099 ! local variables
3100 integer je
3101
3102
3103
3104
3105 jphase(ibin) = jliquid
3106 jhyst_leg(ibin) = jhyst_up ! upper curve
3107
3108 ! partition all electrolytes into liquid phase
3109 do je = 1, nelectrolyte
3110 electrolyte(je,jsolid,ibin) = 0.0
3111 epercent(je,jsolid,ibin) = 0.0
3112 electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
3113 epercent(je,jliquid,ibin) = epercent(je,jtotal,ibin)
3114 enddo
3115 ! except these electrolytes, which always remain in the solid phase
3116 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
3117 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
3118 epercent(jcaco3,jsolid,ibin) = epercent(jcaco3,jtotal,ibin)
3119 epercent(jcaso4,jsolid,ibin) = epercent(jcaso4,jtotal,ibin)
3120 electrolyte(jcaco3,jliquid,ibin)= 0.0
3121 electrolyte(jcaso4,jliquid,ibin)= 0.0
3122 epercent(jcaco3,jliquid,ibin) = 0.0
3123 epercent(jcaso4,jliquid,ibin) = 0.0
3124
3125
3126 ! partition all the aer species into
3127 ! solid phase
3128 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
3129 aer(ino3_a,jsolid,ibin) = 0.0
3130 aer(icl_a,jsolid,ibin) = 0.0
3131 aer(inh4_a,jsolid,ibin) = 0.0
3132 aer(ioc_a,jsolid,ibin) = aer(ioc_a,jtotal,ibin)
3133 aer(imsa_a,jsolid,ibin) = 0.0
3134 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
3135 aer(ina_a,jsolid,ibin) = 0.0
3136 aer(ica_a,jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
3137 electrolyte(jcaso4,jsolid,ibin)
3138 aer(ibc_a,jsolid,ibin) = aer(ibc_a,jtotal,ibin)
3139 aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
3140 aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
3141 aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
3142 aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
3143 aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
3144 aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
3145 aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
3146 aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
3147 aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
3148
3149 ! liquid-phase
3150 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
3151 aer(iso4_a,jsolid,ibin)
3152 aer(iso4_a,jliquid,ibin) = max(0.D0, aer(iso4_a,jliquid,ibin))
3153 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
3154 aer(icl_a,jliquid,ibin) = aer(icl_a,jtotal,ibin)
3155 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
3156 aer(ioc_a,jliquid,ibin) = 0.0
3157 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
3158 aer(ico3_a,jliquid,ibin) = 0.0
3159 aer(ina_a,jliquid,ibin) = aer(ina_a,jtotal,ibin)
3160 aer(ica_a,jliquid,ibin) = aer(ica_a,jtotal,ibin) - &
3161 aer(ica_a,jsolid,ibin)
3162 aer(ica_a,jliquid,ibin) = max(0.D0, aer(ica_a,jliquid,ibin))
3163 aer(ibc_a,jliquid,ibin) = 0.0
3164 aer(ioin_a,jliquid,ibin) = 0.0
3165 aer(iaro1_a,jliquid,ibin)= 0.0
3166 aer(iaro2_a,jliquid,ibin)= 0.0
3167 aer(ialk1_a,jliquid,ibin)= 0.0
3168 aer(iole1_a,jliquid,ibin)= 0.0
3169 aer(iapi1_a,jliquid,ibin)= 0.0
3170 aer(iapi2_a,jliquid,ibin)= 0.0
3171 aer(ilim1_a,jliquid,ibin)= 0.0
3172 aer(ilim2_a,jliquid,ibin)= 0.0
3173
3174 return
3175 end subroutine adjust_liquid_aerosol
3176
3177
3178
3179
3180
3181
3182
3183 ! end of mesa package
3184 !=======================================================================
3185
3186
3187
3188
3189
3190
3191
3192
3193 !***********************************************************************
3194 ! ASTEM: Adaptive Step Time-Split Euler Method
3195 !
3196 ! author: Rahul A. Zaveri
3197 ! update: jan 2007
3198 !-----------------------------------------------------------------------
3199 subroutine ASTEM(dtchem)
3200 ! implicit none
3201 ! include 'chemistry.com'
3202 ! include 'mosaic.h'
3203 ! subr arguments
3204 real(kind=8) dtchem
3205 ! local variables
3206 integer ibin
3207 real(kind=8) dumdum
3208
3209 ! logical first
3210 ! save first
3211 ! data first/.true./
3212
3213 integer, save :: iclm_debug, jclm_debug, kclm_debug, ncnt_debug
3214 data iclm_debug /25/
3215 data jclm_debug /1/
3216 data kclm_debug /9/
3217 data ncnt_debug /2/
3218
3219
3220
3221 if(iclm_aer .eq. iclm_debug .and. &
3222 jclm_aer .eq. jclm_debug .and. &
3223 kclm_aer .eq. kclm_debug .and. &
3224 ncorecnt_aer .eq. ncnt_debug)then
3225 dumdum = 0.0
3226 endif
3227
3228
3229
3230 ! update ASTEM call counter
3231 nASTEM_call = nASTEM_call + 1
3232
3233 ! reset input print flag
3234 iprint_input = mYES
3235
3236
3237
3238
3239 ! compute aerosol phase state before starting integration
3240 do ibin = 1, nbin_a
3241 if(jaerosolstate(ibin) .ne. no_aerosol)then
3242 call aerosol_phase_state(ibin)
3243 if (istat_mosaic_fe1 .lt. 0) return
3244 call calc_dry_n_wet_aerosol_props(ibin)
3245 endif
3246 enddo
3247
3248
3249 ! if(first)then
3250 ! first=.false.
3251 ! call print_aer(0) ! BOX
3252 ! endif
3253
3254
3255 ! compute new gas-aerosol mass transfer coefficients
3256 call aerosolmtc
3257 if (istat_mosaic_fe1 .lt. 0) return
3258
3259 ! condense h2so4, msa, and nh3 only
3260 call ASTEM_non_volatiles(dtchem) ! analytical solution
3261 if (istat_mosaic_fe1 .lt. 0) return
3262
3263 ! condense inorganic semi-volatile gases hno3, hcl, nh3, and co2
3264 call ASTEM_semi_volatiles(dtchem) ! semi-implicit + explicit euler
3265 if (istat_mosaic_fe1 .lt. 0) return
3266
3267 ! condense secondary organic gases (8 sorgam species)
3268 ! call ASTEM_secondary_organics(dtchem) ! semi-implicit euler
3269 ! if (istat_mosaic_fe1 .lt. 0) return
3270
3271
3272 ! template for error status checking
3273 ! if (iprint_mosaic_fe1 .gt. 0) then
3274 ! write(6,*)'error in computing dtmax for soa'
3275 ! write(6,*)'mosaic fatal error in astem_soa_dtmax'
3276 ! endif
3277 ! stop
3278 ! istat_mosaic_fe1 = -1800
3279 ! return
3280 ! endif
3281
3282
3283
3284 return
3285 end subroutine astem
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295 subroutine print_mosaic_stats( iflag1 )
3296 ! implicit none
3297 ! include 'mosaic.h'
3298 ! subr arguments
3299 integer iflag1
3300 ! local variables
3301 integer ibin
3302 real(kind=8) p_mesa_fails, p_astem_fails, dumcnt
3303
3304
3305 if (iflag1 .le. 0) goto 2000
3306
3307 ! print mesa and astem statistics
3308
3309 dumcnt = float(max(nmesa_call,1))
3310 p_mesa_fails = 100.*float(nmesa_fail)/dumcnt
3311 niter_mesa_avg = float(niter_mesa)/dumcnt
3312
3313 dumcnt = float(max(nastem_call,1))
3314 p_astem_fails = 100.*float(nastem_fail)/dumcnt
3315 nsteps_astem_avg = float(nsteps_astem)/dumcnt
3316
3317
3318 if (iprint_mosaic_perform_stats .gt. 0) then
3319 write(6,*)'------------------------------------------------'
3320 write(6,*)' astem performance statistics'
3321 write(6,*)'number of astem calls=', nastem_call
3322 write(6,*)'percent astem fails =', nastem_fail
3323 write(6,*)'avg steps per dtchem =', nsteps_astem_avg
3324 write(6,*)'max steps per dtchem =', nsteps_astem_max
3325 write(6,*)' '
3326 write(6,*)' mesa performance statistics'
3327 write(6,*)'number of mesa calls =', nmesa_call
3328 write(6,*)'total mesa fails =', nmesa_fail
3329 write(6,*)'percent mesa fails =', p_mesa_fails
3330 write(6,*)'avg iterations/call =', niter_mesa_avg
3331 write(6,*)'max iterations/call =', niter_mesa_max
3332 write(6,*)' '
3333 endif
3334
3335 if (iprint_mosaic_fe1 .gt. 0) then
3336 if ((nfe1_mosaic_cur .gt. 0) .or. &
3337 (iprint_mosaic_fe1 .ge. 100)) then
3338 write(6,*)'-----------------------------------------'
3339 write(6,*)'mosaic failure count (current step) =', &
3340 nfe1_mosaic_cur
3341 write(6,*)'mosaic failure count (all step tot) =', &
3342 nfe1_mosaic_tot
3343 write(6,*)' '
3344 endif
3345 endif
3346
3347 if (nfe1_mosaic_tot .gt. 9999) then
3348 write(6,'(a)') "MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!"
3349 call peg_error_fatal( lunerr_aer, &
3350 "---> MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!" )
3351 endif
3352
3353 2000 continue
3354
3355 ! reset counters
3356 nfe1_mosaic_cur = 0
3357
3358 nmesa_call = 0
3359 nmesa_fail = 0
3360 niter_mesa = 0.0
3361 niter_mesa_max = 0
3362
3363 nastem_call = 0
3364 nastem_fail = 0
3365
3366 nsteps_astem = 0.0
3367 nsteps_astem_max = 0.0
3368
3369
3370 return
3371 end subroutine print_mosaic_stats
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388 !***********************************************************************
3389 ! part of ASTEM: integrates semi-volatile inorganic gases
3390 !
3391 ! author: Rahul A. Zaveri
3392 ! update: jan 2007
3393 !-----------------------------------------------------------------------
3394 subroutine ASTEM_semi_volatiles(dtchem)
3395 ! implicit none
3396 ! include 'chemistry.com'
3397 ! include 'mosaic.h'
3398 ! subr arguments
3399 real(kind=8) dtchem
3400 ! local variables
3401 integer ibin, iv, jp
3402 real(kind=8) dtmax, t_new, t_old, t_out, xt
3403 real(kind=8) sum1, sum2, sum3, sum4, sum4a, sum4b, h_flux_s
3404
3405
3406 ! initialize time
3407 t_old = 0.0
3408 t_out = dtchem
3409
3410 ! reset ASTEM time steps and MESA iterations counters to zero
3411 isteps_ASTEM = 0
3412 do ibin = 1, nbin_a
3413 iter_MESA(ibin) = 0
3414 enddo
3415
3416 !--------------------------------
3417 ! overall integration loop begins over dtchem seconds
3418
3419 10 isteps_ASTEM = isteps_ASTEM + 1
3420
3421 ! compute new fluxes
3422 phi_nh4no3_s = 0.0
3423 phi_nh4cl_s = 0.0
3424 ieqblm_ASTEM = mYES ! reset to default
3425
3426 do 501 ibin = 1, nbin_a
3427
3428 idry_case3a(ibin) = mNO ! reset to default
3429 ! default fluxes and other stuff
3430 do iv = 1, ngas_ioa
3431 sfc_a(iv) = gas(iv)
3432 df_gas_s(iv,ibin) = 0.0
3433 df_gas_l(iv,ibin) = 0.0
3434 flux_s(iv,ibin) = 0.0
3435 flux_l(iv,ibin) = 0.0
3436 Heff(iv,ibin) = 0.0
3437 volatile_s(iv,ibin) = 0.0
3438 phi_volatile_s(iv,ibin) = 0.0
3439 phi_volatile_l(iv,ibin) = 0.0
3440 integrate(iv,jsolid,ibin) = mNO ! reset to default
3441 integrate(iv,jliquid,ibin) = mNO ! reset to default
3442 enddo
3443
3444
3445 if(jaerosolstate(ibin) .eq. all_solid)then
3446 jphase(ibin) = jsolid
3447 call ASTEM_flux_dry(ibin)
3448 elseif(jaerosolstate(ibin) .eq. all_liquid)then
3449 jphase(ibin) = jliquid
3450 call ASTEM_flux_wet(ibin)
3451 elseif(jaerosolstate(ibin) .eq. mixed)then
3452
3453 if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3454 electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3455 call ASTEM_flux_mix(ibin) ! jphase(ibin) will be determined in this subr.
3456 else
3457 jphase(ibin) = jliquid
3458 call ASTEM_flux_wet(ibin)
3459 endif
3460
3461 endif
3462
3463 501 continue
3464
3465 if(ieqblm_ASTEM .eq. mYES)goto 30 ! all bins have reached eqblm, so quit.
3466
3467 !-------------------------
3468
3469
3470 ! calculate maximum possible internal time-step
3471 11 call ASTEM_calculate_dtmax(dtchem, dtmax)
3472 t_new = t_old + dtmax ! update time
3473 if(t_new .gt. t_out)then ! check if the new time step is too large
3474 dtmax = t_out - t_old
3475 t_new = t_out*1.01
3476 endif
3477
3478
3479 !------------------------------------------
3480 ! do internal time-step (dtmax) integration
3481
3482 do 20 iv = 2, 4
3483
3484 sum1 = 0.0
3485 sum2 = 0.0
3486 sum3 = 0.0
3487 sum4 = 0.0
3488 sum4a= 0.0
3489 sum4b= 0.0
3490
3491 do 21 ibin = 1, nbin_a
3492 if(jaerosolstate(ibin) .eq. no_aerosol)goto 21
3493
3494 jp = jliquid
3495 sum1 = sum1 + aer(iv,jp,ibin)/ &
3496 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3497
3498 sum2 = sum2 + kg(iv,ibin)*integrate(iv,jp,ibin)/ &
3499 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3500
3501 jp = jsolid
3502 sum3 = sum3 + aer(iv,jp,ibin)
3503
3504 if(flux_s(iv,ibin) .gt. 0.)then
3505 h_flux_s = dtmax*flux_s(iv,ibin)
3506 sum4a = sum4a + h_flux_s
3507 aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3508 elseif(flux_s(iv,ibin) .lt. 0.)then
3509 h_flux_s = min(h_s_i_m(iv,ibin),dtmax)*flux_s(iv,ibin)
3510 sum4b = sum4b + h_flux_s
3511 aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3512 aer(iv,jp,ibin) = max(aer(iv,jp,ibin), 0.0D0)
3513 endif
3514
3515 21 continue
3516
3517 sum4 = sum4a + sum4b
3518
3519
3520 ! first update gas concentration
3521 gas(iv) = (total_species(iv) - (sum1 + sum3 + sum4) )/ &
3522 (1. + dtmax*sum2)
3523 gas(iv) = max(gas(iv), 0.0D0)
3524
3525 ! if(gas(iv) .lt. 0.)write(6,*) gas(iv)
3526
3527 ! now update aer concentration in the liquid phase
3528 do 22 ibin = 1, nbin_a
3529
3530 if(integrate(iv,jliquid,ibin) .eq. mYES)then
3531 aer(iv,jliquid,ibin) = &
3532 (aer(iv,jliquid,ibin) + dtmax*kg(iv,ibin)*gas(iv))/ &
3533 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin))
3534
3535 endif
3536
3537 22 continue
3538
3539
3540 20 continue
3541 !------------------------------------------
3542 ! sub-step integration done
3543
3544
3545 !------------------------------------------
3546 ! now update aer(jtotal) and update internal phase equilibrium
3547 ! also do integration of species by mass balance if necessary
3548
3549 do 40 ibin = 1, nbin_a
3550 if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
3551
3552 if(jphase(ibin) .eq. jsolid)then
3553 call form_electrolytes(jsolid,ibin,XT) ! degas excess nh3 (if present)
3554 elseif(jphase(ibin) .eq. jliquid)then
3555 call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3556 elseif(jphase(ibin) .eq. jtotal)then
3557 call form_electrolytes(jsolid,ibin,XT) ! degas excess nh3 (if present)
3558 call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3559 endif
3560
3561 !========================
3562 ! now update jtotal
3563 do iv = 2, ngas_ioa
3564 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
3565 enddo
3566 !========================
3567
3568
3569 call form_electrolytes(jtotal,ibin,XT) ! for MDRH diagnosis
3570
3571
3572
3573 ! update internal phase equilibrium
3574 if(jhyst_leg(ibin) .eq. jhyst_lo)then
3575 call ASTEM_update_phase_eqblm(ibin)
3576 else
3577 call do_full_deliquescence(ibin) ! simply do liquid <-- total
3578 endif
3579
3580
3581 40 continue
3582 !------------------------------------------
3583
3584 ! update time
3585 t_old = t_new
3586
3587
3588 if(isteps_astem .ge. nmax_astem)then
3589 nastem_fail = nastem_fail + 1
3590 write(6,*)'ASTEM internal steps exceeded', nmax_astem
3591 if(iprint_input .eq. mYES)then
3592 write(67,*)'ASTEM internal steps exceeded', nmax_astem
3593 call print_input
3594 iprint_input = mNO
3595 endif
3596 goto 30
3597 elseif(t_new .lt. t_out)then
3598 goto 10
3599 endif
3600
3601
3602 ! check if end of dtchem reached
3603 if(t_new .lt. 0.9999*t_out) goto 10
3604
3605 30 nsteps_astem = nsteps_astem + isteps_astem ! cumulative steps
3606 nsteps_astem_max = max(nsteps_astem_max, isteps_astem) ! max steps in a dtchem time-step
3607
3608 !================================================
3609 ! end of overall integration loop over dtchem seconds
3610
3611
3612
3613 ! call subs to calculate fluxes over mixed-phase particles to update H+ ions,
3614 ! which were wiped off during update_phase_eqblm
3615 ! do ibin = 1, nbin_a
3616 !
3617 ! if(jaerosolstate(ibin) .eq. mixed)then
3618 ! if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3619 ! electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3620 ! call ASTEM_flux_mix(ibin) ! jphase(ibin) will be determined in this subr.
3621 ! else
3622 ! jphase(ibin) = jliquid
3623 ! call ASTEM_flux_wet(ibin)
3624 ! endif
3625 ! endif
3626 !
3627 ! enddo
3628
3629
3630
3631 return
3632 end subroutine ASTEM_semi_volatiles
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645 !***********************************************************************
3646 ! part of ASTEM: computes max time step for gas-aerosol integration
3647 !
3648 ! author: Rahul A. Zaveri
3649 ! update: jan 2005
3650 !-----------------------------------------------------------------------
3651 subroutine ASTEM_calculate_dtmax(dtchem, dtmax)
3652 ! implicit none
3653 ! include 'mosaic.h'
3654 ! subr arguments
3655 real(kind=8) dtchem, dtmax
3656 ! local variables
3657 integer ibin, iv
3658 real(kind=8) alpha, h_gas, h_sub_max, &
3659 h_gas_i(ngas_ioa), h_gas_l, h_gas_s, &
3660 sum_kg_phi, sumflux_s
3661
3662
3663 h_sub_max = 150.0 ! sec
3664
3665
3666 ! set alpha_gas
3667 do ibin = 1, nbin_a
3668 do iv = 2, ngas_ioa
3669
3670 if(flux_s(iv,ibin) .gt. 0.0)then
3671
3672 alpha_gas(iv) = max( abs(phi_volatile_s(iv,ibin)), &
3673 alpha_ASTEM )
3674 alpha_gas(iv) = min(alpha_gas(iv), 0.5D0)
3675
3676 endif
3677
3678 enddo
3679 enddo
3680
3681
3682
3683
3684
3685 ! gas-side
3686
3687 ! solid-phase
3688 ! calculate h_gas_i and h_gas_l
3689
3690 h_gas_s = 2.e16
3691
3692 do 5 iv = 2, ngas_ioa
3693 h_gas_i(iv) = 1.e16
3694 sumflux_s = 0.0
3695 do ibin = 1, nbin_a
3696 if(flux_s(iv,ibin) .gt. 0.0)then
3697 sumflux_s = sumflux_s + flux_s(iv,ibin)
3698 endif
3699 enddo
3700
3701 if(sumflux_s .gt. 0.0)then
3702 h_gas_i(iv) = alpha_gas(iv)*gas(iv)/sumflux_s
3703 h_gas_s = min(h_gas_s, h_gas_i(iv))
3704 endif
3705
3706 5 continue
3707
3708
3709 ! liquid-phase
3710 ! calculate h_gas_s and h_gas_l
3711
3712 h_gas_l = 2.e16
3713
3714 do 6 iv = 2, ngas_ioa
3715 h_gas_i(iv) = 1.e16
3716 sum_kg_phi = 0.0
3717 do ibin = 1, nbin_a
3718 if(integrate(iv,jliquid,ibin) .eq. mYES)then
3719 sum_kg_phi = sum_kg_phi + &
3720 abs(phi_volatile_l(iv,ibin))*kg(iv,ibin)
3721 endif
3722 enddo
3723
3724 if(sum_kg_phi .gt. 0.0)then
3725 h_gas_i(iv) = alpha_astem/sum_kg_phi
3726 h_gas_l = min(h_gas_l, h_gas_i(iv))
3727 endif
3728
3729 6 continue
3730
3731 h_gas = min(h_gas_s, h_gas_l)
3732 h_gas = min(h_gas, h_sub_max)
3733
3734
3735
3736
3737 ! aerosol-side: solid-phase
3738
3739 ! first load volatile_solid array
3740 do ibin = 1, nbin_a
3741
3742 volatile_s(ino3_a,ibin) = electrolyte(jnh4no3,jsolid,ibin)
3743 volatile_s(inh4_a,ibin) = electrolyte(jnh4cl,jsolid,ibin) + &
3744 electrolyte(jnh4no3,jsolid,ibin)
3745
3746 if(idry_case3a(ibin) .eq. mYES)then
3747 volatile_s(icl_a,ibin) = aer(icl_a,jsolid,ibin)
3748 else
3749 volatile_s(icl_a,ibin) = electrolyte(jnh4cl,jsolid,ibin)
3750 endif
3751
3752 enddo
3753
3754
3755 ! next calculate weighted avg_df_gas_s
3756 do iv = 2, ngas_ioa
3757
3758 sum_bin_s(iv) = 0.0
3759 sum_vdf_s(iv) = 0.0
3760 sum_vol_s(iv) = 0.0
3761
3762 do ibin = 1, nbin_a
3763 if(flux_s(iv,ibin) .lt. 0.)then ! aer -> gas
3764 sum_bin_s(iv) = sum_bin_s(iv) + 1.0
3765 sum_vdf_s(iv) = sum_vdf_s(iv) + &
3766 volatile_s(iv,ibin)*df_gas_s(iv,ibin)
3767 sum_vol_s(iv) = sum_vol_s(iv) + volatile_s(iv,ibin)
3768 endif
3769 enddo
3770
3771 if(sum_vol_s(iv) .gt. 0.0)then
3772 avg_df_gas_s(iv) = sum_vdf_s(iv)/sum_vol_s(iv)
3773 else
3774 avg_df_gas_s(iv) = 1.0 ! never used, but set to 1.0 just to be safe
3775 endif
3776
3777 enddo
3778
3779
3780 ! calculate h_s_i_m
3781
3782
3783 do 20 ibin = 1, nbin_a
3784
3785 if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
3786
3787 do 10 iv = 2, ngas_ioa
3788
3789 if(flux_s(iv,ibin) .lt. 0.)then ! aer -> gas
3790
3791 alpha = abs(avg_df_gas_s(iv))/ &
3792 (volatile_s(iv,ibin)*sum_bin_s(iv))
3793 alpha = min(alpha, 1.0D0)
3794
3795 if(idry_case3a(ibin) .eq. mYES)alpha = 1.0D0
3796
3797 h_s_i_m(iv,ibin) = &
3798 -alpha*volatile_s(iv,ibin)/flux_s(iv,ibin)
3799
3800 endif
3801
3802 10 continue
3803
3804
3805 20 continue
3806
3807
3808 dtmax = min(dtchem, h_gas)
3809
3810
3811 if(dtmax .eq. 0.0)then
3812 write(6,*)' dtmax = ', dtmax
3813 write(67,*)' dtmax = ', dtmax
3814 call print_input
3815 iprint_input = mNO
3816 stop
3817 endif
3818
3819 return
3820 end subroutine astem_calculate_dtmax
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836 !***********************************************************************
3837 ! part of ASTEM: updates solid-liquid partitioning after each gas-aerosol
3838 ! mass transfer step
3839 !
3840 ! author: Rahul A. Zaveri
3841 ! update: jan 2005
3842 !-----------------------------------------------------------------------
3843 subroutine ASTEM_update_phase_eqblm(ibin) ! TOUCH
3844 ! implicit none
3845 ! include 'mosaic.h'
3846 ! subr arguments
3847 integer ibin
3848 ! local variables
3849 integer jdum, js, j_index
3850 real(kind=8) XT
3851
3852
3853
3854 ! calculate overall sulfate ratio
3855 call calculate_XT(ibin,jtotal,XT) ! calc updated XT
3856
3857 ! now diagnose MDRH
3858 if(XT .lt. 1. .and. XT .gt. 0. )goto 10 ! excess sulfate domain - no MDRH exists
3859
3860 jdum = 0
3861 do js = 1, nsalt
3862 jsalt_present(js) = 0 ! default value - salt absent
3863
3864 if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
3865 jsalt_present(js) = 1 ! salt present
3866 jdum = jdum + jsalt_index(js)
3867 endif
3868 enddo
3869
3870 if(jdum .eq. 0)then
3871 jaerosolstate(ibin) = all_solid ! no significant soluble material present
3872 jphase(ibin) = jsolid
3873 call adjust_solid_aerosol(ibin)
3874 return
3875 endif
3876
3877 if(XT .ge. 2.0 .or. XT .lt. 0.0)then
3878 j_index = jsulf_poor(jdum)
3879 else
3880 j_index = jsulf_rich(jdum)
3881 endif
3882
3883 MDRH(ibin) = MDRH_T(j_index)
3884
3885 if(aH2O*100. .lt. MDRH(ibin)) then
3886 jaerosolstate(ibin) = all_solid
3887 jphase(ibin) = jsolid
3888 call adjust_solid_aerosol(ibin)
3889 return
3890 endif
3891
3892
3893 ! none of the above means it must be sub-saturated or mixed-phase
3894 10 if(jphase(ibin) .eq. jsolid)then
3895 call do_full_deliquescence(ibin)
3896 call MESA_PTC(ibin)
3897 else
3898 call MESA_PTC(ibin)
3899 endif
3900
3901
3902
3903 return
3904 end subroutine ASTEM_update_phase_eqblm
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917 !==================================================================
3918 !
3919 ! LIQUID PARTICLES
3920 !
3921 !***********************************************************************
3922 ! part of ASTEM: computes fluxes over wet aerosols
3923 !
3924 ! author: Rahul A. Zaveri
3925 ! update: Jan 2007
3926 !-----------------------------------------------------------------------
3927 subroutine ASTEM_flux_wet(ibin)
3928 ! implicit none
3929 ! include 'mosaic.h'
3930 ! subr arguments
3931 integer ibin
3932 ! local variables
3933 integer iv, iadjust, iadjust_intermed
3934 real(kind=8) xt, g_nh3_hno3, g_nh3_hcl, a_nh4_no3, a_nh4_cl
3935
3936
3937
3938 call ions_to_electrolytes(jliquid,ibin,XT) ! for water content calculation
3939 call compute_activities(ibin)
3940
3941 if(water_a(ibin) .eq. 0.0)then
3942 write(6,*)'Water is zero in liquid phase'
3943 write(6,*)'Stopping in ASTEM_flux_wet'
3944 stop
3945 endif
3946
3947 !-------------------------------------------------------------------
3948 ! CASE 1: caco3 > 0 absorb acids (and indirectly degas co2)
3949
3950 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
3951 call ASTEM_flux_wet_case1(ibin)
3952 return
3953 endif
3954
3955 !-------------------------------------------------------------------
3956 ! CASE 2: Sulfate-Rich Domain
3957
3958 if(XT.lt.1.9999 .and. XT.ge.0.)then
3959 call ASTEM_flux_wet_case2(ibin)
3960 return
3961 endif
3962
3963 !-------------------------------------------------------------------
3964
3965 if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10 ! no ammonia in the system
3966
3967 !-------------------------------------------------------------------
3968 ! CASE 3: nh4no3 and/or nh4cl maybe active
3969 ! do some small adjustments (if needed) before deciding case 3
3970
3971 iadjust = mNO ! default
3972 iadjust_intermed = mNO ! default
3973
3974 ! nh4no3
3975 g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
3976 a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
3977
3978 if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
3979 call absorb_tiny_nh4no3(ibin)
3980 iadjust = mYES
3981 iadjust_intermed = mYES
3982 endif
3983
3984 if(iadjust_intermed .eq. mYES)then
3985 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
3986 iadjust_intermed = mNO ! reset
3987 endif
3988
3989 ! nh4cl
3990 g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
3991 a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
3992
3993 if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
3994 call absorb_tiny_nh4cl(ibin)
3995 iadjust = mYES
3996 iadjust_intermed = mYES
3997 endif
3998
3999 if(iadjust_intermed .eq. mYES)then
4000 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
4001 endif
4002
4003 if(iadjust .eq. mYES)then
4004 call compute_activities(ibin) ! update after adjustments
4005 endif
4006
4007
4008 ! all adjustments done...
4009
4010 !--------
4011 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
4012 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
4013
4014 kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
4015 Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl ! = [NH3]s * [HCl]s
4016
4017 call ASTEM_flux_wet_case3(ibin)
4018
4019 return
4020
4021
4022 !-------------------------------------------------------------------
4023 ! CASE 4: ammonia = 0. hno3 and hcl exchange may happen here
4024 ! do small adjustments (if needed) before deciding case 4
4025
4026 10 iadjust = mNO ! default
4027 iadjust_intermed = mNO ! default
4028
4029 ! hno3
4030 if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and. &
4031 aer(icl_a,jliquid,ibin) .gt. 0.0)then
4032 call absorb_tiny_hno3(ibin) ! and degas tiny hcl
4033 iadjust = mYES
4034 iadjust_intermed = mYES
4035 endif
4036
4037 if(iadjust_intermed .eq. mYES)then
4038 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
4039 iadjust_intermed = mNO ! reset
4040 endif
4041
4042 ! hcl
4043 if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin).eq.0. .and. &
4044 aer(ino3_a,jliquid,ibin) .gt. 0.0)then
4045 call absorb_tiny_hcl(ibin) ! and degas tiny hno3
4046 iadjust = mYES
4047 iadjust_intermed = mYES
4048 endif
4049
4050 if(iadjust_intermed .eq. mYES)then
4051 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
4052 endif
4053
4054 if(iadjust .eq. mYES)then
4055 call compute_activities(ibin) ! update after adjustments
4056 endif
4057
4058 ! all adjustments done...
4059
4060 call ASTEM_flux_wet_case4(ibin)
4061
4062
4063 return
4064 end subroutine ASTEM_flux_wet
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077 !***********************************************************************
4078 ! part of ASTEM: subroutines for flux_wet cases
4079 !
4080 ! author: Rahul A. Zaveri
4081 ! update: Jan 2007
4082 !-----------------------------------------------------------------------
4083
4084 ! CASE 1: CaCO3 > 0 absorb all acids (and indirectly degas co2)
4085
4086 subroutine ASTEM_flux_wet_case1(ibin)
4087 ! implicit none
4088 ! include 'mosaic.h'
4089 ! subr arguments
4090 integer ibin
4091 ! local variables
4092 integer iv
4093
4094 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4095
4096 ! same as dry case1
4097 if(gas(ihno3_g) .gt. 1.e-5)then
4098 sfc_a(ihno3_g) = 0.0
4099 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4100 phi_volatile_s(ihno3_g,ibin) = 1.0
4101 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4102 integrate(ihno3_g,jsolid,ibin) = mYES
4103 jphase(ibin) = jsolid
4104 ieqblm_ASTEM = mNO
4105 endif
4106
4107 if(gas(ihcl_g) .gt. 1.e-5)then
4108 sfc_a(ihcl_g) = 0.0
4109 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4110 phi_volatile_s(ihcl_g,ibin) = 1.0
4111 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4112 integrate(ihcl_g,jsolid,ibin) = mYES
4113 jphase(ibin) = jsolid
4114 ieqblm_ASTEM = mNO
4115 endif
4116
4117 return
4118 end subroutine ASTEM_flux_wet_case1
4119
4120
4121
4122 !--------------------------------------------------------------------
4123 ! CASE 2: Sulfate-Rich Domain
4124
4125 subroutine ASTEM_flux_wet_case2(ibin)
4126 ! implicit none
4127 ! include 'mosaic.h'
4128 ! subr arguments
4129 integer ibin
4130 ! local variables
4131 real(kind=8) dum_hno3, dum_hcl, dum_nh3
4132
4133
4134 sfc_a(inh3_g) = kel(inh3_g,ibin)* &
4135 gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4136 (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4137
4138 sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4139 mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4140 Keq_gl(3)
4141
4142 sfc_a(ihcl_g) = kel(ihcl_g,ibin)* &
4143 mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4144 Keq_gl(4)
4145
4146 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4147 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4148 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4149
4150
4151 ! compute relative driving forces
4152 if(dum_hno3 .gt. 0.0)then
4153 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4154 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4155 else
4156 phi_volatile_l(ihno3_g,ibin)= 0.0
4157 endif
4158
4159 if(dum_hcl .gt. 0.0)then
4160 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4161 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4162 else
4163 phi_volatile_l(ihcl_g,ibin) = 0.0
4164 endif
4165
4166 if(dum_nh3 .gt. 0.0)then
4167 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4168 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4169 else
4170 phi_volatile_l(inh3_g,ibin) = 0.0
4171 endif
4172
4173
4174 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4175 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4176 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4177
4178 return
4179
4180 endif
4181
4182
4183 ! compute Heff
4184 if(dum_hno3 .gt. 0.0)then
4185 Heff(ihno3_g,ibin)= &
4186 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4187 (water_a(ibin)*Keq_gl(3))
4188 integrate(ihno3_g,jliquid,ibin)= mYES
4189 ieqblm_ASTEM = mNO
4190 endif
4191
4192 if(dum_hcl .gt. 0.0)then
4193 Heff(ihcl_g,ibin)= &
4194 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4195 (water_a(ibin)*Keq_gl(4))
4196 integrate(ihcl_g,jliquid,ibin) = mYES
4197 ieqblm_ASTEM = mNO
4198 endif
4199
4200 if(dum_nh3 .gt. 0.0)then
4201 Heff(inh3_g,ibin) = &
4202 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4203 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4204 integrate(inh3_g,jliquid,ibin) = mYES
4205 ieqblm_ASTEM = mNO
4206 endif
4207
4208
4209 return
4210 end subroutine ASTEM_flux_wet_case2
4211
4212
4213
4214
4215
4216
4217
4218
4219 !---------------------------------------------------------------------
4220 ! CASE 3: nh4no3 and/or nh4cl may be active
4221
4222 subroutine ASTEM_flux_wet_case3(ibin)
4223 ! implicit none
4224 ! include 'mosaic.h'
4225 ! subr arguments
4226 integer ibin
4227 ! local variables
4228 real(kind=8) a, b, c, dum_hno3, dum_hcl, dum_nh3
4229 ! function
4230 ! real(kind=8) quadratic
4231
4232 a = kg(inh3_g,ibin)
4233 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4234 + kg(ihno3_g,ibin)*gas(ihno3_g) &
4235 + kg(ihcl_g,ibin)*gas(ihcl_g)
4236 c = -(kg(ihno3_g,ibin)*Keq_nh4no3 + kg(ihcl_g,ibin)*Keq_nh4cl)
4237
4238 sfc_a(inh3_g) = quadratic(a,b,c)
4239 sfc_a(ihno3_g) = Keq_nh4no3/max(sfc_a(inh3_g),1.D-20)
4240 sfc_a(ihcl_g) = Keq_nh4cl/max(sfc_a(inh3_g),1.D-20)
4241
4242
4243 ! diagnose mH+
4244 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4245 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4246 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4247 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4248 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4249 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4250 else
4251 call equilibrate_acids(ibin) ! hno3 and/or hcl may be > 0 in the gas phase
4252 mc(jc_h,ibin) = max(mc(jc_h,ibin), sqrt(Keq_ll(3)))
4253
4254 sfc_a(inh3_g) = kel(inh3_g,ibin)* &
4255 gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4256 (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4257
4258 sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4259 mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4260 Keq_gl(3)
4261 sfc_a(ihcl_g) = kel(ihcl_g,ibin)* &
4262 mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4263 Keq_gl(4)
4264 endif
4265
4266
4267
4268 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4269 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4270 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4271
4272 ! compute relative driving forces
4273 if(dum_hno3 .gt. 0.0)then
4274 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4275 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4276 else
4277 phi_volatile_l(ihno3_g,ibin)= 0.0
4278 endif
4279
4280 if(dum_hcl .gt. 0.0)then
4281 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4282 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4283 else
4284 phi_volatile_l(ihcl_g,ibin) = 0.0
4285 endif
4286
4287 if(dum_nh3 .gt. 0.0)then
4288 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4289 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4290 else
4291 phi_volatile_l(inh3_g,ibin) = 0.0
4292 endif
4293
4294
4295
4296 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4297 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4298 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4299
4300 return
4301
4302 endif
4303
4304
4305 ! compute Heff
4306 if(dum_hno3 .gt. 0.0)then
4307 Heff(ihno3_g,ibin)= &
4308 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4309 (water_a(ibin)*Keq_gl(3))
4310 integrate(ihno3_g,jliquid,ibin)= mYES
4311 ieqblm_ASTEM = mNO
4312 endif
4313
4314 if(dum_hcl .gt. 0.0)then
4315 Heff(ihcl_g,ibin)= &
4316 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4317 (water_a(ibin)*Keq_gl(4))
4318 integrate(ihcl_g,jliquid,ibin) = mYES
4319 ieqblm_ASTEM = mNO
4320 endif
4321
4322 if(dum_nh3 .gt. 0.0)then
4323 Heff(inh3_g,ibin) = &
4324 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4325 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4326 integrate(inh3_g,jliquid,ibin) = mYES
4327 ieqblm_ASTEM = mNO
4328 endif
4329
4330
4331
4332 return
4333 end subroutine ASTEM_flux_wet_case3
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343 !--------------------------------------------------------------------
4344 ! CASE 3a: only NH4NO3 (aq) active
4345
4346 subroutine ASTEM_flux_wet_case3a(ibin) ! NH4NO3 (aq)
4347 ! implicit none
4348 ! include 'mosaic.h'
4349 ! subr arguments
4350 integer ibin
4351 ! local variables
4352 real(kind=8) a, b, c, dum_hno3, dum_nh3
4353 ! function
4354 ! real(kind=8) quadratic
4355
4356
4357 a = kg(inh3_g,ibin)
4358 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4359 + kg(ihno3_g,ibin)*gas(ihno3_g)
4360 c = -(kg(ihno3_g,ibin)*Keq_nh4no3)
4361
4362 sfc_a(inh3_g) = quadratic(a,b,c)
4363 sfc_a(ihno3_g) = Keq_nh4no3/sfc_a(inh3_g)
4364
4365
4366 ! diagnose mH+
4367 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4368 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4369 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4370 else
4371 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4372 endif
4373
4374
4375 ! compute Heff
4376 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4377 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4378
4379 ! compute relative driving forces
4380 if(dum_hno3 .gt. 0.0)then
4381 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4382 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4383 else
4384 phi_volatile_l(ihno3_g,ibin)= 0.0
4385 endif
4386
4387 if(dum_nh3 .gt. 0.0)then
4388 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4389 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4390 else
4391 phi_volatile_l(inh3_g,ibin) = 0.0
4392 endif
4393
4394
4395 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4396 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4397
4398 return
4399
4400 endif
4401
4402
4403 ! compute Heff
4404 Heff(ihno3_g,ibin)= &
4405 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4406 (water_a(ibin)*Keq_gl(3))
4407 integrate(ihno3_g,jliquid,ibin)= mYES
4408
4409
4410 Heff(inh3_g,ibin) = &
4411 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4412 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4413 integrate(inh3_g,jliquid,ibin) = mYES
4414
4415
4416 ieqblm_ASTEM = mNO
4417
4418
4419 return
4420 end subroutine ASTEM_flux_wet_case3a
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430 !--------------------------------------------------------------------
4431 ! CASE 3b: only NH4Cl (aq) active
4432
4433 subroutine ASTEM_flux_wet_case3b(ibin) ! NH4Cl (aq)
4434 ! implicit none
4435 ! include 'mosaic.h'
4436 ! subr arguments
4437 integer ibin
4438 ! local variables
4439 real(kind=8) a, b, c, dum_hcl, dum_nh3
4440 ! function
4441 ! real(kind=8) quadratic
4442
4443
4444 a = kg(inh3_g,ibin)
4445 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4446 + kg(ihcl_g,ibin)*gas(ihcl_g)
4447 c = -(kg(ihcl_g,ibin)*Keq_nh4cl)
4448
4449 sfc_a(inh3_g) = quadratic(a,b,c)
4450 sfc_a(ihcl_g) = Keq_nh4cl /sfc_a(inh3_g)
4451
4452
4453 ! diagnose mH+
4454 if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4455 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4456 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4457 else
4458 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4459 endif
4460
4461
4462 ! compute Heff
4463 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4464 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4465
4466
4467 ! compute relative driving forces
4468 if(dum_hcl .gt. 0.0)then
4469 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4470 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4471 else
4472 phi_volatile_l(ihcl_g,ibin) = 0.0
4473 endif
4474
4475 if(dum_nh3 .gt. 0.0)then
4476 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4477 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4478 else
4479 phi_volatile_l(inh3_g,ibin) = 0.0
4480 endif
4481
4482
4483
4484 if(phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4485 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4486
4487 return
4488
4489 endif
4490
4491
4492
4493 ! compute Heff
4494 Heff(ihcl_g,ibin)= &
4495 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4496 (water_a(ibin)*Keq_gl(4))
4497 integrate(ihcl_g,jliquid,ibin) = mYES
4498
4499
4500 Heff(inh3_g,ibin) = &
4501 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4502 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4503 integrate(inh3_g,jliquid,ibin) = mYES
4504
4505
4506 ieqblm_ASTEM = mNO
4507
4508
4509
4510 return
4511 end subroutine ASTEM_flux_wet_case3b
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521 !-----------------------------------------------------------------------
4522 ! CASE 4: NH3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
4523
4524 subroutine ASTEM_flux_wet_case4(ibin)
4525 ! implicit none
4526 ! include 'mosaic.h'
4527 ! subr arguments
4528 integer ibin
4529 ! local variables
4530 real(kind=8) dum_numer, dum_denom, gas_eqb_ratio, dum_hno3, dum_hcl
4531
4532
4533 dum_numer = kel(ihno3_g,ibin)*Keq_gl(4)*ma(ja_no3,ibin)* &
4534 gam(jhno3,ibin)**2
4535 dum_denom = kel(ihcl_g,ibin)*Keq_gl(3)*ma(ja_cl ,ibin)* &
4536 gam(jhcl,ibin)**2
4537
4538
4539 if(dum_denom .eq. 0.0 .or. dum_numer .eq. 0.0)then
4540 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4541 return
4542 endif
4543
4544 gas_eqb_ratio = dum_numer/dum_denom ! Ce,hno3/Ce,hcl
4545
4546
4547 ! compute equilibrium surface concentrations
4548 sfc_a(ihcl_g) = &
4549 ( kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g) )/ &
4550 ( kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin) )
4551 sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
4552
4553
4554 ! diagnose mH+
4555 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4556 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4557 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4558 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4559 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4560 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4561 else
4562 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4563 endif
4564
4565
4566 ! compute Heff
4567 dum_hno3 = min(sfc_a(ihno3_g), gas(ihno3_g))
4568 dum_hcl = min(sfc_a(ihcl_g), gas(ihcl_g))
4569
4570 ! compute relative driving forces
4571 if(dum_hno3 .gt. 0.0)then
4572 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4573 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4574 else
4575 phi_volatile_l(ihno3_g,ibin)= 0.0
4576 endif
4577
4578 if(dum_hcl .gt. 0.0)then
4579 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4580 phi_volatile_l(ihcl_g,ibin)= df_gas_l(ihcl_g,ibin)/dum_hcl
4581 else
4582 phi_volatile_l(ihcl_g,ibin)= 0.0
4583 endif
4584
4585
4586 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4587 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem)then
4588
4589 return
4590
4591 endif
4592
4593
4594
4595 ! compute Heff
4596 Heff(ihno3_g,ibin)= &
4597 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4598 (water_a(ibin)*Keq_gl(3))
4599 integrate(ihno3_g,jliquid,ibin)= mYES
4600
4601
4602 Heff(ihcl_g,ibin)= &
4603 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4604 (water_a(ibin)*Keq_gl(4))
4605 integrate(ihcl_g,jliquid,ibin) = mYES
4606
4607
4608 ieqblm_ASTEM = mNO
4609
4610
4611
4612 return
4613 end subroutine ASTEM_flux_wet_case4
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628 !===========================================================
4629 !
4630 ! DRY PARTICLES
4631 !
4632 !===========================================================
4633 !***********************************************************************
4634 ! part of ASTEM: computes gas-aerosol fluxes over dry aerosols
4635 !
4636 ! author: Rahul A. Zaveri
4637 ! update: dec 2006
4638 !-----------------------------------------------------------------------
4639 subroutine ASTEM_flux_dry(ibin)
4640 ! implicit none
4641 ! include 'mosaic.h'
4642 ! subr arguments
4643 integer ibin
4644 ! local variables
4645 integer iv
4646 real(kind=8) XT, prod_nh4no3, prod_nh4cl, volatile_cl
4647
4648
4649
4650
4651 call calculate_XT(ibin,jsolid,XT)
4652
4653 !-----------------------------------------------------------------
4654 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
4655
4656 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
4657
4658 call ASTEM_flux_dry_case1(ibin)
4659
4660 return
4661 endif
4662
4663 !-----------------------------------------------------------------
4664 ! CASE 2: Sulfate-Rich Domain
4665
4666 if(XT.lt.1.9999 .and. XT.ge.0.)then ! excess sulfate (acidic)
4667
4668 call ASTEM_flux_dry_case2(ibin)
4669
4670 return
4671 endif
4672
4673 !-------------------------------------------------------------------
4674 ! CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
4675
4676 volatile_cl = electrolyte(jnacl,jsolid,ibin) + &
4677 electrolyte(jcacl2,jsolid,ibin)
4678
4679
4680 if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
4681
4682 call ASTEM_flux_dry_case3a(ibin)
4683
4684 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_sg(2)), 0.0D0) + &
4685 electrolyte(jnh4cl, jsolid,ibin)
4686
4687 if(prod_nh4cl .gt. 0.0)then
4688 call ASTEM_flux_dry_case3b(ibin)
4689 endif
4690
4691 return
4692 endif
4693
4694 !-----------------------------------------------------------------
4695 ! CASE 4: nh4no3 or nh4cl or both may be active
4696
4697 prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-Keq_sg(1)),0.D0) + &
4698 electrolyte(jnh4no3,jsolid,ibin)
4699 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g) -Keq_sg(2)),0.D0) + &
4700 electrolyte(jnh4cl, jsolid,ibin)
4701
4702 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
4703 call ASTEM_flux_dry_case4(ibin)
4704 return
4705 endif
4706
4707 !-----------------------------------------------------------------
4708
4709 return
4710 end subroutine ASTEM_flux_dry
4711
4712 !----------------------------------------------------------------------
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726 !***********************************************************************
4727 ! part of ASTEM: subroutines for flux_dry cases
4728 !
4729 ! author: Rahul A. Zaveri
4730 ! update: dec 2006
4731 !-----------------------------------------------------------------------
4732
4733 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
4734
4735 subroutine ASTEM_flux_dry_case1(ibin)
4736 ! implicit none
4737 ! include 'mosaic.h'
4738 ! subr arguments
4739 integer ibin
4740
4741
4742 if(gas(ihno3_g) .gt. 1.e-5)then
4743 sfc_a(ihno3_g) = 0.0
4744 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4745 phi_volatile_s(ihno3_g,ibin) = 1.0
4746 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4747 integrate(ihno3_g,jsolid,ibin) = mYES
4748 ieqblm_ASTEM = mNO
4749 endif
4750
4751 if(gas(ihcl_g) .gt. 1.e-5)then
4752 sfc_a(ihcl_g) = 0.0
4753 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4754 phi_volatile_s(ihcl_g,ibin) = 1.0
4755 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4756 integrate(ihcl_g,jsolid,ibin) = mYES
4757 ieqblm_ASTEM = mNO
4758 endif
4759
4760
4761 return
4762 end subroutine ASTEM_flux_dry_case1
4763
4764
4765
4766 !---------------------------------------------------------------------
4767 ! CASE 2: Sulfate-Rich Domain
4768
4769 subroutine ASTEM_flux_dry_case2(ibin) ! TOUCH
4770 ! implicit none
4771 ! include 'mosaic.h'
4772 ! subr arguments
4773 integer ibin
4774
4775
4776 if(gas(inh3_g).gt.1.e-5)then
4777 sfc_a(inh3_g) = 0.0
4778 df_gas_s(inh3_g,ibin) = gas(inh3_g)
4779 phi_volatile_s(inh3_g,ibin) = 1.0
4780 flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
4781 integrate(inh3_g,jsolid,ibin) = mYES
4782 ieqblm_ASTEM = mNO
4783 endif
4784
4785
4786 return
4787 end subroutine ASTEM_flux_dry_case2
4788
4789
4790
4791
4792 !---------------------------------------------------------------------
4793 ! CASE 3a: degas hcl from nacl or cacl2 by flux_s balance with hno3
4794
4795 subroutine ASTEM_flux_dry_case3a(ibin)
4796 ! implicit none
4797 ! include 'mosaic.h'
4798 ! subr arguments
4799 integer ibin
4800
4801
4802 if(gas(ihno3_g) .gt. 1.e-5)then
4803 sfc_a(ihno3_g) = 0.0
4804 sfc_a(ihcl_g) = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4805
4806 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4807 df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
4808
4809 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
4810 flux_s(ihcl_g,ibin) = -flux_s(ihno3_g,ibin)
4811
4812 phi_volatile_s(ihno3_g,ibin) = 1.0
4813 phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)
4814
4815 integrate(ihno3_g,jsolid,ibin) = mYES
4816 integrate(ihcl_g,jsolid,ibin) = mYES
4817
4818 idry_case3a(ibin) = mYES
4819 ieqblm_ASTEM = mNO
4820 endif
4821
4822 return
4823 end subroutine ASTEM_flux_dry_case3a
4824
4825
4826
4827
4828 !---------------------------------------------------------------------
4829 ! CASE 3b: nh4cl may form/evaporate here
4830
4831 subroutine ASTEM_flux_dry_case3b(ibin) ! TOUCH
4832 ! implicit none
4833 ! include 'mosaic.h'
4834 ! subr arguments
4835 integer ibin
4836 ! local variables
4837 integer iactive_nh4cl
4838 real(kind=8) a, b, c
4839 ! function
4840 ! real(kind=8) quadratic
4841
4842
4843 !-------------------
4844 ! set default values for flags
4845 iactive_nh4cl = 1
4846
4847
4848 ! compute relative driving force
4849 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4850 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4851
4852
4853 !-------------------
4854 ! now determine if nh4cl is active or significant
4855 ! nh4cl
4856 if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4857 iactive_nh4cl = 0
4858 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4859 epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4860 iactive_nh4cl = 0
4861 if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4862 call degas_solid_nh4cl(ibin)
4863 endif
4864 endif
4865
4866
4867 ! check the outcome
4868 if(iactive_nh4cl .eq. 0)return
4869
4870
4871 !-----------------
4872 ! nh4cl is active
4873
4874
4875 a = kg(inh3_g,ibin)
4876 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4877 + kg(ihcl_g,ibin)*gas(ihcl_g)
4878 c = -(kg(ihcl_g,ibin)*Keq_sg(2))
4879
4880 sfc_a(inh3_g) = quadratic(a,b,c)
4881 sfc_a(ihcl_g) = Keq_sg(2)/sfc_a(inh3_g)
4882
4883 df_gas_s(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4884 df_gas_s(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4885
4886 flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas_s(inh3_g,ibin)
4887 flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) + flux_s(inh3_g,ibin)
4888
4889 phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
4890
4891 if(flux_s(ihcl_g,ibin) .gt. 0.0)then
4892 df_gas_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin) ! recompute df_gas
4893 phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
4894 else
4895 sfc_a(ihcl_g) = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4896 df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
4897 phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g) ! not to be used
4898 endif
4899
4900 integrate(inh3_g,jsolid,ibin) = mYES
4901 integrate(ihcl_g,jsolid,ibin) = mYES ! integrate HCl with explicit euler
4902
4903 ieqblm_ASTEM = mNO
4904
4905 return
4906 end subroutine ASTEM_flux_dry_case3b
4907
4908
4909
4910
4911 !---------------------------------------------------------------------
4912 ! Case 4: NH4NO3 and/or NH4Cl may be active
4913
4914 subroutine ASTEM_flux_dry_case4(ibin) ! TOUCH
4915 ! implicit none
4916 ! include 'mosaic.h'
4917 ! subr arguments
4918 integer ibin
4919 ! local variables
4920 integer iactive_nh4no3, iactive_nh4cl, iactive
4921 real(kind=8) a, b, c
4922 ! function
4923 ! real(kind=8) quadratic
4924
4925
4926 !-------------------
4927 ! set default values for flags
4928 iactive_nh4no3 = 1
4929 iactive_nh4cl = 2
4930
4931
4932 ! compute diagnostic products and ratios
4933 phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
4934 max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
4935 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4936 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4937
4938
4939 !-------------------
4940 ! now determine if nh4no3 and/or nh4cl are active or significant
4941
4942 ! nh4no3
4943 if( abs(phi_nh4no3_s) .lt. rtol_eqb_ASTEM )then
4944 iactive_nh4no3 = 0
4945 elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
4946 epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
4947 iactive_nh4no3 = 0
4948 if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
4949 call degas_solid_nh4no3(ibin)
4950 endif
4951 endif
4952
4953 ! nh4cl
4954 if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4955 iactive_nh4cl = 0
4956 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4957 epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4958 iactive_nh4cl = 0
4959 if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4960 call degas_solid_nh4cl(ibin)
4961 endif
4962 endif
4963
4964
4965 iactive = iactive_nh4no3 + iactive_nh4cl
4966
4967 ! check the outcome
4968 if(iactive .eq. 0)return
4969
4970
4971 goto (1,2,3),iactive
4972
4973 !---------------------------------
4974 ! only nh4no3 solid is active
4975 1 call ASTEM_flux_dry_case4a(ibin)
4976
4977 return
4978
4979
4980 !-----------------
4981 ! only nh4cl solid is active
4982 2 call ASTEM_flux_dry_case4b(ibin)
4983
4984 return
4985
4986
4987 !-----------------
4988 ! both nh4no3 and nh4cl are active
4989 3 call ASTEM_flux_dry_case4ab(ibin)
4990
4991
4992
4993
4994 return
4995 end subroutine ASTEM_flux_dry_case4
4996
4997
4998
4999
5000
5001
5002
5003 !---------------------------------------------------------------------
5004 ! Case 4a
5005
5006 subroutine ASTEM_flux_dry_case4a(ibin) ! NH4NO3 solid
5007 ! implicit none
5008 ! include 'mosaic.h'
5009 ! subr arguments
5010 integer ibin
5011 ! local variables
5012 real(kind=8) a, b, c
5013 ! function
5014 ! real(kind=8) quadratic
5015
5016
5017
5018 a = kg(inh3_g,ibin)
5019 b = - kg(inh3_g,ibin)*gas(inh3_g) &
5020 + kg(ihno3_g,ibin)*gas(ihno3_g)
5021 c = -(kg(ihno3_g,ibin)*Keq_sg(1))
5022
5023 sfc_a(inh3_g) = quadratic(a,b,c)
5024 sfc_a(ihno3_g) = Keq_sg(1)/sfc_a(inh3_g)
5025
5026 integrate(ihno3_g,jsolid,ibin) = mYES
5027 integrate(inh3_g,jsolid,ibin) = mYES
5028
5029 df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5030 df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5031
5032 phi_volatile_s(ihno3_g,ibin)= phi_nh4no3_s
5033 phi_volatile_s(inh3_g,ibin) = phi_nh4no3_s
5034
5035 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
5036 flux_s(inh3_g,ibin) = flux_s(ihno3_g,ibin)
5037
5038 ieqblm_ASTEM = mNO
5039
5040 return
5041 end subroutine ASTEM_flux_dry_case4a
5042
5043
5044
5045
5046 !---------------------------------------------------------
5047 ! Case 4b
5048
5049 subroutine ASTEM_flux_dry_case4b(ibin) ! NH4Cl solid
5050 ! implicit none
5051 ! include 'mosaic.h'
5052 ! subr arguments
5053 integer ibin
5054 ! local variables
5055 real(kind=8) a, b, c
5056 ! function
5057 ! real(kind=8) quadratic
5058
5059
5060 a = kg(inh3_g,ibin)
5061 b = - kg(inh3_g,ibin)*gas(inh3_g) &
5062 + kg(ihcl_g,ibin)*gas(ihcl_g)
5063 c = -(kg(ihcl_g,ibin)*Keq_sg(2))
5064
5065 sfc_a(inh3_g) = quadratic(a,b,c)
5066 sfc_a(ihcl_g) = Keq_sg(2) /sfc_a(inh3_g)
5067
5068 integrate(ihcl_g,jsolid,ibin) = mYES
5069 integrate(inh3_g,jsolid,ibin) = mYES
5070
5071 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)-sfc_a(ihcl_g)
5072 df_gas_s(inh3_g,ibin) = gas(inh3_g)-sfc_a(inh3_g)
5073
5074 phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
5075 phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
5076
5077 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
5078 flux_s(inh3_g,ibin) = flux_s(ihcl_g,ibin)
5079
5080 ieqblm_ASTEM = mNO
5081
5082 return
5083 end subroutine ASTEM_flux_dry_case4b
5084
5085
5086
5087
5088 !-------------------------------------------------------------------
5089 ! Case 4ab
5090
5091 subroutine ASTEM_flux_dry_case4ab(ibin) ! NH4NO3 + NH4Cl (solid)
5092 ! implicit none
5093 ! include 'mosaic.h'
5094 ! subr arguments
5095 integer ibin
5096 ! local variables
5097 real(kind=8) a, b, c, &
5098 flux_nh3_est, flux_nh3_max, ratio_flux
5099 ! function
5100 ! real(kind=8) quadratic
5101
5102 call ASTEM_flux_dry_case4a(ibin)
5103 call ASTEM_flux_dry_case4b(ibin)
5104
5105
5106 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
5107
5108 flux_nh3_est = flux_s(ihno3_g,ibin)+flux_s(ihcl_g,ibin)
5109 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
5110
5111
5112 if(flux_nh3_est .le. flux_nh3_max)then
5113
5114 flux_s(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
5115 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(ihno3_g)
5116 flux_s(inh3_g,ibin)/kg(inh3_g,ibin)
5117 phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5118 abs(phi_nh4cl_s))
5119
5120 else ! reduce hno3 and hcl flux_ses as necessary so that nh3 flux_s = flux_s_nh3_max
5121
5122 ratio_flux = flux_nh3_max/flux_nh3_est
5123 flux_s(inh3_g,ibin) = flux_nh3_max
5124 flux_s(ihno3_g,ibin)= flux_s(ihno3_g,ibin)*ratio_flux
5125 flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) *ratio_flux
5126
5127 sfc_a(inh3_g) = 0.0
5128 sfc_a(ihno3_g)= gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
5129 flux_s(ihno3_g,ibin)/kg(ihno3_g,ibin)
5130 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
5131 flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)
5132
5133 df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5134 df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5135 df_gas_s(ihcl_g,ibin) =gas(ihcl_g) -sfc_a(ihcl_g)
5136
5137 phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5138 abs(phi_nh4cl_s))
5139
5140 endif
5141
5142 ieqblm_ASTEM = mNO
5143
5144 return
5145 end subroutine ASTEM_flux_dry_case4ab
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157 !=======================================================================
5158 !
5159 ! MIXED-PHASE PARTICLES
5160 !
5161 !***********************************************************************
5162 ! part of ASTEM: computes gas-aerosol fluxes over mixed-phase aerosols
5163 !
5164 ! author: Rahul A. Zaveri
5165 ! update: apr 2006
5166 !-----------------------------------------------------------------------
5167
5168 subroutine ASTEM_flux_mix(ibin)
5169 ! implicit none
5170 ! include 'mosaic.h'
5171 ! subr arguments
5172 integer ibin
5173 ! local variables
5174 integer iv, iadjust, iadjust_intermed
5175 real(kind=8) XT, g_nh3_hno3, g_nh3_hcl, &
5176 a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
5177 prod_nh4no3, prod_nh4cl
5178 real(kind=8) volatile_cl
5179
5180
5181 call ions_to_electrolytes(jliquid,ibin,XT) ! for water content calculation
5182 call compute_activities(ibin)
5183
5184 if(water_a(ibin) .eq. 0.0)then
5185 write(6,*)'Water is zero in liquid phase'
5186 write(6,*)'Stopping in ASTEM_flux_wet'
5187 stop
5188 endif
5189
5190
5191
5192 !-----------------------------------------------------------------
5193 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
5194
5195 if(epercent(jcaco3,jsolid,ibin) .gt. 0.0)then
5196 jphase(ibin) = jliquid
5197 call ASTEM_flux_wet_case1(ibin)
5198 return
5199 endif
5200
5201 !-----------------------------------------------------------------
5202 ! CASE 2: Sulfate-Rich Domain
5203
5204 if(XT.lt.1.9999 .and. XT.ge.0.)then ! excess sulfate (acidic)
5205 jphase(ibin) = jliquid
5206 call ASTEM_flux_wet_case2(ibin)
5207 return
5208 endif
5209
5210 !-------------------------------------------------------------------
5211 ! CASE 3: nh4no3 or nh4cl or both may be active
5212
5213 if( electrolyte(jnh4no3,jsolid,ibin).gt.0. .and. &
5214 electrolyte(jnh4cl,jsolid,ibin) .gt.0. )then
5215 jphase(ibin) = jsolid
5216 call ASTEM_flux_dry_case4(ibin)
5217
5218 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5219 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5220 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5221 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5222 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5223 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5224 else
5225 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5226 endif
5227
5228 return
5229
5230 elseif( electrolyte(jnh4no3,jsolid,ibin).gt.0. )then
5231 ! do small adjustments for nh4cl aq
5232 g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
5233 a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
5234
5235 iadjust = mNO ! initialize
5236 if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .eq. 0.0)then
5237 call absorb_tiny_nh4cl(ibin)
5238 iadjust = mYES
5239 elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
5240 call degas_tiny_nh4cl(ibin)
5241 iadjust = mYES
5242 endif
5243
5244 if(iadjust .eq. mYES)then
5245 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
5246 call compute_activities(ibin) ! update after adjustments
5247 endif
5248
5249 call ASTEM_flux_mix_case3a(ibin) ! nh4no3 solid + nh4cl aq
5250 jphase(ibin) = jtotal
5251 return
5252
5253 elseif( electrolyte(jnh4cl,jsolid,ibin).gt.0.)then
5254 ! do small adjustments for nh4no3 aq
5255 g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
5256 a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
5257
5258 iadjust = mNO ! initialize
5259 if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .eq. 0.0)then
5260 call absorb_tiny_nh4no3(ibin)
5261 iadjust = mYES
5262 elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
5263 call degas_tiny_nh4no3(ibin)
5264 iadjust = mYES
5265 endif
5266
5267 if(iadjust .eq. mYES)then
5268 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
5269 call compute_activities(ibin) ! update after adjustments
5270 endif
5271
5272 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5273 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
5274
5275 call ASTEM_flux_mix_case3b(ibin) ! nh4cl solid + nh4no3 aq
5276 jphase(ibin) = jtotal
5277 return
5278 endif
5279
5280
5281 return
5282 end subroutine ASTEM_flux_mix
5283
5284 !----------------------------------------------------------------------
5285
5286
5287
5288
5289
5290
5291
5292
5293 !------------------------------------------------------------------
5294 ! Mix Case 3a: NH4NO3 solid maybe active. NH4Cl aq maybe active
5295
5296 subroutine ASTEM_flux_mix_case3a(ibin) ! TOUCH
5297 ! implicit none
5298 ! include 'mosaic.h'
5299 ! subr arguments
5300 integer ibin
5301 ! local variables
5302 integer iactive_nh4no3, iactive_nh4cl
5303
5304
5305 ! set default values for flags
5306 iactive_nh4no3 = mYES
5307 iactive_nh4cl = mYES
5308
5309
5310 ! nh4no3 (solid)
5311 phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
5312 max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
5313
5314 ! nh4cl (liquid)
5315 kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
5316 Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl ! = [NH3]s * [HCl]s
5317
5318
5319 !-------------------
5320 ! now determine if nh4no3 and/or nh4cl are active or significant
5321 ! nh4no3 solid
5322 if( abs(phi_nh4no3_s) .le. rtol_eqb_ASTEM )then
5323 iactive_nh4no3 = mNO
5324 elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
5325 epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
5326 iactive_nh4no3 = mNO
5327 if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
5328 call degas_solid_nh4no3(ibin)
5329 endif
5330 endif
5331
5332 ! nh4cl aq
5333 if( gas(inh3_g)*gas(ihcl_g).eq.0. .or. Keq_nh4cl.eq.0. )then
5334 iactive_nh4cl = mNO
5335 endif
5336
5337
5338 !---------------------------------
5339 if(iactive_nh4no3 .eq. mYES)then
5340
5341 jphase(ibin) = jsolid
5342 call ASTEM_flux_dry_case4a(ibin) ! NH4NO3 (solid)
5343
5344 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5345 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5346 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5347 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5348 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5349 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5350 else
5351 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5352 endif
5353
5354 endif
5355
5356
5357 if(iactive_nh4cl .eq. mYES)then
5358
5359 jphase(ibin) = jliquid
5360 call ASTEM_flux_wet_case3b(ibin) ! NH4Cl (liquid)
5361
5362 if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5363 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5364 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5365 else
5366 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5367 endif
5368
5369 endif
5370
5371
5372 if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
5373 jphase(ibin) = jtotal
5374 endif
5375
5376
5377
5378 return
5379 end subroutine ASTEM_flux_mix_case3a
5380
5381
5382
5383
5384
5385
5386
5387
5388 !------------------------------------------------------------------
5389 ! Mix Case 3b: NH4Cl solid maybe active. NH4NO3 aq may or maybe active
5390
5391 subroutine ASTEM_flux_mix_case3b(ibin) ! TOUCH
5392 ! implicit none
5393 ! include 'mosaic.h'
5394 ! subr arguments
5395 integer ibin
5396 ! local variables
5397 integer iactive_nh4no3, iactive_nh4cl
5398
5399
5400 ! set default values for flags
5401 iactive_nh4cl = mYES
5402 iactive_nh4no3 = mYES
5403
5404
5405 ! nh4cl (solid)
5406 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
5407 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
5408
5409 ! nh4no3 (liquid)
5410 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5411 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
5412
5413
5414 !-------------------
5415 ! now determine if nh4no3 and/or nh4cl are active or significant
5416 ! nh4cl (solid)
5417 if( abs(phi_nh4cl_s) .le. rtol_eqb_ASTEM )then
5418 iactive_nh4cl = mNO
5419 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
5420 epercent(jnh4cl,jsolid,ibin) .le. ptol_mol_ASTEM)then
5421 iactive_nh4cl = mNO
5422 if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0)then
5423 call degas_solid_nh4cl(ibin)
5424 endif
5425 endif
5426
5427 ! nh4no3 (liquid)
5428 if( gas(inh3_g)*gas(ihno3_g).eq.0. .or. Keq_nh4no3.eq.0. )then
5429 iactive_nh4no3 = mNO
5430 endif
5431
5432
5433 !---------------------------------
5434 if(iactive_nh4cl .eq. mYES)then
5435
5436 jphase(ibin) = jsolid
5437 call ASTEM_flux_dry_case4b(ibin) ! NH4Cl (solid)
5438
5439 if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5440 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5441 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5442 elseif(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5443 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5444 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5445 else
5446 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5447 endif
5448
5449 endif
5450
5451
5452 if(iactive_nh4no3 .eq. mYES)then
5453
5454 jphase(ibin) = jliquid
5455 call ASTEM_flux_wet_case3a(ibin) ! NH4NO3 (liquid)
5456
5457 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5458 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5459 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5460 else
5461 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5462 endif
5463
5464 endif
5465
5466
5467 if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
5468 jphase(ibin) = jtotal
5469 endif
5470
5471
5472
5473 return
5474 end subroutine ASTEM_flux_mix_case3b
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486 !***********************************************************************
5487 ! part of ASTEM: condenses h2so4, msa, and nh3 analytically over dtchem [s]
5488 !
5489 ! author: Rahul A. Zaveri
5490 ! update: jan 2007
5491 !-----------------------------------------------------------------------
5492
5493 subroutine ASTEM_non_volatiles(dtchem) ! TOUCH
5494 ! implicit none
5495 ! include 'mosaic.h'
5496 ! subr arguments
5497 real(kind=8) dtchem
5498 ! local variables
5499 integer ibin, iupdate_phase_state
5500 real(kind=8) decay_h2so4, decay_msa, &
5501 delta_h2so4, delta_tmsa, delta_nh3, delta_hno3, delta_hcl, &
5502 delta_so4(nbin_a), delta_msa(nbin_a), &
5503 delta_nh4(nbin_a)
5504 real(kind=8) XT
5505
5506
5507
5508
5509 sumkg_h2so4 = 0.0
5510 sumkg_msa = 0.0
5511 sumkg_nh3 = 0.0
5512 sumkg_hno3 = 0.0
5513 sumkg_hcl = 0.0
5514 do ibin = 1, nbin_a
5515 sumkg_h2so4 = sumkg_h2so4 + kg(ih2so4_g,ibin)
5516 sumkg_msa = sumkg_msa + kg(imsa_g,ibin)
5517 sumkg_nh3 = sumkg_nh3 + kg(inh3_g,ibin)
5518 sumkg_hno3 = sumkg_hno3 + kg(ihno3_g,ibin)
5519 sumkg_hcl = sumkg_hcl + kg(ihcl_g,ibin)
5520 enddo
5521
5522
5523
5524 !--------------------------------------
5525 ! H2SO4
5526 if(gas(ih2so4_g) .gt. 1.e-14)then
5527
5528 ! integrate h2so4 condensation analytically
5529 decay_h2so4 = exp(-sumkg_h2so4*dtchem)
5530 delta_h2so4 = gas(ih2so4_g)*(1.0 - decay_h2so4)
5531 gas(ih2so4_g) = gas(ih2so4_g)*decay_h2so4
5532
5533
5534 ! now distribute delta_h2so4 to each bin and conform the particle (may degas by massbal)
5535 do ibin = 1, nbin_a
5536 if(jaerosolstate(ibin) .ne. no_aerosol)then
5537 delta_so4(ibin) = delta_h2so4*kg(ih2so4_g,ibin)/sumkg_h2so4
5538 aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
5539 delta_so4(ibin)
5540 endif
5541 enddo
5542
5543 else
5544
5545 delta_h2so4 = 0.0
5546 do ibin = 1, nbin_a
5547 delta_so4(ibin) = 0.0
5548 enddo
5549
5550 endif
5551 ! h2so4 condensation is now complete
5552 !--------------------------------------
5553
5554
5555
5556 ! MSA
5557 if(gas(imsa_g) .gt. 1.e-14)then
5558
5559 ! integrate msa condensation analytically
5560 decay_msa = exp(-sumkg_msa*dtchem)
5561 delta_tmsa = gas(imsa_g)*(1.0 - decay_msa)
5562 gas(imsa_g) = gas(imsa_g)*decay_msa
5563
5564 ! now distribute delta_msa to each bin and conform the particle (may degas by massbal)
5565 do ibin = 1, nbin_a
5566 if(jaerosolstate(ibin) .ne. no_aerosol)then
5567 delta_msa(ibin) = delta_tmsa*kg(imsa_g,ibin)/sumkg_msa
5568 aer(imsa_a,jtotal,ibin) = aer(imsa_a,jtotal,ibin) + &
5569 delta_msa(ibin)
5570 endif
5571 enddo
5572
5573 else
5574
5575 delta_tmsa = 0.0
5576 do ibin = 1, nbin_a
5577 delta_msa(ibin) = 0.0
5578 enddo
5579
5580 endif
5581 ! msa condensation is now complete
5582 !-------------------------------------
5583
5584
5585
5586 ! compute max allowable nh3, hno3, and hcl condensation
5587 delta_nh3 = gas(inh3_g) *(1.0 - exp(-sumkg_nh3*dtchem))
5588 delta_hno3= gas(ihno3_g)*(1.0 - exp(-sumkg_hno3*dtchem))
5589 delta_hcl = gas(ihcl_g) *(1.0 - exp(-sumkg_hcl*dtchem))
5590
5591 ! compute max possible nh4 condensation for each bin
5592 do ibin = 1, nbin_a
5593 if(jaerosolstate(ibin) .ne. no_aerosol)then
5594 delta_nh3_max(ibin) = delta_nh3*kg(inh3_g,ibin)/sumkg_nh3
5595 delta_hno3_max(ibin)= delta_hno3*kg(ihno3_g,ibin)/sumkg_hno3
5596 delta_hcl_max(ibin) = delta_hcl*kg(ihcl_g,ibin)/sumkg_hcl
5597 endif
5598 enddo
5599
5600
5601 if(delta_h2so4 .eq. 0.0 .and. delta_tmsa .eq. 0.0)then
5602 iupdate_phase_state = mNO
5603 goto 100
5604 endif
5605
5606
5607 ! now condense appropriate amounts of nh3 to each bin
5608 do ibin = 1, nbin_a
5609
5610 if(epercent(jnacl,jtotal,ibin) .eq. 0.0 .and. &
5611 epercent(jcacl2,jtotal,ibin) .eq. 0.0 .and. &
5612 epercent(jnano3,jtotal,ibin) .eq. 0.0 .and. &
5613 epercent(jcano3,jtotal,ibin) .eq. 0.0 .and. &
5614 epercent(jcaco3,jtotal,ibin) .eq. 0.0 .and. &
5615 jaerosolstate(ibin) .ne. no_aerosol)then
5616
5617 delta_nh4(ibin)=min( (2.*delta_so4(ibin)+delta_msa(ibin)), &
5618 delta_nh3_max(ibin) )
5619
5620 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) + & ! update aer-phase
5621 delta_nh4(ibin)
5622
5623 gas(inh3_g) = gas(inh3_g) - delta_nh4(ibin) ! update gas-phase
5624
5625 else
5626
5627 delta_nh4(ibin) = 0.0
5628
5629 endif
5630
5631 enddo
5632
5633 iupdate_phase_state = mYES
5634
5635
5636 ! recompute phase equilibrium
5637 100 if(iupdate_phase_state .eq. mYES)then
5638 do ibin = 1, nbin_a
5639 if(jaerosolstate(ibin) .ne. no_aerosol)then
5640 call conform_electrolytes(jtotal,ibin,XT)
5641 call aerosol_phase_state(ibin)
5642 endif
5643 enddo
5644 endif
5645
5646 return
5647 end subroutine ASTEM_non_volatiles
5648
5649
5650
5651
5652
5653
5654
5655 !***********************************************************************
5656 ! computes mass transfer coefficients for each condensing species for
5657 ! all the aerosol bins
5658 !
5659 ! author: rahul a. zaveri
5660 ! update: jan 2005
5661 !-----------------------------------------------------------------------
5662 subroutine aerosolmtc
5663
5664 use module_data_mosaic_asect
5665
5666 ! implicit none
5667 ! include 'v33com9a'
5668 ! include 'mosaic.h'
5669 ! local variables
5670 integer nghq
5671 parameter (nghq = 2) ! gauss-hermite quadrature order
5672 integer ibin, iq, iv
5673 real(kind=8) tworootpi, root2, beta
5674 parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
5675 real(kind=8) cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed, &
5676 sumghq
5677 real(kind=8) xghq(nghq), wghq(nghq) ! quadrature abscissae and weights
5678 real(kind=8) mw_vol(ngas_volatile), v_molar(ngas_volatile), & ! mw and molar vols of volatile species
5679 freepath(ngas_volatile), accom(ngas_volatile), &
5680 dg(ngas_volatile) ! keep local
5681 ! real(kind=8) fuchs_sutugin ! mosaic func
5682 ! real(kind=8) gas_diffusivity ! mosaic func
5683 ! real(kind=8) mean_molecular_speed ! mosaic func
5684
5685
5686
5687
5688
5689 ! molecular weights
5690 mw_vol(ih2so4_g) = 98.0
5691 mw_vol(ihno3_g) = 63.0
5692 mw_vol(ihcl_g) = 36.5
5693 mw_vol(inh3_g) = 17.0
5694 mw_vol(imsa_g) = 96.0
5695 mw_vol(iaro1_g) = 150.0
5696 mw_vol(iaro2_g) = 150.0
5697 mw_vol(ialk1_g) = 140.0
5698 mw_vol(iole1_g) = 140.0
5699 mw_vol(iapi1_g) = 184.0
5700 mw_vol(iapi2_g) = 184.0
5701 mw_vol(ilim1_g) = 200.0
5702 mw_vol(ilim2_g) = 200.0
5703
5704 v_molar(ih2so4_g)= 42.88
5705 v_molar(ihno3_g) = 24.11
5706 v_molar(ihcl_g) = 21.48
5707 v_molar(inh3_g) = 14.90
5708 v_molar(imsa_g) = 58.00
5709
5710 ! mass accommodation coefficients
5711 accom(ih2so4_g) = 0.1
5712 accom(ihno3_g) = 0.1
5713 accom(ihcl_g) = 0.1
5714 accom(inh3_g) = 0.1
5715 accom(imsa_g) = 0.1
5716 accom(iaro1_g) = 0.1
5717 accom(iaro2_g) = 0.1
5718 accom(ialk1_g) = 0.1
5719 accom(iole1_g) = 0.1
5720 accom(iapi1_g) = 0.1
5721 accom(iapi2_g) = 0.1
5722 accom(ilim1_g) = 0.1
5723 accom(ilim2_g) = 0.1
5724
5725 ! quadrature weights
5726 xghq(1) = 0.70710678
5727 xghq(2) = -0.70710678
5728 wghq(1) = 0.88622693
5729 wghq(2) = 0.88622693
5730
5731
5732
5733 ! calculate gas diffusivity and mean free path for condensing gases
5734 ! ioa
5735 do iv = 1, ngas_ioa
5736 speed = mean_molecular_speed(t_k,mw_vol(iv)) ! cm/s
5737 dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
5738 freepath(iv) = 3.*dg(iv)/speed ! cm
5739 enddo
5740
5741 ! soa
5742 do iv = iaro1_g, ngas_volatile
5743 speed = mean_molecular_speed(t_k,mw_vol(iv)) ! cm/s
5744 dg(iv) = 0.02 ! cm^2/s
5745 freepath(iv) = 3.*dg(iv)/speed
5746 enddo
5747
5748
5749 ! calc mass transfer coefficients for gases over various aerosol bins
5750
5751 if (msize_framework .eq. mmodal) then
5752
5753 ! for modal approach
5754 do 10 ibin = 1, nbin_a
5755
5756 if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
5757 call calc_dry_n_wet_aerosol_props(ibin)
5758
5759 dpgn_a(ibin) = dp_wet_a(ibin) ! cm
5760
5761 lnsg = log(sigmag_a(ibin))
5762 lndpgn = log(dpgn_a(ibin))
5763 cdum = tworootpi*num_a(ibin)* &
5764 exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
5765
5766 do 20 iv = 1, ngas_volatile
5767
5768 sumghq = 0.0
5769 do 30 iq = 1, nghq ! sum over gauss-hermite quadrature points
5770 lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
5771 dp = exp(lndp)
5772 kn = 2.*freepath(iv)/dp
5773 fkn = fuchs_sutugin(kn,accom(iv))
5774 sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
5775 30 continue
5776
5777 kg(iv,ibin) = cdum*dg(iv)*sumghq ! 1/s
5778 20 continue
5779 10 continue
5780
5781 elseif(msize_framework .eq. msection)then
5782
5783 ! for sectional approach
5784 do 11 ibin = 1, nbin_a
5785
5786 if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
5787
5788 call calc_dry_n_wet_aerosol_props(ibin)
5789
5790 dp_avg = dp_wet_a(ibin)
5791 cdum = 6.283185*dp_avg*num_a(ibin)
5792
5793 do 21 iv = 1, ngas_volatile
5794 kn = 2.*freepath(iv)/dp_avg
5795 fkn = fuchs_sutugin(kn,accom(iv))
5796 kg(iv,ibin) = cdum*dg(iv)*fkn ! 1/s
5797 21 continue
5798
5799 11 continue
5800
5801 else
5802
5803 if (iprint_mosaic_fe1 .gt. 0) then
5804 write(6,*)'error in the choice of msize_framework'
5805 write(6,*)'mosaic fatal error in subr. aerosolmtc'
5806 endif
5807 ! stop
5808 istat_mosaic_fe1 = -1900
5809 return
5810
5811 endif
5812
5813
5814 return
5815 end subroutine aerosolmtc
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828 !***********************************************************************
5829 ! calculates dry and wet aerosol properties: density, refractive indices
5830 !
5831 ! author: rahul a. zaveri
5832 ! update: jan 2005
5833 !-----------------------------------------------------------------------
5834 subroutine calc_dry_n_wet_aerosol_props(ibin)
5835
5836 use module_data_mosaic_asect
5837
5838 ! implicit none
5839 ! include 'v33com9a'
5840 ! include 'mosaic.h'
5841 ! subr arguments
5842 integer ibin
5843 ! local variables
5844 integer jc, je, iaer, isize, itype
5845 real(kind=8) aer_H
5846 complex(kind=8) ri_dum
5847
5848
5849 ! calculate dry mass and dry volume of a bin
5850 mass_dry_a(ibin) = 0.0 ! initialize to 0.0
5851 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
5852 area_dry_a(ibin) = 0.0 ! initialize to 0.0
5853
5854 if(jaerosolstate(ibin) .ne. no_aerosol)then
5855
5856 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
5857 aer(ino3_a,jtotal,ibin) + &
5858 aer(icl_a,jtotal,ibin) + &
5859 aer(imsa_a,jtotal,ibin) + &
5860 2.*aer(ico3_a,jtotal,ibin))- &
5861 (2.*aer(ica_a,jtotal,ibin) + &
5862 aer(ina_a,jtotal,ibin) + &
5863 aer(inh4_a,jtotal,ibin))
5864
5865 do iaer = 1, naer
5866 mass_dry_a(ibin) = mass_dry_a(ibin) + &
5867 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
5868 vol_dry_a(ibin) = vol_dry_a(ibin) + &
5869 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
5870 enddo
5871 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
5872 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
5873
5874 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
5875 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air)
5876
5877 ! wet mass and wet volume
5878 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
5879 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air)
5880
5881 ! calculate mean dry and wet particle densities
5882 dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
5883 dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
5884
5885 ! calculate mean dry and wet particle surface areas
5886 area_dry_a(ibin)= 0.785398*num_a(ibin)*Dp_dry_a(ibin)**2 ! cm^2/cc(air)
5887 area_wet_a(ibin)= 0.785398*num_a(ibin)*Dp_wet_a(ibin)**2 ! cm^2/cc(air)
5888
5889 ! calculate mean dry and wet particle diameters
5890 dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
5891 dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
5892
5893 ! calculate volume average refractive index
5894 ! load comp_a array
5895 do je = 1, nelectrolyte
5896 comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5897 enddo
5898 comp_a(joc) = aer(ioc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5899 comp_a(jbc) = aer(ibc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5900 comp_a(join) = aer(ioin_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5901 comp_a(jaro1)= aer(iaro1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5902 comp_a(jaro2)= aer(iaro2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5903 comp_a(jalk1)= aer(ialk1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5904 comp_a(jole1)= aer(iole1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5905 comp_a(japi1)= aer(iapi1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5906 comp_a(japi2)= aer(iapi2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5907 comp_a(jlim1)= aer(ilim1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5908 comp_a(jlim2)= aer(ilim2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5909 comp_a(jh2o) = water_a(ibin)*1.e-3 ! g/cc(air)
5910
5911 ri_dum = (0.0,0.0)
5912 do jc = 1, naercomp
5913 ri_dum = ri_dum + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
5914 enddo
5915
5916 ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
5917
5918 else ! use defaults
5919
5920 dens_dry_a(ibin) = 1.0 ! g/cc(aerosol)
5921 dens_wet_a(ibin) = 1.0 ! g/cc(aerosol)
5922
5923 call isize_itype_from_ibin( ibin, isize, itype )
5924 dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
5925 dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
5926
5927 ri_avg_a(ibin) = (1.5,0.0)
5928 endif
5929
5930
5931 return
5932 end subroutine calc_dry_n_wet_aerosol_props
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953 !***********************************************************************
5954 ! computes activities
5955 !
5956 ! author: rahul a. zaveri
5957 ! update: jan 2005
5958 !-----------------------------------------------------------------------
5959 subroutine compute_activities(ibin)
5960 ! implicit none
5961 ! include 'mosaic.h'
5962 ! subr arguments
5963 integer ibin
5964 ! local variables
5965 integer jp, ja
5966 real(kind=8) xt, xmol(nelectrolyte), sum_elec, dumK, c_bal, a_c
5967 real(kind=8) quad, aq, bq, cq, xq, dum
5968 ! function
5969 ! real(kind=8) aerosol_water
5970
5971
5972 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
5973 if(water_a(ibin) .eq. 0.0)return
5974
5975
5976 call calculate_xt(ibin,jliquid,xt)
5977
5978 if(xt.gt.2.0 .or. xt.lt.0.)then
5979 ! sulfate poor: fully dissociated electrolytes
5980
5981
5982 ! anion molalities (mol/kg water)
5983 ma(ja_so4,ibin) = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
5984 ma(ja_hso4,ibin) = 0.0
5985 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5986 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5987 ma(ja_msa,ibin) = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
5988
5989 ! cation molalities (mol/kg water)
5990 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5991 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5992 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5993 a_c = ( 2.d0*ma(ja_so4,ibin)+ &
5994 ma(ja_no3,ibin)+ &
5995 ma(ja_cl,ibin) + &
5996 ma(ja_msa,ibin) ) - &
5997 ( 2.d0*mc(jc_ca,ibin) + &
5998 mc(jc_nh4,ibin)+ &
5999 mc(jc_na,ibin) )
6000 mc(jc_h,ibin) = 0.5*a_c + sqrt(a_c**2 + 4.*Keq_ll(3))
6001
6002 if(mc(jc_h,ibin) .eq. 0.0)then
6003 mc(jc_h,ibin) = sqrt(Keq_ll(3))
6004 endif
6005
6006
6007 jp = jliquid
6008
6009
6010 sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) + &
6011 2.*electrolyte(jnh4cl,jp,ibin) + &
6012 3.*electrolyte(jnh4so4,jp,ibin) + &
6013 3.*electrolyte(jna2so4,jp,ibin) + &
6014 2.*electrolyte(jnano3,jp,ibin) + &
6015 2.*electrolyte(jnacl,jp,ibin) + &
6016 3.*electrolyte(jcano3,jp,ibin) + &
6017 3.*electrolyte(jcacl2,jp,ibin) + &
6018 2.*electrolyte(jhno3,jp,ibin) + &
6019 2.*electrolyte(jhcl,jp,ibin)
6020
6021 if(sum_elec .eq. 0.0)then
6022 do ja = 1, nelectrolyte
6023 gam(ja,ibin) = 1.0
6024 enddo
6025 goto 10
6026 endif
6027
6028
6029 ! ionic mole fractions
6030 xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
6031 xmol(jnh4cl) = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
6032 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6033 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6034 xmol(jnano3) = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
6035 xmol(jnacl) = 2.*electrolyte(jnacl,jp,ibin) /sum_elec
6036 xmol(jcano3) = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
6037 xmol(jcacl2) = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
6038 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin) /sum_elec
6039 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin) /sum_elec
6040
6041
6042 ja = jnh4so4
6043 if(xmol(ja).gt.0.0)then
6044 log_gam(ja) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6045 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6046 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6047 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6048 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6049 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6050 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6051 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6052 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6053 xmol(jhcl) *log_gamZ(jA,jhcl)
6054 gam(jA,ibin) = 10.**log_gam(jA)
6055 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6056 gam(jnh4so4,ibin)**3
6057 endif
6058
6059
6060
6061 jA = jnh4no3
6062 if(xmol(jA).gt.0.0)then
6063 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6064 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6065 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6066 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6067 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6068 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6069 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6070 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6071 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6072 xmol(jhcl) *log_gamZ(jA,jhcl)
6073 gam(jA,ibin) = 10.**log_gam(jA)
6074 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
6075 gam(jnh4no3,ibin)**2
6076 endif
6077
6078
6079 jA = jnh4cl
6080 if(xmol(jA).gt.0.0)then
6081 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6082 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6083 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6084 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6085 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6086 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6087 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6088 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6089 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6090 xmol(jhcl) *log_gamZ(jA,jhcl)
6091 gam(jA,ibin) = 10.**log_gam(jA)
6092 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin)* &
6093 gam(jnh4cl,ibin)**2
6094 endif
6095
6096
6097 jA = jna2so4
6098 if(xmol(jA).gt.0.0)then
6099 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6100 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6101 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6102 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6103 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6104 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6105 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6106 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6107 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6108 xmol(jhcl) *log_gamZ(jA,jhcl)
6109 gam(jA,ibin) = 10.**log_gam(jA)
6110 activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6111 gam(jna2so4,ibin)**3
6112 endif
6113
6114
6115 jA = jnano3
6116 if(xmol(jA).gt.0.0)then
6117 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6118 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6119 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6120 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6121 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6122 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6123 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6124 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6125 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6126 xmol(jhcl) *log_gamZ(jA,jhcl)
6127 gam(jA,ibin) = 10.**log_gam(jA)
6128 activity(jnano3,ibin) = mc(jc_na,ibin)*ma(ja_no3,ibin)* &
6129 gam(jnano3,ibin)**2
6130 endif
6131
6132
6133
6134 jA = jnacl
6135 if(xmol(jA).gt.0.0)then
6136 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6137 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6138 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6139 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6140 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6141 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6142 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6143 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6144 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6145 xmol(jhcl) *log_gamZ(jA,jhcl)
6146 gam(jA,ibin) = 10.**log_gam(jA)
6147 activity(jnacl,ibin) = mc(jc_na,ibin)*ma(ja_cl,ibin)* &
6148 gam(jnacl,ibin)**2
6149 endif
6150
6151
6152
6153 ! jA = jcano3
6154 ! if(xmol(jA).gt.0.0)then
6155 ! gam(jA,ibin) = 1.0
6156 ! activity(jcano3,ibin) = 1.0
6157 ! endif
6158
6159
6160
6161 ! jA = jcacl2
6162 ! if(xmol(jA).gt.0.0)then
6163 ! gam(jA,ibin) = 1.0
6164 ! activity(jcacl2,ibin) = 1.0
6165 ! endif
6166
6167 jA = jcano3
6168 if(xmol(jA).gt.0.0)then
6169 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6170 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6171 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6172 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6173 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6174 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6175 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6176 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6177 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6178 xmol(jhcl) *log_gamZ(jA,jhcl)
6179 gam(jA,ibin) = 10.**log_gam(jA)
6180 activity(jcano3,ibin) = mc(jc_ca,ibin)*ma(ja_no3,ibin)**2* &
6181 gam(jcano3,ibin)**3
6182 endif
6183
6184
6185
6186 jA = jcacl2
6187 if(xmol(jA).gt.0.0)then
6188 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6189 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6190 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6191 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6192 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6193 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6194 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6195 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6196 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6197 xmol(jhcl) *log_gamZ(jA,jhcl)
6198 gam(jA,ibin) = 10.**log_gam(jA)
6199 activity(jcacl2,ibin) = mc(jc_ca,ibin)*ma(ja_cl,ibin)**2* &
6200 gam(jcacl2,ibin)**3
6201 endif
6202
6203
6204 jA = jhno3
6205 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6206 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6207 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6208 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6209 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6210 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6211 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6212 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6213 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6214 xmol(jhcl) *log_gamZ(jA,jhcl)
6215 gam(jA,ibin) = 10.**log_gam(jA)
6216 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6217 gam(jhno3,ibin)**2
6218
6219
6220 jA = jhcl
6221 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6222 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6223 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6224 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6225 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6226 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6227 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6228 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6229 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6230 xmol(jhcl) *log_gamZ(jA,jhcl)
6231 gam(jA,ibin) = 10.**log_gam(jA)
6232 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6233 gam(jhcl,ibin)**2
6234
6235 !----
6236 10 gam(jlvcite,ibin) = 1.0
6237
6238 gam(jnh4hso4,ibin)= 1.0
6239
6240 gam(jnh4msa,ibin) = 1.0
6241
6242 gam(jna3hso4,ibin) = 1.0
6243
6244 gam(jnahso4,ibin) = 1.0
6245
6246 gam(jnamsa,ibin) = 1.0
6247
6248 activity(jlvcite,ibin) = 0.0
6249
6250 activity(jnh4hso4,ibin)= 0.0
6251
6252 activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6253 gam(jnh4msa,ibin)**2
6254
6255 activity(jna3hso4,ibin)= 0.0
6256
6257 activity(jnahso4,ibin) = 0.0
6258
6259 activity(jnh4msa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
6260 gam(jnamsa,ibin)**2
6261
6262 gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
6263
6264
6265 else
6266 ! SULFATE-RICH: solve for SO4= and HSO4- ions
6267
6268 jp = jliquid
6269
6270 sum_elec = 3.*electrolyte(jh2so4,jp,ibin) + &
6271 2.*electrolyte(jnh4hso4,jp,ibin) + &
6272 5.*electrolyte(jlvcite,jp,ibin) + &
6273 3.*electrolyte(jnh4so4,jp,ibin) + &
6274 2.*electrolyte(jnahso4,jp,ibin) + &
6275 5.*electrolyte(jna3hso4,jp,ibin) + &
6276 3.*electrolyte(jna2so4,jp,ibin) + &
6277 2.*electrolyte(jhno3,jp,ibin) + &
6278 2.*electrolyte(jhcl,jp,ibin)
6279
6280
6281 if(sum_elec .eq. 0.0)then
6282 do jA = 1, nelectrolyte
6283 gam(jA,ibin) = 1.0
6284 enddo
6285 goto 20
6286 endif
6287
6288
6289 xmol(jh2so4) = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
6290 xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
6291 xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
6292 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6293 xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
6294 xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
6295 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6296 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
6297 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
6298
6299
6300 ! 2H.SO4
6301 jA = jh2so4
6302 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6303 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6304 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6305 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6306 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6307 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6308 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6309 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6310 xmol(jhcl) *log_gamZ(jA,jhcl)
6311 gam(jA,ibin) = 10.**log_gam(jA)
6312
6313
6314 ! H.HSO4
6315 jA = jhhso4
6316 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6317 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6318 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6319 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6320 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6321 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6322 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6323 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6324 xmol(jhcl) *log_gamZ(jA,jhcl)
6325 gam(jA,ibin) = 10.**log_gam(jA)
6326
6327
6328 ! NH4HSO4
6329 jA = jnh4hso4
6330 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6331 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6332 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6333 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6334 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6335 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6336 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6337 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6338 xmol(jhcl) *log_gamZ(jA,jhcl)
6339 gam(jA,ibin) = 10.**log_gam(jA)
6340
6341
6342 ! LETOVICITE
6343 jA = jlvcite
6344 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6345 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6346 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6347 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6348 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6349 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6350 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6351 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6352 xmol(jhcl) *log_gamZ(jA,jhcl)
6353 gam(jA,ibin) = 10.**log_gam(jA)
6354
6355
6356 ! (NH4)2SO4
6357 jA = jnh4so4
6358 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6359 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6360 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6361 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6362 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6363 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6364 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6365 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6366 xmol(jhcl) *log_gamZ(jA,jhcl)
6367 gam(jA,ibin) = 10.**log_gam(jA)
6368
6369
6370 ! NaHSO4
6371 jA = jnahso4
6372 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6373 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6374 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6375 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6376 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6377 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6378 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6379 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6380 xmol(jhcl) *log_gamZ(jA,jhcl)
6381 gam(jA,ibin) = 10.**log_gam(jA)
6382
6383
6384 ! Na3H(SO4)2
6385 jA = jna3hso4
6386 ! log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6387 ! xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6388 ! xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6389 ! xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6390 ! xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6391 ! xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6392 ! xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6393 ! xmol(jhno3) *log_gamZ(jA,jhno3) + &
6394 ! xmol(jhcl) *log_gamZ(jA,jhcl)
6395 ! gam(jA,ibin) = 10.**log_gam(jA)
6396 gam(jA,ibin) = 1.0
6397
6398
6399 ! Na2SO4
6400 jA = jna2so4
6401 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6402 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6403 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6404 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6405 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6406 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6407 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6408 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6409 xmol(jhcl) *log_gamZ(jA,jhcl)
6410 gam(jA,ibin) = 10.**log_gam(jA)
6411
6412
6413 ! HNO3
6414 jA = jhno3
6415 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6416 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6417 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6418 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6419 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6420 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6421 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6422 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6423 xmol(jhcl) *log_gamZ(jA,jhcl)
6424 gam(jA,ibin) = 10.**log_gam(jA)
6425
6426
6427 ! HCl
6428 jA = jhcl
6429 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6430 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6431 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6432 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6433 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6434 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6435 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6436 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6437 xmol(jhcl) *log_gamZ(jA,jhcl)
6438 gam(jA,ibin) = 10.**log_gam(jA)
6439
6440
6441 20 gam(jnh4no3,ibin) = 1.0
6442 gam(jnh4cl,ibin) = 1.0
6443 gam(jnano3,ibin) = 1.0
6444 gam(jnacl,ibin) = 1.0
6445 gam(jcano3,ibin) = 1.0
6446 gam(jcacl2,ibin) = 1.0
6447
6448 gam(jnh4msa,ibin) = 1.0
6449 gam(jnamsa,ibin) = 1.0
6450
6451
6452
6453 ! compute equilibrium pH
6454 ! cation molalities (mol/kg water)
6455 mc(jc_ca,ibin) = 0.0 ! aqueous ca never exists in sulfate rich cases
6456 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
6457 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
6458
6459 ! anion molalities (mol/kg water)
6460 mSULF = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
6461 ma(ja_hso4,ibin) = 0.0
6462 ma(ja_so4,ibin) = 0.0
6463 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
6464 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
6465 ma(ja_msa,ibin) = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
6466
6467 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
6468 dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
6469
6470 c_bal = mc(jc_nh4,ibin) + mc(jc_na,ibin) &
6471 - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
6472
6473 aq = 1.0
6474 bq = dumK + c_bal
6475 cq = dumK*(c_bal - mSULF)
6476
6477
6478 !--quadratic solution
6479 if(bq .ne. 0.0)then
6480 xq = 4.*(1./bq)*(cq/bq)
6481 else
6482 xq = 1.e+6
6483 endif
6484
6485 if(abs(xq) .lt. 1.e-6)then
6486 dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
6487 quad = (-0.5*bq/aq)*dum
6488 if(quad .lt. 0.)then
6489 quad = -bq/aq - quad
6490 endif
6491 else
6492 quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
6493 endif
6494 !--end of quadratic solution
6495
6496 mc(jc_h,ibin) = max(quad, 1.D-7)
6497 ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
6498 ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
6499
6500
6501 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6502 gam(jnh4so4,ibin)**3
6503
6504 activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3*ma(ja_hso4,ibin)* &
6505 ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
6506
6507 activity(jnh4hso4,ibin)= mc(jc_nh4,ibin)*ma(ja_hso4,ibin)* &
6508 gam(jnh4hso4,ibin)**2
6509
6510 activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6511 gam(jnh4msa,ibin)**2
6512
6513 activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6514 gam(jna2so4,ibin)**3
6515
6516 activity(jnahso4,ibin) = mc(jc_na,ibin)*ma(ja_hso4,ibin)* &
6517 gam(jnahso4,ibin)**2
6518
6519 activity(jnamsa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
6520 gam(jnamsa,ibin)**2
6521
6522 ! activity(jna3hso4,ibin)= mc(jc_na,ibin)**3*ma(ja_hso4,ibin)* &
6523 ! ma(ja_so4,ibin)*gam(jna3hso4,ibin)**5
6524
6525 activity(jna3hso4,ibin)= 0.0
6526
6527 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6528 gam(jhno3,ibin)**2
6529
6530 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6531 gam(jhcl,ibin)**2
6532
6533 activity(jmsa,ibin) = mc(jc_h,ibin)*ma(ja_msa,ibin)* &
6534 gam(jmsa,ibin)**2
6535
6536
6537 ! sulfate-poor species
6538 activity(jnh4no3,ibin) = 0.0
6539
6540 activity(jnh4cl,ibin) = 0.0
6541
6542 activity(jnano3,ibin) = 0.0
6543
6544 activity(jnacl,ibin) = 0.0
6545
6546 activity(jcano3,ibin) = 0.0
6547
6548 activity(jcacl2,ibin) = 0.0
6549
6550
6551 endif
6552
6553
6554
6555
6556 return
6557 end subroutine compute_activities
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570 !***********************************************************************
6571 ! computes mtem ternary parameters only once per transport time-step
6572 ! for a given ah2o (= rh)
6573 !
6574 ! author: rahul a. zaveri
6575 ! update: jan 2005
6576 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
6577 ! a new method for multicomponent activity coefficients of electrolytes
6578 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
6579 !-----------------------------------------------------------------------
6580 subroutine mtem_compute_log_gamz
6581 ! implicit none
6582 ! include 'mosaic.h'
6583 ! local variables
6584 integer ja
6585 ! functions
6586 ! real(kind=8) fnlog_gamz, bin_molality
6587
6588
6589 ! sulfate-poor species
6590 ja = jhno3
6591 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6592 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6593 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6594 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6595 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6596 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6597 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6598 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6599 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6600 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6601 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6602 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6603 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6604 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6605 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6606
6607
6608 ja = jhcl
6609 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6610 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6611 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6612 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6613 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6614 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6615 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6616 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6617 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6618 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6619 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6620 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6621 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6622 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6623 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6624
6625
6626 ja = jnh4so4
6627 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6628 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6629 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6630 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6631 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6632 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6633 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6634 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6635 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6636 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6637 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6638 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6639 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6640 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6641 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6642
6643
6644 ja = jnh4no3
6645 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6646 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6647 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6648 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6649 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6650 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6651 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6652 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6653 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6654 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6655
6656
6657 ja = jnh4cl
6658 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6659 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6660 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6661 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6662 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6663 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6664 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6665 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6666 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6667 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6668
6669
6670 ja = jna2so4
6671 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6672 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6673 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6674 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6675 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6676 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6677 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6678 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6679 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6680 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6681 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6682 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6683 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6684 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6685 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6686
6687
6688 ja = jnano3
6689 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6690 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6691 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6692 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6693 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6694 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6695 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6696 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6697 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6698 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6699
6700
6701 ja = jnacl
6702 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6703 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6704 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6705 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6706 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6707 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6708 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6709 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6710 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6711 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6712
6713
6714 ja = jcano3
6715 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6716 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6717 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6718 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6719 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6720 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6721 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6722 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6723 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6724 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6725
6726
6727 ja = jcacl2
6728 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6729 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6730 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6731 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6732 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6733 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6734 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6735 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6736 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6737 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6738
6739
6740 ! sulfate-rich species
6741 ja = jh2so4
6742 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6743 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6744 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6745 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6746 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6747 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6748 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6749 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6750 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6751
6752
6753 ja = jhhso4
6754 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6755 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6756 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6757 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6758 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6759 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6760 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6761 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6762 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6763
6764
6765 ja = jnh4hso4
6766 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6767 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6768 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6769 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6770 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6771 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6772 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6773 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6774 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6775
6776
6777 ja = jlvcite
6778 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6779 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6780 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6781 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6782 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6783 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6784 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6785 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6786 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6787
6788
6789 ja = jnahso4
6790 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6791 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6792 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6793 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6794 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6795 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6796 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6797 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6798 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6799
6800
6801 ja = jna3hso4
6802 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6803 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6804 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6805 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6806 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6807 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6808 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6809 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6810 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6811
6812 return
6813 end subroutine mtem_compute_log_gamz
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842 !***********************************************************************
6843 ! computes sulfate ratio
6844 !
6845 ! author: rahul a. zaveri
6846 ! update: dec 1999
6847 !-----------------------------------------------------------------------
6848 subroutine calculate_xt(ibin,jp,xt)
6849 ! implicit none
6850 ! include 'mosaic.h'
6851 ! subr arguments
6852 integer ibin, jp
6853 real(kind=8) xt
6854
6855
6856 if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
6857 xt = ( aer(inh4_a,jp,ibin) + &
6858 & aer(ina_a,jp,ibin) + &
6859 & 2.*aer(ica_a,jp,ibin) )/ &
6860 & (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
6861 else
6862 xt = -1.0
6863 endif
6864
6865
6866 return
6867 end subroutine calculate_xt
6868
6869
6870
6871
6872
6873 !***********************************************************************
6874 ! computes ions from electrolytes
6875 !
6876 ! author: rahul a. zaveri
6877 ! update: jan 2005
6878 !-----------------------------------------------------------------------
6879 subroutine electrolytes_to_ions(jp,ibin)
6880 ! implicit none
6881 ! include 'mosaic.h'
6882 ! subr arguments
6883 integer jp, ibin
6884 ! local variables
6885 real(kind=8) sum_dum
6886
6887
6888 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
6889 electrolyte(jna2so4,jp,ibin) + &
6890 2.*electrolyte(jna3hso4,jp,ibin)+ &
6891 electrolyte(jnahso4,jp,ibin) + &
6892 electrolyte(jnh4so4,jp,ibin) + &
6893 2.*electrolyte(jlvcite,jp,ibin) + &
6894 electrolyte(jnh4hso4,jp,ibin)+ &
6895 electrolyte(jh2so4,jp,ibin)
6896
6897 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
6898 2.*electrolyte(jcano3,jp,ibin) + &
6899 electrolyte(jnh4no3,jp,ibin) + &
6900 electrolyte(jhno3,jp,ibin)
6901
6902 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
6903 2.*electrolyte(jcacl2,jp,ibin) + &
6904 electrolyte(jnh4cl,jp,ibin) + &
6905 electrolyte(jhcl,jp,ibin)
6906
6907 aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) + &
6908 electrolyte(jnamsa,jp,ibin) + &
6909 2.*electrolyte(jcamsa2,jp,ibin) + &
6910 electrolyte(jmsa,jp,ibin)
6911
6912 aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
6913
6914 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
6915 electrolyte(jcano3,jp,ibin) + &
6916 electrolyte(jcacl2,jp,ibin) + &
6917 electrolyte(jcaco3,jp,ibin) + &
6918 electrolyte(jcamsa2,jp,ibin)
6919
6920 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
6921 electrolyte(jnacl,jp,ibin) + &
6922 2.*electrolyte(jna2so4,jp,ibin) + &
6923 3.*electrolyte(jna3hso4,jp,ibin)+ &
6924 electrolyte(jnahso4,jp,ibin) + &
6925 electrolyte(jnamsa,jp,ibin)
6926
6927 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
6928 electrolyte(jnh4cl,jp,ibin) + &
6929 2.*electrolyte(jnh4so4,jp,ibin) + &
6930 3.*electrolyte(jlvcite,jp,ibin) + &
6931 electrolyte(jnh4hso4,jp,ibin)+ &
6932 electrolyte(jnh4msa,jp,ibin)
6933
6934
6935 sum_dum = aer(ica_a,jp,ibin) + &
6936 aer(ina_a,jp,ibin) + &
6937 aer(inh4_a,jp,ibin)+ &
6938 aer(iso4_a,jp,ibin)+ &
6939 aer(ino3_a,jp,ibin)+ &
6940 aer(icl_a,jp,ibin) + &
6941 aer(imsa_a,jp,ibin)+ &
6942 aer(ico3_a,jp,ibin)
6943
6944 if(sum_dum .eq. 0.)sum_dum = 1.0
6945 aer_sum(jp,ibin) = sum_dum
6946
6947 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
6948 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
6949 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
6950 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
6951 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
6952 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
6953 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
6954 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
6955
6956
6957 return
6958 end subroutine electrolytes_to_ions
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969 !***********************************************************************
6970 ! combinatorial method for computing electrolytes from ions
6971 !
6972 ! notes:
6973 ! - to be used for liquid-phase or total-phase only
6974 ! - transfers caso4 and caco3 from liquid to solid phase
6975 !
6976 ! author: rahul a. zaveri (based on code provided by a.s. wexler
6977 ! update: apr 2005
6978 !-----------------------------------------------------------------------
6979 subroutine ions_to_electrolytes(jp,ibin,xt)
6980 ! implicit none
6981 ! include 'mosaic.h'
6982 ! subr arguments
6983 integer ibin, jp
6984 real(kind=8) xt
6985 ! local variables
6986 integer iaer, je, jc, ja, icase
6987 real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4, &
6988 f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
6989 real(kind=8) nc(ncation), na(nanion)
6990
6991
6992
6993
6994 if(jp .ne. jliquid)then
6995 if (iprint_mosaic_fe1 .gt. 0) then
6996 write(6,*)' jp must be jliquid'
6997 write(6,*)' in ions_to_electrolytes sub'
6998 write(6,*)' wrong jp = ', jp
6999 write(6,*)' mosaic fatal error in ions_to_electrolytes'
7000 endif
7001 ! stop
7002 istat_mosaic_fe1 = -2000
7003 return
7004 endif
7005
7006 ! remove negative concentrations, if any
7007 do iaer = 1, naer
7008 aer(iaer,jp,ibin) = max(0.0D0, aer(iaer,jp,ibin))
7009 enddo
7010
7011
7012 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
7013 store(ica_a) = aer(ica_a, jp,ibin)
7014 store(iso4_a) = aer(iso4_a,jp,ibin)
7015
7016 call form_caso4(store,jp,ibin)
7017
7018 if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
7019 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) - &
7020 electrolyte(jcaso4,jliquid,ibin)
7021
7022 aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)- &
7023 electrolyte(jcaso4,jliquid,ibin)
7024
7025 aer(ica_a,jsolid,ibin) = aer(ica_a,jsolid,ibin) + &
7026 electrolyte(jcaso4,jliquid,ibin)
7027
7028 aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) + &
7029 electrolyte(jcaso4,jliquid,ibin)
7030
7031 electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
7032 +electrolyte(jcaso4,jliquid,ibin)
7033 electrolyte(jcaso4,jliquid,ibin)= 0.0
7034 endif
7035
7036
7037 ! calculate sulfate ratio
7038 call calculate_xt(ibin,jp,xt)
7039
7040 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7041 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7042 else
7043 icase = 2 ! acidic (acidity is caused by excess so4)
7044 endif
7045
7046
7047 ! initialize to zero
7048 do je = 1, nelectrolyte
7049 electrolyte(je,jp,ibin) = 0.0
7050 enddo
7051 !
7052 !---------------------------------------------------------
7053 ! initialize moles of ions depending on the sulfate domain
7054
7055 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
7056
7057 na(ja_hso4)= 0.0
7058 na(ja_so4) = aer(iso4_a,jp,ibin)
7059 na(ja_no3) = aer(ino3_a,jp,ibin)
7060 na(ja_cl) = aer(icl_a, jp,ibin)
7061 na(ja_msa) = aer(imsa_a,jp,ibin)
7062
7063 nc(jc_ca) = aer(ica_a, jp,ibin)
7064 nc(jc_na) = aer(ina_a, jp,ibin)
7065 nc(jc_nh4) = aer(inh4_a,jp,ibin)
7066
7067 cat_net =&
7068 ( 2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) )- &
7069 ( 2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
7070
7071 if(cat_net .lt. 0.0)then
7072
7073 nc(jc_h) = 0.0
7074
7075 else ! cat_net must be 0.0 or positive
7076
7077 nc(jc_h) = cat_net
7078
7079 endif
7080
7081
7082 ! now compute equivalent fractions
7083 sum_naza = 0.0
7084 do ja = 1, nanion
7085 sum_naza = sum_naza + na(ja)*za(ja)
7086 enddo
7087
7088 sum_nczc = 0.0
7089 do jc = 1, ncation
7090 sum_nczc = sum_nczc + nc(jc)*zc(jc)
7091 enddo
7092
7093 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
7094 if (iprint_mosaic_diag1 .gt. 0) then
7095 write(6,*)'mosaic ions_to_electrolytes'
7096 write(6,*)'ionic concentrations are zero'
7097 write(6,*)'sum_naza = ', sum_naza
7098 write(6,*)'sum_nczc = ', sum_nczc
7099 endif
7100 return
7101 endif
7102
7103 do ja = 1, nanion
7104 xeq_a(ja) = na(ja)*za(ja)/sum_naza
7105 enddo
7106
7107 do jc = 1, ncation
7108 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
7109 enddo
7110
7111 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
7112 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
7113 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
7114 na_ma(ja_msa) = na(ja_msa) *mw_a(ja_msa)
7115 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
7116
7117 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
7118 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
7119 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
7120 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
7121
7122
7123 ! now compute electrolyte moles
7124 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7125 electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
7126 xeq_a(ja_so4)*nc_mc(jc_na))/ &
7127 mw_electrolyte(jna2so4)
7128 endif
7129
7130 electrolyte(jnahso4,jp,ibin) = 0.0
7131
7132 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7133 electrolyte(jnamsa,jp,ibin) = (xeq_c(jc_na) *na_Ma(ja_msa) + &
7134 xeq_a(ja_msa)*nc_Mc(jc_na))/ &
7135 mw_electrolyte(jnamsa)
7136 endif
7137
7138 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7139 electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
7140 xeq_a(ja_no3)*nc_mc(jc_na))/ &
7141 mw_electrolyte(jnano3)
7142 endif
7143
7144 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7145 electrolyte(jnacl, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) + &
7146 xeq_a(ja_cl) *nc_mc(jc_na))/ &
7147 mw_electrolyte(jnacl)
7148 endif
7149
7150 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7151 electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
7152 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
7153 mw_electrolyte(jnh4so4)
7154 endif
7155
7156 electrolyte(jnh4hso4,jp,ibin)= 0.0
7157
7158 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7159 electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) + &
7160 xeq_a(ja_msa)*nc_Mc(jc_nh4))/ &
7161 mw_electrolyte(jnh4msa)
7162 endif
7163
7164 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7165 electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
7166 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
7167 mw_electrolyte(jnh4no3)
7168 endif
7169
7170 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7171 electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
7172 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
7173 mw_electrolyte(jnh4cl)
7174 endif
7175
7176 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
7177 electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
7178 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
7179 mw_electrolyte(jcano3)
7180 endif
7181
7182 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7183 electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
7184 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
7185 mw_electrolyte(jcacl2)
7186 endif
7187
7188 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7189 electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) + &
7190 xeq_a(ja_msa) *nc_Mc(jc_ca))/ &
7191 mw_electrolyte(jcamsa2)
7192 endif
7193
7194 electrolyte(jh2so4, jp,ibin) = 0.0
7195
7196 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7197 electrolyte(jhno3, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_no3) + &
7198 xeq_a(ja_no3)*nc_mc(jc_h))/ &
7199 mw_electrolyte(jhno3)
7200 endif
7201
7202 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7203 electrolyte(jhcl, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) + &
7204 xeq_a(ja_cl)*nc_mc(jc_h))/ &
7205 mw_electrolyte(jhcl)
7206 endif
7207
7208 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7209 electrolyte(jmsa,jp,ibin) = (xeq_c(jc_h) *na_ma(ja_msa) + &
7210 xeq_a(ja_msa)*nc_mc(jc_h))/ &
7211 mw_electrolyte(jmsa)
7212 endif
7213
7214 !--------------------------------------------------------------------
7215
7216 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
7217
7218 store(imsa_a) = aer(imsa_a,jp,ibin)
7219 store(ica_a) = aer(ica_a, jp,ibin)
7220
7221 call form_camsa2(store,jp,ibin)
7222
7223 sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
7224
7225 if(sum_na_nh4 .gt. 0.0)then
7226 f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
7227 f_na = aer(ina_a,jp,ibin)/sum_na_nh4
7228 else
7229 f_nh4 = 0.0
7230 f_na = 0.0
7231 endif
7232
7233 ! first form msa electrolytes
7234 if(sum_na_nh4 .gt. store(imsa_a))then
7235 electrolyte(jnamsa,jp,ibin) = f_na *store(imsa_a)
7236 electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
7237 rem_na = aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin) ! remaining na
7238 rem_nh4= aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin) ! remaining nh4
7239 else
7240 electrolyte(jnamsa,jp,ibin) = aer(ina_a,jp,ibin)
7241 electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
7242 electrolyte(jmsa,jp,ibin) = store(imsa_a) - sum_na_nh4
7243 rem_nh4 = 0.0 ! remaining nh4
7244 rem_na = 0.0 ! remaining na
7245 endif
7246
7247
7248 ! recompute xt
7249 if(aer(iso4_a,jp,ibin).gt.0.0)then
7250 xt = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
7251 else
7252 goto 10
7253 endif
7254
7255 if(xt .le. 1.0)then ! h2so4 + bisulfate
7256 xh = (1.0 - xt)
7257 xb = xt
7258 electrolyte(jh2so4,jp,ibin) = xh*aer(iso4_a,jp,ibin)
7259 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7260 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
7261 elseif(xt .le. 1.5)then ! bisulfate + letovicite
7262 xb = 3.0 - 2.0*xt
7263 xl = xt - 1.0
7264 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7265 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
7266 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
7267 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7268 else ! letovicite + sulfate
7269 xl = 2.0 - xt
7270 xs = 2.0*xt - 3.0
7271 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
7272 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7273 electrolyte(jnh4so4,jp,ibin) = xs*f_nh4*aer(iso4_a,jp,ibin)
7274 electrolyte(jna2so4,jp,ibin) = xs*f_na *aer(iso4_a,jp,ibin)
7275 endif
7276
7277 electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
7278 electrolyte(jhcl,jp,ibin) = aer(icl_a,jp,ibin)
7279
7280 endif
7281 !---------------------------------------------------------
7282 !
7283 ! calculate % composition
7284 10 sum_dum = 0.0
7285 do je = 1, nelectrolyte
7286 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7287 enddo
7288
7289 if(sum_dum .eq. 0.)sum_dum = 1.0
7290 electrolyte_sum(jp,ibin) = sum_dum
7291
7292 do je = 1, nelectrolyte
7293 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7294 enddo
7295
7296 sum_dum = aer(ica_a,jp,ibin) + &
7297 aer(ina_a,jp,ibin) + &
7298 aer(inh4_a,jp,ibin)+ &
7299 aer(iso4_a,jp,ibin)+ &
7300 aer(ino3_a,jp,ibin)+ &
7301 aer(icl_a,jp,ibin) + &
7302 aer(imsa_a,jp,ibin)+ &
7303 aer(ico3_a,jp,ibin)
7304
7305 if(sum_dum .eq. 0.)sum_dum = 1.0
7306 aer_sum(jp,ibin) = sum_dum
7307
7308 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7309 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7310 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7311 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7312 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7313 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7314 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7315 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7316
7317
7318
7319 return
7320 end subroutine ions_to_electrolytes
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348 !***********************************************************************
7349 ! conforms aerosol generic species to a valid electrolyte composition
7350 !
7351 ! author: rahul a. zaveri
7352 ! update: june 2000
7353 !-----------------------------------------------------------------------
7354 subroutine conform_electrolytes(jp,ibin,xt)
7355 ! implicit none
7356 ! include 'mosaic.h'
7357 ! subr arguments
7358 integer ibin, jp
7359 real(kind=8) xt
7360 ! local variables
7361 integer i, ixt_case, je
7362 real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7363 real(kind=8) store(naer)
7364
7365 ! remove negative concentrations, if any
7366 do i=1,naer
7367 aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7368 enddo
7369
7370
7371 call calculate_xt(ibin,jp,xt)
7372
7373 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7374 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7375 else
7376 ixt_case = 2 ! acidic (acidity is caused by excess so4)
7377 endif
7378
7379 ! initialize
7380 !
7381 ! put total aer(*) into store(*)
7382 store(iso4_a) = aer(iso4_a,jp,ibin)
7383 store(ino3_a) = aer(ino3_a,jp,ibin)
7384 store(icl_a) = aer(icl_a, jp,ibin)
7385 store(imsa_a) = aer(imsa_a,jp,ibin)
7386 store(ico3_a) = aer(ico3_a,jp,ibin)
7387 store(inh4_a) = aer(inh4_a,jp,ibin)
7388 store(ina_a) = aer(ina_a, jp,ibin)
7389 store(ica_a) = aer(ica_a, jp,ibin)
7390
7391 do je=1,nelectrolyte
7392 electrolyte(je,jp,ibin) = 0.0
7393 enddo
7394 !
7395 !---------------------------------------------------------
7396 !
7397 if(ixt_case.eq.1)then
7398
7399 ! xt >= 2 : sulfate deficient
7400
7401 call form_caso4(store,jp,ibin)
7402 call form_camsa2(store,jp,ibin)
7403 call form_na2so4(store,jp,ibin)
7404 call form_namsa(store,jp,ibin)
7405 call form_cano3(store,jp,ibin)
7406 call form_nano3(store,jp,ibin)
7407 call form_nacl(store,jp,ibin)
7408 call form_cacl2(store,jp,ibin)
7409 call form_caco3(store,jp,ibin)
7410 call form_nh4so4(store,jp,ibin)
7411 call form_nh4msa(store,jp,ibin)
7412 call form_nh4no3(store,jp,ibin)
7413 call form_nh4cl(store,jp,ibin)
7414 call form_msa(store,jp,ibin)
7415 call degas_hno3(store,jp,ibin)
7416 call degas_hcl(store,jp,ibin)
7417 call degas_nh3(store,jp,ibin)
7418
7419 elseif(ixt_case.eq.2)then
7420
7421 ! xt < 2 : sulfate enough or sulfate excess
7422
7423 call form_caso4(store,jp,ibin)
7424 call form_camsa2(store,jp,ibin)
7425 call form_namsa(store,jp,ibin)
7426 call form_nh4msa(store,jp,ibin)
7427 call form_msa(store,jp,ibin)
7428
7429 if(store(iso4_a).eq.0.0)goto 10
7430
7431
7432 xt_prime =(store(ina_a)+store(inh4_a))/ &
7433 store(iso4_a)
7434 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7435
7436 if(xt_prime.ge.xna_prime)then
7437 call form_na2so4(store,jp,ibin)
7438 xnh4_prime = 0.0
7439 if(store(iso4_a).gt.1.e-15)then
7440 xnh4_prime = store(inh4_a)/store(iso4_a)
7441 endif
7442
7443 if(xnh4_prime .ge. 1.5)then
7444 call form_nh4so4_lvcite(store,jp,ibin)
7445 else
7446 call form_lvcite_nh4hso4(store,jp,ibin)
7447 endif
7448
7449 elseif(xt_prime.ge.1.)then
7450 call form_nh4hso4(store,jp,ibin)
7451 call form_na2so4_nahso4(store,jp,ibin)
7452 elseif(xt_prime.lt.1.)then
7453 call form_nahso4(store,jp,ibin)
7454 call form_nh4hso4(store,jp,ibin)
7455 call form_h2so4(store,jp,ibin)
7456 endif
7457
7458 10 call degas_hno3(store,jp,ibin)
7459 call degas_hcl(store,jp,ibin)
7460 call degas_nh3(store,jp,ibin)
7461
7462 endif ! case 1, 2
7463
7464
7465 ! re-calculate ions to eliminate round-off errors
7466 call electrolytes_to_ions(jp, ibin)
7467 !---------------------------------------------------------
7468 !
7469 ! calculate % composition
7470 sum_dum = 0.0
7471 do je = 1, nelectrolyte
7472 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7473 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7474 enddo
7475
7476 if(sum_dum .eq. 0.)sum_dum = 1.0
7477 electrolyte_sum(jp,ibin) = sum_dum
7478
7479 do je = 1, nelectrolyte
7480 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7481 enddo
7482
7483
7484 sum_dum = aer(ica_a,jp,ibin) + &
7485 aer(ina_a,jp,ibin) + &
7486 aer(inh4_a,jp,ibin)+ &
7487 aer(iso4_a,jp,ibin)+ &
7488 aer(ino3_a,jp,ibin)+ &
7489 aer(icl_a,jp,ibin) + &
7490 aer(imsa_a,jp,ibin)+ &
7491 aer(ico3_a,jp,ibin)
7492
7493 if(sum_dum .eq. 0.)sum_dum = 1.0
7494 aer_sum(jp,ibin) = sum_dum
7495
7496 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7497 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7498 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7499 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7500 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7501 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7502 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7503 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7504
7505 return
7506 end subroutine conform_electrolytes
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518 !***********************************************************************
7519 ! forms electrolytes from ions
7520 !
7521 ! author: rahul a. zaveri
7522 ! update: june 2000
7523 !-----------------------------------------------------------------------
7524 subroutine form_electrolytes(jp,ibin,xt)
7525 ! implicit none
7526 ! include 'mosaic.h'
7527 ! subr arguments
7528 integer ibin, jp
7529 real(kind=8) xt
7530 ! local variables
7531 integer i, ixt_case, j, je
7532 real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7533 real(kind=8) store(naer)
7534
7535 ! remove negative concentrations, if any
7536 do i=1,naer
7537 aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7538 enddo
7539
7540
7541 call calculate_xt(ibin,jp,xt)
7542
7543 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7544 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7545 else
7546 ixt_case = 2 ! acidic (acidity is caused by excess so4)
7547 endif
7548
7549 ! initialize
7550 !
7551 ! put total aer(*) into store(*)
7552 store(iso4_a) = aer(iso4_a,jp,ibin)
7553 store(ino3_a) = aer(ino3_a,jp,ibin)
7554 store(icl_a) = aer(icl_a, jp,ibin)
7555 store(imsa_a) = aer(imsa_a,jp,ibin)
7556 store(ico3_a) = aer(ico3_a,jp,ibin)
7557 store(inh4_a) = aer(inh4_a,jp,ibin)
7558 store(ina_a) = aer(ina_a, jp,ibin)
7559 store(ica_a) = aer(ica_a, jp,ibin)
7560 !
7561 do j=1,nelectrolyte
7562 electrolyte(j,jp,ibin) = 0.0
7563 enddo
7564 !
7565 !---------------------------------------------------------
7566 !
7567 if(ixt_case.eq.1)then
7568
7569 ! xt >= 2 : sulfate deficient
7570 call form_caso4(store,jp,ibin)
7571 call form_camsa2(store,jp,ibin)
7572 call form_na2so4(store,jp,ibin)
7573 call form_namsa(store,jp,ibin)
7574 call form_cano3(store,jp,ibin)
7575 call form_nano3(store,jp,ibin)
7576 call form_nacl(store,jp,ibin)
7577 call form_cacl2(store,jp,ibin)
7578 call form_caco3(store,jp,ibin)
7579 call form_nh4so4(store,jp,ibin)
7580 call form_nh4msa(store,jp,ibin)
7581 call form_nh4no3(store,jp,ibin)
7582 call form_nh4cl(store,jp,ibin)
7583 call form_msa(store,jp,ibin)
7584
7585 if(jp .eq. jsolid)then
7586 call degas_hno3(store,jp,ibin)
7587 call degas_hcl(store,jp,ibin)
7588 call degas_nh3(store,jp,ibin)
7589 else
7590 call form_hno3(store,jp,ibin)
7591 call form_hcl(store,jp,ibin)
7592 call degas_nh3(store,jp,ibin)
7593 endif
7594
7595
7596
7597 elseif(ixt_case.eq.2)then
7598
7599 ! xt < 2 : sulfate enough or sulfate excess
7600
7601 call form_caso4(store,jp,ibin)
7602 call form_camsa2(store,jp,ibin)
7603 call form_namsa(store,jp,ibin)
7604 call form_nh4msa(store,jp,ibin)
7605 call form_msa(store,jp,ibin)
7606
7607 if(store(iso4_a).eq.0.0)goto 10
7608
7609
7610 xt_prime =(store(ina_a)+store(inh4_a))/ &
7611 store(iso4_a)
7612 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7613
7614 if(xt_prime.ge.xna_prime)then
7615 call form_na2so4(store,jp,ibin)
7616 xnh4_prime = 0.0
7617 if(store(iso4_a).gt.1.e-15)then
7618 xnh4_prime = store(inh4_a)/store(iso4_a)
7619 endif
7620
7621 if(xnh4_prime .ge. 1.5)then
7622 call form_nh4so4_lvcite(store,jp,ibin)
7623 else
7624 call form_lvcite_nh4hso4(store,jp,ibin)
7625 endif
7626
7627 elseif(xt_prime.ge.1.)then
7628 call form_nh4hso4(store,jp,ibin)
7629 call form_na2so4_nahso4(store,jp,ibin)
7630 elseif(xt_prime.lt.1.)then
7631 call form_nahso4(store,jp,ibin)
7632 call form_nh4hso4(store,jp,ibin)
7633 call form_h2so4(store,jp,ibin)
7634 endif
7635
7636 10 if(jp .eq. jsolid)then
7637 call degas_hno3(store,jp,ibin)
7638 call degas_hcl(store,jp,ibin)
7639 call degas_nh3(store,jp,ibin)
7640 else
7641 call form_hno3(store,jp,ibin)
7642 call form_hcl(store,jp,ibin)
7643 call degas_nh3(store,jp,ibin)
7644 endif
7645
7646 endif ! case 1, 2
7647
7648
7649 ! re-calculate ions to eliminate round-off errors
7650 call electrolytes_to_ions(jp, ibin)
7651 !---------------------------------------------------------
7652 !
7653 ! calculate % composition
7654 sum_dum = 0.0
7655 do je = 1, nelectrolyte
7656 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7657 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7658 enddo
7659
7660 if(sum_dum .eq. 0.)sum_dum = 1.0
7661 electrolyte_sum(jp,ibin) = sum_dum
7662
7663 do je = 1, nelectrolyte
7664 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7665 enddo
7666
7667 sum_dum = aer(ica_a,jp,ibin) + &
7668 aer(ina_a,jp,ibin) + &
7669 aer(inh4_a,jp,ibin)+ &
7670 aer(iso4_a,jp,ibin)+ &
7671 aer(ino3_a,jp,ibin)+ &
7672 aer(icl_a,jp,ibin) + &
7673 aer(imsa_a,jp,ibin)+ &
7674 aer(ico3_a,jp,ibin)
7675
7676 if(sum_dum .eq. 0.)sum_dum = 1.0
7677 aer_sum(jp,ibin) = sum_dum
7678
7679 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7680 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7681 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7682 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7683 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7684 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7685 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7686 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7687
7688 return
7689 end subroutine form_electrolytes
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704 !***********************************************************************
7705 ! electrolyte formation subroutines
7706 !
7707 ! author: rahul a. zaveri
7708 ! update: june 2000
7709 !-----------------------------------------------------------------------
7710 subroutine form_caso4(store,jp,ibin)
7711 ! implicit none
7712 ! include 'mosaic.h'
7713 ! subr arguments
7714 integer jp, ibin
7715 real(kind=8) store(naer)
7716
7717 electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
7718 store(ica_a) = store(ica_a) - electrolyte(jcaso4,jp,ibin)
7719 store(iso4_a) = store(iso4_a) - electrolyte(jcaso4,jp,ibin)
7720 store(ica_a) = max(0.D0, store(ica_a))
7721 store(iso4_a) = max(0.D0, store(iso4_a))
7722
7723 return
7724 end subroutine form_caso4
7725
7726
7727
7728 subroutine form_camsa2(store,jp,ibin)
7729 ! implicit none
7730 ! include 'mosaic.h'
7731 ! subr arguments
7732 integer jp, ibin
7733 real(kind=8) store(naer)
7734
7735 electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
7736 store(ica_a) = store(ica_a) - electrolyte(jcamsa2,jp,ibin)
7737 store(imsa_a) = store(imsa_a) - 2.d0*electrolyte(jcamsa2,jp,ibin)
7738 store(ica_a) = max(0.D0, store(ica_a))
7739 store(imsa_a) = max(0.D0, store(imsa_a))
7740
7741 return
7742 end subroutine form_camsa2
7743
7744
7745
7746 subroutine form_cano3(store,jp,ibin) ! ca(no3)2
7747 ! implicit none
7748 ! include 'mosaic.h'
7749 ! subr arguments
7750 integer jp, ibin
7751 real(kind=8) store(naer)
7752
7753 electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
7754
7755 store(ica_a) = store(ica_a) - electrolyte(jcano3,jp,ibin)
7756 store(ino3_a) = store(ino3_a) - 2.*electrolyte(jcano3,jp,ibin)
7757 store(ica_a) = max(0.D0, store(ica_a))
7758 store(ino3_a) = max(0.D0, store(ino3_a))
7759
7760 return
7761 end subroutine form_cano3
7762
7763
7764 subroutine form_cacl2(store,jp,ibin)
7765 ! implicit none
7766 ! include 'mosaic.h'
7767 ! subr arguments
7768 integer jp, ibin
7769 real(kind=8) store(naer)
7770
7771 electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
7772
7773 store(ica_a) = store(ica_a) - electrolyte(jcacl2,jp,ibin)
7774 store(icl_a) = store(icl_a) - 2.*electrolyte(jcacl2,jp,ibin)
7775 store(ica_a) = max(0.D0, store(ica_a))
7776 store(icl_a) = max(0.D0, store(icl_a))
7777
7778 return
7779 end subroutine form_cacl2
7780
7781
7782 subroutine form_caco3(store,jp,ibin)
7783 ! implicit none
7784 ! include 'mosaic.h'
7785 ! subr arguments
7786 integer jp, ibin
7787 real(kind=8) store(naer)
7788
7789 if(jp.eq.jtotal .or. jp.eq.jsolid)then
7790 electrolyte(jcaco3,jp,ibin) = store(ica_a)
7791
7792 aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin) ! force co3 = caco3
7793
7794 store(ica_a) = 0.0
7795 store(ico3_a)= 0.0
7796 endif
7797
7798 return
7799 end subroutine form_caco3
7800
7801
7802 subroutine form_na2so4(store,jp,ibin)
7803 ! implicit none
7804 ! include 'mosaic.h'
7805 ! subr arguments
7806 integer jp, ibin
7807 real(kind=8) store(naer)
7808
7809 electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a), &
7810 store(iso4_a))
7811 store(ina_a) = store(ina_a) - 2.*electrolyte(jna2so4,jp,ibin)
7812 store(iso4_a)= store(iso4_a) - electrolyte(jna2so4,jp,ibin)
7813 store(ina_a) = max(0.D0, store(ina_a))
7814 store(iso4_a)= max(0.D0, store(iso4_a))
7815
7816 return
7817 end subroutine form_na2so4
7818
7819
7820
7821 subroutine form_nahso4(store,jp,ibin)
7822 ! implicit none
7823 ! include 'mosaic.h'
7824 ! subr arguments
7825 integer jp, ibin
7826 real(kind=8) store(naer)
7827
7828 electrolyte(jnahso4,jp,ibin) = min(store(ina_a), &
7829 store(iso4_a))
7830 store(ina_a) = store(ina_a) - electrolyte(jnahso4,jp,ibin)
7831 store(iso4_a) = store(iso4_a) - electrolyte(jnahso4,jp,ibin)
7832 store(ina_a) = max(0.D0, store(ina_a))
7833 store(iso4_a) = max(0.D0, store(iso4_a))
7834
7835 return
7836 end subroutine form_nahso4
7837
7838
7839
7840 subroutine form_namsa(store,jp,ibin)
7841 ! implicit none
7842 ! include 'mosaic.h'
7843 ! subr arguments
7844 integer jp, ibin
7845 real(kind=8) store(naer)
7846
7847 electrolyte(jnamsa,jp,ibin) = min(store(ina_a), &
7848 store(imsa_a))
7849 store(ina_a) = store(ina_a) - electrolyte(jnamsa,jp,ibin)
7850 store(imsa_a) = store(imsa_a) - electrolyte(jnamsa,jp,ibin)
7851 store(ina_a) = max(0.D0, store(ina_a))
7852 store(imsa_a) = max(0.D0, store(imsa_a))
7853
7854 return
7855 end subroutine form_namsa
7856
7857
7858
7859 subroutine form_nano3(store,jp,ibin)
7860 ! implicit none
7861 ! include 'mosaic.h'
7862 ! subr arguments
7863 integer jp, ibin
7864 real(kind=8) store(naer)
7865
7866 electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
7867 store(ina_a) = store(ina_a) - electrolyte(jnano3,jp,ibin)
7868 store(ino3_a) = store(ino3_a) - electrolyte(jnano3,jp,ibin)
7869 store(ina_a) = max(0.D0, store(ina_a))
7870 store(ino3_a) = max(0.D0, store(ino3_a))
7871
7872 return
7873 end subroutine form_nano3
7874
7875
7876
7877 subroutine form_nacl(store,jp,ibin)
7878 ! implicit none
7879 ! include 'mosaic.h'
7880 ! subr arguments
7881 integer jp, ibin
7882 real(kind=8) store(naer)
7883
7884 electrolyte(jnacl,jp,ibin) = store(ina_a)
7885
7886 store(ina_a) = 0.0
7887 store(icl_a) = store(icl_a) - electrolyte(jnacl,jp,ibin)
7888
7889 if(store(icl_a) .lt. 0.)then ! cl deficit in aerosol. take some from gas
7890 aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a) ! update aer(icl_a)
7891
7892 if(jp .ne. jtotal)then
7893 aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ & ! update for jtotal
7894 aer(icl_a,jsolid,ibin)
7895 endif
7896
7897 gas(ihcl_g) = gas(ihcl_g) + store(icl_a) ! update gas(ihcl_g)
7898
7899 if(gas(ihcl_g) .lt. 0.0)then
7900 total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g) ! update total_species
7901 tot_cl_in = tot_cl_in - gas(ihcl_g) ! update tot_cl_in
7902 endif
7903
7904 gas(ihcl_g) = max(0.D0, gas(ihcl_g)) ! restrict gas(ihcl_g) to >= 0.
7905 store(icl_a) = 0. ! force store(icl_a) to 0.
7906
7907 endif
7908
7909 store(icl_a) = max(0.D0, store(icl_a))
7910
7911 return
7912 end subroutine form_nacl
7913
7914
7915
7916 subroutine form_nh4so4(store,jp,ibin) ! (nh4)2so4
7917 ! implicit none
7918 ! include 'mosaic.h'
7919 ! subr arguments
7920 integer jp, ibin
7921 real(kind=8) store(naer)
7922
7923 electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a), &
7924 store(iso4_a))
7925 store(inh4_a)= store(inh4_a) - 2.*electrolyte(jnh4so4,jp,ibin)
7926 store(iso4_a)= store(iso4_a) - electrolyte(jnh4so4,jp,ibin)
7927 store(inh4_a) = max(0.D0, store(inh4_a))
7928 store(iso4_a) = max(0.D0, store(iso4_a))
7929
7930 return
7931 end subroutine form_nh4so4
7932
7933
7934
7935 subroutine form_nh4hso4(store,jp,ibin) ! nh4hso4
7936 ! implicit none
7937 ! include 'mosaic.h'
7938 ! subr arguments
7939 integer jp, ibin
7940 real(kind=8) store(naer)
7941
7942 electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a), &
7943 store(iso4_a))
7944 store(inh4_a)= store(inh4_a) - electrolyte(jnh4hso4,jp,ibin)
7945 store(iso4_a)= store(iso4_a) - electrolyte(jnh4hso4,jp,ibin)
7946 store(inh4_a) = max(0.D0, store(inh4_a))
7947 store(iso4_a) = max(0.D0, store(iso4_a))
7948
7949 return
7950 end subroutine form_nh4hso4
7951
7952
7953
7954 subroutine form_nh4msa(store,jp,ibin)
7955 ! implicit none
7956 ! include 'mosaic.h'
7957 ! subr arguments
7958 integer jp, ibin
7959 real(kind=8) store(naer)
7960
7961 electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a), &
7962 store(imsa_a))
7963 store(inh4_a) = store(inh4_a) - electrolyte(jnh4msa,jp,ibin)
7964 store(imsa_a) = store(imsa_a) - electrolyte(jnh4msa,jp,ibin)
7965 store(inh4_a) = max(0.D0, store(inh4_a))
7966 store(imsa_a) = max(0.D0, store(imsa_a))
7967
7968 return
7969 end subroutine form_nh4msa
7970
7971
7972
7973 subroutine form_nh4cl(store,jp,ibin)
7974 ! implicit none
7975 ! include 'mosaic.h'
7976 ! subr arguments
7977 integer jp, ibin
7978 real(kind=8) store(naer)
7979
7980 electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a), &
7981 store(icl_a))
7982 store(inh4_a) = store(inh4_a) - electrolyte(jnh4cl,jp,ibin)
7983 store(icl_a) = store(icl_a) - electrolyte(jnh4cl,jp,ibin)
7984 store(inh4_a) = max(0.D0, store(inh4_a))
7985 store(icl_a) = max(0.D0, store(icl_a))
7986
7987 return
7988 end subroutine form_nh4cl
7989
7990
7991
7992 subroutine form_nh4no3(store,jp,ibin)
7993 ! implicit none
7994 ! include 'mosaic.h'
7995 ! subr arguments
7996 integer jp, ibin
7997 real(kind=8) store(naer)
7998
7999 electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a), &
8000 store(ino3_a))
8001 store(inh4_a) = store(inh4_a) - electrolyte(jnh4no3,jp,ibin)
8002 store(ino3_a) = store(ino3_a) - electrolyte(jnh4no3,jp,ibin)
8003 store(inh4_a) = max(0.D0, store(inh4_a))
8004 store(ino3_a) = max(0.D0, store(ino3_a))
8005
8006 return
8007 end subroutine form_nh4no3
8008
8009
8010
8011 subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
8012 ! implicit none
8013 ! include 'mosaic.h'
8014 ! subr arguments
8015 integer jp, ibin
8016 real(kind=8) store(naer)
8017
8018 electrolyte(jnh4so4,jp,ibin)= 2.*store(inh4_a) - 3.*store(iso4_a)
8019 electrolyte(jlvcite,jp,ibin)= 2.*store(iso4_a) - store(inh4_a)
8020 electrolyte(jnh4so4,jp,ibin)= max(0.D0, &
8021 electrolyte(jnh4so4,jp,ibin))
8022 electrolyte(jlvcite,jp,ibin)= max(0.D0, &
8023 electrolyte(jlvcite,jp,ibin))
8024 store(inh4_a) = 0.
8025 store(iso4_a) = 0.
8026
8027 return
8028 end subroutine form_nh4so4_lvcite
8029
8030
8031
8032 subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
8033 ! implicit none
8034 ! include 'mosaic.h'
8035 ! subr arguments
8036 integer jp, ibin
8037 real(kind=8) store(naer)
8038
8039 electrolyte(jlvcite,jp,ibin) = store(inh4_a) - store(iso4_a)
8040 electrolyte(jnh4hso4,jp,ibin)= 3.*store(iso4_a) - 2.*store(inh4_a)
8041 electrolyte(jlvcite,jp,ibin) = max(0.D0, &
8042 electrolyte(jlvcite,jp,ibin))
8043 electrolyte(jnh4hso4,jp,ibin)= max(0.D0, &
8044 electrolyte(jnh4hso4,jp,ibin))
8045 store(inh4_a) = 0.
8046 store(iso4_a) = 0.
8047
8048 return
8049 end subroutine form_lvcite_nh4hso4
8050
8051
8052
8053 subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
8054 ! implicit none
8055 ! include 'mosaic.h'
8056 ! subr arguments
8057 integer jp, ibin
8058 real(kind=8) store(naer)
8059
8060 electrolyte(jna2so4,jp,ibin)= store(ina_a) - store(iso4_a)
8061 electrolyte(jnahso4,jp,ibin)= 2.*store(iso4_a) - store(ina_a)
8062 electrolyte(jna2so4,jp,ibin)= max(0.D0, &
8063 electrolyte(jna2so4,jp,ibin))
8064 electrolyte(jnahso4,jp,ibin)= max(0.D0, &
8065 electrolyte(jnahso4,jp,ibin))
8066 store(ina_a) = 0.
8067 store(iso4_a) = 0.
8068
8069 ! write(6,*)'na2so4 + nahso4'
8070
8071 return
8072 end subroutine form_na2so4_nahso4
8073
8074
8075
8076
8077 subroutine form_h2so4(store,jp,ibin)
8078 ! implicit none
8079 ! include 'mosaic.h'
8080 ! subr arguments
8081 integer jp, ibin
8082 real(kind=8) store(naer)
8083
8084 electrolyte(jh2so4,jp,ibin) = max(0.0D0, store(iso4_a))
8085 store(iso4_a) = 0.0
8086
8087 return
8088 end subroutine form_h2so4
8089
8090
8091
8092
8093 subroutine form_msa(store,jp,ibin)
8094 ! implicit none
8095 ! include 'mosaic.h'
8096 ! subr arguments
8097 integer jp, ibin
8098 real(kind=8) store(naer)
8099
8100 electrolyte(jmsa,jp,ibin) = max(0.0D0, store(imsa_a))
8101 store(imsa_a) = 0.0
8102
8103 return
8104 end subroutine form_msa
8105
8106
8107
8108 subroutine form_hno3(store,jp,ibin)
8109 ! implicit none
8110 ! include 'mosaic.h'
8111 ! subr arguments
8112 integer jp, ibin
8113 real(kind=8) store(naer)
8114
8115 electrolyte(jhno3,jp,ibin) = max(0.0D0, store(ino3_a))
8116 store(ino3_a) = 0.0
8117
8118 return
8119 end subroutine form_hno3
8120
8121
8122
8123
8124 subroutine form_hcl(store,jp,ibin)
8125 ! implicit none
8126 ! include 'mosaic.h'
8127 ! subr arguments
8128 integer jp, ibin
8129 real(kind=8) store(naer)
8130
8131 electrolyte(jhcl,jp,ibin) = max(0.0D0, store(icl_a))
8132 store(icl_a) = 0.0
8133
8134 return
8135 end subroutine form_hcl
8136
8137
8138
8139
8140 subroutine degas_hno3(store,jp,ibin)
8141 ! implicit none
8142 ! include 'mosaic.h'
8143 ! subr arguments
8144 integer jp, ibin
8145 real(kind=8) store(naer)
8146
8147 store(ino3_a) = max(0.0D0, store(ino3_a))
8148 gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
8149 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - store(ino3_a)
8150 aer(ino3_a,jp,ibin) = max(0.0D0,aer(ino3_a,jp,ibin))
8151
8152 ! also do it for jtotal
8153 if(jp .ne. jtotal)then
8154 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) + &
8155 aer(ino3_a,jliquid,ibin)
8156 endif
8157
8158 electrolyte(jhno3,jp,ibin) = 0.0
8159 store(ino3_a) = 0.0
8160
8161 return
8162 end subroutine degas_hno3
8163
8164
8165
8166 subroutine degas_hcl(store,jp,ibin)
8167 ! implicit none
8168 ! include 'mosaic.h'
8169 ! subr arguments
8170 integer jp, ibin
8171 real(kind=8) store(naer)
8172
8173 store(icl_a) = max(0.0D0, store(icl_a))
8174 gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
8175 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - store(icl_a)
8176 aer(icl_a,jp,ibin) = max(0.0D0,aer(icl_a,jp,ibin))
8177
8178 ! also do it for jtotal
8179 if(jp .ne. jtotal)then
8180 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) + &
8181 aer(icl_a,jliquid,ibin)
8182 endif
8183
8184 electrolyte(jhcl,jp,ibin) = 0.0
8185 store(icl_a) = 0.0
8186
8187 return
8188 end subroutine degas_hcl
8189
8190
8191
8192 subroutine degas_nh3(store,jp,ibin)
8193 ! implicit none
8194 ! include 'mosaic.h'
8195 ! subr arguments
8196 integer jp, ibin
8197 real(kind=8) store(naer)
8198
8199 store(inh4_a) = max(0.0D0, store(inh4_a))
8200 gas(inh3_g) = gas(inh3_g) + store(inh4_a)
8201 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - store(inh4_a)
8202 aer(inh4_a,jp,ibin) = max(0.0D0,aer(inh4_a,jp,ibin))
8203
8204 ! also do it for jtotal
8205 if(jp .ne. jtotal)then
8206 aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) + &
8207 aer(inh4_a,jliquid,ibin)
8208 endif
8209
8210 store(inh4_a) = 0.0
8211
8212 return
8213 end subroutine degas_nh3
8214
8215
8216
8217
8218
8219
8220
8221
8222
8223 subroutine degas_acids(jp,ibin,xt)
8224 ! implicit none
8225 ! include 'mosaic.h'
8226 ! subr arguments
8227 integer jp, ibin
8228 real(kind=8) xt
8229 ! local variables
8230 real(kind=8) ehno3, ehcl
8231
8232
8233
8234 if(jp .ne. jliquid)then
8235 if (iprint_mosaic_diag1 .gt. 0) then
8236 write(6,*)'mosaic - error in degas_acids'
8237 write(6,*)'wrong jp'
8238 endif
8239 endif
8240
8241 ehno3 = electrolyte(jhno3,jp,ibin)
8242 ehcl = electrolyte(jhcl,jp,ibin)
8243
8244 ! add to gas
8245 gas(ihno3_g) = gas(ihno3_g) + ehno3
8246 gas(ihcl_g) = gas(ihcl_g) + ehcl
8247
8248 ! remove from aer
8249 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
8250 aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
8251
8252 ! update jtotal
8253 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8254 aer(ino3_a,jsolid, ibin)
8255
8256 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8257 aer(icl_a,jsolid, ibin)
8258
8259 electrolyte(jhno3,jp,ibin) = 0.0
8260 electrolyte(jhcl,jp,ibin) = 0.0
8261
8262 return
8263 end subroutine degas_acids
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278 !***********************************************************************
8279 ! subroutines to evaporate solid volatile species
8280 !
8281 ! author: rahul a. zaveri
8282 ! update: sep 2004
8283 !-----------------------------------------------------------------------
8284 !
8285 ! nh4no3 (solid)
8286 subroutine degas_solid_nh4no3(ibin)
8287 ! implicit none
8288 ! include 'mosaic.h'
8289 ! subr arguments
8290 integer ibin
8291 ! local variables
8292 integer jp
8293 real(kind=8) a, b, c, xgas, xt
8294 ! real(kind=8) quadratic ! mosaic func
8295
8296
8297 jp = jsolid
8298
8299 a = 1.0
8300 b = gas(inh3_g) + gas(ihno3_g)
8301 c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
8302 xgas = quadratic(a,b,c)
8303
8304 if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
8305
8306 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4no3,jp,ibin)
8307 gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
8308 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
8309 electrolyte(jnh4no3,jp,ibin)
8310 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - &
8311 electrolyte(jnh4no3,jp,ibin)
8312
8313 else ! degas only xgas amount of nh4no3
8314
8315 gas(inh3_g) = gas(inh3_g) + xgas
8316 gas(ihno3_g)= gas(ihno3_g) + xgas
8317 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8318 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
8319 endif
8320
8321
8322 ! update jtotal
8323 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8324 aer(inh4_a,jliquid,ibin)
8325 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8326 aer(ino3_a,jliquid,ibin)
8327
8328 return
8329 end subroutine degas_solid_nh4no3
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339 ! nh4cl (solid)
8340 subroutine degas_solid_nh4cl(ibin)
8341 ! implicit none
8342 ! include 'mosaic.h'
8343 ! subr arguments
8344 integer ibin
8345 ! local variables
8346 integer jp
8347 real(kind=8) a, b, c, xgas, xt
8348 ! real(kind=8) quadratic ! mosaic func
8349
8350
8351 jp = jsolid
8352
8353 a = 1.0
8354 b = gas(inh3_g) + gas(ihcl_g)
8355 c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
8356 xgas = quadratic(a,b,c)
8357
8358 if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
8359
8360 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
8361 gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
8362 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
8363 electrolyte(jnh4cl,jp,ibin)
8364 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - &
8365 electrolyte(jnh4cl,jp,ibin)
8366
8367 else ! degas only xgas amount of nh4cl
8368
8369 gas(inh3_g) = gas(inh3_g) + xgas
8370 gas(ihcl_g) = gas(ihcl_g) + xgas
8371 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8372 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - xgas
8373
8374 endif
8375
8376
8377 ! update jtotal
8378 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8379 aer(inh4_a,jliquid,ibin)
8380 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8381 aer(icl_a,jliquid,ibin)
8382
8383 return
8384 end subroutine degas_solid_nh4cl
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396 !***********************************************************************
8397 ! subroutines to absorb and degas small amounts of volatile species
8398 !
8399 ! author: rahul a. zaveri
8400 ! update: jun 2002
8401 !-----------------------------------------------------------------------
8402 !
8403 ! nh4no3 (liquid)
8404 subroutine absorb_tiny_nh4no3(ibin)
8405 ! implicit none
8406 ! include 'mosaic.h'
8407 ! subr arguments
8408 integer ibin
8409 ! local variables
8410 real(kind=8) small_aer, small_gas, small_amt
8411
8412 small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
8413 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8414 if(small_aer .eq. 0.0)small_aer = small_gas
8415
8416 small_amt = min(small_gas, small_aer)
8417
8418 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8419 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8420
8421 ! update jtotal
8422 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8423 aer(inh4_a,jliquid,ibin)
8424 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8425 aer(ino3_a,jliquid,ibin)
8426
8427 ! update gas
8428 gas(inh3_g) = gas(inh3_g) - small_amt
8429 gas(ihno3_g) = gas(ihno3_g) - small_amt
8430
8431 return
8432 end subroutine absorb_tiny_nh4no3
8433
8434
8435
8436
8437
8438
8439 !--------------------------------------------------------------------
8440 ! nh4cl (liquid)
8441 subroutine absorb_tiny_nh4cl(ibin)
8442 ! implicit none
8443 ! include 'mosaic.h'
8444 ! subr arguments
8445 integer ibin
8446 ! local variables
8447 real(kind=8) small_aer, small_gas, small_amt
8448
8449 small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
8450 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8451 if(small_aer .eq. 0.0)small_aer = small_gas
8452
8453 small_amt = min(small_gas, small_aer)
8454
8455 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8456 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + small_amt
8457
8458 ! update jtotal
8459 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8460 aer(inh4_a,jliquid,ibin)
8461 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8462 aer(icl_a,jliquid,ibin)
8463
8464 ! update gas
8465 gas(inh3_g) = gas(inh3_g) - small_amt
8466 gas(ihcl_g) = gas(ihcl_g) - small_amt
8467
8468 return
8469 end subroutine absorb_tiny_nh4cl
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483 !--------------------------------------------------------------
8484 ! nh4no3 (liquid)
8485 subroutine degas_tiny_nh4no3(ibin)
8486 ! implicit none
8487 ! include 'mosaic.h'
8488 ! subr arguments
8489 integer ibin
8490 ! local variables
8491 real(kind=8) small_amt
8492
8493 small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
8494
8495 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8496 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8497
8498 ! update jtotal
8499 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8500 aer(inh4_a,jliquid,ibin)
8501 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8502 aer(ino3_a,jliquid,ibin)
8503
8504 ! update gas
8505 gas(inh3_g) = gas(inh3_g) + small_amt
8506 gas(ihno3_g) = gas(ihno3_g) + small_amt
8507
8508 return
8509 end subroutine degas_tiny_nh4no3
8510
8511
8512
8513
8514 !--------------------------------------------------------------------
8515 ! liquid nh4cl (liquid)
8516 subroutine degas_tiny_nh4cl(ibin)
8517 ! implicit none
8518 ! include 'mosaic.h'
8519 ! subr arguments
8520 integer ibin
8521 ! local variables
8522 real(kind=8) small_amt
8523
8524
8525 small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
8526
8527 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8528 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
8529
8530 ! update jtotal
8531 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8532 aer(inh4_a,jliquid,ibin)
8533 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8534 aer(icl_a,jliquid,ibin)
8535
8536 ! update gas
8537 gas(inh3_g) = gas(inh3_g) + small_amt
8538 gas(ihcl_g) = gas(ihcl_g) + small_amt
8539
8540 return
8541 end subroutine degas_tiny_nh4cl
8542
8543
8544
8545
8546
8547
8548
8549 !--------------------------------------------------------------------
8550 ! hcl (liquid)
8551 subroutine absorb_tiny_hcl(ibin) ! and degas tiny hno3
8552 ! implicit none
8553 ! include 'mosaic.h'
8554 ! subr arguments
8555 integer ibin
8556 ! local variables
8557 real(kind=8) small_aer, small_amt, small_gas
8558
8559 small_gas = 0.01 * gas(ihcl_g)
8560 small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
8561
8562 small_amt = min(small_gas, small_aer)
8563
8564 ! absorb tiny hcl
8565 aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
8566 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8567 aer(icl_a,jliquid,ibin)
8568 gas(ihcl_g) = gas(ihcl_g) - small_amt
8569
8570 ! degas tiny hno3
8571 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8572 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8573 aer(ino3_a,jliquid,ibin)
8574
8575 ! update gas
8576 gas(ihno3_g) = gas(ihno3_g) + small_amt
8577
8578 return
8579 end subroutine absorb_tiny_hcl
8580
8581
8582
8583 !--------------------------------------------------------------------
8584 ! hno3 (liquid)
8585 subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
8586 ! implicit none
8587 ! include 'mosaic.h'
8588 ! subr arguments
8589 integer ibin
8590 ! local variables
8591 real(kind=8) small_aer, small_amt, small_gas
8592
8593 small_gas = 0.01 * gas(ihno3_g)
8594 small_aer = 0.01 * aer(icl_a,jliquid,ibin)
8595
8596 small_amt = min(small_gas, small_aer)
8597
8598 ! absorb tiny hno3
8599 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8600 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8601 aer(ino3_a,jliquid,ibin)
8602 gas(ihno3_g) = gas(ihno3_g) - small_amt
8603
8604 ! degas tiny hcl
8605 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
8606 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8607 aer(icl_a,jliquid,ibin)
8608
8609 ! update gas
8610 gas(ihcl_g) = gas(ihcl_g) + small_amt
8611
8612 return
8613 end subroutine absorb_tiny_hno3
8614
8615
8616
8617
8618
8619
8620
8621
8622
8623 !***********************************************************************
8624 ! subroutines to equilibrate volatile acids
8625 !
8626 ! author: rahul a. zaveri
8627 ! update: may 2002
8628 !-----------------------------------------------------------------------
8629 subroutine equilibrate_acids(ibin)
8630 ! implicit none
8631 ! include 'mosaic.h'
8632 ! subr arguments
8633 integer ibin
8634
8635
8636
8637 if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
8638 call equilibrate_hcl_and_hno3(ibin)
8639 elseif(gas(ihcl_g) .gt. 0.)then
8640 call equilibrate_hcl(ibin)
8641 elseif(gas(ihno3_g) .gt. 0.)then
8642 call equilibrate_hno3(ibin)
8643 endif
8644
8645
8646 return
8647 end subroutine equilibrate_acids
8648
8649
8650
8651
8652
8653
8654
8655
8656 ! only hcl
8657 subroutine equilibrate_hcl(ibin)
8658 ! implicit none
8659 ! include 'mosaic.h'
8660 ! subr arguments
8661 integer ibin
8662 ! local variables
8663 real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl, &
8664 w, xt, z
8665 ! real(kind=8) quadratic ! mosaic func
8666
8667 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8668 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8669
8670 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
8671 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8672 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8673 aer(inh4_a,jliquid,ibin) + &
8674 2.*aer(ica_a, jliquid,ibin) ) - &
8675 (2.*aerso4 + &
8676 aerhso4 + &
8677 aer(ino3_a,jliquid,ibin) )
8678
8679
8680 w = water_a(ibin) ! kg/m^3(air)
8681
8682 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8683 a = 1.0
8684 b = (kdash_hcl*w + z/w)*1.e-9
8685 c = kdash_hcl*(z - tcl)*1.e-18
8686
8687
8688 dum = b*b - 4.*a*c
8689 if (dum .lt. 0.) return ! no real root
8690
8691
8692 if(c .lt. 0.)then
8693 mh = quadratic(a,b,c) ! mol/kg(water)
8694 aerh = mh*w*1.e+9
8695 aer(icl_a,jliquid,ibin) = aerh + z
8696 else
8697 mh = sqrt(keq_ll(3))
8698 endif
8699
8700 call form_electrolytes(jliquid,ibin,xt)
8701
8702 ! update gas phase concentration
8703 gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
8704
8705
8706 ! update the following molalities
8707 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8708 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8709 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8710 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8711
8712 mc(jc_h,ibin) = mh
8713 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8714 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8715 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8716
8717
8718 ! update the following activities
8719 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
8720 gam(jhcl,ibin)**2
8721
8722 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
8723 gam(jhno3,ibin)**2
8724
8725 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
8726 gam(jnh4cl,ibin)**2
8727
8728
8729 ! also update xyz(jtotal)
8730 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8731 aer(icl_a,jsolid,ibin)
8732
8733 electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
8734
8735 return
8736 end subroutine equilibrate_hcl
8737
8738
8739
8740
8741 ! only hno3
8742 subroutine equilibrate_hno3(ibin)
8743 ! implicit none
8744 ! include 'mosaic.h'
8745 ! subr arguments
8746 integer ibin
8747 ! local variables
8748 real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh, &
8749 tno3, w, xt, z
8750 ! real(kind=8) quadratic ! mosaic func
8751
8752 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8753 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8754
8755 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
8756 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8757 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8758 aer(inh4_a,jliquid,ibin) + &
8759 2.*aer(ica_a, jliquid,ibin) ) - &
8760 (2.*aerso4 + &
8761 aerhso4 + &
8762 aer(icl_a,jliquid,ibin) )
8763
8764
8765 w = water_a(ibin) ! kg/m^3(air)
8766
8767 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8768 a = 1.0
8769 b = (kdash_hno3*w + z/w)*1.e-9
8770 c = kdash_hno3*(z - tno3)*1.e-18
8771
8772 dum = b*b - 4.*a*c
8773 if (dum .lt. 0.) return ! no real root
8774
8775
8776
8777 if(c .lt. 0.)then
8778 mh = quadratic(a,b,c) ! mol/kg(water)
8779 aerh = mh*w*1.e+9
8780 aer(ino3_a,jliquid,ibin) = aerh + z
8781 else
8782 mh = sqrt(keq_ll(3))
8783 endif
8784
8785 call form_electrolytes(jliquid,ibin,xt)
8786
8787 ! update gas phase concentration
8788 gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8789
8790
8791 ! update the following molalities
8792 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8793 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8794 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8795 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8796
8797 mc(jc_h,ibin) = mh
8798 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8799 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8800 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8801
8802
8803 ! update the following activities
8804 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
8805 gam(jhcl,ibin)**2
8806
8807 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
8808 gam(jhno3,ibin)**2
8809
8810 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) * &
8811 gam(jnh4no3,ibin)**2
8812
8813
8814 ! also update xyz(jtotal)
8815 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8816 aer(ino3_a,jsolid,ibin)
8817
8818 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8819
8820 return
8821 end subroutine equilibrate_hno3
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832 ! both hcl and hno3
8833 subroutine equilibrate_hcl_and_hno3(ibin)
8834 ! implicit none
8835 ! include 'mosaic.h'
8836 ! subr arguments
8837 integer ibin
8838 ! local variables
8839 real(kind=8) aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3, &
8840 mh, p, q, r, tcl, tno3, w, xt, z
8841 ! real(kind=8) cubic ! mosaic func
8842
8843
8844 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8845 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8846
8847 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
8848 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
8849
8850 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8851 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8852
8853 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8854 aer(inh4_a,jliquid,ibin) + &
8855 2.*aer(ica_a, jliquid,ibin) ) - &
8856 (2.*aerso4 + aerhso4 )
8857
8858
8859 w = water_a(ibin)
8860
8861 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8862 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8863
8864 p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
8865
8866 q = 1.e-18*kdash_hcl*kdash_hno3*w**2 + &
8867 1.e-18*z*(kdash_hcl + kdash_hno3) - &
8868 1.e-18*kdash_hcl*tcl - &
8869 1.e-18*kdash_hno3*tno3
8870
8871 r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
8872
8873 mh = cubic(p,q,r)
8874
8875 if(mh .gt. 0.0)then
8876 aerh = mh*w*1.e+9
8877 aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/ &
8878 (aerh + kdash_hno3*w*w)
8879 aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/ &
8880 (aerh + kdash_hcl*w*w)
8881 else
8882 mh = sqrt(keq_ll(3))
8883 endif
8884
8885 call form_electrolytes(jliquid,ibin,xt)
8886
8887 ! update gas phase concentration
8888 gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8889 gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
8890
8891
8892 ! update the following molalities
8893 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8894 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8895 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8896 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8897
8898 mc(jc_h,ibin) = mh
8899 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8900 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8901 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8902
8903
8904 ! update the following activities
8905 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin) * &
8906 gam(jhcl,ibin)**2
8907
8908 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin) * &
8909 gam(jhno3,ibin)**2
8910
8911 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
8912 gam(jnh4no3,ibin)**2
8913
8914 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
8915 gam(jnh4cl,ibin)**2
8916
8917
8918 ! also update xyz(jtotal)
8919 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8920 aer(icl_a,jsolid,ibin)
8921
8922 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8923 aer(ino3_a,jsolid,ibin)
8924
8925 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8926 electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
8927
8928 return
8929 end subroutine equilibrate_hcl_and_hno3
8930
8931
8932
8933
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943 !***********************************************************************
8944 ! called only once per entire simulation to load gas and aerosol
8945 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
8946 !
8947 ! author: rahul a. zaveri
8948 ! update: jan 2005
8949 !-----------------------------------------------------------------------
8950 subroutine load_mosaic_parameters
8951 ! implicit none
8952 ! include 'v33com2'
8953 ! include 'mosaic.h'
8954 ! local variables
8955 integer iaer, je, ja, j_index, ibin
8956 ! logical first
8957 ! save first
8958 ! data first/.true./
8959 logical, save :: first = .true.
8960
8961
8962
8963 if(first)then
8964 first=.false.
8965
8966 !----------------------------------------------------------------
8967 ! control settings
8968 msize_framework = msection ! mmodal or msection
8969 mgas_aer_xfer = myes ! myes, mno
8970
8971 ! astem parameters
8972 nmax_astem = 200 ! max number of time steps in astem
8973 alpha_astem = 0.5 ! choose a value between 0.01 and 1.0
8974 rtol_eqb_astem = 0.01 ! equilibrium tolerance in astem
8975 ptol_mol_astem = 0.01 ! mol percent tolerance in astem
8976
8977 ! mesa parameters
8978 nmax_mesa = 80 ! max number of iterations in mesa_ptc
8979 rtol_mesa = 0.01 ! mesa equilibrium tolerance
8980 !----------------------------------------------------------------
8981 !
8982 ! set gas and aerosol indices
8983 !
8984 ! gas (local)
8985 ih2so4_g = 1 ! ioa (inorganic aerosol)
8986 ihno3_g = 2 ! ioa
8987 ihcl_g = 3 ! ioa
8988 inh3_g = 4 ! ioa
8989 imsa_g = 5 ! ioa
8990 iaro1_g = 6 ! soa (secondary organic aerosol)
8991 iaro2_g = 7 ! soa
8992 ialk1_g = 8 ! soa
8993 iole1_g = 9 ! soa
8994 iapi1_g = 10 ! soa
8995 iapi2_g = 11 ! soa
8996 ilim1_g = 12 ! soa
8997 ilim2_g = 13 ! soa
8998
8999 ! ico2_g = 14 ! currently not used
9000 !
9001 ! aerosol (local): used for total species
9002 iso4_a = 1 ! <-> ih2so4_g
9003 ino3_a = 2 ! <-> ihno3_g
9004 icl_a = 3 ! <-> ihcl_g
9005 inh4_a = 4 ! <-> inh3_g
9006 imsa_a = 5 ! <-> imsa_g
9007 iaro1_a = 6 ! <-> iaro1_g
9008 iaro2_a = 7 ! <-> iaro2_g
9009 ialk1_a = 8 ! <-> ialk1_g
9010 iole1_a = 9 ! <-> iole1_g
9011 iapi1_a = 10 ! <-> iapi1_g
9012 iapi2_a = 11 ! <-> iapi2_g
9013 ilim1_a = 12 ! <-> ilim1_g
9014 ilim2_a = 13 ! <-> ilim2_g
9015 ico3_a = 14 ! <-> ico2_g
9016 ina_a = 15
9017 ica_a = 16
9018 ioin_a = 17
9019 ioc_a = 18
9020 ibc_a = 19
9021
9022
9023 ! electrolyte indices (used for water content calculations)
9024 ! these indices are order sensitive
9025 jnh4so4 = 1 ! soluble
9026 jlvcite = 2 ! soluble
9027 jnh4hso4 = 3 ! soluble
9028 jnh4msa = 4 ! soluble new
9029 jnh4no3 = 5 ! soluble
9030 jnh4cl = 6 ! soluble
9031 jna2so4 = 7 ! soluble
9032 jna3hso4 = 8 ! soluble
9033 jnahso4 = 9 ! soluble
9034 jnamsa = 10 ! soluble new
9035 jnano3 = 11 ! soluble
9036 jnacl = 12 ! soluble
9037 jcano3 = 13 ! soluble
9038 jcacl2 = 14 ! soluble
9039 jcamsa2 = 15 ! soluble new nsalt
9040 jh2so4 = 16 ! soluble
9041 jmsa = 17 ! soluble new
9042 jhno3 = 18 ! soluble
9043 jhcl = 19 ! soluble
9044 jhhso4 = 20 ! soluble
9045 jcaso4 = 21 ! insoluble
9046 jcaco3 = 22 ! insoluble
9047 joc = 23 ! insoluble - part of naercomp
9048 jbc = 24 ! insoluble - part of naercomp
9049 join = 25 ! insoluble - part of naercomp
9050 jaro1 = 26 ! insoluble - part of naercomp
9051 jaro2 = 27 ! insoluble - part of naercomp
9052 jalk1 = 28 ! insoluble - part of naercomp
9053 jole1 = 29 ! insoluble - part of naercomp
9054 japi1 = 30 ! insoluble - part of naercomp
9055 japi2 = 31 ! insoluble - part of naercomp
9056 jlim1 = 32 ! insoluble - part of naercomp
9057 jlim2 = 33 ! insoluble - part of naercomp
9058 jh2o = 34 ! water - part of naercomp
9059
9060
9061 ! local aerosol ions
9062 ! cations
9063 jc_h = 1
9064 jc_nh4 = 2
9065 jc_na = 3
9066 jc_ca = 4
9067 !
9068 ! anions
9069 ja_hso4 = 1
9070 ja_so4 = 2
9071 ja_no3 = 3
9072 ja_cl = 4
9073 ja_msa = 5
9074 ! ja_co3 = 6
9075
9076 !--------------------------------------------------------------------
9077 ! phase state names
9078 ! phasestate(no_aerosol) = "NOAERO"
9079 ! phasestate(all_solid) = "SOLID "
9080 ! phasestate(all_liquid) = "LIQUID"
9081 ! phasestate(mixed) = "MIXED "
9082
9083 ! names of aer species
9084 aer_name(iso4_a) = 'so4'
9085 aer_name(ino3_a) = 'no3'
9086 aer_name(icl_a) = 'cl '
9087 aer_name(inh4_a) = 'nh4'
9088 aer_name(ioc_a) = 'oc '
9089 aer_name(imsa_a) = 'msa'
9090 aer_name(ico3_a) = 'co3'
9091 aer_name(ina_a) = 'na '
9092 aer_name(ica_a) = 'ca '
9093 aer_name(ibc_a) = 'bc '
9094 aer_name(ioin_a) = 'oin'
9095 aer_name(iaro1_a)= 'aro1'
9096 aer_name(iaro2_a)= 'aro2'
9097 aer_name(ialk1_a)= 'alk1'
9098 aer_name(iole1_a)= 'ole1'
9099 aer_name(iapi1_a)= 'api1'
9100 aer_name(iapi2_a)= 'api2'
9101 aer_name(ilim1_a)= 'lim1'
9102 aer_name(ilim2_a)= 'lim2'
9103
9104 ! names of gas species
9105 gas_name(ih2so4_g) = 'h2so4'
9106 gas_name(ihno3_g) = 'hno3 '
9107 gas_name(ihcl_g) = 'hcl '
9108 gas_name(inh3_g) = 'nh3 '
9109 gas_name(imsa_g) = "msa "
9110 gas_name(iaro1_g) = "aro1 "
9111 gas_name(iaro2_g) = "aro2 "
9112 gas_name(ialk1_g) = "alk1 "
9113 gas_name(iole1_g) = "ole1 "
9114 gas_name(iapi1_g) = "api1 "
9115 gas_name(iapi2_g) = "api2 "
9116 gas_name(ilim1_g) = "lim1 "
9117 gas_name(ilim2_g) = "lim2 "
9118
9119 ! names of electrolytes
9120 ename(jnh4so4) = 'amso4'
9121 ename(jlvcite) = '(nh4)3h(so4)2'
9122 ename(jnh4hso4)= 'nh4hso4'
9123 ename(jnh4msa) = "ch3so3nh4"
9124 ename(jnh4no3) = 'nh4no3'
9125 ename(jnh4cl) = 'nh4cl'
9126 ename(jnacl) = 'nacl'
9127 ename(jnano3) = 'nano3'
9128 ename(jna2so4) = 'na2so4'
9129 ename(jna3hso4)= 'na3h(so4)2'
9130 ename(jnamsa) = "ch3so3na"
9131 ename(jnahso4) = 'nahso4'
9132 ename(jcaso4) = 'caso4'
9133 ename(jcamsa2) = "(ch3so3)2ca"
9134 ename(jcano3) = 'ca(no3)2'
9135 ename(jcacl2) = 'cacl2'
9136 ename(jcaco3) = 'caco3'
9137 ename(jh2so4) = 'h2so4'
9138 ename(jhhso4) = 'hhso4'
9139 ename(jhno3) = 'hno3'
9140 ename(jhcl) = 'hcl'
9141 ename(jmsa) = "ch3so3h"
9142
9143 ! molecular weights of electrolytes
9144 mw_electrolyte(jnh4so4) = 132.0
9145 mw_electrolyte(jlvcite) = 247.0
9146 mw_electrolyte(jnh4hso4)= 115.0
9147 mw_electrolyte(jnh4msa) = 113.0
9148 mw_electrolyte(jnh4no3) = 80.0
9149 mw_electrolyte(jnh4cl) = 53.5
9150 mw_electrolyte(jnacl) = 58.5
9151 mw_electrolyte(jnano3) = 85.0
9152 mw_electrolyte(jna2so4) = 142.0
9153 mw_electrolyte(jna3hso4)= 262.0
9154 mw_electrolyte(jnahso4) = 120.0
9155 mw_electrolyte(jnamsa) = 118.0
9156 mw_electrolyte(jcaso4) = 136.0
9157 mw_electrolyte(jcamsa2) = 230.0
9158 mw_electrolyte(jcano3) = 164.0
9159 mw_electrolyte(jcacl2) = 111.0
9160 mw_electrolyte(jcaco3) = 100.0
9161 mw_electrolyte(jh2so4) = 98.0
9162 mw_electrolyte(jhno3) = 63.0
9163 mw_electrolyte(jhcl) = 36.5
9164 mw_electrolyte(jmsa) = 96.0
9165
9166
9167 ! molecular weights of ions [g/mol]
9168 mw_c(jc_h) = 1.0
9169 mw_c(jc_nh4)= 18.0
9170 mw_c(jc_na) = 23.0
9171 mw_c(jc_ca) = 40.0
9172
9173 mw_a(ja_so4) = 96.0
9174 mw_a(ja_hso4)= 97.0
9175 mw_a(ja_no3) = 62.0
9176 mw_a(ja_cl) = 35.5
9177 MW_a(ja_msa) = 95.0
9178
9179
9180 ! magnitude of the charges on ions
9181 zc(jc_h) = 1
9182 zc(jc_nh4) = 1
9183 zc(jc_na) = 1
9184 zc(jc_ca) = 2
9185
9186 za(ja_hso4)= 1
9187 za(ja_so4) = 2
9188 za(ja_no3) = 1
9189 za(ja_cl) = 1
9190 za(ja_msa) = 1
9191
9192
9193 ! densities of pure electrolytes in g/cc
9194 dens_electrolyte(jnh4so4) = 1.8
9195 dens_electrolyte(jlvcite) = 1.8
9196 dens_electrolyte(jnh4hso4) = 1.8
9197 dens_electrolyte(jnh4msa) = 1.8 ! assumed same as nh4hso4
9198 dens_electrolyte(jnh4no3) = 1.8
9199 dens_electrolyte(jnh4cl) = 1.8
9200 dens_electrolyte(jnacl) = 2.2
9201 dens_electrolyte(jnano3) = 2.2
9202 dens_electrolyte(jna2so4) = 2.2
9203 dens_electrolyte(jna3hso4) = 2.2
9204 dens_electrolyte(jnahso4) = 2.2
9205 dens_electrolyte(jnamsa) = 2.2 ! assumed same as nahso4
9206 dens_electrolyte(jcaso4) = 2.6
9207 dens_electrolyte(jcamsa2) = 2.6 ! assumed same as caso4
9208 dens_electrolyte(jcano3) = 2.6
9209 dens_electrolyte(jcacl2) = 2.6
9210 dens_electrolyte(jcaco3) = 2.6
9211 dens_electrolyte(jh2so4) = 1.8
9212 dens_electrolyte(jhhso4) = 1.8
9213 dens_electrolyte(jhno3) = 1.8
9214 dens_electrolyte(jhcl) = 1.8
9215 dens_electrolyte(jmsa) = 1.8 ! assumed same as h2so4
9216
9217
9218 ! densities of compounds in g/cc
9219 dens_comp_a(jnh4so4) = 1.8
9220 dens_comp_a(jlvcite) = 1.8
9221 dens_comp_a(jnh4hso4) = 1.8
9222 dens_comp_a(jnh4msa) = 1.8 ! assumed same as nh4hso4
9223 dens_comp_a(jnh4no3) = 1.7
9224 dens_comp_a(jnh4cl) = 1.5
9225 dens_comp_a(jnacl) = 2.2
9226 dens_comp_a(jnano3) = 2.2
9227 dens_comp_a(jna2so4) = 2.2
9228 dens_comp_a(jna3hso4) = 2.2
9229 dens_comp_a(jnahso4) = 2.2
9230 dens_comp_a(jnamsa) = 2.2 ! assumed same as nahso4
9231 dens_comp_a(jcaso4) = 2.6
9232 dens_comp_a(jcamsa2) = 2.6 ! assumed same as caso4
9233 dens_comp_a(jcano3) = 2.6
9234 dens_comp_a(jcacl2) = 2.6
9235 dens_comp_a(jcaco3) = 2.6
9236 dens_comp_a(jh2so4) = 1.8
9237 dens_comp_a(jhhso4) = 1.8
9238 dens_comp_a(jhno3) = 1.8
9239 dens_comp_a(jhcl) = 1.8
9240 dens_comp_a(jmsa) = 1.8 ! assumed same as h2so4
9241 dens_comp_a(joc) = 1.0
9242 dens_comp_a(jbc) = 1.8
9243 dens_comp_a(join) = 2.6
9244 dens_comp_a(jaro1) = 1.0
9245 dens_comp_a(jaro2) = 1.0
9246 dens_comp_a(jalk1) = 1.0
9247 dens_comp_a(jole1) = 1.0
9248 dens_comp_a(japi1) = 1.0
9249 dens_comp_a(japi2) = 1.0
9250 dens_comp_a(jlim1) = 1.0
9251 dens_comp_a(jlim2) = 1.0
9252 dens_comp_a(jh2o) = 1.0
9253
9254
9255 ! molecular weights of generic aerosol species
9256 mw_aer_mac(iso4_a) = 96.0
9257 mw_aer_mac(ino3_a) = 62.0
9258 mw_aer_mac(icl_a) = 35.5
9259 mw_aer_mac(imsa_a) = 95.0 ! ch3so3
9260 mw_aer_mac(ico3_a) = 60.0
9261 mw_aer_mac(inh4_a) = 18.0
9262 mw_aer_mac(ina_a) = 23.0
9263 mw_aer_mac(ica_a) = 40.0
9264 mw_aer_mac(ioin_a) = 1.0 ! not used
9265 mw_aer_mac(ibc_a) = 1.0 ! not used
9266 mw_aer_mac(ioc_a) = 1.0 ! 200 assumed for primary organics
9267 mw_aer_mac(iaro1_a)= 150.0
9268 mw_aer_mac(iaro2_a)= 150.0
9269 mw_aer_mac(ialk1_a)= 140.0
9270 mw_aer_mac(iole1_a)= 140.0
9271 mw_aer_mac(iapi1_a)= 184.0
9272 mw_aer_mac(iapi2_a)= 184.0
9273 mw_aer_mac(ilim1_a)= 200.0
9274 mw_aer_mac(ilim2_a)= 200.0
9275
9276 ! molecular weights of compounds
9277 mw_comp_a(jnh4so4) = 132.0
9278 mw_comp_a(jlvcite) = 247.0
9279 mw_comp_a(jnh4hso4)= 115.0
9280 mw_comp_a(jnh4msa) = 113.0
9281 mw_comp_a(jnh4no3) = 80.0
9282 mw_comp_a(jnh4cl) = 53.5
9283 mw_comp_a(jnacl) = 58.5
9284 mw_comp_a(jnano3) = 85.0
9285 mw_comp_a(jna2so4) = 142.0
9286 mw_comp_a(jna3hso4)= 262.0
9287 mw_comp_a(jnahso4) = 120.0
9288 mw_comp_a(jnamsa) = 118.0
9289 mw_comp_a(jcaso4) = 136.0
9290 mw_comp_a(jcamsa2) = 230.0
9291 mw_comp_a(jcano3) = 164.0
9292 mw_comp_a(jcacl2) = 111.0
9293 mw_comp_a(jcaco3) = 100.0
9294 mw_comp_a(jh2so4) = 98.0
9295 mw_comp_a(jhhso4) = 98.0
9296 mw_comp_a(jhno3) = 63.0
9297 mw_comp_a(jhcl) = 36.5
9298 mw_comp_a(jmsa) = 96.0
9299 mw_comp_a(joc) = 1.0
9300 mw_comp_a(jbc) = 1.0
9301 mw_comp_a(join) = 1.0
9302 mw_comp_a(jaro1) = 150.0
9303 mw_comp_a(jaro2) = 150.0
9304 mw_comp_a(jalk1) = 140.0
9305 mw_comp_a(jole1) = 140.0
9306 mw_comp_a(japi1) = 184.0
9307 mw_comp_a(japi2) = 184.0
9308 mw_comp_a(jlim1) = 200.0
9309 mw_comp_a(jlim2) = 200.0
9310 mw_comp_a(jh2o) = 18.0
9311
9312 ! densities of generic aerosol species
9313 dens_aer_mac(iso4_a) = 1.8 ! used
9314 dens_aer_mac(ino3_a) = 1.8 ! used
9315 dens_aer_mac(icl_a) = 2.2 ! used
9316 dens_aer_mac(imsa_a) = 1.8 ! used
9317 dens_aer_mac(ico3_a) = 2.6 ! used
9318 dens_aer_mac(inh4_a) = 1.8 ! used
9319 dens_aer_mac(ina_a) = 2.2 ! used
9320 dens_aer_mac(ica_a) = 2.6 ! used
9321 dens_aer_mac(ioin_a) = 2.6 ! used
9322 dens_aer_mac(ioc_a) = 1.0 ! used
9323 dens_aer_mac(ibc_a) = 1.7 ! used
9324 dens_aer_mac(iaro1_a)= 1.0
9325 dens_aer_mac(iaro2_a)= 1.0
9326 dens_aer_mac(ialk1_a)= 1.0
9327 dens_aer_mac(iole1_a)= 1.0
9328 dens_aer_mac(iapi1_a)= 1.0
9329 dens_aer_mac(iapi2_a)= 1.0
9330 dens_aer_mac(ilim1_a)= 1.0
9331 dens_aer_mac(ilim2_a)= 1.0
9332
9333
9334 ! partial molar volumes of condensing species
9335 partial_molar_vol(ih2so4_g) = 51.83
9336 partial_molar_vol(ihno3_g) = 31.45
9337 partial_molar_vol(ihcl_g) = 20.96
9338 partial_molar_vol(inh3_g) = 24.03
9339 partial_molar_vol(imsa_g) = 53.33
9340 partial_molar_vol(iaro1_g) = 150.0
9341 partial_molar_vol(iaro2_g) = 150.0
9342 partial_molar_vol(ialk1_g) = 140.0
9343 partial_molar_vol(iole1_g) = 140.0
9344 partial_molar_vol(iapi1_g) = 184.0
9345 partial_molar_vol(iapi2_g) = 184.0
9346 partial_molar_vol(ilim1_g) = 200.0
9347 partial_molar_vol(ilim2_g) = 200.0
9348
9349
9350 ! refractive index
9351 ref_index_a(jnh4so4) = cmplx(1.52,0.)
9352 ref_index_a(jlvcite) = cmplx(1.50,0.)
9353 ref_index_a(jnh4hso4)= cmplx(1.47,0.)
9354 ref_index_a(jnh4msa) = cmplx(1.50,0.) ! assumed
9355 ref_index_a(jnh4no3) = cmplx(1.50,0.)
9356 ref_index_a(jnh4cl) = cmplx(1.50,0.)
9357 ref_index_a(jnacl) = cmplx(1.45,0.)
9358 ref_index_a(jnano3) = cmplx(1.50,0.)
9359 ref_index_a(jna2so4) = cmplx(1.50,0.)
9360 ref_index_a(jna3hso4)= cmplx(1.50,0.)
9361 ref_index_a(jnahso4) = cmplx(1.50,0.)
9362 ref_index_a(jnamsa) = cmplx(1.50,0.) ! assumed
9363 ref_index_a(jcaso4) = cmplx(1.56,0.006)
9364 ref_index_a(jcamsa2) = cmplx(1.56,0.006) ! assumed
9365 ref_index_a(jcano3) = cmplx(1.56,0.006)
9366 ref_index_a(jcacl2) = cmplx(1.52,0.006)
9367 ref_index_a(jcaco3) = cmplx(1.68,0.006)
9368 ref_index_a(jh2so4) = cmplx(1.43,0.)
9369 ref_index_a(jhhso4) = cmplx(1.43,0.)
9370 ref_index_a(jhno3) = cmplx(1.50,0.)
9371 ref_index_a(jhcl) = cmplx(1.50,0.)
9372 ref_index_a(jmsa) = cmplx(1.43,0.) ! assumed
9373 ref_index_a(joc) = cmplx(1.45,0.)
9374 ref_index_a(jbc) = cmplx(1.82,0.74)
9375 ref_index_a(join) = cmplx(1.55,0.006)
9376 ref_index_a(jaro1) = cmplx(1.45,0.)
9377 ref_index_a(jaro2) = cmplx(1.45,0.)
9378 ref_index_a(jalk1) = cmplx(1.45,0.)
9379 ref_index_a(jole1) = cmplx(1.45,0.)
9380 ref_index_a(japi1) = cmplx(1.45,0.)
9381 ref_index_a(japi2) = cmplx(1.45,0.)
9382 ref_index_a(jlim1) = cmplx(1.45,0.)
9383 ref_index_a(jlim2) = cmplx(1.45,0.)
9384 ref_index_a(jh2o) = cmplx(1.33,0.)
9385
9386 ! jsalt_index
9387 jsalt_index(jnh4so4) = 5 ! as
9388 jsalt_index(jlvcite) = 2 ! lv
9389 jsalt_index(jnh4hso4)= 1 ! ab
9390 jsalt_index(jnh4no3) = 2 ! an
9391 jsalt_index(jnh4cl) = 1 ! ac
9392 jsalt_index(jna2so4) = 60 ! ss
9393 jsalt_index(jnahso4) = 10 ! sb
9394 jsalt_index(jnano3) = 40 ! sn
9395 jsalt_index(jnacl) = 10 ! sc
9396 jsalt_index(jcano3) = 120 ! cn
9397 jsalt_index(jcacl2) = 80 ! cc
9398 jsalt_index(jnh4msa) = 0 ! AM zero for now
9399 jsalt_index(jnamsa) = 0 ! SM zero for now
9400 jsalt_index(jcamsa2) = 0 ! CM zero for now
9401
9402
9403 ! aerosol indices
9404 ! ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
9405 ! ab = 1, lv = 2, sb = 10
9406 !
9407 ! sulfate-poor domain
9408 jsulf_poor(1) = 1 ! ac
9409 jsulf_poor(2) = 2 ! an
9410 jsulf_poor(5) = 3 ! as
9411 jsulf_poor(10) = 4 ! sc
9412 jsulf_poor(40) = 5 ! sn
9413 jsulf_poor(60) = 6 ! ss
9414 jsulf_poor(80) = 7 ! cc
9415 jsulf_poor(120) = 8 ! cn
9416 jsulf_poor(3) = 9 ! an + ac
9417 jsulf_poor(6) = 10 ! as + ac
9418 jsulf_poor(7) = 11 ! as + an
9419 jsulf_poor(8) = 12 ! as + an + ac
9420 jsulf_poor(11) = 13 ! sc + ac
9421 jsulf_poor(41) = 14 ! sn + ac
9422 jsulf_poor(42) = 15 ! sn + an
9423 jsulf_poor(43) = 16 ! sn + an + ac
9424 jsulf_poor(50) = 17 ! sn + sc
9425 jsulf_poor(51) = 18 ! sn + sc + ac
9426 jsulf_poor(61) = 19 ! ss + ac
9427 jsulf_poor(62) = 20 ! ss + an
9428 jsulf_poor(63) = 21 ! ss + an + ac
9429 jsulf_poor(65) = 22 ! ss + as
9430 jsulf_poor(66) = 23 ! ss + as + ac
9431 jsulf_poor(67) = 24 ! ss + as + an
9432 jsulf_poor(68) = 25 ! ss + as + an + ac
9433 jsulf_poor(70) = 26 ! ss + sc
9434 jsulf_poor(71) = 27 ! ss + sc + ac
9435 jsulf_poor(100) = 28 ! ss + sn
9436 jsulf_poor(101) = 29 ! ss + sn + ac
9437 jsulf_poor(102) = 30 ! ss + sn + an
9438 jsulf_poor(103) = 31 ! ss + sn + an + ac
9439 jsulf_poor(110) = 32 ! ss + sn + sc
9440 jsulf_poor(111) = 33 ! ss + sn + sc + ac
9441 jsulf_poor(81) = 34 ! cc + ac
9442 jsulf_poor(90) = 35 ! cc + sc
9443 jsulf_poor(91) = 36 ! cc + sc + ac
9444 jsulf_poor(121) = 37 ! cn + ac
9445 jsulf_poor(122) = 38 ! cn + an
9446 jsulf_poor(123) = 39 ! cn + an + ac
9447 jsulf_poor(130) = 40 ! cn + sc
9448 jsulf_poor(131) = 41 ! cn + sc + ac
9449 jsulf_poor(160) = 42 ! cn + sn
9450 jsulf_poor(161) = 43 ! cn + sn + ac
9451 jsulf_poor(162) = 44 ! cn + sn + an
9452 jsulf_poor(163) = 45 ! cn + sn + an + ac
9453 jsulf_poor(170) = 46 ! cn + sn + sc
9454 jsulf_poor(171) = 47 ! cn + sn + sc + ac
9455 jsulf_poor(200) = 48 ! cn + cc
9456 jsulf_poor(201) = 49 ! cn + cc + ac
9457 jsulf_poor(210) = 50 ! cn + cc + sc
9458 jsulf_poor(211) = 51 ! cn + cc + sc + ac
9459 !
9460 ! sulfate-rich domain
9461 jsulf_rich(1) = 52 ! ab
9462 jsulf_rich(2) = 53 ! lv
9463 jsulf_rich(10) = 54 ! sb
9464 jsulf_rich(3) = 55 ! ab + lv
9465 jsulf_rich(7) = 56 ! as + lv
9466 jsulf_rich(70) = 57 ! ss + sb
9467 jsulf_rich(62) = 58 ! ss + lv
9468 jsulf_rich(67) = 59 ! ss + as + lv
9469 jsulf_rich(61) = 60 ! ss + ab
9470 jsulf_rich(63) = 61 ! ss + lv + ab
9471 jsulf_rich(11) = 62 ! sb + ab
9472 jsulf_rich(71) = 63 ! ss + sb + ab
9473 jsulf_rich(5) = 3 ! as
9474 jsulf_rich(60) = 6 ! ss
9475 jsulf_rich(65) = 22 ! ss + as
9476
9477
9478
9479 !
9480 ! polynomial coefficients for binary molality (used in zsr equation)
9481 !
9482 !
9483 ! a_zsr for aw < 0.97
9484 !
9485 ! (nh4)2so4
9486 je = jnh4so4
9487 a_zsr(1,je) = 1.30894
9488 a_zsr(2,je) = -7.09922
9489 a_zsr(3,je) = 20.62831
9490 a_zsr(4,je) = -32.19965
9491 a_zsr(5,je) = 25.17026
9492 a_zsr(6,je) = -7.81632
9493 aw_min(je) = 0.1
9494 !
9495 ! (nh4)3h(so4)2
9496 je = jlvcite
9497 a_zsr(1,je) = 1.10725
9498 a_zsr(2,je) = -5.17978
9499 a_zsr(3,je) = 12.29534
9500 a_zsr(4,je) = -16.32545
9501 a_zsr(5,je) = 11.29274
9502 a_zsr(6,je) = -3.19164
9503 aw_min(je) = 0.1
9504 !
9505 ! nh4hso4
9506 je = jnh4hso4
9507 a_zsr(1,je) = 1.15510
9508 a_zsr(2,je) = -3.20815
9509 a_zsr(3,je) = 2.71141
9510 a_zsr(4,je) = 2.01155
9511 a_zsr(5,je) = -4.71014
9512 a_zsr(6,je) = 2.04616
9513 aw_min(je) = 0.1
9514 !
9515 ! nh4msa (assumed same as nh4hso4)
9516 je = jnh4msa
9517 a_zsr(1,je) = 1.15510
9518 a_zsr(2,je) = -3.20815
9519 a_zsr(3,je) = 2.71141
9520 a_zsr(4,je) = 2.01155
9521 a_zsr(5,je) = -4.71014
9522 a_zsr(6,je) = 2.04616
9523 aw_min(je) = 0.1
9524 !
9525 ! nh4no3
9526 je = jnh4no3
9527 a_zsr(1,je) = 0.43507
9528 a_zsr(2,je) = 6.38220
9529 a_zsr(3,je) = -30.19797
9530 a_zsr(4,je) = 53.36470
9531 a_zsr(5,je) = -43.44203
9532 a_zsr(6,je) = 13.46158
9533 aw_min(je) = 0.1
9534 !
9535 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
9536 je = jnh4cl
9537 a_zsr(1,je) = 0.45309
9538 a_zsr(2,je) = 2.65606
9539 a_zsr(3,je) = -14.7730
9540 a_zsr(4,je) = 26.2936
9541 a_zsr(5,je) = -20.5735
9542 a_zsr(6,je) = 5.94255
9543 aw_min(je) = 0.1
9544 !
9545 ! nacl
9546 je = jnacl
9547 a_zsr(1,je) = 0.42922
9548 a_zsr(2,je) = -1.17718
9549 a_zsr(3,je) = 2.80208
9550 a_zsr(4,je) = -4.51097
9551 a_zsr(5,je) = 3.76963
9552 a_zsr(6,je) = -1.31359
9553 aw_min(je) = 0.1
9554 !
9555 ! nano3
9556 je = jnano3
9557 a_zsr(1,je) = 1.34966
9558 a_zsr(2,je) = -5.20116
9559 a_zsr(3,je) = 11.49011
9560 a_zsr(4,je) = -14.41380
9561 a_zsr(5,je) = 9.07037
9562 a_zsr(6,je) = -2.29769
9563 aw_min(je) = 0.1
9564 !
9565 ! na2so4
9566 je = jna2so4
9567 a_zsr(1,je) = 0.39888
9568 a_zsr(2,je) = -1.27150
9569 a_zsr(3,je) = 3.42792
9570 a_zsr(4,je) = -5.92632
9571 a_zsr(5,je) = 5.33351
9572 a_zsr(6,je) = -1.96541
9573 aw_min(je) = 0.1
9574 !
9575 ! na3h(so4)2 added on 1/14/2004
9576 je = jna3hso4
9577 a_zsr(1,je) = 0.31480
9578 a_zsr(2,je) = -1.01087
9579 a_zsr(3,je) = 2.44029
9580 a_zsr(4,je) = -3.66095
9581 a_zsr(5,je) = 2.77632
9582 a_zsr(6,je) = -0.86058
9583 aw_min(je) = 0.1
9584 !
9585 ! nahso4
9586 je = jnahso4
9587 a_zsr(1,je) = 0.62764
9588 a_zsr(2,je) = -1.63520
9589 a_zsr(3,je) = 4.62531
9590 a_zsr(4,je) = -10.06925
9591 a_zsr(5,je) = 10.33547
9592 a_zsr(6,je) = -3.88729
9593 aw_min(je) = 0.1
9594 !
9595 ! namsa (assumed same as nahso4)
9596 je = jnamsa
9597 a_zsr(1,je) = 0.62764
9598 a_zsr(2,je) = -1.63520
9599 a_zsr(3,je) = 4.62531
9600 a_zsr(4,je) = -10.06925
9601 a_zsr(5,je) = 10.33547
9602 a_zsr(6,je) = -3.88729
9603 aw_min(je) = 0.1
9604 !
9605 ! ca(no3)2
9606 je = jcano3
9607 a_zsr(1,je) = 0.38895
9608 a_zsr(2,je) = -1.16013
9609 a_zsr(3,je) = 2.16819
9610 a_zsr(4,je) = -2.23079
9611 a_zsr(5,je) = 1.00268
9612 a_zsr(6,je) = -0.16923
9613 aw_min(je) = 0.1
9614 !
9615 ! cacl2: kim and seinfeld
9616 je = jcacl2
9617 a_zsr(1,je) = 0.29891
9618 a_zsr(2,je) = -1.31104
9619 a_zsr(3,je) = 3.68759
9620 a_zsr(4,je) = -5.81708
9621 a_zsr(5,je) = 4.67520
9622 a_zsr(6,je) = -1.53223
9623 aw_min(je) = 0.1
9624 !
9625 ! h2so4
9626 je = jh2so4
9627 a_zsr(1,je) = 0.32751
9628 a_zsr(2,je) = -1.00692
9629 a_zsr(3,je) = 2.59750
9630 a_zsr(4,je) = -4.40014
9631 a_zsr(5,je) = 3.88212
9632 a_zsr(6,je) = -1.39916
9633 aw_min(je) = 0.1
9634 !
9635 ! msa (assumed same as h2so4)
9636 je = jmsa
9637 a_zsr(1,je) = 0.32751
9638 a_zsr(2,je) = -1.00692
9639 a_zsr(3,je) = 2.59750
9640 a_zsr(4,je) = -4.40014
9641 a_zsr(5,je) = 3.88212
9642 a_zsr(6,je) = -1.39916
9643 aw_min(je) = 0.1
9644 !
9645 ! hhso4
9646 je = jhhso4
9647 a_zsr(1,je) = 0.32751
9648 a_zsr(2,je) = -1.00692
9649 a_zsr(3,je) = 2.59750
9650 a_zsr(4,je) = -4.40014
9651 a_zsr(5,je) = 3.88212
9652 a_zsr(6,je) = -1.39916
9653 aw_min(je) = 1.0
9654 !
9655 ! hno3
9656 je = jhno3
9657 a_zsr(1,je) = 0.75876
9658 a_zsr(2,je) = -3.31529
9659 a_zsr(3,je) = 9.26392
9660 a_zsr(4,je) = -14.89799
9661 a_zsr(5,je) = 12.08781
9662 a_zsr(6,je) = -3.89958
9663 aw_min(je) = 0.1
9664 !
9665 ! hcl
9666 je = jhcl
9667 a_zsr(1,je) = 0.31133
9668 a_zsr(2,je) = -0.79688
9669 a_zsr(3,je) = 1.93995
9670 a_zsr(4,je) = -3.31582
9671 a_zsr(5,je) = 2.93513
9672 a_zsr(6,je) = -1.07268
9673 aw_min(je) = 0.1
9674 !
9675 ! caso4
9676 je = jcaso4
9677 a_zsr(1,je) = 0.0
9678 a_zsr(2,je) = 0.0
9679 a_zsr(3,je) = 0.0
9680 a_zsr(4,je) = 0.0
9681 a_zsr(5,je) = 0.0
9682 a_zsr(6,je) = 0.0
9683 aw_min(je) = 1.0
9684 !
9685 ! ca(msa)2 (assumed same as ca(no3)2)
9686 je = jcamsa2
9687 a_zsr(1,je) = 0.38895
9688 a_zsr(2,je) = -1.16013
9689 a_zsr(3,je) = 2.16819
9690 a_zsr(4,je) = -2.23079
9691 a_zsr(5,je) = 1.00268
9692 a_zsr(6,je) = -0.16923
9693 aw_min(je) = 0.1
9694 !
9695 ! caco3
9696 je = jcaco3
9697 a_zsr(1,je) = 0.0
9698 a_zsr(2,je) = 0.0
9699 a_zsr(3,je) = 0.0
9700 a_zsr(4,je) = 0.0
9701 a_zsr(5,je) = 0.0
9702 a_zsr(6,je) = 0.0
9703 aw_min(je) = 1.0
9704
9705
9706
9707 !-------------------------------------------
9708 ! b_zsr for aw => 0.97 to 0.99999
9709 !
9710 ! (nh4)2so4
9711 b_zsr(jnh4so4) = 28.0811
9712 !
9713 ! (nh4)3h(so4)2
9714 b_zsr(jlvcite) = 14.7178
9715 !
9716 ! nh4hso4
9717 b_zsr(jnh4hso4) = 29.4779
9718 !
9719 ! nh4msa
9720 b_zsr(jnh4msa) = 29.4779 ! assumed same as nh4hso4
9721 !
9722 ! nh4no3
9723 b_zsr(jnh4no3) = 33.4049
9724 !
9725 ! nh4cl
9726 b_zsr(jnh4cl) = 30.8888
9727 !
9728 ! nacl
9729 b_zsr(jnacl) = 29.8375
9730 !
9731 ! nano3
9732 b_zsr(jnano3) = 32.2756
9733 !
9734 ! na2so4
9735 b_zsr(jna2so4) = 27.6889
9736 !
9737 ! na3h(so4)2
9738 b_zsr(jna3hso4) = 14.2184
9739 !
9740 ! nahso4
9741 b_zsr(jnahso4) = 28.3367
9742 !
9743 ! namsa
9744 b_zsr(jnamsa) = 28.3367 ! assumed same as nahso4
9745 !
9746 ! ca(no3)2
9747 b_zsr(jcano3) = 18.3661
9748 !
9749 ! cacl2
9750 b_zsr(jcacl2) = 20.8792
9751 !
9752 ! h2so4
9753 b_zsr(jh2so4) = 26.7347
9754 !
9755 ! hhso4
9756 b_zsr(jhhso4) = 26.7347
9757 !
9758 ! hno3
9759 b_zsr(jhno3) = 28.8257
9760 !
9761 ! hcl
9762 b_zsr(jhcl) = 27.7108
9763 !
9764 ! msa
9765 b_zsr(jmsa) = 26.7347 ! assumed same as h2so4
9766 !
9767 ! caso4
9768 b_zsr(jcaso4) = 0.0
9769 !
9770 ! ca(msa)2
9771 b_zsr(jcamsa2) = 18.3661 ! assumed same as Ca(NO3)2
9772 !
9773 ! caco3
9774 b_zsr(jcaco3) = 0.0
9775
9776
9777
9778
9779
9780
9781
9782 !----------------------------------------------------------------
9783 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
9784 ! log_gamz(ja,je) a in e
9785 !----------------------------------------------------------------
9786 !
9787 ! (nh4)2so4 in e
9788 ja = jnh4so4
9789
9790 ! in (nh4)2so4
9791 je = jnh4so4
9792 b_mtem(1,ja,je) = -2.94685
9793 b_mtem(2,ja,je) = 17.3328
9794 b_mtem(3,ja,je) = -64.8441
9795 b_mtem(4,ja,je) = 122.7070
9796 b_mtem(5,ja,je) = -114.4373
9797 b_mtem(6,ja,je) = 41.6811
9798
9799 ! in nh4no3
9800 je = jnh4no3
9801 b_mtem(1,ja,je) = -2.7503
9802 b_mtem(2,ja,je) = 4.3806
9803 b_mtem(3,ja,je) = -1.1110
9804 b_mtem(4,ja,je) = -1.7005
9805 b_mtem(5,ja,je) = -4.4207
9806 b_mtem(6,ja,je) = 5.1990
9807
9808 ! in nh4cl (revised on 11/15/2003)
9809 je = jnh4cl
9810 b_mtem(1,ja,je) = -2.06952
9811 b_mtem(2,ja,je) = 7.1240
9812 b_mtem(3,ja,je) = -24.4274
9813 b_mtem(4,ja,je) = 51.1458
9814 b_mtem(5,ja,je) = -54.2056
9815 b_mtem(6,ja,je) = 22.0606
9816
9817 ! in na2so4
9818 je = jna2so4
9819 b_mtem(1,ja,je) = -2.17361
9820 b_mtem(2,ja,je) = 15.9919
9821 b_mtem(3,ja,je) = -69.0952
9822 b_mtem(4,ja,je) = 139.8860
9823 b_mtem(5,ja,je) = -134.9890
9824 b_mtem(6,ja,je) = 49.8877
9825
9826 ! in nano3
9827 je = jnano3
9828 b_mtem(1,ja,je) = -4.4370
9829 b_mtem(2,ja,je) = 24.0243
9830 b_mtem(3,ja,je) = -76.2437
9831 b_mtem(4,ja,je) = 128.6660
9832 b_mtem(5,ja,je) = -110.0900
9833 b_mtem(6,ja,je) = 37.7414
9834
9835 ! in nacl
9836 je = jnacl
9837 b_mtem(1,ja,je) = -1.5394
9838 b_mtem(2,ja,je) = 5.8671
9839 b_mtem(3,ja,je) = -22.7726
9840 b_mtem(4,ja,je) = 47.0547
9841 b_mtem(5,ja,je) = -47.8266
9842 b_mtem(6,ja,je) = 18.8489
9843
9844 ! in hno3
9845 je = jhno3
9846 b_mtem(1,ja,je) = -0.35750
9847 b_mtem(2,ja,je) = -3.82466
9848 b_mtem(3,ja,je) = 4.55462
9849 b_mtem(4,ja,je) = 5.05402
9850 b_mtem(5,ja,je) = -14.7476
9851 b_mtem(6,ja,je) = 8.8009
9852
9853 ! in hcl
9854 je = jhcl
9855 b_mtem(1,ja,je) = -2.15146
9856 b_mtem(2,ja,je) = 5.50205
9857 b_mtem(3,ja,je) = -19.1476
9858 b_mtem(4,ja,je) = 39.1880
9859 b_mtem(5,ja,je) = -39.9460
9860 b_mtem(6,ja,je) = 16.0700
9861
9862 ! in h2so4
9863 je = jh2so4
9864 b_mtem(1,ja,je) = -2.52604
9865 b_mtem(2,ja,je) = 9.76022
9866 b_mtem(3,ja,je) = -35.2540
9867 b_mtem(4,ja,je) = 71.2981
9868 b_mtem(5,ja,je) = -71.8207
9869 b_mtem(6,ja,je) = 28.0758
9870
9871 !
9872 ! in nh4hso4
9873 je = jnh4hso4
9874 b_mtem(1,ja,je) = -4.13219
9875 b_mtem(2,ja,je) = 13.8863
9876 b_mtem(3,ja,je) = -34.5387
9877 b_mtem(4,ja,je) = 56.5012
9878 b_mtem(5,ja,je) = -51.8702
9879 b_mtem(6,ja,je) = 19.6232
9880
9881 !
9882 ! in (nh4)3h(so4)2
9883 je = jlvcite
9884 b_mtem(1,ja,je) = -2.53482
9885 b_mtem(2,ja,je) = 12.3333
9886 b_mtem(3,ja,je) = -46.1020
9887 b_mtem(4,ja,je) = 90.4775
9888 b_mtem(5,ja,je) = -88.1254
9889 b_mtem(6,ja,je) = 33.4715
9890
9891 !
9892 ! in nahso4
9893 je = jnahso4
9894 b_mtem(1,ja,je) = -3.23425
9895 b_mtem(2,ja,je) = 18.7842
9896 b_mtem(3,ja,je) = -78.7807
9897 b_mtem(4,ja,je) = 161.517
9898 b_mtem(5,ja,je) = -154.940
9899 b_mtem(6,ja,je) = 56.2252
9900
9901 !
9902 ! in na3h(so4)2
9903 je = jna3hso4
9904 b_mtem(1,ja,je) = -1.25316
9905 b_mtem(2,ja,je) = 7.40960
9906 b_mtem(3,ja,je) = -34.8929
9907 b_mtem(4,ja,je) = 72.8853
9908 b_mtem(5,ja,je) = -72.4503
9909 b_mtem(6,ja,je) = 27.7706
9910
9911
9912 !-----------------
9913 ! nh4no3 in e
9914 ja = jnh4no3
9915
9916 ! in (nh4)2so4
9917 je = jnh4so4
9918 b_mtem(1,ja,je) = -3.5201
9919 b_mtem(2,ja,je) = 21.6584
9920 b_mtem(3,ja,je) = -72.1499
9921 b_mtem(4,ja,je) = 126.7000
9922 b_mtem(5,ja,je) = -111.4550
9923 b_mtem(6,ja,je) = 38.5677
9924
9925 ! in nh4no3
9926 je = jnh4no3
9927 b_mtem(1,ja,je) = -2.2630
9928 b_mtem(2,ja,je) = -0.1518
9929 b_mtem(3,ja,je) = 17.0898
9930 b_mtem(4,ja,je) = -36.7832
9931 b_mtem(5,ja,je) = 29.8407
9932 b_mtem(6,ja,je) = -7.9314
9933
9934 ! in nh4cl (revised on 11/15/2003)
9935 je = jnh4cl
9936 b_mtem(1,ja,je) = -1.3851
9937 b_mtem(2,ja,je) = -0.4462
9938 b_mtem(3,ja,je) = 8.4567
9939 b_mtem(4,ja,je) = -11.5988
9940 b_mtem(5,ja,je) = 2.9802
9941 b_mtem(6,ja,je) = 1.8132
9942
9943 ! in na2so4
9944 je = jna2so4
9945 b_mtem(1,ja,je) = -1.7602
9946 b_mtem(2,ja,je) = 10.4044
9947 b_mtem(3,ja,je) = -35.5894
9948 b_mtem(4,ja,je) = 64.3584
9949 b_mtem(5,ja,je) = -57.8931
9950 b_mtem(6,ja,je) = 20.2141
9951
9952 ! in nano3
9953 je = jnano3
9954 b_mtem(1,ja,je) = -3.24346
9955 b_mtem(2,ja,je) = 16.2794
9956 b_mtem(3,ja,je) = -48.7601
9957 b_mtem(4,ja,je) = 79.2246
9958 b_mtem(5,ja,je) = -65.8169
9959 b_mtem(6,ja,je) = 22.1500
9960
9961 ! in nacl
9962 je = jnacl
9963 b_mtem(1,ja,je) = -1.75658
9964 b_mtem(2,ja,je) = 7.71384
9965 b_mtem(3,ja,je) = -22.7984
9966 b_mtem(4,ja,je) = 39.1532
9967 b_mtem(5,ja,je) = -34.6165
9968 b_mtem(6,ja,je) = 12.1283
9969
9970 ! in ca(no3)2
9971 je = jcano3
9972 b_mtem(1,ja,je) = -0.97178
9973 b_mtem(2,ja,je) = 6.61964
9974 b_mtem(3,ja,je) = -26.2353
9975 b_mtem(4,ja,je) = 50.5259
9976 b_mtem(5,ja,je) = -47.6586
9977 b_mtem(6,ja,je) = 17.5074
9978
9979 ! in cacl2 added on 12/22/2003
9980 je = jcacl2
9981 b_mtem(1,ja,je) = -0.41515
9982 b_mtem(2,ja,je) = 6.44101
9983 b_mtem(3,ja,je) = -26.4473
9984 b_mtem(4,ja,je) = 49.0718
9985 b_mtem(5,ja,je) = -44.2631
9986 b_mtem(6,ja,je) = 15.3771
9987
9988 ! in hno3
9989 je = jhno3
9990 b_mtem(1,ja,je) = -1.20644
9991 b_mtem(2,ja,je) = 5.70117
9992 b_mtem(3,ja,je) = -18.2783
9993 b_mtem(4,ja,je) = 31.7199
9994 b_mtem(5,ja,je) = -27.8703
9995 b_mtem(6,ja,je) = 9.7299
9996
9997 ! in hcl
9998 je = jhcl
9999 b_mtem(1,ja,je) = -0.680862
10000 b_mtem(2,ja,je) = 3.59456
10001 b_mtem(3,ja,je) = -10.7969
10002 b_mtem(4,ja,je) = 17.8434
10003 b_mtem(5,ja,je) = -15.3165
10004 b_mtem(6,ja,je) = 5.17123
10005
10006
10007 !----------
10008 ! nh4cl in e
10009 ja = jnh4cl
10010
10011 ! in (nh4)2so4
10012 je = jnh4so4
10013 b_mtem(1,ja,je) = -2.8850
10014 b_mtem(2,ja,je) = 20.6970
10015 b_mtem(3,ja,je) = -70.6810
10016 b_mtem(4,ja,je) = 124.3690
10017 b_mtem(5,ja,je) = -109.2880
10018 b_mtem(6,ja,je) = 37.5831
10019
10020 ! in nh4no3
10021 je = jnh4no3
10022 b_mtem(1,ja,je) = -1.9386
10023 b_mtem(2,ja,je) = 1.3238
10024 b_mtem(3,ja,je) = 11.8500
10025 b_mtem(4,ja,je) = -28.1168
10026 b_mtem(5,ja,je) = 21.8543
10027 b_mtem(6,ja,je) = -5.1671
10028
10029 ! in nh4cl (revised on 11/15/2003)
10030 je = jnh4cl
10031 b_mtem(1,ja,je) = -0.9559
10032 b_mtem(2,ja,je) = 0.8121
10033 b_mtem(3,ja,je) = 4.3644
10034 b_mtem(4,ja,je) = -8.9258
10035 b_mtem(5,ja,je) = 4.2362
10036 b_mtem(6,ja,je) = 0.2891
10037
10038 ! in na2so4
10039 je = jna2so4
10040 b_mtem(1,ja,je) = 0.0377
10041 b_mtem(2,ja,je) = 6.0752
10042 b_mtem(3,ja,je) = -30.8641
10043 b_mtem(4,ja,je) = 63.3095
10044 b_mtem(5,ja,je) = -61.0070
10045 b_mtem(6,ja,je) = 22.1734
10046
10047 ! in nano3
10048 je = jnano3
10049 b_mtem(1,ja,je) = -1.8336
10050 b_mtem(2,ja,je) = 12.8160
10051 b_mtem(3,ja,je) = -42.3388
10052 b_mtem(4,ja,je) = 71.1816
10053 b_mtem(5,ja,je) = -60.5708
10054 b_mtem(6,ja,je) = 20.5853
10055
10056 ! in nacl
10057 je = jnacl
10058 b_mtem(1,ja,je) = -0.1429
10059 b_mtem(2,ja,je) = 2.3561
10060 b_mtem(3,ja,je) = -10.4425
10061 b_mtem(4,ja,je) = 20.8951
10062 b_mtem(5,ja,je) = -20.7739
10063 b_mtem(6,ja,je) = 7.9355
10064
10065 ! in ca(no3)2
10066 je = jcano3
10067 b_mtem(1,ja,je) = 0.76235
10068 b_mtem(2,ja,je) = 3.08323
10069 b_mtem(3,ja,je) = -23.6772
10070 b_mtem(4,ja,je) = 53.7415
10071 b_mtem(5,ja,je) = -55.4043
10072 b_mtem(6,ja,je) = 21.2944
10073
10074 ! in cacl2 (revised on 11/27/2003)
10075 je = jcacl2
10076 b_mtem(1,ja,je) = 1.13864
10077 b_mtem(2,ja,je) = -0.340539
10078 b_mtem(3,ja,je) = -8.67025
10079 b_mtem(4,ja,je) = 22.8008
10080 b_mtem(5,ja,je) = -24.5181
10081 b_mtem(6,ja,je) = 9.3663
10082
10083 ! in hno3
10084 je = jhno3
10085 b_mtem(1,ja,je) = 2.42532
10086 b_mtem(2,ja,je) = -14.1755
10087 b_mtem(3,ja,je) = 38.804
10088 b_mtem(4,ja,je) = -58.2437
10089 b_mtem(5,ja,je) = 43.5431
10090 b_mtem(6,ja,je) = -12.5824
10091
10092 ! in hcl
10093 je = jhcl
10094 b_mtem(1,ja,je) = 0.330337
10095 b_mtem(2,ja,je) = 0.0778934
10096 b_mtem(3,ja,je) = -2.30492
10097 b_mtem(4,ja,je) = 4.73003
10098 b_mtem(5,ja,je) = -4.80849
10099 b_mtem(6,ja,je) = 1.78866
10100
10101
10102 !----------
10103 ! na2so4 in e
10104 ja = jna2so4
10105
10106 ! in (nh4)2so4
10107 je = jnh4so4
10108 b_mtem(1,ja,je) = -2.6982
10109 b_mtem(2,ja,je) = 22.9875
10110 b_mtem(3,ja,je) = -98.9840
10111 b_mtem(4,ja,je) = 198.0180
10112 b_mtem(5,ja,je) = -188.7270
10113 b_mtem(6,ja,je) = 69.0548
10114
10115 ! in nh4no3
10116 je = jnh4no3
10117 b_mtem(1,ja,je) = -2.4844
10118 b_mtem(2,ja,je) = 6.5420
10119 b_mtem(3,ja,je) = -9.8998
10120 b_mtem(4,ja,je) = 11.3884
10121 b_mtem(5,ja,je) = -13.6842
10122 b_mtem(6,ja,je) = 7.7411
10123
10124 ! in nh4cl (revised on 11/15/2003)
10125 je = jnh4cl
10126 b_mtem(1,ja,je) = -1.3325
10127 b_mtem(2,ja,je) = 13.0406
10128 b_mtem(3,ja,je) = -56.1935
10129 b_mtem(4,ja,je) = 107.1170
10130 b_mtem(5,ja,je) = -97.3721
10131 b_mtem(6,ja,je) = 34.3763
10132
10133 ! in na2so4
10134 je = jna2so4
10135 b_mtem(1,ja,je) = -1.2832
10136 b_mtem(2,ja,je) = 12.8526
10137 b_mtem(3,ja,je) = -62.2087
10138 b_mtem(4,ja,je) = 130.3876
10139 b_mtem(5,ja,je) = -128.2627
10140 b_mtem(6,ja,je) = 48.0340
10141
10142 ! in nano3
10143 je = jnano3
10144 b_mtem(1,ja,je) = -3.5384
10145 b_mtem(2,ja,je) = 21.3758
10146 b_mtem(3,ja,je) = -70.7638
10147 b_mtem(4,ja,je) = 121.1580
10148 b_mtem(5,ja,je) = -104.6230
10149 b_mtem(6,ja,je) = 36.0557
10150
10151 ! in nacl
10152 je = jnacl
10153 b_mtem(1,ja,je) = 0.2175
10154 b_mtem(2,ja,je) = -0.5648
10155 b_mtem(3,ja,je) = -8.0288
10156 b_mtem(4,ja,je) = 25.9734
10157 b_mtem(5,ja,je) = -32.3577
10158 b_mtem(6,ja,je) = 14.3924
10159
10160 ! in hno3
10161 je = jhno3
10162 b_mtem(1,ja,je) = -0.309617
10163 b_mtem(2,ja,je) = -1.82899
10164 b_mtem(3,ja,je) = -1.5505
10165 b_mtem(4,ja,je) = 13.3847
10166 b_mtem(5,ja,je) = -20.1284
10167 b_mtem(6,ja,je) = 9.93163
10168
10169 ! in hcl
10170 je = jhcl
10171 b_mtem(1,ja,je) = -0.259455
10172 b_mtem(2,ja,je) = -0.819366
10173 b_mtem(3,ja,je) = -4.28964
10174 b_mtem(4,ja,je) = 16.4305
10175 b_mtem(5,ja,je) = -21.8546
10176 b_mtem(6,ja,je) = 10.3044
10177
10178 ! in h2so4
10179 je = jh2so4
10180 b_mtem(1,ja,je) = -1.84257
10181 b_mtem(2,ja,je) = 7.85788
10182 b_mtem(3,ja,je) = -29.9275
10183 b_mtem(4,ja,je) = 61.7515
10184 b_mtem(5,ja,je) = -63.2308
10185 b_mtem(6,ja,je) = 24.9542
10186
10187 ! in nh4hso4
10188 je = jnh4hso4
10189 b_mtem(1,ja,je) = -1.05891
10190 b_mtem(2,ja,je) = 2.84831
10191 b_mtem(3,ja,je) = -21.1827
10192 b_mtem(4,ja,je) = 57.5175
10193 b_mtem(5,ja,je) = -64.8120
10194 b_mtem(6,ja,je) = 26.1986
10195
10196 ! in (nh4)3h(so4)2
10197 je = jlvcite
10198 b_mtem(1,ja,je) = -1.16584
10199 b_mtem(2,ja,je) = 8.50075
10200 b_mtem(3,ja,je) = -44.3420
10201 b_mtem(4,ja,je) = 97.3974
10202 b_mtem(5,ja,je) = -98.4549
10203 b_mtem(6,ja,je) = 37.6104
10204
10205 ! in nahso4
10206 je = jnahso4
10207 b_mtem(1,ja,je) = -1.95805
10208 b_mtem(2,ja,je) = 6.62417
10209 b_mtem(3,ja,je) = -31.8072
10210 b_mtem(4,ja,je) = 77.8603
10211 b_mtem(5,ja,je) = -84.6458
10212 b_mtem(6,ja,je) = 33.4963
10213
10214 ! in na3h(so4)2
10215 je = jna3hso4
10216 b_mtem(1,ja,je) = -0.36045
10217 b_mtem(2,ja,je) = 3.55223
10218 b_mtem(3,ja,je) = -24.0327
10219 b_mtem(4,ja,je) = 54.4879
10220 b_mtem(5,ja,je) = -56.6531
10221 b_mtem(6,ja,je) = 22.4956
10222
10223
10224 !----------
10225 ! nano3 in e
10226 ja = jnano3
10227
10228 ! in (nh4)2so4
10229 je = jnh4so4
10230 b_mtem(1,ja,je) = -2.5888
10231 b_mtem(2,ja,je) = 17.6192
10232 b_mtem(3,ja,je) = -63.2183
10233 b_mtem(4,ja,je) = 115.3520
10234 b_mtem(5,ja,je) = -104.0860
10235 b_mtem(6,ja,je) = 36.7390
10236
10237 ! in nh4no3
10238 je = jnh4no3
10239 b_mtem(1,ja,je) = -2.0669
10240 b_mtem(2,ja,je) = 1.4792
10241 b_mtem(3,ja,je) = 10.5261
10242 b_mtem(4,ja,je) = -27.0987
10243 b_mtem(5,ja,je) = 23.0591
10244 b_mtem(6,ja,je) = -6.0938
10245
10246 ! in nh4cl (revised on 11/15/2003)
10247 je = jnh4cl
10248 b_mtem(1,ja,je) = -0.8325
10249 b_mtem(2,ja,je) = 3.9933
10250 b_mtem(3,ja,je) = -15.3789
10251 b_mtem(4,ja,je) = 30.4050
10252 b_mtem(5,ja,je) = -29.4204
10253 b_mtem(6,ja,je) = 11.0597
10254
10255 ! in na2so4
10256 je = jna2so4
10257 b_mtem(1,ja,je) = -1.1233
10258 b_mtem(2,ja,je) = 8.3998
10259 b_mtem(3,ja,je) = -31.9002
10260 b_mtem(4,ja,je) = 60.1450
10261 b_mtem(5,ja,je) = -55.5503
10262 b_mtem(6,ja,je) = 19.7757
10263
10264 ! in nano3
10265 je = jnano3
10266 b_mtem(1,ja,je) = -2.5386
10267 b_mtem(2,ja,je) = 13.9039
10268 b_mtem(3,ja,je) = -42.8467
10269 b_mtem(4,ja,je) = 69.7442
10270 b_mtem(5,ja,je) = -57.8988
10271 b_mtem(6,ja,je) = 19.4635
10272
10273 ! in nacl
10274 je = jnacl
10275 b_mtem(1,ja,je) = -0.4351
10276 b_mtem(2,ja,je) = 2.8311
10277 b_mtem(3,ja,je) = -11.4485
10278 b_mtem(4,ja,je) = 22.7201
10279 b_mtem(5,ja,je) = -22.4228
10280 b_mtem(6,ja,je) = 8.5792
10281
10282 ! in ca(no3)2
10283 je = jcano3
10284 b_mtem(1,ja,je) = -0.72060
10285 b_mtem(2,ja,je) = 5.64915
10286 b_mtem(3,ja,je) = -23.5020
10287 b_mtem(4,ja,je) = 46.0078
10288 b_mtem(5,ja,je) = -43.8075
10289 b_mtem(6,ja,je) = 16.1652
10290
10291 ! in cacl2
10292 je = jcacl2
10293 b_mtem(1,ja,je) = 0.003928
10294 b_mtem(2,ja,je) = 3.54724
10295 b_mtem(3,ja,je) = -18.6057
10296 b_mtem(4,ja,je) = 38.1445
10297 b_mtem(5,ja,je) = -36.7745
10298 b_mtem(6,ja,je) = 13.4529
10299
10300 ! in hno3
10301 je = jhno3
10302 b_mtem(1,ja,je) = -1.1712
10303 b_mtem(2,ja,je) = 7.20907
10304 b_mtem(3,ja,je) = -22.9215
10305 b_mtem(4,ja,je) = 38.1257
10306 b_mtem(5,ja,je) = -32.0759
10307 b_mtem(6,ja,je) = 10.6443
10308
10309 ! in hcl
10310 je = jhcl
10311 b_mtem(1,ja,je) = 0.738022
10312 b_mtem(2,ja,je) = -1.14313
10313 b_mtem(3,ja,je) = 0.32251
10314 b_mtem(4,ja,je) = 0.838679
10315 b_mtem(5,ja,je) = -1.81747
10316 b_mtem(6,ja,je) = 0.873986
10317
10318
10319 !----------
10320 ! nacl in e
10321 ja = jnacl
10322
10323 ! in (nh4)2so4
10324 je = jnh4so4
10325 b_mtem(1,ja,je) = -1.9525
10326 b_mtem(2,ja,je) = 16.6433
10327 b_mtem(3,ja,je) = -61.7090
10328 b_mtem(4,ja,je) = 112.9910
10329 b_mtem(5,ja,je) = -101.9370
10330 b_mtem(6,ja,je) = 35.7760
10331
10332 ! in nh4no3
10333 je = jnh4no3
10334 b_mtem(1,ja,je) = -1.7525
10335 b_mtem(2,ja,je) = 3.0713
10336 b_mtem(3,ja,je) = 4.8063
10337 b_mtem(4,ja,je) = -17.5334
10338 b_mtem(5,ja,je) = 14.2872
10339 b_mtem(6,ja,je) = -3.0690
10340
10341 ! in nh4cl (revised on 11/15/2003)
10342 je = jnh4cl
10343 b_mtem(1,ja,je) = -0.4021
10344 b_mtem(2,ja,je) = 5.2399
10345 b_mtem(3,ja,je) = -19.4278
10346 b_mtem(4,ja,je) = 33.0027
10347 b_mtem(5,ja,je) = -28.1020
10348 b_mtem(6,ja,je) = 9.5159
10349
10350 ! in na2so4
10351 je = jna2so4
10352 b_mtem(1,ja,je) = 0.6692
10353 b_mtem(2,ja,je) = 4.1207
10354 b_mtem(3,ja,je) = -27.3314
10355 b_mtem(4,ja,je) = 59.3112
10356 b_mtem(5,ja,je) = -58.7998
10357 b_mtem(6,ja,je) = 21.7674
10358
10359 ! in nano3
10360 je = jnano3
10361 b_mtem(1,ja,je) = -1.17444
10362 b_mtem(2,ja,je) = 10.9927
10363 b_mtem(3,ja,je) = -38.9013
10364 b_mtem(4,ja,je) = 66.8521
10365 b_mtem(5,ja,je) = -57.6564
10366 b_mtem(6,ja,je) = 19.7296
10367
10368 ! in nacl
10369 je = jnacl
10370 b_mtem(1,ja,je) = 1.17679
10371 b_mtem(2,ja,je) = -2.5061
10372 b_mtem(3,ja,je) = 0.8508
10373 b_mtem(4,ja,je) = 4.4802
10374 b_mtem(5,ja,je) = -8.4945
10375 b_mtem(6,ja,je) = 4.3182
10376
10377 ! in ca(no3)2
10378 je = jcano3
10379 b_mtem(1,ja,je) = 1.01450
10380 b_mtem(2,ja,je) = 2.10260
10381 b_mtem(3,ja,je) = -20.9036
10382 b_mtem(4,ja,je) = 49.1481
10383 b_mtem(5,ja,je) = -51.4867
10384 b_mtem(6,ja,je) = 19.9301
10385
10386 ! in cacl2 (psc92: revised on 11/27/2003)
10387 je = jcacl2
10388 b_mtem(1,ja,je) = 1.55463
10389 b_mtem(2,ja,je) = -3.20122
10390 b_mtem(3,ja,je) = -0.957075
10391 b_mtem(4,ja,je) = 12.103
10392 b_mtem(5,ja,je) = -17.221
10393 b_mtem(6,ja,je) = 7.50264
10394
10395 ! in hno3
10396 je = jhno3
10397 b_mtem(1,ja,je) = 2.46187
10398 b_mtem(2,ja,je) = -12.6845
10399 b_mtem(3,ja,je) = 34.2383
10400 b_mtem(4,ja,je) = -51.9992
10401 b_mtem(5,ja,je) = 39.4934
10402 b_mtem(6,ja,je) = -11.7247
10403
10404 ! in hcl
10405 je = jhcl
10406 b_mtem(1,ja,je) = 1.74915
10407 b_mtem(2,ja,je) = -4.65768
10408 b_mtem(3,ja,je) = 8.80287
10409 b_mtem(4,ja,je) = -12.2503
10410 b_mtem(5,ja,je) = 8.668751
10411 b_mtem(6,ja,je) = -2.50158
10412
10413
10414 !----------
10415 ! ca(no3)2 in e
10416 ja = jcano3
10417
10418 ! in nh4no3
10419 je = jnh4no3
10420 b_mtem(1,ja,je) = -1.86260
10421 b_mtem(2,ja,je) = 11.6178
10422 b_mtem(3,ja,je) = -30.9069
10423 b_mtem(4,ja,je) = 41.7578
10424 b_mtem(5,ja,je) = -33.7338
10425 b_mtem(6,ja,je) = 12.7541
10426
10427 ! in nh4cl (revised on 11/15/2003)
10428 je = jnh4cl
10429 b_mtem(1,ja,je) = -1.1798
10430 b_mtem(2,ja,je) = 25.9608
10431 b_mtem(3,ja,je) = -98.9373
10432 b_mtem(4,ja,je) = 160.2300
10433 b_mtem(5,ja,je) = -125.9540
10434 b_mtem(6,ja,je) = 39.5130
10435
10436 ! in nano3
10437 je = jnano3
10438 b_mtem(1,ja,je) = -1.44384
10439 b_mtem(2,ja,je) = 13.6044
10440 b_mtem(3,ja,je) = -54.4300
10441 b_mtem(4,ja,je) = 100.582
10442 b_mtem(5,ja,je) = -91.2364
10443 b_mtem(6,ja,je) = 32.5970
10444
10445 ! in nacl
10446 je = jnacl
10447 b_mtem(1,ja,je) = -0.099114
10448 b_mtem(2,ja,je) = 2.84091
10449 b_mtem(3,ja,je) = -16.9229
10450 b_mtem(4,ja,je) = 37.4839
10451 b_mtem(5,ja,je) = -39.5132
10452 b_mtem(6,ja,je) = 15.8564
10453
10454 ! in ca(no3)2
10455 je = jcano3
10456 b_mtem(1,ja,je) = 0.055116
10457 b_mtem(2,ja,je) = 4.58610
10458 b_mtem(3,ja,je) = -27.6629
10459 b_mtem(4,ja,je) = 60.8288
10460 b_mtem(5,ja,je) = -61.4988
10461 b_mtem(6,ja,je) = 23.3136
10462
10463 ! in cacl2 (psc92: revised on 11/27/2003)
10464 je = jcacl2
10465 b_mtem(1,ja,je) = 1.57155
10466 b_mtem(2,ja,je) = -3.18486
10467 b_mtem(3,ja,je) = -3.35758
10468 b_mtem(4,ja,je) = 18.7501
10469 b_mtem(5,ja,je) = -24.5604
10470 b_mtem(6,ja,je) = 10.3798
10471
10472 ! in hno3
10473 je = jhno3
10474 b_mtem(1,ja,je) = 1.04446
10475 b_mtem(2,ja,je) = -3.19066
10476 b_mtem(3,ja,je) = 2.44714
10477 b_mtem(4,ja,je) = 2.07218
10478 b_mtem(5,ja,je) = -6.43949
10479 b_mtem(6,ja,je) = 3.66471
10480
10481 ! in hcl
10482 je = jhcl
10483 b_mtem(1,ja,je) = 1.05723
10484 b_mtem(2,ja,je) = -1.46826
10485 b_mtem(3,ja,je) = -1.0713
10486 b_mtem(4,ja,je) = 4.64439
10487 b_mtem(5,ja,je) = -6.32402
10488 b_mtem(6,ja,je) = 2.78202
10489
10490
10491 !----------
10492 ! cacl2 in e
10493 ja = jcacl2
10494
10495 ! in nh4no3 (psc92: revised on 12/22/2003)
10496 je = jnh4no3
10497 b_mtem(1,ja,je) = -1.43626
10498 b_mtem(2,ja,je) = 13.6598
10499 b_mtem(3,ja,je) = -38.2068
10500 b_mtem(4,ja,je) = 53.9057
10501 b_mtem(5,ja,je) = -44.9018
10502 b_mtem(6,ja,je) = 16.6120
10503
10504 ! in nh4cl (psc92: revised on 11/27/2003)
10505 je = jnh4cl
10506 b_mtem(1,ja,je) = -0.603965
10507 b_mtem(2,ja,je) = 27.6027
10508 b_mtem(3,ja,je) = -104.258
10509 b_mtem(4,ja,je) = 163.553
10510 b_mtem(5,ja,je) = -124.076
10511 b_mtem(6,ja,je) = 37.4153
10512
10513 ! in nano3 (psc92: revised on 12/22/2003)
10514 je = jnano3
10515 b_mtem(1,ja,je) = 0.44648
10516 b_mtem(2,ja,je) = 8.8850
10517 b_mtem(3,ja,je) = -45.5232
10518 b_mtem(4,ja,je) = 89.3263
10519 b_mtem(5,ja,je) = -83.8604
10520 b_mtem(6,ja,je) = 30.4069
10521
10522 ! in nacl (psc92: revised on 11/27/2003)
10523 je = jnacl
10524 b_mtem(1,ja,je) = 1.61927
10525 b_mtem(2,ja,je) = 0.247547
10526 b_mtem(3,ja,je) = -18.1252
10527 b_mtem(4,ja,je) = 45.2479
10528 b_mtem(5,ja,je) = -48.6072
10529 b_mtem(6,ja,je) = 19.2784
10530
10531 ! in ca(no3)2 (psc92: revised on 11/27/2003)
10532 je = jcano3
10533 b_mtem(1,ja,je) = 2.36667
10534 b_mtem(2,ja,je) = -0.123309
10535 b_mtem(3,ja,je) = -24.2723
10536 b_mtem(4,ja,je) = 65.1486
10537 b_mtem(5,ja,je) = -71.8504
10538 b_mtem(6,ja,je) = 28.3696
10539
10540 ! in cacl2 (psc92: revised on 11/27/2003)
10541 je = jcacl2
10542 b_mtem(1,ja,je) = 3.64023
10543 b_mtem(2,ja,je) = -12.1926
10544 b_mtem(3,ja,je) = 20.2028
10545 b_mtem(4,ja,je) = -16.0056
10546 b_mtem(5,ja,je) = 1.52355
10547 b_mtem(6,ja,je) = 2.44709
10548
10549 ! in hno3
10550 je = jhno3
10551 b_mtem(1,ja,je) = 5.88794
10552 b_mtem(2,ja,je) = -29.7083
10553 b_mtem(3,ja,je) = 78.6309
10554 b_mtem(4,ja,je) = -118.037
10555 b_mtem(5,ja,je) = 88.932
10556 b_mtem(6,ja,je) = -26.1407
10557
10558 ! in hcl
10559 je = jhcl
10560 b_mtem(1,ja,je) = 2.40628
10561 b_mtem(2,ja,je) = -6.16566
10562 b_mtem(3,ja,je) = 10.2851
10563 b_mtem(4,ja,je) = -12.9035
10564 b_mtem(5,ja,je) = 7.7441
10565 b_mtem(6,ja,je) = -1.74821
10566
10567
10568 !----------
10569 ! hno3 in e
10570 ja = jhno3
10571
10572 ! in (nh4)2so4
10573 je = jnh4so4
10574 b_mtem(1,ja,je) = -3.57598
10575 b_mtem(2,ja,je) = 21.5469
10576 b_mtem(3,ja,je) = -77.4111
10577 b_mtem(4,ja,je) = 144.136
10578 b_mtem(5,ja,je) = -132.849
10579 b_mtem(6,ja,je) = 47.9412
10580
10581 ! in nh4no3
10582 je = jnh4no3
10583 b_mtem(1,ja,je) = -2.00209
10584 b_mtem(2,ja,je) = -3.48399
10585 b_mtem(3,ja,je) = 34.9906
10586 b_mtem(4,ja,je) = -68.6653
10587 b_mtem(5,ja,je) = 54.0992
10588 b_mtem(6,ja,je) = -15.1343
10589
10590 ! in nh4cl revised on 12/22/2003
10591 je = jnh4cl
10592 b_mtem(1,ja,je) = -0.63790
10593 b_mtem(2,ja,je) = -1.67730
10594 b_mtem(3,ja,je) = 10.1727
10595 b_mtem(4,ja,je) = -14.9097
10596 b_mtem(5,ja,je) = 7.67410
10597 b_mtem(6,ja,je) = -0.79586
10598
10599 ! in nacl
10600 je = jnacl
10601 b_mtem(1,ja,je) = 1.3446
10602 b_mtem(2,ja,je) = -2.5578
10603 b_mtem(3,ja,je) = 1.3464
10604 b_mtem(4,ja,je) = 2.90537
10605 b_mtem(5,ja,je) = -6.53014
10606 b_mtem(6,ja,je) = 3.31339
10607
10608 ! in nano3
10609 je = jnano3
10610 b_mtem(1,ja,je) = -0.546636
10611 b_mtem(2,ja,je) = 10.3127
10612 b_mtem(3,ja,je) = -39.9603
10613 b_mtem(4,ja,je) = 71.4609
10614 b_mtem(5,ja,je) = -63.4958
10615 b_mtem(6,ja,je) = 22.0679
10616
10617 ! in na2so4
10618 je = jna2so4
10619 b_mtem(1,ja,je) = 1.35059
10620 b_mtem(2,ja,je) = 4.34557
10621 b_mtem(3,ja,je) = -35.8425
10622 b_mtem(4,ja,je) = 80.9868
10623 b_mtem(5,ja,je) = -81.6544
10624 b_mtem(6,ja,je) = 30.4841
10625
10626 ! in ca(no3)2
10627 je = jcano3
10628 b_mtem(1,ja,je) = 0.869414
10629 b_mtem(2,ja,je) = 2.98486
10630 b_mtem(3,ja,je) = -22.255
10631 b_mtem(4,ja,je) = 50.1863
10632 b_mtem(5,ja,je) = -51.214
10633 b_mtem(6,ja,je) = 19.2235
10634
10635 ! in cacl2 (km) revised on 12/22/2003
10636 je = jcacl2
10637 b_mtem(1,ja,je) = 1.42800
10638 b_mtem(2,ja,je) = -1.78959
10639 b_mtem(3,ja,je) = -2.49075
10640 b_mtem(4,ja,je) = 10.1877
10641 b_mtem(5,ja,je) = -12.1948
10642 b_mtem(6,ja,je) = 4.64475
10643
10644 ! in hno3 (added on 12/06/2004)
10645 je = jhno3
10646 b_mtem(1,ja,je) = 0.22035
10647 b_mtem(2,ja,je) = 2.94973
10648 b_mtem(3,ja,je) = -12.1469
10649 b_mtem(4,ja,je) = 20.4905
10650 b_mtem(5,ja,je) = -17.3966
10651 b_mtem(6,ja,je) = 5.70779
10652
10653 ! in hcl (added on 12/06/2004)
10654 je = jhcl
10655 b_mtem(1,ja,je) = 1.55503
10656 b_mtem(2,ja,je) = -3.61226
10657 b_mtem(3,ja,je) = 6.28265
10658 b_mtem(4,ja,je) = -8.69575
10659 b_mtem(5,ja,je) = 6.09372
10660 b_mtem(6,ja,je) = -1.80898
10661
10662 ! in h2so4
10663 je = jh2so4
10664 b_mtem(1,ja,je) = 1.10783
10665 b_mtem(2,ja,je) = -1.3363
10666 b_mtem(3,ja,je) = -1.83525
10667 b_mtem(4,ja,je) = 7.47373
10668 b_mtem(5,ja,je) = -9.72954
10669 b_mtem(6,ja,je) = 4.12248
10670
10671 ! in nh4hso4
10672 je = jnh4hso4
10673 b_mtem(1,ja,je) = -0.851026
10674 b_mtem(2,ja,je) = 12.2515
10675 b_mtem(3,ja,je) = -49.788
10676 b_mtem(4,ja,je) = 91.6215
10677 b_mtem(5,ja,je) = -81.4877
10678 b_mtem(6,ja,je) = 28.0002
10679
10680 ! in (nh4)3h(so4)2
10681 je = jlvcite
10682 b_mtem(1,ja,je) = -3.09464
10683 b_mtem(2,ja,je) = 14.9303
10684 b_mtem(3,ja,je) = -43.0454
10685 b_mtem(4,ja,je) = 72.6695
10686 b_mtem(5,ja,je) = -65.2140
10687 b_mtem(6,ja,je) = 23.4814
10688
10689 ! in nahso4
10690 je = jnahso4
10691 b_mtem(1,ja,je) = 1.22973
10692 b_mtem(2,ja,je) = 2.82702
10693 b_mtem(3,ja,je) = -17.5869
10694 b_mtem(4,ja,je) = 28.9564
10695 b_mtem(5,ja,je) = -23.5814
10696 b_mtem(6,ja,je) = 7.91153
10697
10698 ! in na3h(so4)2
10699 je = jna3hso4
10700 b_mtem(1,ja,je) = 1.64773
10701 b_mtem(2,ja,je) = 0.94188
10702 b_mtem(3,ja,je) = -19.1242
10703 b_mtem(4,ja,je) = 46.9887
10704 b_mtem(5,ja,je) = -50.9494
10705 b_mtem(6,ja,je) = 20.2169
10706
10707
10708 !----------
10709 ! hcl in e
10710 ja = jhcl
10711
10712 ! in (nh4)2so4
10713 je = jnh4so4
10714 b_mtem(1,ja,je) = -2.93783
10715 b_mtem(2,ja,je) = 20.5546
10716 b_mtem(3,ja,je) = -75.8548
10717 b_mtem(4,ja,je) = 141.729
10718 b_mtem(5,ja,je) = -130.697
10719 b_mtem(6,ja,je) = 46.9905
10720
10721 ! in nh4no3
10722 je = jnh4no3
10723 b_mtem(1,ja,je) = -1.69063
10724 b_mtem(2,ja,je) = -1.85303
10725 b_mtem(3,ja,je) = 29.0927
10726 b_mtem(4,ja,je) = -58.7401
10727 b_mtem(5,ja,je) = 44.999
10728 b_mtem(6,ja,je) = -11.9988
10729
10730 ! in nh4cl (revised on 11/15/2003)
10731 je = jnh4cl
10732 b_mtem(1,ja,je) = -0.2073
10733 b_mtem(2,ja,je) = -0.4322
10734 b_mtem(3,ja,je) = 6.1271
10735 b_mtem(4,ja,je) = -12.3146
10736 b_mtem(5,ja,je) = 8.9919
10737 b_mtem(6,ja,je) = -2.3388
10738
10739 ! in nacl
10740 je = jnacl
10741 b_mtem(1,ja,je) = 2.95913
10742 b_mtem(2,ja,je) = -7.92254
10743 b_mtem(3,ja,je) = 13.736
10744 b_mtem(4,ja,je) = -15.433
10745 b_mtem(5,ja,je) = 7.40386
10746 b_mtem(6,ja,je) = -0.918641
10747
10748 ! in nano3
10749 je = jnano3
10750 b_mtem(1,ja,je) = 0.893272
10751 b_mtem(2,ja,je) = 6.53768
10752 b_mtem(3,ja,je) = -32.3458
10753 b_mtem(4,ja,je) = 61.2834
10754 b_mtem(5,ja,je) = -56.4446
10755 b_mtem(6,ja,je) = 19.9202
10756
10757 ! in na2so4
10758 je = jna2so4
10759 b_mtem(1,ja,je) = 3.14484
10760 b_mtem(2,ja,je) = 0.077019
10761 b_mtem(3,ja,je) = -31.4199
10762 b_mtem(4,ja,je) = 80.5865
10763 b_mtem(5,ja,je) = -85.392
10764 b_mtem(6,ja,je) = 32.6644
10765
10766 ! in ca(no3)2
10767 je = jcano3
10768 b_mtem(1,ja,je) = 2.60432
10769 b_mtem(2,ja,je) = -0.55909
10770 b_mtem(3,ja,je) = -19.6671
10771 b_mtem(4,ja,je) = 53.3446
10772 b_mtem(5,ja,je) = -58.9076
10773 b_mtem(6,ja,je) = 22.9927
10774
10775 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
10776 je = jcacl2
10777 b_mtem(1,ja,je) = 2.98036
10778 b_mtem(2,ja,je) = -8.55365
10779 b_mtem(3,ja,je) = 15.2108
10780 b_mtem(4,ja,je) = -15.9359
10781 b_mtem(5,ja,je) = 7.41772
10782 b_mtem(6,ja,je) = -1.32143
10783
10784 ! in hno3 (added on 12/06/2004)
10785 je = jhno3
10786 b_mtem(1,ja,je) = 3.8533
10787 b_mtem(2,ja,je) = -16.9427
10788 b_mtem(3,ja,je) = 45.0056
10789 b_mtem(4,ja,je) = -69.6145
10790 b_mtem(5,ja,je) = 54.1491
10791 b_mtem(6,ja,je) = -16.6513
10792
10793 ! in hcl (added on 12/06/2004)
10794 je = jhcl
10795 b_mtem(1,ja,je) = 2.56665
10796 b_mtem(2,ja,je) = -7.13585
10797 b_mtem(3,ja,je) = 14.8103
10798 b_mtem(4,ja,je) = -21.8881
10799 b_mtem(5,ja,je) = 16.6808
10800 b_mtem(6,ja,je) = -5.22091
10801
10802 ! in h2so4
10803 je = jh2so4
10804 b_mtem(1,ja,je) = 2.50179
10805 b_mtem(2,ja,je) = -6.69364
10806 b_mtem(3,ja,je) = 11.6551
10807 b_mtem(4,ja,je) = -13.6897
10808 b_mtem(5,ja,je) = 7.36796
10809 b_mtem(6,ja,je) = -1.33245
10810
10811 ! in nh4hso4
10812 je = jnh4hso4
10813 b_mtem(1,ja,je) = 0.149955
10814 b_mtem(2,ja,je) = 11.8213
10815 b_mtem(3,ja,je) = -53.9164
10816 b_mtem(4,ja,je) = 101.574
10817 b_mtem(5,ja,je) = -91.4123
10818 b_mtem(6,ja,je) = 31.5487
10819
10820 ! in (nh4)3h(so4)2
10821 je = jlvcite
10822 b_mtem(1,ja,je) = -2.36927
10823 b_mtem(2,ja,je) = 14.8359
10824 b_mtem(3,ja,je) = -44.3443
10825 b_mtem(4,ja,je) = 73.6229
10826 b_mtem(5,ja,je) = -65.3366
10827 b_mtem(6,ja,je) = 23.3250
10828
10829 ! in nahso4
10830 je = jnahso4
10831 b_mtem(1,ja,je) = 2.72993
10832 b_mtem(2,ja,je) = -0.23406
10833 b_mtem(3,ja,je) = -10.4103
10834 b_mtem(4,ja,je) = 13.1586
10835 b_mtem(5,ja,je) = -7.79925
10836 b_mtem(6,ja,je) = 2.30843
10837
10838 ! in na3h(so4)2
10839 je = jna3hso4
10840 b_mtem(1,ja,je) = 3.51258
10841 b_mtem(2,ja,je) = -3.95107
10842 b_mtem(3,ja,je) = -11.0175
10843 b_mtem(4,ja,je) = 38.8617
10844 b_mtem(5,ja,je) = -48.1575
10845 b_mtem(6,ja,je) = 20.4717
10846
10847
10848 !----------
10849 ! 2h.so4 in e
10850 ja = jh2so4
10851
10852 ! in h2so4
10853 je = jh2so4
10854 b_mtem(1,ja,je) = 0.76734
10855 b_mtem(2,ja,je) = -1.12263
10856 b_mtem(3,ja,je) = -9.08728
10857 b_mtem(4,ja,je) = 30.3836
10858 b_mtem(5,ja,je) = -38.4133
10859 b_mtem(6,ja,je) = 17.0106
10860
10861 ! in nh4hso4
10862 je = jnh4hso4
10863 b_mtem(1,ja,je) = -2.03879
10864 b_mtem(2,ja,je) = 15.7033
10865 b_mtem(3,ja,je) = -58.7363
10866 b_mtem(4,ja,je) = 109.242
10867 b_mtem(5,ja,je) = -102.237
10868 b_mtem(6,ja,je) = 37.5350
10869
10870 ! in (nh4)3h(so4)2
10871 je = jlvcite
10872 b_mtem(1,ja,je) = -3.10228
10873 b_mtem(2,ja,je) = 16.6920
10874 b_mtem(3,ja,je) = -59.1522
10875 b_mtem(4,ja,je) = 113.487
10876 b_mtem(5,ja,je) = -110.890
10877 b_mtem(6,ja,je) = 42.4578
10878
10879 ! in (nh4)2so4
10880 je = jnh4so4
10881 b_mtem(1,ja,je) = -3.43885
10882 b_mtem(2,ja,je) = 21.0372
10883 b_mtem(3,ja,je) = -84.7026
10884 b_mtem(4,ja,je) = 165.324
10885 b_mtem(5,ja,je) = -156.101
10886 b_mtem(6,ja,je) = 57.3101
10887
10888 ! in nahso4
10889 je = jnahso4
10890 b_mtem(1,ja,je) = 0.33164
10891 b_mtem(2,ja,je) = 6.55864
10892 b_mtem(3,ja,je) = -33.5876
10893 b_mtem(4,ja,je) = 65.1798
10894 b_mtem(5,ja,je) = -63.2046
10895 b_mtem(6,ja,je) = 24.1783
10896
10897 ! in na3h(so4)2
10898 je = jna3hso4
10899 b_mtem(1,ja,je) = 3.06830
10900 b_mtem(2,ja,je) = -3.18408
10901 b_mtem(3,ja,je) = -19.6332
10902 b_mtem(4,ja,je) = 61.3657
10903 b_mtem(5,ja,je) = -73.4438
10904 b_mtem(6,ja,je) = 31.2334
10905
10906 ! in na2so4
10907 je = jna2so4
10908 b_mtem(1,ja,je) = 2.58649
10909 b_mtem(2,ja,je) = 0.87921
10910 b_mtem(3,ja,je) = -39.3023
10911 b_mtem(4,ja,je) = 101.603
10912 b_mtem(5,ja,je) = -109.469
10913 b_mtem(6,ja,je) = 43.0188
10914
10915 ! in hno3
10916 je = jhno3
10917 b_mtem(1,ja,je) = 1.54587
10918 b_mtem(2,ja,je) = -7.50976
10919 b_mtem(3,ja,je) = 12.8237
10920 b_mtem(4,ja,je) = -10.1452
10921 b_mtem(5,ja,je) = -0.541956
10922 b_mtem(6,ja,je) = 3.34536
10923
10924 ! in hcl
10925 je = jhcl
10926 b_mtem(1,ja,je) = 0.829757
10927 b_mtem(2,ja,je) = -4.11316
10928 b_mtem(3,ja,je) = 3.67111
10929 b_mtem(4,ja,je) = 3.6833
10930 b_mtem(5,ja,je) = -11.2711
10931 b_mtem(6,ja,je) = 6.71421
10932
10933
10934 !----------
10935 ! h.hso4 in e
10936 ja = jhhso4
10937
10938 ! in h2so4
10939 je = jh2so4
10940 b_mtem(1,ja,je) = 2.63953
10941 b_mtem(2,ja,je) = -6.01532
10942 b_mtem(3,ja,je) = 10.0204
10943 b_mtem(4,ja,je) = -12.4840
10944 b_mtem(5,ja,je) = 7.78853
10945 b_mtem(6,ja,je) = -2.12638
10946
10947 ! in nh4hso4
10948 je = jnh4hso4
10949 b_mtem(1,ja,je) = -0.77412
10950 b_mtem(2,ja,je) = 14.1656
10951 b_mtem(3,ja,je) = -53.4087
10952 b_mtem(4,ja,je) = 93.2013
10953 b_mtem(5,ja,je) = -80.5723
10954 b_mtem(6,ja,je) = 27.1577
10955
10956 ! in (nh4)3h(so4)2
10957 je = jlvcite
10958 b_mtem(1,ja,je) = -2.98882
10959 b_mtem(2,ja,je) = 14.4436
10960 b_mtem(3,ja,je) = -40.1774
10961 b_mtem(4,ja,je) = 67.5937
10962 b_mtem(5,ja,je) = -61.5040
10963 b_mtem(6,ja,je) = 22.3695
10964
10965 ! in (nh4)2so4
10966 je = jnh4so4
10967 b_mtem(1,ja,je) = -1.15502
10968 b_mtem(2,ja,je) = 8.12309
10969 b_mtem(3,ja,je) = -38.4726
10970 b_mtem(4,ja,je) = 80.8861
10971 b_mtem(5,ja,je) = -80.1644
10972 b_mtem(6,ja,je) = 30.4717
10973
10974 ! in nahso4
10975 je = jnahso4
10976 b_mtem(1,ja,je) = 1.99641
10977 b_mtem(2,ja,je) = -2.96061
10978 b_mtem(3,ja,je) = 5.54778
10979 b_mtem(4,ja,je) = -14.5488
10980 b_mtem(5,ja,je) = 14.8492
10981 b_mtem(6,ja,je) = -5.1389
10982
10983 ! in na3h(so4)2
10984 je = jna3hso4
10985 b_mtem(1,ja,je) = 2.23816
10986 b_mtem(2,ja,je) = -3.20847
10987 b_mtem(3,ja,je) = -4.82853
10988 b_mtem(4,ja,je) = 20.9192
10989 b_mtem(5,ja,je) = -27.2819
10990 b_mtem(6,ja,je) = 11.8655
10991
10992 ! in na2so4
10993 je = jna2so4
10994 b_mtem(1,ja,je) = 2.56907
10995 b_mtem(2,ja,je) = 1.13444
10996 b_mtem(3,ja,je) = -34.6853
10997 b_mtem(4,ja,je) = 87.9775
10998 b_mtem(5,ja,je) = -93.2330
10999 b_mtem(6,ja,je) = 35.9260
11000
11001 ! in hno3
11002 je = jhno3
11003 b_mtem(1,ja,je) = 2.00024
11004 b_mtem(2,ja,je) = -4.80868
11005 b_mtem(3,ja,je) = 8.29222
11006 b_mtem(4,ja,je) = -11.0849
11007 b_mtem(5,ja,je) = 7.51262
11008 b_mtem(6,ja,je) = -2.07654
11009
11010 ! in hcl
11011 je = jhcl
11012 b_mtem(1,ja,je) = 2.8009
11013 b_mtem(2,ja,je) = -6.98416
11014 b_mtem(3,ja,je) = 14.3146
11015 b_mtem(4,ja,je) = -22.0068
11016 b_mtem(5,ja,je) = 17.5557
11017 b_mtem(6,ja,je) = -5.84917
11018
11019
11020 !----------
11021 ! nh4hso4 in e
11022 ja = jnh4hso4
11023
11024 ! in h2so4
11025 je = jh2so4
11026 b_mtem(1,ja,je) = 0.169160
11027 b_mtem(2,ja,je) = 2.15094
11028 b_mtem(3,ja,je) = -9.62904
11029 b_mtem(4,ja,je) = 18.2631
11030 b_mtem(5,ja,je) = -17.3333
11031 b_mtem(6,ja,je) = 6.19835
11032
11033 ! in nh4hso4
11034 je = jnh4hso4
11035 b_mtem(1,ja,je) = -2.34457
11036 b_mtem(2,ja,je) = 12.8035
11037 b_mtem(3,ja,je) = -35.2513
11038 b_mtem(4,ja,je) = 53.6153
11039 b_mtem(5,ja,je) = -42.7655
11040 b_mtem(6,ja,je) = 13.7129
11041
11042 ! in (nh4)3h(so4)2
11043 je = jlvcite
11044 b_mtem(1,ja,je) = -2.56109
11045 b_mtem(2,ja,je) = 11.1414
11046 b_mtem(3,ja,je) = -30.2361
11047 b_mtem(4,ja,je) = 50.0320
11048 b_mtem(5,ja,je) = -44.1586
11049 b_mtem(6,ja,je) = 15.5393
11050
11051 ! in (nh4)2so4
11052 je = jnh4so4
11053 b_mtem(1,ja,je) = -0.97315
11054 b_mtem(2,ja,je) = 7.06295
11055 b_mtem(3,ja,je) = -29.3032
11056 b_mtem(4,ja,je) = 57.6101
11057 b_mtem(5,ja,je) = -54.9020
11058 b_mtem(6,ja,je) = 20.2222
11059
11060 ! in nahso4
11061 je = jnahso4
11062 b_mtem(1,ja,je) = -0.44450
11063 b_mtem(2,ja,je) = 3.33451
11064 b_mtem(3,ja,je) = -15.2791
11065 b_mtem(4,ja,je) = 30.1413
11066 b_mtem(5,ja,je) = -26.7710
11067 b_mtem(6,ja,je) = 8.78462
11068
11069 ! in na3h(so4)2
11070 je = jna3hso4
11071 b_mtem(1,ja,je) = -0.99780
11072 b_mtem(2,ja,je) = 4.69200
11073 b_mtem(3,ja,je) = -16.1219
11074 b_mtem(4,ja,je) = 29.3100
11075 b_mtem(5,ja,je) = -26.3383
11076 b_mtem(6,ja,je) = 9.20695
11077
11078 ! in na2so4
11079 je = jna2so4
11080 b_mtem(1,ja,je) = -0.52694
11081 b_mtem(2,ja,je) = 7.02684
11082 b_mtem(3,ja,je) = -33.7508
11083 b_mtem(4,ja,je) = 70.0565
11084 b_mtem(5,ja,je) = -68.3226
11085 b_mtem(6,ja,je) = 25.2692
11086
11087 ! in hno3
11088 je = jhno3
11089 b_mtem(1,ja,je) = 0.572926
11090 b_mtem(2,ja,je) = -2.04791
11091 b_mtem(3,ja,je) = 2.1134
11092 b_mtem(4,ja,je) = 0.246654
11093 b_mtem(5,ja,je) = -3.06019
11094 b_mtem(6,ja,je) = 1.98126
11095
11096 ! in hcl
11097 je = jhcl
11098 b_mtem(1,ja,je) = 0.56514
11099 b_mtem(2,ja,je) = 0.22287
11100 b_mtem(3,ja,je) = -2.76973
11101 b_mtem(4,ja,je) = 4.54444
11102 b_mtem(5,ja,je) = -3.86549
11103 b_mtem(6,ja,je) = 1.13441
11104
11105
11106 !----------
11107 ! (nh4)3h(so4)2 in e
11108 ja = jlvcite
11109
11110 ! in h2so4
11111 je = jh2so4
11112 b_mtem(1,ja,je) = -1.44811
11113 b_mtem(2,ja,je) = 6.71815
11114 b_mtem(3,ja,je) = -25.0141
11115 b_mtem(4,ja,je) = 50.1109
11116 b_mtem(5,ja,je) = -50.0561
11117 b_mtem(6,ja,je) = 19.3370
11118
11119 ! in nh4hso4
11120 je = jnh4hso4
11121 b_mtem(1,ja,je) = -3.41707
11122 b_mtem(2,ja,je) = 13.4496
11123 b_mtem(3,ja,je) = -34.8018
11124 b_mtem(4,ja,je) = 55.2987
11125 b_mtem(5,ja,je) = -48.1839
11126 b_mtem(6,ja,je) = 17.2444
11127
11128 ! in (nh4)3h(so4)2
11129 je = jlvcite
11130 b_mtem(1,ja,je) = -2.54479
11131 b_mtem(2,ja,je) = 11.8501
11132 b_mtem(3,ja,je) = -39.7286
11133 b_mtem(4,ja,je) = 74.2479
11134 b_mtem(5,ja,je) = -70.4934
11135 b_mtem(6,ja,je) = 26.2836
11136
11137 ! in (nh4)2so4
11138 je = jnh4so4
11139 b_mtem(1,ja,je) = -2.30561
11140 b_mtem(2,ja,je) = 14.5806
11141 b_mtem(3,ja,je) = -55.1238
11142 b_mtem(4,ja,je) = 103.451
11143 b_mtem(5,ja,je) = -95.2571
11144 b_mtem(6,ja,je) = 34.2218
11145
11146 ! in nahso4
11147 je = jnahso4
11148 b_mtem(1,ja,je) = -2.20809
11149 b_mtem(2,ja,je) = 13.6391
11150 b_mtem(3,ja,je) = -57.8246
11151 b_mtem(4,ja,je) = 117.907
11152 b_mtem(5,ja,je) = -112.154
11153 b_mtem(6,ja,je) = 40.3058
11154
11155 ! in na3h(so4)2
11156 je = jna3hso4
11157 b_mtem(1,ja,je) = -1.15099
11158 b_mtem(2,ja,je) = 6.32269
11159 b_mtem(3,ja,je) = -27.3860
11160 b_mtem(4,ja,je) = 55.4592
11161 b_mtem(5,ja,je) = -54.0100
11162 b_mtem(6,ja,je) = 20.3469
11163
11164 ! in na2so4
11165 je = jna2so4
11166 b_mtem(1,ja,je) = -1.15678
11167 b_mtem(2,ja,je) = 8.28718
11168 b_mtem(3,ja,je) = -37.3231
11169 b_mtem(4,ja,je) = 76.6124
11170 b_mtem(5,ja,je) = -74.9307
11171 b_mtem(6,ja,je) = 28.0559
11172
11173 ! in hno3
11174 je = jhno3
11175 b_mtem(1,ja,je) = 0.01502
11176 b_mtem(2,ja,je) = -3.1197
11177 b_mtem(3,ja,je) = 3.61104
11178 b_mtem(4,ja,je) = 3.05196
11179 b_mtem(5,ja,je) = -9.98957
11180 b_mtem(6,ja,je) = 6.04155
11181
11182 ! in hcl
11183 je = jhcl
11184 b_mtem(1,ja,je) = -1.06477
11185 b_mtem(2,ja,je) = 3.38801
11186 b_mtem(3,ja,je) = -12.5784
11187 b_mtem(4,ja,je) = 25.2823
11188 b_mtem(5,ja,je) = -25.4611
11189 b_mtem(6,ja,je) = 10.0754
11190
11191
11192 !----------
11193 ! nahso4 in e
11194 ja = jnahso4
11195
11196 ! in h2so4
11197 je = jh2so4
11198 b_mtem(1,ja,je) = 0.68259
11199 b_mtem(2,ja,je) = 0.71468
11200 b_mtem(3,ja,je) = -5.59003
11201 b_mtem(4,ja,je) = 11.0089
11202 b_mtem(5,ja,je) = -10.7983
11203 b_mtem(6,ja,je) = 3.82335
11204
11205 ! in nh4hso4
11206 je = jnh4hso4
11207 b_mtem(1,ja,je) = -0.03956
11208 b_mtem(2,ja,je) = 4.52828
11209 b_mtem(3,ja,je) = -25.2557
11210 b_mtem(4,ja,je) = 54.4225
11211 b_mtem(5,ja,je) = -52.5105
11212 b_mtem(6,ja,je) = 18.6562
11213
11214 ! in (nh4)3h(so4)2
11215 je = jlvcite
11216 b_mtem(1,ja,je) = -1.53503
11217 b_mtem(2,ja,je) = 8.27608
11218 b_mtem(3,ja,je) = -28.9539
11219 b_mtem(4,ja,je) = 55.2876
11220 b_mtem(5,ja,je) = -51.9563
11221 b_mtem(6,ja,je) = 18.6576
11222
11223 ! in (nh4)2so4
11224 je = jnh4so4
11225 b_mtem(1,ja,je) = -0.38793
11226 b_mtem(2,ja,je) = 7.14680
11227 b_mtem(3,ja,je) = -38.7201
11228 b_mtem(4,ja,je) = 84.3965
11229 b_mtem(5,ja,je) = -84.7453
11230 b_mtem(6,ja,je) = 32.1283
11231
11232 ! in nahso4
11233 je = jnahso4
11234 b_mtem(1,ja,je) = -0.41982
11235 b_mtem(2,ja,je) = 4.26491
11236 b_mtem(3,ja,je) = -20.2351
11237 b_mtem(4,ja,je) = 42.6764
11238 b_mtem(5,ja,je) = -40.7503
11239 b_mtem(6,ja,je) = 14.2868
11240
11241 ! in na3h(so4)2
11242 je = jna3hso4
11243 b_mtem(1,ja,je) = -0.32912
11244 b_mtem(2,ja,je) = 1.80808
11245 b_mtem(3,ja,je) = -8.01286
11246 b_mtem(4,ja,je) = 15.5791
11247 b_mtem(5,ja,je) = -14.5494
11248 b_mtem(6,ja,je) = 5.27052
11249
11250 ! in na2so4
11251 je = jna2so4
11252 b_mtem(1,ja,je) = 0.10271
11253 b_mtem(2,ja,je) = 5.09559
11254 b_mtem(3,ja,je) = -30.3295
11255 b_mtem(4,ja,je) = 66.2975
11256 b_mtem(5,ja,je) = -66.3458
11257 b_mtem(6,ja,je) = 24.9443
11258
11259 ! in hno3
11260 je = jhno3
11261 b_mtem(1,ja,je) = 0.608309
11262 b_mtem(2,ja,je) = -0.541905
11263 b_mtem(3,ja,je) = -2.52084
11264 b_mtem(4,ja,je) = 6.63297
11265 b_mtem(5,ja,je) = -7.24599
11266 b_mtem(6,ja,je) = 2.88811
11267
11268 ! in hcl
11269 je = jhcl
11270 b_mtem(1,ja,je) = 1.98399
11271 b_mtem(2,ja,je) = -4.51562
11272 b_mtem(3,ja,je) = 8.36059
11273 b_mtem(4,ja,je) = -12.4948
11274 b_mtem(5,ja,je) = 9.67514
11275 b_mtem(6,ja,je) = -3.18004
11276
11277
11278 !----------
11279 ! na3h(so4)2 in e
11280 ja = jna3hso4
11281
11282 ! in h2so4
11283 je = jh2so4
11284 b_mtem(1,ja,je) = -0.83214
11285 b_mtem(2,ja,je) = 4.99572
11286 b_mtem(3,ja,je) = -20.1697
11287 b_mtem(4,ja,je) = 41.4066
11288 b_mtem(5,ja,je) = -42.2119
11289 b_mtem(6,ja,je) = 16.4855
11290
11291 ! in nh4hso4
11292 je = jnh4hso4
11293 b_mtem(1,ja,je) = -0.65139
11294 b_mtem(2,ja,je) = 3.52300
11295 b_mtem(3,ja,je) = -22.8220
11296 b_mtem(4,ja,je) = 56.2956
11297 b_mtem(5,ja,je) = -59.9028
11298 b_mtem(6,ja,je) = 23.1844
11299
11300 ! in (nh4)3h(so4)2
11301 je = jlvcite
11302 b_mtem(1,ja,je) = -1.31331
11303 b_mtem(2,ja,je) = 8.40835
11304 b_mtem(3,ja,je) = -38.1757
11305 b_mtem(4,ja,je) = 80.5312
11306 b_mtem(5,ja,je) = -79.8346
11307 b_mtem(6,ja,je) = 30.0219
11308
11309 ! in (nh4)2so4
11310 je = jnh4so4
11311 b_mtem(1,ja,je) = -1.03054
11312 b_mtem(2,ja,je) = 8.08155
11313 b_mtem(3,ja,je) = -38.1046
11314 b_mtem(4,ja,je) = 78.7168
11315 b_mtem(5,ja,je) = -77.2263
11316 b_mtem(6,ja,je) = 29.1521
11317
11318 ! in nahso4
11319 je = jnahso4
11320 b_mtem(1,ja,je) = -1.90695
11321 b_mtem(2,ja,je) = 11.6241
11322 b_mtem(3,ja,je) = -50.3175
11323 b_mtem(4,ja,je) = 105.884
11324 b_mtem(5,ja,je) = -103.258
11325 b_mtem(6,ja,je) = 37.6588
11326
11327 ! in na3h(so4)2
11328 je = jna3hso4
11329 b_mtem(1,ja,je) = -0.34780
11330 b_mtem(2,ja,je) = 2.85363
11331 b_mtem(3,ja,je) = -17.6224
11332 b_mtem(4,ja,je) = 38.9220
11333 b_mtem(5,ja,je) = -39.8106
11334 b_mtem(6,ja,je) = 15.6055
11335
11336 ! in na2so4
11337 je = jna2so4
11338 b_mtem(1,ja,je) = -0.75230
11339 b_mtem(2,ja,je) = 10.0140
11340 b_mtem(3,ja,je) = -50.5677
11341 b_mtem(4,ja,je) = 106.941
11342 b_mtem(5,ja,je) = -105.534
11343 b_mtem(6,ja,je) = 39.5196
11344
11345 ! in hno3
11346 je = jhno3
11347 b_mtem(1,ja,je) = 0.057456
11348 b_mtem(2,ja,je) = -1.31264
11349 b_mtem(3,ja,je) = -1.94662
11350 b_mtem(4,ja,je) = 10.7024
11351 b_mtem(5,ja,je) = -14.9946
11352 b_mtem(6,ja,je) = 7.12161
11353
11354 ! in hcl
11355 je = jhcl
11356 b_mtem(1,ja,je) = 0.637894
11357 b_mtem(2,ja,je) = -2.29719
11358 b_mtem(3,ja,je) = 0.765361
11359 b_mtem(4,ja,je) = 4.8748
11360 b_mtem(5,ja,je) = -9.25978
11361 b_mtem(6,ja,je) = 4.91773
11362 !
11363 !
11364 !
11365 !----------------------------------------------------------
11366 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3 (t in kelvin)
11367 ! valid temperature range: 240 - 320 k
11368 !----------------------------------------------------------
11369 !
11370 ! sulfate-poor systems
11371 ! ac
11372 j_index = 1
11373 d_mdrh(j_index,1) = -58.00268351
11374 d_mdrh(j_index,2) = 2.031077573
11375 d_mdrh(j_index,3) = -0.008281218
11376 d_mdrh(j_index,4) = 1.00447e-05
11377
11378 ! an
11379 j_index = 2
11380 d_mdrh(j_index,1) = 1039.137773
11381 d_mdrh(j_index,2) = -11.47847095
11382 d_mdrh(j_index,3) = 0.047702786
11383 d_mdrh(j_index,4) = -6.77675e-05
11384
11385 ! as
11386 j_index = 3
11387 d_mdrh(j_index,1) = 115.8366357
11388 d_mdrh(j_index,2) = 0.491881663
11389 d_mdrh(j_index,3) = -0.00422807
11390 d_mdrh(j_index,4) = 7.29274e-06
11391
11392 ! sc
11393 j_index = 4
11394 d_mdrh(j_index,1) = 253.2424151
11395 d_mdrh(j_index,2) = -1.429957864
11396 d_mdrh(j_index,3) = 0.003727554
11397 d_mdrh(j_index,4) = -3.13037e-06
11398
11399 ! sn
11400 j_index = 5
11401 d_mdrh(j_index,1) = -372.4306506
11402 d_mdrh(j_index,2) = 5.3955633
11403 d_mdrh(j_index,3) = -0.019804438
11404 d_mdrh(j_index,4) = 2.25662e-05
11405
11406 ! ss
11407 j_index = 6
11408 d_mdrh(j_index,1) = 286.1271416
11409 d_mdrh(j_index,2) = -1.670787758
11410 d_mdrh(j_index,3) = 0.004431373
11411 d_mdrh(j_index,4) = -3.57757e-06
11412
11413 ! cc
11414 j_index = 7
11415 d_mdrh(j_index,1) = -1124.07059
11416 d_mdrh(j_index,2) = 14.26364209
11417 d_mdrh(j_index,3) = -0.054816822
11418 d_mdrh(j_index,4) = 6.70107e-05
11419
11420 ! cn
11421 j_index = 8
11422 d_mdrh(j_index,1) = 1855.413934
11423 d_mdrh(j_index,2) = -20.29219473
11424 d_mdrh(j_index,3) = 0.07807482
11425 d_mdrh(j_index,4) = -1.017887858e-4
11426
11427 ! an + ac
11428 j_index = 9
11429 d_mdrh(j_index,1) = 1761.176886
11430 d_mdrh(j_index,2) = -19.29811062
11431 d_mdrh(j_index,3) = 0.075676987
11432 d_mdrh(j_index,4) = -1.0116959e-4
11433
11434 ! as + ac
11435 j_index = 10
11436 d_mdrh(j_index,1) = 122.1074303
11437 d_mdrh(j_index,2) = 0.429692122
11438 d_mdrh(j_index,3) = -0.003928277
11439 d_mdrh(j_index,4) = 6.43275e-06
11440
11441 ! as + an
11442 j_index = 11
11443 d_mdrh(j_index,1) = 2424.634678
11444 d_mdrh(j_index,2) = -26.54031307
11445 d_mdrh(j_index,3) = 0.101625387
11446 d_mdrh(j_index,4) = -1.31544547798e-4
11447
11448 ! as + an + ac
11449 j_index = 12
11450 d_mdrh(j_index,1) = 2912.082599
11451 d_mdrh(j_index,2) = -31.8894185
11452 d_mdrh(j_index,3) = 0.121185849
11453 d_mdrh(j_index,4) = -1.556534623e-4
11454
11455 ! sc + ac
11456 j_index = 13
11457 d_mdrh(j_index,1) = 172.2596493
11458 d_mdrh(j_index,2) = -0.511006195
11459 d_mdrh(j_index,3) = 4.27244597e-4
11460 d_mdrh(j_index,4) = 4.12797e-07
11461
11462 ! sn + ac
11463 j_index = 14
11464 d_mdrh(j_index,1) = 1596.184935
11465 d_mdrh(j_index,2) = -16.37945565
11466 d_mdrh(j_index,3) = 0.060281218
11467 d_mdrh(j_index,4) = -7.6161e-05
11468
11469 ! sn + an
11470 j_index = 15
11471 d_mdrh(j_index,1) = 1916.072988
11472 d_mdrh(j_index,2) = -20.85594868
11473 d_mdrh(j_index,3) = 0.081140141
11474 d_mdrh(j_index,4) = -1.07954274796e-4
11475
11476 ! sn + an + ac
11477 j_index = 16
11478 d_mdrh(j_index,1) = 1467.165935
11479 d_mdrh(j_index,2) = -16.01166196
11480 d_mdrh(j_index,3) = 0.063505582
11481 d_mdrh(j_index,4) = -8.66722e-05
11482
11483 ! sn + sc
11484 j_index = 17
11485 d_mdrh(j_index,1) = 158.447059
11486 d_mdrh(j_index,2) = -0.628167358
11487 d_mdrh(j_index,3) = 0.002014448
11488 d_mdrh(j_index,4) = -3.13037e-06
11489
11490 ! sn + sc + ac
11491 j_index = 18
11492 d_mdrh(j_index,1) = 1115.892468
11493 d_mdrh(j_index,2) = -11.76936534
11494 d_mdrh(j_index,3) = 0.045577399
11495 d_mdrh(j_index,4) = -6.05779e-05
11496
11497 ! ss + ac
11498 j_index = 19
11499 d_mdrh(j_index,1) = 269.5432407
11500 d_mdrh(j_index,2) = -1.319963885
11501 d_mdrh(j_index,3) = 0.002592363
11502 d_mdrh(j_index,4) = -1.44479e-06
11503
11504 ! ss + an
11505 j_index = 20
11506 d_mdrh(j_index,1) = 2841.334784
11507 d_mdrh(j_index,2) = -31.1889487
11508 d_mdrh(j_index,3) = 0.118809274
11509 d_mdrh(j_index,4) = -1.53007e-4
11510
11511 ! ss + an + ac
11512 j_index = 21
11513 d_mdrh(j_index,1) = 2199.36914
11514 d_mdrh(j_index,2) = -24.11926569
11515 d_mdrh(j_index,3) = 0.092932361
11516 d_mdrh(j_index,4) = -1.21774e-4
11517
11518 ! ss + as
11519 j_index = 22
11520 d_mdrh(j_index,1) = 395.0051604
11521 d_mdrh(j_index,2) = -2.521101657
11522 d_mdrh(j_index,3) = 0.006139319
11523 d_mdrh(j_index,4) = -4.43756e-06
11524
11525 ! ss + as + ac
11526 j_index = 23
11527 d_mdrh(j_index,1) = 386.5150675
11528 d_mdrh(j_index,2) = -2.4632138
11529 d_mdrh(j_index,3) = 0.006139319
11530 d_mdrh(j_index,4) = -4.98796e-06
11531
11532 ! ss + as + an
11533 j_index = 24
11534 d_mdrh(j_index,1) = 3101.538491
11535 d_mdrh(j_index,2) = -34.19978105
11536 d_mdrh(j_index,3) = 0.130118605
11537 d_mdrh(j_index,4) = -1.66873e-4
11538
11539 ! ss + as + an + ac
11540 j_index = 25
11541 d_mdrh(j_index,1) = 2307.579403
11542 d_mdrh(j_index,2) = -25.43136774
11543 d_mdrh(j_index,3) = 0.098064728
11544 d_mdrh(j_index,4) = -1.28301e-4
11545
11546 ! ss + sc
11547 j_index = 26
11548 d_mdrh(j_index,1) = 291.8309602
11549 d_mdrh(j_index,2) = -1.828912974
11550 d_mdrh(j_index,3) = 0.005053148
11551 d_mdrh(j_index,4) = -4.57516e-06
11552
11553 ! ss + sc + ac
11554 j_index = 27
11555 d_mdrh(j_index,1) = 188.3914345
11556 d_mdrh(j_index,2) = -0.631345031
11557 d_mdrh(j_index,3) = 0.000622807
11558 d_mdrh(j_index,4) = 4.47196e-07
11559
11560 ! ss + sn
11561 j_index = 28
11562 d_mdrh(j_index,1) = -167.1252839
11563 d_mdrh(j_index,2) = 2.969828002
11564 d_mdrh(j_index,3) = -0.010637255
11565 d_mdrh(j_index,4) = 1.13175e-05
11566
11567 ! ss + sn + ac
11568 j_index = 29
11569 d_mdrh(j_index,1) = 1516.782768
11570 d_mdrh(j_index,2) = -15.7922661
11571 d_mdrh(j_index,3) = 0.058942209
11572 d_mdrh(j_index,4) = -7.5301e-05
11573
11574 ! ss + sn + an
11575 j_index = 30
11576 d_mdrh(j_index,1) = 1739.963163
11577 d_mdrh(j_index,2) = -19.06576022
11578 d_mdrh(j_index,3) = 0.07454963
11579 d_mdrh(j_index,4) = -9.94302e-05
11580
11581 ! ss + sn + an + ac
11582 j_index = 31
11583 d_mdrh(j_index,1) = 2152.104877
11584 d_mdrh(j_index,2) = -23.74998008
11585 d_mdrh(j_index,3) = 0.092256654
11586 d_mdrh(j_index,4) = -1.21953e-4
11587
11588 ! ss + sn + sc
11589 j_index = 32
11590 d_mdrh(j_index,1) = 221.9976265
11591 d_mdrh(j_index,2) = -1.311331272
11592 d_mdrh(j_index,3) = 0.004406089
11593 d_mdrh(j_index,4) = -5.88235e-06
11594
11595 ! ss + sn + sc + ac
11596 j_index = 33
11597 d_mdrh(j_index,1) = 1205.645615
11598 d_mdrh(j_index,2) = -12.71353459
11599 d_mdrh(j_index,3) = 0.048803922
11600 d_mdrh(j_index,4) = -6.41899e-05
11601
11602 ! cc + ac
11603 j_index = 34
11604 d_mdrh(j_index,1) = 506.6737879
11605 d_mdrh(j_index,2) = -3.723520818
11606 d_mdrh(j_index,3) = 0.010814242
11607 d_mdrh(j_index,4) = -1.21087e-05
11608
11609 ! cc + sc
11610 j_index = 35
11611 d_mdrh(j_index,1) = -1123.523841
11612 d_mdrh(j_index,2) = 14.08345977
11613 d_mdrh(j_index,3) = -0.053687823
11614 d_mdrh(j_index,4) = 6.52219e-05
11615
11616 ! cc + sc + ac
11617 j_index = 36
11618 d_mdrh(j_index,1) = -1159.98607
11619 d_mdrh(j_index,2) = 14.44309169
11620 d_mdrh(j_index,3) = -0.054841073
11621 d_mdrh(j_index,4) = 6.64259e-05
11622
11623 ! cn + ac
11624 j_index = 37
11625 d_mdrh(j_index,1) = 756.0747916
11626 d_mdrh(j_index,2) = -8.546826257
11627 d_mdrh(j_index,3) = 0.035798677
11628 d_mdrh(j_index,4) = -5.06629e-05
11629
11630 ! cn + an
11631 j_index = 38
11632 d_mdrh(j_index,1) = 338.668191
11633 d_mdrh(j_index,2) = -2.971223403
11634 d_mdrh(j_index,3) = 0.012294866
11635 d_mdrh(j_index,4) = -1.87558e-05
11636
11637 ! cn + an + ac
11638 j_index = 39
11639 d_mdrh(j_index,1) = -53.18033508
11640 d_mdrh(j_index,2) = 0.663911748
11641 d_mdrh(j_index,3) = 9.16326e-4
11642 d_mdrh(j_index,4) = -6.70354e-06
11643
11644 ! cn + sc
11645 j_index = 40
11646 d_mdrh(j_index,1) = 3623.831129
11647 d_mdrh(j_index,2) = -39.27226457
11648 d_mdrh(j_index,3) = 0.144559515
11649 d_mdrh(j_index,4) = -1.78159e-4
11650
11651 ! cn + sc + ac
11652 j_index = 41
11653 d_mdrh(j_index,1) = 3436.656743
11654 d_mdrh(j_index,2) = -37.16192684
11655 d_mdrh(j_index,3) = 0.136641377
11656 d_mdrh(j_index,4) = -1.68262e-4
11657
11658 ! cn + sn
11659 j_index = 42
11660 d_mdrh(j_index,1) = 768.608476
11661 d_mdrh(j_index,2) = -8.051517149
11662 d_mdrh(j_index,3) = 0.032342332
11663 d_mdrh(j_index,4) = -4.52224e-05
11664
11665 ! cn + sn + ac
11666 j_index = 43
11667 d_mdrh(j_index,1) = 33.58027951
11668 d_mdrh(j_index,2) = -0.308772182
11669 d_mdrh(j_index,3) = 0.004713639
11670 d_mdrh(j_index,4) = -1.19658e-05
11671
11672 ! cn + sn + an
11673 j_index = 44
11674 d_mdrh(j_index,1) = 57.80183041
11675 d_mdrh(j_index,2) = 0.215264604
11676 d_mdrh(j_index,3) = 4.11406e-4
11677 d_mdrh(j_index,4) = -4.30702e-06
11678
11679 ! cn + sn + an + ac
11680 j_index = 45
11681 d_mdrh(j_index,1) = -234.368984
11682 d_mdrh(j_index,2) = 2.721045204
11683 d_mdrh(j_index,3) = -0.006688341
11684 d_mdrh(j_index,4) = 2.31729e-06
11685
11686 ! cn + sn + sc
11687 j_index = 46
11688 d_mdrh(j_index,1) = 3879.080557
11689 d_mdrh(j_index,2) = -42.13562874
11690 d_mdrh(j_index,3) = 0.155235005
11691 d_mdrh(j_index,4) = -1.91387e-4
11692
11693 ! cn + sn + sc + ac
11694 j_index = 47
11695 d_mdrh(j_index,1) = 3600.576985
11696 d_mdrh(j_index,2) = -39.0283489
11697 d_mdrh(j_index,3) = 0.143710316
11698 d_mdrh(j_index,4) = -1.77167e-4
11699
11700 ! cn + cc
11701 j_index = 48
11702 d_mdrh(j_index,1) = -1009.729826
11703 d_mdrh(j_index,2) = 12.9145339
11704 d_mdrh(j_index,3) = -0.049811146
11705 d_mdrh(j_index,4) = 6.09563e-05
11706
11707 ! cn + cc + ac
11708 j_index = 49
11709 d_mdrh(j_index,1) = -577.0919514
11710 d_mdrh(j_index,2) = 8.020324227
11711 d_mdrh(j_index,3) = -0.031469556
11712 d_mdrh(j_index,4) = 3.82181e-05
11713
11714 ! cn + cc + sc
11715 j_index = 50
11716 d_mdrh(j_index,1) = -728.9983499
11717 d_mdrh(j_index,2) = 9.849458215
11718 d_mdrh(j_index,3) = -0.03879257
11719 d_mdrh(j_index,4) = 4.78844e-05
11720
11721 ! cn + cc + sc + ac
11722 j_index = 51
11723 d_mdrh(j_index,1) = -803.7026845
11724 d_mdrh(j_index,2) = 10.61881494
11725 d_mdrh(j_index,3) = -0.041402993
11726 d_mdrh(j_index,4) = 5.08084e-05
11727
11728 !
11729 ! sulfate-rich systems
11730 ! ab
11731 j_index = 52
11732 d_mdrh(j_index,1) = -493.6190458
11733 d_mdrh(j_index,2) = 6.747053851
11734 d_mdrh(j_index,3) = -0.026955267
11735 d_mdrh(j_index,4) = 3.45118e-05
11736
11737 ! lv
11738 j_index = 53
11739 d_mdrh(j_index,1) = 53.37874093
11740 d_mdrh(j_index,2) = 1.01368249
11741 d_mdrh(j_index,3) = -0.005887513
11742 d_mdrh(j_index,4) = 8.94393e-06
11743
11744 ! sb
11745 j_index = 54
11746 d_mdrh(j_index,1) = 206.619047
11747 d_mdrh(j_index,2) = -1.342735684
11748 d_mdrh(j_index,3) = 0.003197691
11749 d_mdrh(j_index,4) = -1.93603e-06
11750
11751 ! ab + lv
11752 j_index = 55
11753 d_mdrh(j_index,1) = -493.6190458
11754 d_mdrh(j_index,2) = 6.747053851
11755 d_mdrh(j_index,3) = -0.026955267
11756 d_mdrh(j_index,4) = 3.45118e-05
11757
11758 ! as + lv
11759 j_index = 56
11760 d_mdrh(j_index,1) = 53.37874093
11761 d_mdrh(j_index,2) = 1.01368249
11762 d_mdrh(j_index,3) = -0.005887513
11763 d_mdrh(j_index,4) = 8.94393e-06
11764
11765 ! ss + sb
11766 j_index = 57
11767 d_mdrh(j_index,1) = 206.619047
11768 d_mdrh(j_index,2) = -1.342735684
11769 d_mdrh(j_index,3) = 0.003197691
11770 d_mdrh(j_index,4) = -1.93603e-06
11771
11772 ! ss + lv
11773 j_index = 58
11774 d_mdrh(j_index,1) = 41.7619047
11775 d_mdrh(j_index,2) = 1.303872053
11776 d_mdrh(j_index,3) = -0.007647908
11777 d_mdrh(j_index,4) = 1.17845e-05
11778
11779 ! ss + as + lv
11780 j_index = 59
11781 d_mdrh(j_index,1) = 41.7619047
11782 d_mdrh(j_index,2) = 1.303872053
11783 d_mdrh(j_index,3) = -0.007647908
11784 d_mdrh(j_index,4) = 1.17845e-05
11785
11786 ! ss + ab
11787 j_index = 60
11788 d_mdrh(j_index,1) = -369.7142842
11789 d_mdrh(j_index,2) = 5.512878771
11790 d_mdrh(j_index,3) = -0.02301948
11791 d_mdrh(j_index,4) = 3.0303e-05
11792
11793 ! ss + lv + ab
11794 j_index = 61
11795 d_mdrh(j_index,1) = -369.7142842
11796 d_mdrh(j_index,2) = 5.512878771
11797 d_mdrh(j_index,3) = -0.02301948
11798 d_mdrh(j_index,4) = 3.0303e-05
11799
11800 ! sb + ab
11801 j_index = 62
11802 d_mdrh(j_index,1) = -162.8095232
11803 d_mdrh(j_index,2) = 2.399326592
11804 d_mdrh(j_index,3) = -0.009336219
11805 d_mdrh(j_index,4) = 1.17845e-05
11806
11807 ! ss + sb + ab
11808 j_index = 63
11809 d_mdrh(j_index,1) = -735.4285689
11810 d_mdrh(j_index,2) = 8.885521857
11811 d_mdrh(j_index,3) = -0.033488456
11812 d_mdrh(j_index,4) = 4.12458e-05
11813
11814
11815 endif ! first
11816
11817 return
11818 end subroutine load_mosaic_parameters
11819
11820
11821
11822
11823
11824
11825
11826
11827
11828
11829
11830 !***********************************************************************
11831 ! updates all temperature dependent thermodynamic parameters
11832 !
11833 ! author: rahul a. zaveri
11834 ! update: jan 2005
11835 !-----------------------------------------------------------------------
11836 subroutine update_thermodynamic_constants
11837 ! implicit none
11838 ! include 'mosaic.h'
11839 ! local variables
11840 integer iv, j_index, ibin, je
11841 real(kind=8) tr, rt, term
11842 ! function
11843 ! real(kind=8) fn_keq, fn_po, drh_mutual, bin_molality
11844
11845
11846 tr = 298.15 ! reference temperature
11847 rt = 82.056*t_k/(1.e9*1.e6) ! [m^3 atm/nmol]
11848
11849 ! gas-liquid
11850 keq_gl(1)= 1.0 ! kelvin effect (default)
11851 keq_gl(2)= fn_keq(57.64d0 , 13.79d0, -5.39d0,t_k)*rt ! nh3(g) <=> nh3(l)
11852 keq_gl(3)= fn_keq(2.63d6, 29.17d0, 16.83d0,t_k)*rt ! hno3(g) <=> no3- + h+
11853 keq_gl(4)= fn_keq(2.00d6, 30.20d0, 19.91d0,t_k)*rt ! hcl(g) <=> cl- + h+
11854
11855 ! liquid-liquid
11856 keq_ll(1)= fn_keq(1.0502d-2, 8.85d0, 25.14d0,t_k) ! hso4- <=> so4= + h+
11857 keq_ll(2)= fn_keq(1.805d-5, -1.50d0, 26.92d0,t_k) ! nh3(l) + h2o = nh4+ + oh-
11858 keq_ll(3)= fn_keq(1.01d-14,-22.52d0, 26.92d0,t_k) ! h2o(l) <=> h+ + oh-
11859
11860
11861 kp_nh3 = keq_ll(3)/(keq_ll(2)*keq_gl(2))
11862 kp_nh4no3= kp_nh3/keq_gl(3)
11863 kp_nh4cl = kp_nh3/keq_gl(4)
11864
11865
11866 ! solid-gas
11867 keq_sg(1)= fn_keq(4.72d-17,-74.38d0,6.12d0,t_k)/rt**2 ! nh4no3<=>nh3(g)+hno3(g)
11868 keq_sg(2)= fn_keq(8.43d-17,-71.00d0,2.40d0,t_k)/rt**2 ! nh4cl <=>nh3(g)+hcl(g)
11869
11870
11871 ! solid-liquid
11872 keq_sl(jnh4so4) = fn_keq(1.040d0,-2.65d0, 38.57d0, t_k) ! amso4(s) = 2nh4+ + so4=
11873 keq_sl(jlvcite) = fn_keq(11.8d0, -5.19d0, 54.40d0, t_k) ! lvcite(s)= 3nh4+ + hso4- + so4=
11874 keq_sl(jnh4hso4)= fn_keq(117.0d0,-2.87d0, 15.83d0, t_k) ! amhso4(s)= nh4+ + hso4-
11875 keq_sl(jnh4msa) = 1.e15 ! NH4MSA(s)= NH4+ + MSA-
11876 keq_sl(jnh4no3) = fn_keq(12.21d0,-10.4d0, 17.56d0, t_k) ! nh4no3(s)= nh4+ + no3-
11877 keq_sl(jnh4cl) = fn_keq(17.37d0,-6.03d0, 16.92d0, t_k) ! nh4cl(s) = nh4+ + cl-
11878 keq_sl(jna2so4) = fn_keq(0.491d0, 0.98d0, 39.75d0, t_k) ! na2so4(s)= 2na+ + so4=
11879 keq_sl(jnahso4) = fn_keq(313.0d0, 0.8d0, 14.79d0, t_k) ! nahso4(s)= na+ + hso4-
11880 keq_sl(jna3hso4)= 1.e15 ! na3h(so4)2(s) = 2na+ + hso4- + so4=
11881 keq_sl(jnamsa) = 1.e15 ! NaMSA(s) = Na+ + MSA-
11882 keq_sl(jnano3) = fn_keq(11.95d0,-8.22d0, 16.01d0, t_k) ! nano3(s) = na+ + no3-
11883 keq_sl(jnacl) = fn_keq(38.28d0,-1.52d0, 16.89d0, t_k) ! nacl(s) = na+ + cl-
11884 keq_sl(jcacl2) = fn_keq(8.0d11,32.84d0,44.79d0, t_k)*1.e5 ! cacl2(s) = ca++ + 2cl-
11885 keq_sl(jcano3) = fn_keq(4.31d5, 7.83d0,42.01d0, t_k)*1.e5 ! ca(no3)2(s) = ca++ + 2no3-
11886 keq_sl(jcamsa2) = 1.e15 ! CaMSA2(s)= Ca+ + 2MSA-
11887
11888 ! vapor pressures of soa species
11889 po_soa(iaro1_g) = fn_po(5.7d-5, 156.0d0, t_k) ! [pascal]
11890 po_soa(iaro2_g) = fn_po(1.6d-3, 156.0d0, t_k) ! [pascal]
11891 po_soa(ialk1_g) = fn_po(5.0d-6, 156.0d0, t_k) ! [pascal]
11892 po_soa(iole1_g) = fn_po(5.0d-6, 156.0d0, t_k) ! [pascal]
11893 po_soa(iapi1_g) = fn_po(4.0d-6, 156.0d0, t_k) ! [pascal]
11894 po_soa(iapi2_g) = fn_po(1.7d-4, 156.0d0, t_k) ! [pascal]
11895 po_soa(ilim1_g) = fn_po(2.5d-5, 156.0d0, t_k) ! [pascal]
11896 po_soa(ilim2_g) = fn_po(1.2d-4, 156.0d0, t_k) ! [pascal]
11897
11898 do iv = iaro1_g, ngas_volatile
11899 sat_soa(iv) = 1.e9*po_soa(iv)/(8.314*t_k) ! [nmol/m^3(air)]
11900 enddo
11901
11902 ! water surface tension
11903 term = (647.15 - t_k)/647.15
11904 sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
11905
11906 ! mdrh(t)
11907 do j_index = 1, 63
11908 mdrh_t(j_index) = drh_mutual(j_index)
11909 enddo
11910
11911
11912
11913 ! rh dependent parameters
11914 do ibin = 1, nbin_a
11915 ah2o_a(ibin) = ah2o ! initialize
11916 enddo
11917
11918 call mtem_compute_log_gamz ! function of ah2o and t
11919
11920
11921 return
11922 end subroutine update_thermodynamic_constants
11923
11924
11925
11926
11927 !***********************************************************************
11928 ! functions used in mosaic
11929 !
11930 ! author: rahul a. zaveri
11931 ! update: jan 2005
11932 !-----------------------------------------------------------------------
11933
11934
11935
11936 !----------------------------------------------------------
11937 real(kind=8) function fn_keq(keq_298, a, b, t)
11938 ! implicit none
11939 ! subr. arguments
11940 real(kind=8) keq_298, a, b, t
11941 ! local variables
11942 real(kind=8) tt
11943
11944
11945 tt = 298.15/t
11946 fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+log(tt)-tt))
11947
11948 return
11949 end function fn_keq
11950 !----------------------------------------------------------
11951
11952
11953
11954
11955
11956 !----------------------------------------------------------
11957 real(kind=8) function fn_po(po_298, dh, t) ! touch
11958 ! implicit none
11959 ! subr. arguments
11960 real(kind=8) po_298, dh, t
11961 ! local variables
11962
11963 fn_po = po_298*exp(-(dh/8.314e-3)*(1./t - 3.354016435e-3))
11964
11965 return
11966 end function fn_po
11967 !----------------------------------------------------------
11968
11969
11970
11971
11972
11973 !----------------------------------------------------------
11974 real(kind=8) function drh_mutual(j_index)
11975 ! implicit none
11976 ! include 'mosaic.h'
11977 ! subr. arguments
11978 integer j_index
11979 ! local variables
11980 integer j
11981
11982
11983 j = j_index
11984
11985 if(j_index .eq. 7 .or. j_index .eq. 8 .or. &
11986 (j_index.ge. 34 .and. j_index .le. 51))then
11987
11988 drh_mutual = 10.0 ! cano3 or cacl2 containing mixtures
11989
11990 else
11991
11992 drh_mutual = d_mdrh(j,1) + t_k* &
11993 (d_mdrh(j,2) + t_k* &
11994 (d_mdrh(j,3) + t_k* &
11995 d_mdrh(j,4) )) + 1.0
11996
11997 endif
11998
11999
12000 return
12001 end function drh_mutual
12002 !----------------------------------------------------------
12003
12004
12005
12006
12007
12008
12009 !----------------------------------------------------------
12010 ! zsr method at 60% rh
12011 !
12012 real(kind=8) function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
12013 ! implicit none
12014 ! include 'mosaic.h'
12015 ! subr. arguments
12016 integer ibin
12017 ! local variables
12018 integer jp, je
12019 real(kind=8) dum
12020 ! function
12021 ! real(kind=8) bin_molality_60
12022
12023
12024 jp = jtotal
12025 dum = 0.0
12026
12027 do je = 1, (nsalt+4) ! include hno3 and hcl in water calculation
12028 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
12029 enddo
12030
12031 aerosol_water_up = dum
12032
12033 return
12034 end function aerosol_water_up
12035 !----------------------------------------------------------
12036
12037
12038
12039
12040
12041
12042 !----------------------------------------------------------
12043 ! zsr method
12044 real(kind=8) function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
12045 ! implicit none
12046 ! include 'mosaic.h'
12047 ! subr. arguments
12048 integer jp, ibin
12049 ! local variables
12050 integer je
12051 real(kind=8) dum
12052 ! function
12053 ! real(kind=8) bin_molality
12054
12055
12056
12057 dum = 0.0
12058 do je = 1, (nsalt+4) ! include hno3 and hcl in water calculation
12059 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality(je,ibin)
12060 enddo
12061
12062 aerosol_water = dum
12063
12064 if(aerosol_water .le. 0.0)then
12065 if (iprint_mosaic_diag1 .gt. 0) then
12066 write(6,*)'mosaic aerosol_water - water .le. 0'
12067 write(6,*)'iclm jclm ibin jp = ', &
12068 iclm_aer, jclm_aer, ibin, jp
12069 write(6,*)'ah2o, water = ', ah2o, aerosol_water
12070 write(6,*)'dry mass = ', mass_dry_a(ibin)
12071 write(6,*)'soluble mass = ', mass_soluble_a(ibin)
12072 write(6,*)'number = ', num_a(ibin)
12073 do je = 1, nsoluble
12074 write(6,44)ename(je), electrolyte(je,jp,ibin)
12075 enddo
12076 write(6,*)'error in water calculation'
12077 write(6,*)'ibin = ', ibin
12078 write(6,*)'water content cannot be negative or zero'
12079 write(6,*)'setting jaerosolstate to all_solid'
12080 endif
12081
12082 call print_input
12083
12084 jaerosolstate(ibin) = all_solid
12085 jphase(ibin) = jsolid
12086 jhyst_leg(ibin) = jhyst_lo
12087
12088 !c write(6,*)'stopping execution in function aerosol_water'
12089 !c stop
12090 endif
12091
12092 44 format(a7, 2x, e11.3)
12093
12094
12095 return
12096 end function aerosol_water
12097 !----------------------------------------------------------
12098
12099
12100
12101
12102
12103 !----------------------------------------------------------
12104 real(kind=8) function bin_molality(je,ibin)
12105 ! implicit none
12106 ! include 'mosaic.h'
12107 ! subr. arguments
12108 integer je, ibin
12109 ! local variables
12110 real(kind=8) aw, xm
12111
12112
12113 aw = max(ah2o_a(ibin), aw_min(je))
12114 aw = min(aw, 0.999999D0)
12115
12116
12117 if(aw .lt. 0.97)then
12118
12119 xm = a_zsr(1,je) + &
12120 aw*(a_zsr(2,je) + &
12121 aw*(a_zsr(3,je) + &
12122 aw*(a_zsr(4,je) + &
12123 aw*(a_zsr(5,je) + &
12124 aw* a_zsr(6,je) ))))
12125
12126 bin_molality = 55.509*xm/(1. - xm)
12127
12128 else
12129
12130 bin_molality = -b_zsr(je)*log(aw)
12131
12132 endif
12133
12134
12135 return
12136 end function bin_molality
12137 !----------------------------------------------------------
12138
12139
12140
12141
12142
12143 !----------------------------------------------------------
12144 real(kind=8) function bin_molality_60(je)
12145 ! implicit none
12146 ! include 'mosaic.h'
12147 ! subr. arguments
12148 integer je
12149 ! local variables
12150 real(kind=8) aw, xm
12151
12152
12153 aw = 0.6
12154
12155 xm = a_zsr(1,je) + aw* &
12156 (a_zsr(2,je) + aw* &
12157 (a_zsr(3,je) + aw* &
12158 (a_zsr(4,je) + aw* &
12159 (a_zsr(5,je) + aw* &
12160 a_zsr(6,je) ))))
12161
12162 bin_molality_60 = 55.509*xm/(1. - xm)
12163
12164 return
12165 end function bin_molality_60
12166 !----------------------------------------------------------
12167
12168
12169
12170
12171
12172 !----------------------------------------------------------
12173 real(kind=8) function fnlog_gamz(ja,je) ! ja in je
12174 ! implicit none
12175 ! include 'mosaic.h'
12176 ! subr. arguments
12177 integer ja, je
12178 ! local variables
12179 real(kind=8) aw
12180
12181
12182 aw = max(ah2o, aw_min(je))
12183
12184 fnlog_gamz = b_mtem(1,ja,je) + aw* &
12185 (b_mtem(2,ja,je) + aw* &
12186 (b_mtem(3,ja,je) + aw* &
12187 (b_mtem(4,ja,je) + aw* &
12188 (b_mtem(5,ja,je) + aw* &
12189 b_mtem(6,ja,je) ))))
12190
12191 return
12192 end function fnlog_gamz
12193 !----------------------------------------------------------
12194
12195
12196
12197
12198 !----------------------------------------------------------
12199 real(kind=8) function mean_molecular_speed(t, mw) ! in cm/s
12200 ! implicit none
12201 ! subr. arguments
12202 real(kind=8) t, mw ! t(k)
12203
12204 mean_molecular_speed = 1.455e4 * sqrt(t/mw)
12205
12206 return
12207 end function mean_molecular_speed
12208 !----------------------------------------------------------
12209
12210
12211
12212
12213 !----------------------------------------------------------
12214 real(kind=8) function gas_diffusivity(t, p, mw, vm) ! in cm^2/s
12215 ! implicit none
12216 ! subr. arguments
12217 real(kind=8) mw, vm, t, p ! t(k), p(atm)
12218
12219
12220 gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/ &
12221 (p * (vm**0.333333 + 2.7189)**2)
12222
12223
12224 return
12225 end function gas_diffusivity
12226 !----------------------------------------------------------
12227
12228
12229
12230
12231 !----------------------------------------------------------
12232 real(kind=8) function fuchs_sutugin(rkn,a)
12233 ! implicit none
12234 ! subr. arguments
12235 real(kind=8) rkn, a
12236 ! local variables
12237 real(kind=8) rnum, denom
12238
12239
12240 rnum = 0.75*a*(1. + rkn)
12241 denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
12242 fuchs_sutugin = rnum/denom
12243
12244 return
12245 end function fuchs_sutugin
12246 !----------------------------------------------------------
12247
12248
12249
12250
12251
12252 !----------------------------------------------------------
12253 ! solution to x^3 + px^2 + qx + r = 0
12254 !
12255 real(kind=8) function cubic( p, q, r )
12256 ! implicit none
12257 ! subr arguments
12258 real(kind=8), intent(in) :: p, q, r
12259 ! local variables
12260 real(kind=8) a, b, d, m, n, third, y
12261 real(kind=8) k, phi, thesign, x(3), duma
12262 integer icase, kk
12263
12264 third = 1.d0/3.d0
12265
12266 a = (1.d0/3.d0)*((3.d0*q) - (p*p))
12267 b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
12268
12269 d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
12270
12271 if(d .gt. 0.)then ! => 1 real and 2 complex roots
12272 icase = 1
12273 elseif(d .eq. 0.)then ! => 3 real roots, atleast 2 identical
12274 icase = 2
12275 else ! d < 0 => 3 distinct real roots
12276 icase = 3
12277 endif
12278
12279
12280 goto (1,2,3), icase
12281
12282 ! case 1: d > 0
12283 1 thesign = 1.
12284 if(b .gt. 0.)then
12285 b = -b
12286 thesign = -1.
12287 endif
12288
12289 m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
12290 n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
12291
12292 cubic = real( (m) + (n) - (p/3.d0) )
12293 return
12294
12295 ! case 2: d = 0
12296 2 thesign = 1.
12297 if(b .gt. 0.)then
12298 b = -b
12299 thesign = -1.
12300 endif
12301
12302 m = thesign*(-b/2.d0)**third
12303 n = m
12304
12305 x(1) = real( (m) + (n) - (p/3.d0) )
12306 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12307 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12308
12309 cubic = 0.
12310 do kk = 1, 3
12311 if(x(kk).gt.cubic) cubic = x(kk)
12312 enddo
12313 return
12314
12315 ! case 3: d < 0
12316 3 if(b.gt.0.)then
12317 thesign = -1.
12318 elseif(b.lt.0.)then
12319 thesign = 1.
12320 endif
12321
12322 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
12323 ! phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )) ! radians
12324 duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
12325 duma = min( duma, +1.0D0 )
12326 duma = max( duma, -1.0D0 )
12327 phi = acos( duma ) ! radians
12328
12329
12330 cubic = 0.
12331 do kk = 1, 3
12332 k = kk-1
12333 y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
12334 x(kk) = real((y) - (p/3.d0))
12335 if(x(kk).gt.cubic) cubic = x(kk)
12336 enddo
12337 return
12338
12339 end function cubic
12340 !----------------------------------------------------------
12341
12342
12343
12344
12345 !----------------------------------------------------------
12346 real(kind=8) function quadratic(a,b,c)
12347 ! implicit none
12348 ! subr. arguments
12349 real(kind=8) a, b, c
12350 ! local variables
12351 real(kind=8) x, dum, quad1, quad2
12352
12353
12354 if(b .ne. 0.0)then
12355 x = 4.*(a/b)*(c/b)
12356 else
12357 x = 1.e+6
12358 endif
12359
12360 if(abs(x) .lt. 1.e-6)then
12361 dum = (0.5*x) + &
12362 (0.125*x**2) + &
12363 (0.0625*x**3)
12364
12365 quadratic = (-0.5*b/a)*dum
12366
12367 if(quadratic .lt. 0.)then
12368 quadratic = -b/a - quadratic
12369 endif
12370
12371 else
12372 quad1 = (-b+sqrt(b*b-4.*a*c))/(2.*a)
12373 quad2 = (-b-sqrt(b*b-4.*a*c))/(2.*a)
12374
12375 quadratic = max(quad1, quad2)
12376 endif
12377
12378 return
12379 end function quadratic
12380 !----------------------------------------------------------
12381
12382
12383
12384 !----------------------------------------------------------
12385 ! currently not used
12386
12387 ! two roots of a quadratic equation
12388
12389 subroutine quadratix(a,b,c, qx1,qx2)
12390 ! implicit none
12391 ! subr. arguments
12392 real(kind=8) a, b, c, qx1, qx2
12393 ! local variables
12394 real(kind=8) x, dum
12395
12396
12397 if(b .ne. 0.0)then
12398 x = 4.*(a/b)*(c/b)
12399 else
12400 x = 1.e+6
12401 endif
12402
12403 if(abs(x) .lt. 1.e-6)then
12404 dum = (0.5*x) + &
12405 (0.125*x**2) + &
12406 (0.0625*x**3)
12407
12408 qx1 = (-0.5*b/a)*dum
12409 qx2 = -b/a - qx1
12410
12411 else
12412
12413 qx1 = (-b+sqrt(b*b - 4.*a*c))/(2.*a)
12414 qx2 = (-b-sqrt(b*b - 4.*a*c))/(2.*a)
12415
12416 endif
12417
12418 return
12419 end subroutine quadratix
12420
12421
12422 !=====================================================================
12423
12424
12425
12426
12427
12428
12429
12430
12431
12432
12433
12434
12435
12436
12437
12438
12439
12440 !***********************************************************************
12441 ! computes aerosol optical properties
12442 !
12443 ! author: rahul a. zaveri
12444 ! update: jan 2005
12445 !-----------------------------------------------------------------------
12446 subroutine aerosol_optical_properties(iclm, jclm, nz, refindx, &
12447 radius_wet, number_bin)
12448 ! changed to use rsub instead of rclm 7-8-04 egc
12449 use module_data_mosaic_asect
12450 use module_data_mosaic_other
12451 use module_state_description, only: param_first_scalar
12452
12453 ! implicit none
12454
12455 ! subr arguments
12456 integer, intent(in ) :: iclm, jclm, nz
12457 real, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12458 number_bin, radius_wet
12459 complex, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12460 refindx
12461
12462 ! local variables
12463 integer iaer, ibin, iphase, isize, itype, je, k, l, m
12464 integer ilaporte, jlaporte
12465 integer p1st
12466 real(kind=8) xt
12467
12468
12469 ! if a species index is less than this value, then the species is not defined
12470 p1st = param_first_scalar
12471
12472 ! fix number of subareas at 1
12473 nsubareas = 1
12474
12475 lunerr_aer = lunerr
12476 ncorecnt_aer = ncorecnt
12477
12478 call load_mosaic_parameters
12479
12480 iclm_aer = iclm
12481 jclm_aer = jclm
12482
12483 do 110 m = 1, nsubareas
12484 do 100 k = 1, nz
12485
12486 mclm_aer = m
12487 kclm_aer = k
12488
12489 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
12490 cair_mol_cc = cairclm(k)
12491
12492 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
12493 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
12494 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
12495 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
12496
12497
12498 ! initialize to zero
12499 do ibin = 1, nbin_a
12500 do iaer = 1, naer
12501 aer(iaer,jtotal,ibin) = 0.0
12502 enddo
12503
12504 do je = 1, nelectrolyte
12505 electrolyte(je,jtotal,ibin) = 0.0
12506 enddo
12507
12508 jaerosolstate(ibin) = -1 ! initialize to default value
12509
12510 enddo
12511
12512
12513 ! rce 18-nov-2004 - map (transfer) aerosol mass/water/number from rsub
12514 ! to mosaic arrays (aer, watr_a, num_a)
12515 ! always map so4 and number,
12516 ! but only map other species when (lptr_xxx .ge. p1st)
12517 ! (the mapping is identical to that done in mapgasaerspecies)
12518
12519 iphase = ai_phase
12520 ibin = 0
12521 do 90 itype = 1, ntype_aer
12522 do 90 isize = 1, nsize_aer(itype)
12523 ibin = ibin + 1
12524
12525 ! aer array units are nmol/(m^3 air)
12526 l = lptr_so4_aer(isize,itype,iphase)
12527 if (l .ge. p1st) then
12528 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12529 else
12530 aer(iso4_a,jtotal,ibin)=0.0
12531 end if
12532
12533 l = lptr_no3_aer(isize,itype,iphase)
12534 if (l .ge. p1st) then
12535 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12536 else
12537 aer(ino3_a,jtotal,ibin)=0.0
12538 end if
12539
12540 l = lptr_cl_aer(isize,itype,iphase)
12541 if (l .ge. p1st) then
12542 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12543 else
12544 aer(icl_a,jtotal,ibin)=0.0
12545 end if
12546
12547 l = lptr_nh4_aer(isize,itype,iphase)
12548 if (l .ge. p1st) then
12549 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12550 else
12551 aer(inh4_a,jtotal,ibin)=0.0
12552 end if
12553
12554 l = lptr_oc_aer(isize,itype,iphase)
12555 if (l .ge. p1st) then
12556 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12557 else
12558 aer(ioc_a,jtotal,ibin)=0.0
12559 end if
12560
12561 l = lptr_bc_aer(isize,itype,iphase)
12562 if (l .ge. p1st) then
12563 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12564 else
12565 aer(ibc_a,jtotal,ibin)=0.0
12566 end if
12567
12568 l = lptr_na_aer(isize,itype,iphase)
12569 if (l .ge. p1st) then
12570 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12571 else
12572 aer(ina_a,jtotal,ibin)=0.0
12573 end if
12574
12575 l = lptr_oin_aer(isize,itype,iphase)
12576 if (l .ge. p1st) then
12577 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12578 else
12579 aer(ioin_a,jtotal,ibin)=0.0
12580 end if
12581
12582 l = lptr_msa_aer(isize,itype,iphase)
12583 if (l .ge. p1st) then
12584 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12585 else
12586 aer(imsa_a,jtotal,ibin)=0.0
12587 end if
12588
12589 l = lptr_co3_aer(isize,itype,iphase)
12590 if (l .ge. p1st) then
12591 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12592 else
12593 aer(ico3_a,jtotal,ibin)=0.0
12594 end if
12595
12596 l = lptr_ca_aer(isize,itype,iphase)
12597 if (l .ge. p1st) then
12598 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12599 else
12600 aer(ica_a,jtotal,ibin)=0.0
12601 end if
12602
12603 ! soa aerosol-phase species -- currently deactivated
12604 ! l = lptr_aro1_aer(isize,itype,iphase)
12605 ! if (l .ge. p1st) then
12606 ! aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12607 ! else
12608 aer(iaro1_a,jtotal,ibin)=0.0
12609 ! end if
12610
12611 ! l = lptr_aro2_aer(isize,itype,iphase)
12612 ! if (l .ge. p1st) then
12613 ! aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12614 ! else
12615 aer(iaro2_a,jtotal,ibin)=0.0
12616 ! end if
12617
12618 ! l = lptr_alk1_aer(isize,itype,iphase)
12619 ! if (l .ge. p1st) then
12620 ! aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12621 ! else
12622 aer(ialk1_a,jtotal,ibin)=0.0
12623 ! end if
12624
12625 ! l = lptr_ole1_aer(isize,itype,iphase)
12626 ! if (l .ge. p1st) then
12627 ! aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12628 ! else
12629 aer(iole1_a,jtotal,ibin)=0.0
12630 ! end if
12631
12632 ! l = lptr_api1_aer(isize,itype,iphase)
12633 ! if (l .ge. p1st) then
12634 ! aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12635 ! else
12636 aer(iapi1_a,jtotal,ibin)=0.0
12637 ! end if
12638
12639 ! l = lptr_api2_aer(isize,itype,iphase)
12640 ! if (l .ge. p1st) then
12641 ! aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12642 ! else
12643 aer(iapi2_a,jtotal,ibin)=0.0
12644 ! end if
12645
12646 ! l = lptr_lim1_aer(isize,itype,iphase)
12647 ! if (l .ge. p1st) then
12648 ! aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12649 ! else
12650 aer(ilim1_a,jtotal,ibin)=0.0
12651 ! end if
12652
12653 ! l = lptr_lim2_aer(isize,itype,iphase)
12654 ! if (l .ge. p1st) then
12655 ! aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12656 ! else
12657 aer(ilim2_a,jtotal,ibin)=0.0
12658 ! end if
12659
12660 ! water_a and water_a_hyst units are kg/(m^3 air)
12661 l = hyswptr_aer(isize,itype)
12662 if (l .ge. p1st) then
12663 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
12664 else
12665 water_a_hyst(ibin)=0.0
12666 end if
12667
12668 ! water_a units are kg/(m^3 air)
12669 l = waterptr_aer(isize,itype)
12670 if (l .ge. p1st) then
12671 water_a(ibin)=rsub(l,k,m)*conv2a
12672 else
12673 water_a(ibin)=0.0
12674 end if
12675
12676 ! num_a units are #/(cm^3 air)
12677 l = numptr_aer(isize,itype,iphase)
12678 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
12679
12680
12681 call check_aerosol_mass(ibin)
12682 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
12683 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
12684 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
12685 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
12686 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
12687 call calc_dry_n_wet_aerosol_props(ibin) ! calc dp_wet, ref index
12688
12689
12690
12691 refindx(ibin,k) = ri_avg_a(ibin) ! vol avg ref index
12692 radius_wet(ibin,k) = dp_wet_a(ibin)/2.0 ! wet radius (cm)
12693 number_bin(ibin,k) = num_a(ibin) ! #/cc air
12694
12695 90 continue
12696
12697 100 continue ! k levels
12698 110 continue ! m subareas
12699
12700
12701 return
12702 end subroutine aerosol_optical_properties
12703
12704
12705
12706
12707
12708
12709
12710
12711
12712
12713 !***********************************************************************
12714 ! save aerosol drymass and drydens before aerosol mass transfer is
12715 ! calculated this subr is called from within subr mosaic_dynamic_solver,
12716 ! after the initial calls to check_aerosol_mass, conform_electrolytes,
12717 ! conform_aerosol_number, and aerosol_phase_state, but before the mass
12718 ! transfer is calculated
12719 !
12720 ! author: richard c. easter
12721 !-----------------------------------------------------------------------
12722 subroutine save_pregrow_props
12723
12724 use module_data_mosaic_asect
12725 use module_data_mosaic_other
12726
12727 ! implicit none
12728 ! include 'v33com'
12729 ! include 'v33com9a'
12730 ! include 'v33com9b'
12731 ! include 'mosaic.h'
12732
12733 ! subr arguments (none)
12734
12735 ! local variables
12736 integer ibin, isize, itype
12737
12738
12739 ! air conc in mol/cm^3
12740 cair_mol_cc = cairclm(kclm_aer)
12741
12742 ! compute then save drymass and drydens for each bin
12743 do ibin = 1, nbin_a
12744
12745 call calc_dry_n_wet_aerosol_props( ibin )
12746
12747 call isize_itype_from_ibin( ibin, isize, itype )
12748 drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol(air)
12749 if(jaerosolstate(ibin) .eq. no_aerosol) then
12750 drydens_pregrow(isize,itype) = -1.
12751 else
12752 drydens_pregrow(isize,itype) = dens_dry_a(ibin) ! g/cc
12753 end if
12754
12755 end do
12756
12757 return
12758 end subroutine save_pregrow_props
12759
12760
12761
12762
12763
12764
12765
12766 !***********************************************************************
12767 ! special output
12768 !
12769 ! author: richard c. easter
12770 !-----------------------------------------------------------------------
12771 subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
12772
12773 ! implicit none
12774
12775 integer iclm, jclm, kclm, msub
12776 character*(*) fromwhere
12777
12778 return
12779 end subroutine specialoutaa
12780
12781
12782
12783
12784 !***********************************************************************
12785 ! box model test output
12786 !
12787 ! author: richard c. easter
12788 !-----------------------------------------------------------------------
12789 subroutine aerchem_boxtest_output( &
12790 iflag, iclm, jclm, kclm, msub, dtchem )
12791
12792 use module_data_mosaic_asect
12793 use module_data_mosaic_other
12794 ! implicit none
12795
12796 ! include 'v33com'
12797 ! include 'v33com2'
12798 ! include 'v33com9a'
12799
12800 integer iflag, iclm, jclm, kclm, msub
12801 real(kind=8) dtchem
12802
12803 ! local variables
12804 integer lun
12805 parameter (lun=83)
12806 integer, save :: ientryno = -13579
12807 integer icomp, iphase, isize, itype, k, l, m, n
12808
12809 real(kind=8) dtchem_sv1
12810 save dtchem_sv1
12811 real(kind=8) rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
12812
12813
12814 ! bypass unless maerchem_boxtest_output > 0
12815 if (maerchem_boxtest_output .le. 0) return
12816
12817
12818
12819 !
12820 ! *** currently this only works for ntype_aer = 1
12821 !
12822 itype = 1
12823 iphase = ai_phase
12824
12825 ! do initial output
12826 if (ientryno .ne. -13579) goto 1000
12827
12828 ientryno = +1
12829 call peg_message( lunerr, '***' )
12830 call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
12831 call peg_message( lunerr, '***' )
12832
12833 write(lun) ltot, ltot2, itot, jtot, ktot
12834 write(lun) (name(l), l=1,ltot2)
12835
12836 write(lun) maerocoag, maerchem, maeroptical
12837 write(lun) msectional, maerosolincw
12838
12839 write(lun) nsize_aer(itype), ntot_mastercomp_aer
12840
12841 do icomp = 1, ntot_mastercomp_aer
12842 write(lun) &
12843 name_mastercomp_aer(icomp)
12844 write(lun) &
12845 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
12846 end do
12847
12848 do isize = 1, nsize_aer(itype)
12849 write(lun) &
12850 ncomp_plustracer_aer(itype), &
12851 ncomp_aer(itype), &
12852 waterptr_aer(isize,itype), &
12853 numptr_aer(isize,itype,iphase), &
12854 mprognum_aer(isize,itype,iphase)
12855 write(lun) &
12856 ( mastercompptr_aer(l,itype), &
12857 massptr_aer(l,isize,itype,iphase), &
12858 l=1,ncomp_plustracer_aer(itype) )
12859 write(lun) &
12860 volumcen_sect(isize,itype), &
12861 volumlo_sect(isize,itype), &
12862 volumhi_sect(isize,itype), &
12863 dcen_sect(isize,itype), &
12864 dlo_sect(isize,itype), &
12865 dhi_sect(isize,itype)
12866 write(lun) &
12867 lptr_so4_aer(isize,itype,iphase), &
12868 lptr_msa_aer(isize,itype,iphase), &
12869 lptr_no3_aer(isize,itype,iphase), &
12870 lptr_cl_aer(isize,itype,iphase), &
12871 lptr_co3_aer(isize,itype,iphase), &
12872 lptr_nh4_aer(isize,itype,iphase), &
12873 lptr_na_aer(isize,itype,iphase), &
12874 lptr_ca_aer(isize,itype,iphase), &
12875 lptr_oin_aer(isize,itype,iphase), &
12876 lptr_oc_aer(isize,itype,iphase), &
12877 lptr_bc_aer(isize,itype,iphase), &
12878 hyswptr_aer(isize,itype)
12879 end do
12880
12881 !
12882 ! test iflag
12883 !
12884 1000 continue
12885 if (iflag .eq. 1) goto 1010
12886 if (iflag .eq. 2) goto 2000
12887 if (iflag .eq. 3) goto 3000
12888 return
12889
12890 !
12891 ! iflag=1 -- save initial values
12892 !
12893 1010 continue
12894 dtchem_sv1 = dtchem
12895 do m = 1, nsubareas
12896 do k = 1, ktot
12897 do l = 1, ltot2
12898 rsub_sv1(l,k,m) = rsub(l,k,m)
12899 end do
12900 end do
12901 end do
12902
12903 return
12904
12905 !
12906 ! iflag=2 -- save intermediate values before doing move_sections
12907 ! (this is deactivated for now)
12908 !
12909 2000 continue
12910 return
12911
12912
12913 !
12914 ! iflag=3 -- do output
12915 !
12916 3000 continue
12917 do m = 1, nsubareas
12918 do k = 1, ktot
12919
12920 write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
12921 write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k), &
12922 ptotclm(k), afracsubarea(k,m)
12923
12924 write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
12925
12926 end do
12927 end do
12928
12929
12930 return
12931 end subroutine aerchem_boxtest_output
12932
12933
12934
12935 !***********************************************************************
12936 ! 'debugging' output when mosaic encounters 'fatal error' situation
12937 !
12938 ! author: richard c. easter
12939 !-----------------------------------------------------------------------
12940 subroutine mosaic_aerchem_error_dump( istop, ibin, luna, msga )
12941 !
12942 ! dumps current column information when a fatal computational error occurs
12943 ! when istop>0, the simulation is halted
12944 !
12945 use module_data_mosaic_asect
12946 use module_data_mosaic_other
12947 ! implicit none
12948
12949 ! arguments
12950 integer istop, ibin, luna
12951 character*(*) msga
12952
12953 ! local variables
12954 integer icomp, iphase, isize, itype, k, l, lunb, m, n
12955 real(kind=8) dtchem_sv1
12956
12957
12958 !
12959 ! *** currently this only works for ntype_aer = 1
12960 !
12961 itype = 1
12962
12963
12964 lunb = luna
12965 if (lunb .le. 0) lunb = 6
12966
12967 9000 format( a )
12968 9010 format( 7i10 )
12969 9020 format( 3(1pe19.11) )
12970
12971 write(lunb,9000)
12972 write(lunb,9000) 'begin mosaic_aerchem_error_dump - msga ='
12973 write(lunb,9000) msga
12974 write(lunb,9000) 'i, j, k, msub,ibin ='
12975 write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
12976
12977 write(lunb,9010) ltot, ltot2, itot, jtot, ktot
12978 write(lunb,9000) (name(l), l=1,ltot2)
12979
12980 write(lunb,9010) maerocoag, maerchem, maeroptical
12981 write(lunb,9010) msectional, maerosolincw
12982
12983 write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
12984
12985 do icomp = 1, ntot_mastercomp_aer
12986 write(lunb,9000) &
12987 name_mastercomp_aer(icomp)
12988 write(lunb,9020) &
12989 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
12990 end do
12991
12992 do isize = 1, nsize_aer(itype)
12993 write(lunb,9010) &
12994 ncomp_plustracer_aer(itype), &
12995 ncomp_aer(itype), &
12996 waterptr_aer(isize,itype), &
12997 numptr_aer(isize,itype,iphase), &
12998 mprognum_aer(isize,itype,iphase)
12999 write(lunb,9010) &
13000 ( mastercompptr_aer(l,itype), &
13001 massptr_aer(l,isize,itype,iphase), &
13002 l=1,ncomp_plustracer_aer(itype) )
13003 write(lunb,9020) &
13004 volumcen_sect(isize,itype), &
13005 volumlo_sect(isize,itype), &
13006 volumhi_sect(isize,itype), &
13007 dcen_sect(isize,itype), &
13008 dlo_sect(isize,itype), &
13009 dhi_sect(isize,itype)
13010 write(lunb,9010) &
13011 lptr_so4_aer(isize,itype,iphase), &
13012 lptr_msa_aer(isize,itype,iphase), &
13013 lptr_no3_aer(isize,itype,iphase), &
13014 lptr_cl_aer(isize,itype,iphase), &
13015 lptr_co3_aer(isize,itype,iphase), &
13016 lptr_nh4_aer(isize,itype,iphase), &
13017 lptr_na_aer(isize,itype,iphase), &
13018 lptr_ca_aer(isize,itype,iphase), &
13019 lptr_oin_aer(isize,itype,iphase), &
13020 lptr_oc_aer(isize,itype,iphase), &
13021 lptr_bc_aer(isize,itype,iphase), &
13022 hyswptr_aer(isize,itype)
13023 end do
13024
13025
13026 dtchem_sv1 = -1.0
13027 do m = 1, nsubareas
13028 do k = 1, ktot
13029
13030 write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
13031 write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k), &
13032 ptotclm(k), afracsubarea(k,m)
13033
13034 write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
13035
13036 end do
13037 end do
13038
13039 write(lunb,9000) 'end mosaic_aerchem_error_dump'
13040
13041
13042 if (istop .gt. 0) call peg_error_fatal( luna, msga )
13043
13044 return
13045 end subroutine mosaic_aerchem_error_dump
13046 !-----------------------------------------------------------------------
13047
13048 end module module_mosaic_therm