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.22.0)
27 ! 30-apr-07 raz - made about a dozen changes/bug fixes. search for "raz-30apr07" to see the changes
28 ! 05-feb-07 wig - converted to double
29 ! 10-jan-07 raz - contains major revisions and updates. new module ASTEM replaces ASTEEM.
30 ! 04-aug-06 raz - fixed bugs in asteem_flux_mix_case3a and asteem_flux_mix_case3b
31 ! revised treatment of kelvin effect.
32 ! 06-jun-06 rce - changed dens_aer_mac(ica_a) & (ico3_a) from 2.5 to 2.6
33 ! 31-may-06 rce - got latest version from
34 ! nirvana:/home/zaveri/rahul/pegasus/pegasus.3.1.1/src
35 ! in subr map_mosaic_species, turned off mapping
36 ! of soa species
37 ! 18-may-06 raz - major revisions in asteem and minor changes in mesa
38 ! 22-jan-06 raz - revised nh4no3 and nh4cl condensation algorithm
39 ! 07-jan-06 raz - improved asteem algorithm
40 ! 28-apr-05 raz - reversed calls to form_cacl2 and form_nacl
41 ! fixed caco3 error in subr. electrolytes_to_ions
42 ! renamed dens_aer to dens_aer_mac; mw_aer to mw_aer_mac
43 ! 27-apr-05 raz - updated dry_mass calculation approach in mesa_convergence
44 ! 22-apr-05 raz - fixed caso4 mass balance problem and updated algorithm to
45 ! calculate phi_volatile for nh3, hno3, and hcl.
46 ! 20-apr-05 raz - updated asceem
47 ! 19-apr-05 raz - updated the algorithm to constrain the nh4 concentration
48 ! during simultaneous nh3, hno3, and hcl integration such
49 ! that it does not exceed the max possible value for a given bin
50 ! 14-apr-05 raz - fixed asteem_flux_wet_case3 and asteem_flux_dry_case3c
51 ! 11-jan-05 raz - major updates to many subroutines
52 ! 18-nov-04 rce - make sure that acos argument is between +/-1.0
53 ! 28-jan-04 rce - added subr aerchem_boxtest_output;
54 ! eliminated some unnecessary 'include v33com-'
55 ! 01-dec-03 rce - added 'implicit none' to many routines;
56 ! eliminated some unnecessary 'include v33com-'
57 ! 05-oct-03 raz - added hysteresis treatment
58 ! 02-sep-03 raz - implemented asteem
59 ! 10-jul-03 raz - changed ix to ixd in interp. subrs fast*_up and fast*_lo
60 ! 08-jul-03 raz - implemented asteem (adaptive step time-split
61 ! explicit euler method)
62 ! 26-jun-03 raz - updated almost all the subrs. this version contains
63 ! options for rigorous and fast solvers (including lsode solver)
64 !
65 ! 07-oct-02 raz - made zx and zm integers in activity coeff subs.
66 ! 16-sep-02 raz - updated many subrs to treat calcium salts
67 ! 19-aug-02 raz - inlcude v33com9a in subr aerosolmtc
68 ! 14-aug-02 rce - '(msectional.eq.0)' changed to '(msectional.le.0)'
69 ! 07-aug-02 rce - this is rahul's latest version from freshair
70 ! after adding 'real mean_molecular_speed' wherever it is used
71 ! 01-apr-02 raz - made final tests and gave the code to jerome
72 !
73 ! 04--14-dec-01 rce - several minor changes during initial testing/debug
74 ! in 3d los angeles simulation
75 ! (see earlier versions for details about these changes)
76 !-----------------------------------------------------------------------
77 !23456789012345678901234567890123456789012345678901234567890123456789012
78
79 !***********************************************************************
80 ! interface to mosaic
81 !
82 ! author: rahul a. zaveri
83 ! update: jan 2005
84 !-----------------------------------------------------------------------
85 subroutine aerchemistry( iclm, jclm, kclm_calcbgn, kclm_calcend, &
86 dtchem_sngl, idiagaa )
87
88 use module_data_mosaic_asect
89 use module_data_mosaic_other
90 use module_mosaic_movesect, only: move_sections
91
92 ! implicit none
93 ! include 'v33com'
94 ! include 'v33com2'
95 ! include 'v33com3'
96 ! include 'mosaic.h'
97 ! subr arguments
98 integer iclm, jclm, kclm_calcbgn, kclm_calcend, idiagaa
99 real dtchem_sngl
100 ! local variables
101 real(kind=8) :: dtchem
102 integer k, m
103
104
105
106 dtchem = dtchem_sngl
107
108 lunerr_aer = lunerr
109 ncorecnt_aer = ncorecnt
110
111 ! special output for solver testing
112 call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
113
114 iclm_aer = iclm
115 jclm_aer = jclm
116 kclm_aer_calcbgn = kclm_calcbgn
117 kclm_aer_calcend = kclm_calcend
118
119
120 do 200 m = 1, nsubareas
121 mclm_aer = m
122
123 do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
124
125 kclm_aer = k
126 if (afracsubarea(k,m) .lt. 1.e-4) goto 100
127
128 istat_mosaic_fe1 = 1
129
130 call mosaic( k, m, dtchem )
131
132 if (istat_mosaic_fe1 .lt. 0) then
133 nfe1_mosaic_cur = nfe1_mosaic_cur + 1
134 nfe1_mosaic_tot = nfe1_mosaic_tot + 1
135 if (iprint_mosaic_fe1 .gt. 0) then
136 write(6,*) 'mosaic aerchemistry fatal error - i/j/k/m =', &
137 iclm_aer, jclm_aer, kclm_aer, mclm_aer
138 call print_input
139 if (iprint_mosaic_fe1 .ge. 10) &
140 call mosaic_aerchem_error_dump( 0, 0, lunerr_aer, &
141 'aerchemistry fatal error' )
142 end if
143 goto 100
144 end if
145
146 call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
147 call move_sections( 1, iclm, jclm, k, m)
148 call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
149
150 100 continue ! k levels
151
152 200 continue ! subareas
153
154
155 ! special output for solver testing
156 call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
157
158 return
159 end subroutine aerchemistry
160
161
162
163
164
165
166
167
168
169
170 !***********************************************************************
171 ! mosaic (model for simulating aerosol interactions and chemistry)
172 !
173 ! author: rahul a. zaveri
174 ! update: dec 2004
175 !-----------------------------------------------------------------------
176 subroutine mosaic(k, m, dtchem)
177
178 use module_data_mosaic_asect
179 use module_data_mosaic_other
180
181 ! implicit none
182 ! include 'v33com'
183 ! include 'v33com3'
184 ! include 'mosaic.h'
185 ! subr arguments
186 integer k, m
187 real(kind=8) dtchem
188 ! local variables
189 real(kind=8) yh2o, dumdum
190 integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
191 ! data iclm_debug /28/
192 ! data jclm_debug /1/
193 ! data kclm_debug /9/
194 ! data ncnt_debug /6/
195 iclm_debug=-28; jclm_debug=1; kclm_debug=9; ncnt_debug=6
196
197
198
199 if(iclm_aer .eq. iclm_debug .and. &
200 jclm_aer .eq. jclm_debug .and. &
201 kclm_aer .eq. kclm_debug .and. &
202 ncorecnt_aer .eq. ncnt_debug)then
203 dumdum = 0.0
204 endif
205
206
207 ! overwrite inputs
208 if(1.eq.0)then
209 call hijack_input(k,m)
210 endif
211
212
213 t_k = rsub(ktemp,k,m) ! update temperature = k
214 p_atm = ptotclm(k) /1.032d6 ! update pressure = atm
215 yh2o = rsub(kh2o,k,m) ! mol(h2o)/mol(air)
216 rh_pc = 100.*relhumclm(k) ! rh (%)
217 ah2o = relhumclm(k) ! fractional rh
218
219
220 call load_mosaic_parameters ! sets up indices and other stuff once per simulation
221
222 call initialize_mosaic_variables
223
224 call update_thermodynamic_constants ! update t and rh dependent constants
225
226 call map_mosaic_species(k, m, 0)
227
228
229 call overall_massbal_in ! save input mass over all bins
230 iprint_input = myes ! reset to default
231
232
233 call mosaic_dynamic_solver( dtchem )
234 if (istat_mosaic_fe1 .lt. 0) return
235
236
237 call overall_massbal_out(0) ! check mass balance after integration
238
239 call map_mosaic_species(k, m, 1)
240
241 ! write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
242
243 return
244 end subroutine mosaic
245
246
247
248
249
250
251
252
253
254
255
256
257 !***********************************************************************
258 ! interface to asceem and asteem dynamic gas-particle exchange solvers
259 !
260 ! author: rahul a. zaveri
261 ! update: jan 2005
262 !-----------------------------------------------------------------------
263 subroutine mosaic_dynamic_solver( dtchem )
264 ! implicit none
265 ! include 'v33com'
266 ! include 'mosaic.h'
267 ! subr arguments
268 real(kind=8) dtchem
269 ! local variables
270 integer ibin, iv, k, m
271 real(kind=8) xt, dumdum
272 ! real(kind=8) aerosol_water_up ! mosaic func
273
274
275 ! if(iclm_aer .eq. 21 .and. &
276 ! jclm_aer .eq. 17 .and. &
277 ! kclm_aer .eq. 3 .and. &
278 ! ncorecnt_aer .eq. 4)then
279 ! dumdum = 0.0
280 ! endif
281
282
283 do 500 ibin = 1, nbin_a
284
285 call check_aerosol_mass(ibin)
286 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
287
288 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
289
290 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
291 if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
292
293 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
294
295 500 continue
296
297
298
299 ! box
300 ! call initial_aer_print_box ! box
301
302 call save_pregrow_props
303
304 call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77, &
305 'after_conform' )
306 !
307 !-------------------------------------
308 ! do dynamic gas-aerosol mass transfer
309
310 if(mgas_aer_xfer .eq. mon)then
311
312 call astem(dtchem)
313
314 endif
315
316 !-------------------------------------
317 ! box
318 ! grows or shrinks size depending on mass increase or decrease
319 !
320 ! do ibin = 1, nbin_a
321 ! if(jaerosolstate(ibin) .ne. no_aerosol)then
322 ! call conform_particle_size(ibin) ! box
323 ! endif
324 ! enddo
325
326
327
328 do 600 ibin = 1, nbin_a
329 if(jaerosolstate(ibin).eq.no_aerosol) goto 600
330
331 if(jhyst_leg(ibin) .eq. jhyst_lo)then
332 water_a_hyst(ibin) = 0.0
333 elseif(jhyst_leg(ibin) .eq. jhyst_up)then
334 water_a_up(ibin) = aerosol_water_up(ibin) ! at 60% rh
335 water_a_hyst(ibin) = water_a_up(ibin)
336 endif
337
338 call calc_dry_n_wet_aerosol_props(ibin) ! compute final mass and density
339 600 continue
340
341 return
342 end subroutine mosaic_dynamic_solver
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357 subroutine hijack_input(k, m)
358
359 use module_data_mosaic_asect
360 use module_data_mosaic_other
361
362 ! implicit none
363 ! include 'v33com'
364 ! include 'v33com3'
365 ! include 'v33com9a'
366 ! include 'v33com9b'
367 ! include 'mosaic.h'
368 ! subr arguments
369 integer k, m
370 ! local variables
371 integer ibin, igas, iphase, isize, itype
372 real(kind=8) t_kdum, p_atmdum, rhdum, cairclmdum
373 real(kind=8) gasdum(4), aerdum(14,8)
374
375
376
377
378 ! read inputs----------------
379 open(92, file = 'box.txt')
380
381 read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
382 ! do igas = 1, 4
383 read(92,*)gasdum(1),gasdum(2),gasdum(3),gasdum(4)
384 ! enddo
385
386 do ibin = 1, nbin_a
387 read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin), &
388 aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin), &
389 aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin), &
390 aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin), &
391 aerdum(13,ibin),aerdum(14,ibin)
392 enddo
393
394 close(92)
395 !----------------------------
396
397
398
399 rsub(ktemp,k,m) = t_kdum ! update temperature = k
400 ptotclm(k) = p_atmdum*1.032d6! update pressure = atm
401 relhumclm(k) = rhdum/100.0 ! fractional rh
402 cairclm(k) = cairclmdum ! mol/cc
403
404
405 ! 3-d
406 ! calculate air conc in mol/m^3
407 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
408 cair_mol_cc = cairclm(k)
409
410 ! 3-d
411 ! define conversion factors
412 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
413 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
414 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
415 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
416
417
418 ! read rsub (mol/mol(air))
419 ! gas
420 rsub(kh2so4,k,m) = gasdum(1)
421 rsub(khno3,k,m) = gasdum(2)
422 rsub(khcl,k,m) = gasdum(3)
423 rsub(knh3,k,m) = gasdum(4)
424
425
426 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
427 iphase = ai_phase
428 ibin = 0
429 do 10 itype = 1, ntype_aer
430 do 10 isize = 1, nsize_aer(itype)
431 ibin = ibin + 1
432
433 rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
434 rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
435 rsub(lptr_cl_aer(isize,itype,iphase),k,m) = aerdum(3,ibin)
436 rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
437 rsub(lptr_oc_aer(isize,itype,iphase),k,m) = aerdum(5,ibin)
438 rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
439 rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
440 rsub(lptr_bc_aer(isize,itype,iphase),k,m) = aerdum(8,ibin)
441 rsub(lptr_na_aer(isize,itype,iphase),k,m) = aerdum(9,ibin)
442 rsub(lptr_ca_aer(isize,itype,iphase),k,m) = aerdum(10,ibin)
443 rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
444
445 rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
446 rsub(waterptr_aer(isize,itype),k,m) = aerdum(13,ibin) ! kg/m^3(air)
447 rsub(numptr_aer(isize,itype,iphase),k,m) = aerdum(14,ibin) ! num_a is in #/cc
448 10 continue
449
450 return
451 end subroutine hijack_input
452
453
454
455
456
457 !***********************************************************************
458 ! intializes all the mosaic variables to zero or their default values.
459 !
460 ! author: rahul a. zaveri
461 ! update: jun 2003
462 !-----------------------------------------------------------------------
463 subroutine initialize_mosaic_variables
464 ! implicit none
465 ! include 'mosaic.h'
466 ! local variables
467 integer iaer, ibin, iv, ja, jc, je
468
469
470
471 do iv = 1, ngas_ioa
472 gas(iv) = 0.0
473 enddo
474
475 ! initialize to zero
476 do ibin = 1, nbin_a
477
478 num_a(ibin) = 0.0
479 mass_dry_a(ibin) = 0.0
480 mass_soluble_a(ibin) = 0.0
481
482 do iaer = 1, naer
483 aer(iaer,jtotal,ibin) = 0.0
484 aer(iaer,jsolid,ibin) = 0.0
485 aer(iaer,jliquid,ibin) = 0.0
486 enddo
487
488 do je = 1, nelectrolyte
489 electrolyte(je,jtotal,ibin) = 0.0
490 electrolyte(je,jsolid,ibin) = 0.0
491 electrolyte(je,jliquid,ibin) = 0.0
492 activity(je,ibin) = 0.0
493 gam(je,ibin) = 0.0
494 enddo
495
496 gam_ratio(ibin) = 0.0
497
498 do iv = 1, ngas_ioa
499 flux_s(iv,ibin) = 0.0
500 flux_l(iv,ibin) = 0.0
501 kg(iv,ibin) = 0.0
502 phi_volatile_s(iv,ibin) = 0.0
503 phi_volatile_l(iv,ibin) = 0.0
504 df_gas_s(iv,ibin) = 0.0
505 df_gas_l(iv,ibin) = 0.0
506 volatile_s(iv,ibin) = 0.0
507 enddo
508
509
510 jaerosolstate(ibin) = -1 ! initialize to default value
511 jphase(ibin) = 0
512
513 do jc = 1, ncation
514 mc(jc,ibin) = 0.0
515 enddo
516
517 do ja = 1, nanion
518 ma(ja,ibin) = 0.0
519 enddo
520
521 enddo ! ibin
522
523
524 return
525 end subroutine initialize_mosaic_variables
526
527
528
529
530
531
532 !***********************************************************************
533 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
534 !
535 ! author: rahul a. zaveri
536 ! update: nov 2001
537 !-------------------------------------------------------------------------
538 subroutine map_mosaic_species(k, m, imap)
539
540 use module_data_mosaic_asect
541 use module_data_mosaic_other
542 use module_state_description, only: param_first_scalar
543
544 ! implicit none
545
546 ! include 'v33com'
547 ! include 'v33com3'
548 ! include 'v33com9a'
549 ! include 'v33com9b'
550
551 ! subr arguments
552 integer k, m, imap
553 ! local variables
554 integer ibin, iphase, isize, itsi, itype, l, p1st
555
556
557 ! if a species index is less than this value, then the species is not defined
558 p1st = param_first_scalar
559
560 ! 3-d
561 ! calculate air conc in mol/m^3
562 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
563 cair_mol_cc = cairclm(k)
564
565 ! 3-d
566 ! define conversion factors
567 conv1a = cair_mol_m3*1.d9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
568 conv1b = 1.d0/conv1a ! converts nq/m^3 to q/mol(air)
569 conv2a = cair_mol_m3*18.*1.d-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
570 conv2b = 1.d0/conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
571
572
573 ! box
574 ! conv1 = 1.d15/avogad ! converts (molec/cc) to (nmol/m^3)
575 ! conv2 = 1.d0/conv1 ! converts (nmol/m^3) to (molec/cc)
576 ! kaerstart = ngas_max
577
578
579 if(imap.eq.0)then ! map rsub (mol/mol(air)) into aer (nmol/m^3)
580 ! gas
581 if (kh2so4 .ge. p1st) then
582 gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a ! nmol/m^3
583 else
584 gas(ih2so4_g) = 0.0
585 end if
586 if (khno3 .ge. p1st) then
587 gas(ihno3_g) = rsub(khno3,k,m)*conv1a
588 else
589 gas(ihno3_g) = 0.0
590 end if
591 if (khcl .ge. p1st) then
592 gas(ihcl_g) = rsub(khcl,k,m)*conv1a
593 else
594 gas(ihcl_g) = 0.0
595 end if
596 if (knh3 .ge. p1st) then
597 gas(inh3_g) = rsub(knh3,k,m)*conv1a
598 else
599 gas(inh3_g) = 0.0
600 end if
601
602 ! soa gas-phase species -- currently deactivated
603 ! if (karo1 .ge. p1st) then
604 ! gas(iaro1_g) = rsub(karo1,k,m)*conv1a
605 ! else
606 gas(iaro1_g) = 0.0
607 ! end if
608 ! if (karo2 .ge. p1st) then
609 ! gas(iaro2_g) = rsub(karo2,k,m)*conv1a
610 ! else
611 gas(iaro2_g) = 0.0
612 ! end if
613 ! if (kalk1 .ge. p1st) then
614 ! gas(ialk1_g) = rsub(kalk1,k,m)*conv1a
615 ! else
616 gas(ialk1_g) = 0.0
617 ! end if
618 ! if (kole1 .ge. p1st) then
619 ! gas(iole1_g) = rsub(kole1,k,m)*conv1a
620 ! else
621 gas(iole1_g) = 0.0
622 ! end if
623 ! if (kapi1 .ge. p1st) then
624 ! gas(iapi1_g) = rsub(kapi1,k,m)*conv1a
625 ! else
626 gas(iapi1_g) = 0.0
627 ! end if
628 ! if (kapi2 .ge. p1st) then
629 ! gas(iapi2_g) = rsub(kapi2,k,m)*conv1a
630 ! else
631 gas(iapi2_g) = 0.0
632 ! end if
633 ! if (klim1 .ge. p1st) then
634 ! gas(ilim1_g) = rsub(klim1,k,m)*conv1a
635 ! else
636 gas(ilim1_g) = 0.0
637 ! end if
638 ! if (klim2 .ge. p1st) then
639 ! gas(ilim2_g) = rsub(klim2,k,m)*conv1a
640 ! else
641 gas(ilim2_g) = 0.0
642 ! end if
643
644
645 ! aerosol
646 iphase = ai_phase
647 ibin = 0
648 do 10 itype = 1, ntype_aer
649 do 10 isize = 1, nsize_aer(itype)
650 ibin = ibin + 1
651
652 ! aer array units are nmol/(m^3 air)
653
654 ! rce 18-nov-2004 - always map so4 and number,
655 ! but only map other species when (lptr_xxx .ge. p1st)
656 ! rce 11-may-2006 - so4 mapping now optional
657 l = lptr_so4_aer(isize,itype,iphase)
658 if (l .ge. p1st) then
659 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
660 else
661 aer(iso4_a,jtotal,ibin)=0.0
662 end if
663
664 l = lptr_no3_aer(isize,itype,iphase)
665 if (l .ge. p1st) then
666 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
667 else
668 aer(ino3_a,jtotal,ibin)=0.0
669 end if
670
671 l = lptr_cl_aer(isize,itype,iphase)
672 if (l .ge. p1st) then
673 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
674 else
675 aer(icl_a,jtotal,ibin)=0.0
676 end if
677
678 l = lptr_nh4_aer(isize,itype,iphase)
679 if (l .ge. p1st) then
680 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
681 else
682 aer(inh4_a,jtotal,ibin)=0.0
683 end if
684
685 l = lptr_oc_aer(isize,itype,iphase)
686 if (l .ge. p1st) then
687 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
688 else
689 aer(ioc_a,jtotal,ibin)=0.0
690 end if
691
692 l = lptr_bc_aer(isize,itype,iphase)
693 if (l .ge. p1st) then
694 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
695 else
696 aer(ibc_a,jtotal,ibin)=0.0
697 end if
698
699 l = lptr_na_aer(isize,itype,iphase)
700 if (l .ge. p1st) then
701 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
702 else
703 aer(ina_a,jtotal,ibin)=0.0
704 end if
705
706 l = lptr_oin_aer(isize,itype,iphase)
707 if (l .ge. p1st) then
708 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
709 else
710 aer(ioin_a,jtotal,ibin)=0.0
711 end if
712
713 l = lptr_msa_aer(isize,itype,iphase)
714 if (l .ge. p1st) then
715 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
716 else
717 aer(imsa_a,jtotal,ibin)=0.0
718 end if
719
720 l = lptr_co3_aer(isize,itype,iphase)
721 if (l .ge. p1st) then
722 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
723 else
724 aer(ico3_a,jtotal,ibin)=0.0
725 end if
726
727 l = lptr_ca_aer(isize,itype,iphase)
728 if (l .ge. p1st) then
729 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
730 else
731 aer(ica_a,jtotal,ibin)=0.0
732 end if
733
734 ! soa aerosol-phase species -- currently deactivated
735 ! l = lptr_aro1_aer(isize,itype,iphase)
736 ! if (l .ge. p1st) then
737 ! aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
738 ! else
739 aer(iaro1_a,jtotal,ibin)=0.0
740 ! end if
741
742 ! l = lptr_aro2_aer(isize,itype,iphase)
743 ! if (l .ge. p1st) then
744 ! aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
745 ! else
746 aer(iaro2_a,jtotal,ibin)=0.0
747 ! end if
748
749 ! l = lptr_alk1_aer(isize,itype,iphase)
750 ! if (l .ge. p1st) then
751 ! aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
752 ! else
753 aer(ialk1_a,jtotal,ibin)=0.0
754 ! end if
755
756 ! l = lptr_ole1_aer(isize,itype,iphase)
757 ! if (l .ge. p1st) then
758 ! aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
759 ! else
760 aer(iole1_a,jtotal,ibin)=0.0
761 ! end if
762
763 ! l = lptr_api1_aer(isize,itype,iphase)
764 ! if (l .ge. p1st) then
765 ! aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
766 ! else
767 aer(iapi1_a,jtotal,ibin)=0.0
768 ! end if
769
770 ! l = lptr_api2_aer(isize,itype,iphase)
771 ! if (l .ge. p1st) then
772 ! aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
773 ! else
774 aer(iapi2_a,jtotal,ibin)=0.0
775 ! end if
776
777 ! l = lptr_lim1_aer(isize,itype,iphase)
778 ! if (l .ge. p1st) then
779 ! aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
780 ! else
781 aer(ilim1_a,jtotal,ibin)=0.0
782 ! end if
783
784 ! l = lptr_lim2_aer(isize,itype,iphase)
785 ! if (l .ge. p1st) then
786 ! aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
787 ! else
788 aer(ilim2_a,jtotal,ibin)=0.0
789 ! end if
790
791 ! water_a and water_a_hyst units are kg/(m^3 air)
792 l = hyswptr_aer(isize,itype)
793 if (l .ge. p1st) then
794 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
795 else
796 water_a_hyst(ibin)=0.0
797 end if
798
799 ! water_a units are kg/(m^3 air)
800 l = waterptr_aer(isize,itype)
801 if (l .ge. p1st) then
802 water_a(ibin)=rsub(l,k,m)*conv2a
803 else
804 water_a(ibin)=0.0
805 end if
806
807 ! num_a units are #/(cm^3 air)
808 l = numptr_aer(isize,itype,iphase)
809 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
810
811 ! other bin parameters (fixed for now)
812 sigmag_a(ibin) = 1.02
813
814 10 continue
815
816
817
818
819 !---------------------------------------------------------------------
820
821
822 else ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
823
824
825
826 ! gas
827 if (kh2so4 .ge. p1st) &
828 rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
829 if (khno3 .ge. p1st) &
830 rsub(khno3,k,m) = gas(ihno3_g)*conv1b
831 if (khcl .ge. p1st) &
832 rsub(khcl,k,m) = gas(ihcl_g)*conv1b
833 if (knh3 .ge. p1st) &
834 rsub(knh3,k,m) = gas(inh3_g)*conv1b
835
836 ! soa gas-phase species -- currently deactivated
837 ! if (karo1 .ge. p1st) &
838 ! rsub(karo1,k,m) = gas(iaro1_g)*conv1b
839 ! if (karo2 .ge. p1st) &
840 ! rsub(karo2,k,m) = gas(iaro2_g)*conv1b
841 ! if (kalk1 .ge. p1st) &
842 ! rsub(kalk1,k,m) = gas(ialk1_g)*conv1b
843 ! if (kole1 .ge. p1st) &
844 ! rsub(kole1,k,m) = gas(iole1_g)*conv1b
845 ! if (kapi1 .ge. p1st) &
846 ! rsub(kapi1,k,m) = gas(iapi1_g)*conv1b
847 ! if (kapi2 .ge. p1st) &
848 ! rsub(kapi2,k,m) = gas(iapi2_g)*conv1b
849 ! if (klim1 .ge. p1st) &
850 ! rsub(klim1,k,m) = gas(ilim1_g)*conv1b
851 ! if (klim2 .ge. p1st) &
852 ! rsub(klim2,k,m) = gas(ilim2_g)*conv1b
853
854 ! aerosol
855 iphase = ai_phase
856 ibin = 0
857 do 20 itype = 1, ntype_aer
858 do 20 isize = 1, nsize_aer(itype)
859 ibin = ibin + 1
860
861
862 ! rce 18-nov-2004 - always map so4 and number,
863 ! but only map other species when (lptr_xxx .ge. p1st)
864 l = lptr_so4_aer(isize,itype,iphase)
865 rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
866
867 l = lptr_no3_aer(isize,itype,iphase)
868 if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
869
870 l = lptr_cl_aer(isize,itype,iphase)
871 if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
872
873 l = lptr_nh4_aer(isize,itype,iphase)
874 if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
875
876 l = lptr_oc_aer(isize,itype,iphase)
877 if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
878
879 l = lptr_bc_aer(isize,itype,iphase)
880 if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
881
882 l = lptr_na_aer(isize,itype,iphase)
883 if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
884
885 l = lptr_oin_aer(isize,itype,iphase)
886 if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
887
888 l = lptr_msa_aer(isize,itype,iphase)
889 if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
890
891 l = lptr_co3_aer(isize,itype,iphase)
892 if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
893
894 l = lptr_ca_aer(isize,itype,iphase)
895 if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
896
897 ! soa aerosol-phase species -- currently deactivated
898 ! l = lptr_aro1_aer(isize,itype,iphase)
899 ! if (l .ge. p1st) rsub(l,k,m) = aer(iaro1_a,jtotal,ibin)*conv1b
900
901 ! l = lptr_aro2_aer(isize,itype,iphase)
902 ! if (l .ge. p1st) rsub(l,k,m) = aer(iaro2_a,jtotal,ibin)*conv1b
903
904 ! l = lptr_alk1_aer(isize,itype,iphase)
905 ! if (l .ge. p1st) rsub(l,k,m) = aer(ialk1_a,jtotal,ibin)*conv1b
906
907 ! l = lptr_ole1_aer(isize,itype,iphase)
908 ! if (l .ge. p1st) rsub(l,k,m) = aer(iole1_a,jtotal,ibin)*conv1b
909
910 ! l = lptr_api1_aer(isize,itype,iphase)
911 ! if (l .ge. p1st) rsub(l,k,m) = aer(iapi1_a,jtotal,ibin)*conv1b
912
913 ! l = lptr_api2_aer(isize,itype,iphase)
914 ! if (l .ge. p1st) rsub(l,k,m) = aer(iapi2_a,jtotal,ibin)*conv1b
915
916 ! l = lptr_lim1_aer(isize,itype,iphase)
917 ! if (l .ge. p1st) rsub(l,k,m) = aer(ilim1_a,jtotal,ibin)*conv1b
918
919 ! l = lptr_lim2_aer(isize,itype,iphase)
920 ! if (l .ge. p1st) rsub(l,k,m) = aer(ilim2_a,jtotal,ibin)*conv1b
921
922 l = hyswptr_aer(isize,itype)
923 if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
924
925 l = waterptr_aer(isize,itype)
926 if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
927
928 l = numptr_aer(isize,itype,iphase)
929 if (l .ge. p1st) rsub(l,k,m) = num_a(ibin)/cair_mol_cc
930
931
932 drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
933 if(jaerosolstate(ibin) .eq. no_aerosol) then
934 drydens_aftgrow(isize,itype) = -1.
935 else
936 drydens_aftgrow(isize,itype) = dens_dry_a(ibin) ! g/cc
937 end if
938
939 20 continue
940
941 endif
942
943 return
944 end subroutine map_mosaic_species
945
946
947
948
949
950 subroutine isize_itype_from_ibin( ibin, isize, itype )
951 !
952 ! inside of mosaic, the '2d' (isize,itype) indexing is replaced
953 ! by '1d' (ibin) indexing
954 ! this routine gives (isize,itype) corresponding to (ibin)
955 !
956 use module_data_mosaic_asect
957 use module_data_mosaic_other, only: lunerr
958 ! implicit none
959
960 ! subr arguments
961 integer ibin, isize, itype
962 ! local variables
963 integer jdum_bin, jdum_size, jdum_type
964 character*80 msg
965
966 isize = -999888777
967 itype = -999888777
968
969 jdum_bin = 0
970 do jdum_type = 1, ntype_aer
971 do jdum_size = 1, nsize_aer(jdum_type)
972 jdum_bin = jdum_bin + 1
973 if (ibin .eq. jdum_bin) then
974 isize = jdum_size
975 itype = jdum_type
976 end if
977 end do
978 end do
979
980 if (isize .le. 0) then
981 write(msg,'(a,1x,i5)') &
982 '*** subr isize_itype_from_ibin - bad ibin =', ibin
983 call peg_error_fatal( lunerr, msg )
984 end if
985
986 return
987 end subroutine isize_itype_from_ibin
988
989
990
991
992 subroutine overall_massbal_in
993
994 use module_data_mosaic_asect
995 use module_data_mosaic_other
996
997 ! implicit none
998 ! include 'mosaic.h'
999 integer ibin
1000
1001 tot_so4_in = gas(ih2so4_g)
1002 tot_no3_in = gas(ihno3_g)
1003 tot_cl_in = gas(ihcl_g)
1004 tot_nh4_in = gas(inh3_g)
1005 tot_na_in = 0.0
1006 tot_ca_in = 0.0
1007
1008
1009 do ibin = 1, nbin_a
1010 tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
1011 tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
1012 tot_cl_in = tot_cl_in + aer(icl_a, jtotal,ibin)
1013 tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
1014 tot_na_in = tot_na_in + aer(ina_a,jtotal,ibin)
1015 tot_ca_in = tot_ca_in + aer(ica_a,jtotal,ibin)
1016 enddo
1017
1018
1019 total_species(inh3_g) = tot_nh4_in
1020 total_species(ihno3_g)= tot_no3_in
1021 total_species(ihcl_g) = tot_cl_in
1022
1023
1024 return
1025 end subroutine overall_massbal_in
1026
1027
1028
1029 subroutine overall_massbal_out(mbin)
1030 ! implicit none
1031 ! include 'v33com'
1032 ! include 'v33com3'
1033 ! include 'v33com9a'
1034 ! include 'v33com9b'
1035 ! include 'mosaic.h'
1036
1037 ! subr. agrument
1038 integer mbin
1039 ! local variables
1040 integer ibin
1041
1042
1043
1044 tot_so4_out = gas(ih2so4_g)
1045 tot_no3_out = gas(ihno3_g)
1046 tot_cl_out = gas(ihcl_g)
1047 tot_nh4_out = gas(inh3_g)
1048 tot_na_out = 0.0
1049 tot_ca_out = 0.0
1050
1051 do ibin = 1, nbin_a
1052 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1053 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1054 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
1055 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1056 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
1057 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
1058 enddo
1059
1060 diff_so4 = tot_so4_out - tot_so4_in
1061 diff_no3 = tot_no3_out - tot_no3_in
1062 diff_cl = tot_cl_out - tot_cl_in
1063 diff_nh4 = tot_nh4_out - tot_nh4_in
1064 diff_na = tot_na_out - tot_na_in
1065 diff_ca = tot_ca_out - tot_ca_in
1066
1067
1068 reldiff_so4 = 0.0
1069 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1070 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1071 endif
1072
1073 reldiff_no3 = 0.0
1074 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1075 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1076 endif
1077
1078 reldiff_cl = 0.0
1079 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1080 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1081 endif
1082
1083 reldiff_nh4 = 0.0
1084 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1085 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1086 endif
1087
1088 reldiff_na = 0.0
1089 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1090 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1091 endif
1092
1093 reldiff_ca = 0.0
1094 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1095 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1096 endif
1097
1098
1099
1100 if( abs(reldiff_so4) .gt. 1.e-4 .or. &
1101 abs(reldiff_no3) .gt. 1.e-4 .or. &
1102 abs(reldiff_cl) .gt. 1.e-4 .or. &
1103 abs(reldiff_nh4) .gt. 1.e-4 .or. &
1104 abs(reldiff_na) .gt. 1.e-4 .or. &
1105 abs(reldiff_ca) .gt. 1.e-4)then
1106
1107
1108 if (iprint_mosaic_diag1 .gt. 0) then
1109 if (iprint_input .eq. myes) then
1110 write(6,*)'*** mbin = ', mbin, ' isteps = ', isteps_ASTEM
1111 write(6,*)'reldiff_so4 = ', reldiff_so4
1112 write(6,*)'reldiff_no3 = ', reldiff_no3
1113 write(6,*)'reldiff_cl = ', reldiff_cl
1114 write(6,*)'reldiff_nh4 = ', reldiff_nh4
1115 write(6,*)'reldiff_na = ', reldiff_na
1116 write(6,*)'reldiff_ca = ', reldiff_ca
1117 call print_input
1118 iprint_input = mno
1119 endif
1120 endif
1121
1122 endif
1123
1124
1125 return
1126 end subroutine overall_massbal_out
1127
1128
1129
1130
1131
1132
1133
1134 subroutine print_input
1135
1136 use module_data_mosaic_asect
1137 use module_data_mosaic_other
1138
1139 ! implicit none
1140 ! include 'v33com'
1141 ! include 'v33com3'
1142 ! include 'v33com9a'
1143 ! include 'v33com9b'
1144 ! include 'mosaic.h'
1145 ! subr arguments
1146 integer k, m
1147 ! local variables
1148 integer ibin, iphase, isize, itype
1149 integer ipasstmp, luntmp
1150
1151
1152 ! check for print_input allowed and not already done
1153 if (iprint_mosaic_input_ok .le. 0) return
1154 if (iprint_input .ne. myes) return
1155 iprint_input = mno
1156
1157 k = kclm_aer
1158 m = mclm_aer
1159
1160
1161 tot_so4_out = gas(ih2so4_g)
1162 tot_no3_out = gas(ihno3_g)
1163 tot_cl_out = gas(ihcl_g)
1164 tot_nh4_out = gas(inh3_g)
1165 tot_na_out = 0.0
1166 tot_ca_out = 0.0
1167
1168 do ibin = 1, nbin_a
1169 tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1170 tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1171 tot_cl_out = tot_cl_out + aer(icl_a,jtotal,ibin)
1172 tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1173 tot_na_out = tot_na_out + aer(ina_a,jtotal,ibin)
1174 tot_ca_out = tot_ca_out + aer(ica_a,jtotal,ibin)
1175 enddo
1176
1177 diff_so4 = tot_so4_out - tot_so4_in
1178 diff_no3 = tot_no3_out - tot_no3_in
1179 diff_cl = tot_cl_out - tot_cl_in
1180 diff_nh4 = tot_nh4_out - tot_nh4_in
1181 diff_na = tot_na_out - tot_na_in
1182 diff_ca = tot_ca_out - tot_ca_in
1183
1184
1185 reldiff_so4 = 0.0
1186 if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1187 reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1188 endif
1189
1190 reldiff_no3 = 0.0
1191 if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1192 reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1193 endif
1194
1195 reldiff_cl = 0.0
1196 if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1197 reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1198 endif
1199
1200 reldiff_nh4 = 0.0
1201 if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1202 reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1203 endif
1204
1205 reldiff_na = 0.0
1206 if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1207 reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1208 endif
1209
1210 reldiff_ca = 0.0
1211 if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1212 reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1213 endif
1214
1215
1216 do 2900 ipasstmp = 1, 2
1217
1218 if (ipasstmp .eq. 1) then
1219 luntmp = 6 ! write to standard output
1220 else
1221 luntmp = 67 ! write to fort.67
1222 ! goto 2900 ! skip this
1223 endif
1224
1225 ! write to monitor screen
1226 write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1227 write(luntmp,*)'i j k n = ', iclm_aer, jclm_aer, kclm_aer, &
1228 ncorecnt_aer
1229 write(luntmp,*)'relative so4 mass bal = ', reldiff_so4
1230 write(luntmp,*)'relative no3 mass bal = ', reldiff_no3
1231 write(luntmp,*)'relative cl mass bal = ', reldiff_cl
1232 write(luntmp,*)'relative nh4 mass bal = ', reldiff_nh4
1233 write(luntmp,*)'relative na mass bal = ', reldiff_na
1234 write(luntmp,*)'relative ca mass bal = ', reldiff_ca
1235 write(luntmp,*)'inputs:'
1236 write(luntmp,*)'t (k), p (atm), rh (%), cair (mol/cc) = '
1237 write(luntmp,44) t_k, p_atm, rh_pc, cairclm(k)
1238 write(luntmp,*)'gas h2so4, hno3, hcl, nh3 (mol/mol)'
1239 write(luntmp,44)rsub(kh2so4,k,m), rsub(khno3,k,m), &
1240 rsub(khcl,k,m), rsub(knh3,k,m)
1241
1242
1243 iphase = ai_phase
1244 ibin = 0
1245 do itype = 1, ntype_aer
1246 do isize = 1, nsize_aer(itype)
1247 ibin = ibin + 1
1248
1249 write(luntmp,44) rsub(lptr_so4_aer(ibin,itype,iphase),k,m), &
1250 rsub(lptr_no3_aer(ibin,itype,iphase),k,m), &
1251 rsub(lptr_cl_aer(ibin,itype,iphase),k,m), &
1252 rsub(lptr_nh4_aer(ibin,itype,iphase),k,m), &
1253 rsub(lptr_oc_aer(ibin,itype,iphase),k,m), & ! ng/m^3(air)
1254 rsub(lptr_co3_aer(ibin,itype,iphase),k,m), &
1255 rsub(lptr_msa_aer(ibin,itype,iphase),k,m), &
1256 rsub(lptr_bc_aer(ibin,itype,iphase),k,m), & ! ng/m^3(air)
1257 rsub(lptr_na_aer(ibin,itype,iphase),k,m), &
1258 rsub(lptr_ca_aer(ibin,itype,iphase),k,m), &
1259 rsub(lptr_oin_aer(ibin,itype,iphase),k,m), &
1260 rsub(hyswptr_aer(ibin,itype),k,m), &
1261 rsub(waterptr_aer(ibin,itype),k,m), &
1262 rsub(numptr_aer(ibin,itype,iphase),k,m)
1263 enddo
1264 enddo
1265
1266 write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1267
1268 2900 continue
1269
1270
1271 44 format(14e20.10)
1272
1273 !c stop
1274
1275 return
1276 end subroutine print_input
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295 !***********************************************************************
1296 ! checks if aerosol mass is too low to be of any significance
1297 ! and determine jaerosolstate
1298 !
1299 ! author: rahul a. zaveri
1300 ! update: jan 2005
1301 !-----------------------------------------------------------------------
1302 subroutine check_aerosol_mass(ibin)
1303 ! implicit none
1304 ! include 'mosaic.h'
1305 ! subr arguments
1306 integer ibin
1307 ! local variables
1308 integer iaer
1309 real(kind=8) drymass, aer_H
1310
1311 mass_dry_a(ibin) = 0.0
1312
1313 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1314 aer(ino3_a,jtotal,ibin) + &
1315 aer(icl_a,jtotal,ibin) + &
1316 aer(imsa_a,jtotal,ibin) + &
1317 2.*aer(ico3_a,jtotal,ibin))- &
1318 (2.*aer(ica_a,jtotal,ibin) + &
1319 aer(ina_a,jtotal,ibin) + &
1320 aer(inh4_a,jtotal,ibin))
1321
1322
1323 do iaer = 1, naer
1324 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1325 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
1326 enddo
1327 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1328
1329 drymass = mass_dry_a(ibin) ! ng/m^3(air)
1330 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
1331
1332 if(drymass .lt. mass_cutoff)then ! bin mass is too small
1333 jaerosolstate(ibin) = no_aerosol
1334 jphase(ibin) = 0
1335 if(drymass .eq. 0.)num_a(ibin) = 0.0
1336 endif
1337
1338 return
1339 end subroutine check_aerosol_mass
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351 !***********************************************************************
1352 ! checks and conforms number according to the mass and bin size range
1353 !
1354 ! author: rahul a. zaveri
1355 ! update: jan 2005
1356 !-----------------------------------------------------------------------
1357 subroutine conform_aerosol_number(ibin)
1358
1359 use module_data_mosaic_asect
1360
1361 ! implicit none
1362 ! include 'v33com'
1363 ! include 'v33com3'
1364 ! include 'v33com9a'
1365 ! include 'mosaic.h'
1366 ! subr arguments
1367 integer ibin
1368 ! local variables
1369 integer je, l, iaer, isize, itype
1370 real(kind=8) num_at_dlo, num_at_dhi, numold
1371 real(kind=8) aer_H
1372
1373 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
1374
1375 if(jaerosolstate(ibin) .eq. no_aerosol) return
1376
1377 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1378 aer(ino3_a,jtotal,ibin) + &
1379 aer(icl_a,jtotal,ibin) + &
1380 aer(imsa_a,jtotal,ibin) + &
1381 2.*aer(ico3_a,jtotal,ibin))- &
1382 (2.*aer(ica_a,jtotal,ibin) + &
1383 aer(ina_a,jtotal,ibin) + &
1384 aer(inh4_a,jtotal,ibin))
1385
1386 do iaer = 1, naer
1387 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1388 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ng/m^3(air)
1389 enddo
1390 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1391
1392 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air)
1393
1394 ! conform number
1395 call isize_itype_from_ibin( ibin, isize, itype )
1396 num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
1397 num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
1398
1399 numold = num_a(ibin)
1400 num_a(ibin) = min(num_a(ibin), num_at_dlo) ! #/cc(air)
1401 num_a(ibin) = max(num_a(ibin), num_at_dhi) ! #/cc(air)
1402
1403 ! if (numold .ne. num_a(ibin)) then
1404 ! write(*,*) 'conform number - i, vol, mass, numold/new', ibin,
1405 ! & vol_dry_a(ibin), mass_dry_temp, numold, num_a(ibin)
1406 ! write(*,*) 'conform i,j,k', iclm_aer, jclm_aer, kclm_aer
1407 ! if (nsubareas .gt. 0) then
1408 ! write(*,'(a,1pe14.4)') (name(l), rsub(l,kclm_aer,1), l=1,ltot2)
1409 ! else
1410 ! write(*,'(a,1pe14.4)') (name(l), rclm(kclm_aer,l), l=1,ltot2)
1411 ! end if
1412 ! stop
1413 ! end if
1414
1415 return
1416 end subroutine conform_aerosol_number
1417
1418
1419
1420
1421
1422 !***********************************************************************
1423 ! determines phase state of an aerosol bin. includes kelvin effect.
1424 !
1425 ! author: rahul a. zaveri
1426 ! update: jan 2005
1427 !-----------------------------------------------------------------------
1428 subroutine aerosol_phase_state(ibin)
1429 ! implicit none
1430 ! include 'mosaic.h'
1431 ! subr arguments
1432 integer ibin
1433 ! local variables
1434 integer js, je, iaer, iv, iter_kelvin
1435 real(kind=8) ah2o_a_new, rel_err
1436 ! real(kind=8) aerosol_water_up, bin_molality ! mosaic func
1437 real(kind=8) kelvin_toler, term
1438 real(kind=8) aer_H
1439
1440
1441 ah2o = rh_pc*0.01
1442 ah2o_a(ibin) = ah2o
1443 kelvin(ibin) = 1.0
1444 do iv = 1, ngas_volatile
1445 kel(iv,ibin) = 1.0
1446 enddo
1447
1448 if(rh_pc .le. 99)then
1449 kelvin_toler = 1.e-2
1450 else
1451 kelvin_toler = 1.e-6
1452 endif
1453
1454 ! calculate dry mass and dry volume of a bin
1455 mass_dry_a(ibin) = 0.0 ! initialize to 0.0
1456 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
1457
1458 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1459 aer(ino3_a,jtotal,ibin) + &
1460 aer(icl_a,jtotal,ibin) + &
1461 aer(imsa_a,jtotal,ibin) + &
1462 2.*aer(ico3_a,jtotal,ibin))- &
1463 (2.*aer(ica_a,jtotal,ibin) + &
1464 aer(ina_a,jtotal,ibin) + &
1465 aer(inh4_a,jtotal,ibin))
1466
1467 do iaer = 1, naer
1468 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1469 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
1470 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1471 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
1472 enddo
1473 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1474 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1475
1476 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
1477 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air) or m^3/m^3(air)
1478
1479 ! wet mass and wet volume
1480 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1481 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1482
1483
1484 water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
1485
1486 iter_kelvin = 0
1487
1488 10 iter_kelvin = iter_kelvin + 1
1489 do je = 1, nelectrolyte
1490 molality0(je) = bin_molality(je,ibin) ! compute ah2o dependent binary molalities
1491 enddo
1492
1493 call mesa(ibin)
1494 if(jaerosolstate(ibin) .eq. all_solid)then
1495 return
1496 endif
1497 if (istat_mosaic_fe1 .lt. 0) return
1498
1499 ! new wet mass and wet volume
1500 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1501 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1502
1503 call calculate_kelvin(ibin)
1504
1505 ah2o_a_new = rh_pc*0.01/kelvin(ibin)
1506
1507 rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
1508
1509 if(rel_err .gt. kelvin_toler .and. iter_kelvin.le.20)then
1510 ah2o_a(ibin) = ah2o_a_new
1511 goto 10
1512 endif
1513
1514 if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
1515
1516 ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
1517 do iv = 1, ngas_volatile
1518 term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/ &
1519 (8.3144e7*T_K*DpmV(ibin))
1520 kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1521 enddo
1522
1523
1524 return
1525 end subroutine aerosol_phase_state
1526
1527
1528
1529
1530
1531
1532 !***********************************************************************
1533 ! computes kelvin effect term (kelvin => 1.0)
1534 !
1535 ! author: rahul a. zaveri
1536 ! update: jan 2005
1537 !-----------------------------------------------------------------------
1538 subroutine calculate_kelvin(ibin)
1539 ! implicit none
1540 ! include 'mosaic.h'
1541 ! subr arguments
1542 integer ibin
1543 ! local variables
1544 real(kind=8) term
1545
1546
1547
1548 volume_a(ibin) = vol_wet_a(ibin) ! [cc/cc(air)]
1549 dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.) ! [cm]
1550 sigma_soln(ibin) = sigma_water + 49.0*(1. - ah2o_a(ibin)) ! [dyn/cm]
1551 term = 72.*sigma_soln(ibin)/(8.3144e7*t_k*dpmv(ibin)) ! [-]
1552 ! kelvin(ibin) = exp(term)
1553 kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1554
1555
1556 return
1557 end subroutine calculate_kelvin
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573 !***********************************************************************
1574 ! mesa: multicomponent equilibrium solver for aerosols.
1575 ! computes equilibrum solid and liquid phases by integrating
1576 ! pseudo-transient dissolution and precipitation reactions
1577 !
1578 ! author: rahul a. zaveri
1579 ! update: jan 2005
1580 !-----------------------------------------------------------------------
1581 subroutine mesa(ibin) ! touch
1582 ! implicit none
1583 ! include 'mosaic.h'
1584 ! subr arguments
1585 integer ibin
1586
1587 ! local variables
1588 integer idissolved, j_index, jdum, js
1589 real(kind=8) crh, solids, sum_soluble, sum_insoluble, xt
1590 ! real(kind=8) aerosol_water ! mosaic func
1591 ! real(kind=8) drh_mutual ! mosaic func
1592 real(kind=8) h_ion
1593
1594
1595 call calculate_xt(ibin,jtotal,xt)
1596
1597 crh = 0.35 ! raz-30apr07
1598
1599 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
1600 if( (ah2o_a(ibin) .lt. crh) .and. &
1601 (xt.gt.1.0 .or. xt.lt.0.) .and. &
1602 (epercent(jcano3,jtotal,ibin) .le. ptol_mol_astem) .and. &
1603 (epercent(jcacl2,jtotal,ibin) .le. ptol_mol_astem) )then ! raz-30apr07
1604 jaerosolstate(ibin) = all_solid
1605 jphase(ibin) = jsolid
1606 jhyst_leg(ibin) = jhyst_lo
1607 call adjust_solid_aerosol(ibin)
1608 return
1609 endif
1610
1611
1612 ! step 2: check for supersaturation/metastable state
1613 if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin))then
1614
1615 call do_full_deliquescence(ibin)
1616
1617 sum_soluble = 0.0
1618 do js = 1, nsoluble
1619 sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
1620 enddo
1621
1622 solids = electrolyte(jcaso4,jtotal,ibin) + &
1623 electrolyte(jcaco3,jtotal,ibin) + &
1624 aer(ioin_a ,jtotal,ibin)
1625
1626
1627 if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
1628
1629 jaerosolstate(ibin) = all_solid ! no soluble material present
1630 jphase(ibin) = jsolid
1631 call adjust_solid_aerosol(ibin)
1632
1633 ! new wet mass and wet volume
1634 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1635 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1636 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1637
1638 return
1639
1640 elseif(sum_soluble .gt. 0.0 .and. solids .eq. 0.0)then
1641
1642 jaerosolstate(ibin) = all_liquid
1643 jhyst_leg(ibin) = jhyst_up
1644 jphase(ibin) = jliquid
1645 water_a(ibin) = aerosol_water(jtotal,ibin)
1646
1647 if(water_a(ibin) .lt. 0.0)then
1648 jaerosolstate(ibin) = all_solid ! no soluble material present
1649 jphase(ibin) = jsolid
1650 jhyst_leg(ibin) = jhyst_lo
1651 call adjust_solid_aerosol(ibin)
1652 else
1653 call adjust_liquid_aerosol(ibin)
1654 call compute_activities(ibin)
1655 endif
1656
1657 ! new wet mass and wet volume
1658 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1659 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1660 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1661
1662 return
1663
1664 endif
1665
1666 endif
1667
1668
1669
1670
1671 ! step 3: diagnose mdrh
1672 if(xt .lt. 1. .and. xt .gt. 0. )goto 10 ! excess sulfate domain - no mdrh exists
1673
1674 jdum = 0
1675 do js = 1, nsalt
1676 jsalt_present(js) = 0 ! default value - salt absent
1677
1678 if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
1679 jsalt_present(js) = 1 ! salt present
1680 jdum = jdum + jsalt_index(js)
1681 endif
1682 enddo
1683
1684 if(jdum .eq. 0)then
1685 jaerosolstate(ibin) = all_solid ! no significant soluble material present
1686 jphase(ibin) = jsolid
1687 call adjust_solid_aerosol(ibin)
1688 return
1689 endif
1690
1691 if(xt .ge. 2.0 .or. xt .lt. 0.0)then
1692 j_index = jsulf_poor(jdum)
1693 else
1694 j_index = jsulf_rich(jdum)
1695 endif
1696
1697 mdrh(ibin) = mdrh_t(j_index)
1698
1699 if(ah2o_a(ibin)*100. .lt. mdrh(ibin)) then
1700 jaerosolstate(ibin) = all_solid
1701 jphase(ibin) = jsolid
1702 jhyst_leg(ibin) = jhyst_lo
1703 call adjust_solid_aerosol(ibin)
1704 return
1705 endif
1706
1707
1708 ! step 4: none of the above means it must be sub-saturated or mixed-phase
1709 10 call do_full_deliquescence(ibin)
1710 call mesa_ptc(ibin) ! determines jaerosolstate(ibin)
1711 if (istat_mosaic_fe1 .lt. 0) return
1712
1713
1714
1715 return
1716 end subroutine mesa
1717
1718
1719
1720
1721
1722
1723
1724
1725 !***********************************************************************
1726 ! this subroutine completely deliquesces an aerosol and partitions
1727 ! all the soluble electrolytes into the liquid phase and insoluble
1728 ! ones into the solid phase. it also calculates the corresponding
1729 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
1730 ! concentrations
1731 !
1732 ! author: rahul a. zaveri
1733 ! update: jan 2005
1734 !-----------------------------------------------------------------------
1735 subroutine do_full_deliquescence(ibin) ! touch
1736 ! implicit none
1737 ! include 'mosaic.h'
1738 ! subr arguments
1739 integer ibin
1740 ! local variables
1741 integer js
1742
1743
1744
1745
1746 ! partition all electrolytes into liquid phase
1747 do js = 1, nelectrolyte
1748 electrolyte(js,jsolid,ibin) = 0.0
1749 electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
1750 enddo
1751 !
1752 ! except these electrolytes, which always remain in the solid phase
1753 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1754 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1755 electrolyte(jcaco3,jliquid,ibin)= 0.0
1756 electrolyte(jcaso4,jliquid,ibin)= 0.0
1757
1758
1759 ! partition all the generic aer species into solid and liquid phases
1760 ! solid phase
1761 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1762 aer(ino3_a,jsolid,ibin) = 0.0
1763 aer(icl_a, jsolid,ibin) = 0.0
1764 aer(inh4_a,jsolid,ibin) = 0.0
1765 aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1766 aer(imsa_a,jsolid,ibin) = 0.0
1767 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1768 aer(ina_a, jsolid,ibin) = 0.0
1769 aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
1770 electrolyte(jcaso4,jsolid,ibin)
1771 aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1772 aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
1773 aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
1774 aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
1775 aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
1776 aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
1777 aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
1778 aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
1779 aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
1780 aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
1781
1782 ! liquid-phase
1783 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
1784 electrolyte(jcaso4,jsolid,ibin)
1785 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1786 aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1787 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1788 aer(ioc_a, jliquid,ibin) = 0.0
1789 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1790 aer(ico3_a,jliquid,ibin) = 0.0
1791 aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1792 aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) + &
1793 electrolyte(jcacl2,jtotal,ibin)
1794 aer(ibc_a, jliquid,ibin) = 0.0
1795 aer(ioin_a,jliquid,ibin) = 0.0
1796 aer(iaro1_a,jliquid,ibin)= 0.0
1797 aer(iaro2_a,jliquid,ibin)= 0.0
1798 aer(ialk1_a,jliquid,ibin)= 0.0
1799 aer(iole1_a,jliquid,ibin)= 0.0
1800 aer(iapi1_a,jliquid,ibin)= 0.0
1801 aer(iapi2_a,jliquid,ibin)= 0.0
1802 aer(ilim1_a,jliquid,ibin)= 0.0
1803 aer(ilim2_a,jliquid,ibin)= 0.0
1804
1805 return
1806 end subroutine do_full_deliquescence
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829 !***********************************************************************
1830 ! mesa: multicomponent equilibrium solver for aerosol-phase
1831 ! computes equilibrum solid and liquid phases by integrating
1832 ! pseudo-transient dissolution and precipitation reactions
1833 !
1834 ! author: rahul a. zaveri
1835 ! update: jan 2005
1836 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
1837 !-----------------------------------------------------------------------
1838 subroutine mesa_ptc(ibin) ! touch
1839 ! implicit none
1840 ! include 'mosaic.h'
1841 ! subr arguments
1842 integer ibin
1843 ! local variables
1844 integer iaer, iconverge, iconverge_flux, iconverge_mass, &
1845 idissolved, itdum, js, je, jp
1846 real(kind=8) tau_p(nsalt), tau_d(nsalt)
1847 real(kind=8) frac_solid, sumflux, hsalt_min, alpha, xt, dumdum, &
1848 h_ion
1849 real(kind=8) phi_prod, alpha_fac, sum_dum
1850 real(kind=8) aer_H
1851 ! function
1852 ! real(kind=8) aerosol_water
1853
1854
1855
1856 ! initialize
1857 itdum = 0 ! initialize time
1858 hsalt_max = 1.e25
1859
1860
1861
1862 do js = 1, nsalt
1863 hsalt(js) = 0.0
1864 sat_ratio(js) = 0.0
1865 phi_salt(js) = 0.0
1866 flux_sl(js) = 0.0
1867 enddo
1868
1869
1870 do js = 1, nsalt
1871 jsalt_present(js) = 0 ! default value - salt absent
1872 if(epercent(js,jtotal,ibin) .gt. 1.0)then
1873 jsalt_present(js) = 1 ! salt present
1874 endif
1875 enddo
1876
1877
1878 mass_dry_a(ibin) = 0.0
1879
1880 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
1881 aer(ino3_a,jtotal,ibin) + &
1882 aer(icl_a,jtotal,ibin) + &
1883 aer(imsa_a,jtotal,ibin) + &
1884 2.*aer(ico3_a,jtotal,ibin))- &
1885 (2.*aer(ica_a,jtotal,ibin) + &
1886 aer(ina_a,jtotal,ibin) + &
1887 aer(inh4_a,jtotal,ibin))
1888
1889 do iaer = 1, naer
1890 mass_dry_a(ibin) = mass_dry_a(ibin) + &
1891 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! [ng/m^3(air)]
1892 vol_dry_a(ibin) = vol_dry_a(ibin) + &
1893 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
1894 enddo
1895 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1896 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1897
1898 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! [g/cc(air)]
1899 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! [cc(aer)/cc(air)]
1900
1901 mass_dry_salt(ibin) = 0.0 ! soluble salts only
1902 do je = 1, nsalt
1903 mass_dry_salt(ibin) = mass_dry_salt(ibin) + &
1904 electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15 ! g/cc(air)
1905 enddo
1906
1907 ! call mesa_check_complete_dissolution(ibin, &
1908 ! mdissolved, &
1909 ! iconverge_flux)
1910 ! if (istat_mosaic_fe1 .lt. 0) return
1911 ! if(mdissolved .eq. myes .or. iconverge_flux .eq. myes)then
1912 ! return
1913 ! endif
1914
1915
1916 nmesa_call = nmesa_call + 1
1917
1918 !----begin pseudo time continuation loop-------------------------------
1919
1920 do 500 itdum = 1, nmax_mesa
1921
1922
1923 ! compute new salt fluxes
1924 call mesa_flux_salt(ibin)
1925 if (istat_mosaic_fe1 .lt. 0) return
1926
1927
1928 ! check convergence
1929 call mesa_convergence_criterion(ibin, &
1930 iconverge_mass, &
1931 iconverge_flux, &
1932 idissolved)
1933
1934 if(iconverge_mass .eq. myes)then
1935 iter_mesa(ibin) = iter_mesa(ibin) + itdum
1936 niter_mesa = niter_mesa + itdum
1937 niter_mesa_max = max(niter_mesa_max, itdum)
1938 jaerosolstate(ibin) = all_solid
1939 call adjust_solid_aerosol(ibin)
1940 jhyst_leg(ibin) = jhyst_lo
1941 growth_factor(ibin) = 1.0
1942 return
1943 elseif(iconverge_flux .eq. myes)then
1944 iter_mesa(ibin) = iter_mesa(ibin)+ itdum
1945 niter_mesa = niter_mesa + itdum
1946 niter_mesa_max = max(niter_mesa_max, itdum)
1947 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
1948 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
1949 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
1950
1951 if(idissolved .eq. myes)then
1952 jaerosolstate(ibin) = all_liquid
1953 ! jhyst_leg(ibin) = jhyst_up ! do this later (to avoid tripping kelvin iterations)
1954 else
1955 jaerosolstate(ibin) = mixed
1956 jhyst_leg(ibin) = jhyst_lo
1957 endif
1958
1959 ! calculate epercent(jsolid) composition in mixed-phase aerosol
1960 sum_dum = 0.0
1961 jp = jsolid
1962 do je = 1, nelectrolyte
1963 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
1964 sum_dum = sum_dum + electrolyte(je,jp,ibin)
1965 enddo
1966 electrolyte_sum(jp,ibin) = sum_dum
1967 if(sum_dum .eq. 0.)sum_dum = 1.0
1968 do je = 1, nelectrolyte
1969 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
1970 enddo
1971
1972 return
1973 endif
1974
1975
1976 ! calculate hsalt(js) ! time step
1977 hsalt_min = 1.e25
1978 do js = 1, nsalt
1979
1980 phi_prod = phi_salt(js) * phi_salt_old(js)
1981
1982 if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
1983 phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/ &
1984 alpha_salt(js)
1985 else
1986 phi_bar(js) = 0.0 ! oscillating, or phi_salt and/or phi_salt_old may be zero
1987 endif
1988
1989 if(phi_bar(js) .lt. 0.0)then ! good. phi getting lower. maybe able to take bigger alphas
1990 phi_bar(js) = max(phi_bar(js), -10.0D0)
1991 alpha_fac = 3.0*exp(phi_bar(js))
1992 alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9D0)
1993 elseif(phi_bar(js) .gt. 0.0)then ! bad - phi is getting bigger. so be conservative with alpha
1994 alpha_salt(js) = min(abs(phi_salt(js)), 0.5D0)
1995 else ! very bad - phi is oscillating. be very conservative
1996 alpha_salt(js) = min(abs(phi_salt(js))/3.0, 0.5D0)
1997 endif
1998
1999 ! alpha_salt(js) = max(alpha_salt(js), 0.01D0)
2000
2001 phi_salt_old(js) = phi_salt(js) ! update old array
2002
2003
2004 if(flux_sl(js) .gt. 0.)then
2005
2006 tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
2007 if(tau_p(js) .eq. 0.0)then
2008 hsalt(js) = 1.e25
2009 flux_sl(js) = 0.0
2010 phi_salt(js)= 0.0
2011 else
2012 hsalt(js) = alpha_salt(js)*tau_p(js)
2013 endif
2014
2015 elseif(flux_sl(js) .lt. 0.)then
2016
2017 tau_p(js) = -eleliquid(js)/flux_sl(js) ! precipitation time scale
2018 tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
2019 if(tau_p(js) .eq. 0.0)then
2020 hsalt(js) = alpha_salt(js)*tau_d(js)
2021 else
2022 hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
2023 endif
2024
2025 else
2026
2027 hsalt(js) = 1.e25
2028
2029 endif
2030
2031 hsalt_min = min(hsalt(js), hsalt_min)
2032
2033 enddo
2034
2035 !---------------------------------
2036
2037 ! integrate electrolyte(solid)
2038 do js = 1, nsalt
2039 electrolyte(js,jsolid,ibin) = &
2040 electrolyte(js,jsolid,ibin) + &
2041 hsalt(js) * flux_sl(js)
2042 enddo
2043
2044
2045 ! compute aer(solid) from electrolyte(solid)
2046 call electrolytes_to_ions(jsolid,ibin)
2047
2048
2049 ! compute new electrolyte(liquid) from mass balance
2050 do iaer = 1, naer
2051 aer(iaer,jliquid,ibin) = aer(iaer,jtotal,ibin) - &
2052 aer(iaer,jsolid,ibin)
2053 enddo
2054
2055 !---------------------------------
2056
2057
2058
2059 500 continue ! end time continuation loop
2060 !--------------------------------------------------------------------
2061 nmesa_fail = nmesa_fail + 1
2062 iter_mesa(ibin) = iter_mesa(ibin) + itdum
2063 niter_mesa = niter_mesa + itdum
2064 jaerosolstate(ibin) = mixed
2065 jhyst_leg(ibin) = jhyst_lo
2066 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2067 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2068 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2069
2070 return
2071 end subroutine mesa_ptc
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082 !***********************************************************************
2083 ! part of mesa: checks if particle is completely deliquesced at the
2084 ! current rh
2085 !
2086 ! author: rahul a. zaveri
2087 ! update: feb 2005
2088 !-----------------------------------------------------------------------
2089 subroutine mesa_check_complete_dissolution(ibin, &
2090 mdissolved, &
2091 iconverge_flux)
2092 ! implicit none
2093 ! include 'mosaic.h'
2094 ! subr arguments
2095 integer ibin, mdissolved, iconverge_flux, je, js, iaer
2096 ! local variables
2097 real(kind=8) sumflux, aer_sav(naer,3,nbin_a), &
2098 electrolyte_sav(nelectrolyte,3,nbin_a), crustal_solids
2099
2100
2101 ! save current solid-liquid arrays
2102 do je = 1, nelectrolyte
2103 electrolyte_sav(je,jsolid,ibin) =electrolyte(je,jsolid,ibin)
2104 electrolyte_sav(je,jliquid,ibin)=electrolyte(je,jliquid,ibin)
2105 enddo
2106
2107 do iaer = 1, naer
2108 aer_sav(iaer,jsolid,ibin) =aer(iaer,jsolid,ibin)
2109 aer_sav(iaer,jliquid,ibin)=aer(iaer,jliquid,ibin)
2110 enddo
2111
2112 call do_full_deliquescence(ibin)
2113
2114 do js = 1, nsalt
2115 sat_ratio(js) = 0.0
2116 phi_salt(js) = 0.0
2117 flux_sl(js) = 0.0
2118 enddo
2119
2120
2121 ! compute new salt fluxes
2122 call mesa_flux_salt(ibin)
2123 if (istat_mosaic_fe1 .lt. 0) return
2124
2125
2126 ! check if all the fluxes are zero
2127 sumflux = 0.0
2128 do js = 1, nsalt
2129 sumflux = sumflux + abs(flux_sl(js))
2130 enddo
2131
2132 crustal_solids = electrolyte(jcaco3,jsolid,ibin) + &
2133 electrolyte(jcaso4,jsolid,ibin) + &
2134 aer(ioin_a,jsolid,ibin)
2135 if(sumflux .eq. 0.0 .and. crustal_solids.eq.0.)then ! it is completely dissolved
2136
2137 jaerosolstate(ibin) = all_liquid
2138 jphase(ibin) = jliquid
2139 mdissolved = myes
2140 iconverge_flux = myes
2141
2142 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2143 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2144 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2145
2146 elseif(sumflux .eq. 0.0)then
2147
2148 jaerosolstate(ibin) = mixed
2149 jphase(ibin) = jliquid
2150 iconverge_flux = myes
2151 mdissolved = mno
2152 jhyst_leg(ibin) = jhyst_lo
2153 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
2154 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air) or m^3/m^3(air)
2155 growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin) ! mass growth factor
2156
2157 else ! restore saved solid-liquid arrays
2158
2159 do je = 1, nelectrolyte
2160 electrolyte(je,jsolid,ibin) =electrolyte_sav(je,jsolid,ibin)
2161 electrolyte(je,jliquid,ibin)=electrolyte_sav(je,jliquid,ibin)
2162 enddo
2163 do iaer = 1, naer
2164 aer(iaer,jsolid,ibin) =aer_sav(iaer,jsolid,ibin)
2165 aer(iaer,jliquid,ibin)=aer_sav(iaer,jliquid,ibin)
2166 enddo
2167 mdissolved = mno
2168 iconverge_flux = mno
2169
2170 endif
2171
2172
2173 return
2174 end subroutine mesa_check_complete_dissolution
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190 !***********************************************************************
2191 ! part of mesa: calculates solid-liquid fluxes of soluble salts
2192 !
2193 ! author: rahul a. zaveri
2194 ! update: jan 2005
2195 !-----------------------------------------------------------------------
2196 subroutine mesa_flux_salt(ibin) ! touch
2197 ! implicit none
2198 ! include 'mosaic.h'
2199 ! subr arguments
2200 integer ibin
2201 ! local variables
2202 integer js
2203 real(kind=8) xt, calcium, sum_salt
2204
2205
2206 ! compute activities and water content
2207 call ions_to_electrolytes(jliquid,ibin,xt)
2208 if (istat_mosaic_fe1 .lt. 0) return
2209 call compute_activities(ibin)
2210 activity(jna3hso4,ibin) = 0.0
2211
2212 if(water_a(ibin) .le. 0.0)then
2213 do js = 1, nsalt
2214 flux_sl(js) = 0.0
2215 enddo
2216 return
2217 endif
2218
2219
2220 call mesa_estimate_eleliquid(ibin,xt)
2221
2222 calcium = aer(ica_a,jliquid,ibin)
2223
2224
2225 ! calculate % electrolyte composition in the solid and liquid phases
2226 sum_salt = 0.0
2227 do js = 1, nsalt
2228 sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
2229 enddo
2230 electrolyte_sum(jsolid,ibin) = sum_salt
2231 if(sum_salt .eq. 0.0)sum_salt = 1.0
2232 do js = 1, nsalt
2233 frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
2234 frac_salt_liq(js) = epercent(js,jliquid,ibin)/100.
2235 enddo
2236
2237
2238
2239 ! compute salt fluxes
2240 do js = 1, nsalt ! soluble solid salts
2241
2242 ! compute new saturation ratio
2243 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2244 ! compute relative driving force
2245 phi_salt(js) = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0D0)
2246
2247 ! check if too little solid-phase salt is trying to dissolve
2248 if(sat_ratio(js) .lt. 1.00 .and. &
2249 frac_salt_solid(js) .lt. 0.01 .and. &
2250 frac_salt_solid(js) .gt. 0.0)then
2251 call mesa_dissolve_small_salt(ibin,js)
2252 call mesa_estimate_eleliquid(ibin,xt)
2253 sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2254 endif
2255
2256 ! compute flux
2257 flux_sl(js) = sat_ratio(js) - 1.0
2258
2259 ! apply heaviside function
2260 if( (sat_ratio(js) .lt. 1.0 .and. &
2261 electrolyte(js,jsolid,ibin) .eq. 0.0) .or. &
2262 (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or. &
2263 (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
2264 flux_sl(js) = 0.0
2265 phi_salt(js)= 0.0
2266 endif
2267
2268 enddo
2269
2270
2271 ! force cacl2 and cano3 fluxes to zero
2272 sat_ratio(jcano3) = 1.0
2273 phi_salt(jcano3) = 0.0
2274 flux_sl(jcano3) = 0.0
2275
2276 sat_ratio(jcacl2) = 1.0
2277 phi_salt(jcacl2) = 0.0
2278 flux_sl(jcacl2) = 0.0
2279
2280
2281 return
2282 end subroutine mesa_flux_salt
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295 !***********************************************************************
2296 ! part of mesa: calculates liquid electrolytes from ions
2297 !
2298 ! notes:
2299 ! - this subroutine is to be used for liquid-phase or total-phase only
2300 ! - this sub transfers caso4 and caco3 from liquid to solid phase
2301 !
2302 ! author: rahul a. zaveri
2303 ! update: jan 2005
2304 !-----------------------------------------------------------------------
2305 subroutine mesa_estimate_eleliquid(ibin,xt) ! touch
2306 ! implicit none
2307 ! include 'mosaic.h'
2308 ! subr arguments
2309 integer ibin, jp
2310 real(kind=8) xt
2311 ! local variables
2312 integer iaer, je, jc, ja, icase
2313 real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4, &
2314 f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d, &
2315 xdum, dum, cat_net
2316 real(kind=8) nc(ncation), na(nanion)
2317 real(kind=8) dum_ca, dum_no3, dum_cl, cano3, cacl2
2318
2319
2320
2321 ! remove negative concentrations, if any
2322 do iaer = 1, naer
2323 aer(iaer,jliquid,ibin) = max(0.0D0, aer(iaer,jliquid,ibin))
2324 enddo
2325
2326
2327 ! calculate sulfate ratio
2328 call calculate_xt(ibin,jliquid,xt)
2329
2330 if(xt .ge. 2.0 .or. xt.lt.0.)then
2331 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
2332 else
2333 icase = 2 ! acidic (acidity is caused by excess so4)
2334 endif
2335
2336
2337 ! initialize to zero
2338 do je = 1, nelectrolyte
2339 eleliquid(je) = 0.0
2340 enddo
2341 !
2342 !---------------------------------------------------------
2343 ! initialize moles of ions depending on the sulfate domain
2344
2345 jp = jliquid
2346
2347 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
2348
2349 dum_ca = aer(ica_a,jp,ibin)
2350 dum_no3 = aer(ino3_a,jp,ibin)
2351 dum_cl = aer(icl_a,jp,ibin)
2352
2353 cano3 = min(dum_ca, 0.5*dum_no3)
2354 dum_ca = max(0.D0, dum_ca - cano3)
2355 dum_no3 = max(0.D0, dum_no3 - 2.*cano3)
2356
2357 cacl2 = min(dum_ca, 0.5*dum_cl)
2358 dum_ca = max(0.D0, dum_ca - cacl2)
2359 dum_cl = max(0.D0, dum_cl - 2.*cacl2)
2360
2361 na(ja_hso4)= 0.0
2362 na(ja_so4) = aer(iso4_a,jp,ibin)
2363 na(ja_no3) = aer(ino3_a,jp,ibin)
2364 na(ja_cl) = aer(icl_a, jp,ibin)
2365 na(ja_msa) = aer(imsa_a,jp,ibin)
2366
2367 nc(jc_ca) = aer(ica_a, jp,ibin)
2368 nc(jc_na) = aer(ina_a, jp,ibin)
2369 nc(jc_nh4) = aer(inh4_a,jp,ibin)
2370
2371 cat_net = &
2372 ( 2.d0*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) ) - &
2373 ( nc(jc_h)+2.d0*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
2374
2375 if(cat_net .lt. 0.0)then
2376
2377 nc(jc_h) = 0.0
2378
2379 else ! cat_net must be 0.0 or positive
2380
2381 nc(jc_h) = cat_net
2382
2383 endif
2384
2385
2386 ! now compute equivalent fractions
2387 sum_naza = 0.0
2388 do ja = 1, nanion
2389 sum_naza = sum_naza + na(ja)*za(ja)
2390 enddo
2391
2392 sum_nczc = 0.0
2393 do jc = 1, ncation
2394 sum_nczc = sum_nczc + nc(jc)*zc(jc)
2395 enddo
2396
2397 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
2398 if (iprint_mosaic_diag1 .gt. 0) then
2399 write(6,*)'subroutine mesa_estimate_eleliquid'
2400 write(6,*)'ionic concentrations are zero'
2401 write(6,*)'sum_naza = ', sum_naza
2402 write(6,*)'sum_nczc = ', sum_nczc
2403 endif
2404 return
2405 endif
2406
2407 do ja = 1, nanion
2408 xeq_a(ja) = na(ja)*za(ja)/sum_naza
2409 enddo
2410
2411 do jc = 1, ncation
2412 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2413 enddo
2414
2415 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
2416 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
2417 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
2418 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
2419 na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
2420
2421 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
2422 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
2423 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
2424 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
2425
2426
2427 ! now compute electrolyte moles
2428 eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) + &
2429 xeq_a(ja_so4)*nc_mc(jc_na))/ &
2430 mw_electrolyte(jna2so4)
2431
2432 eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) + &
2433 xeq_a(ja_hso4)*nc_mc(jc_na))/ &
2434 mw_electrolyte(jnahso4)
2435
2436 eleliquid(jnamsa) = (xeq_c(jc_na) *na_ma(ja_msa) + &
2437 xeq_a(ja_msa)*nc_mc(jc_na))/ &
2438 mw_electrolyte(jnamsa)
2439
2440 eleliquid(jnano3) = (xeq_c(jc_na) *na_ma(ja_no3) + &
2441 xeq_a(ja_no3)*nc_mc(jc_na))/ &
2442 mw_electrolyte(jnano3)
2443
2444 eleliquid(jnacl) = (xeq_c(jc_na) *na_ma(ja_cl) + &
2445 xeq_a(ja_cl) *nc_mc(jc_na))/ &
2446 mw_electrolyte(jnacl)
2447
2448 eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
2449 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
2450 mw_electrolyte(jnh4so4)
2451
2452 eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) + &
2453 xeq_a(ja_hso4)*nc_mc(jc_nh4))/ &
2454 mw_electrolyte(jnh4hso4)
2455
2456 eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_ma(ja_msa) + &
2457 xeq_a(ja_msa)*nc_mc(jc_nh4))/ &
2458 mw_electrolyte(jnh4msa)
2459
2460 eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
2461 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
2462 mw_electrolyte(jnh4no3)
2463
2464 eleliquid(jnh4cl) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
2465 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
2466 mw_electrolyte(jnh4cl)
2467
2468 eleliquid(jcano3) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
2469 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
2470 mw_electrolyte(jcano3)
2471
2472 eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_ma(ja_msa) + &
2473 xeq_a(ja_msa)*nc_mc(jc_ca))/ &
2474 mw_electrolyte(jcamsa2)
2475
2476 eleliquid(jcacl2) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
2477 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
2478 mw_electrolyte(jcacl2)
2479
2480 eleliquid(jh2so4) = (xeq_c(jc_h) *na_ma(ja_hso4) + &
2481 xeq_a(ja_hso4)*nc_mc(jc_h))/ &
2482 mw_electrolyte(jh2so4)
2483
2484 eleliquid(jhno3) = (xeq_c(jc_h) *na_ma(ja_no3) + &
2485 xeq_a(ja_no3)*nc_mc(jc_h))/ &
2486 mw_electrolyte(jhno3)
2487
2488 eleliquid(jhcl) = (xeq_c(jc_h) *na_ma(ja_cl) + &
2489 xeq_a(ja_cl)*nc_mc(jc_h))/ &
2490 mw_electrolyte(jhcl)
2491
2492 eleliquid(jmsa) = (xeq_c(jc_h) *na_ma(ja_msa) + &
2493 xeq_a(ja_msa)*nc_mc(jc_h))/ &
2494 mw_electrolyte(jmsa)
2495
2496 !--------------------------------------------------------------------
2497
2498 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
2499
2500 jp = jliquid
2501
2502 store(iso4_a) = aer(iso4_a,jp,ibin)
2503 store(imsa_a) = aer(imsa_a,jp,ibin)
2504 store(inh4_a) = aer(inh4_a,jp,ibin)
2505 store(ina_a) = aer(ina_a, jp,ibin)
2506 store(ica_a) = aer(ica_a, jp,ibin)
2507
2508 call form_camsa2(store,jp,ibin)
2509
2510 sum_na_nh4 = store(ina_a) + store(inh4_a)
2511 if(sum_na_nh4 .gt. 0.0)then
2512 f_nh4 = store(inh4_a)/sum_na_nh4
2513 f_na = store(ina_a)/sum_na_nh4
2514 else
2515 f_nh4 = 0.0
2516 f_na = 0.0
2517 endif
2518
2519 ! first form msa electrolytes
2520 if(sum_na_nh4 .gt. store(imsa_a))then
2521 eleliquid(jnh4msa) = f_nh4*store(imsa_a)
2522 eleliquid(jnamsa) = f_na *store(imsa_a)
2523 store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
2524 store(ina_a) = store(ina_a) -eleliquid(jnamsa) ! remaining na
2525 else
2526 eleliquid(jnh4msa) = store(inh4_a)
2527 eleliquid(jnamsa) = store(ina_a)
2528 eleliquid(jmsa) = store(imsa_a) - sum_na_nh4
2529 store(inh4_a)= 0.0 ! remaining nh4
2530 store(ina_a) = 0.0 ! remaining na
2531 endif
2532
2533 if(store(iso4_a).eq.0.0)goto 10
2534
2535 xt_d = xt
2536 xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
2537 xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
2538
2539 dum = 2.d0*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin)
2540 if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
2541 xnh4_d = 2.*aer(inh4_a,jp,ibin)/ &
2542 (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
2543 else
2544 xnh4_d = 0.0
2545 endif
2546
2547
2548 if(aer(inh4_a,jp,ibin) .gt. 0.0)then
2549
2550
2551 if(xt_d .ge. xna_d)then
2552 eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
2553
2554 if(xnh4_d .ge. 5./3.)then
2555 eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin) &
2556 - 3.*xdum - aer(inh4_a,jp,ibin)
2557 eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin) &
2558 - aer(ina_a,jp,ibin)
2559 elseif(xnh4_d .ge. 1.5)then
2560 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
2561 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
2562 elseif(xnh4_d .ge. 1.0)then
2563 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2564 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2565 eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
2566 endif
2567
2568 elseif(xt_d .gt. 1.0)then
2569 eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2570 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2571 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
2572 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/3.
2573 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/3.
2574 elseif(xt_d .le. 1.0)then
2575 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2576 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2577 eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2578 eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
2579 endif
2580
2581 else
2582
2583 if(xt_d .gt. 1.0)then
2584 eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
2585 eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) - &
2586 aer(ina_a,jp,ibin)
2587 else
2588 eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2589 eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2590 endif
2591
2592
2593 endif
2594
2595
2596
2597 endif
2598 !---------------------------------------------------------
2599 !
2600 ! calculate % composition
2601 10 sum_dum = 0.0
2602 do je = 1, nelectrolyte
2603 sum_dum = sum_dum + eleliquid(je)
2604 enddo
2605
2606 electrolyte_sum(jp,ibin) = sum_dum
2607
2608 if(sum_dum .eq. 0.)sum_dum = 1.0
2609 do je = 1, nelectrolyte
2610 epercent(je,jp,ibin) = 100.*eleliquid(je)/sum_dum
2611 enddo
2612
2613
2614 return
2615 end subroutine mesa_estimate_eleliquid
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626 !***********************************************************************
2627 ! part of mesa: completely dissolves small amounts of soluble salts
2628 !
2629 ! author: rahul a. zaveri
2630 ! update: jan 2005
2631 !-----------------------------------------------------------------------
2632 subroutine mesa_dissolve_small_salt(ibin,js)
2633 ! implicit none
2634 ! include 'mosaic.h'
2635 ! subr arguments
2636 integer ibin, js, jp
2637
2638 jp = jsolid
2639
2640
2641 if(js .eq. jnh4so4)then
2642 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2643 2.*electrolyte(js,jsolid,ibin)
2644 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2645 electrolyte(js,jsolid,ibin)
2646
2647 electrolyte(js,jsolid,ibin) = 0.0
2648
2649 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2650 electrolyte(jnh4cl,jp,ibin) + &
2651 2.*electrolyte(jnh4so4,jp,ibin) + &
2652 3.*electrolyte(jlvcite,jp,ibin) + &
2653 electrolyte(jnh4hso4,jp,ibin)+ &
2654 electrolyte(jnh4msa,jp,ibin)
2655
2656 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2657 electrolyte(jna2so4,jp,ibin) + &
2658 2.*electrolyte(jna3hso4,jp,ibin)+ &
2659 electrolyte(jnahso4,jp,ibin) + &
2660 electrolyte(jnh4so4,jp,ibin) + &
2661 2.*electrolyte(jlvcite,jp,ibin) + &
2662 electrolyte(jnh4hso4,jp,ibin)+ &
2663 electrolyte(jh2so4,jp,ibin)
2664 return
2665 endif
2666
2667
2668 if(js .eq. jlvcite)then
2669 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2670 3.*electrolyte(js,jsolid,ibin)
2671 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2672 2.*electrolyte(js,jsolid,ibin)
2673
2674 electrolyte(js,jsolid,ibin) = 0.0
2675
2676 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2677 electrolyte(jnh4cl,jp,ibin) + &
2678 2.*electrolyte(jnh4so4,jp,ibin) + &
2679 3.*electrolyte(jlvcite,jp,ibin) + &
2680 electrolyte(jnh4hso4,jp,ibin)+ &
2681 electrolyte(jnh4msa,jp,ibin)
2682
2683 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2684 electrolyte(jna2so4,jp,ibin) + &
2685 2.*electrolyte(jna3hso4,jp,ibin)+ &
2686 electrolyte(jnahso4,jp,ibin) + &
2687 electrolyte(jnh4so4,jp,ibin) + &
2688 2.*electrolyte(jlvcite,jp,ibin) + &
2689 electrolyte(jnh4hso4,jp,ibin)+ &
2690 electrolyte(jh2so4,jp,ibin)
2691 return
2692 endif
2693
2694
2695 if(js .eq. jnh4hso4)then
2696 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2697 electrolyte(js,jsolid,ibin)
2698 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2699 electrolyte(js,jsolid,ibin)
2700
2701 electrolyte(js,jsolid,ibin) = 0.0
2702
2703 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2704 electrolyte(jnh4cl,jp,ibin) + &
2705 2.*electrolyte(jnh4so4,jp,ibin) + &
2706 3.*electrolyte(jlvcite,jp,ibin) + &
2707 electrolyte(jnh4hso4,jp,ibin)+ &
2708 electrolyte(jnh4msa,jp,ibin)
2709
2710 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2711 electrolyte(jna2so4,jp,ibin) + &
2712 2.*electrolyte(jna3hso4,jp,ibin)+ &
2713 electrolyte(jnahso4,jp,ibin) + &
2714 electrolyte(jnh4so4,jp,ibin) + &
2715 2.*electrolyte(jlvcite,jp,ibin) + &
2716 electrolyte(jnh4hso4,jp,ibin)+ &
2717 electrolyte(jh2so4,jp,ibin)
2718 return
2719 endif
2720
2721
2722 if(js .eq. jna2so4)then
2723 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2724 2.*electrolyte(js,jsolid,ibin)
2725 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2726 electrolyte(js,jsolid,ibin)
2727
2728 electrolyte(js,jsolid,ibin) = 0.0
2729
2730 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2731 electrolyte(jnacl,jp,ibin) + &
2732 2.*electrolyte(jna2so4,jp,ibin) + &
2733 3.*electrolyte(jna3hso4,jp,ibin)+ &
2734 electrolyte(jnahso4,jp,ibin) + &
2735 electrolyte(jnamsa,jp,ibin)
2736
2737 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2738 electrolyte(jna2so4,jp,ibin) + &
2739 2.*electrolyte(jna3hso4,jp,ibin)+ &
2740 electrolyte(jnahso4,jp,ibin) + &
2741 electrolyte(jnh4so4,jp,ibin) + &
2742 2.*electrolyte(jlvcite,jp,ibin) + &
2743 electrolyte(jnh4hso4,jp,ibin)+ &
2744 electrolyte(jh2so4,jp,ibin)
2745 return
2746 endif
2747
2748
2749 if(js .eq. jna3hso4)then
2750 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2751 3.*electrolyte(js,jsolid,ibin)
2752 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2753 2.*electrolyte(js,jsolid,ibin)
2754
2755 electrolyte(js,jsolid,ibin) = 0.0
2756
2757 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2758 electrolyte(jnacl,jp,ibin) + &
2759 2.*electrolyte(jna2so4,jp,ibin) + &
2760 3.*electrolyte(jna3hso4,jp,ibin)+ &
2761 electrolyte(jnahso4,jp,ibin) + &
2762 electrolyte(jnamsa,jp,ibin)
2763
2764 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2765 electrolyte(jna2so4,jp,ibin) + &
2766 2.*electrolyte(jna3hso4,jp,ibin)+ &
2767 electrolyte(jnahso4,jp,ibin) + &
2768 electrolyte(jnh4so4,jp,ibin) + &
2769 2.*electrolyte(jlvcite,jp,ibin) + &
2770 electrolyte(jnh4hso4,jp,ibin)+ &
2771 electrolyte(jh2so4,jp,ibin)
2772 return
2773 endif
2774
2775
2776 if(js .eq. jnahso4)then
2777 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2778 electrolyte(js,jsolid,ibin)
2779 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) + &
2780 electrolyte(js,jsolid,ibin)
2781
2782 electrolyte(js,jsolid,ibin) = 0.0
2783
2784 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2785 electrolyte(jnacl,jp,ibin) + &
2786 2.*electrolyte(jna2so4,jp,ibin) + &
2787 3.*electrolyte(jna3hso4,jp,ibin)+ &
2788 electrolyte(jnahso4,jp,ibin) + &
2789 electrolyte(jnamsa,jp,ibin)
2790
2791 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2792 electrolyte(jna2so4,jp,ibin) + &
2793 2.*electrolyte(jna3hso4,jp,ibin)+ &
2794 electrolyte(jnahso4,jp,ibin) + &
2795 electrolyte(jnh4so4,jp,ibin) + &
2796 2.*electrolyte(jlvcite,jp,ibin) + &
2797 electrolyte(jnh4hso4,jp,ibin)+ &
2798 electrolyte(jh2so4,jp,ibin)
2799 return
2800 endif
2801
2802
2803 if(js .eq. jnh4no3)then
2804 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2805 electrolyte(js,jsolid,ibin)
2806 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2807 electrolyte(js,jsolid,ibin)
2808
2809 electrolyte(js,jsolid,ibin) = 0.0
2810
2811 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2812 electrolyte(jnh4cl,jp,ibin) + &
2813 2.*electrolyte(jnh4so4,jp,ibin) + &
2814 3.*electrolyte(jlvcite,jp,ibin) + &
2815 electrolyte(jnh4hso4,jp,ibin)+ &
2816 electrolyte(jnh4msa,jp,ibin)
2817
2818 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2819 2.*electrolyte(jcano3,jp,ibin) + &
2820 electrolyte(jnh4no3,jp,ibin) + &
2821 electrolyte(jhno3,jp,ibin)
2822 return
2823 endif
2824
2825
2826 if(js .eq. jnh4cl)then
2827 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + &
2828 electrolyte(js,jsolid,ibin)
2829 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2830 electrolyte(js,jsolid,ibin)
2831
2832 electrolyte(js,jsolid,ibin) = 0.0
2833
2834 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
2835 electrolyte(jnh4cl,jp,ibin) + &
2836 2.*electrolyte(jnh4so4,jp,ibin) + &
2837 3.*electrolyte(jlvcite,jp,ibin) + &
2838 electrolyte(jnh4hso4,jp,ibin)+ &
2839 electrolyte(jnh4msa,jp,ibin)
2840
2841 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2842 2.*electrolyte(jcacl2,jp,ibin) + &
2843 electrolyte(jnh4cl,jp,ibin) + &
2844 electrolyte(jhcl,jp,ibin)
2845 return
2846 endif
2847
2848
2849 if(js .eq. jnano3)then
2850 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2851 electrolyte(js,jsolid,ibin)
2852 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2853 electrolyte(js,jsolid,ibin)
2854
2855 electrolyte(js,jsolid,ibin) = 0.0
2856
2857 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2858 electrolyte(jnacl,jp,ibin) + &
2859 2.*electrolyte(jna2so4,jp,ibin) + &
2860 3.*electrolyte(jna3hso4,jp,ibin)+ &
2861 electrolyte(jnahso4,jp,ibin) + &
2862 electrolyte(jnamsa,jp,ibin)
2863
2864 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2865 2.*electrolyte(jcano3,jp,ibin) + &
2866 electrolyte(jnh4no3,jp,ibin) + &
2867 electrolyte(jhno3,jp,ibin)
2868 return
2869 endif
2870
2871
2872 if(js .eq. jnacl)then
2873 aer(ina_a,jliquid,ibin) = aer(ina_a,jliquid,ibin) + &
2874 electrolyte(js,jsolid,ibin)
2875 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2876 electrolyte(js,jsolid,ibin)
2877
2878 electrolyte(js,jsolid,ibin) = 0.0
2879
2880 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2881 electrolyte(jnacl,jp,ibin) + &
2882 2.*electrolyte(jna2so4,jp,ibin) + &
2883 3.*electrolyte(jna3hso4,jp,ibin)+ &
2884 electrolyte(jnahso4,jp,ibin) + &
2885 electrolyte(jnamsa,jp,ibin)
2886
2887 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2888 2.*electrolyte(jcacl2,jp,ibin) + &
2889 electrolyte(jnh4cl,jp,ibin) + &
2890 electrolyte(jhcl,jp,ibin)
2891 return
2892 endif
2893
2894
2895 if(js .eq. jcano3)then
2896 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2897 electrolyte(js,jsolid,ibin)
2898 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + &
2899 2.*electrolyte(js,jsolid,ibin)
2900
2901 electrolyte(js,jsolid,ibin) = 0.0
2902
2903 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2904 electrolyte(jcano3,jp,ibin) + &
2905 electrolyte(jcacl2,jp,ibin) + &
2906 electrolyte(jcaco3,jp,ibin) + &
2907 electrolyte(jcamsa2,jp,ibin)
2908
2909 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
2910 2.*electrolyte(jcano3,jp,ibin) + &
2911 electrolyte(jnh4no3,jp,ibin) + &
2912 electrolyte(jhno3,jp,ibin)
2913 return
2914 endif
2915
2916
2917 if(js .eq. jcacl2)then
2918 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) + &
2919 electrolyte(js,jsolid,ibin)
2920 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + &
2921 2.*electrolyte(js,jsolid,ibin)
2922
2923 electrolyte(js,jsolid,ibin) = 0.0
2924
2925 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
2926 electrolyte(jcano3,jp,ibin) + &
2927 electrolyte(jcacl2,jp,ibin) + &
2928 electrolyte(jcaco3,jp,ibin) + &
2929 electrolyte(jcamsa2,jp,ibin)
2930
2931 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
2932 2.*electrolyte(jcacl2,jp,ibin) + &
2933 electrolyte(jnh4cl,jp,ibin) + &
2934 electrolyte(jhcl,jp,ibin)
2935 return
2936 endif
2937
2938
2939
2940 return
2941 end subroutine mesa_dissolve_small_salt
2942
2943
2944
2945
2946
2947
2948 !***********************************************************************
2949 ! part of mesa: checks mesa convergence
2950 !
2951 ! author: rahul a. zaveri
2952 ! update: jan 2005
2953 !-----------------------------------------------------------------------
2954 subroutine mesa_convergence_criterion(ibin, & ! touch
2955 iconverge_mass, &
2956 iconverge_flux, &
2957 idissolved)
2958 ! implicit none
2959 ! include 'mosaic.h'
2960 ! subr arguments
2961 integer ibin, iconverge_mass, iconverge_flux, idissolved
2962 ! local variables
2963 integer je, js, iaer
2964 real(kind=8) mass_solid, mass_solid_salt, frac_solid, xt, h_ion, &
2965 crustal_solids, sumflux
2966
2967
2968 idissolved = mno ! default = not completely dissolved
2969
2970 ! check mass convergence
2971 iconverge_mass = mno ! default value = no convergence
2972
2973 ! call electrolytes_to_ions(jsolid,ibin)
2974 ! mass_solid = 0.0
2975 ! do iaer = 1, naer
2976 ! mass_solid = mass_solid + &
2977 ! aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15 ! g/cc(air)
2978 ! enddo
2979
2980 mass_solid_salt = 0.0
2981 do je = 1, nsalt
2982 mass_solid_salt = mass_solid_salt + &
2983 electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15 ! g/cc(air)
2984 enddo
2985
2986
2987
2988 ! frac_solid = mass_solid/mass_dry_a(ibin)
2989
2990 frac_solid = mass_solid_salt/mass_dry_salt(ibin)
2991
2992 if(frac_solid .ge. 0.98)then
2993 iconverge_mass = myes
2994 return
2995 endif
2996
2997
2998
2999 ! check relative driving force convergence
3000 iconverge_flux = myes
3001 do js = 1, nsalt
3002 if(abs(phi_salt(js)).gt. rtol_mesa)then
3003 iconverge_flux = mno
3004 return
3005 endif
3006 enddo
3007
3008
3009
3010 ! check if all the fluxes are zero
3011
3012 sumflux = 0.0
3013 do js = 1, nsalt
3014 sumflux = sumflux + abs(flux_sl(js))
3015 enddo
3016
3017 crustal_solids = electrolyte(jcaco3,jsolid,ibin) + &
3018 electrolyte(jcaso4,jsolid,ibin) + &
3019 aer(ioin_a,jsolid,ibin)
3020
3021 if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
3022 idissolved = myes
3023 endif
3024
3025
3026
3027 return
3028 end subroutine mesa_convergence_criterion
3029
3030
3031
3032
3033
3034
3035
3036
3037 !***********************************************************************
3038 ! called when aerosol bin is completely solid.
3039 !
3040 ! author: rahul a. zaveri
3041 ! update: jan 2005
3042 !-----------------------------------------------------------------------
3043 subroutine adjust_solid_aerosol(ibin)
3044 ! implicit none
3045 ! include 'mosaic.h'
3046 ! subr arguments
3047 integer ibin
3048 ! local variables
3049 integer iaer, je
3050
3051
3052 jphase(ibin) = jsolid
3053 jhyst_leg(ibin) = jhyst_lo ! lower curve
3054 water_a(ibin) = 0.0
3055
3056 ! transfer aer(jtotal) to aer(jsolid)
3057 do iaer = 1, naer
3058 aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
3059 aer(iaer, jliquid,ibin) = 0.0
3060 enddo
3061
3062 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
3063 do je = 1, nelectrolyte
3064 electrolyte(je,jliquid,ibin) = 0.0
3065 epercent(je,jliquid,ibin) = 0.0
3066 electrolyte(je,jsolid,ibin) = electrolyte(je,jtotal,ibin)
3067 epercent(je,jsolid,ibin) = epercent(je,jtotal,ibin)
3068 enddo
3069
3070 ! update aer(jtotal) that may have been affected above
3071 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
3072 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
3073 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin)
3074
3075 ! update electrolyte(jtotal)
3076 do je = 1, nelectrolyte
3077 electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
3078 epercent(je,jtotal,ibin) = epercent(je,jsolid,ibin)
3079 enddo
3080
3081 return
3082 end subroutine adjust_solid_aerosol
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092 !***********************************************************************
3093 ! called when aerosol bin is completely liquid.
3094 !
3095 ! author: rahul a. zaveri
3096 ! update: jan 2005
3097 !-----------------------------------------------------------------------
3098 subroutine adjust_liquid_aerosol(ibin)
3099 ! implicit none
3100 ! include 'mosaic.h'
3101 ! subr arguments
3102 integer ibin
3103 ! local variables
3104 integer je
3105
3106
3107
3108
3109 jphase(ibin) = jliquid
3110 jhyst_leg(ibin) = jhyst_up ! upper curve
3111
3112 ! partition all electrolytes into liquid phase
3113 do je = 1, nelectrolyte
3114 electrolyte(je,jsolid,ibin) = 0.0
3115 epercent(je,jsolid,ibin) = 0.0
3116 electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
3117 epercent(je,jliquid,ibin) = epercent(je,jtotal,ibin)
3118 enddo
3119 ! except these electrolytes, which always remain in the solid phase
3120 electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
3121 electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
3122 epercent(jcaco3,jsolid,ibin) = epercent(jcaco3,jtotal,ibin)
3123 epercent(jcaso4,jsolid,ibin) = epercent(jcaso4,jtotal,ibin)
3124 electrolyte(jcaco3,jliquid,ibin)= 0.0
3125 electrolyte(jcaso4,jliquid,ibin)= 0.0
3126 epercent(jcaco3,jliquid,ibin) = 0.0
3127 epercent(jcaso4,jliquid,ibin) = 0.0
3128
3129
3130 ! partition all the aer species into
3131 ! solid phase
3132 aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
3133 aer(ino3_a,jsolid,ibin) = 0.0
3134 aer(icl_a,jsolid,ibin) = 0.0
3135 aer(inh4_a,jsolid,ibin) = 0.0
3136 aer(ioc_a,jsolid,ibin) = aer(ioc_a,jtotal,ibin)
3137 aer(imsa_a,jsolid,ibin) = 0.0
3138 aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
3139 aer(ina_a,jsolid,ibin) = 0.0
3140 aer(ica_a,jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) + &
3141 electrolyte(jcaso4,jsolid,ibin)
3142 aer(ibc_a,jsolid,ibin) = aer(ibc_a,jtotal,ibin)
3143 aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
3144 aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
3145 aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
3146 aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
3147 aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
3148 aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
3149 aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
3150 aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
3151 aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
3152
3153 ! liquid-phase
3154 aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
3155 aer(iso4_a,jsolid,ibin)
3156 aer(iso4_a,jliquid,ibin) = max(0.D0, aer(iso4_a,jliquid,ibin))
3157 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
3158 aer(icl_a,jliquid,ibin) = aer(icl_a,jtotal,ibin)
3159 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
3160 aer(ioc_a,jliquid,ibin) = 0.0
3161 aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
3162 aer(ico3_a,jliquid,ibin) = 0.0
3163 aer(ina_a,jliquid,ibin) = aer(ina_a,jtotal,ibin)
3164 aer(ica_a,jliquid,ibin) = aer(ica_a,jtotal,ibin) - &
3165 aer(ica_a,jsolid,ibin)
3166 aer(ica_a,jliquid,ibin) = max(0.D0, aer(ica_a,jliquid,ibin))
3167 aer(ibc_a,jliquid,ibin) = 0.0
3168 aer(ioin_a,jliquid,ibin) = 0.0
3169 aer(iaro1_a,jliquid,ibin)= 0.0
3170 aer(iaro2_a,jliquid,ibin)= 0.0
3171 aer(ialk1_a,jliquid,ibin)= 0.0
3172 aer(iole1_a,jliquid,ibin)= 0.0
3173 aer(iapi1_a,jliquid,ibin)= 0.0
3174 aer(iapi2_a,jliquid,ibin)= 0.0
3175 aer(ilim1_a,jliquid,ibin)= 0.0
3176 aer(ilim2_a,jliquid,ibin)= 0.0
3177
3178 return
3179 end subroutine adjust_liquid_aerosol
3180
3181
3182
3183
3184
3185
3186
3187 ! end of mesa package
3188 !=======================================================================
3189
3190
3191
3192
3193
3194
3195
3196
3197 !***********************************************************************
3198 ! ASTEM: Adaptive Step Time-Split Euler Method
3199 !
3200 ! author: Rahul A. Zaveri
3201 ! update: jan 2007
3202 !-----------------------------------------------------------------------
3203 subroutine ASTEM(dtchem)
3204 ! implicit none
3205 ! include 'chemistry.com'
3206 ! include 'mosaic.h'
3207 ! subr arguments
3208 real(kind=8) dtchem
3209 ! local variables
3210 integer ibin
3211 real(kind=8) dumdum
3212
3213 ! logical first
3214 ! save first
3215 ! data first/.true./
3216
3217 integer, save :: iclm_debug, jclm_debug, kclm_debug, ncnt_debug
3218 data iclm_debug /25/
3219 data jclm_debug /1/
3220 data kclm_debug /9/
3221 data ncnt_debug /2/
3222
3223
3224
3225 if(iclm_aer .eq. iclm_debug .and. &
3226 jclm_aer .eq. jclm_debug .and. &
3227 kclm_aer .eq. kclm_debug .and. &
3228 ncorecnt_aer .eq. ncnt_debug)then
3229 dumdum = 0.0
3230 endif
3231
3232
3233
3234 ! update ASTEM call counter
3235 nASTEM_call = nASTEM_call + 1
3236
3237 ! reset input print flag
3238 iprint_input = mYES
3239
3240
3241
3242
3243 ! compute aerosol phase state before starting integration
3244 do ibin = 1, nbin_a
3245 if(jaerosolstate(ibin) .ne. no_aerosol)then
3246 call aerosol_phase_state(ibin)
3247 if (istat_mosaic_fe1 .lt. 0) return
3248 call calc_dry_n_wet_aerosol_props(ibin)
3249 endif
3250 enddo
3251
3252
3253 ! if(first)then
3254 ! first=.false.
3255 ! call print_aer(0) ! BOX
3256 ! endif
3257
3258
3259 ! compute new gas-aerosol mass transfer coefficients
3260 call aerosolmtc
3261 if (istat_mosaic_fe1 .lt. 0) return
3262
3263 ! condense h2so4, msa, and nh3 only
3264 call ASTEM_non_volatiles(dtchem) ! analytical solution
3265 if (istat_mosaic_fe1 .lt. 0) return
3266
3267 ! condense inorganic semi-volatile gases hno3, hcl, nh3, and co2
3268 call ASTEM_semi_volatiles(dtchem) ! semi-implicit + explicit euler
3269 if (istat_mosaic_fe1 .lt. 0) return
3270
3271 ! condense secondary organic gases (8 sorgam species)
3272 ! call ASTEM_secondary_organics(dtchem) ! semi-implicit euler
3273 ! if (istat_mosaic_fe1 .lt. 0) return
3274
3275
3276 ! template for error status checking
3277 ! if (iprint_mosaic_fe1 .gt. 0) then
3278 ! write(6,*)'error in computing dtmax for soa'
3279 ! write(6,*)'mosaic fatal error in astem_soa_dtmax'
3280 ! endif
3281 ! stop
3282 ! istat_mosaic_fe1 = -1800
3283 ! return
3284 ! endif
3285
3286
3287
3288 return
3289 end subroutine astem
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299 subroutine print_mosaic_stats( iflag1 )
3300 ! implicit none
3301 ! include 'mosaic.h'
3302 ! subr arguments
3303 integer iflag1
3304 ! local variables
3305 integer ibin
3306 real(kind=8) p_mesa_fails, p_astem_fails, dumcnt
3307
3308
3309 if (iflag1 .le. 0) goto 2000
3310
3311 ! print mesa and astem statistics
3312
3313 dumcnt = float(max(nmesa_call,1))
3314 p_mesa_fails = 100.*float(nmesa_fail)/dumcnt
3315 niter_mesa_avg = float(niter_mesa)/dumcnt
3316
3317 dumcnt = float(max(nastem_call,1))
3318 p_astem_fails = 100.*float(nastem_fail)/dumcnt
3319 nsteps_astem_avg = float(nsteps_astem)/dumcnt
3320
3321
3322 if (iprint_mosaic_perform_stats .gt. 0) then
3323 write(6,*)'------------------------------------------------'
3324 write(6,*)' astem performance statistics'
3325 write(6,*)'number of astem calls=', nastem_call
3326 write(6,*)'percent astem fails =', nastem_fail
3327 write(6,*)'avg steps per dtchem =', nsteps_astem_avg
3328 write(6,*)'max steps per dtchem =', nsteps_astem_max
3329 write(6,*)' '
3330 write(6,*)' mesa performance statistics'
3331 write(6,*)'number of mesa calls =', nmesa_call
3332 write(6,*)'total mesa fails =', nmesa_fail
3333 write(6,*)'percent mesa fails =', p_mesa_fails
3334 write(6,*)'avg iterations/call =', niter_mesa_avg
3335 write(6,*)'max iterations/call =', niter_mesa_max
3336 write(6,*)' '
3337 endif
3338
3339 if (iprint_mosaic_fe1 .gt. 0) then
3340 if ((nfe1_mosaic_cur .gt. 0) .or. &
3341 (iprint_mosaic_fe1 .ge. 100)) then
3342 write(6,*)'-----------------------------------------'
3343 write(6,*)'mosaic failure count (current step) =', &
3344 nfe1_mosaic_cur
3345 write(6,*)'mosaic failure count (all step tot) =', &
3346 nfe1_mosaic_tot
3347 write(6,*)' '
3348 endif
3349 endif
3350
3351 if (nfe1_mosaic_tot .gt. 9999) then
3352 write(6,'(a)') "MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!"
3353 call peg_error_fatal( lunerr_aer, &
3354 "---> MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!" )
3355 endif
3356
3357 2000 continue
3358
3359 ! reset counters
3360 nfe1_mosaic_cur = 0
3361
3362 nmesa_call = 0
3363 nmesa_fail = 0
3364 niter_mesa = 0.0
3365 niter_mesa_max = 0
3366
3367 nastem_call = 0
3368 nastem_fail = 0
3369
3370 nsteps_astem = 0.0
3371 nsteps_astem_max = 0.0
3372
3373
3374 return
3375 end subroutine print_mosaic_stats
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392 !***********************************************************************
3393 ! part of ASTEM: integrates semi-volatile inorganic gases
3394 !
3395 ! author: Rahul A. Zaveri
3396 ! update: jan 2007
3397 !-----------------------------------------------------------------------
3398 subroutine ASTEM_semi_volatiles(dtchem)
3399 ! implicit none
3400 ! include 'chemistry.com'
3401 ! include 'mosaic.h'
3402 ! subr arguments
3403 real(kind=8) dtchem
3404 ! local variables
3405 integer ibin, iv, jp
3406 real(kind=8) dtmax, t_new, t_old, t_out, xt
3407 real(kind=8) sum1, sum2, sum3, sum4, sum4a, sum4b, h_flux_s
3408
3409
3410 ! initialize time
3411 t_old = 0.0
3412 t_out = dtchem
3413
3414 ! reset ASTEM time steps and MESA iterations counters to zero
3415 isteps_ASTEM = 0
3416 do ibin = 1, nbin_a
3417 iter_MESA(ibin) = 0
3418 enddo
3419
3420 !--------------------------------
3421 ! overall integration loop begins over dtchem seconds
3422
3423 10 isteps_ASTEM = isteps_ASTEM + 1
3424
3425 ! compute new fluxes
3426 phi_nh4no3_s = 0.0
3427 phi_nh4cl_s = 0.0
3428 ieqblm_ASTEM = mYES ! reset to default
3429
3430 do 501 ibin = 1, nbin_a
3431
3432 idry_case3a(ibin) = mNO ! reset to default
3433 ! default fluxes and other stuff
3434 do iv = 1, ngas_ioa
3435 sfc_a(iv) = gas(iv)
3436 df_gas_s(iv,ibin) = 0.0
3437 df_gas_l(iv,ibin) = 0.0
3438 flux_s(iv,ibin) = 0.0
3439 flux_l(iv,ibin) = 0.0
3440 Heff(iv,ibin) = 0.0
3441 volatile_s(iv,ibin) = 0.0
3442 phi_volatile_s(iv,ibin) = 0.0
3443 phi_volatile_l(iv,ibin) = 0.0
3444 integrate(iv,jsolid,ibin) = mNO ! reset to default
3445 integrate(iv,jliquid,ibin) = mNO ! reset to default
3446 enddo
3447
3448
3449 if(jaerosolstate(ibin) .eq. all_solid)then
3450 jphase(ibin) = jsolid
3451 call ASTEM_flux_dry(ibin)
3452 elseif(jaerosolstate(ibin) .eq. all_liquid)then
3453 jphase(ibin) = jliquid
3454 call ASTEM_flux_wet(ibin)
3455 elseif(jaerosolstate(ibin) .eq. mixed)then
3456
3457 if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3458 electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3459 call ASTEM_flux_mix(ibin) ! jphase(ibin) will be determined in this subr.
3460 else
3461 jphase(ibin) = jliquid
3462 call ASTEM_flux_wet(ibin)
3463 endif
3464
3465 endif
3466
3467 501 continue
3468
3469 if(ieqblm_ASTEM .eq. mYES)goto 30 ! all bins have reached eqblm, so quit.
3470
3471 !-------------------------
3472
3473
3474 ! calculate maximum possible internal time-step
3475 11 call ASTEM_calculate_dtmax(dtchem, dtmax)
3476 t_new = t_old + dtmax ! update time
3477 if(t_new .gt. t_out)then ! check if the new time step is too large
3478 dtmax = t_out - t_old
3479 t_new = t_out*1.01
3480 endif
3481
3482
3483 !------------------------------------------
3484 ! do internal time-step (dtmax) integration
3485
3486 do 20 iv = 2, 4
3487
3488 sum1 = 0.0
3489 sum2 = 0.0
3490 sum3 = 0.0
3491 sum4 = 0.0
3492 sum4a= 0.0
3493 sum4b= 0.0
3494
3495 do 21 ibin = 1, nbin_a
3496 if(jaerosolstate(ibin) .eq. no_aerosol)goto 21
3497
3498 jp = jliquid
3499 sum1 = sum1 + aer(iv,jp,ibin)/ &
3500 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3501
3502 sum2 = sum2 + kg(iv,ibin)*integrate(iv,jp,ibin)/ &
3503 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3504
3505 jp = jsolid
3506 sum3 = sum3 + aer(iv,jp,ibin)
3507
3508 if(flux_s(iv,ibin) .gt. 0.)then
3509 h_flux_s = dtmax*flux_s(iv,ibin)
3510 sum4a = sum4a + h_flux_s
3511 aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3512 elseif(flux_s(iv,ibin) .lt. 0.)then
3513 h_flux_s = min(h_s_i_m(iv,ibin),dtmax)*flux_s(iv,ibin)
3514 sum4b = sum4b + h_flux_s
3515 aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3516 aer(iv,jp,ibin) = max(aer(iv,jp,ibin), 0.0D0)
3517 endif
3518
3519 21 continue
3520
3521 sum4 = sum4a + sum4b
3522
3523
3524 ! first update gas concentration
3525 gas(iv) = (total_species(iv) - (sum1 + sum3 + sum4) )/ &
3526 (1. + dtmax*sum2)
3527 gas(iv) = max(gas(iv), 0.0D0)
3528
3529 ! if(gas(iv) .lt. 0.)write(6,*) gas(iv)
3530
3531 ! now update aer concentration in the liquid phase
3532 do 22 ibin = 1, nbin_a
3533
3534 if(integrate(iv,jliquid,ibin) .eq. mYES)then
3535 aer(iv,jliquid,ibin) = &
3536 (aer(iv,jliquid,ibin) + dtmax*kg(iv,ibin)*gas(iv))/ &
3537 (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin))
3538
3539 endif
3540
3541 22 continue
3542
3543
3544 20 continue
3545 !------------------------------------------
3546 ! sub-step integration done
3547
3548
3549 !------------------------------------------
3550 ! now update aer(jtotal) and update internal phase equilibrium
3551 ! also do integration of species by mass balance if necessary
3552
3553 do 40 ibin = 1, nbin_a
3554 if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
3555
3556 if(jphase(ibin) .eq. jsolid)then
3557 call form_electrolytes(jsolid,ibin,XT) ! degas excess nh3 (if present)
3558 elseif(jphase(ibin) .eq. jliquid)then
3559 call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3560 elseif(jphase(ibin) .eq. jtotal)then
3561 call form_electrolytes(jsolid,ibin,XT) ! degas excess nh3 (if present)
3562 call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3563 endif
3564
3565 !========================
3566 ! now update jtotal
3567 do iv = 2, ngas_ioa
3568 aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
3569 enddo
3570 !========================
3571
3572
3573 call form_electrolytes(jtotal,ibin,XT) ! for MDRH diagnosis
3574
3575
3576
3577 ! update internal phase equilibrium
3578 if(jhyst_leg(ibin) .eq. jhyst_lo)then
3579 call ASTEM_update_phase_eqblm(ibin)
3580 else
3581 call do_full_deliquescence(ibin) ! simply do liquid <-- total
3582 endif
3583
3584
3585 40 continue
3586 !------------------------------------------
3587
3588 ! update time
3589 t_old = t_new
3590
3591
3592 if(isteps_astem .ge. nmax_astem)then
3593 nastem_fail = nastem_fail + 1
3594 write(6,*)'ASTEM internal steps exceeded', nmax_astem
3595 if(iprint_input .eq. mYES)then
3596 write(67,*)'ASTEM internal steps exceeded', nmax_astem
3597 call print_input
3598 iprint_input = mNO
3599 endif
3600 goto 30
3601 elseif(t_new .lt. t_out)then
3602 goto 10
3603 endif
3604
3605
3606 ! check if end of dtchem reached
3607 if(t_new .lt. 0.9999*t_out) goto 10
3608
3609 30 nsteps_astem = nsteps_astem + isteps_astem ! cumulative steps
3610 nsteps_astem_max = max(nsteps_astem_max, isteps_astem) ! max steps in a dtchem time-step
3611
3612 !================================================
3613 ! end of overall integration loop over dtchem seconds
3614
3615
3616
3617 ! call subs to calculate fluxes over mixed-phase particles to update H+ ions,
3618 ! which were wiped off during update_phase_eqblm
3619 ! do ibin = 1, nbin_a
3620 !
3621 ! if(jaerosolstate(ibin) .eq. mixed)then
3622 ! if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3623 ! electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3624 ! call ASTEM_flux_mix(ibin) ! jphase(ibin) will be determined in this subr.
3625 ! else
3626 ! jphase(ibin) = jliquid
3627 ! call ASTEM_flux_wet(ibin)
3628 ! endif
3629 ! endif
3630 !
3631 ! enddo
3632
3633
3634
3635 return
3636 end subroutine ASTEM_semi_volatiles
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649 !***********************************************************************
3650 ! part of ASTEM: computes max time step for gas-aerosol integration
3651 !
3652 ! author: Rahul A. Zaveri
3653 ! update: jan 2005
3654 !-----------------------------------------------------------------------
3655 subroutine ASTEM_calculate_dtmax(dtchem, dtmax)
3656 ! implicit none
3657 ! include 'mosaic.h'
3658 ! subr arguments
3659 real(kind=8) dtchem, dtmax
3660 ! local variables
3661 integer ibin, iv
3662 real(kind=8) alpha, h_gas, h_sub_max, &
3663 h_gas_i(ngas_ioa), h_gas_l, h_gas_s, &
3664 sum_kg_phi, sumflux_s
3665
3666
3667 h_sub_max = 100.0 ! sec raz-30apr07
3668
3669
3670 ! gas-side
3671
3672 ! solid-phase
3673 ! calculate h_gas_i and h_gas_l
3674
3675 h_gas_s = 2.e16
3676
3677 do 5 iv = 2, ngas_ioa
3678 h_gas_i(iv) = 1.e16
3679 sumflux_s = 0.0
3680 do ibin = 1, nbin_a
3681 if(flux_s(iv,ibin) .gt. 0.0)then
3682 sumflux_s = sumflux_s + flux_s(iv,ibin)
3683 endif
3684 enddo
3685
3686 if(sumflux_s .gt. 0.0)then
3687 h_gas_i(iv) = 0.1*gas(iv)/sumflux_s ! raz-30apr07
3688 h_gas_s = min(h_gas_s, h_gas_i(iv))
3689 endif
3690
3691 5 continue
3692
3693
3694 ! liquid-phase
3695 ! calculate h_gas_s and h_gas_l
3696
3697 h_gas_l = 2.e16
3698
3699 do 6 iv = 2, ngas_ioa
3700 h_gas_i(iv) = 1.e16
3701 sum_kg_phi = 0.0
3702 do ibin = 1, nbin_a
3703 if(integrate(iv,jliquid,ibin) .eq. mYES)then
3704 sum_kg_phi = sum_kg_phi + &
3705 abs(phi_volatile_l(iv,ibin))*kg(iv,ibin)
3706 endif
3707 enddo
3708
3709 if(sum_kg_phi .gt. 0.0)then
3710 h_gas_i(iv) = alpha_astem/sum_kg_phi
3711 h_gas_l = min(h_gas_l, h_gas_i(iv))
3712 endif
3713
3714 6 continue
3715
3716 h_gas = min(h_gas_s, h_gas_l)
3717 h_gas = min(h_gas, h_sub_max)
3718
3719
3720
3721
3722 ! aerosol-side: solid-phase
3723
3724 ! first load volatile_solid array
3725 do ibin = 1, nbin_a
3726
3727 volatile_s(ino3_a,ibin) = electrolyte(jnh4no3,jsolid,ibin)
3728 volatile_s(inh4_a,ibin) = electrolyte(jnh4cl,jsolid,ibin) + &
3729 electrolyte(jnh4no3,jsolid,ibin)
3730
3731 if(idry_case3a(ibin) .eq. mYES)then
3732 volatile_s(icl_a,ibin) = aer(icl_a,jsolid,ibin)
3733 else
3734 volatile_s(icl_a,ibin) = electrolyte(jnh4cl,jsolid,ibin)
3735 endif
3736
3737 enddo
3738
3739
3740 ! next calculate weighted avg_df_gas_s
3741 do iv = 2, ngas_ioa
3742
3743 sum_bin_s(iv) = 0.0
3744 sum_vdf_s(iv) = 0.0
3745 sum_vol_s(iv) = 0.0
3746
3747 do ibin = 1, nbin_a
3748 if(flux_s(iv,ibin) .lt. 0.)then ! aer -> gas
3749 sum_bin_s(iv) = sum_bin_s(iv) + 1.0
3750 sum_vdf_s(iv) = sum_vdf_s(iv) + &
3751 volatile_s(iv,ibin)*df_gas_s(iv,ibin)
3752 sum_vol_s(iv) = sum_vol_s(iv) + volatile_s(iv,ibin)
3753 endif
3754 enddo
3755
3756 if(sum_vol_s(iv) .gt. 0.0)then
3757 avg_df_gas_s(iv) = sum_vdf_s(iv)/sum_vol_s(iv)
3758 else
3759 avg_df_gas_s(iv) = 1.0 ! never used, but set to 1.0 just to be safe
3760 endif
3761
3762 enddo
3763
3764
3765 ! calculate h_s_i_m
3766
3767
3768 do 20 ibin = 1, nbin_a
3769
3770 if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
3771
3772 do 10 iv = 2, ngas_ioa
3773
3774 if(flux_s(iv,ibin) .lt. 0.)then ! aer -> gas
3775
3776 alpha = abs(avg_df_gas_s(iv))/ &
3777 (volatile_s(iv,ibin)*sum_bin_s(iv))
3778 alpha = min(alpha, 1.0D0)
3779
3780 if(idry_case3a(ibin) .eq. mYES)alpha = 1.0D0
3781
3782 h_s_i_m(iv,ibin) = &
3783 -alpha*volatile_s(iv,ibin)/flux_s(iv,ibin)
3784
3785 endif
3786
3787 10 continue
3788
3789
3790 20 continue
3791
3792
3793 dtmax = min(dtchem, h_gas)
3794
3795
3796 if(dtmax .eq. 0.0)then
3797 write(6,*)' dtmax = ', dtmax
3798 write(67,*)' dtmax = ', dtmax
3799 call print_input
3800 iprint_input = mNO
3801 stop
3802 endif
3803
3804 return
3805 end subroutine astem_calculate_dtmax
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821 !***********************************************************************
3822 ! part of ASTEM: updates solid-liquid partitioning after each gas-aerosol
3823 ! mass transfer step
3824 !
3825 ! author: Rahul A. Zaveri
3826 ! update: jan 2005
3827 !-----------------------------------------------------------------------
3828 subroutine ASTEM_update_phase_eqblm(ibin) ! TOUCH
3829 ! implicit none
3830 ! include 'mosaic.h'
3831 ! subr arguments
3832 integer ibin
3833 ! local variables
3834 integer jdum, js, j_index
3835 real(kind=8) XT
3836
3837
3838
3839 ! calculate overall sulfate ratio
3840 call calculate_XT(ibin,jtotal,XT) ! calc updated XT
3841
3842 ! now diagnose MDRH
3843 if(XT .lt. 1. .and. XT .gt. 0. )goto 10 ! excess sulfate domain - no MDRH exists
3844
3845 jdum = 0
3846 do js = 1, nsalt
3847 jsalt_present(js) = 0 ! default value - salt absent
3848
3849 if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
3850 jsalt_present(js) = 1 ! salt present
3851 jdum = jdum + jsalt_index(js)
3852 endif
3853 enddo
3854
3855 if(jdum .eq. 0)then
3856 jaerosolstate(ibin) = all_solid ! no significant soluble material present
3857 jphase(ibin) = jsolid
3858 call adjust_solid_aerosol(ibin)
3859 return
3860 endif
3861
3862 if(XT .ge. 2.0 .or. XT .lt. 0.0)then
3863 j_index = jsulf_poor(jdum)
3864 else
3865 j_index = jsulf_rich(jdum)
3866 endif
3867
3868 MDRH(ibin) = MDRH_T(j_index)
3869
3870 if(aH2O*100. .lt. MDRH(ibin)) then
3871 jaerosolstate(ibin) = all_solid
3872 jphase(ibin) = jsolid
3873 call adjust_solid_aerosol(ibin)
3874 return
3875 endif
3876
3877
3878 ! none of the above means it must be sub-saturated or mixed-phase
3879 10 if(jphase(ibin) .eq. jsolid)then
3880 call do_full_deliquescence(ibin)
3881 call MESA_PTC(ibin)
3882 else
3883 call MESA_PTC(ibin)
3884 endif
3885
3886
3887
3888 return
3889 end subroutine ASTEM_update_phase_eqblm
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902 !==================================================================
3903 !
3904 ! LIQUID PARTICLES
3905 !
3906 !***********************************************************************
3907 ! part of ASTEM: computes fluxes over wet aerosols
3908 !
3909 ! author: Rahul A. Zaveri
3910 ! update: Jan 2007
3911 !-----------------------------------------------------------------------
3912 subroutine ASTEM_flux_wet(ibin)
3913 ! implicit none
3914 ! include 'mosaic.h'
3915 ! subr arguments
3916 integer ibin
3917 ! local variables
3918 integer iv, iadjust, iadjust_intermed
3919 real(kind=8) xt, g_nh3_hno3, g_nh3_hcl, a_nh4_no3, a_nh4_cl
3920
3921
3922
3923 call ions_to_electrolytes(jliquid,ibin,XT) ! for water content calculation
3924 call compute_activities(ibin)
3925
3926 if(water_a(ibin) .eq. 0.0)then
3927 write(6,*)'Water is zero in liquid phase'
3928 write(6,*)'Stopping in ASTEM_flux_wet'
3929 stop
3930 endif
3931
3932 !-------------------------------------------------------------------
3933 ! CASE 1: caco3 > 0 absorb acids (and indirectly degas co2)
3934
3935 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
3936 call ASTEM_flux_wet_case1(ibin)
3937 return
3938 endif
3939
3940 !-------------------------------------------------------------------
3941 ! CASE 2: Sulfate-Rich Domain
3942
3943 if(XT.lt.1.9999 .and. XT.ge.0.)then
3944 call ASTEM_flux_wet_case2(ibin)
3945 return
3946 endif
3947
3948 !-------------------------------------------------------------------
3949
3950 if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10 ! no ammonia in the system
3951
3952 !-------------------------------------------------------------------
3953 ! CASE 3: nh4no3 and/or nh4cl maybe active
3954 ! do some small adjustments (if needed) before deciding case 3
3955
3956 iadjust = mNO ! default
3957 iadjust_intermed = mNO ! default
3958
3959 ! nh4no3
3960 g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
3961 a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
3962
3963 if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
3964 call absorb_tiny_nh4no3(ibin)
3965 iadjust = mYES
3966 iadjust_intermed = mYES
3967 endif
3968
3969 if(iadjust_intermed .eq. mYES)then
3970 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
3971 iadjust_intermed = mNO ! reset
3972 endif
3973
3974 ! nh4cl
3975 g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
3976 a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
3977
3978 if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
3979 call absorb_tiny_nh4cl(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 endif
3987
3988 if(iadjust .eq. mYES)then
3989 call compute_activities(ibin) ! update after adjustments
3990 endif
3991
3992
3993 ! all adjustments done...
3994
3995 !--------
3996 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
3997 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
3998
3999 kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
4000 Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl ! = [NH3]s * [HCl]s
4001
4002 call ASTEM_flux_wet_case3(ibin)
4003
4004 return
4005
4006
4007 !-------------------------------------------------------------------
4008 ! CASE 4: ammonia = 0. hno3 and hcl exchange may happen here
4009 ! do small adjustments (if needed) before deciding case 4
4010
4011 10 iadjust = mNO ! default
4012 iadjust_intermed = mNO ! default
4013
4014 ! hno3
4015 if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and. &
4016 aer(icl_a,jliquid,ibin) .gt. 0.0)then
4017 call absorb_tiny_hno3(ibin) ! and degas tiny hcl
4018 iadjust = mYES
4019 iadjust_intermed = mYES
4020 endif
4021
4022 if(iadjust_intermed .eq. mYES)then
4023 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
4024 iadjust_intermed = mNO ! reset
4025 endif
4026
4027 ! hcl
4028 if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin).eq.0. .and. &
4029 aer(ino3_a,jliquid,ibin) .gt. 0.0)then
4030 call absorb_tiny_hcl(ibin) ! and degas tiny hno3
4031 iadjust = mYES
4032 iadjust_intermed = mYES
4033 endif
4034
4035 if(iadjust_intermed .eq. mYES)then
4036 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
4037 endif
4038
4039 if(iadjust .eq. mYES)then
4040 call compute_activities(ibin) ! update after adjustments
4041 endif
4042
4043 ! all adjustments done...
4044
4045 call ASTEM_flux_wet_case4(ibin)
4046
4047
4048 return
4049 end subroutine ASTEM_flux_wet
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062 !***********************************************************************
4063 ! part of ASTEM: subroutines for flux_wet cases
4064 !
4065 ! author: Rahul A. Zaveri
4066 ! update: Jan 2007
4067 !-----------------------------------------------------------------------
4068
4069 ! CASE 1: CaCO3 > 0 absorb all acids (and indirectly degas co2)
4070
4071 subroutine ASTEM_flux_wet_case1(ibin)
4072 ! implicit none
4073 ! include 'mosaic.h'
4074 ! subr arguments
4075 integer ibin
4076 ! local variables
4077 integer iv
4078
4079 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4080
4081 ! same as dry case1
4082 if(gas(ihno3_g) .gt. 1.e-5)then
4083 sfc_a(ihno3_g) = 0.0
4084 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4085 phi_volatile_s(ihno3_g,ibin) = 1.0
4086 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4087 integrate(ihno3_g,jsolid,ibin) = mYES
4088 jphase(ibin) = jsolid
4089 ieqblm_ASTEM = mNO
4090 endif
4091
4092 if(gas(ihcl_g) .gt. 1.e-5)then
4093 sfc_a(ihcl_g) = 0.0
4094 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4095 phi_volatile_s(ihcl_g,ibin) = 1.0
4096 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4097 integrate(ihcl_g,jsolid,ibin) = mYES
4098 jphase(ibin) = jsolid
4099 ieqblm_ASTEM = mNO
4100 endif
4101
4102 return
4103 end subroutine ASTEM_flux_wet_case1
4104
4105
4106
4107 !--------------------------------------------------------------------
4108 ! CASE 2: Sulfate-Rich Domain
4109
4110 subroutine ASTEM_flux_wet_case2(ibin)
4111 ! implicit none
4112 ! include 'mosaic.h'
4113 ! subr arguments
4114 integer ibin
4115 ! local variables
4116 real(kind=8) dum_hno3, dum_hcl, dum_nh3
4117
4118
4119 sfc_a(inh3_g) = kel(inh3_g,ibin)* &
4120 gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4121 (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4122
4123 sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4124 mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4125 Keq_gl(3)
4126
4127 sfc_a(ihcl_g) = kel(ihcl_g,ibin)* &
4128 mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4129 Keq_gl(4)
4130
4131 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4132 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4133 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4134
4135
4136 ! compute relative driving forces
4137 if(dum_hno3 .gt. 0.0)then
4138 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4139 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4140 else
4141 phi_volatile_l(ihno3_g,ibin)= 0.0
4142 endif
4143
4144 if(dum_hcl .gt. 0.0)then
4145 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4146 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4147 else
4148 phi_volatile_l(ihcl_g,ibin) = 0.0
4149 endif
4150
4151 if(dum_nh3 .gt. 0.0)then
4152 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4153 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4154 else
4155 phi_volatile_l(inh3_g,ibin) = 0.0
4156 endif
4157
4158
4159 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4160 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4161 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4162
4163 return
4164
4165 endif
4166
4167
4168 ! compute Heff
4169 if(dum_hno3 .gt. 0.0)then
4170 Heff(ihno3_g,ibin)= &
4171 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4172 (water_a(ibin)*Keq_gl(3))
4173 integrate(ihno3_g,jliquid,ibin)= mYES
4174 ieqblm_ASTEM = mNO
4175 endif
4176
4177 if(dum_hcl .gt. 0.0)then
4178 Heff(ihcl_g,ibin)= &
4179 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4180 (water_a(ibin)*Keq_gl(4))
4181 integrate(ihcl_g,jliquid,ibin) = mYES
4182 ieqblm_ASTEM = mNO
4183 endif
4184
4185 if(dum_nh3 .gt. 0.0)then
4186 Heff(inh3_g,ibin) = &
4187 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4188 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4189 integrate(inh3_g,jliquid,ibin) = mYES
4190 ieqblm_ASTEM = mNO
4191 endif
4192
4193
4194 return
4195 end subroutine ASTEM_flux_wet_case2
4196
4197
4198
4199
4200
4201
4202
4203
4204 !---------------------------------------------------------------------
4205 ! CASE 3: nh4no3 and/or nh4cl may be active
4206
4207 subroutine ASTEM_flux_wet_case3(ibin)
4208 ! implicit none
4209 ! include 'mosaic.h'
4210 ! subr arguments
4211 integer ibin
4212 ! local variables
4213 real(kind=8) a, b, c, dum_hno3, dum_hcl, dum_nh3
4214 ! function
4215 ! real(kind=8) quadratic
4216
4217 a = kg(inh3_g,ibin)
4218 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4219 + kg(ihno3_g,ibin)*gas(ihno3_g) &
4220 + kg(ihcl_g,ibin)*gas(ihcl_g)
4221 c = -(kg(ihno3_g,ibin)*Keq_nh4no3 + kg(ihcl_g,ibin)*Keq_nh4cl)
4222
4223 sfc_a(inh3_g) = quadratic(a,b,c)
4224 sfc_a(ihno3_g) = Keq_nh4no3/max(sfc_a(inh3_g),1.D-20)
4225 sfc_a(ihcl_g) = Keq_nh4cl/max(sfc_a(inh3_g),1.D-20)
4226
4227
4228 ! diagnose mH+
4229 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4230 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4231 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4232 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4233 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4234 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4235 else
4236 call equilibrate_acids(ibin) ! hno3 and/or hcl may be > 0 in the gas phase
4237 mc(jc_h,ibin) = max(mc(jc_h,ibin), sqrt(Keq_ll(3)))
4238
4239 sfc_a(inh3_g) = kel(inh3_g,ibin)* &
4240 gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4241 (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4242
4243 sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4244 mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4245 Keq_gl(3)
4246 sfc_a(ihcl_g) = kel(ihcl_g,ibin)* &
4247 mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4248 Keq_gl(4)
4249 endif
4250
4251
4252
4253 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4254 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4255 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4256
4257 ! compute relative driving forces
4258 if(dum_hno3 .gt. 0.0)then
4259 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4260 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4261 else
4262 phi_volatile_l(ihno3_g,ibin)= 0.0
4263 endif
4264
4265 if(dum_hcl .gt. 0.0)then
4266 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4267 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4268 else
4269 phi_volatile_l(ihcl_g,ibin) = 0.0
4270 endif
4271
4272 if(dum_nh3 .gt. 0.0)then
4273 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4274 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4275 else
4276 phi_volatile_l(inh3_g,ibin) = 0.0
4277 endif
4278
4279
4280
4281 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4282 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4283 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4284
4285 return
4286
4287 endif
4288
4289
4290 ! compute Heff
4291 if(dum_hno3 .gt. 0.0)then
4292 Heff(ihno3_g,ibin)= &
4293 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4294 (water_a(ibin)*Keq_gl(3))
4295 integrate(ihno3_g,jliquid,ibin)= mYES
4296 ieqblm_ASTEM = mNO
4297 endif
4298
4299 if(dum_hcl .gt. 0.0)then
4300 Heff(ihcl_g,ibin)= &
4301 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4302 (water_a(ibin)*Keq_gl(4))
4303 integrate(ihcl_g,jliquid,ibin) = mYES
4304 ieqblm_ASTEM = mNO
4305 endif
4306
4307 if(dum_nh3 .gt. 0.0)then
4308 Heff(inh3_g,ibin) = &
4309 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4310 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4311 integrate(inh3_g,jliquid,ibin) = mYES
4312 ieqblm_ASTEM = mNO
4313 endif
4314
4315
4316
4317 return
4318 end subroutine ASTEM_flux_wet_case3
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328 !--------------------------------------------------------------------
4329 ! CASE 3a: only NH4NO3 (aq) active
4330
4331 subroutine ASTEM_flux_wet_case3a(ibin) ! NH4NO3 (aq)
4332 ! implicit none
4333 ! include 'mosaic.h'
4334 ! subr arguments
4335 integer ibin
4336 ! local variables
4337 real(kind=8) a, b, c, dum_hno3, dum_nh3
4338 ! function
4339 ! real(kind=8) quadratic
4340
4341
4342 a = kg(inh3_g,ibin)
4343 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4344 + kg(ihno3_g,ibin)*gas(ihno3_g)
4345 c = -(kg(ihno3_g,ibin)*Keq_nh4no3)
4346
4347 sfc_a(inh3_g) = quadratic(a,b,c)
4348 sfc_a(ihno3_g) = Keq_nh4no3/sfc_a(inh3_g)
4349
4350
4351 ! diagnose mH+
4352 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4353 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4354 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4355 else
4356 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4357 endif
4358
4359
4360 ! compute Heff
4361 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4362 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4363
4364 ! compute relative driving forces
4365 if(dum_hno3 .gt. 0.0)then
4366 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4367 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4368 else
4369 phi_volatile_l(ihno3_g,ibin)= 0.0
4370 endif
4371
4372 if(dum_nh3 .gt. 0.0)then
4373 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4374 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4375 else
4376 phi_volatile_l(inh3_g,ibin) = 0.0
4377 endif
4378
4379
4380 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4381 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4382
4383 return
4384
4385 endif
4386
4387
4388 ! compute Heff
4389 Heff(ihno3_g,ibin)= &
4390 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4391 (water_a(ibin)*Keq_gl(3))
4392 integrate(ihno3_g,jliquid,ibin)= mYES
4393
4394
4395 Heff(inh3_g,ibin) = &
4396 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4397 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4398 integrate(inh3_g,jliquid,ibin) = mYES
4399
4400
4401 ieqblm_ASTEM = mNO
4402
4403
4404 return
4405 end subroutine ASTEM_flux_wet_case3a
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415 !--------------------------------------------------------------------
4416 ! CASE 3b: only NH4Cl (aq) active
4417
4418 subroutine ASTEM_flux_wet_case3b(ibin) ! NH4Cl (aq)
4419 ! implicit none
4420 ! include 'mosaic.h'
4421 ! subr arguments
4422 integer ibin
4423 ! local variables
4424 real(kind=8) a, b, c, dum_hcl, dum_nh3
4425 ! function
4426 ! real(kind=8) quadratic
4427
4428
4429 a = kg(inh3_g,ibin)
4430 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4431 + kg(ihcl_g,ibin)*gas(ihcl_g)
4432 c = -(kg(ihcl_g,ibin)*Keq_nh4cl)
4433
4434 sfc_a(inh3_g) = quadratic(a,b,c)
4435 sfc_a(ihcl_g) = Keq_nh4cl /sfc_a(inh3_g)
4436
4437
4438 ! diagnose mH+
4439 if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4440 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4441 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4442 else
4443 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4444 endif
4445
4446
4447 ! compute Heff
4448 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g))
4449 dum_nh3 = max(sfc_a(inh3_g), gas(inh3_g))
4450
4451
4452 ! compute relative driving forces
4453 if(dum_hcl .gt. 0.0)then
4454 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4455 phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4456 else
4457 phi_volatile_l(ihcl_g,ibin) = 0.0
4458 endif
4459
4460 if(dum_nh3 .gt. 0.0)then
4461 df_gas_l(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4462 phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4463 else
4464 phi_volatile_l(inh3_g,ibin) = 0.0
4465 endif
4466
4467
4468
4469 if(phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem .and. &
4470 phi_volatile_l(inh3_g,ibin) .le. rtol_eqb_astem)then
4471
4472 return
4473
4474 endif
4475
4476
4477
4478 ! compute Heff
4479 Heff(ihcl_g,ibin)= &
4480 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4481 (water_a(ibin)*Keq_gl(4))
4482 integrate(ihcl_g,jliquid,ibin) = mYES
4483
4484
4485 Heff(inh3_g,ibin) = &
4486 kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4487 (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4488 integrate(inh3_g,jliquid,ibin) = mYES
4489
4490
4491 ieqblm_ASTEM = mNO
4492
4493
4494
4495 return
4496 end subroutine ASTEM_flux_wet_case3b
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506 !-----------------------------------------------------------------------
4507 ! CASE 4: NH3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
4508
4509 subroutine ASTEM_flux_wet_case4(ibin)
4510 ! implicit none
4511 ! include 'mosaic.h'
4512 ! subr arguments
4513 integer ibin
4514 ! local variables
4515 real(kind=8) dum_numer, dum_denom, gas_eqb_ratio, dum_hno3, dum_hcl
4516
4517
4518 dum_numer = kel(ihno3_g,ibin)*Keq_gl(4)*ma(ja_no3,ibin)* &
4519 gam(jhno3,ibin)**2
4520 dum_denom = kel(ihcl_g,ibin)*Keq_gl(3)*ma(ja_cl ,ibin)* &
4521 gam(jhcl,ibin)**2
4522
4523
4524 if(dum_denom .eq. 0.0 .or. dum_numer .eq. 0.0)then
4525 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4526 return
4527 endif
4528
4529 gas_eqb_ratio = dum_numer/dum_denom ! Ce,hno3/Ce,hcl
4530
4531
4532 ! compute equilibrium surface concentrations
4533 sfc_a(ihcl_g) = &
4534 ( kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g) )/ &
4535 ( kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin) )
4536 sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
4537
4538
4539 ! diagnose mH+
4540 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4541 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4542 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4543 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4544 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4545 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4546 else
4547 mc(jc_h,ibin) = sqrt(Keq_ll(3))
4548 endif
4549
4550
4551 ! compute Heff
4552 dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g)) ! raz-30apr07
4553 dum_hcl = max(sfc_a(ihcl_g), gas(ihcl_g)) ! raz-30apr07
4554
4555 ! compute relative driving forces
4556 if(dum_hno3 .gt. 0.0)then
4557 df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4558 phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4559 else
4560 phi_volatile_l(ihno3_g,ibin)= 0.0
4561 endif
4562
4563 if(dum_hcl .gt. 0.0)then
4564 df_gas_l(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4565 phi_volatile_l(ihcl_g,ibin)= df_gas_l(ihcl_g,ibin)/dum_hcl
4566 else
4567 phi_volatile_l(ihcl_g,ibin)= 0.0
4568 endif
4569
4570
4571 if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4572 phi_volatile_l(ihcl_g,ibin) .le. rtol_eqb_astem)then
4573
4574 return
4575
4576 endif
4577
4578
4579
4580 ! compute Heff
4581 Heff(ihno3_g,ibin)= &
4582 kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4583 (water_a(ibin)*Keq_gl(3))
4584 integrate(ihno3_g,jliquid,ibin)= mYES
4585
4586
4587 Heff(ihcl_g,ibin)= &
4588 kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4589 (water_a(ibin)*Keq_gl(4))
4590 integrate(ihcl_g,jliquid,ibin) = mYES
4591
4592
4593 ieqblm_ASTEM = mNO
4594
4595
4596
4597 return
4598 end subroutine ASTEM_flux_wet_case4
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613 !===========================================================
4614 !
4615 ! DRY PARTICLES
4616 !
4617 !===========================================================
4618 !***********************************************************************
4619 ! part of ASTEM: computes gas-aerosol fluxes over dry aerosols
4620 !
4621 ! author: Rahul A. Zaveri
4622 ! update: dec 2006
4623 !-----------------------------------------------------------------------
4624 subroutine ASTEM_flux_dry(ibin)
4625 ! implicit none
4626 ! include 'mosaic.h'
4627 ! subr arguments
4628 integer ibin
4629 ! local variables
4630 integer iv
4631 real(kind=8) XT, prod_nh4no3, prod_nh4cl, volatile_cl
4632
4633
4634
4635
4636 call calculate_XT(ibin,jsolid,XT)
4637
4638 !-----------------------------------------------------------------
4639 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
4640
4641 if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
4642
4643 call ASTEM_flux_dry_case1(ibin)
4644
4645 return
4646 endif
4647
4648 !-----------------------------------------------------------------
4649 ! CASE 2: Sulfate-Rich Domain
4650
4651 if(XT.lt.1.9999 .and. XT.ge.0.)then ! excess sulfate (acidic)
4652
4653 call ASTEM_flux_dry_case2(ibin)
4654
4655 return
4656 endif
4657
4658 !-------------------------------------------------------------------
4659 ! CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
4660
4661 volatile_cl = electrolyte(jnacl,jsolid,ibin) + &
4662 electrolyte(jcacl2,jsolid,ibin)
4663
4664
4665 if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
4666
4667 call ASTEM_flux_dry_case3a(ibin)
4668
4669 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_sg(2)), 0.0D0) + &
4670 electrolyte(jnh4cl, jsolid,ibin)
4671
4672 if(prod_nh4cl .gt. 0.0)then
4673 call ASTEM_flux_dry_case3b(ibin)
4674 endif
4675
4676 return
4677 endif
4678
4679 !-----------------------------------------------------------------
4680 ! CASE 4: nh4no3 or nh4cl or both may be active
4681
4682 prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-Keq_sg(1)),0.D0) + &
4683 electrolyte(jnh4no3,jsolid,ibin)
4684 prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g) -Keq_sg(2)),0.D0) + &
4685 electrolyte(jnh4cl, jsolid,ibin)
4686
4687 if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
4688 call ASTEM_flux_dry_case4(ibin)
4689 return
4690 endif
4691
4692 !-----------------------------------------------------------------
4693
4694 return
4695 end subroutine ASTEM_flux_dry
4696
4697 !----------------------------------------------------------------------
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711 !***********************************************************************
4712 ! part of ASTEM: subroutines for flux_dry cases
4713 !
4714 ! author: Rahul A. Zaveri
4715 ! update: dec 2006
4716 !-----------------------------------------------------------------------
4717
4718 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
4719
4720 subroutine ASTEM_flux_dry_case1(ibin)
4721 ! implicit none
4722 ! include 'mosaic.h'
4723 ! subr arguments
4724 integer ibin
4725
4726
4727 if(gas(ihno3_g) .gt. 1.e-5)then
4728 sfc_a(ihno3_g) = 0.0
4729 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4730 phi_volatile_s(ihno3_g,ibin) = 1.0
4731 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4732 integrate(ihno3_g,jsolid,ibin) = mYES
4733 ieqblm_ASTEM = mNO
4734 endif
4735
4736 if(gas(ihcl_g) .gt. 1.e-5)then
4737 sfc_a(ihcl_g) = 0.0
4738 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4739 phi_volatile_s(ihcl_g,ibin) = 1.0
4740 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4741 integrate(ihcl_g,jsolid,ibin) = mYES
4742 ieqblm_ASTEM = mNO
4743 endif
4744
4745
4746 return
4747 end subroutine ASTEM_flux_dry_case1
4748
4749
4750
4751 !---------------------------------------------------------------------
4752 ! CASE 2: Sulfate-Rich Domain
4753
4754 subroutine ASTEM_flux_dry_case2(ibin) ! TOUCH
4755 ! implicit none
4756 ! include 'mosaic.h'
4757 ! subr arguments
4758 integer ibin
4759
4760
4761 if(gas(inh3_g).gt.1.e-5)then
4762 sfc_a(inh3_g) = 0.0
4763 df_gas_s(inh3_g,ibin) = gas(inh3_g)
4764 phi_volatile_s(inh3_g,ibin) = 1.0
4765 flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
4766 integrate(inh3_g,jsolid,ibin) = mYES
4767 ieqblm_ASTEM = mNO
4768 endif
4769
4770
4771 return
4772 end subroutine ASTEM_flux_dry_case2
4773
4774
4775
4776
4777 !---------------------------------------------------------------------
4778 ! CASE 3a: degas hcl from nacl or cacl2 by flux_s balance with hno3
4779
4780 subroutine ASTEM_flux_dry_case3a(ibin)
4781 ! implicit none
4782 ! include 'mosaic.h'
4783 ! subr arguments
4784 integer ibin
4785
4786
4787 if(gas(ihno3_g) .gt. 1.e-5)then
4788 sfc_a(ihno3_g) = 0.0
4789 sfc_a(ihcl_g) = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4790
4791 df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4792 df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
4793
4794 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
4795 flux_s(ihcl_g,ibin) = -flux_s(ihno3_g,ibin)
4796
4797 phi_volatile_s(ihno3_g,ibin) = 1.0
4798 phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)
4799
4800 integrate(ihno3_g,jsolid,ibin) = mYES
4801 integrate(ihcl_g,jsolid,ibin) = mYES
4802
4803 idry_case3a(ibin) = mYES
4804 ieqblm_ASTEM = mNO
4805 endif
4806
4807 return
4808 end subroutine ASTEM_flux_dry_case3a
4809
4810
4811
4812
4813 !---------------------------------------------------------------------
4814 ! CASE 3b: nh4cl may form/evaporate here
4815
4816 subroutine ASTEM_flux_dry_case3b(ibin) ! TOUCH
4817 ! implicit none
4818 ! include 'mosaic.h'
4819 ! subr arguments
4820 integer ibin
4821 ! local variables
4822 integer iactive_nh4cl
4823 real(kind=8) a, b, c
4824 ! function
4825 ! real(kind=8) quadratic
4826
4827
4828 !-------------------
4829 ! set default values for flags
4830 iactive_nh4cl = 1
4831
4832
4833 ! compute relative driving force
4834 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4835 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4836
4837
4838 !-------------------
4839 ! now determine if nh4cl is active or significant
4840 ! nh4cl
4841 if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4842 iactive_nh4cl = 0
4843 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4844 epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4845 iactive_nh4cl = 0
4846 if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4847 call degas_solid_nh4cl(ibin)
4848 endif
4849 endif
4850
4851
4852 ! check the outcome
4853 if(iactive_nh4cl .eq. 0)return
4854
4855
4856 !-----------------
4857 ! nh4cl is active
4858
4859
4860 a = kg(inh3_g,ibin)
4861 b = - kg(inh3_g,ibin)*gas(inh3_g) &
4862 + kg(ihcl_g,ibin)*gas(ihcl_g)
4863 c = -(kg(ihcl_g,ibin)*Keq_sg(2))
4864
4865 sfc_a(inh3_g) = quadratic(a,b,c)
4866 sfc_a(ihcl_g) = Keq_sg(2)/sfc_a(inh3_g)
4867
4868 df_gas_s(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4869 df_gas_s(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4870
4871 flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas_s(inh3_g,ibin)
4872 flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) + flux_s(inh3_g,ibin)
4873
4874 phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
4875
4876 if(flux_s(ihcl_g,ibin) .gt. 0.0)then
4877 df_gas_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin) ! recompute df_gas
4878 phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
4879 else
4880 sfc_a(ihcl_g) = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4881 df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
4882 phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g) ! not to be used
4883 endif
4884
4885 integrate(inh3_g,jsolid,ibin) = mYES
4886 integrate(ihcl_g,jsolid,ibin) = mYES ! integrate HCl with explicit euler
4887
4888 ieqblm_ASTEM = mNO
4889
4890 return
4891 end subroutine ASTEM_flux_dry_case3b
4892
4893
4894
4895
4896 !---------------------------------------------------------------------
4897 ! Case 4: NH4NO3 and/or NH4Cl may be active
4898
4899 subroutine ASTEM_flux_dry_case4(ibin) ! TOUCH
4900 ! implicit none
4901 ! include 'mosaic.h'
4902 ! subr arguments
4903 integer ibin
4904 ! local variables
4905 integer iactive_nh4no3, iactive_nh4cl, iactive
4906 real(kind=8) a, b, c
4907 ! function
4908 ! real(kind=8) quadratic
4909
4910
4911 !-------------------
4912 ! set default values for flags
4913 iactive_nh4no3 = 1
4914 iactive_nh4cl = 2
4915
4916
4917 ! compute diagnostic products and ratios
4918 phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
4919 max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
4920 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4921 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4922
4923
4924 !-------------------
4925 ! now determine if nh4no3 and/or nh4cl are active or significant
4926
4927 ! nh4no3
4928 if( abs(phi_nh4no3_s) .lt. rtol_eqb_ASTEM )then
4929 iactive_nh4no3 = 0
4930 elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
4931 epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
4932 iactive_nh4no3 = 0
4933 if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
4934 call degas_solid_nh4no3(ibin)
4935 endif
4936 endif
4937
4938 ! nh4cl
4939 if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4940 iactive_nh4cl = 0
4941 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4942 epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4943 iactive_nh4cl = 0
4944 if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4945 call degas_solid_nh4cl(ibin)
4946 endif
4947 endif
4948
4949
4950 iactive = iactive_nh4no3 + iactive_nh4cl
4951
4952 ! check the outcome
4953 if(iactive .eq. 0)return
4954
4955
4956 goto (1,2,3),iactive
4957
4958 !---------------------------------
4959 ! only nh4no3 solid is active
4960 1 call ASTEM_flux_dry_case4a(ibin)
4961
4962 return
4963
4964
4965 !-----------------
4966 ! only nh4cl solid is active
4967 2 call ASTEM_flux_dry_case4b(ibin)
4968
4969 return
4970
4971
4972 !-----------------
4973 ! both nh4no3 and nh4cl are active
4974 3 call ASTEM_flux_dry_case4ab(ibin)
4975
4976
4977
4978
4979 return
4980 end subroutine ASTEM_flux_dry_case4
4981
4982
4983
4984
4985
4986
4987
4988 !---------------------------------------------------------------------
4989 ! Case 4a
4990
4991 subroutine ASTEM_flux_dry_case4a(ibin) ! NH4NO3 solid
4992 ! implicit none
4993 ! include 'mosaic.h'
4994 ! subr arguments
4995 integer ibin
4996 ! local variables
4997 real(kind=8) a, b, c
4998 ! function
4999 ! real(kind=8) quadratic
5000
5001
5002
5003 a = kg(inh3_g,ibin)
5004 b = - kg(inh3_g,ibin)*gas(inh3_g) &
5005 + kg(ihno3_g,ibin)*gas(ihno3_g)
5006 c = -(kg(ihno3_g,ibin)*Keq_sg(1))
5007
5008 sfc_a(inh3_g) = quadratic(a,b,c)
5009 sfc_a(ihno3_g) = Keq_sg(1)/sfc_a(inh3_g)
5010
5011 integrate(ihno3_g,jsolid,ibin) = mYES
5012 integrate(inh3_g,jsolid,ibin) = mYES
5013
5014 df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5015 df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5016
5017 phi_volatile_s(ihno3_g,ibin)= phi_nh4no3_s
5018 phi_volatile_s(inh3_g,ibin) = phi_nh4no3_s
5019
5020 flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
5021 flux_s(inh3_g,ibin) = flux_s(ihno3_g,ibin)
5022
5023 ieqblm_ASTEM = mNO
5024
5025 return
5026 end subroutine ASTEM_flux_dry_case4a
5027
5028
5029
5030
5031 !---------------------------------------------------------
5032 ! Case 4b
5033
5034 subroutine ASTEM_flux_dry_case4b(ibin) ! NH4Cl solid
5035 ! implicit none
5036 ! include 'mosaic.h'
5037 ! subr arguments
5038 integer ibin
5039 ! local variables
5040 real(kind=8) a, b, c
5041 ! function
5042 ! real(kind=8) quadratic
5043
5044
5045 a = kg(inh3_g,ibin)
5046 b = - kg(inh3_g,ibin)*gas(inh3_g) &
5047 + kg(ihcl_g,ibin)*gas(ihcl_g)
5048 c = -(kg(ihcl_g,ibin)*Keq_sg(2))
5049
5050 sfc_a(inh3_g) = quadratic(a,b,c)
5051 sfc_a(ihcl_g) = Keq_sg(2) /sfc_a(inh3_g)
5052
5053 integrate(ihcl_g,jsolid,ibin) = mYES
5054 integrate(inh3_g,jsolid,ibin) = mYES
5055
5056 df_gas_s(ihcl_g,ibin) = gas(ihcl_g)-sfc_a(ihcl_g)
5057 df_gas_s(inh3_g,ibin) = gas(inh3_g)-sfc_a(inh3_g)
5058
5059 phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
5060 phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
5061
5062 flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
5063 flux_s(inh3_g,ibin) = flux_s(ihcl_g,ibin)
5064
5065 ieqblm_ASTEM = mNO
5066
5067 return
5068 end subroutine ASTEM_flux_dry_case4b
5069
5070
5071
5072
5073 !-------------------------------------------------------------------
5074 ! Case 4ab
5075
5076 subroutine ASTEM_flux_dry_case4ab(ibin) ! NH4NO3 + NH4Cl (solid)
5077 ! implicit none
5078 ! include 'mosaic.h'
5079 ! subr arguments
5080 integer ibin
5081 ! local variables
5082 real(kind=8) a, b, c, &
5083 flux_nh3_est, flux_nh3_max, ratio_flux
5084 ! function
5085 ! real(kind=8) quadratic
5086
5087 call ASTEM_flux_dry_case4a(ibin)
5088 call ASTEM_flux_dry_case4b(ibin)
5089
5090
5091 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
5092
5093 flux_nh3_est = flux_s(ihno3_g,ibin)+flux_s(ihcl_g,ibin)
5094 flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
5095
5096
5097 if(flux_nh3_est .le. flux_nh3_max)then
5098
5099 flux_s(inh3_g,ibin) = flux_nh3_est ! all ok - no adjustments needed
5100 sfc_a(inh3_g) = gas(inh3_g) - & ! recompute sfc_a(ihno3_g)
5101 flux_s(inh3_g,ibin)/kg(inh3_g,ibin)
5102 phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5103 abs(phi_nh4cl_s))
5104
5105 else ! reduce hno3 and hcl flux_ses as necessary so that nh3 flux_s = flux_s_nh3_max
5106
5107 ratio_flux = flux_nh3_max/flux_nh3_est
5108 flux_s(inh3_g,ibin) = flux_nh3_max
5109 flux_s(ihno3_g,ibin)= flux_s(ihno3_g,ibin)*ratio_flux
5110 flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) *ratio_flux
5111
5112 sfc_a(inh3_g) = 0.0
5113 sfc_a(ihno3_g)= gas(ihno3_g) - & ! recompute sfc_a(ihno3_g)
5114 flux_s(ihno3_g,ibin)/kg(ihno3_g,ibin)
5115 sfc_a(ihcl_g) = gas(ihcl_g) - & ! recompute sfc_a(ihcl_g)
5116 flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)
5117
5118 df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5119 df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5120 df_gas_s(ihcl_g,ibin) =gas(ihcl_g) -sfc_a(ihcl_g)
5121
5122 phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5123 abs(phi_nh4cl_s))
5124
5125 endif
5126
5127 ieqblm_ASTEM = mNO
5128
5129 return
5130 end subroutine ASTEM_flux_dry_case4ab
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142 !=======================================================================
5143 !
5144 ! MIXED-PHASE PARTICLES
5145 !
5146 !***********************************************************************
5147 ! part of ASTEM: computes gas-aerosol fluxes over mixed-phase aerosols
5148 !
5149 ! author: Rahul A. Zaveri
5150 ! update: apr 2006
5151 !-----------------------------------------------------------------------
5152
5153 subroutine ASTEM_flux_mix(ibin)
5154 ! implicit none
5155 ! include 'mosaic.h'
5156 ! subr arguments
5157 integer ibin
5158 ! local variables
5159 integer iv, iadjust, iadjust_intermed
5160 real(kind=8) XT, g_nh3_hno3, g_nh3_hcl, &
5161 a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
5162 prod_nh4no3, prod_nh4cl
5163 real(kind=8) volatile_cl
5164
5165
5166 call ions_to_electrolytes(jliquid,ibin,XT) ! for water content calculation
5167 call compute_activities(ibin)
5168
5169 if(water_a(ibin) .eq. 0.0)then
5170 write(6,*)'Water is zero in liquid phase'
5171 write(6,*)'Stopping in ASTEM_flux_wet'
5172 stop
5173 endif
5174
5175
5176
5177 !-----------------------------------------------------------------
5178 ! CASE 1: caco3 > 0 absorb all acids (and indirectly degas co2)
5179
5180 if(epercent(jcaco3,jsolid,ibin) .gt. 0.0)then
5181 jphase(ibin) = jliquid
5182 call ASTEM_flux_wet_case1(ibin)
5183 return
5184 endif
5185
5186 !-----------------------------------------------------------------
5187 ! CASE 2: Sulfate-Rich Domain
5188
5189 if(XT.lt.1.9999 .and. XT.ge.0.)then ! excess sulfate (acidic)
5190 jphase(ibin) = jliquid
5191 call ASTEM_flux_wet_case2(ibin)
5192 return
5193 endif
5194
5195 !-------------------------------------------------------------------
5196 ! CASE 3: nh4no3 or nh4cl or both may be active
5197
5198 if( electrolyte(jnh4no3,jsolid,ibin).gt.0. .and. &
5199 electrolyte(jnh4cl,jsolid,ibin) .gt.0. )then
5200 jphase(ibin) = jsolid
5201 call ASTEM_flux_dry_case4(ibin)
5202
5203 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5204 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5205 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5206 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5207 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5208 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5209 else
5210 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5211 endif
5212
5213 return
5214
5215 elseif( electrolyte(jnh4no3,jsolid,ibin).gt.0. )then
5216 ! do small adjustments for nh4cl aq
5217 g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
5218 a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
5219
5220 iadjust = mNO ! initialize
5221 if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .eq. 0.0)then
5222 call absorb_tiny_nh4cl(ibin)
5223 iadjust = mYES
5224 elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
5225 call degas_tiny_nh4cl(ibin)
5226 iadjust = mYES
5227 endif
5228
5229 if(iadjust .eq. mYES)then
5230 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
5231 call compute_activities(ibin) ! update after adjustments
5232 endif
5233
5234 call ASTEM_flux_mix_case3a(ibin) ! nh4no3 solid + nh4cl aq
5235 jphase(ibin) = jtotal
5236 return
5237
5238 elseif( electrolyte(jnh4cl,jsolid,ibin).gt.0.)then
5239 ! do small adjustments for nh4no3 aq
5240 g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
5241 a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
5242
5243 iadjust = mNO ! initialize
5244 if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .eq. 0.0)then
5245 call absorb_tiny_nh4no3(ibin)
5246 iadjust = mYES
5247 elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
5248 call degas_tiny_nh4no3(ibin)
5249 iadjust = mYES
5250 endif
5251
5252 if(iadjust .eq. mYES)then
5253 call ions_to_electrolytes(jliquid,ibin,XT) ! update after adjustments
5254 call compute_activities(ibin) ! update after adjustments
5255 endif
5256
5257 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5258 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
5259
5260 call ASTEM_flux_mix_case3b(ibin) ! nh4cl solid + nh4no3 aq
5261 jphase(ibin) = jtotal
5262 return
5263 endif
5264
5265
5266 return
5267 end subroutine ASTEM_flux_mix
5268
5269 !----------------------------------------------------------------------
5270
5271
5272
5273
5274
5275
5276
5277
5278 !------------------------------------------------------------------
5279 ! Mix Case 3a: NH4NO3 solid maybe active. NH4Cl aq maybe active
5280
5281 subroutine ASTEM_flux_mix_case3a(ibin) ! TOUCH
5282 ! implicit none
5283 ! include 'mosaic.h'
5284 ! subr arguments
5285 integer ibin
5286 ! local variables
5287 integer iactive_nh4no3, iactive_nh4cl
5288
5289
5290 ! set default values for flags
5291 iactive_nh4no3 = mYES
5292 iactive_nh4cl = mYES
5293
5294
5295 ! nh4no3 (solid)
5296 phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
5297 max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
5298
5299 ! nh4cl (liquid)
5300 kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
5301 Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl ! = [NH3]s * [HCl]s
5302
5303
5304 !-------------------
5305 ! now determine if nh4no3 and/or nh4cl are active or significant
5306 ! nh4no3 solid
5307 if( abs(phi_nh4no3_s) .le. rtol_eqb_ASTEM )then
5308 iactive_nh4no3 = mNO
5309 elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
5310 epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
5311 iactive_nh4no3 = mNO
5312 if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
5313 call degas_solid_nh4no3(ibin)
5314 endif
5315 endif
5316
5317 ! nh4cl aq
5318 if( gas(inh3_g)*gas(ihcl_g).eq.0. .or. Keq_nh4cl.eq.0. )then
5319 iactive_nh4cl = mNO
5320 endif
5321
5322
5323 !---------------------------------
5324 if(iactive_nh4no3 .eq. mYES)then
5325
5326 jphase(ibin) = jsolid
5327 call ASTEM_flux_dry_case4a(ibin) ! NH4NO3 (solid)
5328
5329 if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5330 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5331 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5332 elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5333 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5334 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5335 else
5336 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5337 endif
5338
5339 endif
5340
5341
5342 if(iactive_nh4cl .eq. mYES)then
5343
5344 jphase(ibin) = jliquid
5345 call ASTEM_flux_wet_case3b(ibin) ! NH4Cl (liquid)
5346
5347 if(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 .and. iactive_nh4no3 .eq. mYES)then
5358 jphase(ibin) = jtotal
5359 endif
5360
5361
5362
5363 return
5364 end subroutine ASTEM_flux_mix_case3a
5365
5366
5367
5368
5369
5370
5371
5372
5373 !------------------------------------------------------------------
5374 ! Mix Case 3b: NH4Cl solid maybe active. NH4NO3 aq may or maybe active
5375
5376 subroutine ASTEM_flux_mix_case3b(ibin) ! TOUCH
5377 ! implicit none
5378 ! include 'mosaic.h'
5379 ! subr arguments
5380 integer ibin
5381 ! local variables
5382 integer iactive_nh4no3, iactive_nh4cl
5383
5384
5385 ! set default values for flags
5386 iactive_nh4cl = mYES
5387 iactive_nh4no3 = mYES
5388
5389
5390 ! nh4cl (solid)
5391 phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
5392 max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
5393
5394 ! nh4no3 (liquid)
5395 kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5396 Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3 ! = [NH3]s * [HNO3]s
5397
5398
5399 !-------------------
5400 ! now determine if nh4no3 and/or nh4cl are active or significant
5401 ! nh4cl (solid)
5402 if( abs(phi_nh4cl_s) .le. rtol_eqb_ASTEM )then
5403 iactive_nh4cl = mNO
5404 elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
5405 epercent(jnh4cl,jsolid,ibin) .le. ptol_mol_ASTEM)then
5406 iactive_nh4cl = mNO
5407 if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0)then
5408 call degas_solid_nh4cl(ibin)
5409 endif
5410 endif
5411
5412 ! nh4no3 (liquid)
5413 if( gas(inh3_g)*gas(ihno3_g).eq.0. .or. Keq_nh4no3.eq.0. )then
5414 iactive_nh4no3 = mNO
5415 endif
5416
5417
5418 !---------------------------------
5419 if(iactive_nh4cl .eq. mYES)then
5420
5421 jphase(ibin) = jsolid
5422 call ASTEM_flux_dry_case4b(ibin) ! NH4Cl (solid)
5423
5424 if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5425 mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5426 (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5427 elseif(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5428 mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5429 (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5430 else
5431 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5432 endif
5433
5434 endif
5435
5436
5437 if(iactive_nh4no3 .eq. mYES)then
5438
5439 jphase(ibin) = jliquid
5440 call ASTEM_flux_wet_case3a(ibin) ! NH4NO3 (liquid)
5441
5442 if(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_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
5453 jphase(ibin) = jtotal
5454 endif
5455
5456
5457
5458 return
5459 end subroutine ASTEM_flux_mix_case3b
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471 !***********************************************************************
5472 ! part of ASTEM: condenses h2so4, msa, and nh3 analytically over dtchem [s]
5473 !
5474 ! author: Rahul A. Zaveri
5475 ! update: jan 2007
5476 !-----------------------------------------------------------------------
5477
5478 subroutine ASTEM_non_volatiles(dtchem) ! TOUCH
5479 ! implicit none
5480 ! include 'mosaic.h'
5481 ! subr arguments
5482 real(kind=8) dtchem
5483 ! local variables
5484 integer ibin, iupdate_phase_state
5485 real(kind=8) decay_h2so4, decay_msa, &
5486 delta_h2so4, delta_tmsa, delta_nh3, delta_hno3, delta_hcl, &
5487 delta_so4(nbin_a), delta_msa(nbin_a), &
5488 delta_nh4(nbin_a)
5489 real(kind=8) XT
5490
5491
5492
5493
5494 sumkg_h2so4 = 0.0
5495 sumkg_msa = 0.0
5496 sumkg_nh3 = 0.0
5497 sumkg_hno3 = 0.0
5498 sumkg_hcl = 0.0
5499 do ibin = 1, nbin_a
5500 sumkg_h2so4 = sumkg_h2so4 + kg(ih2so4_g,ibin)
5501 sumkg_msa = sumkg_msa + kg(imsa_g,ibin)
5502 sumkg_nh3 = sumkg_nh3 + kg(inh3_g,ibin)
5503 sumkg_hno3 = sumkg_hno3 + kg(ihno3_g,ibin)
5504 sumkg_hcl = sumkg_hcl + kg(ihcl_g,ibin)
5505 enddo
5506
5507
5508
5509 !--------------------------------------
5510 ! H2SO4
5511 if(gas(ih2so4_g) .gt. 1.e-14)then
5512
5513 ! integrate h2so4 condensation analytically
5514 decay_h2so4 = exp(-sumkg_h2so4*dtchem)
5515 delta_h2so4 = gas(ih2so4_g)*(1.0 - decay_h2so4)
5516 gas(ih2so4_g) = gas(ih2so4_g)*decay_h2so4
5517
5518
5519 ! now distribute delta_h2so4 to each bin and conform the particle (may degas by massbal)
5520 do ibin = 1, nbin_a
5521 if(jaerosolstate(ibin) .ne. no_aerosol)then
5522 delta_so4(ibin) = delta_h2so4*kg(ih2so4_g,ibin)/sumkg_h2so4
5523 aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
5524 delta_so4(ibin)
5525 endif
5526 enddo
5527
5528 else
5529
5530 delta_h2so4 = 0.0
5531 do ibin = 1, nbin_a
5532 delta_so4(ibin) = 0.0
5533 enddo
5534
5535 endif
5536 ! h2so4 condensation is now complete
5537 !--------------------------------------
5538
5539
5540
5541 ! MSA
5542 if(gas(imsa_g) .gt. 1.e-14)then
5543
5544 ! integrate msa condensation analytically
5545 decay_msa = exp(-sumkg_msa*dtchem)
5546 delta_tmsa = gas(imsa_g)*(1.0 - decay_msa)
5547 gas(imsa_g) = gas(imsa_g)*decay_msa
5548
5549 ! now distribute delta_msa to each bin and conform the particle (may degas by massbal)
5550 do ibin = 1, nbin_a
5551 if(jaerosolstate(ibin) .ne. no_aerosol)then
5552 delta_msa(ibin) = delta_tmsa*kg(imsa_g,ibin)/sumkg_msa
5553 aer(imsa_a,jtotal,ibin) = aer(imsa_a,jtotal,ibin) + &
5554 delta_msa(ibin)
5555 endif
5556 enddo
5557
5558 else
5559
5560 delta_tmsa = 0.0
5561 do ibin = 1, nbin_a
5562 delta_msa(ibin) = 0.0
5563 enddo
5564
5565 endif
5566 ! msa condensation is now complete
5567 !-------------------------------------
5568
5569
5570
5571 ! compute max allowable nh3, hno3, and hcl condensation
5572 delta_nh3 = gas(inh3_g) *(1.0 - exp(-sumkg_nh3*dtchem))
5573 delta_hno3= gas(ihno3_g)*(1.0 - exp(-sumkg_hno3*dtchem))
5574 delta_hcl = gas(ihcl_g) *(1.0 - exp(-sumkg_hcl*dtchem))
5575
5576 ! compute max possible nh4 condensation for each bin
5577 do ibin = 1, nbin_a
5578 if(jaerosolstate(ibin) .ne. no_aerosol)then
5579 delta_nh3_max(ibin) = delta_nh3*kg(inh3_g,ibin)/sumkg_nh3
5580 delta_hno3_max(ibin)= delta_hno3*kg(ihno3_g,ibin)/sumkg_hno3
5581 delta_hcl_max(ibin) = delta_hcl*kg(ihcl_g,ibin)/sumkg_hcl
5582 endif
5583 enddo
5584
5585
5586 if(delta_h2so4 .eq. 0.0 .and. delta_tmsa .eq. 0.0)then
5587 iupdate_phase_state = mNO
5588 goto 100
5589 endif
5590
5591
5592 ! now condense appropriate amounts of nh3 to each bin
5593 do ibin = 1, nbin_a
5594
5595 if(epercent(jnacl,jtotal,ibin) .eq. 0.0 .and. &
5596 epercent(jcacl2,jtotal,ibin) .eq. 0.0 .and. &
5597 epercent(jnano3,jtotal,ibin) .eq. 0.0 .and. &
5598 epercent(jcano3,jtotal,ibin) .eq. 0.0 .and. &
5599 epercent(jcaco3,jtotal,ibin) .eq. 0.0 .and. &
5600 jaerosolstate(ibin) .ne. no_aerosol)then
5601
5602 delta_nh4(ibin)=min( (2.*delta_so4(ibin)+delta_msa(ibin)), &
5603 delta_nh3_max(ibin) )
5604
5605 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) + & ! update aer-phase
5606 delta_nh4(ibin)
5607
5608 gas(inh3_g) = gas(inh3_g) - delta_nh4(ibin) ! update gas-phase
5609
5610 else
5611
5612 delta_nh4(ibin) = 0.0
5613
5614 endif
5615
5616 enddo
5617
5618 iupdate_phase_state = mYES
5619
5620
5621 ! recompute phase equilibrium
5622 100 if(iupdate_phase_state .eq. mYES)then
5623 do ibin = 1, nbin_a
5624 if(jaerosolstate(ibin) .ne. no_aerosol)then
5625 call conform_electrolytes(jtotal,ibin,XT)
5626 call aerosol_phase_state(ibin)
5627 endif
5628 enddo
5629 endif
5630
5631 return
5632 end subroutine ASTEM_non_volatiles
5633
5634
5635
5636
5637
5638
5639
5640 !***********************************************************************
5641 ! computes mass transfer coefficients for each condensing species for
5642 ! all the aerosol bins
5643 !
5644 ! author: rahul a. zaveri
5645 ! update: jan 2005
5646 !-----------------------------------------------------------------------
5647 subroutine aerosolmtc
5648
5649 use module_data_mosaic_asect
5650
5651 ! implicit none
5652 ! include 'v33com9a'
5653 ! include 'mosaic.h'
5654 ! local variables
5655 integer nghq
5656 parameter (nghq = 2) ! gauss-hermite quadrature order
5657 integer ibin, iq, iv
5658 real(kind=8) tworootpi, root2, beta
5659 parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
5660 real(kind=8) cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed, &
5661 sumghq
5662 real(kind=8) xghq(nghq), wghq(nghq) ! quadrature abscissae and weights
5663 real(kind=8) mw_vol(ngas_volatile), v_molar(ngas_volatile), & ! mw and molar vols of volatile species
5664 freepath(ngas_volatile), accom(ngas_volatile), &
5665 dg(ngas_volatile) ! keep local
5666 ! real(kind=8) fuchs_sutugin ! mosaic func
5667 ! real(kind=8) gas_diffusivity ! mosaic func
5668 ! real(kind=8) mean_molecular_speed ! mosaic func
5669
5670
5671
5672
5673
5674 ! molecular weights
5675 mw_vol(ih2so4_g) = 98.0
5676 mw_vol(ihno3_g) = 63.0
5677 mw_vol(ihcl_g) = 36.5
5678 mw_vol(inh3_g) = 17.0
5679 mw_vol(imsa_g) = 96.0
5680 mw_vol(iaro1_g) = 150.0
5681 mw_vol(iaro2_g) = 150.0
5682 mw_vol(ialk1_g) = 140.0
5683 mw_vol(iole1_g) = 140.0
5684 mw_vol(iapi1_g) = 184.0
5685 mw_vol(iapi2_g) = 184.0
5686 mw_vol(ilim1_g) = 200.0
5687 mw_vol(ilim2_g) = 200.0
5688
5689 v_molar(ih2so4_g)= 42.88
5690 v_molar(ihno3_g) = 24.11
5691 v_molar(ihcl_g) = 21.48
5692 v_molar(inh3_g) = 14.90
5693 v_molar(imsa_g) = 58.00
5694
5695 ! mass accommodation coefficients
5696 accom(ih2so4_g) = 0.1
5697 accom(ihno3_g) = 0.1
5698 accom(ihcl_g) = 0.1
5699 accom(inh3_g) = 0.1
5700 accom(imsa_g) = 0.1
5701 accom(iaro1_g) = 0.1
5702 accom(iaro2_g) = 0.1
5703 accom(ialk1_g) = 0.1
5704 accom(iole1_g) = 0.1
5705 accom(iapi1_g) = 0.1
5706 accom(iapi2_g) = 0.1
5707 accom(ilim1_g) = 0.1
5708 accom(ilim2_g) = 0.1
5709
5710 ! quadrature weights
5711 xghq(1) = 0.70710678
5712 xghq(2) = -0.70710678
5713 wghq(1) = 0.88622693
5714 wghq(2) = 0.88622693
5715
5716
5717
5718 ! calculate gas diffusivity and mean free path for condensing gases
5719 ! ioa
5720 do iv = 1, ngas_ioa
5721 speed = mean_molecular_speed(t_k,mw_vol(iv)) ! cm/s
5722 dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
5723 freepath(iv) = 3.*dg(iv)/speed ! cm
5724 enddo
5725
5726 ! soa
5727 do iv = iaro1_g, ngas_volatile
5728 speed = mean_molecular_speed(t_k,mw_vol(iv)) ! cm/s
5729 dg(iv) = 0.02 ! cm^2/s
5730 freepath(iv) = 3.*dg(iv)/speed
5731 enddo
5732
5733
5734 ! calc mass transfer coefficients for gases over various aerosol bins
5735
5736 if (msize_framework .eq. mmodal) then
5737
5738 ! for modal approach
5739 do 10 ibin = 1, nbin_a
5740
5741 if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
5742 call calc_dry_n_wet_aerosol_props(ibin)
5743
5744 dpgn_a(ibin) = dp_wet_a(ibin) ! cm
5745
5746 lnsg = log(sigmag_a(ibin))
5747 lndpgn = log(dpgn_a(ibin))
5748 cdum = tworootpi*num_a(ibin)* &
5749 exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
5750
5751 do 20 iv = 1, ngas_volatile
5752
5753 sumghq = 0.0
5754 do 30 iq = 1, nghq ! sum over gauss-hermite quadrature points
5755 lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
5756 dp = exp(lndp)
5757 kn = 2.*freepath(iv)/dp
5758 fkn = fuchs_sutugin(kn,accom(iv))
5759 sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
5760 30 continue
5761
5762 kg(iv,ibin) = cdum*dg(iv)*sumghq ! 1/s
5763 20 continue
5764 10 continue
5765
5766 elseif(msize_framework .eq. msection)then
5767
5768 ! for sectional approach
5769 do 11 ibin = 1, nbin_a
5770
5771 if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
5772
5773 call calc_dry_n_wet_aerosol_props(ibin)
5774
5775 dp_avg = dp_wet_a(ibin)
5776 cdum = 6.283185*dp_avg*num_a(ibin)
5777
5778 do 21 iv = 1, ngas_volatile
5779 kn = 2.*freepath(iv)/dp_avg
5780 fkn = fuchs_sutugin(kn,accom(iv))
5781 kg(iv,ibin) = cdum*dg(iv)*fkn ! 1/s
5782 21 continue
5783
5784 11 continue
5785
5786 else
5787
5788 if (iprint_mosaic_fe1 .gt. 0) then
5789 write(6,*)'error in the choice of msize_framework'
5790 write(6,*)'mosaic fatal error in subr. aerosolmtc'
5791 endif
5792 ! stop
5793 istat_mosaic_fe1 = -1900
5794 return
5795
5796 endif
5797
5798
5799 return
5800 end subroutine aerosolmtc
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813 !***********************************************************************
5814 ! calculates dry and wet aerosol properties: density, refractive indices
5815 !
5816 ! author: rahul a. zaveri
5817 ! update: jan 2005
5818 !-----------------------------------------------------------------------
5819 subroutine calc_dry_n_wet_aerosol_props(ibin)
5820
5821 use module_data_mosaic_asect
5822
5823 ! implicit none
5824 ! include 'v33com9a'
5825 ! include 'mosaic.h'
5826 ! subr arguments
5827 integer ibin
5828 ! local variables
5829 integer jc, je, iaer, isize, itype
5830 real(kind=8) aer_H
5831 complex(kind=8) ri_dum
5832
5833
5834 ! calculate dry mass and dry volume of a bin
5835 mass_dry_a(ibin) = 0.0 ! initialize to 0.0
5836 vol_dry_a(ibin) = 0.0 ! initialize to 0.0
5837 area_dry_a(ibin) = 0.0 ! initialize to 0.0
5838
5839 if(jaerosolstate(ibin) .ne. no_aerosol)then
5840
5841 aer_H = (2.*aer(iso4_a,jtotal,ibin) + &
5842 aer(ino3_a,jtotal,ibin) + &
5843 aer(icl_a,jtotal,ibin) + &
5844 aer(imsa_a,jtotal,ibin) + &
5845 2.*aer(ico3_a,jtotal,ibin))- &
5846 (2.*aer(ica_a,jtotal,ibin) + &
5847 aer(ina_a,jtotal,ibin) + &
5848 aer(inh4_a,jtotal,ibin))
5849
5850 do iaer = 1, naer
5851 mass_dry_a(ibin) = mass_dry_a(ibin) + &
5852 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer) ! ng/m^3(air)
5853 vol_dry_a(ibin) = vol_dry_a(ibin) + &
5854 aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer) ! ncc/m^3(air)
5855 enddo
5856 mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
5857 vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
5858
5859 mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15 ! g/cc(air)
5860 vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15 ! cc(aer)/cc(air)
5861
5862 ! wet mass and wet volume
5863 mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
5864 vol_wet_a(ibin) = vol_dry_a(ibin) + water_a(ibin)*1.e-3 ! cc(aer)/cc(air)
5865
5866 ! calculate mean dry and wet particle densities
5867 dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
5868 dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
5869
5870 ! calculate mean dry and wet particle surface areas
5871 area_dry_a(ibin)= 0.785398*num_a(ibin)*Dp_dry_a(ibin)**2 ! cm^2/cc(air)
5872 area_wet_a(ibin)= 0.785398*num_a(ibin)*Dp_wet_a(ibin)**2 ! cm^2/cc(air)
5873
5874 ! calculate mean dry and wet particle diameters
5875 dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
5876 dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
5877
5878 ! calculate volume average refractive index
5879 ! load comp_a array
5880 do je = 1, nelectrolyte
5881 comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5882 enddo
5883 comp_a(joc) = aer(ioc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5884 comp_a(jbc) = aer(ibc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5885 comp_a(join) = aer(ioin_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5886 comp_a(jaro1)= aer(iaro1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5887 comp_a(jaro2)= aer(iaro2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5888 comp_a(jalk1)= aer(ialk1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5889 comp_a(jole1)= aer(iole1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5890 comp_a(japi1)= aer(iapi1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5891 comp_a(japi2)= aer(iapi2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5892 comp_a(jlim1)= aer(ilim1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5893 comp_a(jlim2)= aer(ilim2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
5894 comp_a(jh2o) = water_a(ibin)*1.e-3 ! g/cc(air)
5895
5896 ri_dum = (0.0,0.0)
5897 do jc = 1, naercomp
5898 ri_dum = ri_dum + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
5899 enddo
5900
5901 ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
5902
5903 else ! use defaults
5904
5905 dens_dry_a(ibin) = 1.0 ! g/cc(aerosol)
5906 dens_wet_a(ibin) = 1.0 ! g/cc(aerosol)
5907
5908 call isize_itype_from_ibin( ibin, isize, itype )
5909 dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
5910 dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
5911
5912 ri_avg_a(ibin) = (1.5,0.0)
5913 endif
5914
5915
5916 return
5917 end subroutine calc_dry_n_wet_aerosol_props
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938 !***********************************************************************
5939 ! computes activities
5940 !
5941 ! author: rahul a. zaveri
5942 ! update: jan 2005
5943 !-----------------------------------------------------------------------
5944 subroutine compute_activities(ibin)
5945 ! implicit none
5946 ! include 'mosaic.h'
5947 ! subr arguments
5948 integer ibin
5949 ! local variables
5950 integer jp, ja
5951 real(kind=8) xt, xmol(nelectrolyte), sum_elec, dumK, c_bal, a_c
5952 real(kind=8) quad, aq, bq, cq, xq, dum
5953 ! function
5954 ! real(kind=8) aerosol_water
5955
5956
5957 water_a(ibin) = aerosol_water(jliquid,ibin) ! kg/m^3(air)
5958 if(water_a(ibin) .eq. 0.0)return
5959
5960
5961 call calculate_xt(ibin,jliquid,xt)
5962
5963 if(xt.gt.2.0 .or. xt.lt.0.)then
5964 ! sulfate poor: fully dissociated electrolytes
5965
5966
5967 ! anion molalities (mol/kg water)
5968 ma(ja_so4,ibin) = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
5969 ma(ja_hso4,ibin) = 0.0
5970 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5971 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5972 ma(ja_msa,ibin) = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
5973
5974 ! cation molalities (mol/kg water)
5975 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5976 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5977 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5978 a_c = ( 2.d0*ma(ja_so4,ibin)+ &
5979 ma(ja_no3,ibin)+ &
5980 ma(ja_cl,ibin) + &
5981 ma(ja_msa,ibin) ) - &
5982 ( 2.d0*mc(jc_ca,ibin) + &
5983 mc(jc_nh4,ibin)+ &
5984 mc(jc_na,ibin) )
5985 mc(jc_h,ibin) = 0.5*a_c + sqrt(a_c**2 + 4.*Keq_ll(3))
5986
5987 if(mc(jc_h,ibin) .eq. 0.0)then
5988 mc(jc_h,ibin) = sqrt(Keq_ll(3))
5989 endif
5990
5991
5992 jp = jliquid
5993
5994
5995 sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) + &
5996 2.*electrolyte(jnh4cl,jp,ibin) + &
5997 3.*electrolyte(jnh4so4,jp,ibin) + &
5998 3.*electrolyte(jna2so4,jp,ibin) + &
5999 2.*electrolyte(jnano3,jp,ibin) + &
6000 2.*electrolyte(jnacl,jp,ibin) + &
6001 3.*electrolyte(jcano3,jp,ibin) + &
6002 3.*electrolyte(jcacl2,jp,ibin) + &
6003 2.*electrolyte(jhno3,jp,ibin) + &
6004 2.*electrolyte(jhcl,jp,ibin)
6005
6006 if(sum_elec .eq. 0.0)then
6007 do ja = 1, nelectrolyte
6008 gam(ja,ibin) = 1.0
6009 enddo
6010 goto 10
6011 endif
6012
6013
6014 ! ionic mole fractions
6015 xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
6016 xmol(jnh4cl) = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
6017 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6018 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6019 xmol(jnano3) = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
6020 xmol(jnacl) = 2.*electrolyte(jnacl,jp,ibin) /sum_elec
6021 xmol(jcano3) = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
6022 xmol(jcacl2) = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
6023 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin) /sum_elec
6024 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin) /sum_elec
6025
6026
6027 ja = jnh4so4
6028 if(xmol(ja).gt.0.0)then
6029 log_gam(ja) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6030 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6031 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6032 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6033 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6034 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6035 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6036 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6037 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6038 xmol(jhcl) *log_gamZ(jA,jhcl)
6039 gam(jA,ibin) = 10.**log_gam(jA)
6040 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6041 gam(jnh4so4,ibin)**3
6042 endif
6043
6044
6045
6046 jA = jnh4no3
6047 if(xmol(jA).gt.0.0)then
6048 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6049 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6050 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6051 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6052 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6053 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6054 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6055 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6056 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6057 xmol(jhcl) *log_gamZ(jA,jhcl)
6058 gam(jA,ibin) = 10.**log_gam(jA)
6059 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
6060 gam(jnh4no3,ibin)**2
6061 endif
6062
6063
6064 jA = jnh4cl
6065 if(xmol(jA).gt.0.0)then
6066 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6067 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6068 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6069 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6070 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6071 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6072 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6073 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6074 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6075 xmol(jhcl) *log_gamZ(jA,jhcl)
6076 gam(jA,ibin) = 10.**log_gam(jA)
6077 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin)* &
6078 gam(jnh4cl,ibin)**2
6079 endif
6080
6081
6082 jA = jna2so4
6083 if(xmol(jA).gt.0.0)then
6084 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6085 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6086 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6087 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6088 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6089 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6090 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6091 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6092 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6093 xmol(jhcl) *log_gamZ(jA,jhcl)
6094 gam(jA,ibin) = 10.**log_gam(jA)
6095 activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6096 gam(jna2so4,ibin)**3
6097 endif
6098
6099
6100 jA = jnano3
6101 if(xmol(jA).gt.0.0)then
6102 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6103 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6104 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6105 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6106 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6107 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6108 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6109 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6110 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6111 xmol(jhcl) *log_gamZ(jA,jhcl)
6112 gam(jA,ibin) = 10.**log_gam(jA)
6113 activity(jnano3,ibin) = mc(jc_na,ibin)*ma(ja_no3,ibin)* &
6114 gam(jnano3,ibin)**2
6115 endif
6116
6117
6118
6119 jA = jnacl
6120 if(xmol(jA).gt.0.0)then
6121 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6122 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6123 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6124 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6125 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6126 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6127 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6128 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6129 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6130 xmol(jhcl) *log_gamZ(jA,jhcl)
6131 gam(jA,ibin) = 10.**log_gam(jA)
6132 activity(jnacl,ibin) = mc(jc_na,ibin)*ma(ja_cl,ibin)* &
6133 gam(jnacl,ibin)**2
6134 endif
6135
6136
6137
6138 ! jA = jcano3
6139 ! if(xmol(jA).gt.0.0)then
6140 ! gam(jA,ibin) = 1.0
6141 ! activity(jcano3,ibin) = 1.0
6142 ! endif
6143
6144
6145
6146 ! jA = jcacl2
6147 ! if(xmol(jA).gt.0.0)then
6148 ! gam(jA,ibin) = 1.0
6149 ! activity(jcacl2,ibin) = 1.0
6150 ! endif
6151
6152 jA = jcano3
6153 if(xmol(jA).gt.0.0)then
6154 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6155 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6156 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6157 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6158 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6159 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6160 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6161 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6162 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6163 xmol(jhcl) *log_gamZ(jA,jhcl)
6164 gam(jA,ibin) = 10.**log_gam(jA)
6165 activity(jcano3,ibin) = mc(jc_ca,ibin)*ma(ja_no3,ibin)**2* &
6166 gam(jcano3,ibin)**3
6167 endif
6168
6169
6170
6171 jA = jcacl2
6172 if(xmol(jA).gt.0.0)then
6173 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6174 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6175 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6176 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6177 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6178 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6179 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6180 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6181 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6182 xmol(jhcl) *log_gamZ(jA,jhcl)
6183 gam(jA,ibin) = 10.**log_gam(jA)
6184 activity(jcacl2,ibin) = mc(jc_ca,ibin)*ma(ja_cl,ibin)**2* &
6185 gam(jcacl2,ibin)**3
6186 endif
6187
6188
6189 jA = jhno3
6190 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6191 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6192 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6193 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6194 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6195 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6196 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6197 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6198 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6199 xmol(jhcl) *log_gamZ(jA,jhcl)
6200 gam(jA,ibin) = 10.**log_gam(jA)
6201 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6202 gam(jhno3,ibin)**2
6203
6204
6205 jA = jhcl
6206 log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) + &
6207 xmol(jnh4cl) *log_gamZ(jA,jnh4cl) + &
6208 xmol(jnh4so4)*log_gamZ(jA,jnh4so4) + &
6209 xmol(jna2so4)*log_gamZ(jA,jna2so4) + &
6210 xmol(jnano3) *log_gamZ(jA,jnano3) + &
6211 xmol(jnacl) *log_gamZ(jA,jnacl) + &
6212 xmol(jcano3) *log_gamZ(jA,jcano3) + &
6213 xmol(jcacl2) *log_gamZ(jA,jcacl2) + &
6214 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6215 xmol(jhcl) *log_gamZ(jA,jhcl)
6216 gam(jA,ibin) = 10.**log_gam(jA)
6217 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6218 gam(jhcl,ibin)**2
6219
6220 !----
6221 10 gam(jlvcite,ibin) = 1.0
6222
6223 gam(jnh4hso4,ibin)= 1.0
6224
6225 gam(jnh4msa,ibin) = 1.0
6226
6227 gam(jna3hso4,ibin) = 1.0
6228
6229 gam(jnahso4,ibin) = 1.0
6230
6231 gam(jnamsa,ibin) = 1.0
6232
6233 gam(jcamsa2,ibin) = 1.0 ! raz-30apr07
6234
6235 activity(jlvcite,ibin) = 0.0
6236
6237 activity(jnh4hso4,ibin)= 0.0
6238
6239 activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6240 gam(jnh4msa,ibin)**2
6241
6242 activity(jna3hso4,ibin)= 0.0
6243
6244 activity(jnahso4,ibin) = 0.0
6245
6246 activity(jnamsa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* & ! raz-30apr07
6247 gam(jnamsa,ibin)**2
6248
6249 activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * & ! raz-30apr07
6250 gam(jcamsa2,ibin)**3
6251
6252 gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
6253
6254
6255 else
6256 ! SULFATE-RICH: solve for SO4= and HSO4- ions
6257
6258 jp = jliquid
6259
6260 sum_elec = 3.*electrolyte(jh2so4,jp,ibin) + &
6261 2.*electrolyte(jnh4hso4,jp,ibin) + &
6262 5.*electrolyte(jlvcite,jp,ibin) + &
6263 3.*electrolyte(jnh4so4,jp,ibin) + &
6264 2.*electrolyte(jnahso4,jp,ibin) + &
6265 5.*electrolyte(jna3hso4,jp,ibin) + &
6266 3.*electrolyte(jna2so4,jp,ibin) + &
6267 2.*electrolyte(jhno3,jp,ibin) + &
6268 2.*electrolyte(jhcl,jp,ibin)
6269
6270
6271 if(sum_elec .eq. 0.0)then
6272 do jA = 1, nelectrolyte
6273 gam(jA,ibin) = 1.0
6274 enddo
6275 goto 20
6276 endif
6277
6278
6279 xmol(jh2so4) = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
6280 xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
6281 xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
6282 xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6283 xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
6284 xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
6285 xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6286 xmol(jhno3) = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
6287 xmol(jhcl) = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
6288
6289
6290 ! 2H.SO4
6291 jA = jh2so4
6292 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6293 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6294 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6295 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6296 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6297 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6298 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6299 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6300 xmol(jhcl) *log_gamZ(jA,jhcl)
6301 gam(jA,ibin) = 10.**log_gam(jA)
6302
6303
6304 ! H.HSO4
6305 jA = jhhso4
6306 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6307 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6308 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6309 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6310 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6311 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6312 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6313 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6314 xmol(jhcl) *log_gamZ(jA,jhcl)
6315 gam(jA,ibin) = 10.**log_gam(jA)
6316
6317
6318 ! NH4HSO4
6319 jA = jnh4hso4
6320 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6321 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6322 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6323 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6324 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6325 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6326 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6327 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6328 xmol(jhcl) *log_gamZ(jA,jhcl)
6329 gam(jA,ibin) = 10.**log_gam(jA)
6330
6331
6332 ! LETOVICITE
6333 jA = jlvcite
6334 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6335 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6336 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6337 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6338 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6339 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6340 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6341 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6342 xmol(jhcl) *log_gamZ(jA,jhcl)
6343 gam(jA,ibin) = 10.**log_gam(jA)
6344
6345
6346 ! (NH4)2SO4
6347 jA = jnh4so4
6348 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6349 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6350 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6351 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6352 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6353 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6354 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6355 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6356 xmol(jhcl) *log_gamZ(jA,jhcl)
6357 gam(jA,ibin) = 10.**log_gam(jA)
6358
6359
6360 ! NaHSO4
6361 jA = jnahso4
6362 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6363 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6364 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6365 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6366 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6367 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6368 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6369 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6370 xmol(jhcl) *log_gamZ(jA,jhcl)
6371 gam(jA,ibin) = 10.**log_gam(jA)
6372
6373
6374 ! Na3H(SO4)2
6375 jA = jna3hso4
6376 ! log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6377 ! xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6378 ! xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6379 ! xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6380 ! xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6381 ! xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6382 ! xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6383 ! xmol(jhno3) *log_gamZ(jA,jhno3) + &
6384 ! xmol(jhcl) *log_gamZ(jA,jhcl)
6385 ! gam(jA,ibin) = 10.**log_gam(jA)
6386 gam(jA,ibin) = 1.0
6387
6388
6389 ! Na2SO4
6390 jA = jna2so4
6391 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6392 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6393 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6394 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6395 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6396 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6397 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6398 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6399 xmol(jhcl) *log_gamZ(jA,jhcl)
6400 gam(jA,ibin) = 10.**log_gam(jA)
6401
6402
6403 ! HNO3
6404 jA = jhno3
6405 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6406 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6407 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6408 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6409 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6410 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6411 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6412 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6413 xmol(jhcl) *log_gamZ(jA,jhcl)
6414 gam(jA,ibin) = 10.**log_gam(jA)
6415
6416
6417 ! HCl
6418 jA = jhcl
6419 log_gam(jA) = xmol(jh2so4) *log_gamZ(jA,jh2so4) + &
6420 xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+ &
6421 xmol(jlvcite) *log_gamZ(jA,jlvcite) + &
6422 xmol(jnh4so4) *log_gamZ(jA,jnh4so4) + &
6423 xmol(jnahso4) *log_gamZ(jA,jnahso4) + &
6424 xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+ &
6425 xmol(jna2so4) *log_gamZ(jA,jna2so4) + &
6426 xmol(jhno3) *log_gamZ(jA,jhno3) + &
6427 xmol(jhcl) *log_gamZ(jA,jhcl)
6428 gam(jA,ibin) = 10.**log_gam(jA)
6429
6430
6431 20 gam(jnh4no3,ibin) = 1.0
6432 gam(jnh4cl,ibin) = 1.0
6433 gam(jnano3,ibin) = 1.0
6434 gam(jnacl,ibin) = 1.0
6435 gam(jcano3,ibin) = 1.0
6436 gam(jcacl2,ibin) = 1.0
6437
6438 gam(jnh4msa,ibin) = 1.0
6439 gam(jnamsa,ibin) = 1.0
6440 gam(jcamsa2,ibin) = 1.0 ! raz-30apr07
6441
6442
6443 ! compute equilibrium pH
6444 ! cation molalities (mol/kg water)
6445 mc(jc_ca,ibin) = 0.0 ! aqueous ca never exists in sulfate rich cases
6446 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
6447 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
6448
6449 ! anion molalities (mol/kg water)
6450 mSULF = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
6451 ma(ja_hso4,ibin) = 0.0
6452 ma(ja_so4,ibin) = 0.0
6453 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
6454 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
6455 ma(ja_msa,ibin) = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
6456
6457 gam_ratio(ibin) = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
6458 dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
6459
6460 c_bal = mc(jc_nh4,ibin) + mc(jc_na,ibin) + 2.*mc(jc_ca,ibin) & ! raz-30apr07
6461 - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
6462
6463 aq = 1.0
6464 bq = dumK + c_bal
6465 cq = dumK*(c_bal - mSULF)
6466
6467
6468 !--quadratic solution
6469 if(bq .ne. 0.0)then
6470 xq = 4.*(1./bq)*(cq/bq)
6471 else
6472 xq = 1.e+6
6473 endif
6474
6475 if(abs(xq) .lt. 1.e-6)then
6476 dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
6477 quad = (-0.5*bq/aq)*dum
6478 if(quad .lt. 0.)then
6479 quad = -bq/aq - quad
6480 endif
6481 else
6482 quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
6483 endif
6484 !--end of quadratic solution
6485
6486 mc(jc_h,ibin) = max(quad, 1.D-7)
6487 ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
6488 ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
6489
6490
6491 activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * & ! raz-30apr07
6492 gam(jcamsa2,ibin)**3
6493
6494 activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6495 gam(jnh4so4,ibin)**3
6496
6497 activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3*ma(ja_hso4,ibin)* &
6498 ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
6499
6500 activity(jnh4hso4,ibin)= mc(jc_nh4,ibin)*ma(ja_hso4,ibin)* &
6501 gam(jnh4hso4,ibin)**2
6502
6503 activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6504 gam(jnh4msa,ibin)**2
6505
6506 activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6507 gam(jna2so4,ibin)**3
6508
6509 activity(jnahso4,ibin) = mc(jc_na,ibin)*ma(ja_hso4,ibin)* &
6510 gam(jnahso4,ibin)**2
6511
6512 activity(jnamsa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
6513 gam(jnamsa,ibin)**2
6514
6515 ! activity(jna3hso4,ibin)= mc(jc_na,ibin)**3*ma(ja_hso4,ibin)* &
6516 ! ma(ja_so4,ibin)*gam(jna3hso4,ibin)**5
6517
6518 activity(jna3hso4,ibin)= 0.0
6519
6520 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6521 gam(jhno3,ibin)**2
6522
6523 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6524 gam(jhcl,ibin)**2
6525
6526 activity(jmsa,ibin) = mc(jc_h,ibin)*ma(ja_msa,ibin)* &
6527 gam(jmsa,ibin)**2
6528
6529
6530 ! sulfate-poor species
6531 activity(jnh4no3,ibin) = 0.0
6532
6533 activity(jnh4cl,ibin) = 0.0
6534
6535 activity(jnano3,ibin) = 0.0
6536
6537 activity(jnacl,ibin) = 0.0
6538
6539 activity(jcano3,ibin) = 0.0
6540
6541 activity(jcacl2,ibin) = 0.0
6542
6543
6544 endif
6545
6546
6547
6548
6549 return
6550 end subroutine compute_activities
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563 !***********************************************************************
6564 ! computes mtem ternary parameters only once per transport time-step
6565 ! for a given ah2o (= rh)
6566 !
6567 ! author: rahul a. zaveri
6568 ! update: jan 2005
6569 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
6570 ! a new method for multicomponent activity coefficients of electrolytes
6571 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
6572 !-----------------------------------------------------------------------
6573 subroutine mtem_compute_log_gamz
6574 ! implicit none
6575 ! include 'mosaic.h'
6576 ! local variables
6577 integer ja
6578 ! functions
6579 ! real(kind=8) fnlog_gamz, bin_molality
6580
6581
6582 ! sulfate-poor species
6583 ja = jhno3
6584 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6585 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6586 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6587 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6588 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6589 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6590 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6591 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6592 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6593 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6594 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6595 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6596 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6597 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6598 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6599
6600
6601 ja = jhcl
6602 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6603 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6604 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6605 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6606 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6607 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6608 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6609 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6610 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6611 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6612 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6613 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6614 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6615 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6616 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6617
6618
6619 ja = jnh4so4
6620 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6621 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6622 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6623 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6624 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6625 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6626 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6627 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6628 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6629 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6630 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6631 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6632 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6633 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6634 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6635
6636
6637 ja = jnh4no3
6638 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6639 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6640 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6641 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6642 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6643 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6644 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6645 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6646 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6647 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6648
6649
6650 ja = jnh4cl
6651 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6652 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6653 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6654 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6655 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6656 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6657 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6658 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6659 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6660 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6661
6662
6663 ja = jna2so4
6664 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6665 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6666 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6667 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6668 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6669 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6670 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6671 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6672 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6673 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6674 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6675 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6676 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6677 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6678 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6679
6680
6681 ja = jnano3
6682 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6683 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6684 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6685 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6686 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6687 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6688 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6689 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6690 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6691 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6692
6693
6694 ja = jnacl
6695 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6696 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6697 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6698 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6699 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6700 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6701 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6702 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6703 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6704 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6705
6706
6707 ja = jcano3
6708 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6709 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6710 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6711 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6712 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6713 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6714 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6715 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6716 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6717 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6718
6719
6720 ja = jcacl2
6721 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6722 log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6723 log_gamz(ja,jnh4cl) = fnlog_gamz(ja,jnh4cl)
6724 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6725 log_gamz(ja,jnano3) = fnlog_gamz(ja,jnano3)
6726 log_gamz(ja,jnacl) = fnlog_gamz(ja,jnacl)
6727 log_gamz(ja,jcano3) = fnlog_gamz(ja,jcano3)
6728 log_gamz(ja,jcacl2) = fnlog_gamz(ja,jcacl2)
6729 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6730 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6731
6732
6733 ! sulfate-rich species
6734 ja = jh2so4
6735 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6736 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6737 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6738 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6739 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6740 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6741 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6742 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6743 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6744
6745
6746 ja = jhhso4
6747 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6748 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6749 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6750 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6751 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6752 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6753 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6754 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6755 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6756
6757
6758 ja = jnh4hso4
6759 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6760 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6761 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6762 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6763 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6764 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6765 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6766 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6767 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6768
6769
6770 ja = jlvcite
6771 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6772 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6773 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6774 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6775 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6776 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6777 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6778 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6779 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6780
6781
6782 ja = jnahso4
6783 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6784 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6785 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6786 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6787 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6788 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6789 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6790 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6791 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6792
6793
6794 ja = jna3hso4
6795 log_gamz(ja,jh2so4) = fnlog_gamz(ja,jh2so4)
6796 log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6797 log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6798 log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6799 log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6800 log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6801 log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6802 log_gamz(ja,jhno3) = fnlog_gamz(ja,jhno3)
6803 log_gamz(ja,jhcl) = fnlog_gamz(ja,jhcl)
6804
6805 return
6806 end subroutine mtem_compute_log_gamz
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835 !***********************************************************************
6836 ! computes sulfate ratio
6837 !
6838 ! author: rahul a. zaveri
6839 ! update: dec 1999
6840 !-----------------------------------------------------------------------
6841 subroutine calculate_xt(ibin,jp,xt)
6842 ! implicit none
6843 ! include 'mosaic.h'
6844 ! subr arguments
6845 integer ibin, jp
6846 real(kind=8) xt
6847
6848
6849 if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
6850 xt = ( aer(inh4_a,jp,ibin) + &
6851 & aer(ina_a,jp,ibin) + &
6852 & 2.*aer(ica_a,jp,ibin) )/ &
6853 & (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
6854 else
6855 xt = -1.0
6856 endif
6857
6858
6859 return
6860 end subroutine calculate_xt
6861
6862
6863
6864
6865
6866 !***********************************************************************
6867 ! computes ions from electrolytes
6868 !
6869 ! author: rahul a. zaveri
6870 ! update: jan 2005
6871 !-----------------------------------------------------------------------
6872 subroutine electrolytes_to_ions(jp,ibin)
6873 ! implicit none
6874 ! include 'mosaic.h'
6875 ! subr arguments
6876 integer jp, ibin
6877 ! local variables
6878 real(kind=8) sum_dum
6879
6880
6881 aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
6882 electrolyte(jna2so4,jp,ibin) + &
6883 2.*electrolyte(jna3hso4,jp,ibin)+ &
6884 electrolyte(jnahso4,jp,ibin) + &
6885 electrolyte(jnh4so4,jp,ibin) + &
6886 2.*electrolyte(jlvcite,jp,ibin) + &
6887 electrolyte(jnh4hso4,jp,ibin)+ &
6888 electrolyte(jh2so4,jp,ibin)
6889
6890 aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
6891 2.*electrolyte(jcano3,jp,ibin) + &
6892 electrolyte(jnh4no3,jp,ibin) + &
6893 electrolyte(jhno3,jp,ibin)
6894
6895 aer(icl_a,jp,ibin) = electrolyte(jnacl,jp,ibin) + &
6896 2.*electrolyte(jcacl2,jp,ibin) + &
6897 electrolyte(jnh4cl,jp,ibin) + &
6898 electrolyte(jhcl,jp,ibin)
6899
6900 aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) + &
6901 electrolyte(jnamsa,jp,ibin) + &
6902 2.*electrolyte(jcamsa2,jp,ibin) + &
6903 electrolyte(jmsa,jp,ibin)
6904
6905 aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
6906
6907 aer(ica_a,jp,ibin) = electrolyte(jcaso4,jp,ibin) + &
6908 electrolyte(jcano3,jp,ibin) + &
6909 electrolyte(jcacl2,jp,ibin) + &
6910 electrolyte(jcaco3,jp,ibin) + &
6911 electrolyte(jcamsa2,jp,ibin)
6912
6913 aer(ina_a,jp,ibin) = electrolyte(jnano3,jp,ibin) + &
6914 electrolyte(jnacl,jp,ibin) + &
6915 2.*electrolyte(jna2so4,jp,ibin) + &
6916 3.*electrolyte(jna3hso4,jp,ibin)+ &
6917 electrolyte(jnahso4,jp,ibin) + &
6918 electrolyte(jnamsa,jp,ibin)
6919
6920 aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) + &
6921 electrolyte(jnh4cl,jp,ibin) + &
6922 2.*electrolyte(jnh4so4,jp,ibin) + &
6923 3.*electrolyte(jlvcite,jp,ibin) + &
6924 electrolyte(jnh4hso4,jp,ibin)+ &
6925 electrolyte(jnh4msa,jp,ibin)
6926
6927
6928 sum_dum = aer(ica_a,jp,ibin) + &
6929 aer(ina_a,jp,ibin) + &
6930 aer(inh4_a,jp,ibin)+ &
6931 aer(iso4_a,jp,ibin)+ &
6932 aer(ino3_a,jp,ibin)+ &
6933 aer(icl_a,jp,ibin) + &
6934 aer(imsa_a,jp,ibin)+ &
6935 aer(ico3_a,jp,ibin)
6936
6937 if(sum_dum .eq. 0.)sum_dum = 1.0
6938 aer_sum(jp,ibin) = sum_dum
6939
6940 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
6941 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
6942 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
6943 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
6944 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
6945 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
6946 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
6947 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
6948
6949
6950 return
6951 end subroutine electrolytes_to_ions
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962 !***********************************************************************
6963 ! combinatorial method for computing electrolytes from ions
6964 !
6965 ! notes:
6966 ! - to be used for liquid-phase or total-phase only
6967 ! - transfers caso4 and caco3 from liquid to solid phase
6968 !
6969 ! author: rahul a. zaveri (based on code provided by a.s. wexler
6970 ! update: apr 2005
6971 !-----------------------------------------------------------------------
6972 subroutine ions_to_electrolytes(jp,ibin,xt)
6973 ! implicit none
6974 ! include 'mosaic.h'
6975 ! subr arguments
6976 integer ibin, jp
6977 real(kind=8) xt
6978 ! local variables
6979 integer iaer, je, jc, ja, icase
6980 real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4, &
6981 f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
6982 real(kind=8) nc(ncation), na(nanion)
6983
6984
6985
6986
6987 if(jp .ne. jliquid)then
6988 if (iprint_mosaic_fe1 .gt. 0) then
6989 write(6,*)' jp must be jliquid'
6990 write(6,*)' in ions_to_electrolytes sub'
6991 write(6,*)' wrong jp = ', jp
6992 write(6,*)' mosaic fatal error in ions_to_electrolytes'
6993 endif
6994 ! stop
6995 istat_mosaic_fe1 = -2000
6996 return
6997 endif
6998
6999 ! remove negative concentrations, if any
7000 do iaer = 1, naer
7001 aer(iaer,jp,ibin) = max(0.0D0, aer(iaer,jp,ibin))
7002 enddo
7003
7004
7005 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
7006 store(ica_a) = aer(ica_a, jp,ibin)
7007 store(iso4_a) = aer(iso4_a,jp,ibin)
7008
7009 call form_caso4(store,jp,ibin)
7010
7011 if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
7012 aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) - &
7013 electrolyte(jcaso4,jliquid,ibin)
7014
7015 aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)- &
7016 electrolyte(jcaso4,jliquid,ibin)
7017
7018 aer(ica_a,jsolid,ibin) = aer(ica_a,jsolid,ibin) + &
7019 electrolyte(jcaso4,jliquid,ibin)
7020
7021 aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) + &
7022 electrolyte(jcaso4,jliquid,ibin)
7023
7024 electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
7025 +electrolyte(jcaso4,jliquid,ibin)
7026 electrolyte(jcaso4,jliquid,ibin)= 0.0
7027 endif
7028
7029
7030 ! calculate sulfate ratio
7031 call calculate_xt(ibin,jp,xt)
7032
7033 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7034 icase = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7035 else
7036 icase = 2 ! acidic (acidity is caused by excess so4)
7037 endif
7038
7039
7040 ! initialize to zero
7041 do je = 1, nelectrolyte
7042 electrolyte(je,jp,ibin) = 0.0
7043 enddo
7044 !
7045 !---------------------------------------------------------
7046 ! initialize moles of ions depending on the sulfate domain
7047
7048 if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
7049
7050 na(ja_hso4)= 0.0
7051 na(ja_so4) = aer(iso4_a,jp,ibin)
7052 na(ja_no3) = aer(ino3_a,jp,ibin)
7053 na(ja_cl) = aer(icl_a, jp,ibin)
7054 na(ja_msa) = aer(imsa_a,jp,ibin)
7055
7056 nc(jc_ca) = aer(ica_a, jp,ibin)
7057 nc(jc_na) = aer(ina_a, jp,ibin)
7058 nc(jc_nh4) = aer(inh4_a,jp,ibin)
7059
7060 cat_net =&
7061 ( 2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) )- &
7062 ( 2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
7063
7064 if(cat_net .lt. 0.0)then
7065
7066 nc(jc_h) = 0.0
7067
7068 else ! cat_net must be 0.0 or positive
7069
7070 nc(jc_h) = cat_net
7071
7072 endif
7073
7074
7075 ! now compute equivalent fractions
7076 sum_naza = 0.0
7077 do ja = 1, nanion
7078 sum_naza = sum_naza + na(ja)*za(ja)
7079 enddo
7080
7081 sum_nczc = 0.0
7082 do jc = 1, ncation
7083 sum_nczc = sum_nczc + nc(jc)*zc(jc)
7084 enddo
7085
7086 if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
7087 if (iprint_mosaic_diag1 .gt. 0) then
7088 write(6,*)'mosaic ions_to_electrolytes'
7089 write(6,*)'ionic concentrations are zero'
7090 write(6,*)'sum_naza = ', sum_naza
7091 write(6,*)'sum_nczc = ', sum_nczc
7092 endif
7093 return
7094 endif
7095
7096 do ja = 1, nanion
7097 xeq_a(ja) = na(ja)*za(ja)/sum_naza
7098 enddo
7099
7100 do jc = 1, ncation
7101 xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
7102 enddo
7103
7104 na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
7105 na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
7106 na_ma(ja_cl) = na(ja_cl) *mw_a(ja_cl)
7107 na_ma(ja_msa) = na(ja_msa) *mw_a(ja_msa)
7108 na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
7109
7110 nc_mc(jc_ca) = nc(jc_ca) *mw_c(jc_ca)
7111 nc_mc(jc_na) = nc(jc_na) *mw_c(jc_na)
7112 nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
7113 nc_mc(jc_h) = nc(jc_h) *mw_c(jc_h)
7114
7115
7116 ! now compute electrolyte moles
7117 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7118 electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
7119 xeq_a(ja_so4)*nc_mc(jc_na))/ &
7120 mw_electrolyte(jna2so4)
7121 endif
7122
7123 electrolyte(jnahso4,jp,ibin) = 0.0
7124
7125 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7126 electrolyte(jnamsa,jp,ibin) = (xeq_c(jc_na) *na_Ma(ja_msa) + &
7127 xeq_a(ja_msa)*nc_Mc(jc_na))/ &
7128 mw_electrolyte(jnamsa)
7129 endif
7130
7131 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7132 electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
7133 xeq_a(ja_no3)*nc_mc(jc_na))/ &
7134 mw_electrolyte(jnano3)
7135 endif
7136
7137 if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7138 electrolyte(jnacl, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) + &
7139 xeq_a(ja_cl) *nc_mc(jc_na))/ &
7140 mw_electrolyte(jnacl)
7141 endif
7142
7143 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7144 electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
7145 xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
7146 mw_electrolyte(jnh4so4)
7147 endif
7148
7149 electrolyte(jnh4hso4,jp,ibin)= 0.0
7150
7151 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7152 electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) + &
7153 xeq_a(ja_msa)*nc_Mc(jc_nh4))/ &
7154 mw_electrolyte(jnh4msa)
7155 endif
7156
7157 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7158 electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
7159 xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
7160 mw_electrolyte(jnh4no3)
7161 endif
7162
7163 if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7164 electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) + &
7165 xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
7166 mw_electrolyte(jnh4cl)
7167 endif
7168
7169 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
7170 electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
7171 xeq_a(ja_no3)*nc_mc(jc_ca))/ &
7172 mw_electrolyte(jcano3)
7173 endif
7174
7175 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7176 electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) + &
7177 xeq_a(ja_cl) *nc_mc(jc_ca))/ &
7178 mw_electrolyte(jcacl2)
7179 endif
7180
7181 if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7182 electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) + &
7183 xeq_a(ja_msa) *nc_Mc(jc_ca))/ &
7184 mw_electrolyte(jcamsa2)
7185 endif
7186
7187 electrolyte(jh2so4, jp,ibin) = 0.0
7188
7189 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7190 electrolyte(jhno3, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_no3) + &
7191 xeq_a(ja_no3)*nc_mc(jc_h))/ &
7192 mw_electrolyte(jhno3)
7193 endif
7194
7195 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7196 electrolyte(jhcl, jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) + &
7197 xeq_a(ja_cl)*nc_mc(jc_h))/ &
7198 mw_electrolyte(jhcl)
7199 endif
7200
7201 if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7202 electrolyte(jmsa,jp,ibin) = (xeq_c(jc_h) *na_ma(ja_msa) + &
7203 xeq_a(ja_msa)*nc_mc(jc_h))/ &
7204 mw_electrolyte(jmsa)
7205 endif
7206
7207 !--------------------------------------------------------------------
7208
7209 elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
7210
7211 store(imsa_a) = aer(imsa_a,jp,ibin)
7212 store(ica_a) = aer(ica_a, jp,ibin)
7213
7214 call form_camsa2(store,jp,ibin)
7215
7216 sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
7217
7218 if(sum_na_nh4 .gt. 0.0)then
7219 f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
7220 f_na = aer(ina_a,jp,ibin)/sum_na_nh4
7221 else
7222 f_nh4 = 0.0
7223 f_na = 0.0
7224 endif
7225
7226 ! first form msa electrolytes
7227 if(sum_na_nh4 .gt. store(imsa_a))then
7228 electrolyte(jnamsa,jp,ibin) = f_na *store(imsa_a)
7229 electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
7230 rem_na = aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin) ! remaining na
7231 rem_nh4= aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin) ! remaining nh4
7232 else
7233 electrolyte(jnamsa,jp,ibin) = aer(ina_a,jp,ibin)
7234 electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
7235 electrolyte(jmsa,jp,ibin) = store(imsa_a) - sum_na_nh4
7236 rem_nh4 = 0.0 ! remaining nh4
7237 rem_na = 0.0 ! remaining na
7238 endif
7239
7240
7241 ! recompute xt
7242 if(aer(iso4_a,jp,ibin).gt.0.0)then
7243 xt = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
7244 else
7245 goto 10
7246 endif
7247
7248 if(xt .le. 1.0)then ! h2so4 + bisulfate
7249 xh = (1.0 - xt)
7250 xb = xt
7251 electrolyte(jh2so4,jp,ibin) = xh*aer(iso4_a,jp,ibin)
7252 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7253 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
7254 elseif(xt .le. 1.5)then ! bisulfate + letovicite
7255 xb = 3.0 - 2.0*xt
7256 xl = xt - 1.0
7257 electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7258 electrolyte(jnahso4,jp,ibin) = xb*f_na *aer(iso4_a,jp,ibin)
7259 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
7260 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7261 else ! letovicite + sulfate
7262 xl = 2.0 - xt
7263 xs = 2.0*xt - 3.0
7264 electrolyte(jlvcite,jp,ibin) = xl*f_nh4*aer(iso4_a,jp,ibin)
7265 electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7266 electrolyte(jnh4so4,jp,ibin) = xs*f_nh4*aer(iso4_a,jp,ibin)
7267 electrolyte(jna2so4,jp,ibin) = xs*f_na *aer(iso4_a,jp,ibin)
7268 endif
7269
7270 electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
7271 electrolyte(jhcl,jp,ibin) = aer(icl_a,jp,ibin)
7272
7273 endif
7274 !---------------------------------------------------------
7275 !
7276 ! calculate % composition
7277 10 sum_dum = 0.0
7278 do je = 1, nelectrolyte
7279 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7280 enddo
7281
7282 if(sum_dum .eq. 0.)sum_dum = 1.0
7283 electrolyte_sum(jp,ibin) = sum_dum
7284
7285 do je = 1, nelectrolyte
7286 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7287 enddo
7288
7289 sum_dum = aer(ica_a,jp,ibin) + &
7290 aer(ina_a,jp,ibin) + &
7291 aer(inh4_a,jp,ibin)+ &
7292 aer(iso4_a,jp,ibin)+ &
7293 aer(ino3_a,jp,ibin)+ &
7294 aer(icl_a,jp,ibin) + &
7295 aer(imsa_a,jp,ibin)+ &
7296 aer(ico3_a,jp,ibin)
7297
7298 if(sum_dum .eq. 0.)sum_dum = 1.0
7299 aer_sum(jp,ibin) = sum_dum
7300
7301 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7302 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7303 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7304 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7305 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7306 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7307 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7308 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7309
7310
7311
7312 return
7313 end subroutine ions_to_electrolytes
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341 !***********************************************************************
7342 ! conforms aerosol generic species to a valid electrolyte composition
7343 !
7344 ! author: rahul a. zaveri
7345 ! update: june 2000
7346 !-----------------------------------------------------------------------
7347 subroutine conform_electrolytes(jp,ibin,xt)
7348 ! implicit none
7349 ! include 'mosaic.h'
7350 ! subr arguments
7351 integer ibin, jp
7352 real(kind=8) xt
7353 ! local variables
7354 integer i, ixt_case, je
7355 real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7356 real(kind=8) store(naer)
7357
7358 ! remove negative concentrations, if any
7359 do i=1,naer
7360 aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7361 enddo
7362
7363
7364 call calculate_xt(ibin,jp,xt)
7365
7366 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7367 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7368 else
7369 ixt_case = 2 ! acidic (acidity is caused by excess so4)
7370 endif
7371
7372 ! initialize
7373 !
7374 ! put total aer(*) into store(*)
7375 store(iso4_a) = aer(iso4_a,jp,ibin)
7376 store(ino3_a) = aer(ino3_a,jp,ibin)
7377 store(icl_a) = aer(icl_a, jp,ibin)
7378 store(imsa_a) = aer(imsa_a,jp,ibin)
7379 store(ico3_a) = aer(ico3_a,jp,ibin)
7380 store(inh4_a) = aer(inh4_a,jp,ibin)
7381 store(ina_a) = aer(ina_a, jp,ibin)
7382 store(ica_a) = aer(ica_a, jp,ibin)
7383
7384 do je=1,nelectrolyte
7385 electrolyte(je,jp,ibin) = 0.0
7386 enddo
7387 !
7388 !---------------------------------------------------------
7389 !
7390 if(ixt_case.eq.1)then
7391
7392 ! xt >= 2 : sulfate deficient
7393
7394 call form_caso4(store,jp,ibin)
7395 call form_camsa2(store,jp,ibin)
7396 call form_na2so4(store,jp,ibin)
7397 call form_namsa(store,jp,ibin)
7398 call form_cano3(store,jp,ibin)
7399 call form_nano3(store,jp,ibin)
7400 call form_nacl(store,jp,ibin)
7401 call form_cacl2(store,jp,ibin)
7402 call form_caco3(store,jp,ibin)
7403 call form_nh4so4(store,jp,ibin)
7404 call form_nh4msa(store,jp,ibin)
7405 call form_nh4no3(store,jp,ibin)
7406 call form_nh4cl(store,jp,ibin)
7407 call form_msa(store,jp,ibin)
7408 call degas_hno3(store,jp,ibin)
7409 call degas_hcl(store,jp,ibin)
7410 call degas_nh3(store,jp,ibin)
7411
7412 elseif(ixt_case.eq.2)then
7413
7414 ! xt < 2 : sulfate enough or sulfate excess
7415
7416 call form_caso4(store,jp,ibin)
7417 call form_camsa2(store,jp,ibin)
7418 call form_namsa(store,jp,ibin)
7419 call form_nh4msa(store,jp,ibin)
7420 call form_msa(store,jp,ibin)
7421
7422 if(store(iso4_a).eq.0.0)goto 10
7423
7424
7425 xt_prime =(store(ina_a)+store(inh4_a))/ &
7426 store(iso4_a)
7427 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7428
7429 if(xt_prime.ge.xna_prime)then
7430 call form_na2so4(store,jp,ibin)
7431 xnh4_prime = 0.0
7432 if(store(iso4_a).gt.1.e-15)then
7433 xnh4_prime = store(inh4_a)/store(iso4_a)
7434 endif
7435
7436 if(xnh4_prime .ge. 1.5)then
7437 call form_nh4so4_lvcite(store,jp,ibin)
7438 else
7439 call form_lvcite_nh4hso4(store,jp,ibin)
7440 endif
7441
7442 elseif(xt_prime.ge.1.)then
7443 call form_nh4hso4(store,jp,ibin)
7444 call form_na2so4_nahso4(store,jp,ibin)
7445 elseif(xt_prime.lt.1.)then
7446 call form_nahso4(store,jp,ibin)
7447 call form_nh4hso4(store,jp,ibin)
7448 call form_h2so4(store,jp,ibin)
7449 endif
7450
7451 10 call degas_hno3(store,jp,ibin)
7452 call degas_hcl(store,jp,ibin)
7453 call degas_nh3(store,jp,ibin)
7454
7455 endif ! case 1, 2
7456
7457
7458 ! re-calculate ions to eliminate round-off errors
7459 call electrolytes_to_ions(jp, ibin)
7460 !---------------------------------------------------------
7461 !
7462 ! calculate % composition
7463 sum_dum = 0.0
7464 do je = 1, nelectrolyte
7465 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7466 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7467 enddo
7468
7469 if(sum_dum .eq. 0.)sum_dum = 1.0
7470 electrolyte_sum(jp,ibin) = sum_dum
7471
7472 do je = 1, nelectrolyte
7473 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7474 enddo
7475
7476
7477 sum_dum = aer(ica_a,jp,ibin) + &
7478 aer(ina_a,jp,ibin) + &
7479 aer(inh4_a,jp,ibin)+ &
7480 aer(iso4_a,jp,ibin)+ &
7481 aer(ino3_a,jp,ibin)+ &
7482 aer(icl_a,jp,ibin) + &
7483 aer(imsa_a,jp,ibin)+ &
7484 aer(ico3_a,jp,ibin)
7485
7486 if(sum_dum .eq. 0.)sum_dum = 1.0
7487 aer_sum(jp,ibin) = sum_dum
7488
7489 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7490 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7491 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7492 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7493 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7494 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7495 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7496 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7497
7498 return
7499 end subroutine conform_electrolytes
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511 !***********************************************************************
7512 ! forms electrolytes from ions
7513 !
7514 ! author: rahul a. zaveri
7515 ! update: june 2000
7516 !-----------------------------------------------------------------------
7517 subroutine form_electrolytes(jp,ibin,xt)
7518 ! implicit none
7519 ! include 'mosaic.h'
7520 ! subr arguments
7521 integer ibin, jp
7522 real(kind=8) xt
7523 ! local variables
7524 integer i, ixt_case, j, je
7525 real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7526 real(kind=8) store(naer)
7527
7528 ! remove negative concentrations, if any
7529 do i=1,naer
7530 aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7531 enddo
7532
7533
7534 call calculate_xt(ibin,jp,xt)
7535
7536 if(xt .ge. 1.9999 .or. xt.lt.0.)then
7537 ixt_case = 1 ! near neutral (acidity is caused by hcl and/or hno3)
7538 else
7539 ixt_case = 2 ! acidic (acidity is caused by excess so4)
7540 endif
7541
7542 ! initialize
7543 !
7544 ! put total aer(*) into store(*)
7545 store(iso4_a) = aer(iso4_a,jp,ibin)
7546 store(ino3_a) = aer(ino3_a,jp,ibin)
7547 store(icl_a) = aer(icl_a, jp,ibin)
7548 store(imsa_a) = aer(imsa_a,jp,ibin)
7549 store(ico3_a) = aer(ico3_a,jp,ibin)
7550 store(inh4_a) = aer(inh4_a,jp,ibin)
7551 store(ina_a) = aer(ina_a, jp,ibin)
7552 store(ica_a) = aer(ica_a, jp,ibin)
7553 !
7554 do j=1,nelectrolyte
7555 electrolyte(j,jp,ibin) = 0.0
7556 enddo
7557 !
7558 !---------------------------------------------------------
7559 !
7560 if(ixt_case.eq.1)then
7561
7562 ! xt >= 2 : sulfate deficient
7563 call form_caso4(store,jp,ibin)
7564 call form_camsa2(store,jp,ibin)
7565 call form_na2so4(store,jp,ibin)
7566 call form_namsa(store,jp,ibin)
7567 call form_cano3(store,jp,ibin)
7568 call form_nano3(store,jp,ibin)
7569 call form_nacl(store,jp,ibin)
7570 call form_cacl2(store,jp,ibin)
7571 call form_caco3(store,jp,ibin)
7572 call form_nh4so4(store,jp,ibin)
7573 call form_nh4msa(store,jp,ibin)
7574 call form_nh4no3(store,jp,ibin)
7575 call form_nh4cl(store,jp,ibin)
7576 call form_msa(store,jp,ibin)
7577
7578 if(jp .eq. jsolid)then
7579 call degas_hno3(store,jp,ibin)
7580 call degas_hcl(store,jp,ibin)
7581 call degas_nh3(store,jp,ibin)
7582 else
7583 call form_hno3(store,jp,ibin)
7584 call form_hcl(store,jp,ibin)
7585 call degas_nh3(store,jp,ibin)
7586 endif
7587
7588
7589
7590 elseif(ixt_case.eq.2)then
7591
7592 ! xt < 2 : sulfate enough or sulfate excess
7593
7594 call form_caso4(store,jp,ibin)
7595 call form_camsa2(store,jp,ibin)
7596 call form_namsa(store,jp,ibin)
7597 call form_nh4msa(store,jp,ibin)
7598 call form_msa(store,jp,ibin)
7599
7600 if(store(iso4_a).eq.0.0)goto 10
7601
7602
7603 xt_prime =(store(ina_a)+store(inh4_a))/ &
7604 store(iso4_a)
7605 xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7606
7607 if(xt_prime.ge.xna_prime)then
7608 call form_na2so4(store,jp,ibin)
7609 xnh4_prime = 0.0
7610 if(store(iso4_a).gt.1.e-15)then
7611 xnh4_prime = store(inh4_a)/store(iso4_a)
7612 endif
7613
7614 if(xnh4_prime .ge. 1.5)then
7615 call form_nh4so4_lvcite(store,jp,ibin)
7616 else
7617 call form_lvcite_nh4hso4(store,jp,ibin)
7618 endif
7619
7620 elseif(xt_prime.ge.1.)then
7621 call form_nh4hso4(store,jp,ibin)
7622 call form_na2so4_nahso4(store,jp,ibin)
7623 elseif(xt_prime.lt.1.)then
7624 call form_nahso4(store,jp,ibin)
7625 call form_nh4hso4(store,jp,ibin)
7626 call form_h2so4(store,jp,ibin)
7627 endif
7628
7629 10 if(jp .eq. jsolid)then
7630 call degas_hno3(store,jp,ibin)
7631 call degas_hcl(store,jp,ibin)
7632 call degas_nh3(store,jp,ibin)
7633 else
7634 call form_hno3(store,jp,ibin)
7635 call form_hcl(store,jp,ibin)
7636 call degas_nh3(store,jp,ibin)
7637 endif
7638
7639 endif ! case 1, 2
7640
7641
7642 ! re-calculate ions to eliminate round-off errors
7643 call electrolytes_to_ions(jp, ibin)
7644 !---------------------------------------------------------
7645 !
7646 ! calculate % composition
7647 sum_dum = 0.0
7648 do je = 1, nelectrolyte
7649 electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7650 sum_dum = sum_dum + electrolyte(je,jp,ibin)
7651 enddo
7652
7653 if(sum_dum .eq. 0.)sum_dum = 1.0
7654 electrolyte_sum(jp,ibin) = sum_dum
7655
7656 do je = 1, nelectrolyte
7657 epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7658 enddo
7659
7660 sum_dum = aer(ica_a,jp,ibin) + &
7661 aer(ina_a,jp,ibin) + &
7662 aer(inh4_a,jp,ibin)+ &
7663 aer(iso4_a,jp,ibin)+ &
7664 aer(ino3_a,jp,ibin)+ &
7665 aer(icl_a,jp,ibin) + &
7666 aer(imsa_a,jp,ibin)+ &
7667 aer(ico3_a,jp,ibin)
7668
7669 if(sum_dum .eq. 0.)sum_dum = 1.0
7670 aer_sum(jp,ibin) = sum_dum
7671
7672 aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7673 aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7674 aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7675 aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7676 aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7677 aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7678 aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7679 aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7680
7681 return
7682 end subroutine form_electrolytes
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697 !***********************************************************************
7698 ! electrolyte formation subroutines
7699 !
7700 ! author: rahul a. zaveri
7701 ! update: june 2000
7702 !-----------------------------------------------------------------------
7703 subroutine form_caso4(store,jp,ibin)
7704 ! implicit none
7705 ! include 'mosaic.h'
7706 ! subr arguments
7707 integer jp, ibin
7708 real(kind=8) store(naer)
7709
7710 electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
7711 store(ica_a) = store(ica_a) - electrolyte(jcaso4,jp,ibin)
7712 store(iso4_a) = store(iso4_a) - electrolyte(jcaso4,jp,ibin)
7713 store(ica_a) = max(0.D0, store(ica_a))
7714 store(iso4_a) = max(0.D0, store(iso4_a))
7715
7716 return
7717 end subroutine form_caso4
7718
7719
7720
7721 subroutine form_camsa2(store,jp,ibin)
7722 ! implicit none
7723 ! include 'mosaic.h'
7724 ! subr arguments
7725 integer jp, ibin
7726 real(kind=8) store(naer)
7727
7728 electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
7729 store(ica_a) = store(ica_a) - electrolyte(jcamsa2,jp,ibin)
7730 store(imsa_a) = store(imsa_a) - 2.d0*electrolyte(jcamsa2,jp,ibin)
7731 store(ica_a) = max(0.D0, store(ica_a))
7732 store(imsa_a) = max(0.D0, store(imsa_a))
7733
7734 return
7735 end subroutine form_camsa2
7736
7737
7738
7739 subroutine form_cano3(store,jp,ibin) ! ca(no3)2
7740 ! implicit none
7741 ! include 'mosaic.h'
7742 ! subr arguments
7743 integer jp, ibin
7744 real(kind=8) store(naer)
7745
7746 electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
7747
7748 store(ica_a) = store(ica_a) - electrolyte(jcano3,jp,ibin)
7749 store(ino3_a) = store(ino3_a) - 2.*electrolyte(jcano3,jp,ibin)
7750 store(ica_a) = max(0.D0, store(ica_a))
7751 store(ino3_a) = max(0.D0, store(ino3_a))
7752
7753 return
7754 end subroutine form_cano3
7755
7756
7757 subroutine form_cacl2(store,jp,ibin)
7758 ! implicit none
7759 ! include 'mosaic.h'
7760 ! subr arguments
7761 integer jp, ibin
7762 real(kind=8) store(naer)
7763
7764 electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
7765
7766 store(ica_a) = store(ica_a) - electrolyte(jcacl2,jp,ibin)
7767 store(icl_a) = store(icl_a) - 2.*electrolyte(jcacl2,jp,ibin)
7768 store(ica_a) = max(0.D0, store(ica_a))
7769 store(icl_a) = max(0.D0, store(icl_a))
7770
7771 return
7772 end subroutine form_cacl2
7773
7774
7775 subroutine form_caco3(store,jp,ibin)
7776 ! implicit none
7777 ! include 'mosaic.h'
7778 ! subr arguments
7779 integer jp, ibin
7780 real(kind=8) store(naer)
7781
7782 if(jp.eq.jtotal .or. jp.eq.jsolid)then
7783 electrolyte(jcaco3,jp,ibin) = store(ica_a)
7784
7785 aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin) ! force co3 = caco3
7786
7787 store(ica_a) = 0.0
7788 store(ico3_a)= 0.0
7789 endif
7790
7791 return
7792 end subroutine form_caco3
7793
7794
7795 subroutine form_na2so4(store,jp,ibin)
7796 ! implicit none
7797 ! include 'mosaic.h'
7798 ! subr arguments
7799 integer jp, ibin
7800 real(kind=8) store(naer)
7801
7802 electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a), &
7803 store(iso4_a))
7804 store(ina_a) = store(ina_a) - 2.*electrolyte(jna2so4,jp,ibin)
7805 store(iso4_a)= store(iso4_a) - electrolyte(jna2so4,jp,ibin)
7806 store(ina_a) = max(0.D0, store(ina_a))
7807 store(iso4_a)= max(0.D0, store(iso4_a))
7808
7809 return
7810 end subroutine form_na2so4
7811
7812
7813
7814 subroutine form_nahso4(store,jp,ibin)
7815 ! implicit none
7816 ! include 'mosaic.h'
7817 ! subr arguments
7818 integer jp, ibin
7819 real(kind=8) store(naer)
7820
7821 electrolyte(jnahso4,jp,ibin) = min(store(ina_a), &
7822 store(iso4_a))
7823 store(ina_a) = store(ina_a) - electrolyte(jnahso4,jp,ibin)
7824 store(iso4_a) = store(iso4_a) - electrolyte(jnahso4,jp,ibin)
7825 store(ina_a) = max(0.D0, store(ina_a))
7826 store(iso4_a) = max(0.D0, store(iso4_a))
7827
7828 return
7829 end subroutine form_nahso4
7830
7831
7832
7833 subroutine form_namsa(store,jp,ibin)
7834 ! implicit none
7835 ! include 'mosaic.h'
7836 ! subr arguments
7837 integer jp, ibin
7838 real(kind=8) store(naer)
7839
7840 electrolyte(jnamsa,jp,ibin) = min(store(ina_a), &
7841 store(imsa_a))
7842 store(ina_a) = store(ina_a) - electrolyte(jnamsa,jp,ibin)
7843 store(imsa_a) = store(imsa_a) - electrolyte(jnamsa,jp,ibin)
7844 store(ina_a) = max(0.D0, store(ina_a))
7845 store(imsa_a) = max(0.D0, store(imsa_a))
7846
7847 return
7848 end subroutine form_namsa
7849
7850
7851
7852 subroutine form_nano3(store,jp,ibin)
7853 ! implicit none
7854 ! include 'mosaic.h'
7855 ! subr arguments
7856 integer jp, ibin
7857 real(kind=8) store(naer)
7858
7859 electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
7860 store(ina_a) = store(ina_a) - electrolyte(jnano3,jp,ibin)
7861 store(ino3_a) = store(ino3_a) - electrolyte(jnano3,jp,ibin)
7862 store(ina_a) = max(0.D0, store(ina_a))
7863 store(ino3_a) = max(0.D0, store(ino3_a))
7864
7865 return
7866 end subroutine form_nano3
7867
7868
7869
7870 subroutine form_nacl(store,jp,ibin)
7871 ! implicit none
7872 ! include 'mosaic.h'
7873 ! subr arguments
7874 integer jp, ibin
7875 real(kind=8) store(naer)
7876
7877 electrolyte(jnacl,jp,ibin) = store(ina_a)
7878
7879 store(ina_a) = 0.0
7880 store(icl_a) = store(icl_a) - electrolyte(jnacl,jp,ibin)
7881
7882 if(store(icl_a) .lt. 0.)then ! cl deficit in aerosol. take some from gas
7883 aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a) ! update aer(icl_a)
7884
7885 if(jp .ne. jtotal)then
7886 aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ & ! update for jtotal
7887 aer(icl_a,jsolid,ibin)
7888 endif
7889
7890 gas(ihcl_g) = gas(ihcl_g) + store(icl_a) ! update gas(ihcl_g)
7891
7892 if(gas(ihcl_g) .lt. 0.0)then
7893 total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g) ! update total_species
7894 tot_cl_in = tot_cl_in - gas(ihcl_g) ! update tot_cl_in
7895 endif
7896
7897 gas(ihcl_g) = max(0.D0, gas(ihcl_g)) ! restrict gas(ihcl_g) to >= 0.
7898 store(icl_a) = 0. ! force store(icl_a) to 0.
7899
7900 endif
7901
7902 store(icl_a) = max(0.D0, store(icl_a))
7903
7904 return
7905 end subroutine form_nacl
7906
7907
7908
7909 subroutine form_nh4so4(store,jp,ibin) ! (nh4)2so4
7910 ! implicit none
7911 ! include 'mosaic.h'
7912 ! subr arguments
7913 integer jp, ibin
7914 real(kind=8) store(naer)
7915
7916 electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a), &
7917 store(iso4_a))
7918 store(inh4_a)= store(inh4_a) - 2.*electrolyte(jnh4so4,jp,ibin)
7919 store(iso4_a)= store(iso4_a) - electrolyte(jnh4so4,jp,ibin)
7920 store(inh4_a) = max(0.D0, store(inh4_a))
7921 store(iso4_a) = max(0.D0, store(iso4_a))
7922
7923 return
7924 end subroutine form_nh4so4
7925
7926
7927
7928 subroutine form_nh4hso4(store,jp,ibin) ! nh4hso4
7929 ! implicit none
7930 ! include 'mosaic.h'
7931 ! subr arguments
7932 integer jp, ibin
7933 real(kind=8) store(naer)
7934
7935 electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a), &
7936 store(iso4_a))
7937 store(inh4_a)= store(inh4_a) - electrolyte(jnh4hso4,jp,ibin)
7938 store(iso4_a)= store(iso4_a) - electrolyte(jnh4hso4,jp,ibin)
7939 store(inh4_a) = max(0.D0, store(inh4_a))
7940 store(iso4_a) = max(0.D0, store(iso4_a))
7941
7942 return
7943 end subroutine form_nh4hso4
7944
7945
7946
7947 subroutine form_nh4msa(store,jp,ibin)
7948 ! implicit none
7949 ! include 'mosaic.h'
7950 ! subr arguments
7951 integer jp, ibin
7952 real(kind=8) store(naer)
7953
7954 electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a), &
7955 store(imsa_a))
7956 store(inh4_a) = store(inh4_a) - electrolyte(jnh4msa,jp,ibin)
7957 store(imsa_a) = store(imsa_a) - electrolyte(jnh4msa,jp,ibin)
7958 store(inh4_a) = max(0.D0, store(inh4_a))
7959 store(imsa_a) = max(0.D0, store(imsa_a))
7960
7961 return
7962 end subroutine form_nh4msa
7963
7964
7965
7966 subroutine form_nh4cl(store,jp,ibin)
7967 ! implicit none
7968 ! include 'mosaic.h'
7969 ! subr arguments
7970 integer jp, ibin
7971 real(kind=8) store(naer)
7972
7973 electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a), &
7974 store(icl_a))
7975 store(inh4_a) = store(inh4_a) - electrolyte(jnh4cl,jp,ibin)
7976 store(icl_a) = store(icl_a) - electrolyte(jnh4cl,jp,ibin)
7977 store(inh4_a) = max(0.D0, store(inh4_a))
7978 store(icl_a) = max(0.D0, store(icl_a))
7979
7980 return
7981 end subroutine form_nh4cl
7982
7983
7984
7985 subroutine form_nh4no3(store,jp,ibin)
7986 ! implicit none
7987 ! include 'mosaic.h'
7988 ! subr arguments
7989 integer jp, ibin
7990 real(kind=8) store(naer)
7991
7992 electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a), &
7993 store(ino3_a))
7994 store(inh4_a) = store(inh4_a) - electrolyte(jnh4no3,jp,ibin)
7995 store(ino3_a) = store(ino3_a) - electrolyte(jnh4no3,jp,ibin)
7996 store(inh4_a) = max(0.D0, store(inh4_a))
7997 store(ino3_a) = max(0.D0, store(ino3_a))
7998
7999 return
8000 end subroutine form_nh4no3
8001
8002
8003
8004 subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
8005 ! implicit none
8006 ! include 'mosaic.h'
8007 ! subr arguments
8008 integer jp, ibin
8009 real(kind=8) store(naer)
8010
8011 electrolyte(jnh4so4,jp,ibin)= 2.*store(inh4_a) - 3.*store(iso4_a)
8012 electrolyte(jlvcite,jp,ibin)= 2.*store(iso4_a) - store(inh4_a)
8013 electrolyte(jnh4so4,jp,ibin)= max(0.D0, &
8014 electrolyte(jnh4so4,jp,ibin))
8015 electrolyte(jlvcite,jp,ibin)= max(0.D0, &
8016 electrolyte(jlvcite,jp,ibin))
8017 store(inh4_a) = 0.
8018 store(iso4_a) = 0.
8019
8020 return
8021 end subroutine form_nh4so4_lvcite
8022
8023
8024
8025 subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
8026 ! implicit none
8027 ! include 'mosaic.h'
8028 ! subr arguments
8029 integer jp, ibin
8030 real(kind=8) store(naer)
8031
8032 electrolyte(jlvcite,jp,ibin) = store(inh4_a) - store(iso4_a)
8033 electrolyte(jnh4hso4,jp,ibin)= 3.*store(iso4_a) - 2.*store(inh4_a)
8034 electrolyte(jlvcite,jp,ibin) = max(0.D0, &
8035 electrolyte(jlvcite,jp,ibin))
8036 electrolyte(jnh4hso4,jp,ibin)= max(0.D0, &
8037 electrolyte(jnh4hso4,jp,ibin))
8038 store(inh4_a) = 0.
8039 store(iso4_a) = 0.
8040
8041 return
8042 end subroutine form_lvcite_nh4hso4
8043
8044
8045
8046 subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
8047 ! implicit none
8048 ! include 'mosaic.h'
8049 ! subr arguments
8050 integer jp, ibin
8051 real(kind=8) store(naer)
8052
8053 electrolyte(jna2so4,jp,ibin)= store(ina_a) - store(iso4_a)
8054 electrolyte(jnahso4,jp,ibin)= 2.*store(iso4_a) - store(ina_a)
8055 electrolyte(jna2so4,jp,ibin)= max(0.D0, &
8056 electrolyte(jna2so4,jp,ibin))
8057 electrolyte(jnahso4,jp,ibin)= max(0.D0, &
8058 electrolyte(jnahso4,jp,ibin))
8059 store(ina_a) = 0.
8060 store(iso4_a) = 0.
8061
8062 ! write(6,*)'na2so4 + nahso4'
8063
8064 return
8065 end subroutine form_na2so4_nahso4
8066
8067
8068
8069
8070 subroutine form_h2so4(store,jp,ibin)
8071 ! implicit none
8072 ! include 'mosaic.h'
8073 ! subr arguments
8074 integer jp, ibin
8075 real(kind=8) store(naer)
8076
8077 electrolyte(jh2so4,jp,ibin) = max(0.0D0, store(iso4_a))
8078 store(iso4_a) = 0.0
8079
8080 return
8081 end subroutine form_h2so4
8082
8083
8084
8085
8086 subroutine form_msa(store,jp,ibin)
8087 ! implicit none
8088 ! include 'mosaic.h'
8089 ! subr arguments
8090 integer jp, ibin
8091 real(kind=8) store(naer)
8092
8093 electrolyte(jmsa,jp,ibin) = max(0.0D0, store(imsa_a))
8094 store(imsa_a) = 0.0
8095
8096 return
8097 end subroutine form_msa
8098
8099
8100
8101 subroutine form_hno3(store,jp,ibin)
8102 ! implicit none
8103 ! include 'mosaic.h'
8104 ! subr arguments
8105 integer jp, ibin
8106 real(kind=8) store(naer)
8107
8108 electrolyte(jhno3,jp,ibin) = max(0.0D0, store(ino3_a))
8109 store(ino3_a) = 0.0
8110
8111 return
8112 end subroutine form_hno3
8113
8114
8115
8116
8117 subroutine form_hcl(store,jp,ibin)
8118 ! implicit none
8119 ! include 'mosaic.h'
8120 ! subr arguments
8121 integer jp, ibin
8122 real(kind=8) store(naer)
8123
8124 electrolyte(jhcl,jp,ibin) = max(0.0D0, store(icl_a))
8125 store(icl_a) = 0.0
8126
8127 return
8128 end subroutine form_hcl
8129
8130
8131
8132
8133 subroutine degas_hno3(store,jp,ibin)
8134 ! implicit none
8135 ! include 'mosaic.h'
8136 ! subr arguments
8137 integer jp, ibin
8138 real(kind=8) store(naer)
8139
8140 store(ino3_a) = max(0.0D0, store(ino3_a))
8141 gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
8142 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - store(ino3_a)
8143 aer(ino3_a,jp,ibin) = max(0.0D0,aer(ino3_a,jp,ibin))
8144
8145 ! also do it for jtotal
8146 if(jp .ne. jtotal)then
8147 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) + &
8148 aer(ino3_a,jliquid,ibin)
8149 endif
8150
8151 electrolyte(jhno3,jp,ibin) = 0.0
8152 store(ino3_a) = 0.0
8153
8154 return
8155 end subroutine degas_hno3
8156
8157
8158
8159 subroutine degas_hcl(store,jp,ibin)
8160 ! implicit none
8161 ! include 'mosaic.h'
8162 ! subr arguments
8163 integer jp, ibin
8164 real(kind=8) store(naer)
8165
8166 store(icl_a) = max(0.0D0, store(icl_a))
8167 gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
8168 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - store(icl_a)
8169 aer(icl_a,jp,ibin) = max(0.0D0,aer(icl_a,jp,ibin))
8170
8171 ! also do it for jtotal
8172 if(jp .ne. jtotal)then
8173 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) + &
8174 aer(icl_a,jliquid,ibin)
8175 endif
8176
8177 electrolyte(jhcl,jp,ibin) = 0.0
8178 store(icl_a) = 0.0
8179
8180 return
8181 end subroutine degas_hcl
8182
8183
8184
8185 subroutine degas_nh3(store,jp,ibin)
8186 ! implicit none
8187 ! include 'mosaic.h'
8188 ! subr arguments
8189 integer jp, ibin
8190 real(kind=8) store(naer)
8191
8192 store(inh4_a) = max(0.0D0, store(inh4_a))
8193 gas(inh3_g) = gas(inh3_g) + store(inh4_a)
8194 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - store(inh4_a)
8195 aer(inh4_a,jp,ibin) = max(0.0D0,aer(inh4_a,jp,ibin))
8196
8197 ! also do it for jtotal
8198 if(jp .ne. jtotal)then
8199 aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) + &
8200 aer(inh4_a,jliquid,ibin)
8201 endif
8202
8203 store(inh4_a) = 0.0
8204
8205 return
8206 end subroutine degas_nh3
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216 subroutine degas_acids(jp,ibin,xt)
8217 ! implicit none
8218 ! include 'mosaic.h'
8219 ! subr arguments
8220 integer jp, ibin
8221 real(kind=8) xt
8222 ! local variables
8223 real(kind=8) ehno3, ehcl
8224
8225
8226
8227 if(jp .ne. jliquid)then
8228 if (iprint_mosaic_diag1 .gt. 0) then
8229 write(6,*)'mosaic - error in degas_acids'
8230 write(6,*)'wrong jp'
8231 endif
8232 endif
8233
8234 ehno3 = electrolyte(jhno3,jp,ibin)
8235 ehcl = electrolyte(jhcl,jp,ibin)
8236
8237 ! add to gas
8238 gas(ihno3_g) = gas(ihno3_g) + ehno3
8239 gas(ihcl_g) = gas(ihcl_g) + ehcl
8240
8241 ! remove from aer
8242 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
8243 aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
8244
8245 ! update jtotal
8246 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8247 aer(ino3_a,jsolid, ibin)
8248
8249 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8250 aer(icl_a,jsolid, ibin)
8251
8252 electrolyte(jhno3,jp,ibin) = 0.0
8253 electrolyte(jhcl,jp,ibin) = 0.0
8254
8255 return
8256 end subroutine degas_acids
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271 !***********************************************************************
8272 ! subroutines to evaporate solid volatile species
8273 !
8274 ! author: rahul a. zaveri
8275 ! update: sep 2004
8276 !-----------------------------------------------------------------------
8277 !
8278 ! nh4no3 (solid)
8279 subroutine degas_solid_nh4no3(ibin)
8280 ! implicit none
8281 ! include 'mosaic.h'
8282 ! subr arguments
8283 integer ibin
8284 ! local variables
8285 integer jp
8286 real(kind=8) a, b, c, xgas, xt
8287 ! real(kind=8) quadratic ! mosaic func
8288
8289
8290 jp = jsolid
8291
8292 a = 1.0
8293 b = gas(inh3_g) + gas(ihno3_g)
8294 c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
8295 xgas = quadratic(a,b,c)
8296
8297 if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
8298
8299 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4no3,jp,ibin)
8300 gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
8301 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
8302 electrolyte(jnh4no3,jp,ibin)
8303 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - &
8304 electrolyte(jnh4no3,jp,ibin)
8305
8306 else ! degas only xgas amount of nh4no3
8307
8308 gas(inh3_g) = gas(inh3_g) + xgas
8309 gas(ihno3_g)= gas(ihno3_g) + xgas
8310 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8311 aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
8312 endif
8313
8314
8315 ! update jtotal
8316 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8317 aer(inh4_a,jliquid,ibin)
8318 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8319 aer(ino3_a,jliquid,ibin)
8320
8321 return
8322 end subroutine degas_solid_nh4no3
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332 ! nh4cl (solid)
8333 subroutine degas_solid_nh4cl(ibin)
8334 ! implicit none
8335 ! include 'mosaic.h'
8336 ! subr arguments
8337 integer ibin
8338 ! local variables
8339 integer jp
8340 real(kind=8) a, b, c, xgas, xt
8341 ! real(kind=8) quadratic ! mosaic func
8342
8343
8344 jp = jsolid
8345
8346 a = 1.0
8347 b = gas(inh3_g) + gas(ihcl_g)
8348 c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
8349 xgas = quadratic(a,b,c)
8350
8351 if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
8352
8353 gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
8354 gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
8355 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - &
8356 electrolyte(jnh4cl,jp,ibin)
8357 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - &
8358 electrolyte(jnh4cl,jp,ibin)
8359
8360 else ! degas only xgas amount of nh4cl
8361
8362 gas(inh3_g) = gas(inh3_g) + xgas
8363 gas(ihcl_g) = gas(ihcl_g) + xgas
8364 aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8365 aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - xgas
8366
8367 endif
8368
8369
8370 ! update jtotal
8371 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8372 aer(inh4_a,jliquid,ibin)
8373 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8374 aer(icl_a,jliquid,ibin)
8375
8376 return
8377 end subroutine degas_solid_nh4cl
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389 !***********************************************************************
8390 ! subroutines to absorb and degas small amounts of volatile species
8391 !
8392 ! author: rahul a. zaveri
8393 ! update: jun 2002
8394 !-----------------------------------------------------------------------
8395 !
8396 ! nh4no3 (liquid)
8397 subroutine absorb_tiny_nh4no3(ibin)
8398 ! implicit none
8399 ! include 'mosaic.h'
8400 ! subr arguments
8401 integer ibin
8402 ! local variables
8403 real(kind=8) small_aer, small_gas, small_amt
8404
8405 small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
8406 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8407 if(small_aer .eq. 0.0)small_aer = small_gas
8408
8409 small_amt = min(small_gas, small_aer)
8410
8411 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8412 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8413
8414 ! update jtotal
8415 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8416 aer(inh4_a,jliquid,ibin)
8417 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8418 aer(ino3_a,jliquid,ibin)
8419
8420 ! update gas
8421 gas(inh3_g) = gas(inh3_g) - small_amt
8422 gas(ihno3_g) = gas(ihno3_g) - small_amt
8423
8424 return
8425 end subroutine absorb_tiny_nh4no3
8426
8427
8428
8429
8430
8431
8432 !--------------------------------------------------------------------
8433 ! nh4cl (liquid)
8434 subroutine absorb_tiny_nh4cl(ibin)
8435 ! implicit none
8436 ! include 'mosaic.h'
8437 ! subr arguments
8438 integer ibin
8439 ! local variables
8440 real(kind=8) small_aer, small_gas, small_amt
8441
8442 small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
8443 small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8444 if(small_aer .eq. 0.0)small_aer = small_gas
8445
8446 small_amt = min(small_gas, small_aer)
8447
8448 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8449 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) + small_amt
8450
8451 ! update jtotal
8452 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8453 aer(inh4_a,jliquid,ibin)
8454 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8455 aer(icl_a,jliquid,ibin)
8456
8457 ! update gas
8458 gas(inh3_g) = gas(inh3_g) - small_amt
8459 gas(ihcl_g) = gas(ihcl_g) - small_amt
8460
8461 return
8462 end subroutine absorb_tiny_nh4cl
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476 !--------------------------------------------------------------
8477 ! nh4no3 (liquid)
8478 subroutine degas_tiny_nh4no3(ibin)
8479 ! implicit none
8480 ! include 'mosaic.h'
8481 ! subr arguments
8482 integer ibin
8483 ! local variables
8484 real(kind=8) small_amt
8485
8486 small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
8487
8488 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8489 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8490
8491 ! update jtotal
8492 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8493 aer(inh4_a,jliquid,ibin)
8494 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8495 aer(ino3_a,jliquid,ibin)
8496
8497 ! update gas
8498 gas(inh3_g) = gas(inh3_g) + small_amt
8499 gas(ihno3_g) = gas(ihno3_g) + small_amt
8500
8501 return
8502 end subroutine degas_tiny_nh4no3
8503
8504
8505
8506
8507 !--------------------------------------------------------------------
8508 ! liquid nh4cl (liquid)
8509 subroutine degas_tiny_nh4cl(ibin)
8510 ! implicit none
8511 ! include 'mosaic.h'
8512 ! subr arguments
8513 integer ibin
8514 ! local variables
8515 real(kind=8) small_amt
8516
8517
8518 small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
8519
8520 aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8521 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
8522
8523 ! update jtotal
8524 aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin) + &
8525 aer(inh4_a,jliquid,ibin)
8526 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8527 aer(icl_a,jliquid,ibin)
8528
8529 ! update gas
8530 gas(inh3_g) = gas(inh3_g) + small_amt
8531 gas(ihcl_g) = gas(ihcl_g) + small_amt
8532
8533 return
8534 end subroutine degas_tiny_nh4cl
8535
8536
8537
8538
8539
8540
8541
8542 !--------------------------------------------------------------------
8543 ! hcl (liquid)
8544 subroutine absorb_tiny_hcl(ibin) ! and degas tiny hno3
8545 ! implicit none
8546 ! include 'mosaic.h'
8547 ! subr arguments
8548 integer ibin
8549 ! local variables
8550 real(kind=8) small_aer, small_amt, small_gas
8551
8552 small_gas = 0.01 * gas(ihcl_g)
8553 small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
8554
8555 small_amt = min(small_gas, small_aer)
8556
8557 ! absorb tiny hcl
8558 aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
8559 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8560 aer(icl_a,jliquid,ibin)
8561 gas(ihcl_g) = gas(ihcl_g) - small_amt
8562
8563 ! degas tiny hno3
8564 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8565 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8566 aer(ino3_a,jliquid,ibin)
8567
8568 ! update gas
8569 gas(ihno3_g) = gas(ihno3_g) + small_amt
8570
8571 return
8572 end subroutine absorb_tiny_hcl
8573
8574
8575
8576 !--------------------------------------------------------------------
8577 ! hno3 (liquid)
8578 subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
8579 ! implicit none
8580 ! include 'mosaic.h'
8581 ! subr arguments
8582 integer ibin
8583 ! local variables
8584 real(kind=8) small_aer, small_amt, small_gas
8585
8586 small_gas = 0.01 * gas(ihno3_g)
8587 small_aer = 0.01 * aer(icl_a,jliquid,ibin)
8588
8589 small_amt = min(small_gas, small_aer)
8590
8591 ! absorb tiny hno3
8592 aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8593 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin) + &
8594 aer(ino3_a,jliquid,ibin)
8595 gas(ihno3_g) = gas(ihno3_g) - small_amt
8596
8597 ! degas tiny hcl
8598 aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) - small_amt
8599 aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) + &
8600 aer(icl_a,jliquid,ibin)
8601
8602 ! update gas
8603 gas(ihcl_g) = gas(ihcl_g) + small_amt
8604
8605 return
8606 end subroutine absorb_tiny_hno3
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616 !***********************************************************************
8617 ! subroutines to equilibrate volatile acids
8618 !
8619 ! author: rahul a. zaveri
8620 ! update: may 2002
8621 !-----------------------------------------------------------------------
8622 subroutine equilibrate_acids(ibin)
8623 ! implicit none
8624 ! include 'mosaic.h'
8625 ! subr arguments
8626 integer ibin
8627
8628
8629
8630 if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
8631 call equilibrate_hcl_and_hno3(ibin)
8632 elseif(gas(ihcl_g) .gt. 0.)then
8633 call equilibrate_hcl(ibin)
8634 elseif(gas(ihno3_g) .gt. 0.)then
8635 call equilibrate_hno3(ibin)
8636 endif
8637
8638
8639 return
8640 end subroutine equilibrate_acids
8641
8642
8643
8644
8645
8646
8647
8648
8649 ! only hcl
8650 subroutine equilibrate_hcl(ibin)
8651 ! implicit none
8652 ! include 'mosaic.h'
8653 ! subr arguments
8654 integer ibin
8655 ! local variables
8656 real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl, &
8657 w, xt, z
8658 ! real(kind=8) quadratic ! mosaic func
8659
8660 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8661 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8662
8663 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
8664 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8665 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8666 aer(inh4_a,jliquid,ibin) + &
8667 2.*aer(ica_a, jliquid,ibin) ) - &
8668 (2.*aerso4 + &
8669 aerhso4 + &
8670 aer(ino3_a,jliquid,ibin) )
8671
8672
8673 w = water_a(ibin) ! kg/m^3(air)
8674
8675 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8676 a = 1.0
8677 b = (kdash_hcl*w + z/w)*1.e-9
8678 c = kdash_hcl*(z - tcl)*1.e-18
8679
8680
8681 dum = b*b - 4.*a*c
8682 if (dum .lt. 0.) return ! no real root
8683
8684
8685 if(c .lt. 0.)then
8686 mh = quadratic(a,b,c) ! mol/kg(water)
8687 aerh = mh*w*1.e+9
8688 aer(icl_a,jliquid,ibin) = aerh + z
8689 else
8690 mh = sqrt(keq_ll(3))
8691 endif
8692
8693 call form_electrolytes(jliquid,ibin,xt)
8694
8695 ! update gas phase concentration
8696 gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
8697
8698
8699 ! update the following molalities
8700 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8701 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8702 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8703 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8704
8705 mc(jc_h,ibin) = mh
8706 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8707 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8708 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8709
8710
8711 ! update the following activities
8712 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
8713 gam(jhcl,ibin)**2
8714
8715 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
8716 gam(jhno3,ibin)**2
8717
8718 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
8719 gam(jnh4cl,ibin)**2
8720
8721
8722 ! also update xyz(jtotal)
8723 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8724 aer(icl_a,jsolid,ibin)
8725
8726 electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
8727
8728 return
8729 end subroutine equilibrate_hcl
8730
8731
8732
8733
8734 ! only hno3
8735 subroutine equilibrate_hno3(ibin)
8736 ! implicit none
8737 ! include 'mosaic.h'
8738 ! subr arguments
8739 integer ibin
8740 ! local variables
8741 real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh, &
8742 tno3, w, xt, z
8743 ! real(kind=8) quadratic ! mosaic func
8744
8745 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8746 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8747
8748 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
8749 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8750 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8751 aer(inh4_a,jliquid,ibin) + &
8752 2.*aer(ica_a, jliquid,ibin) ) - &
8753 (2.*aerso4 + &
8754 aerhso4 + &
8755 aer(icl_a,jliquid,ibin) )
8756
8757
8758 w = water_a(ibin) ! kg/m^3(air)
8759
8760 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8761 a = 1.0
8762 b = (kdash_hno3*w + z/w)*1.e-9
8763 c = kdash_hno3*(z - tno3)*1.e-18
8764
8765 dum = b*b - 4.*a*c
8766 if (dum .lt. 0.) return ! no real root
8767
8768
8769
8770 if(c .lt. 0.)then
8771 mh = quadratic(a,b,c) ! mol/kg(water)
8772 aerh = mh*w*1.e+9
8773 aer(ino3_a,jliquid,ibin) = aerh + z
8774 else
8775 mh = sqrt(keq_ll(3))
8776 endif
8777
8778 call form_electrolytes(jliquid,ibin,xt)
8779
8780 ! update gas phase concentration
8781 gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8782
8783
8784 ! update the following molalities
8785 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8786 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8787 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8788 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8789
8790 mc(jc_h,ibin) = mh
8791 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8792 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8793 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8794
8795
8796 ! update the following activities
8797 activity(jhcl,ibin) = mc(jc_h,ibin) *ma(ja_cl,ibin) * &
8798 gam(jhcl,ibin)**2
8799
8800 activity(jhno3,ibin) = mc(jc_h,ibin) *ma(ja_no3,ibin) * &
8801 gam(jhno3,ibin)**2
8802
8803 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) * &
8804 gam(jnh4no3,ibin)**2
8805
8806
8807 ! also update xyz(jtotal)
8808 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8809 aer(ino3_a,jsolid,ibin)
8810
8811 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8812
8813 return
8814 end subroutine equilibrate_hno3
8815
8816
8817
8818
8819
8820
8821
8822
8823
8824
8825 ! both hcl and hno3
8826 subroutine equilibrate_hcl_and_hno3(ibin)
8827 ! implicit none
8828 ! include 'mosaic.h'
8829 ! subr arguments
8830 integer ibin
8831 ! local variables
8832 real(kind=8) aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3, &
8833 mh, p, q, r, tcl, tno3, w, xt, z
8834 ! real(kind=8) cubic ! mosaic func
8835
8836
8837 aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8838 aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8839
8840 tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g) ! nmol/m^3(air)
8841 tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g) ! nmol/m^3(air)
8842
8843 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8844 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8845
8846 z = ( aer(ina_a, jliquid,ibin) + & ! nmol/m^3(air)
8847 aer(inh4_a,jliquid,ibin) + &
8848 2.*aer(ica_a, jliquid,ibin) ) - &
8849 (2.*aerso4 + aerhso4 )
8850
8851
8852 w = water_a(ibin)
8853
8854 kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8855 kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2 ! (nmol^2/kg^2)/(nmol/m^3(air))
8856
8857 p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
8858
8859 q = 1.e-18*kdash_hcl*kdash_hno3*w**2 + &
8860 1.e-18*z*(kdash_hcl + kdash_hno3) - &
8861 1.e-18*kdash_hcl*tcl - &
8862 1.e-18*kdash_hno3*tno3
8863
8864 r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
8865
8866 mh = cubic(p,q,r)
8867
8868 if(mh .gt. 0.0)then
8869 aerh = mh*w*1.e+9
8870 aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/ &
8871 (aerh + kdash_hno3*w*w)
8872 aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/ &
8873 (aerh + kdash_hcl*w*w)
8874 else
8875 mh = sqrt(keq_ll(3))
8876 endif
8877
8878 call form_electrolytes(jliquid,ibin,xt)
8879
8880 ! update gas phase concentration
8881 gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8882 gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
8883
8884
8885 ! update the following molalities
8886 ma(ja_so4,ibin) = 1.e-9*aerso4/water_a(ibin)
8887 ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8888 ma(ja_no3,ibin) = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8889 ma(ja_cl,ibin) = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8890
8891 mc(jc_h,ibin) = mh
8892 mc(jc_ca,ibin) = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8893 mc(jc_nh4,ibin) = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8894 mc(jc_na,ibin) = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8895
8896
8897 ! update the following activities
8898 activity(jhcl,ibin) = mc(jc_h,ibin)*ma(ja_cl,ibin) * &
8899 gam(jhcl,ibin)**2
8900
8901 activity(jhno3,ibin) = mc(jc_h,ibin)*ma(ja_no3,ibin) * &
8902 gam(jhno3,ibin)**2
8903
8904 activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
8905 gam(jnh4no3,ibin)**2
8906
8907 activity(jnh4cl,ibin) = mc(jc_nh4,ibin)*ma(ja_cl,ibin) * &
8908 gam(jnh4cl,ibin)**2
8909
8910
8911 ! also update xyz(jtotal)
8912 aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) + &
8913 aer(icl_a,jsolid,ibin)
8914
8915 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) + &
8916 aer(ino3_a,jsolid,ibin)
8917
8918 electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8919 electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
8920
8921 return
8922 end subroutine equilibrate_hcl_and_hno3
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
8934
8935
8936 !***********************************************************************
8937 ! called only once per entire simulation to load gas and aerosol
8938 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
8939 !
8940 ! author: rahul a. zaveri
8941 ! update: jan 2005
8942 !-----------------------------------------------------------------------
8943 subroutine load_mosaic_parameters
8944 ! implicit none
8945 ! include 'v33com2'
8946 ! include 'mosaic.h'
8947 ! local variables
8948 integer iaer, je, ja, j_index, ibin
8949 ! logical first
8950 ! save first
8951 ! data first/.true./
8952 logical, save :: first = .true.
8953
8954
8955
8956 if(first)then
8957 first=.false.
8958
8959 !----------------------------------------------------------------
8960 ! control settings
8961 msize_framework = msection ! mmodal or msection
8962 mgas_aer_xfer = myes ! myes, mno
8963
8964 ! astem parameters
8965 nmax_astem = 200 ! max number of time steps in astem
8966 alpha_astem = 0.5 ! choose a value between 0.01 and 1.0
8967 rtol_eqb_astem = 0.01 ! equilibrium tolerance in astem
8968 ptol_mol_astem = 0.01 ! mol percent tolerance in astem
8969
8970 ! mesa parameters
8971 nmax_mesa = 80 ! max number of iterations in mesa_ptc
8972 rtol_mesa = 0.01 ! mesa equilibrium tolerance
8973 !----------------------------------------------------------------
8974 !
8975 ! set gas and aerosol indices
8976 !
8977 ! gas (local)
8978 ih2so4_g = 1 ! ioa (inorganic aerosol)
8979 ihno3_g = 2 ! ioa
8980 ihcl_g = 3 ! ioa
8981 inh3_g = 4 ! ioa
8982 imsa_g = 5 ! ioa
8983 iaro1_g = 6 ! soa (secondary organic aerosol)
8984 iaro2_g = 7 ! soa
8985 ialk1_g = 8 ! soa
8986 iole1_g = 9 ! soa
8987 iapi1_g = 10 ! soa
8988 iapi2_g = 11 ! soa
8989 ilim1_g = 12 ! soa
8990 ilim2_g = 13 ! soa
8991
8992 ! ico2_g = 14 ! currently not used
8993 !
8994 ! aerosol (local): used for total species
8995 iso4_a = 1 ! <-> ih2so4_g
8996 ino3_a = 2 ! <-> ihno3_g
8997 icl_a = 3 ! <-> ihcl_g
8998 inh4_a = 4 ! <-> inh3_g
8999 imsa_a = 5 ! <-> imsa_g
9000 iaro1_a = 6 ! <-> iaro1_g
9001 iaro2_a = 7 ! <-> iaro2_g
9002 ialk1_a = 8 ! <-> ialk1_g
9003 iole1_a = 9 ! <-> iole1_g
9004 iapi1_a = 10 ! <-> iapi1_g
9005 iapi2_a = 11 ! <-> iapi2_g
9006 ilim1_a = 12 ! <-> ilim1_g
9007 ilim2_a = 13 ! <-> ilim2_g
9008 ico3_a = 14 ! <-> ico2_g
9009 ina_a = 15
9010 ica_a = 16
9011 ioin_a = 17
9012 ioc_a = 18
9013 ibc_a = 19
9014
9015
9016 ! electrolyte indices (used for water content calculations)
9017 ! these indices are order sensitive
9018 jnh4so4 = 1 ! soluble
9019 jlvcite = 2 ! soluble
9020 jnh4hso4 = 3 ! soluble
9021 jnh4msa = 4 ! soluble new
9022 jnh4no3 = 5 ! soluble
9023 jnh4cl = 6 ! soluble
9024 jna2so4 = 7 ! soluble
9025 jna3hso4 = 8 ! soluble
9026 jnahso4 = 9 ! soluble
9027 jnamsa = 10 ! soluble new
9028 jnano3 = 11 ! soluble
9029 jnacl = 12 ! soluble
9030 jcano3 = 13 ! soluble
9031 jcacl2 = 14 ! soluble
9032 jcamsa2 = 15 ! soluble new nsalt
9033 jh2so4 = 16 ! soluble
9034 jmsa = 17 ! soluble new
9035 jhno3 = 18 ! soluble
9036 jhcl = 19 ! soluble
9037 jhhso4 = 20 ! soluble
9038 jcaso4 = 21 ! insoluble
9039 jcaco3 = 22 ! insoluble
9040 joc = 23 ! insoluble - part of naercomp
9041 jbc = 24 ! insoluble - part of naercomp
9042 join = 25 ! insoluble - part of naercomp
9043 jaro1 = 26 ! insoluble - part of naercomp
9044 jaro2 = 27 ! insoluble - part of naercomp
9045 jalk1 = 28 ! insoluble - part of naercomp
9046 jole1 = 29 ! insoluble - part of naercomp
9047 japi1 = 30 ! insoluble - part of naercomp
9048 japi2 = 31 ! insoluble - part of naercomp
9049 jlim1 = 32 ! insoluble - part of naercomp
9050 jlim2 = 33 ! insoluble - part of naercomp
9051 jh2o = 34 ! water - part of naercomp
9052
9053
9054 ! local aerosol ions
9055 ! cations
9056 jc_h = 1
9057 jc_nh4 = 2
9058 jc_na = 3
9059 jc_ca = 4
9060 !
9061 ! anions
9062 ja_hso4 = 1
9063 ja_so4 = 2
9064 ja_no3 = 3
9065 ja_cl = 4
9066 ja_msa = 5
9067 ! ja_co3 = 6
9068
9069 !--------------------------------------------------------------------
9070 ! phase state names
9071 ! phasestate(no_aerosol) = "NOAERO"
9072 ! phasestate(all_solid) = "SOLID "
9073 ! phasestate(all_liquid) = "LIQUID"
9074 ! phasestate(mixed) = "MIXED "
9075
9076 ! names of aer species
9077 aer_name(iso4_a) = 'so4'
9078 aer_name(ino3_a) = 'no3'
9079 aer_name(icl_a) = 'cl '
9080 aer_name(inh4_a) = 'nh4'
9081 aer_name(ioc_a) = 'oc '
9082 aer_name(imsa_a) = 'msa'
9083 aer_name(ico3_a) = 'co3'
9084 aer_name(ina_a) = 'na '
9085 aer_name(ica_a) = 'ca '
9086 aer_name(ibc_a) = 'bc '
9087 aer_name(ioin_a) = 'oin'
9088 aer_name(iaro1_a)= 'aro1'
9089 aer_name(iaro2_a)= 'aro2'
9090 aer_name(ialk1_a)= 'alk1'
9091 aer_name(iole1_a)= 'ole1'
9092 aer_name(iapi1_a)= 'api1'
9093 aer_name(iapi2_a)= 'api2'
9094 aer_name(ilim1_a)= 'lim1'
9095 aer_name(ilim2_a)= 'lim2'
9096
9097 ! names of gas species
9098 gas_name(ih2so4_g) = 'h2so4'
9099 gas_name(ihno3_g) = 'hno3 '
9100 gas_name(ihcl_g) = 'hcl '
9101 gas_name(inh3_g) = 'nh3 '
9102 gas_name(imsa_g) = "msa "
9103 gas_name(iaro1_g) = "aro1 "
9104 gas_name(iaro2_g) = "aro2 "
9105 gas_name(ialk1_g) = "alk1 "
9106 gas_name(iole1_g) = "ole1 "
9107 gas_name(iapi1_g) = "api1 "
9108 gas_name(iapi2_g) = "api2 "
9109 gas_name(ilim1_g) = "lim1 "
9110 gas_name(ilim2_g) = "lim2 "
9111
9112 ! names of electrolytes
9113 ename(jnh4so4) = 'amso4'
9114 ename(jlvcite) = '(nh4)3h(so4)2'
9115 ename(jnh4hso4)= 'nh4hso4'
9116 ename(jnh4msa) = "ch3so3nh4"
9117 ename(jnh4no3) = 'nh4no3'
9118 ename(jnh4cl) = 'nh4cl'
9119 ename(jnacl) = 'nacl'
9120 ename(jnano3) = 'nano3'
9121 ename(jna2so4) = 'na2so4'
9122 ename(jna3hso4)= 'na3h(so4)2'
9123 ename(jnamsa) = "ch3so3na"
9124 ename(jnahso4) = 'nahso4'
9125 ename(jcaso4) = 'caso4'
9126 ename(jcamsa2) = "(ch3so3)2ca"
9127 ename(jcano3) = 'ca(no3)2'
9128 ename(jcacl2) = 'cacl2'
9129 ename(jcaco3) = 'caco3'
9130 ename(jh2so4) = 'h2so4'
9131 ename(jhhso4) = 'hhso4'
9132 ename(jhno3) = 'hno3'
9133 ename(jhcl) = 'hcl'
9134 ename(jmsa) = "ch3so3h"
9135
9136 ! molecular weights of electrolytes
9137 mw_electrolyte(jnh4so4) = 132.0
9138 mw_electrolyte(jlvcite) = 247.0
9139 mw_electrolyte(jnh4hso4)= 115.0
9140 mw_electrolyte(jnh4msa) = 113.0
9141 mw_electrolyte(jnh4no3) = 80.0
9142 mw_electrolyte(jnh4cl) = 53.5
9143 mw_electrolyte(jnacl) = 58.5
9144 mw_electrolyte(jnano3) = 85.0
9145 mw_electrolyte(jna2so4) = 142.0
9146 mw_electrolyte(jna3hso4)= 262.0
9147 mw_electrolyte(jnahso4) = 120.0
9148 mw_electrolyte(jnamsa) = 118.0
9149 mw_electrolyte(jcaso4) = 136.0
9150 mw_electrolyte(jcamsa2) = 230.0
9151 mw_electrolyte(jcano3) = 164.0
9152 mw_electrolyte(jcacl2) = 111.0
9153 mw_electrolyte(jcaco3) = 100.0
9154 mw_electrolyte(jh2so4) = 98.0
9155 mw_electrolyte(jhno3) = 63.0
9156 mw_electrolyte(jhcl) = 36.5
9157 mw_electrolyte(jmsa) = 96.0
9158
9159
9160 ! molecular weights of ions [g/mol]
9161 mw_c(jc_h) = 1.0
9162 mw_c(jc_nh4)= 18.0
9163 mw_c(jc_na) = 23.0
9164 mw_c(jc_ca) = 40.0
9165
9166 mw_a(ja_so4) = 96.0
9167 mw_a(ja_hso4)= 97.0
9168 mw_a(ja_no3) = 62.0
9169 mw_a(ja_cl) = 35.5
9170 MW_a(ja_msa) = 95.0
9171
9172
9173 ! magnitude of the charges on ions
9174 zc(jc_h) = 1
9175 zc(jc_nh4) = 1
9176 zc(jc_na) = 1
9177 zc(jc_ca) = 2
9178
9179 za(ja_hso4)= 1
9180 za(ja_so4) = 2
9181 za(ja_no3) = 1
9182 za(ja_cl) = 1
9183 za(ja_msa) = 1
9184
9185
9186 ! densities of pure electrolytes in g/cc
9187 dens_electrolyte(jnh4so4) = 1.8
9188 dens_electrolyte(jlvcite) = 1.8
9189 dens_electrolyte(jnh4hso4) = 1.8
9190 dens_electrolyte(jnh4msa) = 1.8 ! assumed same as nh4hso4
9191 dens_electrolyte(jnh4no3) = 1.8
9192 dens_electrolyte(jnh4cl) = 1.8
9193 dens_electrolyte(jnacl) = 2.2
9194 dens_electrolyte(jnano3) = 2.2
9195 dens_electrolyte(jna2so4) = 2.2
9196 dens_electrolyte(jna3hso4) = 2.2
9197 dens_electrolyte(jnahso4) = 2.2
9198 dens_electrolyte(jnamsa) = 2.2 ! assumed same as nahso4
9199 dens_electrolyte(jcaso4) = 2.6
9200 dens_electrolyte(jcamsa2) = 2.6 ! assumed same as caso4
9201 dens_electrolyte(jcano3) = 2.6
9202 dens_electrolyte(jcacl2) = 2.6
9203 dens_electrolyte(jcaco3) = 2.6
9204 dens_electrolyte(jh2so4) = 1.8
9205 dens_electrolyte(jhhso4) = 1.8
9206 dens_electrolyte(jhno3) = 1.8
9207 dens_electrolyte(jhcl) = 1.8
9208 dens_electrolyte(jmsa) = 1.8 ! assumed same as h2so4
9209
9210
9211 ! densities of compounds in g/cc
9212 dens_comp_a(jnh4so4) = 1.8
9213 dens_comp_a(jlvcite) = 1.8
9214 dens_comp_a(jnh4hso4) = 1.8
9215 dens_comp_a(jnh4msa) = 1.8 ! assumed same as nh4hso4
9216 dens_comp_a(jnh4no3) = 1.7
9217 dens_comp_a(jnh4cl) = 1.5
9218 dens_comp_a(jnacl) = 2.2
9219 dens_comp_a(jnano3) = 2.2
9220 dens_comp_a(jna2so4) = 2.2
9221 dens_comp_a(jna3hso4) = 2.2
9222 dens_comp_a(jnahso4) = 2.2
9223 dens_comp_a(jnamsa) = 2.2 ! assumed same as nahso4
9224 dens_comp_a(jcaso4) = 2.6
9225 dens_comp_a(jcamsa2) = 2.6 ! assumed same as caso4
9226 dens_comp_a(jcano3) = 2.6
9227 dens_comp_a(jcacl2) = 2.6
9228 dens_comp_a(jcaco3) = 2.6
9229 dens_comp_a(jh2so4) = 1.8
9230 dens_comp_a(jhhso4) = 1.8
9231 dens_comp_a(jhno3) = 1.8
9232 dens_comp_a(jhcl) = 1.8
9233 dens_comp_a(jmsa) = 1.8 ! assumed same as h2so4
9234 dens_comp_a(joc) = 1.0
9235 dens_comp_a(jbc) = 1.8
9236 dens_comp_a(join) = 2.6
9237 dens_comp_a(jaro1) = 1.0
9238 dens_comp_a(jaro2) = 1.0
9239 dens_comp_a(jalk1) = 1.0
9240 dens_comp_a(jole1) = 1.0
9241 dens_comp_a(japi1) = 1.0
9242 dens_comp_a(japi2) = 1.0
9243 dens_comp_a(jlim1) = 1.0
9244 dens_comp_a(jlim2) = 1.0
9245 dens_comp_a(jh2o) = 1.0
9246
9247
9248 ! molecular weights of generic aerosol species
9249 mw_aer_mac(iso4_a) = 96.0
9250 mw_aer_mac(ino3_a) = 62.0
9251 mw_aer_mac(icl_a) = 35.5
9252 mw_aer_mac(imsa_a) = 95.0 ! ch3so3
9253 mw_aer_mac(ico3_a) = 60.0
9254 mw_aer_mac(inh4_a) = 18.0
9255 mw_aer_mac(ina_a) = 23.0
9256 mw_aer_mac(ica_a) = 40.0
9257 mw_aer_mac(ioin_a) = 1.0 ! not used
9258 mw_aer_mac(ibc_a) = 1.0 ! not used
9259 mw_aer_mac(ioc_a) = 1.0 ! 200 assumed for primary organics
9260 mw_aer_mac(iaro1_a)= 150.0
9261 mw_aer_mac(iaro2_a)= 150.0
9262 mw_aer_mac(ialk1_a)= 140.0
9263 mw_aer_mac(iole1_a)= 140.0
9264 mw_aer_mac(iapi1_a)= 184.0
9265 mw_aer_mac(iapi2_a)= 184.0
9266 mw_aer_mac(ilim1_a)= 200.0
9267 mw_aer_mac(ilim2_a)= 200.0
9268
9269 ! molecular weights of compounds
9270 mw_comp_a(jnh4so4) = 132.0
9271 mw_comp_a(jlvcite) = 247.0
9272 mw_comp_a(jnh4hso4)= 115.0
9273 mw_comp_a(jnh4msa) = 113.0
9274 mw_comp_a(jnh4no3) = 80.0
9275 mw_comp_a(jnh4cl) = 53.5
9276 mw_comp_a(jnacl) = 58.5
9277 mw_comp_a(jnano3) = 85.0
9278 mw_comp_a(jna2so4) = 142.0
9279 mw_comp_a(jna3hso4)= 262.0
9280 mw_comp_a(jnahso4) = 120.0
9281 mw_comp_a(jnamsa) = 118.0
9282 mw_comp_a(jcaso4) = 136.0
9283 mw_comp_a(jcamsa2) = 230.0
9284 mw_comp_a(jcano3) = 164.0
9285 mw_comp_a(jcacl2) = 111.0
9286 mw_comp_a(jcaco3) = 100.0
9287 mw_comp_a(jh2so4) = 98.0
9288 mw_comp_a(jhhso4) = 98.0
9289 mw_comp_a(jhno3) = 63.0
9290 mw_comp_a(jhcl) = 36.5
9291 mw_comp_a(jmsa) = 96.0
9292 mw_comp_a(joc) = 1.0
9293 mw_comp_a(jbc) = 1.0
9294 mw_comp_a(join) = 1.0
9295 mw_comp_a(jaro1) = 150.0
9296 mw_comp_a(jaro2) = 150.0
9297 mw_comp_a(jalk1) = 140.0
9298 mw_comp_a(jole1) = 140.0
9299 mw_comp_a(japi1) = 184.0
9300 mw_comp_a(japi2) = 184.0
9301 mw_comp_a(jlim1) = 200.0
9302 mw_comp_a(jlim2) = 200.0
9303 mw_comp_a(jh2o) = 18.0
9304
9305 ! densities of generic aerosol species
9306 dens_aer_mac(iso4_a) = 1.8 ! used
9307 dens_aer_mac(ino3_a) = 1.8 ! used
9308 dens_aer_mac(icl_a) = 2.2 ! used
9309 dens_aer_mac(imsa_a) = 1.8 ! used
9310 dens_aer_mac(ico3_a) = 2.6 ! used
9311 dens_aer_mac(inh4_a) = 1.8 ! used
9312 dens_aer_mac(ina_a) = 2.2 ! used
9313 dens_aer_mac(ica_a) = 2.6 ! used
9314 dens_aer_mac(ioin_a) = 2.6 ! used
9315 dens_aer_mac(ioc_a) = 1.0 ! used
9316 dens_aer_mac(ibc_a) = 1.7 ! used
9317 dens_aer_mac(iaro1_a)= 1.0
9318 dens_aer_mac(iaro2_a)= 1.0
9319 dens_aer_mac(ialk1_a)= 1.0
9320 dens_aer_mac(iole1_a)= 1.0
9321 dens_aer_mac(iapi1_a)= 1.0
9322 dens_aer_mac(iapi2_a)= 1.0
9323 dens_aer_mac(ilim1_a)= 1.0
9324 dens_aer_mac(ilim2_a)= 1.0
9325
9326
9327 ! partial molar volumes of condensing species
9328 partial_molar_vol(ih2so4_g) = 51.83
9329 partial_molar_vol(ihno3_g) = 31.45
9330 partial_molar_vol(ihcl_g) = 20.96
9331 partial_molar_vol(inh3_g) = 24.03
9332 partial_molar_vol(imsa_g) = 53.33
9333 partial_molar_vol(iaro1_g) = 150.0
9334 partial_molar_vol(iaro2_g) = 150.0
9335 partial_molar_vol(ialk1_g) = 140.0
9336 partial_molar_vol(iole1_g) = 140.0
9337 partial_molar_vol(iapi1_g) = 184.0
9338 partial_molar_vol(iapi2_g) = 184.0
9339 partial_molar_vol(ilim1_g) = 200.0
9340 partial_molar_vol(ilim2_g) = 200.0
9341
9342
9343 ! refractive index
9344 ref_index_a(jnh4so4) = cmplx(1.52,0.)
9345 ref_index_a(jlvcite) = cmplx(1.50,0.)
9346 ref_index_a(jnh4hso4)= cmplx(1.47,0.)
9347 ref_index_a(jnh4msa) = cmplx(1.50,0.) ! assumed
9348 ref_index_a(jnh4no3) = cmplx(1.50,0.)
9349 ref_index_a(jnh4cl) = cmplx(1.50,0.)
9350 ref_index_a(jnacl) = cmplx(1.45,0.)
9351 ref_index_a(jnano3) = cmplx(1.50,0.)
9352 ref_index_a(jna2so4) = cmplx(1.50,0.)
9353 ref_index_a(jna3hso4)= cmplx(1.50,0.)
9354 ref_index_a(jnahso4) = cmplx(1.50,0.)
9355 ref_index_a(jnamsa) = cmplx(1.50,0.) ! assumed
9356 ref_index_a(jcaso4) = cmplx(1.56,0.006)
9357 ref_index_a(jcamsa2) = cmplx(1.56,0.006) ! assumed
9358 ref_index_a(jcano3) = cmplx(1.56,0.006)
9359 ref_index_a(jcacl2) = cmplx(1.52,0.006)
9360 ref_index_a(jcaco3) = cmplx(1.68,0.006)
9361 ref_index_a(jh2so4) = cmplx(1.43,0.)
9362 ref_index_a(jhhso4) = cmplx(1.43,0.)
9363 ref_index_a(jhno3) = cmplx(1.50,0.)
9364 ref_index_a(jhcl) = cmplx(1.50,0.)
9365 ref_index_a(jmsa) = cmplx(1.43,0.) ! assumed
9366 ref_index_a(joc) = cmplx(1.45,0.)
9367 ref_index_a(jbc) = cmplx(1.82,0.74)
9368 ref_index_a(join) = cmplx(1.55,0.006)
9369 ref_index_a(jaro1) = cmplx(1.45,0.)
9370 ref_index_a(jaro2) = cmplx(1.45,0.)
9371 ref_index_a(jalk1) = cmplx(1.45,0.)
9372 ref_index_a(jole1) = cmplx(1.45,0.)
9373 ref_index_a(japi1) = cmplx(1.45,0.)
9374 ref_index_a(japi2) = cmplx(1.45,0.)
9375 ref_index_a(jlim1) = cmplx(1.45,0.)
9376 ref_index_a(jlim2) = cmplx(1.45,0.)
9377 ref_index_a(jh2o) = cmplx(1.33,0.)
9378
9379 ! jsalt_index
9380 jsalt_index(jnh4so4) = 5 ! as
9381 jsalt_index(jlvcite) = 2 ! lv
9382 jsalt_index(jnh4hso4)= 1 ! ab
9383 jsalt_index(jnh4no3) = 2 ! an
9384 jsalt_index(jnh4cl) = 1 ! ac
9385 jsalt_index(jna2so4) = 60 ! ss
9386 jsalt_index(jnahso4) = 10 ! sb
9387 jsalt_index(jnano3) = 40 ! sn
9388 jsalt_index(jnacl) = 10 ! sc
9389 jsalt_index(jcano3) = 120 ! cn
9390 jsalt_index(jcacl2) = 80 ! cc
9391 jsalt_index(jnh4msa) = 0 ! AM zero for now
9392 jsalt_index(jnamsa) = 0 ! SM zero for now
9393 jsalt_index(jcamsa2) = 0 ! CM zero for now
9394
9395
9396 ! aerosol indices
9397 ! ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
9398 ! ab = 1, lv = 2, sb = 10
9399 !
9400 ! sulfate-poor domain
9401 jsulf_poor(1) = 1 ! ac
9402 jsulf_poor(2) = 2 ! an
9403 jsulf_poor(5) = 3 ! as
9404 jsulf_poor(10) = 4 ! sc
9405 jsulf_poor(40) = 5 ! sn
9406 jsulf_poor(60) = 6 ! ss
9407 jsulf_poor(80) = 7 ! cc
9408 jsulf_poor(120) = 8 ! cn
9409 jsulf_poor(3) = 9 ! an + ac
9410 jsulf_poor(6) = 10 ! as + ac
9411 jsulf_poor(7) = 11 ! as + an
9412 jsulf_poor(8) = 12 ! as + an + ac
9413 jsulf_poor(11) = 13 ! sc + ac
9414 jsulf_poor(41) = 14 ! sn + ac
9415 jsulf_poor(42) = 15 ! sn + an
9416 jsulf_poor(43) = 16 ! sn + an + ac
9417 jsulf_poor(50) = 17 ! sn + sc
9418 jsulf_poor(51) = 18 ! sn + sc + ac
9419 jsulf_poor(61) = 19 ! ss + ac
9420 jsulf_poor(62) = 20 ! ss + an
9421 jsulf_poor(63) = 21 ! ss + an + ac
9422 jsulf_poor(65) = 22 ! ss + as
9423 jsulf_poor(66) = 23 ! ss + as + ac
9424 jsulf_poor(67) = 24 ! ss + as + an
9425 jsulf_poor(68) = 25 ! ss + as + an + ac
9426 jsulf_poor(70) = 26 ! ss + sc
9427 jsulf_poor(71) = 27 ! ss + sc + ac
9428 jsulf_poor(100) = 28 ! ss + sn
9429 jsulf_poor(101) = 29 ! ss + sn + ac
9430 jsulf_poor(102) = 30 ! ss + sn + an
9431 jsulf_poor(103) = 31 ! ss + sn + an + ac
9432 jsulf_poor(110) = 32 ! ss + sn + sc
9433 jsulf_poor(111) = 33 ! ss + sn + sc + ac
9434 jsulf_poor(81) = 34 ! cc + ac
9435 jsulf_poor(90) = 35 ! cc + sc
9436 jsulf_poor(91) = 36 ! cc + sc + ac
9437 jsulf_poor(121) = 37 ! cn + ac
9438 jsulf_poor(122) = 38 ! cn + an
9439 jsulf_poor(123) = 39 ! cn + an + ac
9440 jsulf_poor(130) = 40 ! cn + sc
9441 jsulf_poor(131) = 41 ! cn + sc + ac
9442 jsulf_poor(160) = 42 ! cn + sn
9443 jsulf_poor(161) = 43 ! cn + sn + ac
9444 jsulf_poor(162) = 44 ! cn + sn + an
9445 jsulf_poor(163) = 45 ! cn + sn + an + ac
9446 jsulf_poor(170) = 46 ! cn + sn + sc
9447 jsulf_poor(171) = 47 ! cn + sn + sc + ac
9448 jsulf_poor(200) = 48 ! cn + cc
9449 jsulf_poor(201) = 49 ! cn + cc + ac
9450 jsulf_poor(210) = 50 ! cn + cc + sc
9451 jsulf_poor(211) = 51 ! cn + cc + sc + ac
9452 !
9453 ! sulfate-rich domain
9454 jsulf_rich(1) = 52 ! ab
9455 jsulf_rich(2) = 53 ! lv
9456 jsulf_rich(10) = 54 ! sb
9457 jsulf_rich(3) = 55 ! ab + lv
9458 jsulf_rich(7) = 56 ! as + lv
9459 jsulf_rich(70) = 57 ! ss + sb
9460 jsulf_rich(62) = 58 ! ss + lv
9461 jsulf_rich(67) = 59 ! ss + as + lv
9462 jsulf_rich(61) = 60 ! ss + ab
9463 jsulf_rich(63) = 61 ! ss + lv + ab
9464 jsulf_rich(11) = 62 ! sb + ab
9465 jsulf_rich(71) = 63 ! ss + sb + ab
9466 jsulf_rich(5) = 3 ! as
9467 jsulf_rich(60) = 6 ! ss
9468 jsulf_rich(65) = 22 ! ss + as
9469
9470
9471
9472 !
9473 ! polynomial coefficients for binary molality (used in zsr equation)
9474 !
9475 !
9476 ! a_zsr for aw < 0.97
9477 !
9478 ! (nh4)2so4
9479 je = jnh4so4
9480 a_zsr(1,je) = 1.30894
9481 a_zsr(2,je) = -7.09922
9482 a_zsr(3,je) = 20.62831
9483 a_zsr(4,je) = -32.19965
9484 a_zsr(5,je) = 25.17026
9485 a_zsr(6,je) = -7.81632
9486 aw_min(je) = 0.1
9487 !
9488 ! (nh4)3h(so4)2
9489 je = jlvcite
9490 a_zsr(1,je) = 1.10725
9491 a_zsr(2,je) = -5.17978
9492 a_zsr(3,je) = 12.29534
9493 a_zsr(4,je) = -16.32545
9494 a_zsr(5,je) = 11.29274
9495 a_zsr(6,je) = -3.19164
9496 aw_min(je) = 0.1
9497 !
9498 ! nh4hso4
9499 je = jnh4hso4
9500 a_zsr(1,je) = 1.15510
9501 a_zsr(2,je) = -3.20815
9502 a_zsr(3,je) = 2.71141
9503 a_zsr(4,je) = 2.01155
9504 a_zsr(5,je) = -4.71014
9505 a_zsr(6,je) = 2.04616
9506 aw_min(je) = 0.1
9507 !
9508 ! nh4msa (assumed same as nh4hso4)
9509 je = jnh4msa
9510 a_zsr(1,je) = 1.15510
9511 a_zsr(2,je) = -3.20815
9512 a_zsr(3,je) = 2.71141
9513 a_zsr(4,je) = 2.01155
9514 a_zsr(5,je) = -4.71014
9515 a_zsr(6,je) = 2.04616
9516 aw_min(je) = 0.1
9517 !
9518 ! nh4no3
9519 je = jnh4no3
9520 a_zsr(1,je) = 0.43507
9521 a_zsr(2,je) = 6.38220
9522 a_zsr(3,je) = -30.19797
9523 a_zsr(4,je) = 53.36470
9524 a_zsr(5,je) = -43.44203
9525 a_zsr(6,je) = 13.46158
9526 aw_min(je) = 0.1
9527 !
9528 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
9529 je = jnh4cl
9530 a_zsr(1,je) = 0.45309
9531 a_zsr(2,je) = 2.65606
9532 a_zsr(3,je) = -14.7730
9533 a_zsr(4,je) = 26.2936
9534 a_zsr(5,je) = -20.5735
9535 a_zsr(6,je) = 5.94255
9536 aw_min(je) = 0.1
9537 !
9538 ! nacl
9539 je = jnacl
9540 a_zsr(1,je) = 0.42922
9541 a_zsr(2,je) = -1.17718
9542 a_zsr(3,je) = 2.80208
9543 a_zsr(4,je) = -4.51097
9544 a_zsr(5,je) = 3.76963
9545 a_zsr(6,je) = -1.31359
9546 aw_min(je) = 0.1
9547 !
9548 ! nano3
9549 je = jnano3
9550 a_zsr(1,je) = 1.34966
9551 a_zsr(2,je) = -5.20116
9552 a_zsr(3,je) = 11.49011
9553 a_zsr(4,je) = -14.41380
9554 a_zsr(5,je) = 9.07037
9555 a_zsr(6,je) = -2.29769
9556 aw_min(je) = 0.1
9557 !
9558 ! na2so4
9559 je = jna2so4
9560 a_zsr(1,je) = 0.39888
9561 a_zsr(2,je) = -1.27150
9562 a_zsr(3,je) = 3.42792
9563 a_zsr(4,je) = -5.92632
9564 a_zsr(5,je) = 5.33351
9565 a_zsr(6,je) = -1.96541
9566 aw_min(je) = 0.1
9567 !
9568 ! na3h(so4)2 added on 1/14/2004
9569 je = jna3hso4
9570 a_zsr(1,je) = 0.31480
9571 a_zsr(2,je) = -1.01087
9572 a_zsr(3,je) = 2.44029
9573 a_zsr(4,je) = -3.66095
9574 a_zsr(5,je) = 2.77632
9575 a_zsr(6,je) = -0.86058
9576 aw_min(je) = 0.1
9577 !
9578 ! nahso4
9579 je = jnahso4
9580 a_zsr(1,je) = 0.62764
9581 a_zsr(2,je) = -1.63520
9582 a_zsr(3,je) = 4.62531
9583 a_zsr(4,je) = -10.06925
9584 a_zsr(5,je) = 10.33547
9585 a_zsr(6,je) = -3.88729
9586 aw_min(je) = 0.1
9587 !
9588 ! namsa (assumed same as nahso4)
9589 je = jnamsa
9590 a_zsr(1,je) = 0.62764
9591 a_zsr(2,je) = -1.63520
9592 a_zsr(3,je) = 4.62531
9593 a_zsr(4,je) = -10.06925
9594 a_zsr(5,je) = 10.33547
9595 a_zsr(6,je) = -3.88729
9596 aw_min(je) = 0.1
9597 !
9598 ! ca(no3)2
9599 je = jcano3
9600 a_zsr(1,je) = 0.38895
9601 a_zsr(2,je) = -1.16013
9602 a_zsr(3,je) = 2.16819
9603 a_zsr(4,je) = -2.23079
9604 a_zsr(5,je) = 1.00268
9605 a_zsr(6,je) = -0.16923
9606 aw_min(je) = 0.1
9607 !
9608 ! cacl2: kim and seinfeld
9609 je = jcacl2
9610 a_zsr(1,je) = 0.29891
9611 a_zsr(2,je) = -1.31104
9612 a_zsr(3,je) = 3.68759
9613 a_zsr(4,je) = -5.81708
9614 a_zsr(5,je) = 4.67520
9615 a_zsr(6,je) = -1.53223
9616 aw_min(je) = 0.1
9617 !
9618 ! h2so4
9619 je = jh2so4
9620 a_zsr(1,je) = 0.32751
9621 a_zsr(2,je) = -1.00692
9622 a_zsr(3,je) = 2.59750
9623 a_zsr(4,je) = -4.40014
9624 a_zsr(5,je) = 3.88212
9625 a_zsr(6,je) = -1.39916
9626 aw_min(je) = 0.1
9627 !
9628 ! msa (assumed same as h2so4)
9629 je = jmsa
9630 a_zsr(1,je) = 0.32751
9631 a_zsr(2,je) = -1.00692
9632 a_zsr(3,je) = 2.59750
9633 a_zsr(4,je) = -4.40014
9634 a_zsr(5,je) = 3.88212
9635 a_zsr(6,je) = -1.39916
9636 aw_min(je) = 0.1
9637 !
9638 ! hhso4
9639 je = jhhso4
9640 a_zsr(1,je) = 0.32751
9641 a_zsr(2,je) = -1.00692
9642 a_zsr(3,je) = 2.59750
9643 a_zsr(4,je) = -4.40014
9644 a_zsr(5,je) = 3.88212
9645 a_zsr(6,je) = -1.39916
9646 aw_min(je) = 1.0
9647 !
9648 ! hno3
9649 je = jhno3
9650 a_zsr(1,je) = 0.75876
9651 a_zsr(2,je) = -3.31529
9652 a_zsr(3,je) = 9.26392
9653 a_zsr(4,je) = -14.89799
9654 a_zsr(5,je) = 12.08781
9655 a_zsr(6,je) = -3.89958
9656 aw_min(je) = 0.1
9657 !
9658 ! hcl
9659 je = jhcl
9660 a_zsr(1,je) = 0.31133
9661 a_zsr(2,je) = -0.79688
9662 a_zsr(3,je) = 1.93995
9663 a_zsr(4,je) = -3.31582
9664 a_zsr(5,je) = 2.93513
9665 a_zsr(6,je) = -1.07268
9666 aw_min(je) = 0.1
9667 !
9668 ! caso4
9669 je = jcaso4
9670 a_zsr(1,je) = 0.0
9671 a_zsr(2,je) = 0.0
9672 a_zsr(3,je) = 0.0
9673 a_zsr(4,je) = 0.0
9674 a_zsr(5,je) = 0.0
9675 a_zsr(6,je) = 0.0
9676 aw_min(je) = 1.0
9677 !
9678 ! ca(msa)2 (assumed same as ca(no3)2)
9679 je = jcamsa2
9680 a_zsr(1,je) = 0.38895
9681 a_zsr(2,je) = -1.16013
9682 a_zsr(3,je) = 2.16819
9683 a_zsr(4,je) = -2.23079
9684 a_zsr(5,je) = 1.00268
9685 a_zsr(6,je) = -0.16923
9686 aw_min(je) = 0.1
9687 !
9688 ! caco3
9689 je = jcaco3
9690 a_zsr(1,je) = 0.0
9691 a_zsr(2,je) = 0.0
9692 a_zsr(3,je) = 0.0
9693 a_zsr(4,je) = 0.0
9694 a_zsr(5,je) = 0.0
9695 a_zsr(6,je) = 0.0
9696 aw_min(je) = 1.0
9697
9698
9699
9700 !-------------------------------------------
9701 ! b_zsr for aw => 0.97 to 0.99999
9702 !
9703 ! (nh4)2so4
9704 b_zsr(jnh4so4) = 28.0811
9705 !
9706 ! (nh4)3h(so4)2
9707 b_zsr(jlvcite) = 14.7178
9708 !
9709 ! nh4hso4
9710 b_zsr(jnh4hso4) = 29.4779
9711 !
9712 ! nh4msa
9713 b_zsr(jnh4msa) = 29.4779 ! assumed same as nh4hso4
9714 !
9715 ! nh4no3
9716 b_zsr(jnh4no3) = 33.4049
9717 !
9718 ! nh4cl
9719 b_zsr(jnh4cl) = 30.8888
9720 !
9721 ! nacl
9722 b_zsr(jnacl) = 29.8375
9723 !
9724 ! nano3
9725 b_zsr(jnano3) = 32.2756
9726 !
9727 ! na2so4
9728 b_zsr(jna2so4) = 27.6889
9729 !
9730 ! na3h(so4)2
9731 b_zsr(jna3hso4) = 14.2184
9732 !
9733 ! nahso4
9734 b_zsr(jnahso4) = 28.3367
9735 !
9736 ! namsa
9737 b_zsr(jnamsa) = 28.3367 ! assumed same as nahso4
9738 !
9739 ! ca(no3)2
9740 b_zsr(jcano3) = 18.3661
9741 !
9742 ! cacl2
9743 b_zsr(jcacl2) = 20.8792
9744 !
9745 ! h2so4
9746 b_zsr(jh2so4) = 26.7347
9747 !
9748 ! hhso4
9749 b_zsr(jhhso4) = 26.7347
9750 !
9751 ! hno3
9752 b_zsr(jhno3) = 28.8257
9753 !
9754 ! hcl
9755 b_zsr(jhcl) = 27.7108
9756 !
9757 ! msa
9758 b_zsr(jmsa) = 26.7347 ! assumed same as h2so4
9759 !
9760 ! caso4
9761 b_zsr(jcaso4) = 0.0
9762 !
9763 ! ca(msa)2
9764 b_zsr(jcamsa2) = 18.3661 ! assumed same as Ca(NO3)2
9765 !
9766 ! caco3
9767 b_zsr(jcaco3) = 0.0
9768
9769
9770
9771
9772
9773
9774
9775 !----------------------------------------------------------------
9776 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
9777 ! log_gamz(ja,je) a in e
9778 !----------------------------------------------------------------
9779 !
9780 ! (nh4)2so4 in e
9781 ja = jnh4so4
9782
9783 ! in (nh4)2so4
9784 je = jnh4so4
9785 b_mtem(1,ja,je) = -2.94685
9786 b_mtem(2,ja,je) = 17.3328
9787 b_mtem(3,ja,je) = -64.8441
9788 b_mtem(4,ja,je) = 122.7070
9789 b_mtem(5,ja,je) = -114.4373
9790 b_mtem(6,ja,je) = 41.6811
9791
9792 ! in nh4no3
9793 je = jnh4no3
9794 b_mtem(1,ja,je) = -2.7503
9795 b_mtem(2,ja,je) = 4.3806
9796 b_mtem(3,ja,je) = -1.1110
9797 b_mtem(4,ja,je) = -1.7005
9798 b_mtem(5,ja,je) = -4.4207
9799 b_mtem(6,ja,je) = 5.1990
9800
9801 ! in nh4cl (revised on 11/15/2003)
9802 je = jnh4cl
9803 b_mtem(1,ja,je) = -2.06952
9804 b_mtem(2,ja,je) = 7.1240
9805 b_mtem(3,ja,je) = -24.4274
9806 b_mtem(4,ja,je) = 51.1458
9807 b_mtem(5,ja,je) = -54.2056
9808 b_mtem(6,ja,je) = 22.0606
9809
9810 ! in na2so4
9811 je = jna2so4
9812 b_mtem(1,ja,je) = -2.17361
9813 b_mtem(2,ja,je) = 15.9919
9814 b_mtem(3,ja,je) = -69.0952
9815 b_mtem(4,ja,je) = 139.8860
9816 b_mtem(5,ja,je) = -134.9890
9817 b_mtem(6,ja,je) = 49.8877
9818
9819 ! in nano3
9820 je = jnano3
9821 b_mtem(1,ja,je) = -4.4370
9822 b_mtem(2,ja,je) = 24.0243
9823 b_mtem(3,ja,je) = -76.2437
9824 b_mtem(4,ja,je) = 128.6660
9825 b_mtem(5,ja,je) = -110.0900
9826 b_mtem(6,ja,je) = 37.7414
9827
9828 ! in nacl
9829 je = jnacl
9830 b_mtem(1,ja,je) = -1.5394
9831 b_mtem(2,ja,je) = 5.8671
9832 b_mtem(3,ja,je) = -22.7726
9833 b_mtem(4,ja,je) = 47.0547
9834 b_mtem(5,ja,je) = -47.8266
9835 b_mtem(6,ja,je) = 18.8489
9836
9837 ! in hno3
9838 je = jhno3
9839 b_mtem(1,ja,je) = -0.35750
9840 b_mtem(2,ja,je) = -3.82466
9841 b_mtem(3,ja,je) = 4.55462
9842 b_mtem(4,ja,je) = 5.05402
9843 b_mtem(5,ja,je) = -14.7476
9844 b_mtem(6,ja,je) = 8.8009
9845
9846 ! in hcl
9847 je = jhcl
9848 b_mtem(1,ja,je) = -2.15146
9849 b_mtem(2,ja,je) = 5.50205
9850 b_mtem(3,ja,je) = -19.1476
9851 b_mtem(4,ja,je) = 39.1880
9852 b_mtem(5,ja,je) = -39.9460
9853 b_mtem(6,ja,je) = 16.0700
9854
9855 ! in h2so4
9856 je = jh2so4
9857 b_mtem(1,ja,je) = -2.52604
9858 b_mtem(2,ja,je) = 9.76022
9859 b_mtem(3,ja,je) = -35.2540
9860 b_mtem(4,ja,je) = 71.2981
9861 b_mtem(5,ja,je) = -71.8207
9862 b_mtem(6,ja,je) = 28.0758
9863
9864 !
9865 ! in nh4hso4
9866 je = jnh4hso4
9867 b_mtem(1,ja,je) = -4.13219
9868 b_mtem(2,ja,je) = 13.8863
9869 b_mtem(3,ja,je) = -34.5387
9870 b_mtem(4,ja,je) = 56.5012
9871 b_mtem(5,ja,je) = -51.8702
9872 b_mtem(6,ja,je) = 19.6232
9873
9874 !
9875 ! in (nh4)3h(so4)2
9876 je = jlvcite
9877 b_mtem(1,ja,je) = -2.53482
9878 b_mtem(2,ja,je) = 12.3333
9879 b_mtem(3,ja,je) = -46.1020
9880 b_mtem(4,ja,je) = 90.4775
9881 b_mtem(5,ja,je) = -88.1254
9882 b_mtem(6,ja,je) = 33.4715
9883
9884 !
9885 ! in nahso4
9886 je = jnahso4
9887 b_mtem(1,ja,je) = -3.23425
9888 b_mtem(2,ja,je) = 18.7842
9889 b_mtem(3,ja,je) = -78.7807
9890 b_mtem(4,ja,je) = 161.517
9891 b_mtem(5,ja,je) = -154.940
9892 b_mtem(6,ja,je) = 56.2252
9893
9894 !
9895 ! in na3h(so4)2
9896 je = jna3hso4
9897 b_mtem(1,ja,je) = -1.25316
9898 b_mtem(2,ja,je) = 7.40960
9899 b_mtem(3,ja,je) = -34.8929
9900 b_mtem(4,ja,je) = 72.8853
9901 b_mtem(5,ja,je) = -72.4503
9902 b_mtem(6,ja,je) = 27.7706
9903
9904
9905 !-----------------
9906 ! nh4no3 in e
9907 ja = jnh4no3
9908
9909 ! in (nh4)2so4
9910 je = jnh4so4
9911 b_mtem(1,ja,je) = -3.5201
9912 b_mtem(2,ja,je) = 21.6584
9913 b_mtem(3,ja,je) = -72.1499
9914 b_mtem(4,ja,je) = 126.7000
9915 b_mtem(5,ja,je) = -111.4550
9916 b_mtem(6,ja,je) = 38.5677
9917
9918 ! in nh4no3
9919 je = jnh4no3
9920 b_mtem(1,ja,je) = -2.2630
9921 b_mtem(2,ja,je) = -0.1518
9922 b_mtem(3,ja,je) = 17.0898
9923 b_mtem(4,ja,je) = -36.7832
9924 b_mtem(5,ja,je) = 29.8407
9925 b_mtem(6,ja,je) = -7.9314
9926
9927 ! in nh4cl (revised on 11/15/2003)
9928 je = jnh4cl
9929 b_mtem(1,ja,je) = -1.3851
9930 b_mtem(2,ja,je) = -0.4462
9931 b_mtem(3,ja,je) = 8.4567
9932 b_mtem(4,ja,je) = -11.5988
9933 b_mtem(5,ja,je) = 2.9802
9934 b_mtem(6,ja,je) = 1.8132
9935
9936 ! in na2so4
9937 je = jna2so4
9938 b_mtem(1,ja,je) = -1.7602
9939 b_mtem(2,ja,je) = 10.4044
9940 b_mtem(3,ja,je) = -35.5894
9941 b_mtem(4,ja,je) = 64.3584
9942 b_mtem(5,ja,je) = -57.8931
9943 b_mtem(6,ja,je) = 20.2141
9944
9945 ! in nano3
9946 je = jnano3
9947 b_mtem(1,ja,je) = -3.24346
9948 b_mtem(2,ja,je) = 16.2794
9949 b_mtem(3,ja,je) = -48.7601
9950 b_mtem(4,ja,je) = 79.2246
9951 b_mtem(5,ja,je) = -65.8169
9952 b_mtem(6,ja,je) = 22.1500
9953
9954 ! in nacl
9955 je = jnacl
9956 b_mtem(1,ja,je) = -1.75658
9957 b_mtem(2,ja,je) = 7.71384
9958 b_mtem(3,ja,je) = -22.7984
9959 b_mtem(4,ja,je) = 39.1532
9960 b_mtem(5,ja,je) = -34.6165
9961 b_mtem(6,ja,je) = 12.1283
9962
9963 ! in ca(no3)2
9964 je = jcano3
9965 b_mtem(1,ja,je) = -0.97178
9966 b_mtem(2,ja,je) = 6.61964
9967 b_mtem(3,ja,je) = -26.2353
9968 b_mtem(4,ja,je) = 50.5259
9969 b_mtem(5,ja,je) = -47.6586
9970 b_mtem(6,ja,je) = 17.5074
9971
9972 ! in cacl2 added on 12/22/2003
9973 je = jcacl2
9974 b_mtem(1,ja,je) = -0.41515
9975 b_mtem(2,ja,je) = 6.44101
9976 b_mtem(3,ja,je) = -26.4473
9977 b_mtem(4,ja,je) = 49.0718
9978 b_mtem(5,ja,je) = -44.2631
9979 b_mtem(6,ja,je) = 15.3771
9980
9981 ! in hno3
9982 je = jhno3
9983 b_mtem(1,ja,je) = -1.20644
9984 b_mtem(2,ja,je) = 5.70117
9985 b_mtem(3,ja,je) = -18.2783
9986 b_mtem(4,ja,je) = 31.7199
9987 b_mtem(5,ja,je) = -27.8703
9988 b_mtem(6,ja,je) = 9.7299
9989
9990 ! in hcl
9991 je = jhcl
9992 b_mtem(1,ja,je) = -0.680862
9993 b_mtem(2,ja,je) = 3.59456
9994 b_mtem(3,ja,je) = -10.7969
9995 b_mtem(4,ja,je) = 17.8434
9996 b_mtem(5,ja,je) = -15.3165
9997 b_mtem(6,ja,je) = 5.17123
9998
9999
10000 !----------
10001 ! nh4cl in e
10002 ja = jnh4cl
10003
10004 ! in (nh4)2so4
10005 je = jnh4so4
10006 b_mtem(1,ja,je) = -2.8850
10007 b_mtem(2,ja,je) = 20.6970
10008 b_mtem(3,ja,je) = -70.6810
10009 b_mtem(4,ja,je) = 124.3690
10010 b_mtem(5,ja,je) = -109.2880
10011 b_mtem(6,ja,je) = 37.5831
10012
10013 ! in nh4no3
10014 je = jnh4no3
10015 b_mtem(1,ja,je) = -1.9386
10016 b_mtem(2,ja,je) = 1.3238
10017 b_mtem(3,ja,je) = 11.8500
10018 b_mtem(4,ja,je) = -28.1168
10019 b_mtem(5,ja,je) = 21.8543
10020 b_mtem(6,ja,je) = -5.1671
10021
10022 ! in nh4cl (revised on 11/15/2003)
10023 je = jnh4cl
10024 b_mtem(1,ja,je) = -0.9559
10025 b_mtem(2,ja,je) = 0.8121
10026 b_mtem(3,ja,je) = 4.3644
10027 b_mtem(4,ja,je) = -8.9258
10028 b_mtem(5,ja,je) = 4.2362
10029 b_mtem(6,ja,je) = 0.2891
10030
10031 ! in na2so4
10032 je = jna2so4
10033 b_mtem(1,ja,je) = 0.0377
10034 b_mtem(2,ja,je) = 6.0752
10035 b_mtem(3,ja,je) = -30.8641
10036 b_mtem(4,ja,je) = 63.3095
10037 b_mtem(5,ja,je) = -61.0070
10038 b_mtem(6,ja,je) = 22.1734
10039
10040 ! in nano3
10041 je = jnano3
10042 b_mtem(1,ja,je) = -1.8336
10043 b_mtem(2,ja,je) = 12.8160
10044 b_mtem(3,ja,je) = -42.3388
10045 b_mtem(4,ja,je) = 71.1816
10046 b_mtem(5,ja,je) = -60.5708
10047 b_mtem(6,ja,je) = 20.5853
10048
10049 ! in nacl
10050 je = jnacl
10051 b_mtem(1,ja,je) = -0.1429
10052 b_mtem(2,ja,je) = 2.3561
10053 b_mtem(3,ja,je) = -10.4425
10054 b_mtem(4,ja,je) = 20.8951
10055 b_mtem(5,ja,je) = -20.7739
10056 b_mtem(6,ja,je) = 7.9355
10057
10058 ! in ca(no3)2
10059 je = jcano3
10060 b_mtem(1,ja,je) = 0.76235
10061 b_mtem(2,ja,je) = 3.08323
10062 b_mtem(3,ja,je) = -23.6772
10063 b_mtem(4,ja,je) = 53.7415
10064 b_mtem(5,ja,je) = -55.4043
10065 b_mtem(6,ja,je) = 21.2944
10066
10067 ! in cacl2 (revised on 11/27/2003)
10068 je = jcacl2
10069 b_mtem(1,ja,je) = 1.13864
10070 b_mtem(2,ja,je) = -0.340539
10071 b_mtem(3,ja,je) = -8.67025
10072 b_mtem(4,ja,je) = 22.8008
10073 b_mtem(5,ja,je) = -24.5181
10074 b_mtem(6,ja,je) = 9.3663
10075
10076 ! in hno3
10077 je = jhno3
10078 b_mtem(1,ja,je) = 2.42532
10079 b_mtem(2,ja,je) = -14.1755
10080 b_mtem(3,ja,je) = 38.804
10081 b_mtem(4,ja,je) = -58.2437
10082 b_mtem(5,ja,je) = 43.5431
10083 b_mtem(6,ja,je) = -12.5824
10084
10085 ! in hcl
10086 je = jhcl
10087 b_mtem(1,ja,je) = 0.330337
10088 b_mtem(2,ja,je) = 0.0778934
10089 b_mtem(3,ja,je) = -2.30492
10090 b_mtem(4,ja,je) = 4.73003
10091 b_mtem(5,ja,je) = -4.80849
10092 b_mtem(6,ja,je) = 1.78866
10093
10094
10095 !----------
10096 ! na2so4 in e
10097 ja = jna2so4
10098
10099 ! in (nh4)2so4
10100 je = jnh4so4
10101 b_mtem(1,ja,je) = -2.6982
10102 b_mtem(2,ja,je) = 22.9875
10103 b_mtem(3,ja,je) = -98.9840
10104 b_mtem(4,ja,je) = 198.0180
10105 b_mtem(5,ja,je) = -188.7270
10106 b_mtem(6,ja,je) = 69.0548
10107
10108 ! in nh4no3
10109 je = jnh4no3
10110 b_mtem(1,ja,je) = -2.4844
10111 b_mtem(2,ja,je) = 6.5420
10112 b_mtem(3,ja,je) = -9.8998
10113 b_mtem(4,ja,je) = 11.3884
10114 b_mtem(5,ja,je) = -13.6842
10115 b_mtem(6,ja,je) = 7.7411
10116
10117 ! in nh4cl (revised on 11/15/2003)
10118 je = jnh4cl
10119 b_mtem(1,ja,je) = -1.3325
10120 b_mtem(2,ja,je) = 13.0406
10121 b_mtem(3,ja,je) = -56.1935
10122 b_mtem(4,ja,je) = 107.1170
10123 b_mtem(5,ja,je) = -97.3721
10124 b_mtem(6,ja,je) = 34.3763
10125
10126 ! in na2so4
10127 je = jna2so4
10128 b_mtem(1,ja,je) = -1.2832
10129 b_mtem(2,ja,je) = 12.8526
10130 b_mtem(3,ja,je) = -62.2087
10131 b_mtem(4,ja,je) = 130.3876
10132 b_mtem(5,ja,je) = -128.2627
10133 b_mtem(6,ja,je) = 48.0340
10134
10135 ! in nano3
10136 je = jnano3
10137 b_mtem(1,ja,je) = -3.5384
10138 b_mtem(2,ja,je) = 21.3758
10139 b_mtem(3,ja,je) = -70.7638
10140 b_mtem(4,ja,je) = 121.1580
10141 b_mtem(5,ja,je) = -104.6230
10142 b_mtem(6,ja,je) = 36.0557
10143
10144 ! in nacl
10145 je = jnacl
10146 b_mtem(1,ja,je) = 0.2175
10147 b_mtem(2,ja,je) = -0.5648
10148 b_mtem(3,ja,je) = -8.0288
10149 b_mtem(4,ja,je) = 25.9734
10150 b_mtem(5,ja,je) = -32.3577
10151 b_mtem(6,ja,je) = 14.3924
10152
10153 ! in hno3
10154 je = jhno3
10155 b_mtem(1,ja,je) = -0.309617
10156 b_mtem(2,ja,je) = -1.82899
10157 b_mtem(3,ja,je) = -1.5505
10158 b_mtem(4,ja,je) = 13.3847
10159 b_mtem(5,ja,je) = -20.1284
10160 b_mtem(6,ja,je) = 9.93163
10161
10162 ! in hcl
10163 je = jhcl
10164 b_mtem(1,ja,je) = -0.259455
10165 b_mtem(2,ja,je) = -0.819366
10166 b_mtem(3,ja,je) = -4.28964
10167 b_mtem(4,ja,je) = 16.4305
10168 b_mtem(5,ja,je) = -21.8546
10169 b_mtem(6,ja,je) = 10.3044
10170
10171 ! in h2so4
10172 je = jh2so4
10173 b_mtem(1,ja,je) = -1.84257
10174 b_mtem(2,ja,je) = 7.85788
10175 b_mtem(3,ja,je) = -29.9275
10176 b_mtem(4,ja,je) = 61.7515
10177 b_mtem(5,ja,je) = -63.2308
10178 b_mtem(6,ja,je) = 24.9542
10179
10180 ! in nh4hso4
10181 je = jnh4hso4
10182 b_mtem(1,ja,je) = -1.05891
10183 b_mtem(2,ja,je) = 2.84831
10184 b_mtem(3,ja,je) = -21.1827
10185 b_mtem(4,ja,je) = 57.5175
10186 b_mtem(5,ja,je) = -64.8120
10187 b_mtem(6,ja,je) = 26.1986
10188
10189 ! in (nh4)3h(so4)2
10190 je = jlvcite
10191 b_mtem(1,ja,je) = -1.16584
10192 b_mtem(2,ja,je) = 8.50075
10193 b_mtem(3,ja,je) = -44.3420
10194 b_mtem(4,ja,je) = 97.3974
10195 b_mtem(5,ja,je) = -98.4549
10196 b_mtem(6,ja,je) = 37.6104
10197
10198 ! in nahso4
10199 je = jnahso4
10200 b_mtem(1,ja,je) = -1.95805
10201 b_mtem(2,ja,je) = 6.62417
10202 b_mtem(3,ja,je) = -31.8072
10203 b_mtem(4,ja,je) = 77.8603
10204 b_mtem(5,ja,je) = -84.6458
10205 b_mtem(6,ja,je) = 33.4963
10206
10207 ! in na3h(so4)2
10208 je = jna3hso4
10209 b_mtem(1,ja,je) = -0.36045
10210 b_mtem(2,ja,je) = 3.55223
10211 b_mtem(3,ja,je) = -24.0327
10212 b_mtem(4,ja,je) = 54.4879
10213 b_mtem(5,ja,je) = -56.6531
10214 b_mtem(6,ja,je) = 22.4956
10215
10216
10217 !----------
10218 ! nano3 in e
10219 ja = jnano3
10220
10221 ! in (nh4)2so4
10222 je = jnh4so4
10223 b_mtem(1,ja,je) = -2.5888
10224 b_mtem(2,ja,je) = 17.6192
10225 b_mtem(3,ja,je) = -63.2183
10226 b_mtem(4,ja,je) = 115.3520
10227 b_mtem(5,ja,je) = -104.0860
10228 b_mtem(6,ja,je) = 36.7390
10229
10230 ! in nh4no3
10231 je = jnh4no3
10232 b_mtem(1,ja,je) = -2.0669
10233 b_mtem(2,ja,je) = 1.4792
10234 b_mtem(3,ja,je) = 10.5261
10235 b_mtem(4,ja,je) = -27.0987
10236 b_mtem(5,ja,je) = 23.0591
10237 b_mtem(6,ja,je) = -6.0938
10238
10239 ! in nh4cl (revised on 11/15/2003)
10240 je = jnh4cl
10241 b_mtem(1,ja,je) = -0.8325
10242 b_mtem(2,ja,je) = 3.9933
10243 b_mtem(3,ja,je) = -15.3789
10244 b_mtem(4,ja,je) = 30.4050
10245 b_mtem(5,ja,je) = -29.4204
10246 b_mtem(6,ja,je) = 11.0597
10247
10248 ! in na2so4
10249 je = jna2so4
10250 b_mtem(1,ja,je) = -1.1233
10251 b_mtem(2,ja,je) = 8.3998
10252 b_mtem(3,ja,je) = -31.9002
10253 b_mtem(4,ja,je) = 60.1450
10254 b_mtem(5,ja,je) = -55.5503
10255 b_mtem(6,ja,je) = 19.7757
10256
10257 ! in nano3
10258 je = jnano3
10259 b_mtem(1,ja,je) = -2.5386
10260 b_mtem(2,ja,je) = 13.9039
10261 b_mtem(3,ja,je) = -42.8467
10262 b_mtem(4,ja,je) = 69.7442
10263 b_mtem(5,ja,je) = -57.8988
10264 b_mtem(6,ja,je) = 19.4635
10265
10266 ! in nacl
10267 je = jnacl
10268 b_mtem(1,ja,je) = -0.4351
10269 b_mtem(2,ja,je) = 2.8311
10270 b_mtem(3,ja,je) = -11.4485
10271 b_mtem(4,ja,je) = 22.7201
10272 b_mtem(5,ja,je) = -22.4228
10273 b_mtem(6,ja,je) = 8.5792
10274
10275 ! in ca(no3)2
10276 je = jcano3
10277 b_mtem(1,ja,je) = -0.72060
10278 b_mtem(2,ja,je) = 5.64915
10279 b_mtem(3,ja,je) = -23.5020
10280 b_mtem(4,ja,je) = 46.0078
10281 b_mtem(5,ja,je) = -43.8075
10282 b_mtem(6,ja,je) = 16.1652
10283
10284 ! in cacl2
10285 je = jcacl2
10286 b_mtem(1,ja,je) = 0.003928
10287 b_mtem(2,ja,je) = 3.54724
10288 b_mtem(3,ja,je) = -18.6057
10289 b_mtem(4,ja,je) = 38.1445
10290 b_mtem(5,ja,je) = -36.7745
10291 b_mtem(6,ja,je) = 13.4529
10292
10293 ! in hno3
10294 je = jhno3
10295 b_mtem(1,ja,je) = -1.1712
10296 b_mtem(2,ja,je) = 7.20907
10297 b_mtem(3,ja,je) = -22.9215
10298 b_mtem(4,ja,je) = 38.1257
10299 b_mtem(5,ja,je) = -32.0759
10300 b_mtem(6,ja,je) = 10.6443
10301
10302 ! in hcl
10303 je = jhcl
10304 b_mtem(1,ja,je) = 0.738022
10305 b_mtem(2,ja,je) = -1.14313
10306 b_mtem(3,ja,je) = 0.32251
10307 b_mtem(4,ja,je) = 0.838679
10308 b_mtem(5,ja,je) = -1.81747
10309 b_mtem(6,ja,je) = 0.873986
10310
10311
10312 !----------
10313 ! nacl in e
10314 ja = jnacl
10315
10316 ! in (nh4)2so4
10317 je = jnh4so4
10318 b_mtem(1,ja,je) = -1.9525
10319 b_mtem(2,ja,je) = 16.6433
10320 b_mtem(3,ja,je) = -61.7090
10321 b_mtem(4,ja,je) = 112.9910
10322 b_mtem(5,ja,je) = -101.9370
10323 b_mtem(6,ja,je) = 35.7760
10324
10325 ! in nh4no3
10326 je = jnh4no3
10327 b_mtem(1,ja,je) = -1.7525
10328 b_mtem(2,ja,je) = 3.0713
10329 b_mtem(3,ja,je) = 4.8063
10330 b_mtem(4,ja,je) = -17.5334
10331 b_mtem(5,ja,je) = 14.2872
10332 b_mtem(6,ja,je) = -3.0690
10333
10334 ! in nh4cl (revised on 11/15/2003)
10335 je = jnh4cl
10336 b_mtem(1,ja,je) = -0.4021
10337 b_mtem(2,ja,je) = 5.2399
10338 b_mtem(3,ja,je) = -19.4278
10339 b_mtem(4,ja,je) = 33.0027
10340 b_mtem(5,ja,je) = -28.1020
10341 b_mtem(6,ja,je) = 9.5159
10342
10343 ! in na2so4
10344 je = jna2so4
10345 b_mtem(1,ja,je) = 0.6692
10346 b_mtem(2,ja,je) = 4.1207
10347 b_mtem(3,ja,je) = -27.3314
10348 b_mtem(4,ja,je) = 59.3112
10349 b_mtem(5,ja,je) = -58.7998
10350 b_mtem(6,ja,je) = 21.7674
10351
10352 ! in nano3
10353 je = jnano3
10354 b_mtem(1,ja,je) = -1.17444
10355 b_mtem(2,ja,je) = 10.9927
10356 b_mtem(3,ja,je) = -38.9013
10357 b_mtem(4,ja,je) = 66.8521
10358 b_mtem(5,ja,je) = -57.6564
10359 b_mtem(6,ja,je) = 19.7296
10360
10361 ! in nacl
10362 je = jnacl
10363 b_mtem(1,ja,je) = 1.17679
10364 b_mtem(2,ja,je) = -2.5061
10365 b_mtem(3,ja,je) = 0.8508
10366 b_mtem(4,ja,je) = 4.4802
10367 b_mtem(5,ja,je) = -8.4945
10368 b_mtem(6,ja,je) = 4.3182
10369
10370 ! in ca(no3)2
10371 je = jcano3
10372 b_mtem(1,ja,je) = 1.01450
10373 b_mtem(2,ja,je) = 2.10260
10374 b_mtem(3,ja,je) = -20.9036
10375 b_mtem(4,ja,je) = 49.1481
10376 b_mtem(5,ja,je) = -51.4867
10377 b_mtem(6,ja,je) = 19.9301
10378
10379 ! in cacl2 (psc92: revised on 11/27/2003)
10380 je = jcacl2
10381 b_mtem(1,ja,je) = 1.55463
10382 b_mtem(2,ja,je) = -3.20122
10383 b_mtem(3,ja,je) = -0.957075
10384 b_mtem(4,ja,je) = 12.103
10385 b_mtem(5,ja,je) = -17.221
10386 b_mtem(6,ja,je) = 7.50264
10387
10388 ! in hno3
10389 je = jhno3
10390 b_mtem(1,ja,je) = 2.46187
10391 b_mtem(2,ja,je) = -12.6845
10392 b_mtem(3,ja,je) = 34.2383
10393 b_mtem(4,ja,je) = -51.9992
10394 b_mtem(5,ja,je) = 39.4934
10395 b_mtem(6,ja,je) = -11.7247
10396
10397 ! in hcl
10398 je = jhcl
10399 b_mtem(1,ja,je) = 1.74915
10400 b_mtem(2,ja,je) = -4.65768
10401 b_mtem(3,ja,je) = 8.80287
10402 b_mtem(4,ja,je) = -12.2503
10403 b_mtem(5,ja,je) = 8.668751
10404 b_mtem(6,ja,je) = -2.50158
10405
10406
10407 !----------
10408 ! ca(no3)2 in e
10409 ja = jcano3
10410
10411 ! in nh4no3
10412 je = jnh4no3
10413 b_mtem(1,ja,je) = -1.86260
10414 b_mtem(2,ja,je) = 11.6178
10415 b_mtem(3,ja,je) = -30.9069
10416 b_mtem(4,ja,je) = 41.7578
10417 b_mtem(5,ja,je) = -33.7338
10418 b_mtem(6,ja,je) = 12.7541
10419
10420 ! in nh4cl (revised on 11/15/2003)
10421 je = jnh4cl
10422 b_mtem(1,ja,je) = -1.1798
10423 b_mtem(2,ja,je) = 25.9608
10424 b_mtem(3,ja,je) = -98.9373
10425 b_mtem(4,ja,je) = 160.2300
10426 b_mtem(5,ja,je) = -125.9540
10427 b_mtem(6,ja,je) = 39.5130
10428
10429 ! in nano3
10430 je = jnano3
10431 b_mtem(1,ja,je) = -1.44384
10432 b_mtem(2,ja,je) = 13.6044
10433 b_mtem(3,ja,je) = -54.4300
10434 b_mtem(4,ja,je) = 100.582
10435 b_mtem(5,ja,je) = -91.2364
10436 b_mtem(6,ja,je) = 32.5970
10437
10438 ! in nacl
10439 je = jnacl
10440 b_mtem(1,ja,je) = -0.099114
10441 b_mtem(2,ja,je) = 2.84091
10442 b_mtem(3,ja,je) = -16.9229
10443 b_mtem(4,ja,je) = 37.4839
10444 b_mtem(5,ja,je) = -39.5132
10445 b_mtem(6,ja,je) = 15.8564
10446
10447 ! in ca(no3)2
10448 je = jcano3
10449 b_mtem(1,ja,je) = 0.055116
10450 b_mtem(2,ja,je) = 4.58610
10451 b_mtem(3,ja,je) = -27.6629
10452 b_mtem(4,ja,je) = 60.8288
10453 b_mtem(5,ja,je) = -61.4988
10454 b_mtem(6,ja,je) = 23.3136
10455
10456 ! in cacl2 (psc92: revised on 11/27/2003)
10457 je = jcacl2
10458 b_mtem(1,ja,je) = 1.57155
10459 b_mtem(2,ja,je) = -3.18486
10460 b_mtem(3,ja,je) = -3.35758
10461 b_mtem(4,ja,je) = 18.7501
10462 b_mtem(5,ja,je) = -24.5604
10463 b_mtem(6,ja,je) = 10.3798
10464
10465 ! in hno3
10466 je = jhno3
10467 b_mtem(1,ja,je) = 1.04446
10468 b_mtem(2,ja,je) = -3.19066
10469 b_mtem(3,ja,je) = 2.44714
10470 b_mtem(4,ja,je) = 2.07218
10471 b_mtem(5,ja,je) = -6.43949
10472 b_mtem(6,ja,je) = 3.66471
10473
10474 ! in hcl
10475 je = jhcl
10476 b_mtem(1,ja,je) = 1.05723
10477 b_mtem(2,ja,je) = -1.46826
10478 b_mtem(3,ja,je) = -1.0713
10479 b_mtem(4,ja,je) = 4.64439
10480 b_mtem(5,ja,je) = -6.32402
10481 b_mtem(6,ja,je) = 2.78202
10482
10483
10484 !----------
10485 ! cacl2 in e
10486 ja = jcacl2
10487
10488 ! in nh4no3 (psc92: revised on 12/22/2003)
10489 je = jnh4no3
10490 b_mtem(1,ja,je) = -1.43626
10491 b_mtem(2,ja,je) = 13.6598
10492 b_mtem(3,ja,je) = -38.2068
10493 b_mtem(4,ja,je) = 53.9057
10494 b_mtem(5,ja,je) = -44.9018
10495 b_mtem(6,ja,je) = 16.6120
10496
10497 ! in nh4cl (psc92: revised on 11/27/2003)
10498 je = jnh4cl
10499 b_mtem(1,ja,je) = -0.603965
10500 b_mtem(2,ja,je) = 27.6027
10501 b_mtem(3,ja,je) = -104.258
10502 b_mtem(4,ja,je) = 163.553
10503 b_mtem(5,ja,je) = -124.076
10504 b_mtem(6,ja,je) = 37.4153
10505
10506 ! in nano3 (psc92: revised on 12/22/2003)
10507 je = jnano3
10508 b_mtem(1,ja,je) = 0.44648
10509 b_mtem(2,ja,je) = 8.8850
10510 b_mtem(3,ja,je) = -45.5232
10511 b_mtem(4,ja,je) = 89.3263
10512 b_mtem(5,ja,je) = -83.8604
10513 b_mtem(6,ja,je) = 30.4069
10514
10515 ! in nacl (psc92: revised on 11/27/2003)
10516 je = jnacl
10517 b_mtem(1,ja,je) = 1.61927
10518 b_mtem(2,ja,je) = 0.247547
10519 b_mtem(3,ja,je) = -18.1252
10520 b_mtem(4,ja,je) = 45.2479
10521 b_mtem(5,ja,je) = -48.6072
10522 b_mtem(6,ja,je) = 19.2784
10523
10524 ! in ca(no3)2 (psc92: revised on 11/27/2003)
10525 je = jcano3
10526 b_mtem(1,ja,je) = 2.36667
10527 b_mtem(2,ja,je) = -0.123309
10528 b_mtem(3,ja,je) = -24.2723
10529 b_mtem(4,ja,je) = 65.1486
10530 b_mtem(5,ja,je) = -71.8504
10531 b_mtem(6,ja,je) = 28.3696
10532
10533 ! in cacl2 (psc92: revised on 11/27/2003)
10534 je = jcacl2
10535 b_mtem(1,ja,je) = 3.64023
10536 b_mtem(2,ja,je) = -12.1926
10537 b_mtem(3,ja,je) = 20.2028
10538 b_mtem(4,ja,je) = -16.0056
10539 b_mtem(5,ja,je) = 1.52355
10540 b_mtem(6,ja,je) = 2.44709
10541
10542 ! in hno3
10543 je = jhno3
10544 b_mtem(1,ja,je) = 5.88794
10545 b_mtem(2,ja,je) = -29.7083
10546 b_mtem(3,ja,je) = 78.6309
10547 b_mtem(4,ja,je) = -118.037
10548 b_mtem(5,ja,je) = 88.932
10549 b_mtem(6,ja,je) = -26.1407
10550
10551 ! in hcl
10552 je = jhcl
10553 b_mtem(1,ja,je) = 2.40628
10554 b_mtem(2,ja,je) = -6.16566
10555 b_mtem(3,ja,je) = 10.2851
10556 b_mtem(4,ja,je) = -12.9035
10557 b_mtem(5,ja,je) = 7.7441
10558 b_mtem(6,ja,je) = -1.74821
10559
10560
10561 !----------
10562 ! hno3 in e
10563 ja = jhno3
10564
10565 ! in (nh4)2so4
10566 je = jnh4so4
10567 b_mtem(1,ja,je) = -3.57598
10568 b_mtem(2,ja,je) = 21.5469
10569 b_mtem(3,ja,je) = -77.4111
10570 b_mtem(4,ja,je) = 144.136
10571 b_mtem(5,ja,je) = -132.849
10572 b_mtem(6,ja,je) = 47.9412
10573
10574 ! in nh4no3
10575 je = jnh4no3
10576 b_mtem(1,ja,je) = -2.00209
10577 b_mtem(2,ja,je) = -3.48399
10578 b_mtem(3,ja,je) = 34.9906
10579 b_mtem(4,ja,je) = -68.6653
10580 b_mtem(5,ja,je) = 54.0992
10581 b_mtem(6,ja,je) = -15.1343
10582
10583 ! in nh4cl revised on 12/22/2003
10584 je = jnh4cl
10585 b_mtem(1,ja,je) = -0.63790
10586 b_mtem(2,ja,je) = -1.67730
10587 b_mtem(3,ja,je) = 10.1727
10588 b_mtem(4,ja,je) = -14.9097
10589 b_mtem(5,ja,je) = 7.67410
10590 b_mtem(6,ja,je) = -0.79586
10591
10592 ! in nacl
10593 je = jnacl
10594 b_mtem(1,ja,je) = 1.3446
10595 b_mtem(2,ja,je) = -2.5578
10596 b_mtem(3,ja,je) = 1.3464
10597 b_mtem(4,ja,je) = 2.90537
10598 b_mtem(5,ja,je) = -6.53014
10599 b_mtem(6,ja,je) = 3.31339
10600
10601 ! in nano3
10602 je = jnano3
10603 b_mtem(1,ja,je) = -0.546636
10604 b_mtem(2,ja,je) = 10.3127
10605 b_mtem(3,ja,je) = -39.9603
10606 b_mtem(4,ja,je) = 71.4609
10607 b_mtem(5,ja,je) = -63.4958
10608 b_mtem(6,ja,je) = 22.0679
10609
10610 ! in na2so4
10611 je = jna2so4
10612 b_mtem(1,ja,je) = 1.35059
10613 b_mtem(2,ja,je) = 4.34557
10614 b_mtem(3,ja,je) = -35.8425
10615 b_mtem(4,ja,je) = 80.9868
10616 b_mtem(5,ja,je) = -81.6544
10617 b_mtem(6,ja,je) = 30.4841
10618
10619 ! in ca(no3)2
10620 je = jcano3
10621 b_mtem(1,ja,je) = 0.869414
10622 b_mtem(2,ja,je) = 2.98486
10623 b_mtem(3,ja,je) = -22.255
10624 b_mtem(4,ja,je) = 50.1863
10625 b_mtem(5,ja,je) = -51.214
10626 b_mtem(6,ja,je) = 19.2235
10627
10628 ! in cacl2 (km) revised on 12/22/2003
10629 je = jcacl2
10630 b_mtem(1,ja,je) = 1.42800
10631 b_mtem(2,ja,je) = -1.78959
10632 b_mtem(3,ja,je) = -2.49075
10633 b_mtem(4,ja,je) = 10.1877
10634 b_mtem(5,ja,je) = -12.1948
10635 b_mtem(6,ja,je) = 4.64475
10636
10637 ! in hno3 (added on 12/06/2004)
10638 je = jhno3
10639 b_mtem(1,ja,je) = 0.22035
10640 b_mtem(2,ja,je) = 2.94973
10641 b_mtem(3,ja,je) = -12.1469
10642 b_mtem(4,ja,je) = 20.4905
10643 b_mtem(5,ja,je) = -17.3966
10644 b_mtem(6,ja,je) = 5.70779
10645
10646 ! in hcl (added on 12/06/2004)
10647 je = jhcl
10648 b_mtem(1,ja,je) = 1.55503
10649 b_mtem(2,ja,je) = -3.61226
10650 b_mtem(3,ja,je) = 6.28265
10651 b_mtem(4,ja,je) = -8.69575
10652 b_mtem(5,ja,je) = 6.09372
10653 b_mtem(6,ja,je) = -1.80898
10654
10655 ! in h2so4
10656 je = jh2so4
10657 b_mtem(1,ja,je) = 1.10783
10658 b_mtem(2,ja,je) = -1.3363
10659 b_mtem(3,ja,je) = -1.83525
10660 b_mtem(4,ja,je) = 7.47373
10661 b_mtem(5,ja,je) = -9.72954
10662 b_mtem(6,ja,je) = 4.12248
10663
10664 ! in nh4hso4
10665 je = jnh4hso4
10666 b_mtem(1,ja,je) = -0.851026
10667 b_mtem(2,ja,je) = 12.2515
10668 b_mtem(3,ja,je) = -49.788
10669 b_mtem(4,ja,je) = 91.6215
10670 b_mtem(5,ja,je) = -81.4877
10671 b_mtem(6,ja,je) = 28.0002
10672
10673 ! in (nh4)3h(so4)2
10674 je = jlvcite
10675 b_mtem(1,ja,je) = -3.09464
10676 b_mtem(2,ja,je) = 14.9303
10677 b_mtem(3,ja,je) = -43.0454
10678 b_mtem(4,ja,je) = 72.6695
10679 b_mtem(5,ja,je) = -65.2140
10680 b_mtem(6,ja,je) = 23.4814
10681
10682 ! in nahso4
10683 je = jnahso4
10684 b_mtem(1,ja,je) = 1.22973
10685 b_mtem(2,ja,je) = 2.82702
10686 b_mtem(3,ja,je) = -17.5869
10687 b_mtem(4,ja,je) = 28.9564
10688 b_mtem(5,ja,je) = -23.5814
10689 b_mtem(6,ja,je) = 7.91153
10690
10691 ! in na3h(so4)2
10692 je = jna3hso4
10693 b_mtem(1,ja,je) = 1.64773
10694 b_mtem(2,ja,je) = 0.94188
10695 b_mtem(3,ja,je) = -19.1242
10696 b_mtem(4,ja,je) = 46.9887
10697 b_mtem(5,ja,je) = -50.9494
10698 b_mtem(6,ja,je) = 20.2169
10699
10700
10701 !----------
10702 ! hcl in e
10703 ja = jhcl
10704
10705 ! in (nh4)2so4
10706 je = jnh4so4
10707 b_mtem(1,ja,je) = -2.93783
10708 b_mtem(2,ja,je) = 20.5546
10709 b_mtem(3,ja,je) = -75.8548
10710 b_mtem(4,ja,je) = 141.729
10711 b_mtem(5,ja,je) = -130.697
10712 b_mtem(6,ja,je) = 46.9905
10713
10714 ! in nh4no3
10715 je = jnh4no3
10716 b_mtem(1,ja,je) = -1.69063
10717 b_mtem(2,ja,je) = -1.85303
10718 b_mtem(3,ja,je) = 29.0927
10719 b_mtem(4,ja,je) = -58.7401
10720 b_mtem(5,ja,je) = 44.999
10721 b_mtem(6,ja,je) = -11.9988
10722
10723 ! in nh4cl (revised on 11/15/2003)
10724 je = jnh4cl
10725 b_mtem(1,ja,je) = -0.2073
10726 b_mtem(2,ja,je) = -0.4322
10727 b_mtem(3,ja,je) = 6.1271
10728 b_mtem(4,ja,je) = -12.3146
10729 b_mtem(5,ja,je) = 8.9919
10730 b_mtem(6,ja,je) = -2.3388
10731
10732 ! in nacl
10733 je = jnacl
10734 b_mtem(1,ja,je) = 2.95913
10735 b_mtem(2,ja,je) = -7.92254
10736 b_mtem(3,ja,je) = 13.736
10737 b_mtem(4,ja,je) = -15.433
10738 b_mtem(5,ja,je) = 7.40386
10739 b_mtem(6,ja,je) = -0.918641
10740
10741 ! in nano3
10742 je = jnano3
10743 b_mtem(1,ja,je) = 0.893272
10744 b_mtem(2,ja,je) = 6.53768
10745 b_mtem(3,ja,je) = -32.3458
10746 b_mtem(4,ja,je) = 61.2834
10747 b_mtem(5,ja,je) = -56.4446
10748 b_mtem(6,ja,je) = 19.9202
10749
10750 ! in na2so4
10751 je = jna2so4
10752 b_mtem(1,ja,je) = 3.14484
10753 b_mtem(2,ja,je) = 0.077019
10754 b_mtem(3,ja,je) = -31.4199
10755 b_mtem(4,ja,je) = 80.5865
10756 b_mtem(5,ja,je) = -85.392
10757 b_mtem(6,ja,je) = 32.6644
10758
10759 ! in ca(no3)2
10760 je = jcano3
10761 b_mtem(1,ja,je) = 2.60432
10762 b_mtem(2,ja,je) = -0.55909
10763 b_mtem(3,ja,je) = -19.6671
10764 b_mtem(4,ja,je) = 53.3446
10765 b_mtem(5,ja,je) = -58.9076
10766 b_mtem(6,ja,je) = 22.9927
10767
10768 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
10769 je = jcacl2
10770 b_mtem(1,ja,je) = 2.98036
10771 b_mtem(2,ja,je) = -8.55365
10772 b_mtem(3,ja,je) = 15.2108
10773 b_mtem(4,ja,je) = -15.9359
10774 b_mtem(5,ja,je) = 7.41772
10775 b_mtem(6,ja,je) = -1.32143
10776
10777 ! in hno3 (added on 12/06/2004)
10778 je = jhno3
10779 b_mtem(1,ja,je) = 3.8533
10780 b_mtem(2,ja,je) = -16.9427
10781 b_mtem(3,ja,je) = 45.0056
10782 b_mtem(4,ja,je) = -69.6145
10783 b_mtem(5,ja,je) = 54.1491
10784 b_mtem(6,ja,je) = -16.6513
10785
10786 ! in hcl (added on 12/06/2004)
10787 je = jhcl
10788 b_mtem(1,ja,je) = 2.56665
10789 b_mtem(2,ja,je) = -7.13585
10790 b_mtem(3,ja,je) = 14.8103
10791 b_mtem(4,ja,je) = -21.8881
10792 b_mtem(5,ja,je) = 16.6808
10793 b_mtem(6,ja,je) = -5.22091
10794
10795 ! in h2so4
10796 je = jh2so4
10797 b_mtem(1,ja,je) = 2.50179
10798 b_mtem(2,ja,je) = -6.69364
10799 b_mtem(3,ja,je) = 11.6551
10800 b_mtem(4,ja,je) = -13.6897
10801 b_mtem(5,ja,je) = 7.36796
10802 b_mtem(6,ja,je) = -1.33245
10803
10804 ! in nh4hso4
10805 je = jnh4hso4
10806 b_mtem(1,ja,je) = 0.149955
10807 b_mtem(2,ja,je) = 11.8213
10808 b_mtem(3,ja,je) = -53.9164
10809 b_mtem(4,ja,je) = 101.574
10810 b_mtem(5,ja,je) = -91.4123
10811 b_mtem(6,ja,je) = 31.5487
10812
10813 ! in (nh4)3h(so4)2
10814 je = jlvcite
10815 b_mtem(1,ja,je) = -2.36927
10816 b_mtem(2,ja,je) = 14.8359
10817 b_mtem(3,ja,je) = -44.3443
10818 b_mtem(4,ja,je) = 73.6229
10819 b_mtem(5,ja,je) = -65.3366
10820 b_mtem(6,ja,je) = 23.3250
10821
10822 ! in nahso4
10823 je = jnahso4
10824 b_mtem(1,ja,je) = 2.72993
10825 b_mtem(2,ja,je) = -0.23406
10826 b_mtem(3,ja,je) = -10.4103
10827 b_mtem(4,ja,je) = 13.1586
10828 b_mtem(5,ja,je) = -7.79925
10829 b_mtem(6,ja,je) = 2.30843
10830
10831 ! in na3h(so4)2
10832 je = jna3hso4
10833 b_mtem(1,ja,je) = 3.51258
10834 b_mtem(2,ja,je) = -3.95107
10835 b_mtem(3,ja,je) = -11.0175
10836 b_mtem(4,ja,je) = 38.8617
10837 b_mtem(5,ja,je) = -48.1575
10838 b_mtem(6,ja,je) = 20.4717
10839
10840
10841 !----------
10842 ! 2h.so4 in e
10843 ja = jh2so4
10844
10845 ! in h2so4
10846 je = jh2so4
10847 b_mtem(1,ja,je) = 0.76734
10848 b_mtem(2,ja,je) = -1.12263
10849 b_mtem(3,ja,je) = -9.08728
10850 b_mtem(4,ja,je) = 30.3836
10851 b_mtem(5,ja,je) = -38.4133
10852 b_mtem(6,ja,je) = 17.0106
10853
10854 ! in nh4hso4
10855 je = jnh4hso4
10856 b_mtem(1,ja,je) = -2.03879
10857 b_mtem(2,ja,je) = 15.7033
10858 b_mtem(3,ja,je) = -58.7363
10859 b_mtem(4,ja,je) = 109.242
10860 b_mtem(5,ja,je) = -102.237
10861 b_mtem(6,ja,je) = 37.5350
10862
10863 ! in (nh4)3h(so4)2
10864 je = jlvcite
10865 b_mtem(1,ja,je) = -3.10228
10866 b_mtem(2,ja,je) = 16.6920
10867 b_mtem(3,ja,je) = -59.1522
10868 b_mtem(4,ja,je) = 113.487
10869 b_mtem(5,ja,je) = -110.890
10870 b_mtem(6,ja,je) = 42.4578
10871
10872 ! in (nh4)2so4
10873 je = jnh4so4
10874 b_mtem(1,ja,je) = -3.43885
10875 b_mtem(2,ja,je) = 21.0372
10876 b_mtem(3,ja,je) = -84.7026
10877 b_mtem(4,ja,je) = 165.324
10878 b_mtem(5,ja,je) = -156.101
10879 b_mtem(6,ja,je) = 57.3101
10880
10881 ! in nahso4
10882 je = jnahso4
10883 b_mtem(1,ja,je) = 0.33164
10884 b_mtem(2,ja,je) = 6.55864
10885 b_mtem(3,ja,je) = -33.5876
10886 b_mtem(4,ja,je) = 65.1798
10887 b_mtem(5,ja,je) = -63.2046
10888 b_mtem(6,ja,je) = 24.1783
10889
10890 ! in na3h(so4)2
10891 je = jna3hso4
10892 b_mtem(1,ja,je) = 3.06830
10893 b_mtem(2,ja,je) = -3.18408
10894 b_mtem(3,ja,je) = -19.6332
10895 b_mtem(4,ja,je) = 61.3657
10896 b_mtem(5,ja,je) = -73.4438
10897 b_mtem(6,ja,je) = 31.2334
10898
10899 ! in na2so4
10900 je = jna2so4
10901 b_mtem(1,ja,je) = 2.58649
10902 b_mtem(2,ja,je) = 0.87921
10903 b_mtem(3,ja,je) = -39.3023
10904 b_mtem(4,ja,je) = 101.603
10905 b_mtem(5,ja,je) = -109.469
10906 b_mtem(6,ja,je) = 43.0188
10907
10908 ! in hno3
10909 je = jhno3
10910 b_mtem(1,ja,je) = 1.54587
10911 b_mtem(2,ja,je) = -7.50976
10912 b_mtem(3,ja,je) = 12.8237
10913 b_mtem(4,ja,je) = -10.1452
10914 b_mtem(5,ja,je) = -0.541956
10915 b_mtem(6,ja,je) = 3.34536
10916
10917 ! in hcl
10918 je = jhcl
10919 b_mtem(1,ja,je) = 0.829757
10920 b_mtem(2,ja,je) = -4.11316
10921 b_mtem(3,ja,je) = 3.67111
10922 b_mtem(4,ja,je) = 3.6833
10923 b_mtem(5,ja,je) = -11.2711
10924 b_mtem(6,ja,je) = 6.71421
10925
10926
10927 !----------
10928 ! h.hso4 in e
10929 ja = jhhso4
10930
10931 ! in h2so4
10932 je = jh2so4
10933 b_mtem(1,ja,je) = 2.63953
10934 b_mtem(2,ja,je) = -6.01532
10935 b_mtem(3,ja,je) = 10.0204
10936 b_mtem(4,ja,je) = -12.4840
10937 b_mtem(5,ja,je) = 7.78853
10938 b_mtem(6,ja,je) = -2.12638
10939
10940 ! in nh4hso4
10941 je = jnh4hso4
10942 b_mtem(1,ja,je) = -0.77412
10943 b_mtem(2,ja,je) = 14.1656
10944 b_mtem(3,ja,je) = -53.4087
10945 b_mtem(4,ja,je) = 93.2013
10946 b_mtem(5,ja,je) = -80.5723
10947 b_mtem(6,ja,je) = 27.1577
10948
10949 ! in (nh4)3h(so4)2
10950 je = jlvcite
10951 b_mtem(1,ja,je) = -2.98882
10952 b_mtem(2,ja,je) = 14.4436
10953 b_mtem(3,ja,je) = -40.1774
10954 b_mtem(4,ja,je) = 67.5937
10955 b_mtem(5,ja,je) = -61.5040
10956 b_mtem(6,ja,je) = 22.3695
10957
10958 ! in (nh4)2so4
10959 je = jnh4so4
10960 b_mtem(1,ja,je) = -1.15502
10961 b_mtem(2,ja,je) = 8.12309
10962 b_mtem(3,ja,je) = -38.4726
10963 b_mtem(4,ja,je) = 80.8861
10964 b_mtem(5,ja,je) = -80.1644
10965 b_mtem(6,ja,je) = 30.4717
10966
10967 ! in nahso4
10968 je = jnahso4
10969 b_mtem(1,ja,je) = 1.99641
10970 b_mtem(2,ja,je) = -2.96061
10971 b_mtem(3,ja,je) = 5.54778
10972 b_mtem(4,ja,je) = -14.5488
10973 b_mtem(5,ja,je) = 14.8492
10974 b_mtem(6,ja,je) = -5.1389
10975
10976 ! in na3h(so4)2
10977 je = jna3hso4
10978 b_mtem(1,ja,je) = 2.23816
10979 b_mtem(2,ja,je) = -3.20847
10980 b_mtem(3,ja,je) = -4.82853
10981 b_mtem(4,ja,je) = 20.9192
10982 b_mtem(5,ja,je) = -27.2819
10983 b_mtem(6,ja,je) = 11.8655
10984
10985 ! in na2so4
10986 je = jna2so4
10987 b_mtem(1,ja,je) = 2.56907
10988 b_mtem(2,ja,je) = 1.13444
10989 b_mtem(3,ja,je) = -34.6853
10990 b_mtem(4,ja,je) = 87.9775
10991 b_mtem(5,ja,je) = -93.2330
10992 b_mtem(6,ja,je) = 35.9260
10993
10994 ! in hno3
10995 je = jhno3
10996 b_mtem(1,ja,je) = 2.00024
10997 b_mtem(2,ja,je) = -4.80868
10998 b_mtem(3,ja,je) = 8.29222
10999 b_mtem(4,ja,je) = -11.0849
11000 b_mtem(5,ja,je) = 7.51262
11001 b_mtem(6,ja,je) = -2.07654
11002
11003 ! in hcl
11004 je = jhcl
11005 b_mtem(1,ja,je) = 2.8009
11006 b_mtem(2,ja,je) = -6.98416
11007 b_mtem(3,ja,je) = 14.3146
11008 b_mtem(4,ja,je) = -22.0068
11009 b_mtem(5,ja,je) = 17.5557
11010 b_mtem(6,ja,je) = -5.84917
11011
11012
11013 !----------
11014 ! nh4hso4 in e
11015 ja = jnh4hso4
11016
11017 ! in h2so4
11018 je = jh2so4
11019 b_mtem(1,ja,je) = 0.169160
11020 b_mtem(2,ja,je) = 2.15094
11021 b_mtem(3,ja,je) = -9.62904
11022 b_mtem(4,ja,je) = 18.2631
11023 b_mtem(5,ja,je) = -17.3333
11024 b_mtem(6,ja,je) = 6.19835
11025
11026 ! in nh4hso4
11027 je = jnh4hso4
11028 b_mtem(1,ja,je) = -2.34457
11029 b_mtem(2,ja,je) = 12.8035
11030 b_mtem(3,ja,je) = -35.2513
11031 b_mtem(4,ja,je) = 53.6153
11032 b_mtem(5,ja,je) = -42.7655
11033 b_mtem(6,ja,je) = 13.7129
11034
11035 ! in (nh4)3h(so4)2
11036 je = jlvcite
11037 b_mtem(1,ja,je) = -2.56109
11038 b_mtem(2,ja,je) = 11.1414
11039 b_mtem(3,ja,je) = -30.2361
11040 b_mtem(4,ja,je) = 50.0320
11041 b_mtem(5,ja,je) = -44.1586
11042 b_mtem(6,ja,je) = 15.5393
11043
11044 ! in (nh4)2so4
11045 je = jnh4so4
11046 b_mtem(1,ja,je) = -0.97315
11047 b_mtem(2,ja,je) = 7.06295
11048 b_mtem(3,ja,je) = -29.3032
11049 b_mtem(4,ja,je) = 57.6101
11050 b_mtem(5,ja,je) = -54.9020
11051 b_mtem(6,ja,je) = 20.2222
11052
11053 ! in nahso4
11054 je = jnahso4
11055 b_mtem(1,ja,je) = -0.44450
11056 b_mtem(2,ja,je) = 3.33451
11057 b_mtem(3,ja,je) = -15.2791
11058 b_mtem(4,ja,je) = 30.1413
11059 b_mtem(5,ja,je) = -26.7710
11060 b_mtem(6,ja,je) = 8.78462
11061
11062 ! in na3h(so4)2
11063 je = jna3hso4
11064 b_mtem(1,ja,je) = -0.99780
11065 b_mtem(2,ja,je) = 4.69200
11066 b_mtem(3,ja,je) = -16.1219
11067 b_mtem(4,ja,je) = 29.3100
11068 b_mtem(5,ja,je) = -26.3383
11069 b_mtem(6,ja,je) = 9.20695
11070
11071 ! in na2so4
11072 je = jna2so4
11073 b_mtem(1,ja,je) = -0.52694
11074 b_mtem(2,ja,je) = 7.02684
11075 b_mtem(3,ja,je) = -33.7508
11076 b_mtem(4,ja,je) = 70.0565
11077 b_mtem(5,ja,je) = -68.3226
11078 b_mtem(6,ja,je) = 25.2692
11079
11080 ! in hno3
11081 je = jhno3
11082 b_mtem(1,ja,je) = 0.572926
11083 b_mtem(2,ja,je) = -2.04791
11084 b_mtem(3,ja,je) = 2.1134
11085 b_mtem(4,ja,je) = 0.246654
11086 b_mtem(5,ja,je) = -3.06019
11087 b_mtem(6,ja,je) = 1.98126
11088
11089 ! in hcl
11090 je = jhcl
11091 b_mtem(1,ja,je) = 0.56514
11092 b_mtem(2,ja,je) = 0.22287
11093 b_mtem(3,ja,je) = -2.76973
11094 b_mtem(4,ja,je) = 4.54444
11095 b_mtem(5,ja,je) = -3.86549
11096 b_mtem(6,ja,je) = 1.13441
11097
11098
11099 !----------
11100 ! (nh4)3h(so4)2 in e
11101 ja = jlvcite
11102
11103 ! in h2so4
11104 je = jh2so4
11105 b_mtem(1,ja,je) = -1.44811
11106 b_mtem(2,ja,je) = 6.71815
11107 b_mtem(3,ja,je) = -25.0141
11108 b_mtem(4,ja,je) = 50.1109
11109 b_mtem(5,ja,je) = -50.0561
11110 b_mtem(6,ja,je) = 19.3370
11111
11112 ! in nh4hso4
11113 je = jnh4hso4
11114 b_mtem(1,ja,je) = -3.41707
11115 b_mtem(2,ja,je) = 13.4496
11116 b_mtem(3,ja,je) = -34.8018
11117 b_mtem(4,ja,je) = 55.2987
11118 b_mtem(5,ja,je) = -48.1839
11119 b_mtem(6,ja,je) = 17.2444
11120
11121 ! in (nh4)3h(so4)2
11122 je = jlvcite
11123 b_mtem(1,ja,je) = -2.54479
11124 b_mtem(2,ja,je) = 11.8501
11125 b_mtem(3,ja,je) = -39.7286
11126 b_mtem(4,ja,je) = 74.2479
11127 b_mtem(5,ja,je) = -70.4934
11128 b_mtem(6,ja,je) = 26.2836
11129
11130 ! in (nh4)2so4
11131 je = jnh4so4
11132 b_mtem(1,ja,je) = -2.30561
11133 b_mtem(2,ja,je) = 14.5806
11134 b_mtem(3,ja,je) = -55.1238
11135 b_mtem(4,ja,je) = 103.451
11136 b_mtem(5,ja,je) = -95.2571
11137 b_mtem(6,ja,je) = 34.2218
11138
11139 ! in nahso4
11140 je = jnahso4
11141 b_mtem(1,ja,je) = -2.20809
11142 b_mtem(2,ja,je) = 13.6391
11143 b_mtem(3,ja,je) = -57.8246
11144 b_mtem(4,ja,je) = 117.907
11145 b_mtem(5,ja,je) = -112.154
11146 b_mtem(6,ja,je) = 40.3058
11147
11148 ! in na3h(so4)2
11149 je = jna3hso4
11150 b_mtem(1,ja,je) = -1.15099
11151 b_mtem(2,ja,je) = 6.32269
11152 b_mtem(3,ja,je) = -27.3860
11153 b_mtem(4,ja,je) = 55.4592
11154 b_mtem(5,ja,je) = -54.0100
11155 b_mtem(6,ja,je) = 20.3469
11156
11157 ! in na2so4
11158 je = jna2so4
11159 b_mtem(1,ja,je) = -1.15678
11160 b_mtem(2,ja,je) = 8.28718
11161 b_mtem(3,ja,je) = -37.3231
11162 b_mtem(4,ja,je) = 76.6124
11163 b_mtem(5,ja,je) = -74.9307
11164 b_mtem(6,ja,je) = 28.0559
11165
11166 ! in hno3
11167 je = jhno3
11168 b_mtem(1,ja,je) = 0.01502
11169 b_mtem(2,ja,je) = -3.1197
11170 b_mtem(3,ja,je) = 3.61104
11171 b_mtem(4,ja,je) = 3.05196
11172 b_mtem(5,ja,je) = -9.98957
11173 b_mtem(6,ja,je) = 6.04155
11174
11175 ! in hcl
11176 je = jhcl
11177 b_mtem(1,ja,je) = -1.06477
11178 b_mtem(2,ja,je) = 3.38801
11179 b_mtem(3,ja,je) = -12.5784
11180 b_mtem(4,ja,je) = 25.2823
11181 b_mtem(5,ja,je) = -25.4611
11182 b_mtem(6,ja,je) = 10.0754
11183
11184
11185 !----------
11186 ! nahso4 in e
11187 ja = jnahso4
11188
11189 ! in h2so4
11190 je = jh2so4
11191 b_mtem(1,ja,je) = 0.68259
11192 b_mtem(2,ja,je) = 0.71468
11193 b_mtem(3,ja,je) = -5.59003
11194 b_mtem(4,ja,je) = 11.0089
11195 b_mtem(5,ja,je) = -10.7983
11196 b_mtem(6,ja,je) = 3.82335
11197
11198 ! in nh4hso4
11199 je = jnh4hso4
11200 b_mtem(1,ja,je) = -0.03956
11201 b_mtem(2,ja,je) = 4.52828
11202 b_mtem(3,ja,je) = -25.2557
11203 b_mtem(4,ja,je) = 54.4225
11204 b_mtem(5,ja,je) = -52.5105
11205 b_mtem(6,ja,je) = 18.6562
11206
11207 ! in (nh4)3h(so4)2
11208 je = jlvcite
11209 b_mtem(1,ja,je) = -1.53503
11210 b_mtem(2,ja,je) = 8.27608
11211 b_mtem(3,ja,je) = -28.9539
11212 b_mtem(4,ja,je) = 55.2876
11213 b_mtem(5,ja,je) = -51.9563
11214 b_mtem(6,ja,je) = 18.6576
11215
11216 ! in (nh4)2so4
11217 je = jnh4so4
11218 b_mtem(1,ja,je) = -0.38793
11219 b_mtem(2,ja,je) = 7.14680
11220 b_mtem(3,ja,je) = -38.7201
11221 b_mtem(4,ja,je) = 84.3965
11222 b_mtem(5,ja,je) = -84.7453
11223 b_mtem(6,ja,je) = 32.1283
11224
11225 ! in nahso4
11226 je = jnahso4
11227 b_mtem(1,ja,je) = -0.41982
11228 b_mtem(2,ja,je) = 4.26491
11229 b_mtem(3,ja,je) = -20.2351
11230 b_mtem(4,ja,je) = 42.6764
11231 b_mtem(5,ja,je) = -40.7503
11232 b_mtem(6,ja,je) = 14.2868
11233
11234 ! in na3h(so4)2
11235 je = jna3hso4
11236 b_mtem(1,ja,je) = -0.32912
11237 b_mtem(2,ja,je) = 1.80808
11238 b_mtem(3,ja,je) = -8.01286
11239 b_mtem(4,ja,je) = 15.5791
11240 b_mtem(5,ja,je) = -14.5494
11241 b_mtem(6,ja,je) = 5.27052
11242
11243 ! in na2so4
11244 je = jna2so4
11245 b_mtem(1,ja,je) = 0.10271
11246 b_mtem(2,ja,je) = 5.09559
11247 b_mtem(3,ja,je) = -30.3295
11248 b_mtem(4,ja,je) = 66.2975
11249 b_mtem(5,ja,je) = -66.3458
11250 b_mtem(6,ja,je) = 24.9443
11251
11252 ! in hno3
11253 je = jhno3
11254 b_mtem(1,ja,je) = 0.608309
11255 b_mtem(2,ja,je) = -0.541905
11256 b_mtem(3,ja,je) = -2.52084
11257 b_mtem(4,ja,je) = 6.63297
11258 b_mtem(5,ja,je) = -7.24599
11259 b_mtem(6,ja,je) = 2.88811
11260
11261 ! in hcl
11262 je = jhcl
11263 b_mtem(1,ja,je) = 1.98399
11264 b_mtem(2,ja,je) = -4.51562
11265 b_mtem(3,ja,je) = 8.36059
11266 b_mtem(4,ja,je) = -12.4948
11267 b_mtem(5,ja,je) = 9.67514
11268 b_mtem(6,ja,je) = -3.18004
11269
11270
11271 !----------
11272 ! na3h(so4)2 in e
11273 ja = jna3hso4
11274
11275 ! in h2so4
11276 je = jh2so4
11277 b_mtem(1,ja,je) = -0.83214
11278 b_mtem(2,ja,je) = 4.99572
11279 b_mtem(3,ja,je) = -20.1697
11280 b_mtem(4,ja,je) = 41.4066
11281 b_mtem(5,ja,je) = -42.2119
11282 b_mtem(6,ja,je) = 16.4855
11283
11284 ! in nh4hso4
11285 je = jnh4hso4
11286 b_mtem(1,ja,je) = -0.65139
11287 b_mtem(2,ja,je) = 3.52300
11288 b_mtem(3,ja,je) = -22.8220
11289 b_mtem(4,ja,je) = 56.2956
11290 b_mtem(5,ja,je) = -59.9028
11291 b_mtem(6,ja,je) = 23.1844
11292
11293 ! in (nh4)3h(so4)2
11294 je = jlvcite
11295 b_mtem(1,ja,je) = -1.31331
11296 b_mtem(2,ja,je) = 8.40835
11297 b_mtem(3,ja,je) = -38.1757
11298 b_mtem(4,ja,je) = 80.5312
11299 b_mtem(5,ja,je) = -79.8346
11300 b_mtem(6,ja,je) = 30.0219
11301
11302 ! in (nh4)2so4
11303 je = jnh4so4
11304 b_mtem(1,ja,je) = -1.03054
11305 b_mtem(2,ja,je) = 8.08155
11306 b_mtem(3,ja,je) = -38.1046
11307 b_mtem(4,ja,je) = 78.7168
11308 b_mtem(5,ja,je) = -77.2263
11309 b_mtem(6,ja,je) = 29.1521
11310
11311 ! in nahso4
11312 je = jnahso4
11313 b_mtem(1,ja,je) = -1.90695
11314 b_mtem(2,ja,je) = 11.6241
11315 b_mtem(3,ja,je) = -50.3175
11316 b_mtem(4,ja,je) = 105.884
11317 b_mtem(5,ja,je) = -103.258
11318 b_mtem(6,ja,je) = 37.6588
11319
11320 ! in na3h(so4)2
11321 je = jna3hso4
11322 b_mtem(1,ja,je) = -0.34780
11323 b_mtem(2,ja,je) = 2.85363
11324 b_mtem(3,ja,je) = -17.6224
11325 b_mtem(4,ja,je) = 38.9220
11326 b_mtem(5,ja,je) = -39.8106
11327 b_mtem(6,ja,je) = 15.6055
11328
11329 ! in na2so4
11330 je = jna2so4
11331 b_mtem(1,ja,je) = -0.75230
11332 b_mtem(2,ja,je) = 10.0140
11333 b_mtem(3,ja,je) = -50.5677
11334 b_mtem(4,ja,je) = 106.941
11335 b_mtem(5,ja,je) = -105.534
11336 b_mtem(6,ja,je) = 39.5196
11337
11338 ! in hno3
11339 je = jhno3
11340 b_mtem(1,ja,je) = 0.057456
11341 b_mtem(2,ja,je) = -1.31264
11342 b_mtem(3,ja,je) = -1.94662
11343 b_mtem(4,ja,je) = 10.7024
11344 b_mtem(5,ja,je) = -14.9946
11345 b_mtem(6,ja,je) = 7.12161
11346
11347 ! in hcl
11348 je = jhcl
11349 b_mtem(1,ja,je) = 0.637894
11350 b_mtem(2,ja,je) = -2.29719
11351 b_mtem(3,ja,je) = 0.765361
11352 b_mtem(4,ja,je) = 4.8748
11353 b_mtem(5,ja,je) = -9.25978
11354 b_mtem(6,ja,je) = 4.91773
11355 !
11356 !
11357 !
11358 !----------------------------------------------------------
11359 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3 (t in kelvin)
11360 ! valid temperature range: 240 - 320 k
11361 !----------------------------------------------------------
11362 !
11363 ! sulfate-poor systems
11364 ! ac
11365 j_index = 1
11366 d_mdrh(j_index,1) = -58.00268351
11367 d_mdrh(j_index,2) = 2.031077573
11368 d_mdrh(j_index,3) = -0.008281218
11369 d_mdrh(j_index,4) = 1.00447e-05
11370
11371 ! an
11372 j_index = 2
11373 d_mdrh(j_index,1) = 1039.137773
11374 d_mdrh(j_index,2) = -11.47847095
11375 d_mdrh(j_index,3) = 0.047702786
11376 d_mdrh(j_index,4) = -6.77675e-05
11377
11378 ! as
11379 j_index = 3
11380 d_mdrh(j_index,1) = 115.8366357
11381 d_mdrh(j_index,2) = 0.491881663
11382 d_mdrh(j_index,3) = -0.00422807
11383 d_mdrh(j_index,4) = 7.29274e-06
11384
11385 ! sc
11386 j_index = 4
11387 d_mdrh(j_index,1) = 253.2424151
11388 d_mdrh(j_index,2) = -1.429957864
11389 d_mdrh(j_index,3) = 0.003727554
11390 d_mdrh(j_index,4) = -3.13037e-06
11391
11392 ! sn
11393 j_index = 5
11394 d_mdrh(j_index,1) = -372.4306506
11395 d_mdrh(j_index,2) = 5.3955633
11396 d_mdrh(j_index,3) = -0.019804438
11397 d_mdrh(j_index,4) = 2.25662e-05
11398
11399 ! ss
11400 j_index = 6
11401 d_mdrh(j_index,1) = 286.1271416
11402 d_mdrh(j_index,2) = -1.670787758
11403 d_mdrh(j_index,3) = 0.004431373
11404 d_mdrh(j_index,4) = -3.57757e-06
11405
11406 ! cc
11407 j_index = 7
11408 d_mdrh(j_index,1) = -1124.07059
11409 d_mdrh(j_index,2) = 14.26364209
11410 d_mdrh(j_index,3) = -0.054816822
11411 d_mdrh(j_index,4) = 6.70107e-05
11412
11413 ! cn
11414 j_index = 8
11415 d_mdrh(j_index,1) = 1855.413934
11416 d_mdrh(j_index,2) = -20.29219473
11417 d_mdrh(j_index,3) = 0.07807482
11418 d_mdrh(j_index,4) = -1.017887858e-4
11419
11420 ! an + ac
11421 j_index = 9
11422 d_mdrh(j_index,1) = 1761.176886
11423 d_mdrh(j_index,2) = -19.29811062
11424 d_mdrh(j_index,3) = 0.075676987
11425 d_mdrh(j_index,4) = -1.0116959e-4
11426
11427 ! as + ac
11428 j_index = 10
11429 d_mdrh(j_index,1) = 122.1074303
11430 d_mdrh(j_index,2) = 0.429692122
11431 d_mdrh(j_index,3) = -0.003928277
11432 d_mdrh(j_index,4) = 6.43275e-06
11433
11434 ! as + an
11435 j_index = 11
11436 d_mdrh(j_index,1) = 2424.634678
11437 d_mdrh(j_index,2) = -26.54031307
11438 d_mdrh(j_index,3) = 0.101625387
11439 d_mdrh(j_index,4) = -1.31544547798e-4
11440
11441 ! as + an + ac
11442 j_index = 12
11443 d_mdrh(j_index,1) = 2912.082599
11444 d_mdrh(j_index,2) = -31.8894185
11445 d_mdrh(j_index,3) = 0.121185849
11446 d_mdrh(j_index,4) = -1.556534623e-4
11447
11448 ! sc + ac
11449 j_index = 13
11450 d_mdrh(j_index,1) = 172.2596493
11451 d_mdrh(j_index,2) = -0.511006195
11452 d_mdrh(j_index,3) = 4.27244597e-4
11453 d_mdrh(j_index,4) = 4.12797e-07
11454
11455 ! sn + ac
11456 j_index = 14
11457 d_mdrh(j_index,1) = 1596.184935
11458 d_mdrh(j_index,2) = -16.37945565
11459 d_mdrh(j_index,3) = 0.060281218
11460 d_mdrh(j_index,4) = -7.6161e-05
11461
11462 ! sn + an
11463 j_index = 15
11464 d_mdrh(j_index,1) = 1916.072988
11465 d_mdrh(j_index,2) = -20.85594868
11466 d_mdrh(j_index,3) = 0.081140141
11467 d_mdrh(j_index,4) = -1.07954274796e-4
11468
11469 ! sn + an + ac
11470 j_index = 16
11471 d_mdrh(j_index,1) = 1467.165935
11472 d_mdrh(j_index,2) = -16.01166196
11473 d_mdrh(j_index,3) = 0.063505582
11474 d_mdrh(j_index,4) = -8.66722e-05
11475
11476 ! sn + sc
11477 j_index = 17
11478 d_mdrh(j_index,1) = 158.447059
11479 d_mdrh(j_index,2) = -0.628167358
11480 d_mdrh(j_index,3) = 0.002014448
11481 d_mdrh(j_index,4) = -3.13037e-06
11482
11483 ! sn + sc + ac
11484 j_index = 18
11485 d_mdrh(j_index,1) = 1115.892468
11486 d_mdrh(j_index,2) = -11.76936534
11487 d_mdrh(j_index,3) = 0.045577399
11488 d_mdrh(j_index,4) = -6.05779e-05
11489
11490 ! ss + ac
11491 j_index = 19
11492 d_mdrh(j_index,1) = 269.5432407
11493 d_mdrh(j_index,2) = -1.319963885
11494 d_mdrh(j_index,3) = 0.002592363
11495 d_mdrh(j_index,4) = -1.44479e-06
11496
11497 ! ss + an
11498 j_index = 20
11499 d_mdrh(j_index,1) = 2841.334784
11500 d_mdrh(j_index,2) = -31.1889487
11501 d_mdrh(j_index,3) = 0.118809274
11502 d_mdrh(j_index,4) = -1.53007e-4
11503
11504 ! ss + an + ac
11505 j_index = 21
11506 d_mdrh(j_index,1) = 2199.36914
11507 d_mdrh(j_index,2) = -24.11926569
11508 d_mdrh(j_index,3) = 0.092932361
11509 d_mdrh(j_index,4) = -1.21774e-4
11510
11511 ! ss + as
11512 j_index = 22
11513 d_mdrh(j_index,1) = 395.0051604
11514 d_mdrh(j_index,2) = -2.521101657
11515 d_mdrh(j_index,3) = 0.006139319
11516 d_mdrh(j_index,4) = -4.43756e-06
11517
11518 ! ss + as + ac
11519 j_index = 23
11520 d_mdrh(j_index,1) = 386.5150675
11521 d_mdrh(j_index,2) = -2.4632138
11522 d_mdrh(j_index,3) = 0.006139319
11523 d_mdrh(j_index,4) = -4.98796e-06
11524
11525 ! ss + as + an
11526 j_index = 24
11527 d_mdrh(j_index,1) = 3101.538491
11528 d_mdrh(j_index,2) = -34.19978105
11529 d_mdrh(j_index,3) = 0.130118605
11530 d_mdrh(j_index,4) = -1.66873e-4
11531
11532 ! ss + as + an + ac
11533 j_index = 25
11534 d_mdrh(j_index,1) = 2307.579403
11535 d_mdrh(j_index,2) = -25.43136774
11536 d_mdrh(j_index,3) = 0.098064728
11537 d_mdrh(j_index,4) = -1.28301e-4
11538
11539 ! ss + sc
11540 j_index = 26
11541 d_mdrh(j_index,1) = 291.8309602
11542 d_mdrh(j_index,2) = -1.828912974
11543 d_mdrh(j_index,3) = 0.005053148
11544 d_mdrh(j_index,4) = -4.57516e-06
11545
11546 ! ss + sc + ac
11547 j_index = 27
11548 d_mdrh(j_index,1) = 188.3914345
11549 d_mdrh(j_index,2) = -0.631345031
11550 d_mdrh(j_index,3) = 0.000622807
11551 d_mdrh(j_index,4) = 4.47196e-07
11552
11553 ! ss + sn
11554 j_index = 28
11555 d_mdrh(j_index,1) = -167.1252839
11556 d_mdrh(j_index,2) = 2.969828002
11557 d_mdrh(j_index,3) = -0.010637255
11558 d_mdrh(j_index,4) = 1.13175e-05
11559
11560 ! ss + sn + ac
11561 j_index = 29
11562 d_mdrh(j_index,1) = 1516.782768
11563 d_mdrh(j_index,2) = -15.7922661
11564 d_mdrh(j_index,3) = 0.058942209
11565 d_mdrh(j_index,4) = -7.5301e-05
11566
11567 ! ss + sn + an
11568 j_index = 30
11569 d_mdrh(j_index,1) = 1739.963163
11570 d_mdrh(j_index,2) = -19.06576022
11571 d_mdrh(j_index,3) = 0.07454963
11572 d_mdrh(j_index,4) = -9.94302e-05
11573
11574 ! ss + sn + an + ac
11575 j_index = 31
11576 d_mdrh(j_index,1) = 2152.104877
11577 d_mdrh(j_index,2) = -23.74998008
11578 d_mdrh(j_index,3) = 0.092256654
11579 d_mdrh(j_index,4) = -1.21953e-4
11580
11581 ! ss + sn + sc
11582 j_index = 32
11583 d_mdrh(j_index,1) = 221.9976265
11584 d_mdrh(j_index,2) = -1.311331272
11585 d_mdrh(j_index,3) = 0.004406089
11586 d_mdrh(j_index,4) = -5.88235e-06
11587
11588 ! ss + sn + sc + ac
11589 j_index = 33
11590 d_mdrh(j_index,1) = 1205.645615
11591 d_mdrh(j_index,2) = -12.71353459
11592 d_mdrh(j_index,3) = 0.048803922
11593 d_mdrh(j_index,4) = -6.41899e-05
11594
11595 ! cc + ac
11596 j_index = 34
11597 d_mdrh(j_index,1) = 506.6737879
11598 d_mdrh(j_index,2) = -3.723520818
11599 d_mdrh(j_index,3) = 0.010814242
11600 d_mdrh(j_index,4) = -1.21087e-05
11601
11602 ! cc + sc
11603 j_index = 35
11604 d_mdrh(j_index,1) = -1123.523841
11605 d_mdrh(j_index,2) = 14.08345977
11606 d_mdrh(j_index,3) = -0.053687823
11607 d_mdrh(j_index,4) = 6.52219e-05
11608
11609 ! cc + sc + ac
11610 j_index = 36
11611 d_mdrh(j_index,1) = -1159.98607
11612 d_mdrh(j_index,2) = 14.44309169
11613 d_mdrh(j_index,3) = -0.054841073
11614 d_mdrh(j_index,4) = 6.64259e-05
11615
11616 ! cn + ac
11617 j_index = 37
11618 d_mdrh(j_index,1) = 756.0747916
11619 d_mdrh(j_index,2) = -8.546826257
11620 d_mdrh(j_index,3) = 0.035798677
11621 d_mdrh(j_index,4) = -5.06629e-05
11622
11623 ! cn + an
11624 j_index = 38
11625 d_mdrh(j_index,1) = 338.668191
11626 d_mdrh(j_index,2) = -2.971223403
11627 d_mdrh(j_index,3) = 0.012294866
11628 d_mdrh(j_index,4) = -1.87558e-05
11629
11630 ! cn + an + ac
11631 j_index = 39
11632 d_mdrh(j_index,1) = -53.18033508
11633 d_mdrh(j_index,2) = 0.663911748
11634 d_mdrh(j_index,3) = 9.16326e-4
11635 d_mdrh(j_index,4) = -6.70354e-06
11636
11637 ! cn + sc
11638 j_index = 40
11639 d_mdrh(j_index,1) = 3623.831129
11640 d_mdrh(j_index,2) = -39.27226457
11641 d_mdrh(j_index,3) = 0.144559515
11642 d_mdrh(j_index,4) = -1.78159e-4
11643
11644 ! cn + sc + ac
11645 j_index = 41
11646 d_mdrh(j_index,1) = 3436.656743
11647 d_mdrh(j_index,2) = -37.16192684
11648 d_mdrh(j_index,3) = 0.136641377
11649 d_mdrh(j_index,4) = -1.68262e-4
11650
11651 ! cn + sn
11652 j_index = 42
11653 d_mdrh(j_index,1) = 768.608476
11654 d_mdrh(j_index,2) = -8.051517149
11655 d_mdrh(j_index,3) = 0.032342332
11656 d_mdrh(j_index,4) = -4.52224e-05
11657
11658 ! cn + sn + ac
11659 j_index = 43
11660 d_mdrh(j_index,1) = 33.58027951
11661 d_mdrh(j_index,2) = -0.308772182
11662 d_mdrh(j_index,3) = 0.004713639
11663 d_mdrh(j_index,4) = -1.19658e-05
11664
11665 ! cn + sn + an
11666 j_index = 44
11667 d_mdrh(j_index,1) = 57.80183041
11668 d_mdrh(j_index,2) = 0.215264604
11669 d_mdrh(j_index,3) = 4.11406e-4
11670 d_mdrh(j_index,4) = -4.30702e-06
11671
11672 ! cn + sn + an + ac
11673 j_index = 45
11674 d_mdrh(j_index,1) = -234.368984
11675 d_mdrh(j_index,2) = 2.721045204
11676 d_mdrh(j_index,3) = -0.006688341
11677 d_mdrh(j_index,4) = 2.31729e-06
11678
11679 ! cn + sn + sc
11680 j_index = 46
11681 d_mdrh(j_index,1) = 3879.080557
11682 d_mdrh(j_index,2) = -42.13562874
11683 d_mdrh(j_index,3) = 0.155235005
11684 d_mdrh(j_index,4) = -1.91387e-4
11685
11686 ! cn + sn + sc + ac
11687 j_index = 47
11688 d_mdrh(j_index,1) = 3600.576985
11689 d_mdrh(j_index,2) = -39.0283489
11690 d_mdrh(j_index,3) = 0.143710316
11691 d_mdrh(j_index,4) = -1.77167e-4
11692
11693 ! cn + cc
11694 j_index = 48
11695 d_mdrh(j_index,1) = -1009.729826
11696 d_mdrh(j_index,2) = 12.9145339
11697 d_mdrh(j_index,3) = -0.049811146
11698 d_mdrh(j_index,4) = 6.09563e-05
11699
11700 ! cn + cc + ac
11701 j_index = 49
11702 d_mdrh(j_index,1) = -577.0919514
11703 d_mdrh(j_index,2) = 8.020324227
11704 d_mdrh(j_index,3) = -0.031469556
11705 d_mdrh(j_index,4) = 3.82181e-05
11706
11707 ! cn + cc + sc
11708 j_index = 50
11709 d_mdrh(j_index,1) = -728.9983499
11710 d_mdrh(j_index,2) = 9.849458215
11711 d_mdrh(j_index,3) = -0.03879257
11712 d_mdrh(j_index,4) = 4.78844e-05
11713
11714 ! cn + cc + sc + ac
11715 j_index = 51
11716 d_mdrh(j_index,1) = -803.7026845
11717 d_mdrh(j_index,2) = 10.61881494
11718 d_mdrh(j_index,3) = -0.041402993
11719 d_mdrh(j_index,4) = 5.08084e-05
11720
11721 !
11722 ! sulfate-rich systems
11723 ! ab
11724 j_index = 52
11725 d_mdrh(j_index,1) = -493.6190458
11726 d_mdrh(j_index,2) = 6.747053851
11727 d_mdrh(j_index,3) = -0.026955267
11728 d_mdrh(j_index,4) = 3.45118e-05
11729
11730 ! lv
11731 j_index = 53
11732 d_mdrh(j_index,1) = 53.37874093
11733 d_mdrh(j_index,2) = 1.01368249
11734 d_mdrh(j_index,3) = -0.005887513
11735 d_mdrh(j_index,4) = 8.94393e-06
11736
11737 ! sb
11738 j_index = 54
11739 d_mdrh(j_index,1) = 206.619047
11740 d_mdrh(j_index,2) = -1.342735684
11741 d_mdrh(j_index,3) = 0.003197691
11742 d_mdrh(j_index,4) = -1.93603e-06
11743
11744 ! ab + lv
11745 j_index = 55
11746 d_mdrh(j_index,1) = -493.6190458
11747 d_mdrh(j_index,2) = 6.747053851
11748 d_mdrh(j_index,3) = -0.026955267
11749 d_mdrh(j_index,4) = 3.45118e-05
11750
11751 ! as + lv
11752 j_index = 56
11753 d_mdrh(j_index,1) = 53.37874093
11754 d_mdrh(j_index,2) = 1.01368249
11755 d_mdrh(j_index,3) = -0.005887513
11756 d_mdrh(j_index,4) = 8.94393e-06
11757
11758 ! ss + sb
11759 j_index = 57
11760 d_mdrh(j_index,1) = 206.619047
11761 d_mdrh(j_index,2) = -1.342735684
11762 d_mdrh(j_index,3) = 0.003197691
11763 d_mdrh(j_index,4) = -1.93603e-06
11764
11765 ! ss + lv
11766 j_index = 58
11767 d_mdrh(j_index,1) = 41.7619047
11768 d_mdrh(j_index,2) = 1.303872053
11769 d_mdrh(j_index,3) = -0.007647908
11770 d_mdrh(j_index,4) = 1.17845e-05
11771
11772 ! ss + as + lv
11773 j_index = 59
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 + ab
11780 j_index = 60
11781 d_mdrh(j_index,1) = -369.7142842
11782 d_mdrh(j_index,2) = 5.512878771
11783 d_mdrh(j_index,3) = -0.02301948
11784 d_mdrh(j_index,4) = 3.0303e-05
11785
11786 ! ss + lv + ab
11787 j_index = 61
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 ! sb + ab
11794 j_index = 62
11795 d_mdrh(j_index,1) = -162.8095232
11796 d_mdrh(j_index,2) = 2.399326592
11797 d_mdrh(j_index,3) = -0.009336219
11798 d_mdrh(j_index,4) = 1.17845e-05
11799
11800 ! ss + sb + ab
11801 j_index = 63
11802 d_mdrh(j_index,1) = -735.4285689
11803 d_mdrh(j_index,2) = 8.885521857
11804 d_mdrh(j_index,3) = -0.033488456
11805 d_mdrh(j_index,4) = 4.12458e-05
11806
11807
11808 endif ! first
11809
11810 return
11811 end subroutine load_mosaic_parameters
11812
11813
11814
11815
11816
11817
11818
11819
11820
11821
11822
11823 !***********************************************************************
11824 ! updates all temperature dependent thermodynamic parameters
11825 !
11826 ! author: rahul a. zaveri
11827 ! update: jan 2005
11828 !-----------------------------------------------------------------------
11829 subroutine update_thermodynamic_constants
11830 ! implicit none
11831 ! include 'mosaic.h'
11832 ! local variables
11833 integer iv, j_index, ibin, je
11834 real(kind=8) tr, rt, term
11835 ! function
11836 ! real(kind=8) fn_keq, fn_po, drh_mutual, bin_molality
11837
11838
11839 tr = 298.15 ! reference temperature
11840 rt = 82.056*t_k/(1.e9*1.e6) ! [m^3 atm/nmol]
11841
11842 ! gas-liquid
11843 keq_gl(1)= 1.0 ! kelvin effect (default)
11844 keq_gl(2)= fn_keq(57.64d0 , 13.79d0, -5.39d0,t_k)*rt ! nh3(g) <=> nh3(l)
11845 keq_gl(3)= fn_keq(2.63d6, 29.17d0, 16.83d0,t_k)*rt ! hno3(g) <=> no3- + h+
11846 keq_gl(4)= fn_keq(2.00d6, 30.20d0, 19.91d0,t_k)*rt ! hcl(g) <=> cl- + h+
11847
11848 ! liquid-liquid
11849 keq_ll(1)= fn_keq(1.0502d-2, 8.85d0, 25.14d0,t_k) ! hso4- <=> so4= + h+
11850 keq_ll(2)= fn_keq(1.805d-5, -1.50d0, 26.92d0,t_k) ! nh3(l) + h2o = nh4+ + oh-
11851 keq_ll(3)= fn_keq(1.01d-14,-22.52d0, 26.92d0,t_k) ! h2o(l) <=> h+ + oh-
11852
11853
11854 kp_nh3 = keq_ll(3)/(keq_ll(2)*keq_gl(2))
11855 kp_nh4no3= kp_nh3/keq_gl(3)
11856 kp_nh4cl = kp_nh3/keq_gl(4)
11857
11858
11859 ! solid-gas
11860 keq_sg(1)= fn_keq(4.72d-17,-74.38d0,6.12d0,t_k)/rt**2 ! nh4no3<=>nh3(g)+hno3(g)
11861 keq_sg(2)= fn_keq(8.43d-17,-71.00d0,2.40d0,t_k)/rt**2 ! nh4cl <=>nh3(g)+hcl(g)
11862
11863
11864 ! solid-liquid
11865 keq_sl(jnh4so4) = fn_keq(1.040d0,-2.65d0, 38.57d0, t_k) ! amso4(s) = 2nh4+ + so4=
11866 keq_sl(jlvcite) = fn_keq(11.8d0, -5.19d0, 54.40d0, t_k) ! lvcite(s)= 3nh4+ + hso4- + so4=
11867 keq_sl(jnh4hso4)= fn_keq(117.0d0,-2.87d0, 15.83d0, t_k) ! amhso4(s)= nh4+ + hso4-
11868 keq_sl(jnh4msa) = 1.e15 ! NH4MSA(s)= NH4+ + MSA-
11869 keq_sl(jnh4no3) = fn_keq(12.21d0,-10.4d0, 17.56d0, t_k) ! nh4no3(s)= nh4+ + no3-
11870 keq_sl(jnh4cl) = fn_keq(17.37d0,-6.03d0, 16.92d0, t_k) ! nh4cl(s) = nh4+ + cl-
11871 keq_sl(jna2so4) = fn_keq(0.491d0, 0.98d0, 39.75d0, t_k) ! na2so4(s)= 2na+ + so4=
11872 keq_sl(jnahso4) = fn_keq(313.0d0, 0.8d0, 14.79d0, t_k) ! nahso4(s)= na+ + hso4-
11873 keq_sl(jna3hso4)= 1.e15 ! na3h(so4)2(s) = 2na+ + hso4- + so4=
11874 keq_sl(jnamsa) = 1.e15 ! NaMSA(s) = Na+ + MSA-
11875 keq_sl(jnano3) = fn_keq(11.95d0,-8.22d0, 16.01d0, t_k) ! nano3(s) = na+ + no3-
11876 keq_sl(jnacl) = fn_keq(38.28d0,-1.52d0, 16.89d0, t_k) ! nacl(s) = na+ + cl-
11877 keq_sl(jcacl2) = fn_keq(8.0d11,32.84d0,44.79d0, t_k)*1.e5 ! cacl2(s) = ca++ + 2cl-
11878 keq_sl(jcano3) = fn_keq(4.31d5, 7.83d0,42.01d0, t_k)*1.e5 ! ca(no3)2(s) = ca++ + 2no3-
11879 keq_sl(jcamsa2) = 1.e15 ! CaMSA2(s)= Ca+ + 2MSA-
11880
11881 ! vapor pressures of soa species
11882 po_soa(iaro1_g) = fn_po(5.7d-5, 156.0d0, t_k) ! [pascal]
11883 po_soa(iaro2_g) = fn_po(1.6d-3, 156.0d0, t_k) ! [pascal]
11884 po_soa(ialk1_g) = fn_po(5.0d-6, 156.0d0, t_k) ! [pascal]
11885 po_soa(iole1_g) = fn_po(5.0d-6, 156.0d0, t_k) ! [pascal]
11886 po_soa(iapi1_g) = fn_po(4.0d-6, 156.0d0, t_k) ! [pascal]
11887 po_soa(iapi2_g) = fn_po(1.7d-4, 156.0d0, t_k) ! [pascal]
11888 po_soa(ilim1_g) = fn_po(2.5d-5, 156.0d0, t_k) ! [pascal]
11889 po_soa(ilim2_g) = fn_po(1.2d-4, 156.0d0, t_k) ! [pascal]
11890
11891 do iv = iaro1_g, ngas_volatile
11892 sat_soa(iv) = 1.e9*po_soa(iv)/(8.314*t_k) ! [nmol/m^3(air)]
11893 enddo
11894
11895 ! water surface tension
11896 term = (647.15 - t_k)/647.15
11897 sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
11898
11899 ! mdrh(t)
11900 do j_index = 1, 63
11901 mdrh_t(j_index) = drh_mutual(j_index)
11902 enddo
11903
11904
11905
11906 ! rh dependent parameters
11907 do ibin = 1, nbin_a
11908 ah2o_a(ibin) = ah2o ! initialize
11909 enddo
11910
11911 call mtem_compute_log_gamz ! function of ah2o and t
11912
11913
11914 return
11915 end subroutine update_thermodynamic_constants
11916
11917
11918
11919
11920 !***********************************************************************
11921 ! functions used in mosaic
11922 !
11923 ! author: rahul a. zaveri
11924 ! update: jan 2005
11925 !-----------------------------------------------------------------------
11926
11927
11928
11929 !----------------------------------------------------------
11930 real(kind=8) function fn_keq(keq_298, a, b, t)
11931 ! implicit none
11932 ! subr. arguments
11933 real(kind=8) keq_298, a, b, t
11934 ! local variables
11935 real(kind=8) tt
11936
11937
11938 tt = 298.15/t
11939 fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+log(tt)-tt))
11940
11941 return
11942 end function fn_keq
11943 !----------------------------------------------------------
11944
11945
11946
11947
11948
11949 !----------------------------------------------------------
11950 real(kind=8) function fn_po(po_298, dh, t) ! touch
11951 ! implicit none
11952 ! subr. arguments
11953 real(kind=8) po_298, dh, t
11954 ! local variables
11955
11956 fn_po = po_298*exp(-(dh/8.314e-3)*(1./t - 3.354016435e-3))
11957
11958 return
11959 end function fn_po
11960 !----------------------------------------------------------
11961
11962
11963
11964
11965
11966 !----------------------------------------------------------
11967 real(kind=8) function drh_mutual(j_index)
11968 ! implicit none
11969 ! include 'mosaic.h'
11970 ! subr. arguments
11971 integer j_index
11972 ! local variables
11973 integer j
11974
11975
11976 j = j_index
11977
11978 if(j_index .eq. 7 .or. j_index .eq. 8 .or. &
11979 (j_index.ge. 34 .and. j_index .le. 51))then
11980
11981 drh_mutual = 10.0 ! cano3 or cacl2 containing mixtures
11982
11983 else
11984
11985 drh_mutual = d_mdrh(j,1) + t_k* &
11986 (d_mdrh(j,2) + t_k* &
11987 (d_mdrh(j,3) + t_k* &
11988 d_mdrh(j,4) )) + 1.0
11989
11990 endif
11991
11992
11993 return
11994 end function drh_mutual
11995 !----------------------------------------------------------
11996
11997
11998
11999
12000
12001
12002 !----------------------------------------------------------
12003 ! zsr method at 60% rh
12004 !
12005 real(kind=8) function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
12006 ! implicit none
12007 ! include 'mosaic.h'
12008 ! subr. arguments
12009 integer ibin
12010 ! local variables
12011 integer jp, je
12012 real(kind=8) dum
12013 ! function
12014 ! real(kind=8) bin_molality_60
12015
12016
12017 jp = jtotal
12018 dum = 0.0
12019
12020 do je = 1, (nsalt+4) ! include hno3 and hcl in water calculation
12021 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
12022 enddo
12023
12024 aerosol_water_up = dum
12025
12026 return
12027 end function aerosol_water_up
12028 !----------------------------------------------------------
12029
12030
12031
12032
12033
12034
12035 !----------------------------------------------------------
12036 ! zsr method
12037 real(kind=8) function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
12038 ! implicit none
12039 ! include 'mosaic.h'
12040 ! subr. arguments
12041 integer jp, ibin
12042 ! local variables
12043 integer je
12044 real(kind=8) dum
12045 ! function
12046 ! real(kind=8) bin_molality
12047
12048
12049
12050 dum = 0.0
12051 do je = 1, (nsalt+4) ! include hno3 and hcl in water calculation
12052 dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality(je,ibin)
12053 enddo
12054
12055 aerosol_water = dum
12056
12057 if(aerosol_water .le. 0.0)then
12058 if (iprint_mosaic_diag1 .gt. 0) then
12059 write(6,*)'mosaic aerosol_water - water .le. 0'
12060 write(6,*)'iclm jclm ibin jp = ', &
12061 iclm_aer, jclm_aer, ibin, jp
12062 write(6,*)'ah2o, water = ', ah2o, aerosol_water
12063 write(6,*)'dry mass = ', mass_dry_a(ibin)
12064 write(6,*)'soluble mass = ', mass_soluble_a(ibin)
12065 write(6,*)'number = ', num_a(ibin)
12066 do je = 1, nsoluble
12067 write(6,44)ename(je), electrolyte(je,jp,ibin)
12068 enddo
12069 write(6,*)'error in water calculation'
12070 write(6,*)'ibin = ', ibin
12071 write(6,*)'water content cannot be negative or zero'
12072 write(6,*)'setting jaerosolstate to all_solid'
12073 endif
12074
12075 call print_input
12076
12077 jaerosolstate(ibin) = all_solid
12078 jphase(ibin) = jsolid
12079 jhyst_leg(ibin) = jhyst_lo
12080
12081 !c write(6,*)'stopping execution in function aerosol_water'
12082 !c stop
12083 endif
12084
12085 44 format(a7, 2x, e11.3)
12086
12087
12088 return
12089 end function aerosol_water
12090 !----------------------------------------------------------
12091
12092
12093
12094
12095
12096 !----------------------------------------------------------
12097 real(kind=8) function bin_molality(je,ibin)
12098 ! implicit none
12099 ! include 'mosaic.h'
12100 ! subr. arguments
12101 integer je, ibin
12102 ! local variables
12103 real(kind=8) aw, xm
12104
12105
12106 aw = max(ah2o_a(ibin), aw_min(je))
12107 aw = min(aw, 0.999999D0)
12108
12109
12110 if(aw .lt. 0.97)then
12111
12112 xm = a_zsr(1,je) + &
12113 aw*(a_zsr(2,je) + &
12114 aw*(a_zsr(3,je) + &
12115 aw*(a_zsr(4,je) + &
12116 aw*(a_zsr(5,je) + &
12117 aw* a_zsr(6,je) ))))
12118
12119 bin_molality = 55.509*xm/(1. - xm)
12120
12121 else
12122
12123 bin_molality = -b_zsr(je)*log(aw)
12124
12125 endif
12126
12127
12128 return
12129 end function bin_molality
12130 !----------------------------------------------------------
12131
12132
12133
12134
12135
12136 !----------------------------------------------------------
12137 real(kind=8) function bin_molality_60(je)
12138 ! implicit none
12139 ! include 'mosaic.h'
12140 ! subr. arguments
12141 integer je
12142 ! local variables
12143 real(kind=8) aw, xm
12144
12145
12146 aw = 0.6
12147
12148 xm = a_zsr(1,je) + aw* &
12149 (a_zsr(2,je) + aw* &
12150 (a_zsr(3,je) + aw* &
12151 (a_zsr(4,je) + aw* &
12152 (a_zsr(5,je) + aw* &
12153 a_zsr(6,je) ))))
12154
12155 bin_molality_60 = 55.509*xm/(1. - xm)
12156
12157 return
12158 end function bin_molality_60
12159 !----------------------------------------------------------
12160
12161
12162
12163
12164
12165 !----------------------------------------------------------
12166 real(kind=8) function fnlog_gamz(ja,je) ! ja in je
12167 ! implicit none
12168 ! include 'mosaic.h'
12169 ! subr. arguments
12170 integer ja, je
12171 ! local variables
12172 real(kind=8) aw
12173
12174
12175 aw = max(ah2o, aw_min(je))
12176
12177 fnlog_gamz = b_mtem(1,ja,je) + aw* &
12178 (b_mtem(2,ja,je) + aw* &
12179 (b_mtem(3,ja,je) + aw* &
12180 (b_mtem(4,ja,je) + aw* &
12181 (b_mtem(5,ja,je) + aw* &
12182 b_mtem(6,ja,je) ))))
12183
12184 return
12185 end function fnlog_gamz
12186 !----------------------------------------------------------
12187
12188
12189
12190
12191 !----------------------------------------------------------
12192 real(kind=8) function mean_molecular_speed(t, mw) ! in cm/s
12193 ! implicit none
12194 ! subr. arguments
12195 real(kind=8) t, mw ! t(k)
12196
12197 mean_molecular_speed = 1.455e4 * sqrt(t/mw)
12198
12199 return
12200 end function mean_molecular_speed
12201 !----------------------------------------------------------
12202
12203
12204
12205
12206 !----------------------------------------------------------
12207 real(kind=8) function gas_diffusivity(t, p, mw, vm) ! in cm^2/s
12208 ! implicit none
12209 ! subr. arguments
12210 real(kind=8) mw, vm, t, p ! t(k), p(atm)
12211
12212
12213 gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/ &
12214 (p * (vm**0.333333 + 2.7189)**2)
12215
12216
12217 return
12218 end function gas_diffusivity
12219 !----------------------------------------------------------
12220
12221
12222
12223
12224 !----------------------------------------------------------
12225 real(kind=8) function fuchs_sutugin(rkn,a)
12226 ! implicit none
12227 ! subr. arguments
12228 real(kind=8) rkn, a
12229 ! local variables
12230 real(kind=8) rnum, denom
12231
12232
12233 rnum = 0.75*a*(1. + rkn)
12234 denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
12235 fuchs_sutugin = rnum/denom
12236
12237 return
12238 end function fuchs_sutugin
12239 !----------------------------------------------------------
12240
12241
12242
12243
12244
12245 !----------------------------------------------------------
12246 ! solution to x^3 + px^2 + qx + r = 0
12247 !
12248 real(kind=8) function cubic( p, q, r )
12249 ! implicit none
12250 ! subr arguments
12251 real(kind=8), intent(in) :: p, q, r
12252 ! local variables
12253 real(kind=8) a, b, d, m, n, third, y
12254 real(kind=8) k, phi, thesign, x(3), duma
12255 integer icase, kk
12256
12257 third = 1.d0/3.d0
12258
12259 a = (1.d0/3.d0)*((3.d0*q) - (p*p))
12260 b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
12261
12262 d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
12263
12264 if(d .gt. 0.)then ! => 1 real and 2 complex roots
12265 icase = 1
12266 elseif(d .eq. 0.)then ! => 3 real roots, atleast 2 identical
12267 icase = 2
12268 else ! d < 0 => 3 distinct real roots
12269 icase = 3
12270 endif
12271
12272
12273 goto (1,2,3), icase
12274
12275 ! case 1: d > 0
12276 1 thesign = 1.
12277 if(b .gt. 0.)then
12278 b = -b
12279 thesign = -1.
12280 endif
12281
12282 m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
12283 n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
12284
12285 cubic = real( (m) + (n) - (p/3.d0) )
12286 return
12287
12288 ! case 2: d = 0
12289 2 thesign = 1.
12290 if(b .gt. 0.)then
12291 b = -b
12292 thesign = -1.
12293 endif
12294
12295 m = thesign*(-b/2.d0)**third
12296 n = m
12297
12298 x(1) = real( (m) + (n) - (p/3.d0) )
12299 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12300 x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12301
12302 cubic = 0.
12303 do kk = 1, 3
12304 if(x(kk).gt.cubic) cubic = x(kk)
12305 enddo
12306 return
12307
12308 ! case 3: d < 0
12309 3 if(b.gt.0.)then
12310 thesign = -1.
12311 elseif(b.lt.0.)then
12312 thesign = 1.
12313 endif
12314
12315 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
12316 ! phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )) ! radians
12317 duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
12318 duma = min( duma, +1.0D0 )
12319 duma = max( duma, -1.0D0 )
12320 phi = acos( duma ) ! radians
12321
12322
12323 cubic = 0.
12324 do kk = 1, 3
12325 k = kk-1
12326 y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
12327 x(kk) = real((y) - (p/3.d0))
12328 if(x(kk).gt.cubic) cubic = x(kk)
12329 enddo
12330 return
12331
12332 end function cubic
12333 !----------------------------------------------------------
12334
12335
12336
12337
12338 !----------------------------------------------------------
12339 real(kind=8) function quadratic(a,b,c)
12340 ! implicit none
12341 ! subr. arguments
12342 real(kind=8) a, b, c
12343 ! local variables
12344 real(kind=8) x, dum, quad1, quad2
12345
12346
12347 if(b .ne. 0.0)then
12348 x = 4.*(a/b)*(c/b)
12349 else
12350 x = 1.e+6
12351 endif
12352
12353 if(abs(x) .lt. 1.e-6)then
12354 dum = (0.5*x) + &
12355 (0.125*x**2) + &
12356 (0.0625*x**3)
12357
12358 quadratic = (-0.5*b/a)*dum
12359
12360 if(quadratic .lt. 0.)then
12361 quadratic = -b/a - quadratic
12362 endif
12363
12364 else
12365 quad1 = (-b+sqrt(b*b-4.*a*c))/(2.*a)
12366 quad2 = (-b-sqrt(b*b-4.*a*c))/(2.*a)
12367
12368 quadratic = max(quad1, quad2)
12369 endif
12370
12371 return
12372 end function quadratic
12373 !----------------------------------------------------------
12374
12375
12376
12377 !----------------------------------------------------------
12378 ! currently not used
12379
12380 ! two roots of a quadratic equation
12381
12382 subroutine quadratix(a,b,c, qx1,qx2)
12383 ! implicit none
12384 ! subr. arguments
12385 real(kind=8) a, b, c, qx1, qx2
12386 ! local variables
12387 real(kind=8) x, dum
12388
12389
12390 if(b .ne. 0.0)then
12391 x = 4.*(a/b)*(c/b)
12392 else
12393 x = 1.e+6
12394 endif
12395
12396 if(abs(x) .lt. 1.e-6)then
12397 dum = (0.5*x) + &
12398 (0.125*x**2) + &
12399 (0.0625*x**3)
12400
12401 qx1 = (-0.5*b/a)*dum
12402 qx2 = -b/a - qx1
12403
12404 else
12405
12406 qx1 = (-b+sqrt(b*b - 4.*a*c))/(2.*a)
12407 qx2 = (-b-sqrt(b*b - 4.*a*c))/(2.*a)
12408
12409 endif
12410
12411 return
12412 end subroutine quadratix
12413
12414
12415 !=====================================================================
12416
12417
12418
12419
12420
12421
12422
12423
12424
12425
12426
12427
12428
12429
12430
12431
12432
12433 !***********************************************************************
12434 ! computes aerosol optical properties
12435 !
12436 ! author: rahul a. zaveri
12437 ! update: jan 2005
12438 !-----------------------------------------------------------------------
12439 subroutine aerosol_optical_properties(iclm, jclm, nz, refindx, &
12440 radius_wet, number_bin)
12441 ! changed to use rsub instead of rclm 7-8-04 egc
12442 use module_data_mosaic_asect
12443 use module_data_mosaic_other
12444 use module_state_description, only: param_first_scalar
12445
12446 ! implicit none
12447
12448 ! subr arguments
12449 integer, intent(in ) :: iclm, jclm, nz
12450 real, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12451 number_bin, radius_wet
12452 complex, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12453 refindx
12454
12455 ! local variables
12456 integer iaer, ibin, iphase, isize, itype, je, k, l, m
12457 integer ilaporte, jlaporte
12458 integer p1st
12459 real(kind=8) xt
12460
12461
12462 ! if a species index is less than this value, then the species is not defined
12463 p1st = param_first_scalar
12464
12465 ! fix number of subareas at 1
12466 nsubareas = 1
12467
12468 lunerr_aer = lunerr
12469 ncorecnt_aer = ncorecnt
12470
12471 call load_mosaic_parameters
12472
12473 iclm_aer = iclm
12474 jclm_aer = jclm
12475
12476 do 110 m = 1, nsubareas
12477 do 100 k = 1, nz
12478
12479 mclm_aer = m
12480 kclm_aer = k
12481
12482 cair_mol_m3 = cairclm(k)*1.e6 ! cairclm(k) is in mol/cc
12483 cair_mol_cc = cairclm(k)
12484
12485 conv1a = cair_mol_m3*1.e9 ! converts q/mol(air) to nq/m^3 (q = mol or g)
12486 conv1b = 1./conv1a ! converts nq/m^3 to q/mol(air)
12487 conv2a = cair_mol_m3*18.*1.e-3 ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
12488 conv2b = 1./conv2a ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
12489
12490
12491 ! initialize to zero
12492 do ibin = 1, nbin_a
12493 do iaer = 1, naer
12494 aer(iaer,jtotal,ibin) = 0.0
12495 enddo
12496
12497 do je = 1, nelectrolyte
12498 electrolyte(je,jtotal,ibin) = 0.0
12499 enddo
12500
12501 jaerosolstate(ibin) = -1 ! initialize to default value
12502
12503 enddo
12504
12505
12506 ! rce 18-nov-2004 - map (transfer) aerosol mass/water/number from rsub
12507 ! to mosaic arrays (aer, watr_a, num_a)
12508 ! always map so4 and number,
12509 ! but only map other species when (lptr_xxx .ge. p1st)
12510 ! (the mapping is identical to that done in mapgasaerspecies)
12511
12512 iphase = ai_phase
12513 ibin = 0
12514 do 90 itype = 1, ntype_aer
12515 do 90 isize = 1, nsize_aer(itype)
12516 ibin = ibin + 1
12517
12518 ! aer array units are nmol/(m^3 air)
12519 l = lptr_so4_aer(isize,itype,iphase)
12520 if (l .ge. p1st) then
12521 aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12522 else
12523 aer(iso4_a,jtotal,ibin)=0.0
12524 end if
12525
12526 l = lptr_no3_aer(isize,itype,iphase)
12527 if (l .ge. p1st) then
12528 aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12529 else
12530 aer(ino3_a,jtotal,ibin)=0.0
12531 end if
12532
12533 l = lptr_cl_aer(isize,itype,iphase)
12534 if (l .ge. p1st) then
12535 aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12536 else
12537 aer(icl_a,jtotal,ibin)=0.0
12538 end if
12539
12540 l = lptr_nh4_aer(isize,itype,iphase)
12541 if (l .ge. p1st) then
12542 aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12543 else
12544 aer(inh4_a,jtotal,ibin)=0.0
12545 end if
12546
12547 l = lptr_oc_aer(isize,itype,iphase)
12548 if (l .ge. p1st) then
12549 aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12550 else
12551 aer(ioc_a,jtotal,ibin)=0.0
12552 end if
12553
12554 l = lptr_bc_aer(isize,itype,iphase)
12555 if (l .ge. p1st) then
12556 aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12557 else
12558 aer(ibc_a,jtotal,ibin)=0.0
12559 end if
12560
12561 l = lptr_na_aer(isize,itype,iphase)
12562 if (l .ge. p1st) then
12563 aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12564 else
12565 aer(ina_a,jtotal,ibin)=0.0
12566 end if
12567
12568 l = lptr_oin_aer(isize,itype,iphase)
12569 if (l .ge. p1st) then
12570 aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12571 else
12572 aer(ioin_a,jtotal,ibin)=0.0
12573 end if
12574
12575 l = lptr_msa_aer(isize,itype,iphase)
12576 if (l .ge. p1st) then
12577 aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12578 else
12579 aer(imsa_a,jtotal,ibin)=0.0
12580 end if
12581
12582 l = lptr_co3_aer(isize,itype,iphase)
12583 if (l .ge. p1st) then
12584 aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12585 else
12586 aer(ico3_a,jtotal,ibin)=0.0
12587 end if
12588
12589 l = lptr_ca_aer(isize,itype,iphase)
12590 if (l .ge. p1st) then
12591 aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12592 else
12593 aer(ica_a,jtotal,ibin)=0.0
12594 end if
12595
12596 ! soa aerosol-phase species -- currently deactivated
12597 ! l = lptr_aro1_aer(isize,itype,iphase)
12598 ! if (l .ge. p1st) then
12599 ! aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12600 ! else
12601 aer(iaro1_a,jtotal,ibin)=0.0
12602 ! end if
12603
12604 ! l = lptr_aro2_aer(isize,itype,iphase)
12605 ! if (l .ge. p1st) then
12606 ! aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12607 ! else
12608 aer(iaro2_a,jtotal,ibin)=0.0
12609 ! end if
12610
12611 ! l = lptr_alk1_aer(isize,itype,iphase)
12612 ! if (l .ge. p1st) then
12613 ! aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12614 ! else
12615 aer(ialk1_a,jtotal,ibin)=0.0
12616 ! end if
12617
12618 ! l = lptr_ole1_aer(isize,itype,iphase)
12619 ! if (l .ge. p1st) then
12620 ! aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12621 ! else
12622 aer(iole1_a,jtotal,ibin)=0.0
12623 ! end if
12624
12625 ! l = lptr_api1_aer(isize,itype,iphase)
12626 ! if (l .ge. p1st) then
12627 ! aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12628 ! else
12629 aer(iapi1_a,jtotal,ibin)=0.0
12630 ! end if
12631
12632 ! l = lptr_api2_aer(isize,itype,iphase)
12633 ! if (l .ge. p1st) then
12634 ! aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12635 ! else
12636 aer(iapi2_a,jtotal,ibin)=0.0
12637 ! end if
12638
12639 ! l = lptr_lim1_aer(isize,itype,iphase)
12640 ! if (l .ge. p1st) then
12641 ! aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12642 ! else
12643 aer(ilim1_a,jtotal,ibin)=0.0
12644 ! end if
12645
12646 ! l = lptr_lim2_aer(isize,itype,iphase)
12647 ! if (l .ge. p1st) then
12648 ! aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12649 ! else
12650 aer(ilim2_a,jtotal,ibin)=0.0
12651 ! end if
12652
12653 ! water_a and water_a_hyst units are kg/(m^3 air)
12654 l = hyswptr_aer(isize,itype)
12655 if (l .ge. p1st) then
12656 water_a_hyst(ibin)=rsub(l,k,m)*conv2a
12657 else
12658 water_a_hyst(ibin)=0.0
12659 end if
12660
12661 ! water_a units are kg/(m^3 air)
12662 l = waterptr_aer(isize,itype)
12663 if (l .ge. p1st) then
12664 water_a(ibin)=rsub(l,k,m)*conv2a
12665 else
12666 water_a(ibin)=0.0
12667 end if
12668
12669 ! num_a units are #/(cm^3 air)
12670 l = numptr_aer(isize,itype,iphase)
12671 num_a(ibin) = rsub(l,k,m)*cair_mol_cc
12672
12673
12674 call check_aerosol_mass(ibin)
12675 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
12676 call conform_electrolytes(jtotal,ibin,xt) ! conforms aer(jtotal) to a valid aerosol
12677 call check_aerosol_mass(ibin) ! check mass again after conform_electrolytes
12678 if(jaerosolstate(ibin) .eq. no_aerosol)goto 90 ! ignore this bin
12679 call conform_aerosol_number(ibin) ! adjusts number conc so that it conforms with bin mass and diameter
12680 call calc_dry_n_wet_aerosol_props(ibin) ! calc dp_wet, ref index
12681
12682
12683
12684 refindx(ibin,k) = ri_avg_a(ibin) ! vol avg ref index
12685 radius_wet(ibin,k) = dp_wet_a(ibin)/2.0 ! wet radius (cm)
12686 number_bin(ibin,k) = num_a(ibin) ! #/cc air
12687
12688 90 continue
12689
12690 100 continue ! k levels
12691 110 continue ! m subareas
12692
12693
12694 return
12695 end subroutine aerosol_optical_properties
12696
12697
12698
12699
12700
12701
12702
12703
12704
12705
12706 !***********************************************************************
12707 ! save aerosol drymass and drydens before aerosol mass transfer is
12708 ! calculated this subr is called from within subr mosaic_dynamic_solver,
12709 ! after the initial calls to check_aerosol_mass, conform_electrolytes,
12710 ! conform_aerosol_number, and aerosol_phase_state, but before the mass
12711 ! transfer is calculated
12712 !
12713 ! author: richard c. easter
12714 !-----------------------------------------------------------------------
12715 subroutine save_pregrow_props
12716
12717 use module_data_mosaic_asect
12718 use module_data_mosaic_other
12719
12720 ! implicit none
12721 ! include 'v33com'
12722 ! include 'v33com9a'
12723 ! include 'v33com9b'
12724 ! include 'mosaic.h'
12725
12726 ! subr arguments (none)
12727
12728 ! local variables
12729 integer ibin, isize, itype
12730
12731
12732 ! air conc in mol/cm^3
12733 cair_mol_cc = cairclm(kclm_aer)
12734
12735 ! compute then save drymass and drydens for each bin
12736 do ibin = 1, nbin_a
12737
12738 call calc_dry_n_wet_aerosol_props( ibin )
12739
12740 call isize_itype_from_ibin( ibin, isize, itype )
12741 drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol(air)
12742 if(jaerosolstate(ibin) .eq. no_aerosol) then
12743 drydens_pregrow(isize,itype) = -1.
12744 else
12745 drydens_pregrow(isize,itype) = dens_dry_a(ibin) ! g/cc
12746 end if
12747
12748 end do
12749
12750 return
12751 end subroutine save_pregrow_props
12752
12753
12754
12755
12756
12757
12758
12759 !***********************************************************************
12760 ! special output
12761 !
12762 ! author: richard c. easter
12763 !-----------------------------------------------------------------------
12764 subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
12765
12766 ! implicit none
12767
12768 integer iclm, jclm, kclm, msub
12769 character*(*) fromwhere
12770
12771 return
12772 end subroutine specialoutaa
12773
12774
12775
12776
12777 !***********************************************************************
12778 ! box model test output
12779 !
12780 ! author: richard c. easter
12781 !-----------------------------------------------------------------------
12782 subroutine aerchem_boxtest_output( &
12783 iflag, iclm, jclm, kclm, msub, dtchem )
12784
12785 use module_data_mosaic_asect
12786 use module_data_mosaic_other
12787 ! implicit none
12788
12789 ! include 'v33com'
12790 ! include 'v33com2'
12791 ! include 'v33com9a'
12792
12793 integer iflag, iclm, jclm, kclm, msub
12794 real(kind=8) dtchem
12795
12796 ! local variables
12797 integer lun
12798 parameter (lun=83)
12799 integer, save :: ientryno = -13579
12800 integer icomp, iphase, isize, itype, k, l, m, n
12801
12802 real(kind=8) dtchem_sv1
12803 save dtchem_sv1
12804 real(kind=8) rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
12805
12806
12807 ! bypass unless maerchem_boxtest_output > 0
12808 if (maerchem_boxtest_output .le. 0) return
12809
12810
12811
12812 !
12813 ! *** currently this only works for ntype_aer = 1
12814 !
12815 itype = 1
12816 iphase = ai_phase
12817
12818 ! do initial output
12819 if (ientryno .ne. -13579) goto 1000
12820
12821 ientryno = +1
12822 call peg_message( lunerr, '***' )
12823 call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
12824 call peg_message( lunerr, '***' )
12825
12826 write(lun) ltot, ltot2, itot, jtot, ktot
12827 write(lun) (name(l), l=1,ltot2)
12828
12829 write(lun) maerocoag, maerchem, maeroptical
12830 write(lun) msectional, maerosolincw
12831
12832 write(lun) nsize_aer(itype), ntot_mastercomp_aer
12833
12834 do icomp = 1, ntot_mastercomp_aer
12835 write(lun) &
12836 name_mastercomp_aer(icomp)
12837 write(lun) &
12838 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
12839 end do
12840
12841 do isize = 1, nsize_aer(itype)
12842 write(lun) &
12843 ncomp_plustracer_aer(itype), &
12844 ncomp_aer(itype), &
12845 waterptr_aer(isize,itype), &
12846 numptr_aer(isize,itype,iphase), &
12847 mprognum_aer(isize,itype,iphase)
12848 write(lun) &
12849 ( mastercompptr_aer(l,itype), &
12850 massptr_aer(l,isize,itype,iphase), &
12851 l=1,ncomp_plustracer_aer(itype) )
12852 write(lun) &
12853 volumcen_sect(isize,itype), &
12854 volumlo_sect(isize,itype), &
12855 volumhi_sect(isize,itype), &
12856 dcen_sect(isize,itype), &
12857 dlo_sect(isize,itype), &
12858 dhi_sect(isize,itype)
12859 write(lun) &
12860 lptr_so4_aer(isize,itype,iphase), &
12861 lptr_msa_aer(isize,itype,iphase), &
12862 lptr_no3_aer(isize,itype,iphase), &
12863 lptr_cl_aer(isize,itype,iphase), &
12864 lptr_co3_aer(isize,itype,iphase), &
12865 lptr_nh4_aer(isize,itype,iphase), &
12866 lptr_na_aer(isize,itype,iphase), &
12867 lptr_ca_aer(isize,itype,iphase), &
12868 lptr_oin_aer(isize,itype,iphase), &
12869 lptr_oc_aer(isize,itype,iphase), &
12870 lptr_bc_aer(isize,itype,iphase), &
12871 hyswptr_aer(isize,itype)
12872 end do
12873
12874 !
12875 ! test iflag
12876 !
12877 1000 continue
12878 if (iflag .eq. 1) goto 1010
12879 if (iflag .eq. 2) goto 2000
12880 if (iflag .eq. 3) goto 3000
12881 return
12882
12883 !
12884 ! iflag=1 -- save initial values
12885 !
12886 1010 continue
12887 dtchem_sv1 = dtchem
12888 do m = 1, nsubareas
12889 do k = 1, ktot
12890 do l = 1, ltot2
12891 rsub_sv1(l,k,m) = rsub(l,k,m)
12892 end do
12893 end do
12894 end do
12895
12896 return
12897
12898 !
12899 ! iflag=2 -- save intermediate values before doing move_sections
12900 ! (this is deactivated for now)
12901 !
12902 2000 continue
12903 return
12904
12905
12906 !
12907 ! iflag=3 -- do output
12908 !
12909 3000 continue
12910 do m = 1, nsubareas
12911 do k = 1, ktot
12912
12913 write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
12914 write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k), &
12915 ptotclm(k), afracsubarea(k,m)
12916
12917 write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
12918
12919 end do
12920 end do
12921
12922
12923 return
12924 end subroutine aerchem_boxtest_output
12925
12926
12927
12928 !***********************************************************************
12929 ! 'debugging' output when mosaic encounters 'fatal error' situation
12930 !
12931 ! author: richard c. easter
12932 !-----------------------------------------------------------------------
12933 subroutine mosaic_aerchem_error_dump( istop, ibin, luna, msga )
12934 !
12935 ! dumps current column information when a fatal computational error occurs
12936 ! when istop>0, the simulation is halted
12937 !
12938 use module_data_mosaic_asect
12939 use module_data_mosaic_other
12940 ! implicit none
12941
12942 ! arguments
12943 integer istop, ibin, luna
12944 character*(*) msga
12945
12946 ! local variables
12947 integer icomp, iphase, isize, itype, k, l, lunb, m, n
12948 real(kind=8) dtchem_sv1
12949
12950
12951 !
12952 ! *** currently this only works for ntype_aer = 1
12953 !
12954 itype = 1
12955
12956
12957 lunb = luna
12958 if (lunb .le. 0) lunb = 6
12959
12960 9000 format( a )
12961 9010 format( 7i10 )
12962 9020 format( 3(1pe19.11) )
12963
12964 write(lunb,9000)
12965 write(lunb,9000) 'begin mosaic_aerchem_error_dump - msga ='
12966 write(lunb,9000) msga
12967 write(lunb,9000) 'i, j, k, msub,ibin ='
12968 write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
12969
12970 write(lunb,9010) ltot, ltot2, itot, jtot, ktot
12971 write(lunb,9000) (name(l), l=1,ltot2)
12972
12973 write(lunb,9010) maerocoag, maerchem, maeroptical
12974 write(lunb,9010) msectional, maerosolincw
12975
12976 write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
12977
12978 do icomp = 1, ntot_mastercomp_aer
12979 write(lunb,9000) &
12980 name_mastercomp_aer(icomp)
12981 write(lunb,9020) &
12982 dens_mastercomp_aer(icomp), mw_mastercomp_aer(icomp)
12983 end do
12984
12985 do isize = 1, nsize_aer(itype)
12986 write(lunb,9010) &
12987 ncomp_plustracer_aer(itype), &
12988 ncomp_aer(itype), &
12989 waterptr_aer(isize,itype), &
12990 numptr_aer(isize,itype,iphase), &
12991 mprognum_aer(isize,itype,iphase)
12992 write(lunb,9010) &
12993 ( mastercompptr_aer(l,itype), &
12994 massptr_aer(l,isize,itype,iphase), &
12995 l=1,ncomp_plustracer_aer(itype) )
12996 write(lunb,9020) &
12997 volumcen_sect(isize,itype), &
12998 volumlo_sect(isize,itype), &
12999 volumhi_sect(isize,itype), &
13000 dcen_sect(isize,itype), &
13001 dlo_sect(isize,itype), &
13002 dhi_sect(isize,itype)
13003 write(lunb,9010) &
13004 lptr_so4_aer(isize,itype,iphase), &
13005 lptr_msa_aer(isize,itype,iphase), &
13006 lptr_no3_aer(isize,itype,iphase), &
13007 lptr_cl_aer(isize,itype,iphase), &
13008 lptr_co3_aer(isize,itype,iphase), &
13009 lptr_nh4_aer(isize,itype,iphase), &
13010 lptr_na_aer(isize,itype,iphase), &
13011 lptr_ca_aer(isize,itype,iphase), &
13012 lptr_oin_aer(isize,itype,iphase), &
13013 lptr_oc_aer(isize,itype,iphase), &
13014 lptr_bc_aer(isize,itype,iphase), &
13015 hyswptr_aer(isize,itype)
13016 end do
13017
13018
13019 dtchem_sv1 = -1.0
13020 do m = 1, nsubareas
13021 do k = 1, ktot
13022
13023 write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
13024 write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k), &
13025 ptotclm(k), afracsubarea(k,m)
13026
13027 write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
13028
13029 end do
13030 end do
13031
13032 write(lunb,9000) 'end mosaic_aerchem_error_dump'
13033
13034
13035 if (istop .gt. 0) call peg_error_fatal( luna, msga )
13036
13037 return
13038 end subroutine mosaic_aerchem_error_dump
13039 !-----------------------------------------------------------------------
13040
13041 end module module_mosaic_therm