wrfv2_fire/chem/module_mosaic_therm.F

   1 !**********************************************************************************
   2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
   3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
   4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
   5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
   6 !
   7 ! MOSAIC module: see module_mosaic_driver.F for information and terms of use
   8 !**********************************************************************************
   9       module module_mosaic_therm
  10
  11
  12
  13       use module_data_mosaic_therm
  14       use module_peg_util
  15
  16
  17
  18       implicit none
  19
  20       intrinsic max, min
  21
  22       contains
  23
  24
  25
  26 !   zz01aerchemistry.f (mosaic.21.0)
  27 !   05-feb-07 wig - converted to double
  28 !   10-jan-07 raz - contains major revisions and updates. new module ASTEM replaces ASTEEM.
  29 !   04-aug-06 raz - fixed bugs in asteem_flux_mix_case3a and asteem_flux_mix_case3b
  30 !                   revised treatment of kelvin effect.
  31 !   06-jun-06 rce - changed dens_aer_mac(ica_a) & (ico3_a) from 2.5 to 2.6
  32 !   31-may-06 rce - got latest version from
  33 !                       nirvana:/home/zaveri/rahul/pegasus/pegasus.3.1.1/src
  34 !                   in subr map_mosaic_species, turned off mapping
  35 !                       of soa species
  36 !   18-may-06 raz - major revisions in asteem and minor changes in mesa
  37 !   22-jan-06 raz - revised nh4no3 and nh4cl condensation algorithm
  38 !   07-jan-06 raz - improved asteem algorithm
  39 !   28-apr-05 raz - reversed calls to form_cacl2 and form_nacl
  40 !                   fixed caco3 error in subr. electrolytes_to_ions
  41 !                   renamed dens_aer to dens_aer_mac; mw_aer to mw_aer_mac
  42 !   27-apr-05 raz - updated dry_mass calculation approach in mesa_convergence
  43 !   22-apr-05 raz - fixed caso4 mass balance problem and updated algorithm to
  44 !                   calculate phi_volatile for nh3, hno3, and hcl.
  45 !   20-apr-05 raz - updated asceem
  46 !   19-apr-05 raz - updated the algorithm to constrain the nh4 concentration
  47 !                   during simultaneous nh3, hno3, and hcl integration such
  48 !                   that it does not exceed the max possible value for a given bin
  49 !   14-apr-05 raz - fixed asteem_flux_wet_case3 and asteem_flux_dry_case3c
  50 !   11-jan-05 raz - major updates to many subroutines
  51 !   18-nov-04 rce - make sure that acos argument is between +/-1.0
  52 !   28-jan-04 rce - added subr aerchem_boxtest_output;
  53 !       eliminated some unnecessary 'include v33com-'
  54 !   01-dec-03 rce - added 'implicit none' to many routines;
  55 !       eliminated some unnecessary 'include v33com-'
  56 !   05-oct-03 raz - added hysteresis treatment
  57 !   02-sep-03 raz - implemented asteem
  58 !   10-jul-03 raz - changed ix to ixd in interp. subrs fast*_up and fast*_lo
  59 !   08-jul-03 raz - implemented asteem (adaptive step time-split
  60 !                   explicit euler method)
  61 !   26-jun-03 raz - updated almost all the subrs. this version contains
  62 !       options for rigorous and fast solvers (including lsode solver)
  63 !
  64 !   07-oct-02 raz - made zx and zm integers in activity coeff subs.
  65 !   16-sep-02 raz - updated many subrs to treat calcium salts
  66 !   19-aug-02 raz - inlcude v33com9a in subr aerosolmtc
  67 !   14-aug-02 rce - '(msectional.eq.0)' changed to '(msectional.le.0)'
  68 !   07-aug-02 rce - this is rahul's latest version from freshair
  69 !       after adding 'real mean_molecular_speed' wherever it is used
  70 !   01-apr-02 raz - made final tests and gave the code to jerome
  71 !
  72 !   04--14-dec-01 rce - several minor changes during initial testing/debug
  73 !       in 3d los angeles simulation
  74 !       (see earlier versions for details about these changes)
  75 !-----------------------------------------------------------------------
  76 !23456789012345678901234567890123456789012345678901234567890123456789012
  77
  78 !***********************************************************************
  79 ! interface to mosaic
  80 !
  81 ! author: rahul a. zaveri
  82 ! update: jan 2005
  83 !-----------------------------------------------------------------------
  84       subroutine aerchemistry( iclm, jclm, kclm_calcbgn, kclm_calcend,   &
  85                                dtchem_sngl, idiagaa )
  86
  87       use module_data_mosaic_asect
  88       use module_data_mosaic_other
  89       use module_mosaic_movesect, only:  move_sections
  90
  91 !     implicit none
  92 !     include 'v33com'
  93 !     include 'v33com2'
  94 !     include 'v33com3'
  95 !     include 'mosaic.h'
  96 !   subr arguments
  97       integer iclm, jclm, kclm_calcbgn, kclm_calcend, idiagaa
  98       real dtchem_sngl
  99 !   local variables
 100       real(kind=8) :: dtchem
 101       integer k, m
 102
 103
 104
 105       dtchem = dtchem_sngl
 106
 107       lunerr_aer = lunerr
 108       ncorecnt_aer = ncorecnt
 109
 110 !   special output for solver testing
 111       call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
 112
 113       iclm_aer = iclm
 114       jclm_aer = jclm
 115       kclm_aer_calcbgn = kclm_calcbgn
 116       kclm_aer_calcend = kclm_calcend
 117
 118
 119       do 200 m = 1, nsubareas
 120         mclm_aer = m
 121
 122         do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
 123
 124           kclm_aer = k
 125           if (afracsubarea(k,m) .lt. 1.e-4) goto 100
 126
 127           istat_mosaic_fe1 = 1
 128
 129           call mosaic( k, m, dtchem )
 130
 131           if (istat_mosaic_fe1 .lt. 0) then
 132              nfe1_mosaic_cur = nfe1_mosaic_cur + 1
 133              nfe1_mosaic_tot = nfe1_mosaic_tot + 1
 134              if (iprint_mosaic_fe1 .gt. 0) then
 135                 write(6,*) 'mosaic aerchemistry fatal error - i/j/k/m =',   &
 136                    iclm_aer, jclm_aer, kclm_aer, mclm_aer
 137                 call print_input
 138                 if (iprint_mosaic_fe1 .ge. 10)   &
 139                    call mosaic_aerchem_error_dump( 0, 0, lunerr_aer,   &
 140                       'aerchemistry fatal error' )
 141              end if
 142              goto 100
 143           end if
 144
 145           call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
 146           call move_sections( 1, iclm, jclm, k, m)
 147           call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
 148
 149 100     continue        ! k levels
 150
 151 200   continue          ! subareas
 152
 153
 154 !   special output for solver testing
 155       call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
 156
 157       return
 158       end subroutine aerchemistry
 159
 160
 161
 162
 163
 164
 165
 166
 167
 168
 169 !***********************************************************************
 170 ! mosaic (model for simulating aerosol interactions and chemistry)
 171 !
 172 ! author: rahul a. zaveri
 173 ! update: dec 2004
 174 !-----------------------------------------------------------------------
 175       subroutine mosaic(k, m, dtchem)
 176
 177       use module_data_mosaic_asect
 178       use module_data_mosaic_other
 179
 180 !     implicit none
 181 !     include 'v33com'
 182 !     include 'v33com3'
 183 !     include 'mosaic.h'
 184 !   subr arguments
 185       integer k, m
 186       real(kind=8) dtchem
 187 !   local variables
 188       real(kind=8) yh2o, dumdum
 189       integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
 190 !     data iclm_debug /28/
 191 !     data jclm_debug /1/
 192 !     data kclm_debug /9/
 193 !     data ncnt_debug /6/
 194       iclm_debug=-28; jclm_debug=1; kclm_debug=9; ncnt_debug=6
 195
 196
 197
 198       if(iclm_aer .eq. iclm_debug .and.   &
 199          jclm_aer .eq. jclm_debug .and.   &
 200          kclm_aer .eq. kclm_debug  .and.   &
 201          ncorecnt_aer .eq. ncnt_debug)then
 202         dumdum = 0.0
 203       endif
 204
 205
 206 ! overwrite inputs
 207          if(1.eq.0)then
 208            call hijack_input(k,m)
 209          endif
 210
 211
 212           t_k = rsub(ktemp,k,m)                 ! update temperature  = k
 213           p_atm = ptotclm(k) /1.032d6           ! update pressure = atm
 214           yh2o = rsub(kh2o,k,m)                 ! mol(h2o)/mol(air)
 215           rh_pc = 100.*relhumclm(k)             ! rh (%)
 216           ah2o = relhumclm(k)                   ! fractional rh
 217
 218
 219           call load_mosaic_parameters           ! sets up indices and other stuff once per simulation
 220
 221           call initialize_mosaic_variables
 222
 223           call update_thermodynamic_constants   ! update t and rh dependent constants
 224
 225           call map_mosaic_species(k, m, 0)
 226
 227
 228           call overall_massbal_in ! save input mass over all bins
 229           iprint_input = myes     ! reset to default
 230
 231
 232           call mosaic_dynamic_solver( dtchem )
 233           if (istat_mosaic_fe1 .lt. 0) return
 234
 235
 236           call overall_massbal_out(0) ! check mass balance after integration
 237
 238           call map_mosaic_species(k, m, 1)
 239
 240 !      write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
 241
 242       return
 243       end subroutine mosaic
 244
 245
 246
 247
 248
 249
 250
 251
 252
 253
 254
 255
 256 !***********************************************************************
 257 ! interface to asceem and asteem dynamic gas-particle exchange solvers
 258 !
 259 ! author: rahul a. zaveri
 260 ! update: jan 2005
 261 !-----------------------------------------------------------------------
 262       subroutine mosaic_dynamic_solver( dtchem )
 263 !     implicit none
 264 !     include 'v33com'
 265 !     include 'mosaic.h'
 266 ! subr arguments
 267       real(kind=8) dtchem
 268 ! local variables
 269       integer ibin, iv, k, m
 270       real(kind=8) xt, dumdum
 271 !     real(kind=8) aerosol_water_up                             ! mosaic func
 272
 273
 274 !      if(iclm_aer .eq. 21 .and.   &
 275 !         jclm_aer .eq. 17 .and.   &
 276 !         kclm_aer .eq. 3  .and.   &
 277 !         ncorecnt_aer .eq. 4)then
 278 !        dumdum = 0.0
 279 !      endif
 280
 281
 282       do 500 ibin = 1, nbin_a
 283
 284         call check_aerosol_mass(ibin)
 285         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
 286
 287         call conform_electrolytes(jtotal,ibin,xt)       ! conforms aer(jtotal) to a valid aerosol
 288
 289         call check_aerosol_mass(ibin)                   ! check mass again after conform_electrolytes
 290         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
 291
 292         call conform_aerosol_number(ibin)               ! adjusts number conc so that it conforms with bin mass and diameter
 293
 294 500   continue
 295
 296
 297
 298 ! box
 299 !        call initial_aer_print_box     ! box
 300
 301       call save_pregrow_props
 302
 303       call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77,   &
 304                 'after_conform' )
 305 !
 306 !-------------------------------------
 307 ! do dynamic gas-aerosol mass transfer
 308
 309       if(mgas_aer_xfer .eq. mon)then
 310
 311         call astem(dtchem)
 312
 313       endif
 314
 315 !-------------------------------------
 316 ! box
 317 ! grows or shrinks size depending on mass increase or decrease
 318 !
 319 !      do ibin = 1, nbin_a
 320 !        if(jaerosolstate(ibin) .ne. no_aerosol)then
 321 !          call conform_particle_size(ibin)     ! box
 322 !        endif
 323 !      enddo
 324
 325
 326
 327       do 600 ibin = 1, nbin_a
 328         if(jaerosolstate(ibin).eq.no_aerosol) goto 600
 329
 330         if(jhyst_leg(ibin) .eq. jhyst_lo)then
 331           water_a_hyst(ibin) = 0.0
 332         elseif(jhyst_leg(ibin) .eq. jhyst_up)then
 333           water_a_up(ibin)   = aerosol_water_up(ibin)   ! at 60% rh
 334           water_a_hyst(ibin) = water_a_up(ibin)
 335         endif
 336
 337         call calc_dry_n_wet_aerosol_props(ibin)         ! compute final mass and density
 338 600   continue
 339
 340       return
 341       end subroutine mosaic_dynamic_solver
 342
 343
 344
 345
 346
 347
 348
 349
 350
 351
 352
 353
 354
 355
 356       subroutine hijack_input(k, m)
 357
 358       use module_data_mosaic_asect
 359       use module_data_mosaic_other
 360
 361 !     implicit none
 362 !     include 'v33com'
 363 !     include 'v33com3'
 364 !     include 'v33com9a'
 365 !     include 'v33com9b'
 366 !     include 'mosaic.h'
 367 ! subr arguments
 368       integer k, m
 369 ! local variables
 370       integer ibin, igas, iphase, isize, itype
 371       real(kind=8) t_kdum, p_atmdum, rhdum, cairclmdum
 372       real(kind=8) gasdum(4), aerdum(14,8)
 373
 374
 375
 376
 377 ! read inputs----------------
 378       open(92, file = 'box.txt')
 379
 380       read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
 381 !      do igas = 1, 4
 382         read(92,*)gasdum(1),gasdum(2),gasdum(3),gasdum(4)
 383 !      enddo
 384
 385       do ibin = 1, nbin_a
 386         read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin),   &
 387                   aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin),   &
 388                   aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin),   &
 389                   aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin),   &
 390                   aerdum(13,ibin),aerdum(14,ibin)
 391       enddo
 392
 393       close(92)
 394 !----------------------------
 395
 396
 397
 398       rsub(ktemp,k,m) = t_kdum                  ! update temperature  = k
 399       ptotclm(k)      = p_atmdum*1.032d6! update pressure = atm
 400       relhumclm(k)    = rhdum/100.0             ! fractional rh
 401       cairclm(k)      = cairclmdum              ! mol/cc
 402
 403
 404 ! 3-d
 405 ! calculate air conc in mol/m^3
 406       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 407       cair_mol_cc = cairclm(k)
 408
 409 ! 3-d
 410 ! define conversion factors
 411       conv1a = cair_mol_m3*1.e9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 412       conv1b = 1./conv1a                ! converts nq/m^3 to q/mol(air)
 413       conv2a = cair_mol_m3*18.*1.e-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 414       conv2b = 1./conv2a                ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 415
 416
 417 ! read rsub (mol/mol(air))
 418 ! gas
 419         rsub(kh2so4,k,m) = gasdum(1)
 420         rsub(khno3,k,m)  = gasdum(2)
 421         rsub(khcl,k,m)   = gasdum(3)
 422         rsub(knh3,k,m)   = gasdum(4)
 423
 424
 425 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
 426         iphase = ai_phase
 427         ibin = 0
 428         do 10 itype = 1, ntype_aer
 429         do 10 isize = 1, nsize_aer(itype)
 430         ibin = ibin + 1
 431
 432         rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
 433         rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
 434         rsub(lptr_cl_aer(isize,itype,iphase),k,m)  = aerdum(3,ibin)
 435         rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
 436         rsub(lptr_oc_aer(isize,itype,iphase),k,m)  = aerdum(5,ibin)
 437         rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
 438         rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
 439         rsub(lptr_bc_aer(isize,itype,iphase),k,m)  = aerdum(8,ibin)
 440         rsub(lptr_na_aer(isize,itype,iphase),k,m)  = aerdum(9,ibin)
 441         rsub(lptr_ca_aer(isize,itype,iphase),k,m)  = aerdum(10,ibin)
 442         rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
 443
 444         rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
 445         rsub(waterptr_aer(isize,itype),k,m)       = aerdum(13,ibin)     ! kg/m^3(air)
 446         rsub(numptr_aer(isize,itype,iphase),k,m)          = aerdum(14,ibin)     ! num_a is in #/cc
 447 10    continue
 448
 449       return
 450       end subroutine hijack_input
 451
 452
 453
 454
 455
 456 !***********************************************************************
 457 ! intializes all the mosaic variables to zero or their default values.
 458 !
 459 ! author: rahul a. zaveri
 460 ! update: jun 2003
 461 !-----------------------------------------------------------------------
 462       subroutine initialize_mosaic_variables
 463 !     implicit none
 464 !     include 'mosaic.h'
 465 ! local variables
 466       integer iaer, ibin, iv, ja, jc, je
 467
 468
 469
 470       do iv = 1, ngas_ioa
 471           gas(iv)           = 0.0
 472       enddo
 473
 474 ! initialize to zero
 475       do ibin = 1, nbin_a
 476
 477         num_a(ibin)          = 0.0
 478         mass_dry_a(ibin)     = 0.0
 479         mass_soluble_a(ibin) = 0.0
 480
 481         do iaer = 1, naer
 482           aer(iaer,jtotal,ibin)  = 0.0
 483           aer(iaer,jsolid,ibin)  = 0.0
 484           aer(iaer,jliquid,ibin) = 0.0
 485         enddo
 486
 487         do je = 1, nelectrolyte
 488           electrolyte(je,jtotal,ibin)  = 0.0
 489           electrolyte(je,jsolid,ibin)  = 0.0
 490           electrolyte(je,jliquid,ibin) = 0.0
 491           activity(je,ibin)            = 0.0
 492           gam(je,ibin)                 = 0.0
 493         enddo
 494
 495           gam_ratio(ibin)   = 0.0
 496
 497         do iv = 1, ngas_ioa
 498           flux_s(iv,ibin)   = 0.0
 499           flux_l(iv,ibin)   = 0.0
 500           kg(iv,ibin)       = 0.0
 501           phi_volatile_s(iv,ibin) = 0.0
 502           phi_volatile_l(iv,ibin) = 0.0
 503           df_gas_s(iv,ibin)   = 0.0
 504           df_gas_l(iv,ibin)   = 0.0
 505           volatile_s(iv,ibin) = 0.0
 506         enddo
 507
 508
 509         jaerosolstate(ibin) = -1        ! initialize to default value
 510         jphase(ibin) = 0
 511
 512         do jc = 1, ncation
 513           mc(jc,ibin) = 0.0
 514         enddo
 515
 516         do ja = 1, nanion
 517           ma(ja,ibin) = 0.0
 518         enddo
 519
 520       enddo     ! ibin
 521
 522
 523       return
 524       end subroutine initialize_mosaic_variables
 525
 526
 527
 528
 529
 530
 531 !***********************************************************************
 532 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
 533 !
 534 ! author: rahul a. zaveri
 535 ! update: nov 2001
 536 !-------------------------------------------------------------------------
 537       subroutine map_mosaic_species(k, m, imap)
 538
 539       use module_data_mosaic_asect
 540       use module_data_mosaic_other
 541       use module_state_description, only:  param_first_scalar
 542
 543 !     implicit none
 544
 545 !     include 'v33com'
 546 !     include 'v33com3'
 547 !     include 'v33com9a'
 548 !     include 'v33com9b'
 549
 550 ! subr arguments
 551       integer k, m, imap
 552 ! local variables
 553       integer ibin, iphase, isize, itsi, itype, l, p1st
 554
 555
 556 ! if a species index is less than this value, then the species is not defined
 557       p1st = param_first_scalar
 558
 559 ! 3-d
 560 ! calculate air conc in mol/m^3
 561       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 562       cair_mol_cc = cairclm(k)
 563
 564 ! 3-d
 565 ! define conversion factors
 566       conv1a = cair_mol_m3*1.d9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 567       conv1b = 1.d0/conv1a              ! converts nq/m^3 to q/mol(air)
 568       conv2a = cair_mol_m3*18.*1.d-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 569       conv2b = 1.d0/conv2a              ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 570
 571
 572 ! box
 573 !      conv1 = 1.d15/avogad     ! converts (molec/cc) to (nmol/m^3)
 574 !      conv2 = 1.d0/conv1         ! converts (nmol/m^3) to (molec/cc)
 575 !      kaerstart = ngas_max
 576
 577
 578       if(imap.eq.0)then    ! map rsub (mol/mol(air)) into aer (nmol/m^3)
 579 ! gas
 580         if (kh2so4 .ge. p1st) then
 581             gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a     ! nmol/m^3
 582         else
 583             gas(ih2so4_g) = 0.0
 584         end if
 585         if (khno3 .ge. p1st) then
 586             gas(ihno3_g)  = rsub(khno3,k,m)*conv1a
 587         else
 588             gas(ihno3_g) = 0.0
 589         end if
 590         if (khcl .ge. p1st) then
 591             gas(ihcl_g)   = rsub(khcl,k,m)*conv1a
 592         else
 593             gas(ihcl_g) = 0.0
 594         end if
 595         if (knh3 .ge. p1st) then
 596             gas(inh3_g)   = rsub(knh3,k,m)*conv1a
 597         else
 598             gas(inh3_g) = 0.0
 599         end if
 600
 601 ! soa gas-phase species -- currently deactivated
 602 !       if (karo1 .ge. p1st) then
 603 !           gas(iaro1_g)   = rsub(karo1,k,m)*conv1a
 604 !       else
 605             gas(iaro1_g) = 0.0
 606 !       end if
 607 !       if (karo2 .ge. p1st) then
 608 !           gas(iaro2_g)   = rsub(karo2,k,m)*conv1a
 609 !       else
 610             gas(iaro2_g) = 0.0
 611 !       end if
 612 !       if (kalk1 .ge. p1st) then
 613 !           gas(ialk1_g)   = rsub(kalk1,k,m)*conv1a
 614 !       else
 615             gas(ialk1_g) = 0.0
 616 !       end if
 617 !       if (kole1 .ge. p1st) then
 618 !           gas(iole1_g)   = rsub(kole1,k,m)*conv1a
 619 !       else
 620             gas(iole1_g) = 0.0
 621 !       end if
 622 !       if (kapi1 .ge. p1st) then
 623 !           gas(iapi1_g)   = rsub(kapi1,k,m)*conv1a
 624 !       else
 625             gas(iapi1_g) = 0.0
 626 !       end if
 627 !       if (kapi2 .ge. p1st) then
 628 !           gas(iapi2_g)   = rsub(kapi2,k,m)*conv1a
 629 !       else
 630             gas(iapi2_g) = 0.0
 631 !       end if
 632 !       if (klim1 .ge. p1st) then
 633 !           gas(ilim1_g)   = rsub(klim1,k,m)*conv1a
 634 !       else
 635             gas(ilim1_g) = 0.0
 636 !       end if
 637 !       if (klim2 .ge. p1st) then
 638 !           gas(ilim2_g)   = rsub(klim2,k,m)*conv1a
 639 !       else
 640             gas(ilim2_g) = 0.0
 641 !       end if
 642
 643
 644 ! aerosol
 645         iphase = ai_phase
 646         ibin = 0
 647         do 10 itype = 1, ntype_aer
 648         do 10 isize = 1, nsize_aer(itype)
 649         ibin = ibin + 1
 650
 651 ! aer array units are nmol/(m^3 air)
 652
 653 ! rce 18-nov-2004 - always map so4 and number,
 654 ! but only map other species when (lptr_xxx .ge. p1st)
 655 ! rce 11-may-2006 - so4 mapping now optional
 656         l = lptr_so4_aer(isize,itype,iphase)
 657         if (l .ge. p1st) then
 658             aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 659         else
 660             aer(iso4_a,jtotal,ibin)=0.0
 661         end if
 662
 663         l = lptr_no3_aer(isize,itype,iphase)
 664         if (l .ge. p1st) then
 665             aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 666         else
 667             aer(ino3_a,jtotal,ibin)=0.0
 668         end if
 669
 670         l = lptr_cl_aer(isize,itype,iphase)
 671         if (l .ge. p1st) then
 672             aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 673         else
 674             aer(icl_a,jtotal,ibin)=0.0
 675         end if
 676
 677         l = lptr_nh4_aer(isize,itype,iphase)
 678         if (l .ge. p1st) then
 679             aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 680         else
 681             aer(inh4_a,jtotal,ibin)=0.0
 682         end if
 683
 684         l = lptr_oc_aer(isize,itype,iphase)
 685         if (l .ge. p1st) then
 686             aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 687         else
 688             aer(ioc_a,jtotal,ibin)=0.0
 689         end if
 690
 691         l = lptr_bc_aer(isize,itype,iphase)
 692         if (l .ge. p1st) then
 693             aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 694         else
 695             aer(ibc_a,jtotal,ibin)=0.0
 696         end if
 697
 698         l = lptr_na_aer(isize,itype,iphase)
 699         if (l .ge. p1st) then
 700             aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 701         else
 702             aer(ina_a,jtotal,ibin)=0.0
 703         end if
 704
 705         l = lptr_oin_aer(isize,itype,iphase)
 706         if (l .ge. p1st) then
 707             aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 708         else
 709             aer(ioin_a,jtotal,ibin)=0.0
 710         end if
 711
 712         l = lptr_msa_aer(isize,itype,iphase)
 713         if (l .ge. p1st) then
 714             aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 715         else
 716             aer(imsa_a,jtotal,ibin)=0.0
 717         end if
 718
 719         l = lptr_co3_aer(isize,itype,iphase)
 720         if (l .ge. p1st) then
 721             aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 722         else
 723             aer(ico3_a,jtotal,ibin)=0.0
 724         end if
 725
 726         l = lptr_ca_aer(isize,itype,iphase)
 727         if (l .ge. p1st) then
 728             aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 729         else
 730             aer(ica_a,jtotal,ibin)=0.0
 731         end if
 732
 733 ! soa aerosol-phase species -- currently deactivated
 734 !       l = lptr_aro1_aer(isize,itype,iphase)
 735 !       if (l .ge. p1st) then
 736 !           aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 737 !       else
 738             aer(iaro1_a,jtotal,ibin)=0.0
 739 !       end if
 740
 741 !       l = lptr_aro2_aer(isize,itype,iphase)
 742 !       if (l .ge. p1st) then
 743 !           aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 744 !       else
 745             aer(iaro2_a,jtotal,ibin)=0.0
 746 !       end if
 747
 748 !       l = lptr_alk1_aer(isize,itype,iphase)
 749 !       if (l .ge. p1st) then
 750 !           aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 751 !       else
 752             aer(ialk1_a,jtotal,ibin)=0.0
 753 !       end if
 754
 755 !       l = lptr_ole1_aer(isize,itype,iphase)
 756 !       if (l .ge. p1st) then
 757 !           aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 758 !       else
 759             aer(iole1_a,jtotal,ibin)=0.0
 760 !       end if
 761
 762 !       l = lptr_api1_aer(isize,itype,iphase)
 763 !       if (l .ge. p1st) then
 764 !           aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 765 !       else
 766             aer(iapi1_a,jtotal,ibin)=0.0
 767 !       end if
 768
 769 !       l = lptr_api2_aer(isize,itype,iphase)
 770 !       if (l .ge. p1st) then
 771 !           aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 772 !       else
 773             aer(iapi2_a,jtotal,ibin)=0.0
 774 !       end if
 775
 776 !       l = lptr_lim1_aer(isize,itype,iphase)
 777 !       if (l .ge. p1st) then
 778 !           aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 779 !       else
 780             aer(ilim1_a,jtotal,ibin)=0.0
 781 !       end if
 782
 783 !       l = lptr_lim2_aer(isize,itype,iphase)
 784 !       if (l .ge. p1st) then
 785 !           aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
 786 !       else
 787             aer(ilim2_a,jtotal,ibin)=0.0
 788 !       end if
 789
 790 ! water_a and water_a_hyst units are kg/(m^3 air)
 791         l = hyswptr_aer(isize,itype)
 792         if (l .ge. p1st) then
 793             water_a_hyst(ibin)=rsub(l,k,m)*conv2a
 794         else
 795             water_a_hyst(ibin)=0.0
 796         end if
 797
 798 ! water_a units are kg/(m^3 air)
 799         l = waterptr_aer(isize,itype)
 800         if (l .ge. p1st) then
 801             water_a(ibin)=rsub(l,k,m)*conv2a
 802         else
 803             water_a(ibin)=0.0
 804         end if
 805
 806 ! num_a units are #/(cm^3 air)
 807         l = numptr_aer(isize,itype,iphase)
 808         num_a(ibin) = rsub(l,k,m)*cair_mol_cc
 809
 810 ! other bin parameters (fixed for now)
 811         sigmag_a(ibin)  = 1.02
 812
 813 10      continue
 814
 815
 816
 817
 818 !---------------------------------------------------------------------
 819
 820
 821       else                 ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
 822
 823
 824
 825 ! gas
 826         if (kh2so4 .ge. p1st)   &
 827             rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
 828         if (khno3 .ge. p1st)   &
 829             rsub(khno3,k,m)  = gas(ihno3_g)*conv1b
 830         if (khcl .ge. p1st)   &
 831             rsub(khcl,k,m)   = gas(ihcl_g)*conv1b
 832         if (knh3 .ge. p1st)   &
 833             rsub(knh3,k,m)   = gas(inh3_g)*conv1b
 834
 835 ! soa gas-phase species -- currently deactivated
 836 !       if (karo1 .ge. p1st)   &
 837 !           rsub(karo1,k,m)   = gas(iaro1_g)*conv1b
 838 !       if (karo2 .ge. p1st)   &
 839 !           rsub(karo2,k,m)   = gas(iaro2_g)*conv1b
 840 !       if (kalk1 .ge. p1st)   &
 841 !           rsub(kalk1,k,m)   = gas(ialk1_g)*conv1b
 842 !       if (kole1 .ge. p1st)   &
 843 !           rsub(kole1,k,m)   = gas(iole1_g)*conv1b
 844 !       if (kapi1 .ge. p1st)   &
 845 !           rsub(kapi1,k,m)   = gas(iapi1_g)*conv1b
 846 !       if (kapi2 .ge. p1st)   &
 847 !           rsub(kapi2,k,m)   = gas(iapi2_g)*conv1b
 848 !       if (klim1 .ge. p1st)   &
 849 !           rsub(klim1,k,m)   = gas(ilim1_g)*conv1b
 850 !       if (klim2 .ge. p1st)   &
 851 !           rsub(klim2,k,m)   = gas(ilim2_g)*conv1b
 852
 853 ! aerosol
 854         iphase = ai_phase
 855         ibin = 0
 856         do 20 itype = 1, ntype_aer
 857         do 20 isize = 1, nsize_aer(itype)
 858         ibin = ibin + 1
 859
 860
 861 ! rce 18-nov-2004 - always map so4 and number,
 862 ! but only map other species when (lptr_xxx .ge. p1st)
 863         l = lptr_so4_aer(isize,itype,iphase)
 864         rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
 865
 866         l = lptr_no3_aer(isize,itype,iphase)
 867         if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
 868
 869         l = lptr_cl_aer(isize,itype,iphase)
 870         if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
 871
 872         l = lptr_nh4_aer(isize,itype,iphase)
 873         if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
 874
 875         l = lptr_oc_aer(isize,itype,iphase)
 876         if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
 877
 878         l = lptr_bc_aer(isize,itype,iphase)
 879         if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
 880
 881         l = lptr_na_aer(isize,itype,iphase)
 882         if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
 883
 884         l = lptr_oin_aer(isize,itype,iphase)
 885         if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
 886
 887         l = lptr_msa_aer(isize,itype,iphase)
 888         if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
 889
 890         l = lptr_co3_aer(isize,itype,iphase)
 891         if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
 892
 893         l = lptr_ca_aer(isize,itype,iphase)
 894         if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
 895
 896 ! soa aerosol-phase species -- currently deactivated
 897 !       l = lptr_aro1_aer(isize,itype,iphase)
 898 !       if (l .ge. p1st) rsub(l,k,m) = aer(iaro1_a,jtotal,ibin)*conv1b
 899
 900 !       l = lptr_aro2_aer(isize,itype,iphase)
 901 !       if (l .ge. p1st) rsub(l,k,m) = aer(iaro2_a,jtotal,ibin)*conv1b
 902
 903 !       l = lptr_alk1_aer(isize,itype,iphase)
 904 !       if (l .ge. p1st) rsub(l,k,m) = aer(ialk1_a,jtotal,ibin)*conv1b
 905
 906 !       l = lptr_ole1_aer(isize,itype,iphase)
 907 !       if (l .ge. p1st) rsub(l,k,m) = aer(iole1_a,jtotal,ibin)*conv1b
 908
 909 !       l = lptr_api1_aer(isize,itype,iphase)
 910 !       if (l .ge. p1st) rsub(l,k,m) = aer(iapi1_a,jtotal,ibin)*conv1b
 911
 912 !       l = lptr_api2_aer(isize,itype,iphase)
 913 !       if (l .ge. p1st) rsub(l,k,m) = aer(iapi2_a,jtotal,ibin)*conv1b
 914
 915 !       l = lptr_lim1_aer(isize,itype,iphase)
 916 !       if (l .ge. p1st) rsub(l,k,m) = aer(ilim1_a,jtotal,ibin)*conv1b
 917
 918 !       l = lptr_lim2_aer(isize,itype,iphase)
 919 !       if (l .ge. p1st) rsub(l,k,m) = aer(ilim2_a,jtotal,ibin)*conv1b
 920
 921         l = hyswptr_aer(isize,itype)
 922         if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
 923
 924         l = waterptr_aer(isize,itype)
 925         if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
 926
 927         l = numptr_aer(isize,itype,iphase)
 928         if (l .ge. p1st) rsub(l,k,m) =  num_a(ibin)/cair_mol_cc
 929
 930
 931         drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
 932         if(jaerosolstate(ibin) .eq. no_aerosol) then
 933             drydens_aftgrow(isize,itype) = -1.
 934         else
 935             drydens_aftgrow(isize,itype) = dens_dry_a(ibin)         ! g/cc
 936         end if
 937
 938 20      continue
 939
 940       endif
 941
 942       return
 943       end subroutine map_mosaic_species
 944
 945
 946
 947
 948
 949       subroutine isize_itype_from_ibin( ibin, isize, itype )
 950 !
 951 ! inside of mosaic, the '2d' (isize,itype) indexing is replaced
 952 !     by '1d' (ibin) indexing
 953 ! this routine gives (isize,itype) corresponding to (ibin)
 954 !
 955       use module_data_mosaic_asect
 956       use module_data_mosaic_other, only:  lunerr
 957 !     implicit none
 958
 959 ! subr arguments
 960       integer ibin, isize, itype
 961 ! local variables
 962       integer jdum_bin, jdum_size, jdum_type
 963       character*80 msg
 964
 965       isize = -999888777
 966       itype = -999888777
 967
 968       jdum_bin = 0
 969       do jdum_type = 1, ntype_aer
 970       do jdum_size = 1, nsize_aer(jdum_type)
 971           jdum_bin = jdum_bin + 1
 972           if (ibin .eq. jdum_bin) then
 973               isize = jdum_size
 974               itype = jdum_type
 975           end if
 976       end do
 977       end do
 978
 979       if (isize .le. 0) then
 980           write(msg,'(a,1x,i5)')   &
 981               '*** subr isize_itype_from_ibin - bad ibin =', ibin
 982           call peg_error_fatal( lunerr, msg )
 983       end if
 984
 985       return
 986       end subroutine isize_itype_from_ibin
 987
 988
 989
 990
 991       subroutine overall_massbal_in
 992
 993       use module_data_mosaic_asect
 994       use module_data_mosaic_other
 995
 996 !     implicit none
 997 !     include 'mosaic.h'
 998       integer ibin
 999
1000       tot_so4_in = gas(ih2so4_g)
1001       tot_no3_in = gas(ihno3_g)
1002       tot_cl_in  = gas(ihcl_g)
1003       tot_nh4_in = gas(inh3_g)
1004       tot_na_in  = 0.0
1005       tot_ca_in  = 0.0
1006
1007
1008       do ibin = 1, nbin_a
1009         tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
1010         tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
1011         tot_cl_in  = tot_cl_in  + aer(icl_a, jtotal,ibin)
1012         tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
1013         tot_na_in  = tot_na_in  + aer(ina_a,jtotal,ibin)
1014         tot_ca_in  = tot_ca_in  + aer(ica_a,jtotal,ibin)
1015       enddo
1016
1017
1018         total_species(inh3_g) = tot_nh4_in
1019         total_species(ihno3_g)= tot_no3_in
1020         total_species(ihcl_g) = tot_cl_in
1021
1022
1023       return
1024       end subroutine overall_massbal_in
1025
1026
1027
1028       subroutine overall_massbal_out(mbin)
1029 !     implicit none
1030 !      include 'v33com'
1031 !      include 'v33com3'
1032 !      include 'v33com9a'
1033 !      include 'v33com9b'
1034 !     include 'mosaic.h'
1035
1036 ! subr. agrument
1037       integer mbin
1038 ! local variables
1039       integer ibin
1040
1041
1042
1043         tot_so4_out = gas(ih2so4_g)
1044         tot_no3_out = gas(ihno3_g)
1045         tot_cl_out  = gas(ihcl_g)
1046         tot_nh4_out = gas(inh3_g)
1047         tot_na_out  = 0.0
1048         tot_ca_out  = 0.0
1049
1050         do ibin = 1, nbin_a
1051           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1052           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1053           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
1054           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1055           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
1056           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
1057         enddo
1058
1059         diff_so4 = tot_so4_out - tot_so4_in
1060         diff_no3 = tot_no3_out - tot_no3_in
1061         diff_cl  = tot_cl_out  - tot_cl_in
1062         diff_nh4 = tot_nh4_out - tot_nh4_in
1063         diff_na  = tot_na_out  - tot_na_in
1064         diff_ca  = tot_ca_out  - tot_ca_in
1065
1066
1067         reldiff_so4 = 0.0
1068         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1069           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1070         endif
1071
1072         reldiff_no3 = 0.0
1073         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1074           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1075         endif
1076
1077         reldiff_cl = 0.0
1078         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1079           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1080         endif
1081
1082         reldiff_nh4 = 0.0
1083         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1084           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1085         endif
1086
1087         reldiff_na = 0.0
1088         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1089           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1090         endif
1091
1092         reldiff_ca = 0.0
1093         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1094           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1095         endif
1096
1097
1098
1099       if(  abs(reldiff_so4) .gt. 1.e-4 .or.   &
1100            abs(reldiff_no3) .gt. 1.e-4 .or.   &
1101            abs(reldiff_cl)  .gt. 1.e-4 .or.   &
1102            abs(reldiff_nh4) .gt. 1.e-4 .or.   &
1103            abs(reldiff_na)  .gt. 1.e-4 .or.   &
1104            abs(reldiff_ca)  .gt. 1.e-4)then
1105
1106
1107         if (iprint_mosaic_diag1 .gt. 0) then
1108           if (iprint_input .eq. myes) then
1109             write(6,*)'*** mbin = ', mbin, '  isteps = ', isteps_ASTEM
1110             write(6,*)'reldiff_so4 = ', reldiff_so4
1111             write(6,*)'reldiff_no3 = ', reldiff_no3
1112             write(6,*)'reldiff_cl  = ', reldiff_cl
1113             write(6,*)'reldiff_nh4 = ', reldiff_nh4
1114             write(6,*)'reldiff_na  = ', reldiff_na
1115             write(6,*)'reldiff_ca  = ', reldiff_ca
1116             call print_input
1117             iprint_input = mno
1118           endif
1119         endif
1120
1121       endif
1122
1123
1124       return
1125       end subroutine overall_massbal_out
1126
1127
1128
1129
1130
1131
1132
1133       subroutine print_input
1134
1135       use module_data_mosaic_asect
1136       use module_data_mosaic_other
1137
1138 !     implicit none
1139 !     include 'v33com'
1140 !     include 'v33com3'
1141 !     include 'v33com9a'
1142 !     include 'v33com9b'
1143 !     include 'mosaic.h'
1144 ! subr arguments
1145       integer k, m
1146 ! local variables
1147       integer ibin, iphase, isize, itype
1148       integer ipasstmp, luntmp
1149
1150
1151 ! check for print_input allowed and not already done
1152         if (iprint_mosaic_input_ok .le. 0) return
1153         if (iprint_input .ne. myes) return
1154         iprint_input = mno
1155
1156         k = kclm_aer
1157         m = mclm_aer
1158
1159
1160         tot_so4_out = gas(ih2so4_g)
1161         tot_no3_out = gas(ihno3_g)
1162         tot_cl_out  = gas(ihcl_g)
1163         tot_nh4_out = gas(inh3_g)
1164         tot_na_out  = 0.0
1165         tot_ca_out  = 0.0
1166
1167         do ibin = 1, nbin_a
1168           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
1169           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
1170           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
1171           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
1172           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
1173           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
1174         enddo
1175
1176         diff_so4 = tot_so4_out - tot_so4_in
1177         diff_no3 = tot_no3_out - tot_no3_in
1178         diff_cl  = tot_cl_out  - tot_cl_in
1179         diff_nh4 = tot_nh4_out - tot_nh4_in
1180         diff_na  = tot_na_out  - tot_na_in
1181         diff_ca  = tot_ca_out  - tot_ca_in
1182
1183
1184         reldiff_so4 = 0.0
1185         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
1186           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
1187         endif
1188
1189         reldiff_no3 = 0.0
1190         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
1191           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
1192         endif
1193
1194         reldiff_cl = 0.0
1195         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
1196           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
1197         endif
1198
1199         reldiff_nh4 = 0.0
1200         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
1201           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
1202         endif
1203
1204         reldiff_na = 0.0
1205         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
1206           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
1207         endif
1208
1209         reldiff_ca = 0.0
1210         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
1211           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
1212         endif
1213
1214
1215         do 2900 ipasstmp = 1, 2
1216
1217         if (ipasstmp .eq. 1) then
1218            luntmp = 6     ! write to standard output
1219         else
1220            luntmp = 67    ! write to fort.67
1221 !           goto 2900      ! skip this
1222         endif
1223
1224 ! write to monitor screen
1225           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1226           write(luntmp,*)'i j k n = ', iclm_aer, jclm_aer, kclm_aer,   &
1227                                   ncorecnt_aer
1228           write(luntmp,*)'relative so4 mass bal = ', reldiff_so4
1229           write(luntmp,*)'relative no3 mass bal = ', reldiff_no3
1230           write(luntmp,*)'relative cl  mass bal = ', reldiff_cl
1231           write(luntmp,*)'relative nh4 mass bal = ', reldiff_nh4
1232           write(luntmp,*)'relative na  mass bal = ', reldiff_na
1233           write(luntmp,*)'relative ca  mass bal = ', reldiff_ca
1234           write(luntmp,*)'inputs:'
1235           write(luntmp,*)'t (k), p (atm), rh (%), cair (mol/cc) = '
1236           write(luntmp,44) t_k, p_atm, rh_pc, cairclm(k)
1237           write(luntmp,*)'gas h2so4, hno3, hcl, nh3 (mol/mol)'
1238           write(luntmp,44)rsub(kh2so4,k,m), rsub(khno3,k,m),   &
1239                           rsub(khcl,k,m), rsub(knh3,k,m)
1240
1241
1242           iphase = ai_phase
1243           ibin = 0
1244           do itype = 1, ntype_aer
1245           do isize = 1, nsize_aer(itype)
1246           ibin = ibin + 1
1247
1248           write(luntmp,44) rsub(lptr_so4_aer(ibin,itype,iphase),k,m),   &
1249                       rsub(lptr_no3_aer(ibin,itype,iphase),k,m),   &
1250                       rsub(lptr_cl_aer(ibin,itype,iphase),k,m),   &
1251                       rsub(lptr_nh4_aer(ibin,itype,iphase),k,m),   &
1252                       rsub(lptr_oc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
1253                       rsub(lptr_co3_aer(ibin,itype,iphase),k,m),   &
1254                       rsub(lptr_msa_aer(ibin,itype,iphase),k,m),   &
1255                       rsub(lptr_bc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
1256                       rsub(lptr_na_aer(ibin,itype,iphase),k,m),   &
1257                       rsub(lptr_ca_aer(ibin,itype,iphase),k,m),   &
1258                       rsub(lptr_oin_aer(ibin,itype,iphase),k,m),           &
1259                       rsub(hyswptr_aer(ibin,itype),k,m),   &
1260                       rsub(waterptr_aer(ibin,itype),k,m),   &
1261                       rsub(numptr_aer(ibin,itype,iphase),k,m)
1262           enddo
1263           enddo
1264
1265           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
1266
1267 2900    continue
1268
1269
1270 44      format(14e20.10)
1271
1272 !c      stop
1273
1274       return
1275       end subroutine print_input
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294 !***********************************************************************
1295 ! checks if aerosol mass is too low to be of any significance
1296 ! and determine jaerosolstate
1297 !
1298 ! author: rahul a. zaveri
1299 ! update: jan 2005
1300 !-----------------------------------------------------------------------
1301       subroutine check_aerosol_mass(ibin)
1302 !     implicit none
1303 !     include 'mosaic.h'
1304 ! subr arguments
1305       integer ibin
1306 ! local variables
1307       integer iaer
1308       real(kind=8) drymass, aer_H
1309
1310       mass_dry_a(ibin) = 0.0
1311
1312       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
1313                   aer(ino3_a,jtotal,ibin) +  &
1314                   aer(icl_a,jtotal,ibin)  +  &
1315                   aer(imsa_a,jtotal,ibin) +  &
1316                2.*aer(ico3_a,jtotal,ibin))-  &
1317               (2.*aer(ica_a,jtotal,ibin)  +  &
1318                   aer(ina_a,jtotal,ibin)  +  &
1319                   aer(inh4_a,jtotal,ibin))
1320
1321
1322       do iaer = 1, naer
1323         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
1324                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
1325       enddo
1326       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1327
1328       drymass = mass_dry_a(ibin)                        ! ng/m^3(air)
1329       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15        ! g/cc(air)
1330
1331       if(drymass .lt. mass_cutoff)then                  ! bin mass is too small
1332         jaerosolstate(ibin) = no_aerosol
1333         jphase(ibin) = 0
1334         if(drymass .eq. 0.)num_a(ibin) = 0.0
1335       endif
1336
1337       return
1338       end subroutine check_aerosol_mass
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350 !***********************************************************************
1351 ! checks and conforms number according to the mass and bin size range
1352 !
1353 ! author: rahul a. zaveri
1354 ! update: jan 2005
1355 !-----------------------------------------------------------------------
1356       subroutine conform_aerosol_number(ibin)
1357
1358       use module_data_mosaic_asect
1359
1360 !     implicit none
1361 !     include 'v33com'
1362 !     include 'v33com3'
1363 !     include 'v33com9a'
1364 !     include 'mosaic.h'
1365 ! subr arguments
1366       integer ibin
1367 ! local variables
1368       integer je, l, iaer, isize, itype
1369       real(kind=8) num_at_dlo, num_at_dhi, numold
1370       real(kind=8) aer_H
1371
1372       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
1373
1374       if(jaerosolstate(ibin) .eq. no_aerosol) return
1375
1376       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
1377                   aer(ino3_a,jtotal,ibin) +  &
1378                   aer(icl_a,jtotal,ibin)  +  &
1379                   aer(imsa_a,jtotal,ibin) +  &
1380                2.*aer(ico3_a,jtotal,ibin))-  &
1381               (2.*aer(ica_a,jtotal,ibin)  +  &
1382                   aer(ina_a,jtotal,ibin)  +  &
1383                   aer(inh4_a,jtotal,ibin))
1384
1385       do iaer = 1, naer
1386         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
1387         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)  ! ng/m^3(air)
1388       enddo
1389       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1390
1391       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15  ! cc(aer)/cc(air)
1392
1393 ! conform number
1394       call isize_itype_from_ibin( ibin, isize, itype )
1395       num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
1396       num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
1397
1398       numold = num_a(ibin)
1399       num_a(ibin) = min(num_a(ibin), num_at_dlo) ! #/cc(air)
1400       num_a(ibin) = max(num_a(ibin), num_at_dhi) ! #/cc(air)
1401
1402 !     if (numold .ne. num_a(ibin)) then
1403 !       write(*,*) 'conform number - i, vol, mass, numold/new', ibin,
1404 !     &       vol_dry_a(ibin), mass_dry_temp, numold, num_a(ibin)
1405 !       write(*,*) 'conform i,j,k', iclm_aer, jclm_aer, kclm_aer
1406 !       if (nsubareas .gt. 0) then
1407 !       write(*,'(a,1pe14.4)') (name(l), rsub(l,kclm_aer,1), l=1,ltot2)
1408 !       else
1409 !       write(*,'(a,1pe14.4)') (name(l), rclm(kclm_aer,l), l=1,ltot2)
1410 !       end if
1411 !      stop
1412 !      end if
1413
1414       return
1415       end subroutine conform_aerosol_number
1416
1417
1418
1419
1420
1421 !***********************************************************************
1422 ! determines phase state of an aerosol bin. includes kelvin effect.
1423 !
1424 ! author: rahul a. zaveri
1425 ! update: jan 2005
1426 !-----------------------------------------------------------------------
1427       subroutine aerosol_phase_state(ibin)
1428 !     implicit none
1429 !     include 'mosaic.h'
1430 ! subr arguments
1431       integer ibin
1432 ! local variables
1433       integer js, je, iaer, iv, iter_kelvin
1434       real(kind=8) ah2o_a_new, rel_err
1435 !     real(kind=8) aerosol_water_up, bin_molality               ! mosaic func
1436       real(kind=8) kelvin_toler, term
1437       real(kind=8) aer_H
1438
1439
1440       ah2o = rh_pc*0.01
1441       ah2o_a(ibin) = ah2o
1442       kelvin(ibin) = 1.0
1443       do iv = 1, ngas_volatile
1444         kel(iv,ibin) = 1.0
1445       enddo
1446
1447       if(rh_pc .le. 99)then
1448         kelvin_toler = 1.e-2
1449       else
1450         kelvin_toler = 1.e-6
1451       endif
1452
1453 ! calculate dry mass and dry volume of a bin
1454       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
1455       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
1456
1457       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
1458                   aer(ino3_a,jtotal,ibin) +  &
1459                   aer(icl_a,jtotal,ibin)  +  &
1460                   aer(imsa_a,jtotal,ibin) +  &
1461                2.*aer(ico3_a,jtotal,ibin))-  &
1462               (2.*aer(ica_a,jtotal,ibin)  +  &
1463                   aer(ina_a,jtotal,ibin)  +  &
1464                   aer(inh4_a,jtotal,ibin))
1465
1466       do iaer = 1, naer
1467         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
1468                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
1469         vol_dry_a(ibin)  = vol_dry_a(ibin) +   &
1470         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
1471       enddo
1472       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1473       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1474
1475       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
1476       vol_dry_a(ibin)  = vol_dry_a(ibin)*1.e-15                         ! cc(aer)/cc(air) or m^3/m^3(air)
1477
1478 ! wet mass and wet volume
1479       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
1480       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
1481
1482
1483       water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
1484
1485       iter_kelvin = 0
1486
1487 10    iter_kelvin = iter_kelvin + 1
1488       do je = 1, nelectrolyte
1489         molality0(je) = bin_molality(je,ibin)   ! compute ah2o dependent binary molalities
1490       enddo
1491
1492       call mesa(ibin)
1493       if(jaerosolstate(ibin) .eq. all_solid)then
1494         return
1495       endif
1496       if (istat_mosaic_fe1 .lt. 0) return
1497
1498 ! new wet mass and wet volume
1499       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
1500       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
1501
1502       call calculate_kelvin(ibin)
1503
1504       ah2o_a_new = rh_pc*0.01/kelvin(ibin)
1505
1506       rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
1507
1508       if(rel_err .gt. kelvin_toler .and. iter_kelvin.le.20)then
1509         ah2o_a(ibin) = ah2o_a_new
1510         goto 10
1511       endif
1512
1513       if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
1514
1515 ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
1516       do iv = 1,  ngas_volatile
1517         term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/  &
1518                        (8.3144e7*T_K*DpmV(ibin))
1519         kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1520       enddo
1521
1522
1523       return
1524       end subroutine aerosol_phase_state
1525
1526
1527
1528
1529
1530
1531 !***********************************************************************
1532 ! computes kelvin effect term (kelvin => 1.0)
1533 !
1534 ! author: rahul a. zaveri
1535 ! update: jan 2005
1536 !-----------------------------------------------------------------------
1537       subroutine calculate_kelvin(ibin)
1538 !     implicit none
1539 !     include 'mosaic.h'
1540 ! subr arguments
1541       integer ibin
1542 ! local variables
1543       real(kind=8) term
1544
1545
1546
1547       volume_a(ibin) = vol_wet_a(ibin)                                  ! [cc/cc(air)]
1548       dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.)   ! [cm]
1549       sigma_soln(ibin) = sigma_water + 49.0*(1. - ah2o_a(ibin))         ! [dyn/cm]
1550       term = 72.*sigma_soln(ibin)/(8.3144e7*t_k*dpmv(ibin))             ! [-]
1551 !      kelvin(ibin) = exp(term)
1552       kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
1553
1554
1555       return
1556       end subroutine calculate_kelvin
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572 !***********************************************************************
1573 ! mesa: multicomponent equilibrium solver for aerosols.
1574 ! computes equilibrum solid and liquid phases by integrating
1575 ! pseudo-transient dissolution and precipitation reactions
1576 !
1577 ! author: rahul a. zaveri
1578 ! update: jan 2005
1579 !-----------------------------------------------------------------------
1580       subroutine mesa(ibin)     ! touch
1581 !     implicit none
1582 !     include 'mosaic.h'
1583 ! subr arguments
1584       integer ibin
1585
1586 ! local variables
1587       integer idissolved, j_index, jdum, js
1588       real(kind=8) crh, solids, sum_soluble, sum_insoluble, xt
1589 !     real(kind=8) aerosol_water                                ! mosaic func
1590 !     real(kind=8) drh_mutual                                   ! mosaic func
1591       real(kind=8) h_ion
1592
1593
1594       call calculate_xt(ibin,jtotal,xt)
1595
1596       crh = 0.1
1597
1598 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
1599       if(ah2o_a(ibin).lt.crh .and. (xt.gt.1.0 .or. xt.lt.0.))then
1600         jaerosolstate(ibin) = all_solid
1601         jphase(ibin)    = jsolid
1602         jhyst_leg(ibin) = jhyst_lo
1603         call adjust_solid_aerosol(ibin)
1604         return
1605       endif
1606
1607
1608 ! step 2: check for supersaturation/metastable state
1609       if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin))then
1610
1611         call do_full_deliquescence(ibin)
1612
1613         sum_soluble = 0.0
1614         do js = 1, nsoluble
1615           sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
1616         enddo
1617
1618         solids = electrolyte(jcaso4,jtotal,ibin) +   &
1619                  electrolyte(jcaco3,jtotal,ibin) +   &
1620                  aer(ioin_a ,jtotal,ibin)
1621
1622
1623         if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
1624
1625           jaerosolstate(ibin) = all_solid ! no soluble material present
1626           jphase(ibin) = jsolid
1627           call adjust_solid_aerosol(ibin)
1628
1629 ! new wet mass and wet volume
1630           mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
1631           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
1632           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
1633
1634           return
1635
1636         elseif(sum_soluble .gt. 0.0 .and. solids .eq. 0.0)then
1637
1638           jaerosolstate(ibin) = all_liquid
1639           jhyst_leg(ibin) = jhyst_up
1640           jphase(ibin) = jliquid
1641           water_a(ibin) = aerosol_water(jtotal,ibin)
1642
1643           if(water_a(ibin) .lt. 0.0)then
1644             jaerosolstate(ibin) = all_solid ! no soluble material present
1645             jphase(ibin)    = jsolid
1646             jhyst_leg(ibin) = jhyst_lo
1647             call adjust_solid_aerosol(ibin)
1648           else
1649             call adjust_liquid_aerosol(ibin)
1650             call compute_activities(ibin)
1651           endif
1652
1653 ! new wet mass and wet volume
1654           mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
1655           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
1656           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
1657
1658           return
1659
1660         endif
1661
1662       endif
1663
1664
1665
1666
1667 ! step 3: diagnose mdrh
1668       if(xt .lt. 1. .and. xt .gt. 0. )goto 10   ! excess sulfate domain - no mdrh exists
1669
1670       jdum = 0
1671       do js = 1, nsalt
1672         jsalt_present(js) = 0                   ! default value - salt absent
1673
1674         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
1675           jsalt_present(js) = 1                 ! salt present
1676           jdum = jdum + jsalt_index(js)
1677         endif
1678       enddo
1679
1680       if(jdum .eq. 0)then
1681         jaerosolstate(ibin) = all_solid ! no significant soluble material present
1682         jphase(ibin) = jsolid
1683         call adjust_solid_aerosol(ibin)
1684         return
1685       endif
1686
1687       if(xt .ge. 2.0 .or. xt .lt. 0.0)then
1688         j_index = jsulf_poor(jdum)
1689       else
1690         j_index = jsulf_rich(jdum)
1691       endif
1692
1693       mdrh(ibin) = mdrh_t(j_index)
1694
1695       if(ah2o_a(ibin)*100. .lt. mdrh(ibin)) then
1696         jaerosolstate(ibin) = all_solid
1697         jphase(ibin) = jsolid
1698         jhyst_leg(ibin) = jhyst_lo
1699         call adjust_solid_aerosol(ibin)
1700         return
1701       endif
1702
1703
1704 ! step 4: none of the above means it must be sub-saturated or mixed-phase
1705 10    call do_full_deliquescence(ibin)
1706       call mesa_ptc(ibin)       ! determines jaerosolstate(ibin)
1707       if (istat_mosaic_fe1 .lt. 0) return
1708
1709
1710
1711       return
1712       end subroutine mesa
1713
1714
1715
1716
1717
1718
1719
1720
1721 !***********************************************************************
1722 ! this subroutine completely deliquesces an aerosol and partitions
1723 ! all the soluble electrolytes into the liquid phase and insoluble
1724 ! ones into the solid phase. it also calculates the corresponding
1725 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
1726 ! concentrations
1727 !
1728 ! author: rahul a. zaveri
1729 ! update: jan 2005
1730 !-----------------------------------------------------------------------
1731       subroutine do_full_deliquescence(ibin)    ! touch
1732 !     implicit none
1733 !     include 'mosaic.h'
1734 ! subr arguments
1735       integer ibin
1736 ! local variables
1737       integer js
1738
1739
1740
1741
1742 ! partition all electrolytes into liquid phase
1743       do js = 1, nelectrolyte
1744        electrolyte(js,jsolid,ibin)  = 0.0
1745        electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
1746       enddo
1747 !
1748 ! except these electrolytes, which always remain in the solid phase
1749       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1750       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1751       electrolyte(jcaco3,jliquid,ibin)= 0.0
1752       electrolyte(jcaso4,jliquid,ibin)= 0.0
1753
1754
1755 ! partition all the generic aer species into solid and liquid phases
1756 ! solid phase
1757       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1758       aer(ino3_a,jsolid,ibin) = 0.0
1759       aer(icl_a, jsolid,ibin) = 0.0
1760       aer(inh4_a,jsolid,ibin) = 0.0
1761       aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1762       aer(imsa_a,jsolid,ibin) = 0.0
1763       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1764       aer(ina_a, jsolid,ibin) = 0.0
1765       aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) +   &
1766                                 electrolyte(jcaso4,jsolid,ibin)
1767       aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1768       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
1769       aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
1770       aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
1771       aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
1772       aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
1773       aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
1774       aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
1775       aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
1776       aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
1777
1778 ! liquid-phase
1779       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) -   &
1780                                  electrolyte(jcaso4,jsolid,ibin)
1781       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1782       aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1783       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1784       aer(ioc_a, jliquid,ibin) = 0.0
1785       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1786       aer(ico3_a,jliquid,ibin) = 0.0
1787       aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1788       aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) +   &
1789                                  electrolyte(jcacl2,jtotal,ibin)
1790       aer(ibc_a, jliquid,ibin) = 0.0
1791       aer(ioin_a,jliquid,ibin) = 0.0
1792       aer(iaro1_a,jliquid,ibin)= 0.0
1793       aer(iaro2_a,jliquid,ibin)= 0.0
1794       aer(ialk1_a,jliquid,ibin)= 0.0
1795       aer(iole1_a,jliquid,ibin)= 0.0
1796       aer(iapi1_a,jliquid,ibin)= 0.0
1797       aer(iapi2_a,jliquid,ibin)= 0.0
1798       aer(ilim1_a,jliquid,ibin)= 0.0
1799       aer(ilim2_a,jliquid,ibin)= 0.0
1800
1801       return
1802       end subroutine do_full_deliquescence
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825 !***********************************************************************
1826 ! mesa: multicomponent equilibrium solver for aerosol-phase
1827 ! computes equilibrum solid and liquid phases by integrating
1828 ! pseudo-transient dissolution and precipitation reactions
1829 !
1830 ! author: rahul a. zaveri
1831 ! update: jan 2005
1832 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
1833 !-----------------------------------------------------------------------
1834       subroutine mesa_ptc(ibin)         ! touch
1835 !     implicit none
1836 !     include 'mosaic.h'
1837 ! subr arguments
1838       integer ibin
1839 ! local variables
1840       integer iaer, iconverge, iconverge_flux, iconverge_mass,   &
1841            idissolved, itdum, js, je, jp
1842       real(kind=8) tau_p(nsalt), tau_d(nsalt)
1843       real(kind=8) frac_solid, sumflux, hsalt_min, alpha, xt, dumdum,   &
1844            h_ion
1845       real(kind=8) phi_prod, alpha_fac, sum_dum
1846       real(kind=8) aer_H
1847 ! function
1848 !     real(kind=8) aerosol_water
1849
1850
1851
1852 ! initialize
1853       itdum = 0         ! initialize time
1854       hsalt_max = 1.e25
1855
1856
1857
1858       do js = 1, nsalt
1859         hsalt(js)     = 0.0
1860         sat_ratio(js) = 0.0
1861         phi_salt(js)  = 0.0
1862         flux_sl(js)   = 0.0
1863       enddo
1864
1865
1866       do js = 1, nsalt
1867         jsalt_present(js) = 0                   ! default value - salt absent
1868         if(epercent(js,jtotal,ibin) .gt. 1.0)then
1869           jsalt_present(js) = 1                 ! salt present
1870         endif
1871       enddo
1872
1873
1874       mass_dry_a(ibin) = 0.0
1875
1876       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
1877                   aer(ino3_a,jtotal,ibin) +  &
1878                   aer(icl_a,jtotal,ibin)  +  &
1879                   aer(imsa_a,jtotal,ibin) +  &
1880                2.*aer(ico3_a,jtotal,ibin))-  &
1881               (2.*aer(ica_a,jtotal,ibin)  +  &
1882                   aer(ina_a,jtotal,ibin)  +  &
1883                   aer(inh4_a,jtotal,ibin))
1884
1885       do iaer = 1, naer
1886        mass_dry_a(ibin) = mass_dry_a(ibin) +  &
1887           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)        ! [ng/m^3(air)]
1888         vol_dry_a(ibin)  = vol_dry_a(ibin) +  &
1889           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)     ! ncc/m^3(air)
1890       enddo
1891       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1892       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1893
1894       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! [g/cc(air)]
1895       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! [cc(aer)/cc(air)]
1896
1897       mass_dry_salt(ibin) = 0.0         ! soluble salts only
1898       do je = 1, nsalt
1899         mass_dry_salt(ibin) = mass_dry_salt(ibin) +  &
1900               electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15     ! g/cc(air)
1901       enddo
1902
1903 !      call mesa_check_complete_dissolution(ibin,          &
1904 !                                           mdissolved,    &
1905 !                                           iconverge_flux)
1906 !      if (istat_mosaic_fe1 .lt. 0) return
1907 !      if(mdissolved .eq. myes .or. iconverge_flux .eq. myes)then
1908 !        return
1909 !      endif
1910
1911
1912       nmesa_call = nmesa_call + 1
1913
1914 !----begin pseudo time continuation loop-------------------------------
1915
1916       do 500 itdum = 1, nmax_mesa
1917
1918
1919 ! compute new salt fluxes
1920       call mesa_flux_salt(ibin)
1921       if (istat_mosaic_fe1 .lt. 0) return
1922
1923
1924 ! check convergence
1925       call mesa_convergence_criterion(ibin,      &
1926                                       iconverge_mass,   &
1927                                       iconverge_flux,   &
1928                                       idissolved)
1929
1930       if(iconverge_mass .eq. myes)then
1931         iter_mesa(ibin) = iter_mesa(ibin) + itdum
1932         niter_mesa = niter_mesa + itdum
1933         niter_mesa_max = max(niter_mesa_max, itdum)
1934         jaerosolstate(ibin) = all_solid
1935         call adjust_solid_aerosol(ibin)
1936         jhyst_leg(ibin) = jhyst_lo
1937         growth_factor(ibin) = 1.0
1938         return
1939       elseif(iconverge_flux .eq. myes)then
1940         iter_mesa(ibin) = iter_mesa(ibin)+ itdum
1941         niter_mesa = niter_mesa + itdum
1942         niter_mesa_max = max(niter_mesa_max, itdum)
1943         mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
1944         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3                ! cc(aer)/cc(air) or m^3/m^3(air)
1945         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)         ! mass growth factor
1946
1947         if(idissolved .eq. myes)then
1948           jaerosolstate(ibin) = all_liquid
1949 !          jhyst_leg(ibin) = jhyst_up  ! do this later (to avoid tripping kelvin iterations)
1950         else
1951           jaerosolstate(ibin) = mixed
1952           jhyst_leg(ibin) = jhyst_lo
1953         endif
1954
1955 ! calculate epercent(jsolid) composition in mixed-phase aerosol
1956         sum_dum = 0.0
1957         jp = jsolid
1958         do je = 1, nelectrolyte
1959           electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
1960           sum_dum = sum_dum + electrolyte(je,jp,ibin)
1961         enddo
1962         electrolyte_sum(jp,ibin) = sum_dum
1963         if(sum_dum .eq. 0.)sum_dum = 1.0
1964         do je = 1, nelectrolyte
1965           epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
1966         enddo
1967
1968         return
1969       endif
1970
1971
1972 ! calculate hsalt(js)   ! time step
1973       hsalt_min = 1.e25
1974       do js = 1, nsalt
1975
1976         phi_prod = phi_salt(js) * phi_salt_old(js)
1977
1978         if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
1979           phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/   &
1980                                     alpha_salt(js)
1981         else
1982           phi_bar(js) = 0.0                     ! oscillating, or phi_salt and/or phi_salt_old may be zero
1983         endif
1984
1985         if(phi_bar(js) .lt. 0.0)then            ! good. phi getting lower. maybe able to take bigger alphas
1986           phi_bar(js) = max(phi_bar(js), -10.0D0)
1987           alpha_fac = 3.0*exp(phi_bar(js))
1988           alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9D0)
1989         elseif(phi_bar(js) .gt. 0.0)then        ! bad - phi is getting bigger. so be conservative with alpha
1990            alpha_salt(js) = min(abs(phi_salt(js)), 0.5D0)
1991         else                                    ! very bad - phi is oscillating. be very conservative
1992            alpha_salt(js) = min(abs(phi_salt(js))/3.0, 0.5D0)
1993         endif
1994
1995 !        alpha_salt(js) = max(alpha_salt(js), 0.01D0)
1996
1997         phi_salt_old(js) = phi_salt(js)         ! update old array
1998
1999
2000         if(flux_sl(js) .gt. 0.)then
2001
2002           tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
2003           if(tau_p(js) .eq. 0.0)then
2004             hsalt(js) = 1.e25
2005             flux_sl(js) = 0.0
2006             phi_salt(js)= 0.0
2007           else
2008             hsalt(js) = alpha_salt(js)*tau_p(js)
2009           endif
2010
2011         elseif(flux_sl(js) .lt. 0.)then
2012
2013           tau_p(js) = -eleliquid(js)/flux_sl(js)        ! precipitation time scale
2014           tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
2015           if(tau_p(js) .eq. 0.0)then
2016             hsalt(js) = alpha_salt(js)*tau_d(js)
2017           else
2018             hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
2019           endif
2020
2021         else
2022
2023           hsalt(js) = 1.e25
2024
2025         endif
2026
2027           hsalt_min = min(hsalt(js), hsalt_min)
2028
2029       enddo
2030
2031 !---------------------------------
2032
2033 ! integrate electrolyte(solid)
2034       do js = 1, nsalt
2035         electrolyte(js,jsolid,ibin) =    &
2036                          electrolyte(js,jsolid,ibin)  +   &
2037                          hsalt(js) * flux_sl(js)
2038       enddo
2039
2040
2041 ! compute aer(solid) from electrolyte(solid)
2042       call electrolytes_to_ions(jsolid,ibin)
2043
2044
2045 ! compute new electrolyte(liquid) from mass balance
2046       do iaer = 1, naer
2047         aer(iaer,jliquid,ibin) = aer(iaer,jtotal,ibin) -   &
2048                                        aer(iaer,jsolid,ibin)
2049       enddo
2050
2051 !---------------------------------
2052
2053
2054
2055 500   continue  ! end time continuation loop
2056 !--------------------------------------------------------------------
2057       nmesa_fail = nmesa_fail + 1
2058       iter_mesa(ibin) = iter_mesa(ibin) + itdum
2059       niter_mesa = niter_mesa + itdum
2060       jaerosolstate(ibin) = mixed
2061       jhyst_leg(ibin) = jhyst_lo
2062       mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3      ! g/cc(air)
2063       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
2064       growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)           ! mass growth factor
2065
2066       return
2067       end subroutine mesa_ptc
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078 !***********************************************************************
2079 ! part of mesa: checks if particle is completely deliquesced at the
2080 ! current rh
2081 !
2082 ! author: rahul a. zaveri
2083 ! update: feb 2005
2084 !-----------------------------------------------------------------------
2085       subroutine mesa_check_complete_dissolution(ibin,          &
2086                                                  mdissolved,    &
2087                                                  iconverge_flux)
2088 !     implicit none
2089 !     include 'mosaic.h'
2090 ! subr arguments
2091       integer ibin, mdissolved, iconverge_flux, je, js, iaer
2092 ! local variables
2093       real(kind=8) sumflux, aer_sav(naer,3,nbin_a),   &
2094            electrolyte_sav(nelectrolyte,3,nbin_a), crustal_solids
2095
2096
2097 ! save current solid-liquid arrays
2098       do je = 1, nelectrolyte
2099         electrolyte_sav(je,jsolid,ibin) =electrolyte(je,jsolid,ibin)
2100         electrolyte_sav(je,jliquid,ibin)=electrolyte(je,jliquid,ibin)
2101       enddo
2102
2103       do iaer = 1, naer
2104         aer_sav(iaer,jsolid,ibin) =aer(iaer,jsolid,ibin)
2105         aer_sav(iaer,jliquid,ibin)=aer(iaer,jliquid,ibin)
2106       enddo
2107
2108       call do_full_deliquescence(ibin)
2109
2110       do js = 1, nsalt
2111         sat_ratio(js) = 0.0
2112         phi_salt(js)  = 0.0
2113         flux_sl(js)   = 0.0
2114       enddo
2115
2116
2117 ! compute new salt fluxes
2118       call mesa_flux_salt(ibin)
2119       if (istat_mosaic_fe1 .lt. 0) return
2120
2121
2122 ! check if all the fluxes are zero
2123       sumflux = 0.0
2124       do js = 1, nsalt
2125         sumflux = sumflux + abs(flux_sl(js))
2126       enddo
2127
2128       crustal_solids = electrolyte(jcaco3,jsolid,ibin) +  &
2129                        electrolyte(jcaso4,jsolid,ibin) +  &
2130                        aer(ioin_a,jsolid,ibin)
2131       if(sumflux .eq. 0.0 .and. crustal_solids.eq.0.)then ! it is completely dissolved
2132
2133         jaerosolstate(ibin) = all_liquid
2134         jphase(ibin)        = jliquid
2135         mdissolved          = myes
2136         iconverge_flux      = myes
2137
2138         mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
2139         vol_wet_a(ibin)     = vol_dry_a(ibin) + water_a(ibin)*1.e-3     ! cc(aer)/cc(air) or m^3/m^3(air)
2140         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)         ! mass growth factor
2141
2142       elseif(sumflux .eq. 0.0)then
2143
2144         jaerosolstate(ibin) = mixed
2145         jphase(ibin)        = jliquid
2146         iconverge_flux      = myes
2147         mdissolved          = mno
2148         jhyst_leg(ibin)     = jhyst_lo
2149         mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
2150         vol_wet_a(ibin)     = vol_dry_a(ibin) + water_a(ibin)*1.e-3     ! cc(aer)/cc(air) or m^3/m^3(air)
2151         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)         ! mass growth factor
2152
2153       else ! restore saved solid-liquid arrays
2154
2155         do je = 1, nelectrolyte
2156           electrolyte(je,jsolid,ibin) =electrolyte_sav(je,jsolid,ibin)
2157           electrolyte(je,jliquid,ibin)=electrolyte_sav(je,jliquid,ibin)
2158         enddo
2159         do iaer = 1, naer
2160           aer(iaer,jsolid,ibin) =aer_sav(iaer,jsolid,ibin)
2161           aer(iaer,jliquid,ibin)=aer_sav(iaer,jliquid,ibin)
2162         enddo
2163         mdissolved     = mno
2164         iconverge_flux = mno
2165
2166       endif
2167
2168
2169       return
2170       end subroutine mesa_check_complete_dissolution
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186 !***********************************************************************
2187 ! part of mesa: calculates solid-liquid fluxes of soluble salts
2188 !
2189 ! author: rahul a. zaveri
2190 ! update: jan 2005
2191 !-----------------------------------------------------------------------
2192       subroutine mesa_flux_salt(ibin)   ! touch
2193 !     implicit none
2194 !     include 'mosaic.h'
2195 ! subr arguments
2196       integer ibin
2197 ! local variables
2198       integer js
2199       real(kind=8) xt, calcium, sum_salt
2200
2201
2202 ! compute activities and water content
2203       call ions_to_electrolytes(jliquid,ibin,xt)
2204       if (istat_mosaic_fe1 .lt. 0) return
2205       call compute_activities(ibin)
2206       activity(jna3hso4,ibin)   = 0.0
2207
2208       if(water_a(ibin) .le. 0.0)then
2209         do js = 1, nsalt
2210          flux_sl(js) = 0.0
2211         enddo
2212         return
2213       endif
2214
2215
2216       call mesa_estimate_eleliquid(ibin,xt)
2217
2218       calcium = aer(ica_a,jliquid,ibin)
2219
2220
2221 ! calculate % electrolyte composition in the solid and liquid phases
2222       sum_salt = 0.0
2223       do js = 1, nsalt
2224         sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
2225       enddo
2226       electrolyte_sum(jsolid,ibin) = sum_salt
2227       if(sum_salt .eq. 0.0)sum_salt = 1.0
2228       do js = 1, nsalt
2229         frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
2230         frac_salt_liq(js)   = epercent(js,jliquid,ibin)/100.
2231       enddo
2232
2233
2234
2235 ! compute salt fluxes
2236       do js = 1, nsalt          ! soluble solid salts
2237
2238 ! compute new saturation ratio
2239         sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2240 ! compute relative driving force
2241         phi_salt(js)  = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0D0)
2242
2243 ! check if too little solid-phase salt is trying to dissolve
2244         if(sat_ratio(js)       .lt. 1.00 .and.   &
2245            frac_salt_solid(js) .lt. 0.01 .and.   &
2246            frac_salt_solid(js) .gt. 0.0)then
2247           call mesa_dissolve_small_salt(ibin,js)
2248           call mesa_estimate_eleliquid(ibin,xt)
2249           sat_ratio(js) = activity(js,ibin)/keq_sl(js)
2250         endif
2251
2252 ! compute flux
2253         flux_sl(js) = sat_ratio(js) - 1.0
2254
2255 ! apply heaviside function
2256         if( (sat_ratio(js)               .lt. 1.0 .and.   &
2257              electrolyte(js,jsolid,ibin) .eq. 0.0) .or.   &
2258             (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or.   &
2259             (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
2260           flux_sl(js) = 0.0
2261           phi_salt(js)= 0.0
2262         endif
2263
2264       enddo
2265
2266
2267 ! force cacl2 and cano3 fluxes to zero
2268       sat_ratio(jcano3) = 1.0
2269       phi_salt(jcano3)  = 0.0
2270       flux_sl(jcano3)   = 0.0
2271
2272       sat_ratio(jcacl2) = 1.0
2273       phi_salt(jcacl2)  = 0.0
2274       flux_sl(jcacl2)   = 0.0
2275
2276
2277       return
2278       end subroutine mesa_flux_salt
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291 !***********************************************************************
2292 ! part of mesa: calculates liquid electrolytes from ions
2293 !
2294 ! notes:
2295 !  - this subroutine is to be used for liquid-phase or total-phase only
2296 !  - this sub transfers caso4 and caco3 from liquid to solid phase
2297 !
2298 ! author: rahul a. zaveri
2299 ! update: jan 2005
2300 !-----------------------------------------------------------------------
2301       subroutine mesa_estimate_eleliquid(ibin,xt)       ! touch
2302 !     implicit none
2303 !     include 'mosaic.h'
2304 ! subr arguments
2305       integer ibin, jp
2306       real(kind=8) xt
2307 ! local variables
2308       integer iaer, je, jc, ja, icase
2309       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
2310            f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d,   &
2311            xdum, dum, cat_net
2312       real(kind=8) nc(ncation), na(nanion)
2313       real(kind=8) dum_ca, dum_no3, dum_cl, cano3, cacl2
2314
2315
2316
2317 ! remove negative concentrations, if any
2318       do iaer =  1, naer
2319       aer(iaer,jliquid,ibin) = max(0.0D0, aer(iaer,jliquid,ibin))
2320       enddo
2321
2322
2323 ! calculate sulfate ratio
2324       call calculate_xt(ibin,jliquid,xt)
2325
2326       if(xt .ge. 2.0 .or. xt.lt.0.)then
2327        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
2328       else
2329        icase = 2        ! acidic (acidity is caused by excess so4)
2330       endif
2331
2332
2333 ! initialize to zero
2334       do je = 1, nelectrolyte
2335         eleliquid(je) = 0.0
2336       enddo
2337 !
2338 !---------------------------------------------------------
2339 ! initialize moles of ions depending on the sulfate domain
2340
2341       jp = jliquid
2342
2343       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
2344
2345         dum_ca  = aer(ica_a,jp,ibin)
2346         dum_no3 = aer(ino3_a,jp,ibin)
2347         dum_cl  = aer(icl_a,jp,ibin)
2348
2349         cano3   = min(dum_ca, 0.5*dum_no3)
2350         dum_ca  = max(0.D0, dum_ca - cano3)
2351         dum_no3 = max(0.D0, dum_no3 - 2.*cano3)
2352
2353         cacl2   = min(dum_ca, 0.5*dum_cl)
2354         dum_ca  = max(0.D0, dum_ca - cacl2)
2355         dum_cl  = max(0.D0, dum_cl - 2.*cacl2)
2356
2357         na(ja_hso4)= 0.0
2358         na(ja_so4) = aer(iso4_a,jp,ibin)
2359         na(ja_no3) = aer(ino3_a,jp,ibin)
2360         na(ja_cl)  = aer(icl_a, jp,ibin)
2361         na(ja_msa) = aer(imsa_a,jp,ibin)
2362
2363         nc(jc_ca)  = aer(ica_a, jp,ibin)
2364         nc(jc_na)  = aer(ina_a, jp,ibin)
2365         nc(jc_nh4) = aer(inh4_a,jp,ibin)
2366
2367         cat_net =     &
2368             ( 2.d0*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) ) -  &
2369             ( nc(jc_h)+2.d0*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
2370
2371         if(cat_net .lt. 0.0)then
2372
2373           nc(jc_h) = 0.0
2374
2375         else  ! cat_net must be 0.0 or positive
2376
2377           nc(jc_h) = cat_net
2378
2379         endif
2380
2381
2382 ! now compute equivalent fractions
2383       sum_naza = 0.0
2384       do ja = 1, nanion
2385         sum_naza = sum_naza + na(ja)*za(ja)
2386       enddo
2387
2388       sum_nczc = 0.0
2389       do jc = 1, ncation
2390         sum_nczc = sum_nczc + nc(jc)*zc(jc)
2391       enddo
2392
2393       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
2394         if (iprint_mosaic_diag1 .gt. 0) then
2395           write(6,*)'subroutine mesa_estimate_eleliquid'
2396           write(6,*)'ionic concentrations are zero'
2397           write(6,*)'sum_naza = ', sum_naza
2398           write(6,*)'sum_nczc = ', sum_nczc
2399         endif
2400         return
2401       endif
2402
2403       do ja = 1, nanion
2404         xeq_a(ja) = na(ja)*za(ja)/sum_naza
2405       enddo
2406
2407       do jc = 1, ncation
2408         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2409       enddo
2410
2411       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
2412       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
2413       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
2414       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
2415       na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
2416
2417       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
2418       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
2419       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
2420       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
2421
2422
2423 ! now compute electrolyte moles
2424       eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) +  &
2425                             xeq_a(ja_so4)*nc_mc(jc_na))/   &
2426                              mw_electrolyte(jna2so4)
2427
2428       eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) +  &
2429                             xeq_a(ja_hso4)*nc_mc(jc_na))/   &
2430                              mw_electrolyte(jnahso4)
2431
2432       eleliquid(jnamsa)  = (xeq_c(jc_na) *na_ma(ja_msa) + &
2433                             xeq_a(ja_msa)*nc_mc(jc_na))/  &
2434                              mw_electrolyte(jnamsa)
2435
2436       eleliquid(jnano3)  = (xeq_c(jc_na) *na_ma(ja_no3) +  &
2437                             xeq_a(ja_no3)*nc_mc(jc_na))/   &
2438                              mw_electrolyte(jnano3)
2439
2440       eleliquid(jnacl)   = (xeq_c(jc_na) *na_ma(ja_cl) +   &
2441                             xeq_a(ja_cl) *nc_mc(jc_na))/   &
2442                              mw_electrolyte(jnacl)
2443
2444       eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) +   &
2445                             xeq_a(ja_so4)*nc_mc(jc_nh4))/   &
2446                              mw_electrolyte(jnh4so4)
2447
2448       eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) +   &
2449                             xeq_a(ja_hso4)*nc_mc(jc_nh4))/   &
2450                              mw_electrolyte(jnh4hso4)
2451
2452       eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_ma(ja_msa) +  &
2453                             xeq_a(ja_msa)*nc_mc(jc_nh4))/   &
2454                              mw_electrolyte(jnh4msa)
2455
2456       eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) +   &
2457                             xeq_a(ja_no3)*nc_mc(jc_nh4))/   &
2458                              mw_electrolyte(jnh4no3)
2459
2460       eleliquid(jnh4cl)  = (xeq_c(jc_nh4)*na_ma(ja_cl) +   &
2461                             xeq_a(ja_cl) *nc_mc(jc_nh4))/  &
2462                              mw_electrolyte(jnh4cl)
2463
2464       eleliquid(jcano3)  = (xeq_c(jc_ca) *na_ma(ja_no3) +  &
2465                             xeq_a(ja_no3)*nc_mc(jc_ca))/   &
2466                              mw_electrolyte(jcano3)
2467
2468       eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_ma(ja_msa) +  &
2469                             xeq_a(ja_msa)*nc_mc(jc_ca))/   &
2470                              mw_electrolyte(jcamsa2)
2471
2472       eleliquid(jcacl2)  = (xeq_c(jc_ca) *na_ma(ja_cl) +   &
2473                             xeq_a(ja_cl) *nc_mc(jc_ca))/   &
2474                              mw_electrolyte(jcacl2)
2475
2476       eleliquid(jh2so4)  = (xeq_c(jc_h)  *na_ma(ja_hso4) + &
2477                             xeq_a(ja_hso4)*nc_mc(jc_h))/   &
2478                              mw_electrolyte(jh2so4)
2479
2480       eleliquid(jhno3)   = (xeq_c(jc_h)  *na_ma(ja_no3) +  &
2481                             xeq_a(ja_no3)*nc_mc(jc_h))/    &
2482                              mw_electrolyte(jhno3)
2483
2484       eleliquid(jhcl)    = (xeq_c(jc_h) *na_ma(ja_cl) +   &
2485                             xeq_a(ja_cl)*nc_mc(jc_h))/    &
2486                              mw_electrolyte(jhcl)
2487
2488       eleliquid(jmsa)    = (xeq_c(jc_h)  *na_ma(ja_msa) + &
2489                             xeq_a(ja_msa)*nc_mc(jc_h))/   &
2490                              mw_electrolyte(jmsa)
2491
2492 !--------------------------------------------------------------------
2493
2494       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
2495
2496         jp = jliquid
2497
2498         store(iso4_a) = aer(iso4_a,jp,ibin)
2499         store(imsa_a) = aer(imsa_a,jp,ibin)
2500         store(inh4_a) = aer(inh4_a,jp,ibin)
2501         store(ina_a)  = aer(ina_a, jp,ibin)
2502         store(ica_a)  = aer(ica_a, jp,ibin)
2503
2504         call form_camsa2(store,jp,ibin)
2505
2506         sum_na_nh4 = store(ina_a) + store(inh4_a)
2507         if(sum_na_nh4 .gt. 0.0)then
2508           f_nh4 = store(inh4_a)/sum_na_nh4
2509           f_na  = store(ina_a)/sum_na_nh4
2510         else
2511           f_nh4 = 0.0
2512           f_na  = 0.0
2513         endif
2514
2515 ! first form msa electrolytes
2516         if(sum_na_nh4 .gt. store(imsa_a))then
2517           eleliquid(jnh4msa) = f_nh4*store(imsa_a)
2518           eleliquid(jnamsa)  = f_na *store(imsa_a)
2519           store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
2520           store(ina_a) = store(ina_a) -eleliquid(jnamsa)  ! remaining na
2521         else
2522           eleliquid(jnh4msa) = store(inh4_a)
2523           eleliquid(jnamsa)  = store(ina_a)
2524           eleliquid(jmsa)    = store(imsa_a) - sum_na_nh4
2525           store(inh4_a)= 0.0  ! remaining nh4
2526           store(ina_a) = 0.0  ! remaining na
2527         endif
2528
2529         if(store(iso4_a).eq.0.0)goto 10
2530
2531         xt_d  = xt
2532         xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
2533         xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
2534
2535         dum = 2.d0*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin)
2536         if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
2537           xnh4_d = 2.*aer(inh4_a,jp,ibin)/   &
2538                   (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
2539         else
2540           xnh4_d = 0.0
2541         endif
2542
2543
2544         if(aer(inh4_a,jp,ibin) .gt. 0.0)then
2545
2546
2547         if(xt_d .ge. xna_d)then
2548           eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
2549
2550           if(xnh4_d .ge. 5./3.)then
2551             eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin)   &
2552                                - 3.*xdum - aer(inh4_a,jp,ibin)
2553             eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin)   &
2554                                - aer(ina_a,jp,ibin)
2555           elseif(xnh4_d .ge. 1.5)then
2556             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
2557             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
2558           elseif(xnh4_d .ge. 1.0)then
2559             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
2560             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
2561             eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
2562           endif
2563
2564         elseif(xt_d .gt. 1.0)then
2565           eleliquid(jnh4so4)  = aer(inh4_a,jp,ibin)/6.
2566           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
2567           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
2568           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/3.
2569           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/3.
2570         elseif(xt_d .le. 1.0)then
2571           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/4.
2572           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/2.
2573           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
2574           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
2575         endif
2576
2577         else
2578
2579         if(xt_d .gt. 1.0)then
2580           eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
2581           eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) -   &
2582                                   aer(ina_a,jp,ibin)
2583         else
2584           eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
2585           eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
2586         endif
2587
2588
2589         endif
2590
2591
2592
2593       endif
2594 !---------------------------------------------------------
2595 !
2596 ! calculate % composition
2597 10    sum_dum = 0.0
2598       do je = 1, nelectrolyte
2599         sum_dum = sum_dum + eleliquid(je)
2600       enddo
2601
2602       electrolyte_sum(jp,ibin) = sum_dum
2603
2604       if(sum_dum .eq. 0.)sum_dum = 1.0
2605       do je = 1, nelectrolyte
2606         epercent(je,jp,ibin) = 100.*eleliquid(je)/sum_dum
2607       enddo
2608
2609
2610       return
2611       end subroutine mesa_estimate_eleliquid
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622 !***********************************************************************
2623 ! part of mesa: completely dissolves small amounts of soluble salts
2624 !
2625 ! author: rahul a. zaveri
2626 ! update: jan 2005
2627 !-----------------------------------------------------------------------
2628       subroutine mesa_dissolve_small_salt(ibin,js)
2629 !     implicit none
2630 !     include 'mosaic.h'
2631 ! subr arguments
2632       integer ibin, js, jp
2633
2634       jp = jsolid
2635
2636
2637       if(js .eq. jnh4so4)then
2638         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
2639                            2.*electrolyte(js,jsolid,ibin)
2640         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2641                               electrolyte(js,jsolid,ibin)
2642
2643         electrolyte(js,jsolid,ibin) = 0.0
2644
2645         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2646                             electrolyte(jnh4cl,jp,ibin)  +   &
2647                          2.*electrolyte(jnh4so4,jp,ibin) +   &
2648                          3.*electrolyte(jlvcite,jp,ibin) +   &
2649                             electrolyte(jnh4hso4,jp,ibin)+   &
2650                             electrolyte(jnh4msa,jp,ibin)
2651
2652         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2653                             electrolyte(jna2so4,jp,ibin) +   &
2654                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2655                             electrolyte(jnahso4,jp,ibin) +   &
2656                             electrolyte(jnh4so4,jp,ibin) +   &
2657                          2.*electrolyte(jlvcite,jp,ibin) +   &
2658                             electrolyte(jnh4hso4,jp,ibin)+   &
2659                             electrolyte(jh2so4,jp,ibin)
2660         return
2661       endif
2662
2663
2664       if(js .eq. jlvcite)then
2665         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
2666                            3.*electrolyte(js,jsolid,ibin)
2667         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2668                            2.*electrolyte(js,jsolid,ibin)
2669
2670         electrolyte(js,jsolid,ibin) = 0.0
2671
2672         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2673                             electrolyte(jnh4cl,jp,ibin)  +   &
2674                          2.*electrolyte(jnh4so4,jp,ibin) +   &
2675                          3.*electrolyte(jlvcite,jp,ibin) +   &
2676                             electrolyte(jnh4hso4,jp,ibin)+   &
2677                             electrolyte(jnh4msa,jp,ibin)
2678
2679         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2680                             electrolyte(jna2so4,jp,ibin) +   &
2681                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2682                             electrolyte(jnahso4,jp,ibin) +   &
2683                             electrolyte(jnh4so4,jp,ibin) +   &
2684                          2.*electrolyte(jlvcite,jp,ibin) +   &
2685                             electrolyte(jnh4hso4,jp,ibin)+   &
2686                             electrolyte(jh2so4,jp,ibin)
2687         return
2688       endif
2689
2690
2691       if(js .eq. jnh4hso4)then
2692         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
2693                               electrolyte(js,jsolid,ibin)
2694         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2695                              electrolyte(js,jsolid,ibin)
2696
2697         electrolyte(js,jsolid,ibin) = 0.0
2698
2699         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2700                             electrolyte(jnh4cl,jp,ibin)  +   &
2701                          2.*electrolyte(jnh4so4,jp,ibin) +   &
2702                          3.*electrolyte(jlvcite,jp,ibin) +   &
2703                             electrolyte(jnh4hso4,jp,ibin)+   &
2704                             electrolyte(jnh4msa,jp,ibin)
2705
2706         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2707                             electrolyte(jna2so4,jp,ibin) +   &
2708                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2709                             electrolyte(jnahso4,jp,ibin) +   &
2710                             electrolyte(jnh4so4,jp,ibin) +   &
2711                          2.*electrolyte(jlvcite,jp,ibin) +   &
2712                             electrolyte(jnh4hso4,jp,ibin)+   &
2713                             electrolyte(jh2so4,jp,ibin)
2714         return
2715       endif
2716
2717
2718       if(js .eq. jna2so4)then
2719         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
2720                            2.*electrolyte(js,jsolid,ibin)
2721         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2722                               electrolyte(js,jsolid,ibin)
2723
2724         electrolyte(js,jsolid,ibin) = 0.0
2725
2726         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2727                             electrolyte(jnacl,jp,ibin)   +   &
2728                          2.*electrolyte(jna2so4,jp,ibin) +   &
2729                          3.*electrolyte(jna3hso4,jp,ibin)+   &
2730                             electrolyte(jnahso4,jp,ibin) +   &
2731                             electrolyte(jnamsa,jp,ibin)
2732
2733         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2734                             electrolyte(jna2so4,jp,ibin) +   &
2735                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2736                             electrolyte(jnahso4,jp,ibin) +   &
2737                             electrolyte(jnh4so4,jp,ibin) +   &
2738                          2.*electrolyte(jlvcite,jp,ibin) +   &
2739                             electrolyte(jnh4hso4,jp,ibin)+   &
2740                             electrolyte(jh2so4,jp,ibin)
2741         return
2742       endif
2743
2744
2745       if(js .eq. jna3hso4)then
2746         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
2747                            3.*electrolyte(js,jsolid,ibin)
2748         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2749                            2.*electrolyte(js,jsolid,ibin)
2750
2751         electrolyte(js,jsolid,ibin) = 0.0
2752
2753         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2754                             electrolyte(jnacl,jp,ibin)   +   &
2755                          2.*electrolyte(jna2so4,jp,ibin) +   &
2756                          3.*electrolyte(jna3hso4,jp,ibin)+   &
2757                             electrolyte(jnahso4,jp,ibin) +   &
2758                             electrolyte(jnamsa,jp,ibin)
2759
2760         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2761                             electrolyte(jna2so4,jp,ibin) +   &
2762                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2763                             electrolyte(jnahso4,jp,ibin) +   &
2764                             electrolyte(jnh4so4,jp,ibin) +   &
2765                          2.*electrolyte(jlvcite,jp,ibin) +   &
2766                             electrolyte(jnh4hso4,jp,ibin)+   &
2767                             electrolyte(jh2so4,jp,ibin)
2768         return
2769       endif
2770
2771
2772       if(js .eq. jnahso4)then
2773         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
2774                               electrolyte(js,jsolid,ibin)
2775         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
2776                               electrolyte(js,jsolid,ibin)
2777
2778         electrolyte(js,jsolid,ibin) = 0.0
2779
2780         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2781                             electrolyte(jnacl,jp,ibin)   +   &
2782                          2.*electrolyte(jna2so4,jp,ibin) +   &
2783                          3.*electrolyte(jna3hso4,jp,ibin)+   &
2784                             electrolyte(jnahso4,jp,ibin) +   &
2785                             electrolyte(jnamsa,jp,ibin)
2786
2787         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2788                             electrolyte(jna2so4,jp,ibin) +   &
2789                          2.*electrolyte(jna3hso4,jp,ibin)+   &
2790                             electrolyte(jnahso4,jp,ibin) +   &
2791                             electrolyte(jnh4so4,jp,ibin) +   &
2792                          2.*electrolyte(jlvcite,jp,ibin) +   &
2793                             electrolyte(jnh4hso4,jp,ibin)+   &
2794                             electrolyte(jh2so4,jp,ibin)
2795         return
2796       endif
2797
2798
2799       if(js .eq. jnh4no3)then
2800         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
2801                               electrolyte(js,jsolid,ibin)
2802         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
2803                               electrolyte(js,jsolid,ibin)
2804
2805         electrolyte(js,jsolid,ibin) = 0.0
2806
2807         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2808                             electrolyte(jnh4cl,jp,ibin)  +   &
2809                          2.*electrolyte(jnh4so4,jp,ibin) +   &
2810                          3.*electrolyte(jlvcite,jp,ibin) +   &
2811                             electrolyte(jnh4hso4,jp,ibin)+   &
2812                             electrolyte(jnh4msa,jp,ibin)
2813
2814         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
2815                          2.*electrolyte(jcano3,jp,ibin)  +   &
2816                             electrolyte(jnh4no3,jp,ibin) +   &
2817                             electrolyte(jhno3,jp,ibin)
2818         return
2819       endif
2820
2821
2822       if(js .eq. jnh4cl)then
2823         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
2824                               electrolyte(js,jsolid,ibin)
2825         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
2826                               electrolyte(js,jsolid,ibin)
2827
2828         electrolyte(js,jsolid,ibin) = 0.0
2829
2830         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2831                             electrolyte(jnh4cl,jp,ibin)  +   &
2832                          2.*electrolyte(jnh4so4,jp,ibin) +   &
2833                          3.*electrolyte(jlvcite,jp,ibin) +   &
2834                             electrolyte(jnh4hso4,jp,ibin)+   &
2835                             electrolyte(jnh4msa,jp,ibin)
2836
2837         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
2838                          2.*electrolyte(jcacl2,jp,ibin)  +   &
2839                             electrolyte(jnh4cl,jp,ibin)  +   &
2840                             electrolyte(jhcl,jp,ibin)
2841         return
2842       endif
2843
2844
2845       if(js .eq. jnano3)then
2846         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
2847                               electrolyte(js,jsolid,ibin)
2848         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
2849                               electrolyte(js,jsolid,ibin)
2850
2851         electrolyte(js,jsolid,ibin) = 0.0
2852
2853         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2854                             electrolyte(jnacl,jp,ibin)   +   &
2855                          2.*electrolyte(jna2so4,jp,ibin) +   &
2856                          3.*electrolyte(jna3hso4,jp,ibin)+   &
2857                             electrolyte(jnahso4,jp,ibin) +   &
2858                             electrolyte(jnamsa,jp,ibin)
2859
2860         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
2861                          2.*electrolyte(jcano3,jp,ibin)  +   &
2862                             electrolyte(jnh4no3,jp,ibin) +   &
2863                             electrolyte(jhno3,jp,ibin)
2864         return
2865       endif
2866
2867
2868       if(js .eq. jnacl)then
2869         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
2870                               electrolyte(js,jsolid,ibin)
2871         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
2872                               electrolyte(js,jsolid,ibin)
2873
2874         electrolyte(js,jsolid,ibin) = 0.0
2875
2876         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2877                             electrolyte(jnacl,jp,ibin)   +   &
2878                          2.*electrolyte(jna2so4,jp,ibin) +   &
2879                          3.*electrolyte(jna3hso4,jp,ibin)+   &
2880                             electrolyte(jnahso4,jp,ibin) +   &
2881                             electrolyte(jnamsa,jp,ibin)
2882
2883         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
2884                          2.*electrolyte(jcacl2,jp,ibin)  +   &
2885                             electrolyte(jnh4cl,jp,ibin)  +   &
2886                             electrolyte(jhcl,jp,ibin)
2887         return
2888       endif
2889
2890
2891       if(js .eq. jcano3)then
2892         aer(ica_a,jliquid,ibin)  = aer(ica_a,jliquid,ibin) +   &
2893                               electrolyte(js,jsolid,ibin)
2894         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
2895                             2.*electrolyte(js,jsolid,ibin)
2896
2897         electrolyte(js,jsolid,ibin) = 0.0
2898
2899         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
2900                             electrolyte(jcano3,jp,ibin)  +   &
2901                             electrolyte(jcacl2,jp,ibin)  +   &
2902                             electrolyte(jcaco3,jp,ibin)  +   &
2903                             electrolyte(jcamsa2,jp,ibin)
2904
2905         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
2906                          2.*electrolyte(jcano3,jp,ibin)  +   &
2907                             electrolyte(jnh4no3,jp,ibin) +   &
2908                             electrolyte(jhno3,jp,ibin)
2909         return
2910       endif
2911
2912
2913       if(js .eq. jcacl2)then
2914         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) +   &
2915                               electrolyte(js,jsolid,ibin)
2916         aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) +   &
2917                             2.*electrolyte(js,jsolid,ibin)
2918
2919         electrolyte(js,jsolid,ibin) = 0.0
2920
2921         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
2922                             electrolyte(jcano3,jp,ibin)  +   &
2923                             electrolyte(jcacl2,jp,ibin)  +   &
2924                             electrolyte(jcaco3,jp,ibin)  +   &
2925                             electrolyte(jcamsa2,jp,ibin)
2926
2927         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
2928                          2.*electrolyte(jcacl2,jp,ibin)  +   &
2929                             electrolyte(jnh4cl,jp,ibin)  +   &
2930                             electrolyte(jhcl,jp,ibin)
2931         return
2932       endif
2933
2934
2935
2936       return
2937       end subroutine mesa_dissolve_small_salt
2938
2939
2940
2941
2942
2943
2944 !***********************************************************************
2945 ! part of mesa: checks mesa convergence
2946 !
2947 ! author: rahul a. zaveri
2948 ! update: jan 2005
2949 !-----------------------------------------------------------------------
2950       subroutine mesa_convergence_criterion(ibin,  &  ! touch
2951                                        iconverge_mass,    &
2952                                        iconverge_flux,    &
2953                                        idissolved)
2954 !     implicit none
2955 !     include 'mosaic.h'
2956 ! subr arguments
2957       integer ibin, iconverge_mass, iconverge_flux, idissolved
2958 ! local variables
2959       integer je, js, iaer
2960       real(kind=8) mass_solid, mass_solid_salt, frac_solid, xt, h_ion, &
2961            crustal_solids, sumflux
2962
2963
2964       idissolved = mno          ! default = not completely dissolved
2965
2966 ! check mass convergence
2967       iconverge_mass = mno      ! default value = no convergence
2968
2969 !      call electrolytes_to_ions(jsolid,ibin)
2970 !      mass_solid = 0.0
2971 !      do iaer = 1, naer
2972 !        mass_solid = mass_solid +   &
2973 !                     aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15     ! g/cc(air)
2974 !      enddo
2975
2976       mass_solid_salt = 0.0
2977       do je = 1, nsalt
2978         mass_solid_salt = mass_solid_salt + &
2979              electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15      ! g/cc(air)
2980       enddo
2981
2982
2983
2984 !      frac_solid = mass_solid/mass_dry_a(ibin)
2985
2986       frac_solid = mass_solid_salt/mass_dry_salt(ibin)
2987
2988       if(frac_solid .ge. 0.98)then
2989         iconverge_mass = myes
2990         return
2991       endif
2992
2993
2994
2995 ! check relative driving force convergence
2996       iconverge_flux = myes
2997       do js = 1, nsalt
2998         if(abs(phi_salt(js)).gt. rtol_mesa)then
2999           iconverge_flux = mno
3000           return
3001         endif
3002       enddo
3003
3004
3005
3006 ! check if all the fluxes are zero
3007
3008       sumflux = 0.0
3009       do js = 1, nsalt
3010         sumflux = sumflux + abs(flux_sl(js))
3011       enddo
3012
3013       crustal_solids = electrolyte(jcaco3,jsolid,ibin) +  &
3014                        electrolyte(jcaso4,jsolid,ibin) +  &
3015                        aer(ioin_a,jsolid,ibin)
3016
3017       if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
3018         idissolved = myes
3019       endif
3020
3021
3022
3023       return
3024       end subroutine mesa_convergence_criterion
3025
3026
3027
3028
3029
3030
3031
3032
3033 !***********************************************************************
3034 ! called when aerosol bin is completely solid.
3035 !
3036 ! author: rahul a. zaveri
3037 ! update: jan 2005
3038 !-----------------------------------------------------------------------
3039       subroutine adjust_solid_aerosol(ibin)
3040 !     implicit none
3041 !     include 'mosaic.h'
3042 ! subr arguments
3043       integer ibin
3044 ! local variables
3045       integer iaer, je
3046
3047
3048       jphase(ibin)    = jsolid
3049       jhyst_leg(ibin) = jhyst_lo        ! lower curve
3050       water_a(ibin)   = 0.0
3051
3052 ! transfer aer(jtotal) to aer(jsolid)
3053       do iaer = 1, naer
3054         aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
3055         aer(iaer, jliquid,ibin) = 0.0
3056       enddo
3057
3058 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
3059       do je = 1, nelectrolyte
3060         electrolyte(je,jliquid,ibin) = 0.0
3061         epercent(je,jliquid,ibin)    = 0.0
3062         electrolyte(je,jsolid,ibin)  = electrolyte(je,jtotal,ibin)
3063         epercent(je,jsolid,ibin)     = epercent(je,jtotal,ibin)
3064       enddo
3065
3066 ! update aer(jtotal) that may have been affected above
3067       aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
3068       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
3069       aer(icl_a,jtotal,ibin)  = aer(icl_a,jsolid,ibin)
3070
3071 ! update electrolyte(jtotal)
3072       do je = 1, nelectrolyte
3073         electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
3074         epercent(je,jtotal,ibin)    = epercent(je,jsolid,ibin)
3075       enddo
3076
3077       return
3078       end subroutine adjust_solid_aerosol
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088 !***********************************************************************
3089 ! called when aerosol bin is completely liquid.
3090 !
3091 ! author: rahul a. zaveri
3092 ! update: jan 2005
3093 !-----------------------------------------------------------------------
3094       subroutine adjust_liquid_aerosol(ibin)
3095 !     implicit none
3096 !     include 'mosaic.h'
3097 ! subr arguments
3098       integer ibin
3099 ! local variables
3100       integer je
3101
3102
3103
3104
3105       jphase(ibin)    = jliquid
3106       jhyst_leg(ibin) = jhyst_up        ! upper curve
3107
3108 ! partition all electrolytes into liquid phase
3109       do je = 1, nelectrolyte
3110         electrolyte(je,jsolid,ibin)  = 0.0
3111         epercent(je,jsolid,ibin)     = 0.0
3112         electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
3113         epercent(je,jliquid,ibin)    = epercent(je,jtotal,ibin)
3114       enddo
3115 ! except these electrolytes, which always remain in the solid phase
3116       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
3117       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
3118       epercent(jcaco3,jsolid,ibin)    = epercent(jcaco3,jtotal,ibin)
3119       epercent(jcaso4,jsolid,ibin)    = epercent(jcaso4,jtotal,ibin)
3120       electrolyte(jcaco3,jliquid,ibin)= 0.0
3121       electrolyte(jcaso4,jliquid,ibin)= 0.0
3122       epercent(jcaco3,jliquid,ibin)   = 0.0
3123       epercent(jcaso4,jliquid,ibin)   = 0.0
3124
3125
3126 ! partition all the aer species into
3127 ! solid phase
3128       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
3129       aer(ino3_a,jsolid,ibin) = 0.0
3130       aer(icl_a,jsolid,ibin)  = 0.0
3131       aer(inh4_a,jsolid,ibin) = 0.0
3132       aer(ioc_a,jsolid,ibin)  = aer(ioc_a,jtotal,ibin)
3133       aer(imsa_a,jsolid,ibin) = 0.0
3134       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
3135       aer(ina_a,jsolid,ibin)  = 0.0
3136       aer(ica_a,jsolid,ibin)  = electrolyte(jcaco3,jsolid,ibin) + &
3137                                 electrolyte(jcaso4,jsolid,ibin)
3138       aer(ibc_a,jsolid,ibin)  = aer(ibc_a,jtotal,ibin)
3139       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
3140       aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
3141       aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
3142       aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
3143       aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
3144       aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
3145       aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
3146       aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
3147       aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
3148
3149 ! liquid-phase
3150       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
3151                                  aer(iso4_a,jsolid,ibin)
3152       aer(iso4_a,jliquid,ibin) = max(0.D0, aer(iso4_a,jliquid,ibin))
3153       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
3154       aer(icl_a,jliquid,ibin)  = aer(icl_a,jtotal,ibin)
3155       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
3156       aer(ioc_a,jliquid,ibin)  = 0.0
3157       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
3158       aer(ico3_a,jliquid,ibin) = 0.0
3159       aer(ina_a,jliquid,ibin)  = aer(ina_a,jtotal,ibin)
3160       aer(ica_a,jliquid,ibin)  = aer(ica_a,jtotal,ibin) - &
3161                                  aer(ica_a,jsolid,ibin)
3162       aer(ica_a,jliquid,ibin)  = max(0.D0, aer(ica_a,jliquid,ibin))
3163       aer(ibc_a,jliquid,ibin)  = 0.0
3164       aer(ioin_a,jliquid,ibin) = 0.0
3165       aer(iaro1_a,jliquid,ibin)= 0.0
3166       aer(iaro2_a,jliquid,ibin)= 0.0
3167       aer(ialk1_a,jliquid,ibin)= 0.0
3168       aer(iole1_a,jliquid,ibin)= 0.0
3169       aer(iapi1_a,jliquid,ibin)= 0.0
3170       aer(iapi2_a,jliquid,ibin)= 0.0
3171       aer(ilim1_a,jliquid,ibin)= 0.0
3172       aer(ilim2_a,jliquid,ibin)= 0.0
3173
3174       return
3175       end subroutine adjust_liquid_aerosol
3176
3177
3178
3179
3180
3181
3182
3183 ! end of mesa package
3184 !=======================================================================
3185
3186
3187
3188
3189
3190
3191
3192
3193 !***********************************************************************
3194 ! ASTEM: Adaptive Step Time-Split Euler Method
3195 !
3196 ! author: Rahul A. Zaveri
3197 ! update: jan 2007
3198 !-----------------------------------------------------------------------
3199       subroutine ASTEM(dtchem)
3200 !      implicit none
3201 !      include 'chemistry.com'
3202 !      include 'mosaic.h'
3203 ! subr arguments
3204       real(kind=8) dtchem
3205 ! local variables
3206       integer ibin
3207       real(kind=8) dumdum
3208
3209 !      logical first
3210 !      save first
3211 !      data first/.true./
3212
3213       integer, save :: iclm_debug, jclm_debug, kclm_debug, ncnt_debug
3214       data iclm_debug /25/
3215       data jclm_debug /1/
3216       data kclm_debug /9/
3217       data ncnt_debug /2/
3218
3219
3220
3221       if(iclm_aer .eq. iclm_debug .and.   &
3222          jclm_aer .eq. jclm_debug .and.   &
3223          kclm_aer .eq. kclm_debug  .and.   &
3224          ncorecnt_aer .eq. ncnt_debug)then
3225         dumdum = 0.0
3226       endif
3227
3228
3229
3230 ! update ASTEM call counter
3231       nASTEM_call  = nASTEM_call + 1
3232
3233 ! reset input print flag
3234       iprint_input = mYES
3235
3236
3237
3238
3239 ! compute aerosol phase state before starting integration
3240       do ibin = 1, nbin_a
3241         if(jaerosolstate(ibin) .ne. no_aerosol)then
3242           call aerosol_phase_state(ibin)
3243           if (istat_mosaic_fe1 .lt. 0) return
3244           call calc_dry_n_wet_aerosol_props(ibin)
3245         endif
3246       enddo
3247
3248
3249 !      if(first)then
3250 !        first=.false.
3251 !        call print_aer(0)              ! BOX
3252 !      endif
3253
3254
3255 ! compute new gas-aerosol mass transfer coefficients
3256       call aerosolmtc
3257       if (istat_mosaic_fe1 .lt. 0) return
3258
3259 ! condense h2so4, msa, and nh3 only
3260       call ASTEM_non_volatiles(dtchem)  ! analytical solution
3261       if (istat_mosaic_fe1 .lt. 0) return
3262
3263 ! condense inorganic semi-volatile gases hno3, hcl, nh3, and co2
3264       call ASTEM_semi_volatiles(dtchem) ! semi-implicit + explicit euler
3265       if (istat_mosaic_fe1 .lt. 0) return
3266
3267 ! condense secondary organic gases (8 sorgam species)
3268 !      call ASTEM_secondary_organics(dtchem) ! semi-implicit euler
3269 !      if (istat_mosaic_fe1 .lt. 0) return
3270
3271
3272 ! template for error status checking
3273 !        if (iprint_mosaic_fe1 .gt. 0) then
3274 !          write(6,*)'error in computing dtmax for soa'
3275 !          write(6,*)'mosaic fatal error in astem_soa_dtmax'
3276 !        endif
3277 !       stop
3278 !        istat_mosaic_fe1 = -1800
3279 !        return
3280 !      endif
3281
3282
3283
3284       return
3285       end subroutine astem
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295       subroutine print_mosaic_stats( iflag1 )
3296 !     implicit none
3297 !     include 'mosaic.h'
3298 ! subr arguments
3299       integer iflag1
3300 ! local variables
3301       integer ibin
3302       real(kind=8) p_mesa_fails, p_astem_fails, dumcnt
3303
3304
3305       if (iflag1 .le. 0) goto 2000
3306
3307 ! print mesa and astem statistics
3308
3309       dumcnt = float(max(nmesa_call,1))
3310       p_mesa_fails  = 100.*float(nmesa_fail)/dumcnt
3311       niter_mesa_avg = float(niter_mesa)/dumcnt
3312
3313       dumcnt = float(max(nastem_call,1))
3314       p_astem_fails = 100.*float(nastem_fail)/dumcnt
3315       nsteps_astem_avg = float(nsteps_astem)/dumcnt
3316
3317
3318       if (iprint_mosaic_perform_stats .gt. 0) then
3319         write(6,*)'------------------------------------------------'
3320         write(6,*)'     astem performance statistics'
3321         write(6,*)'number of astem calls=', nastem_call
3322         write(6,*)'percent astem fails  =', nastem_fail
3323         write(6,*)'avg steps per dtchem =', nsteps_astem_avg
3324         write(6,*)'max steps per dtchem =', nsteps_astem_max
3325         write(6,*)'  '
3326         write(6,*)'     mesa performance statistics'
3327         write(6,*)'number of mesa calls =', nmesa_call
3328         write(6,*)'total mesa fails     =', nmesa_fail
3329         write(6,*)'percent mesa fails   =', p_mesa_fails
3330         write(6,*)'avg iterations/call  =', niter_mesa_avg
3331         write(6,*)'max iterations/call  =', niter_mesa_max
3332         write(6,*)'  '
3333       endif
3334
3335       if (iprint_mosaic_fe1 .gt. 0) then
3336          if ((nfe1_mosaic_cur .gt. 0) .or.   &
3337              (iprint_mosaic_fe1 .ge. 100)) then
3338             write(6,*)'-----------------------------------------'
3339             write(6,*)'mosaic failure count (current step) =',   &
3340                nfe1_mosaic_cur
3341             write(6,*)'mosaic failure count (all step tot) =',   &
3342                nfe1_mosaic_tot
3343             write(6,*)'  '
3344          endif
3345       endif
3346
3347       if (nfe1_mosaic_tot .gt. 9999) then
3348          write(6,'(a)') "MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!"
3349          call peg_error_fatal( lunerr_aer, &
3350               "---> MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!" )
3351       endif
3352
3353 2000  continue
3354
3355 ! reset counters
3356       nfe1_mosaic_cur = 0
3357
3358       nmesa_call   = 0
3359       nmesa_fail   = 0
3360       niter_mesa   = 0.0
3361       niter_mesa_max = 0
3362
3363       nastem_call = 0
3364       nastem_fail = 0
3365
3366       nsteps_astem = 0.0
3367       nsteps_astem_max = 0.0
3368
3369
3370       return
3371       end subroutine print_mosaic_stats
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388 !***********************************************************************
3389 ! part of ASTEM: integrates semi-volatile inorganic gases
3390 !
3391 ! author: Rahul A. Zaveri
3392 ! update: jan 2007
3393 !-----------------------------------------------------------------------
3394       subroutine ASTEM_semi_volatiles(dtchem)
3395 !      implicit none
3396 !      include 'chemistry.com'
3397 !      include 'mosaic.h'
3398 ! subr arguments
3399       real(kind=8) dtchem
3400 ! local variables
3401       integer ibin, iv, jp
3402       real(kind=8) dtmax, t_new, t_old, t_out, xt
3403       real(kind=8) sum1, sum2, sum3, sum4, sum4a, sum4b, h_flux_s
3404
3405
3406 ! initialize time
3407       t_old = 0.0
3408       t_out = dtchem
3409
3410 ! reset ASTEM time steps and MESA iterations counters to zero
3411       isteps_ASTEM = 0
3412       do ibin = 1, nbin_a
3413         iter_MESA(ibin) = 0
3414       enddo
3415
3416 !--------------------------------
3417 ! overall integration loop begins over dtchem seconds
3418
3419 10    isteps_ASTEM = isteps_ASTEM + 1
3420
3421 ! compute new fluxes
3422       phi_nh4no3_s = 0.0
3423       phi_nh4cl_s  = 0.0
3424       ieqblm_ASTEM = mYES                       ! reset to default
3425
3426       do 501 ibin = 1, nbin_a
3427
3428         idry_case3a(ibin) = mNO                 ! reset to default
3429 ! default fluxes and other stuff
3430         do iv = 1, ngas_ioa
3431           sfc_a(iv)                  = gas(iv)
3432           df_gas_s(iv,ibin)          = 0.0
3433           df_gas_l(iv,ibin)          = 0.0
3434           flux_s(iv,ibin)            = 0.0
3435           flux_l(iv,ibin)            = 0.0
3436           Heff(iv,ibin)              = 0.0
3437           volatile_s(iv,ibin)        = 0.0
3438           phi_volatile_s(iv,ibin)    = 0.0
3439           phi_volatile_l(iv,ibin)    = 0.0
3440           integrate(iv,jsolid,ibin)  = mNO      ! reset to default
3441           integrate(iv,jliquid,ibin) = mNO      ! reset to default
3442         enddo
3443
3444
3445         if(jaerosolstate(ibin) .eq. all_solid)then
3446           jphase(ibin) = jsolid
3447           call ASTEM_flux_dry(ibin)
3448         elseif(jaerosolstate(ibin) .eq. all_liquid)then
3449           jphase(ibin) = jliquid
3450           call ASTEM_flux_wet(ibin)
3451         elseif(jaerosolstate(ibin) .eq. mixed)then
3452
3453           if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3454               electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3455             call ASTEM_flux_mix(ibin)   ! jphase(ibin) will be determined in this subr.
3456           else
3457             jphase(ibin) = jliquid
3458             call ASTEM_flux_wet(ibin)
3459           endif
3460
3461         endif
3462
3463 501   continue
3464
3465       if(ieqblm_ASTEM .eq. mYES)goto 30 ! all bins have reached eqblm, so quit.
3466
3467 !-------------------------
3468
3469
3470 ! calculate maximum possible internal time-step
3471 11    call ASTEM_calculate_dtmax(dtchem, dtmax)
3472       t_new = t_old + dtmax     ! update time
3473       if(t_new .gt. t_out)then  ! check if the new time step is too large
3474         dtmax = t_out - t_old
3475         t_new = t_out*1.01
3476       endif
3477
3478
3479 !------------------------------------------
3480 ! do internal time-step (dtmax) integration
3481
3482       do 20 iv = 2, 4
3483
3484         sum1 = 0.0
3485         sum2 = 0.0
3486         sum3 = 0.0
3487         sum4 = 0.0
3488         sum4a= 0.0
3489         sum4b= 0.0
3490
3491         do 21 ibin = 1, nbin_a
3492           if(jaerosolstate(ibin) .eq. no_aerosol)goto 21
3493
3494           jp = jliquid
3495           sum1 = sum1 + aer(iv,jp,ibin)/ &
3496           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3497
3498           sum2 = sum2 + kg(iv,ibin)*integrate(iv,jp,ibin)/ &
3499           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
3500
3501           jp = jsolid
3502           sum3 = sum3 + aer(iv,jp,ibin)
3503
3504           if(flux_s(iv,ibin) .gt. 0.)then
3505             h_flux_s = dtmax*flux_s(iv,ibin)
3506             sum4a = sum4a + h_flux_s
3507             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3508           elseif(flux_s(iv,ibin) .lt. 0.)then
3509             h_flux_s = min(h_s_i_m(iv,ibin),dtmax)*flux_s(iv,ibin)
3510             sum4b = sum4b + h_flux_s
3511             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
3512             aer(iv,jp,ibin) = max(aer(iv,jp,ibin), 0.0D0)
3513           endif
3514
3515 21      continue
3516
3517         sum4 = sum4a + sum4b
3518
3519
3520 ! first update gas concentration
3521         gas(iv) = (total_species(iv) - (sum1 + sum3 + sum4) )/ &
3522                               (1. + dtmax*sum2)
3523         gas(iv) = max(gas(iv), 0.0D0)
3524
3525 !        if(gas(iv) .lt. 0.)write(6,*) gas(iv)
3526
3527 ! now update aer concentration in the liquid phase
3528         do 22 ibin = 1, nbin_a
3529
3530           if(integrate(iv,jliquid,ibin) .eq. mYES)then
3531             aer(iv,jliquid,ibin) =  &
3532              (aer(iv,jliquid,ibin) + dtmax*kg(iv,ibin)*gas(iv))/ &
3533                   (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin))
3534
3535           endif
3536
3537 22      continue
3538
3539
3540 20    continue
3541 !------------------------------------------
3542 ! sub-step integration done
3543
3544
3545 !------------------------------------------
3546 ! now update aer(jtotal) and update internal phase equilibrium
3547 ! also do integration of species by mass balance if necessary
3548
3549       do 40 ibin = 1, nbin_a
3550         if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
3551
3552         if(jphase(ibin) .eq. jsolid)then
3553           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
3554         elseif(jphase(ibin) .eq. jliquid)then
3555           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3556         elseif(jphase(ibin) .eq. jtotal)then
3557           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
3558           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
3559         endif
3560
3561 !========================
3562 ! now update jtotal
3563         do iv = 2, ngas_ioa
3564           aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
3565         enddo
3566 !========================
3567
3568
3569         call form_electrolytes(jtotal,ibin,XT)  ! for MDRH diagnosis
3570
3571
3572
3573 ! update internal phase equilibrium
3574         if(jhyst_leg(ibin) .eq. jhyst_lo)then
3575           call ASTEM_update_phase_eqblm(ibin)
3576         else
3577           call do_full_deliquescence(ibin)              ! simply do liquid <-- total
3578         endif
3579
3580
3581 40    continue
3582 !------------------------------------------
3583
3584 ! update time
3585       t_old = t_new
3586
3587
3588       if(isteps_astem .ge. nmax_astem)then
3589         nastem_fail = nastem_fail + 1
3590         write(6,*)'ASTEM internal steps exceeded', nmax_astem
3591         if(iprint_input .eq. mYES)then
3592           write(67,*)'ASTEM internal steps exceeded', nmax_astem
3593           call print_input
3594           iprint_input = mNO
3595         endif
3596         goto 30
3597       elseif(t_new .lt. t_out)then
3598         goto 10
3599       endif
3600
3601
3602 ! check if end of dtchem reached
3603       if(t_new .lt. 0.9999*t_out) goto 10
3604
3605 30    nsteps_astem = nsteps_astem + isteps_astem                ! cumulative steps
3606       nsteps_astem_max = max(nsteps_astem_max, isteps_astem)    ! max steps in a dtchem time-step
3607
3608 !================================================
3609 ! end of overall integration loop over dtchem seconds
3610
3611
3612
3613 ! call subs to calculate fluxes over mixed-phase particles to update H+ ions,
3614 ! which were wiped off during update_phase_eqblm
3615 !      do ibin = 1, nbin_a
3616 !
3617 !        if(jaerosolstate(ibin) .eq. mixed)then
3618 !          if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
3619 !              electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
3620 !            call ASTEM_flux_mix(ibin)          ! jphase(ibin) will be determined in this subr.
3621 !          else
3622 !            jphase(ibin) = jliquid
3623 !            call ASTEM_flux_wet(ibin)
3624 !          endif
3625 !        endif
3626 !
3627 !      enddo
3628
3629
3630
3631       return
3632       end subroutine ASTEM_semi_volatiles
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645 !***********************************************************************
3646 ! part of ASTEM: computes max time step for gas-aerosol integration
3647 !
3648 ! author: Rahul A. Zaveri
3649 ! update: jan 2005
3650 !-----------------------------------------------------------------------
3651       subroutine ASTEM_calculate_dtmax(dtchem, dtmax)
3652 !      implicit none
3653 !      include 'mosaic.h'
3654 ! subr arguments
3655       real(kind=8) dtchem, dtmax
3656 ! local variables
3657       integer ibin, iv
3658       real(kind=8) alpha, h_gas, h_sub_max,  &
3659            h_gas_i(ngas_ioa), h_gas_l, h_gas_s,  &
3660            sum_kg_phi, sumflux_s
3661
3662
3663       h_sub_max = 150.0 ! sec
3664
3665
3666 ! set alpha_gas
3667       do ibin = 1, nbin_a
3668         do iv = 2, ngas_ioa
3669
3670           if(flux_s(iv,ibin) .gt. 0.0)then
3671
3672             alpha_gas(iv) = max( abs(phi_volatile_s(iv,ibin)), &
3673                                      alpha_ASTEM )
3674             alpha_gas(iv) = min(alpha_gas(iv), 0.5D0)
3675
3676           endif
3677
3678         enddo
3679       enddo
3680
3681
3682
3683
3684
3685 ! gas-side
3686
3687 ! solid-phase
3688 ! calculate h_gas_i and h_gas_l
3689
3690       h_gas_s = 2.e16
3691
3692       do 5 iv = 2, ngas_ioa
3693         h_gas_i(iv) = 1.e16
3694         sumflux_s = 0.0
3695         do ibin = 1, nbin_a
3696           if(flux_s(iv,ibin) .gt. 0.0)then
3697             sumflux_s = sumflux_s + flux_s(iv,ibin)
3698           endif
3699         enddo
3700
3701         if(sumflux_s .gt. 0.0)then
3702           h_gas_i(iv) = alpha_gas(iv)*gas(iv)/sumflux_s
3703           h_gas_s     = min(h_gas_s, h_gas_i(iv))
3704         endif
3705
3706 5     continue
3707
3708
3709 ! liquid-phase
3710 ! calculate h_gas_s and h_gas_l
3711
3712       h_gas_l = 2.e16
3713
3714       do 6 iv = 2, ngas_ioa
3715         h_gas_i(iv) = 1.e16
3716         sum_kg_phi = 0.0
3717         do ibin = 1, nbin_a
3718           if(integrate(iv,jliquid,ibin) .eq. mYES)then
3719           sum_kg_phi = sum_kg_phi +  &
3720                        abs(phi_volatile_l(iv,ibin))*kg(iv,ibin)
3721           endif
3722         enddo
3723
3724         if(sum_kg_phi .gt. 0.0)then
3725           h_gas_i(iv) = alpha_astem/sum_kg_phi
3726           h_gas_l     = min(h_gas_l, h_gas_i(iv))
3727         endif
3728
3729 6     continue
3730
3731       h_gas = min(h_gas_s, h_gas_l)
3732       h_gas = min(h_gas, h_sub_max)
3733
3734
3735
3736
3737 ! aerosol-side: solid-phase
3738
3739 ! first load volatile_solid array
3740       do ibin = 1, nbin_a
3741
3742         volatile_s(ino3_a,ibin) = electrolyte(jnh4no3,jsolid,ibin)
3743         volatile_s(inh4_a,ibin) = electrolyte(jnh4cl,jsolid,ibin) +  &
3744                                   electrolyte(jnh4no3,jsolid,ibin)
3745
3746         if(idry_case3a(ibin) .eq. mYES)then
3747           volatile_s(icl_a,ibin)  = aer(icl_a,jsolid,ibin)
3748         else
3749           volatile_s(icl_a,ibin)  = electrolyte(jnh4cl,jsolid,ibin)
3750         endif
3751
3752       enddo
3753
3754
3755 ! next calculate weighted avg_df_gas_s
3756       do iv = 2, ngas_ioa
3757
3758         sum_bin_s(iv) = 0.0
3759         sum_vdf_s(iv) = 0.0
3760         sum_vol_s(iv) = 0.0
3761
3762         do ibin = 1, nbin_a
3763           if(flux_s(iv,ibin) .lt. 0.)then       ! aer -> gas
3764             sum_bin_s(iv) = sum_bin_s(iv) + 1.0
3765             sum_vdf_s(iv) = sum_vdf_s(iv) +  &
3766                             volatile_s(iv,ibin)*df_gas_s(iv,ibin)
3767             sum_vol_s(iv) = sum_vol_s(iv) + volatile_s(iv,ibin)
3768           endif
3769         enddo
3770
3771         if(sum_vol_s(iv) .gt. 0.0)then
3772           avg_df_gas_s(iv) = sum_vdf_s(iv)/sum_vol_s(iv)
3773         else
3774           avg_df_gas_s(iv) = 1.0 ! never used, but set to 1.0 just to be safe
3775         endif
3776
3777       enddo
3778
3779
3780 ! calculate h_s_i_m
3781
3782
3783       do 20 ibin = 1, nbin_a
3784
3785         if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
3786
3787         do 10 iv = 2, ngas_ioa
3788
3789           if(flux_s(iv,ibin) .lt. 0.)then                               ! aer -> gas
3790
3791             alpha = abs(avg_df_gas_s(iv))/  &
3792                    (volatile_s(iv,ibin)*sum_bin_s(iv))
3793             alpha = min(alpha, 1.0D0)
3794
3795             if(idry_case3a(ibin) .eq. mYES)alpha = 1.0D0
3796
3797             h_s_i_m(iv,ibin) =  &
3798                  -alpha*volatile_s(iv,ibin)/flux_s(iv,ibin)
3799
3800           endif
3801
3802 10      continue
3803
3804
3805 20    continue
3806
3807
3808       dtmax = min(dtchem, h_gas)
3809
3810
3811       if(dtmax .eq. 0.0)then
3812         write(6,*)' dtmax = ', dtmax
3813         write(67,*)' dtmax = ', dtmax
3814         call print_input
3815         iprint_input = mNO
3816          stop
3817       endif
3818
3819       return
3820       end subroutine astem_calculate_dtmax
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836 !***********************************************************************
3837 ! part of ASTEM: updates solid-liquid partitioning after each gas-aerosol
3838 ! mass transfer step
3839 !
3840 ! author: Rahul A. Zaveri
3841 ! update: jan 2005
3842 !-----------------------------------------------------------------------
3843       subroutine ASTEM_update_phase_eqblm(ibin) ! TOUCH
3844 !      implicit none
3845 !      include 'mosaic.h'
3846 ! subr arguments
3847       integer ibin
3848 ! local variables
3849       integer jdum, js, j_index
3850       real(kind=8) XT
3851
3852
3853
3854 ! calculate overall sulfate ratio
3855       call calculate_XT(ibin,jtotal,XT)         ! calc updated XT
3856
3857 ! now diagnose MDRH
3858       if(XT .lt. 1. .and. XT .gt. 0. )goto 10   ! excess sulfate domain - no MDRH exists
3859
3860       jdum = 0
3861       do js = 1, nsalt
3862         jsalt_present(js) = 0                   ! default value - salt absent
3863
3864         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
3865           jsalt_present(js) = 1                 ! salt present
3866           jdum = jdum + jsalt_index(js)
3867         endif
3868       enddo
3869
3870       if(jdum .eq. 0)then
3871         jaerosolstate(ibin) = all_solid ! no significant soluble material present
3872         jphase(ibin) = jsolid
3873         call adjust_solid_aerosol(ibin)
3874         return
3875       endif
3876
3877       if(XT .ge. 2.0 .or. XT .lt. 0.0)then
3878         j_index = jsulf_poor(jdum)
3879       else
3880         j_index = jsulf_rich(jdum)
3881       endif
3882
3883       MDRH(ibin) = MDRH_T(j_index)
3884
3885       if(aH2O*100. .lt. MDRH(ibin)) then
3886         jaerosolstate(ibin) = all_solid
3887         jphase(ibin) = jsolid
3888         call adjust_solid_aerosol(ibin)
3889         return
3890       endif
3891
3892
3893 ! none of the above means it must be sub-saturated or mixed-phase
3894 10    if(jphase(ibin) .eq. jsolid)then
3895         call do_full_deliquescence(ibin)
3896         call MESA_PTC(ibin)
3897       else
3898         call MESA_PTC(ibin)
3899       endif
3900
3901
3902
3903       return
3904       end subroutine ASTEM_update_phase_eqblm
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917 !==================================================================
3918 !
3919 ! LIQUID PARTICLES
3920 !
3921 !***********************************************************************
3922 ! part of ASTEM: computes fluxes over wet aerosols
3923 !
3924 ! author: Rahul A. Zaveri
3925 ! update: Jan 2007
3926 !-----------------------------------------------------------------------
3927       subroutine ASTEM_flux_wet(ibin)
3928 !      implicit none
3929 !      include 'mosaic.h'
3930 ! subr arguments
3931       integer ibin
3932 ! local variables
3933       integer iv, iadjust, iadjust_intermed
3934       real(kind=8) xt, g_nh3_hno3, g_nh3_hcl, a_nh4_no3, a_nh4_cl
3935
3936
3937
3938       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
3939       call compute_activities(ibin)
3940
3941       if(water_a(ibin) .eq. 0.0)then
3942         write(6,*)'Water is zero in liquid phase'
3943         write(6,*)'Stopping in ASTEM_flux_wet'
3944         stop
3945       endif
3946
3947 !-------------------------------------------------------------------
3948 ! CASE 1: caco3 > 0 absorb acids (and indirectly degas co2)
3949
3950       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
3951         call ASTEM_flux_wet_case1(ibin)
3952         return
3953       endif
3954
3955 !-------------------------------------------------------------------
3956 ! CASE 2: Sulfate-Rich Domain
3957
3958       if(XT.lt.1.9999 .and. XT.ge.0.)then
3959         call ASTEM_flux_wet_case2(ibin)
3960         return
3961       endif
3962
3963 !-------------------------------------------------------------------
3964
3965       if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10  ! no ammonia in the system
3966
3967 !-------------------------------------------------------------------
3968 ! CASE 3: nh4no3 and/or nh4cl maybe active
3969 ! do some small adjustments (if needed) before deciding case 3
3970
3971       iadjust = mNO             ! default
3972       iadjust_intermed = mNO    ! default
3973
3974 ! nh4no3
3975       g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
3976       a_nh4_no3  = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
3977
3978       if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
3979         call absorb_tiny_nh4no3(ibin)
3980         iadjust = mYES
3981         iadjust_intermed = mYES
3982       endif
3983
3984       if(iadjust_intermed .eq. mYES)then
3985         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
3986         iadjust_intermed = mNO  ! reset
3987       endif
3988
3989 ! nh4cl
3990       g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
3991       a_nh4_cl  = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
3992
3993       if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
3994         call absorb_tiny_nh4cl(ibin)
3995         iadjust = mYES
3996         iadjust_intermed = mYES
3997       endif
3998
3999       if(iadjust_intermed .eq. mYES)then
4000         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
4001       endif
4002
4003       if(iadjust .eq. mYES)then
4004         call compute_activities(ibin)                   ! update after adjustments
4005       endif
4006
4007
4008 ! all adjustments done...
4009
4010 !--------
4011       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
4012       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
4013
4014       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
4015       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
4016
4017       call ASTEM_flux_wet_case3(ibin)
4018
4019       return
4020
4021
4022 !-------------------------------------------------------------------
4023 ! CASE 4: ammonia = 0. hno3 and hcl exchange may happen here
4024 ! do small adjustments (if needed) before deciding case 4
4025
4026 10    iadjust = mNO             ! default
4027       iadjust_intermed = mNO    ! default
4028
4029 ! hno3
4030       if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and. &
4031          aer(icl_a,jliquid,ibin) .gt. 0.0)then
4032         call absorb_tiny_hno3(ibin)     ! and degas tiny hcl
4033         iadjust = mYES
4034         iadjust_intermed = mYES
4035       endif
4036
4037       if(iadjust_intermed .eq. mYES)then
4038         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
4039         iadjust_intermed = mNO  ! reset
4040       endif
4041
4042 ! hcl
4043       if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin).eq.0. .and. &
4044          aer(ino3_a,jliquid,ibin) .gt. 0.0)then
4045         call absorb_tiny_hcl(ibin)      ! and degas tiny hno3
4046         iadjust = mYES
4047         iadjust_intermed = mYES
4048       endif
4049
4050       if(iadjust_intermed .eq. mYES)then
4051         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
4052       endif
4053
4054       if(iadjust .eq. mYES)then
4055         call compute_activities(ibin)                   ! update after adjustments
4056       endif
4057
4058 ! all adjustments done...
4059
4060       call ASTEM_flux_wet_case4(ibin)
4061
4062
4063       return
4064       end subroutine ASTEM_flux_wet
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077 !***********************************************************************
4078 ! part of ASTEM: subroutines for flux_wet cases
4079 !
4080 ! author: Rahul A. Zaveri
4081 ! update: Jan 2007
4082 !-----------------------------------------------------------------------
4083
4084 ! CASE 1: CaCO3 > 0 absorb all acids (and indirectly degas co2)
4085
4086       subroutine ASTEM_flux_wet_case1(ibin)
4087 !      implicit none
4088 !      include 'mosaic.h'
4089 ! subr arguments
4090       integer ibin
4091 ! local variables
4092       integer iv
4093
4094       mc(jc_h,ibin) = sqrt(Keq_ll(3))
4095
4096 ! same as dry case1
4097       if(gas(ihno3_g) .gt. 1.e-5)then
4098         sfc_a(ihno3_g) = 0.0
4099         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4100         phi_volatile_s(ihno3_g,ibin) = 1.0
4101         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4102         integrate(ihno3_g,jsolid,ibin) = mYES
4103         jphase(ibin) = jsolid
4104         ieqblm_ASTEM = mNO
4105       endif
4106
4107       if(gas(ihcl_g) .gt. 1.e-5)then
4108         sfc_a(ihcl_g)  = 0.0
4109         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4110         phi_volatile_s(ihcl_g,ibin) = 1.0
4111         flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4112         integrate(ihcl_g,jsolid,ibin)  = mYES
4113         jphase(ibin) = jsolid
4114         ieqblm_ASTEM = mNO
4115       endif
4116
4117       return
4118       end subroutine ASTEM_flux_wet_case1
4119
4120
4121
4122 !--------------------------------------------------------------------
4123 ! CASE 2: Sulfate-Rich Domain
4124
4125       subroutine ASTEM_flux_wet_case2(ibin)
4126 !      implicit none
4127 !      include 'mosaic.h'
4128 ! subr arguments
4129       integer ibin
4130 ! local variables
4131       real(kind=8) dum_hno3, dum_hcl, dum_nh3
4132
4133
4134       sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
4135                        gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4136                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4137
4138       sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4139                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4140                    Keq_gl(3)
4141
4142       sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
4143                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4144                    Keq_gl(4)
4145
4146       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4147       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
4148       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
4149
4150
4151 ! compute relative driving forces
4152       if(dum_hno3 .gt. 0.0)then
4153         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4154         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4155       else
4156         phi_volatile_l(ihno3_g,ibin)= 0.0
4157       endif
4158
4159       if(dum_hcl .gt. 0.0)then
4160         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
4161         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4162       else
4163         phi_volatile_l(ihcl_g,ibin) = 0.0
4164       endif
4165
4166       if(dum_nh3 .gt. 0.0)then
4167         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
4168         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4169       else
4170         phi_volatile_l(inh3_g,ibin) = 0.0
4171       endif
4172
4173
4174       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4175          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
4176          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
4177
4178         return
4179
4180       endif
4181
4182
4183 ! compute Heff
4184       if(dum_hno3 .gt. 0.0)then
4185         Heff(ihno3_g,ibin)=  &
4186           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4187                        (water_a(ibin)*Keq_gl(3))
4188         integrate(ihno3_g,jliquid,ibin)= mYES
4189         ieqblm_ASTEM = mNO
4190       endif
4191
4192       if(dum_hcl .gt. 0.0)then
4193         Heff(ihcl_g,ibin)=  &
4194           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4195                        (water_a(ibin)*Keq_gl(4))
4196         integrate(ihcl_g,jliquid,ibin) = mYES
4197         ieqblm_ASTEM = mNO
4198       endif
4199
4200       if(dum_nh3 .gt. 0.0)then
4201         Heff(inh3_g,ibin) =  &
4202              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4203              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4204         integrate(inh3_g,jliquid,ibin) = mYES
4205         ieqblm_ASTEM = mNO
4206       endif
4207
4208
4209       return
4210       end subroutine ASTEM_flux_wet_case2
4211
4212
4213
4214
4215
4216
4217
4218
4219 !---------------------------------------------------------------------
4220 ! CASE 3: nh4no3 and/or nh4cl may be active
4221
4222       subroutine ASTEM_flux_wet_case3(ibin)
4223 !      implicit none
4224 !      include 'mosaic.h'
4225 ! subr arguments
4226       integer ibin
4227 ! local variables
4228       real(kind=8) a, b, c, dum_hno3, dum_hcl, dum_nh3
4229 ! function
4230 !      real(kind=8) quadratic
4231
4232       a =   kg(inh3_g,ibin)
4233       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
4234           + kg(ihno3_g,ibin)*gas(ihno3_g)  &
4235           + kg(ihcl_g,ibin)*gas(ihcl_g)
4236       c = -(kg(ihno3_g,ibin)*Keq_nh4no3 + kg(ihcl_g,ibin)*Keq_nh4cl)
4237
4238       sfc_a(inh3_g)  = quadratic(a,b,c)
4239       sfc_a(ihno3_g) = Keq_nh4no3/max(sfc_a(inh3_g),1.D-20)
4240       sfc_a(ihcl_g)  = Keq_nh4cl/max(sfc_a(inh3_g),1.D-20)
4241
4242
4243 ! diagnose mH+
4244       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4245         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4246         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4247       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4248         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4249         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4250       else
4251         call equilibrate_acids(ibin)    ! hno3 and/or hcl may be > 0 in the gas phase
4252         mc(jc_h,ibin)  = max(mc(jc_h,ibin), sqrt(Keq_ll(3)))
4253
4254         sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
4255                          gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
4256                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4257
4258         sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
4259                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
4260                    Keq_gl(3)
4261         sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
4262                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
4263                    Keq_gl(4)
4264       endif
4265
4266
4267
4268       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4269       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
4270       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
4271
4272 ! compute relative driving forces
4273       if(dum_hno3 .gt. 0.0)then
4274         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4275         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4276       else
4277         phi_volatile_l(ihno3_g,ibin)= 0.0
4278       endif
4279
4280       if(dum_hcl .gt. 0.0)then
4281         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
4282         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4283       else
4284         phi_volatile_l(ihcl_g,ibin) = 0.0
4285       endif
4286
4287       if(dum_nh3 .gt. 0.0)then
4288         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
4289         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4290       else
4291         phi_volatile_l(inh3_g,ibin) = 0.0
4292       endif
4293
4294
4295
4296       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4297          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
4298          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
4299
4300         return
4301
4302       endif
4303
4304
4305 ! compute Heff
4306       if(dum_hno3 .gt. 0.0)then
4307         Heff(ihno3_g,ibin)=  &
4308           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4309                        (water_a(ibin)*Keq_gl(3))
4310         integrate(ihno3_g,jliquid,ibin)= mYES
4311         ieqblm_ASTEM = mNO
4312       endif
4313
4314       if(dum_hcl .gt. 0.0)then
4315         Heff(ihcl_g,ibin)=  &
4316           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4317                        (water_a(ibin)*Keq_gl(4))
4318         integrate(ihcl_g,jliquid,ibin) = mYES
4319         ieqblm_ASTEM = mNO
4320       endif
4321
4322       if(dum_nh3 .gt. 0.0)then
4323         Heff(inh3_g,ibin) =  &
4324              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4325              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4326         integrate(inh3_g,jliquid,ibin) = mYES
4327         ieqblm_ASTEM = mNO
4328       endif
4329
4330
4331
4332       return
4333       end subroutine ASTEM_flux_wet_case3
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343 !--------------------------------------------------------------------
4344 ! CASE 3a: only NH4NO3 (aq) active
4345
4346       subroutine ASTEM_flux_wet_case3a(ibin)    ! NH4NO3 (aq)
4347 !      implicit none
4348 !      include 'mosaic.h'
4349 ! subr arguments
4350       integer ibin
4351 ! local variables
4352       real(kind=8) a, b, c, dum_hno3, dum_nh3
4353 ! function
4354 !      real(kind=8) quadratic
4355
4356
4357       a =   kg(inh3_g,ibin)
4358       b = - kg(inh3_g,ibin)*gas(inh3_g) &
4359           + kg(ihno3_g,ibin)*gas(ihno3_g)
4360       c = -(kg(ihno3_g,ibin)*Keq_nh4no3)
4361
4362       sfc_a(inh3_g)  = quadratic(a,b,c)
4363       sfc_a(ihno3_g) = Keq_nh4no3/sfc_a(inh3_g)
4364
4365
4366 ! diagnose mH+
4367       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4368         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4369           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4370       else
4371         mc(jc_h,ibin) = sqrt(Keq_ll(3))
4372       endif
4373
4374
4375 ! compute Heff
4376       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
4377       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
4378
4379 ! compute relative driving forces
4380       if(dum_hno3 .gt. 0.0)then
4381         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4382         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4383       else
4384         phi_volatile_l(ihno3_g,ibin)= 0.0
4385       endif
4386
4387       if(dum_nh3 .gt. 0.0)then
4388         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
4389         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4390       else
4391         phi_volatile_l(inh3_g,ibin) = 0.0
4392       endif
4393
4394
4395       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4396          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
4397
4398         return
4399
4400       endif
4401
4402
4403 ! compute Heff
4404       Heff(ihno3_g,ibin)=  &
4405         kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4406                      (water_a(ibin)*Keq_gl(3))
4407       integrate(ihno3_g,jliquid,ibin)= mYES
4408
4409
4410       Heff(inh3_g,ibin) =  &
4411            kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4412            (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4413       integrate(inh3_g,jliquid,ibin) = mYES
4414
4415
4416       ieqblm_ASTEM = mNO
4417
4418
4419       return
4420       end subroutine ASTEM_flux_wet_case3a
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430 !--------------------------------------------------------------------
4431 ! CASE 3b: only NH4Cl (aq) active
4432
4433       subroutine ASTEM_flux_wet_case3b(ibin)    ! NH4Cl (aq)
4434 !      implicit none
4435 !      include 'mosaic.h'
4436 ! subr arguments
4437       integer ibin
4438 ! local variables
4439       real(kind=8) a, b, c, dum_hcl, dum_nh3
4440 ! function
4441 !      real(kind=8) quadratic
4442
4443
4444       a =   kg(inh3_g,ibin)
4445       b = - kg(inh3_g,ibin)*gas(inh3_g) &
4446           + kg(ihcl_g,ibin)*gas(ihcl_g)
4447       c = -(kg(ihcl_g,ibin)*Keq_nh4cl)
4448
4449       sfc_a(inh3_g)  = quadratic(a,b,c)
4450       sfc_a(ihcl_g)  = Keq_nh4cl /sfc_a(inh3_g)
4451
4452
4453 ! diagnose mH+
4454       if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4455         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4456           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4457       else
4458         mc(jc_h,ibin) = sqrt(Keq_ll(3))
4459       endif
4460
4461
4462 ! compute Heff
4463       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
4464       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
4465
4466
4467 ! compute relative driving forces
4468       if(dum_hcl .gt. 0.0)then
4469         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
4470         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
4471       else
4472         phi_volatile_l(ihcl_g,ibin) = 0.0
4473       endif
4474
4475       if(dum_nh3 .gt. 0.0)then
4476         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
4477         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
4478       else
4479         phi_volatile_l(inh3_g,ibin) = 0.0
4480       endif
4481
4482
4483
4484       if(phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
4485          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
4486
4487         return
4488
4489       endif
4490
4491
4492
4493 ! compute Heff
4494       Heff(ihcl_g,ibin)=  &
4495           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4496                        (water_a(ibin)*Keq_gl(4))
4497       integrate(ihcl_g,jliquid,ibin) = mYES
4498
4499
4500       Heff(inh3_g,ibin) =  &
4501              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
4502              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
4503       integrate(inh3_g,jliquid,ibin) = mYES
4504
4505
4506       ieqblm_ASTEM = mNO
4507
4508
4509
4510       return
4511       end subroutine ASTEM_flux_wet_case3b
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521 !-----------------------------------------------------------------------
4522 ! CASE 4: NH3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
4523
4524       subroutine ASTEM_flux_wet_case4(ibin)
4525 !      implicit none
4526 !      include 'mosaic.h'
4527 ! subr arguments
4528       integer ibin
4529 ! local variables
4530       real(kind=8) dum_numer, dum_denom, gas_eqb_ratio, dum_hno3, dum_hcl
4531
4532
4533       dum_numer = kel(ihno3_g,ibin)*Keq_gl(4)*ma(ja_no3,ibin)* &
4534                   gam(jhno3,ibin)**2
4535       dum_denom = kel(ihcl_g,ibin)*Keq_gl(3)*ma(ja_cl ,ibin)* &
4536                   gam(jhcl,ibin)**2
4537
4538
4539       if(dum_denom .eq. 0.0 .or. dum_numer .eq. 0.0)then
4540         mc(jc_h,ibin) = sqrt(Keq_ll(3))
4541         return
4542       endif
4543
4544       gas_eqb_ratio = dum_numer/dum_denom       ! Ce,hno3/Ce,hcl
4545
4546
4547 ! compute equilibrium surface concentrations
4548       sfc_a(ihcl_g) =  &
4549        ( kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g) )/ &
4550            ( kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin) )
4551       sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
4552
4553
4554 ! diagnose mH+
4555       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
4556         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
4557         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
4558       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
4559         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
4560         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
4561       else
4562         mc(jc_h,ibin) = sqrt(Keq_ll(3))
4563       endif
4564
4565
4566 ! compute Heff
4567       dum_hno3 = min(sfc_a(ihno3_g), gas(ihno3_g))
4568       dum_hcl  = min(sfc_a(ihcl_g), gas(ihcl_g))
4569
4570 ! compute relative driving forces
4571       if(dum_hno3 .gt. 0.0)then
4572         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
4573         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
4574       else
4575         phi_volatile_l(ihno3_g,ibin)= 0.0
4576       endif
4577
4578       if(dum_hcl .gt. 0.0)then
4579         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
4580         phi_volatile_l(ihcl_g,ibin)= df_gas_l(ihcl_g,ibin)/dum_hcl
4581       else
4582         phi_volatile_l(ihcl_g,ibin)= 0.0
4583       endif
4584
4585
4586       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
4587          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem)then
4588
4589         return
4590
4591       endif
4592
4593
4594
4595 ! compute Heff
4596       Heff(ihno3_g,ibin)=  &
4597           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4598                        (water_a(ibin)*Keq_gl(3))
4599       integrate(ihno3_g,jliquid,ibin)= mYES
4600
4601
4602       Heff(ihcl_g,ibin)=  &
4603           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
4604                        (water_a(ibin)*Keq_gl(4))
4605       integrate(ihcl_g,jliquid,ibin) = mYES
4606
4607
4608       ieqblm_ASTEM = mNO
4609
4610
4611
4612       return
4613       end subroutine ASTEM_flux_wet_case4
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628 !===========================================================
4629 !
4630 ! DRY PARTICLES
4631 !
4632 !===========================================================
4633 !***********************************************************************
4634 ! part of ASTEM: computes gas-aerosol fluxes over dry aerosols
4635 !
4636 ! author: Rahul A. Zaveri
4637 ! update: dec 2006
4638 !-----------------------------------------------------------------------
4639       subroutine ASTEM_flux_dry(ibin)
4640 !      implicit none
4641 !      include 'mosaic.h'
4642 ! subr arguments
4643       integer ibin
4644 ! local variables
4645       integer iv
4646       real(kind=8) XT, prod_nh4no3, prod_nh4cl, volatile_cl
4647
4648
4649
4650
4651       call calculate_XT(ibin,jsolid,XT)
4652
4653 !-----------------------------------------------------------------
4654 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
4655
4656       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
4657
4658         call ASTEM_flux_dry_case1(ibin)
4659
4660         return
4661       endif
4662
4663 !-----------------------------------------------------------------
4664 ! CASE 2: Sulfate-Rich Domain
4665
4666       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
4667
4668         call ASTEM_flux_dry_case2(ibin)
4669
4670         return
4671       endif
4672
4673 !-------------------------------------------------------------------
4674 ! CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
4675
4676       volatile_cl  = electrolyte(jnacl,jsolid,ibin) + &
4677                      electrolyte(jcacl2,jsolid,ibin)
4678
4679
4680       if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
4681
4682         call ASTEM_flux_dry_case3a(ibin)
4683
4684         prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_sg(2)), 0.0D0) + &
4685                      electrolyte(jnh4cl, jsolid,ibin)
4686
4687         if(prod_nh4cl .gt. 0.0)then
4688           call ASTEM_flux_dry_case3b(ibin)
4689         endif
4690
4691         return
4692       endif
4693
4694 !-----------------------------------------------------------------
4695 ! CASE 4: nh4no3 or nh4cl or both may be active
4696
4697       prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-Keq_sg(1)),0.D0) + &
4698                     electrolyte(jnh4no3,jsolid,ibin)
4699       prod_nh4cl  = max( (gas(inh3_g)*gas(ihcl_g) -Keq_sg(2)),0.D0) + &
4700                     electrolyte(jnh4cl, jsolid,ibin)
4701
4702       if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
4703         call ASTEM_flux_dry_case4(ibin)
4704         return
4705       endif
4706
4707 !-----------------------------------------------------------------
4708
4709       return
4710       end subroutine ASTEM_flux_dry
4711
4712 !----------------------------------------------------------------------
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726 !***********************************************************************
4727 ! part of ASTEM: subroutines for flux_dry cases
4728 !
4729 ! author: Rahul A. Zaveri
4730 ! update: dec 2006
4731 !-----------------------------------------------------------------------
4732
4733 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
4734
4735       subroutine ASTEM_flux_dry_case1(ibin)
4736 !      implicit none
4737 !      include 'mosaic.h'
4738 ! subr arguments
4739       integer ibin
4740
4741
4742       if(gas(ihno3_g) .gt. 1.e-5)then
4743         sfc_a(ihno3_g) = 0.0
4744         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4745         phi_volatile_s(ihno3_g,ibin) = 1.0
4746         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
4747         integrate(ihno3_g,jsolid,ibin) = mYES
4748         ieqblm_ASTEM = mNO
4749       endif
4750
4751       if(gas(ihcl_g) .gt. 1.e-5)then
4752         sfc_a(ihcl_g)  = 0.0
4753         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
4754         phi_volatile_s(ihcl_g,ibin) = 1.0
4755         flux_s(ihcl_g,ibin)  = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
4756         integrate(ihcl_g,jsolid,ibin)  = mYES
4757         ieqblm_ASTEM = mNO
4758       endif
4759
4760
4761       return
4762       end subroutine ASTEM_flux_dry_case1
4763
4764
4765
4766 !---------------------------------------------------------------------
4767 ! CASE 2: Sulfate-Rich Domain
4768
4769       subroutine ASTEM_flux_dry_case2(ibin) ! TOUCH
4770 !      implicit none
4771 !      include 'mosaic.h'
4772 ! subr arguments
4773       integer ibin
4774
4775
4776       if(gas(inh3_g).gt.1.e-5)then
4777         sfc_a(inh3_g) = 0.0
4778         df_gas_s(inh3_g,ibin) = gas(inh3_g)
4779         phi_volatile_s(inh3_g,ibin)  = 1.0
4780         flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
4781         integrate(inh3_g,jsolid,ibin) = mYES
4782         ieqblm_ASTEM = mNO
4783       endif
4784
4785
4786       return
4787       end subroutine ASTEM_flux_dry_case2
4788
4789
4790
4791
4792 !---------------------------------------------------------------------
4793 ! CASE 3a: degas hcl from nacl or cacl2 by flux_s balance with hno3
4794
4795       subroutine ASTEM_flux_dry_case3a(ibin)
4796 !      implicit none
4797 !      include 'mosaic.h'
4798 ! subr arguments
4799       integer ibin
4800
4801
4802       if(gas(ihno3_g) .gt. 1.e-5)then
4803         sfc_a(ihno3_g) = 0.0
4804         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4805
4806         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
4807         df_gas_s(ihcl_g,ibin)  = -aer(icl_a,jsolid,ibin)
4808
4809         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
4810         flux_s(ihcl_g,ibin)  = -flux_s(ihno3_g,ibin)
4811
4812         phi_volatile_s(ihno3_g,ibin) = 1.0
4813         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)
4814
4815         integrate(ihno3_g,jsolid,ibin) = mYES
4816         integrate(ihcl_g,jsolid,ibin)  = mYES
4817
4818         idry_case3a(ibin) = mYES
4819         ieqblm_ASTEM = mNO
4820       endif
4821
4822       return
4823       end subroutine ASTEM_flux_dry_case3a
4824
4825
4826
4827
4828 !---------------------------------------------------------------------
4829 ! CASE 3b: nh4cl may form/evaporate here
4830
4831       subroutine ASTEM_flux_dry_case3b(ibin)    ! TOUCH
4832 !      implicit none
4833 !      include 'mosaic.h'
4834 ! subr arguments
4835       integer ibin
4836 ! local variables
4837       integer iactive_nh4cl
4838       real(kind=8) a, b, c
4839 ! function
4840 !      real(kind=8) quadratic
4841
4842
4843 !-------------------
4844 ! set default values for flags
4845       iactive_nh4cl  = 1
4846
4847
4848 ! compute relative driving force
4849       phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4850                     max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4851
4852
4853 !-------------------
4854 ! now determine if nh4cl is active or significant
4855 ! nh4cl
4856       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4857         iactive_nh4cl = 0
4858       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4859              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4860         iactive_nh4cl = 0
4861         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4862           call degas_solid_nh4cl(ibin)
4863         endif
4864       endif
4865
4866
4867 ! check the outcome
4868       if(iactive_nh4cl .eq. 0)return
4869
4870
4871 !-----------------
4872 ! nh4cl is active
4873
4874
4875       a =   kg(inh3_g,ibin)
4876       b = - kg(inh3_g,ibin)*gas(inh3_g) &
4877           + kg(ihcl_g,ibin)*gas(ihcl_g)
4878       c = -(kg(ihcl_g,ibin)*Keq_sg(2))
4879
4880       sfc_a(inh3_g) = quadratic(a,b,c)
4881       sfc_a(ihcl_g) = Keq_sg(2)/sfc_a(inh3_g)
4882
4883       df_gas_s(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
4884       df_gas_s(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
4885
4886       flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas_s(inh3_g,ibin)
4887       flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) + flux_s(inh3_g,ibin)
4888
4889       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
4890
4891       if(flux_s(ihcl_g,ibin) .gt. 0.0)then
4892         df_gas_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)     ! recompute df_gas
4893         phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
4894       else
4895         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
4896         df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
4897         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)  ! not to be used
4898       endif
4899
4900       integrate(inh3_g,jsolid,ibin) = mYES
4901       integrate(ihcl_g,jsolid,ibin) = mYES      ! integrate HCl with explicit euler
4902
4903       ieqblm_ASTEM = mNO
4904
4905       return
4906       end subroutine ASTEM_flux_dry_case3b
4907
4908
4909
4910
4911 !---------------------------------------------------------------------
4912 ! Case 4: NH4NO3 and/or NH4Cl may be active
4913
4914       subroutine ASTEM_flux_dry_case4(ibin)     ! TOUCH
4915 !      implicit none
4916 !      include 'mosaic.h'
4917 ! subr arguments
4918       integer ibin
4919 ! local variables
4920       integer iactive_nh4no3, iactive_nh4cl, iactive
4921       real(kind=8) a, b, c
4922 ! function
4923 !      real(kind=8) quadratic
4924
4925
4926 !-------------------
4927 ! set default values for flags
4928       iactive_nh4no3 = 1
4929       iactive_nh4cl  = 2
4930
4931
4932 ! compute diagnostic products and ratios
4933       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
4934                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
4935       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
4936                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
4937
4938
4939 !-------------------
4940 ! now determine if nh4no3 and/or nh4cl are active or significant
4941
4942 ! nh4no3
4943       if( abs(phi_nh4no3_s) .lt. rtol_eqb_ASTEM )then
4944         iactive_nh4no3 = 0
4945       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
4946              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
4947         iactive_nh4no3 = 0
4948         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
4949           call degas_solid_nh4no3(ibin)
4950         endif
4951       endif
4952
4953 ! nh4cl
4954       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
4955         iactive_nh4cl = 0
4956       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
4957              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
4958         iactive_nh4cl = 0
4959         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
4960           call degas_solid_nh4cl(ibin)
4961         endif
4962       endif
4963
4964
4965       iactive = iactive_nh4no3 + iactive_nh4cl
4966
4967 ! check the outcome
4968       if(iactive .eq. 0)return
4969
4970
4971       goto (1,2,3),iactive
4972
4973 !---------------------------------
4974 ! only nh4no3 solid is active
4975 1     call ASTEM_flux_dry_case4a(ibin)
4976
4977       return
4978
4979
4980 !-----------------
4981 ! only nh4cl solid is active
4982 2     call ASTEM_flux_dry_case4b(ibin)
4983
4984       return
4985
4986
4987 !-----------------
4988 ! both nh4no3 and nh4cl are active
4989 3     call ASTEM_flux_dry_case4ab(ibin)
4990
4991
4992
4993
4994       return
4995       end subroutine ASTEM_flux_dry_case4
4996
4997
4998
4999
5000
5001
5002
5003 !---------------------------------------------------------------------
5004 ! Case 4a
5005
5006       subroutine ASTEM_flux_dry_case4a(ibin) ! NH4NO3 solid
5007 !      implicit none
5008 !      include 'mosaic.h'
5009 ! subr arguments
5010       integer ibin
5011 ! local variables
5012       real(kind=8) a, b, c
5013 ! function
5014 !      real(kind=8) quadratic
5015
5016
5017
5018       a =   kg(inh3_g,ibin)
5019       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
5020           + kg(ihno3_g,ibin)*gas(ihno3_g)
5021       c = -(kg(ihno3_g,ibin)*Keq_sg(1))
5022
5023       sfc_a(inh3_g)  = quadratic(a,b,c)
5024       sfc_a(ihno3_g) = Keq_sg(1)/sfc_a(inh3_g)
5025
5026       integrate(ihno3_g,jsolid,ibin) = mYES
5027       integrate(inh3_g,jsolid,ibin)  = mYES
5028
5029       df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5030       df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5031
5032       phi_volatile_s(ihno3_g,ibin)= phi_nh4no3_s
5033       phi_volatile_s(inh3_g,ibin) = phi_nh4no3_s
5034
5035       flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
5036       flux_s(inh3_g,ibin)  = flux_s(ihno3_g,ibin)
5037
5038       ieqblm_ASTEM = mNO
5039
5040       return
5041       end subroutine ASTEM_flux_dry_case4a
5042
5043
5044
5045
5046 !---------------------------------------------------------
5047 ! Case 4b
5048
5049       subroutine ASTEM_flux_dry_case4b(ibin) ! NH4Cl solid
5050 !      implicit none
5051 !      include 'mosaic.h'
5052 ! subr arguments
5053       integer ibin
5054 ! local variables
5055       real(kind=8) a, b, c
5056 ! function
5057 !      real(kind=8) quadratic
5058
5059
5060       a =   kg(inh3_g,ibin)
5061       b = - kg(inh3_g,ibin)*gas(inh3_g) &
5062           + kg(ihcl_g,ibin)*gas(ihcl_g)
5063       c = -(kg(ihcl_g,ibin)*Keq_sg(2))
5064
5065       sfc_a(inh3_g) = quadratic(a,b,c)
5066       sfc_a(ihcl_g) = Keq_sg(2) /sfc_a(inh3_g)
5067
5068       integrate(ihcl_g,jsolid,ibin) = mYES
5069       integrate(inh3_g,jsolid,ibin) = mYES
5070
5071       df_gas_s(ihcl_g,ibin) = gas(ihcl_g)-sfc_a(ihcl_g)
5072       df_gas_s(inh3_g,ibin) = gas(inh3_g)-sfc_a(inh3_g)
5073
5074       phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
5075       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
5076
5077       flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
5078       flux_s(inh3_g,ibin) = flux_s(ihcl_g,ibin)
5079
5080       ieqblm_ASTEM = mNO
5081
5082       return
5083       end subroutine ASTEM_flux_dry_case4b
5084
5085
5086
5087
5088 !-------------------------------------------------------------------
5089 ! Case 4ab
5090
5091       subroutine ASTEM_flux_dry_case4ab(ibin)   ! NH4NO3 + NH4Cl (solid)
5092 !      implicit none
5093 !      include 'mosaic.h'
5094 ! subr arguments
5095       integer ibin
5096 ! local variables
5097       real(kind=8) a, b, c, &
5098            flux_nh3_est, flux_nh3_max, ratio_flux
5099 ! function
5100 !      real(kind=8) quadratic
5101
5102       call ASTEM_flux_dry_case4a(ibin)
5103       call ASTEM_flux_dry_case4b(ibin)
5104
5105
5106 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
5107
5108       flux_nh3_est = flux_s(ihno3_g,ibin)+flux_s(ihcl_g,ibin)
5109       flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
5110
5111
5112       if(flux_nh3_est .le. flux_nh3_max)then
5113
5114         flux_s(inh3_g,ibin) = flux_nh3_est                      ! all ok - no adjustments needed
5115         sfc_a(inh3_g)       = gas(inh3_g) -  &                  ! recompute sfc_a(ihno3_g)
5116                               flux_s(inh3_g,ibin)/kg(inh3_g,ibin)
5117         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5118                                           abs(phi_nh4cl_s))
5119
5120       else                      ! reduce hno3 and hcl flux_ses as necessary so that nh3 flux_s = flux_s_nh3_max
5121
5122         ratio_flux          = flux_nh3_max/flux_nh3_est
5123         flux_s(inh3_g,ibin) = flux_nh3_max
5124         flux_s(ihno3_g,ibin)= flux_s(ihno3_g,ibin)*ratio_flux
5125         flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) *ratio_flux
5126
5127         sfc_a(inh3_g) = 0.0
5128         sfc_a(ihno3_g)= gas(ihno3_g) -  &       ! recompute sfc_a(ihno3_g)
5129                         flux_s(ihno3_g,ibin)/kg(ihno3_g,ibin)
5130         sfc_a(ihcl_g) = gas(ihcl_g) -   &       ! recompute sfc_a(ihcl_g)
5131                         flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)
5132
5133         df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
5134         df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
5135         df_gas_s(ihcl_g,ibin) =gas(ihcl_g) -sfc_a(ihcl_g)
5136
5137         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
5138                                           abs(phi_nh4cl_s))
5139
5140       endif
5141
5142       ieqblm_ASTEM = mNO
5143
5144       return
5145       end subroutine ASTEM_flux_dry_case4ab
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157 !=======================================================================
5158 !
5159 ! MIXED-PHASE PARTICLES
5160 !
5161 !***********************************************************************
5162 ! part of ASTEM: computes gas-aerosol fluxes over mixed-phase aerosols
5163 !
5164 ! author: Rahul A. Zaveri
5165 ! update: apr 2006
5166 !-----------------------------------------------------------------------
5167
5168       subroutine ASTEM_flux_mix(ibin)
5169 !      implicit none
5170 !      include 'mosaic.h'
5171 ! subr arguments
5172       integer ibin
5173 ! local variables
5174       integer iv, iadjust, iadjust_intermed
5175       real(kind=8) XT, g_nh3_hno3, g_nh3_hcl, &
5176            a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
5177            prod_nh4no3, prod_nh4cl
5178       real(kind=8) volatile_cl
5179
5180
5181       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
5182       call compute_activities(ibin)
5183
5184       if(water_a(ibin) .eq. 0.0)then
5185         write(6,*)'Water is zero in liquid phase'
5186         write(6,*)'Stopping in ASTEM_flux_wet'
5187         stop
5188       endif
5189
5190
5191
5192 !-----------------------------------------------------------------
5193 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
5194
5195       if(epercent(jcaco3,jsolid,ibin) .gt. 0.0)then
5196         jphase(ibin) = jliquid
5197         call ASTEM_flux_wet_case1(ibin)
5198         return
5199       endif
5200
5201 !-----------------------------------------------------------------
5202 ! CASE 2: Sulfate-Rich Domain
5203
5204       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
5205         jphase(ibin) = jliquid
5206         call ASTEM_flux_wet_case2(ibin)
5207         return
5208       endif
5209
5210 !-------------------------------------------------------------------
5211 ! CASE 3: nh4no3 or nh4cl or both may be active
5212
5213       if( electrolyte(jnh4no3,jsolid,ibin).gt.0. .and. &
5214           electrolyte(jnh4cl,jsolid,ibin) .gt.0. )then
5215         jphase(ibin) = jsolid
5216         call ASTEM_flux_dry_case4(ibin)
5217
5218         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5219           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5220           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5221         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5222           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5223           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5224         else
5225           mc(jc_h,ibin) = sqrt(Keq_ll(3))
5226         endif
5227
5228         return
5229
5230       elseif( electrolyte(jnh4no3,jsolid,ibin).gt.0. )then
5231 ! do small adjustments for nh4cl aq
5232         g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
5233         a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
5234
5235         iadjust = mNO           ! initialize
5236         if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .eq. 0.0)then
5237           call absorb_tiny_nh4cl(ibin)
5238           iadjust = mYES
5239         elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
5240           call degas_tiny_nh4cl(ibin)
5241           iadjust = mYES
5242         endif
5243
5244         if(iadjust .eq. mYES)then
5245           call ions_to_electrolytes(jliquid,ibin,XT)    ! update after adjustments
5246           call compute_activities(ibin)                 ! update after adjustments
5247         endif
5248
5249         call ASTEM_flux_mix_case3a(ibin)        ! nh4no3 solid + nh4cl aq
5250         jphase(ibin) = jtotal
5251         return
5252
5253       elseif( electrolyte(jnh4cl,jsolid,ibin).gt.0.)then
5254 ! do small adjustments for nh4no3 aq
5255         g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
5256         a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
5257
5258         iadjust = mNO           ! initialize
5259         if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .eq. 0.0)then
5260           call absorb_tiny_nh4no3(ibin)
5261           iadjust = mYES
5262         elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
5263           call degas_tiny_nh4no3(ibin)
5264           iadjust = mYES
5265         endif
5266
5267         if(iadjust .eq. mYES)then
5268           call ions_to_electrolytes(jliquid,ibin,XT)    ! update after adjustments
5269           call compute_activities(ibin)                 ! update after adjustments
5270         endif
5271
5272         kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5273         Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3     ! = [NH3]s * [HNO3]s
5274
5275         call ASTEM_flux_mix_case3b(ibin)        ! nh4cl solid + nh4no3 aq
5276         jphase(ibin) = jtotal
5277         return
5278       endif
5279
5280
5281       return
5282       end subroutine ASTEM_flux_mix
5283
5284 !----------------------------------------------------------------------
5285
5286
5287
5288
5289
5290
5291
5292
5293 !------------------------------------------------------------------
5294 ! Mix Case 3a: NH4NO3 solid maybe active. NH4Cl aq maybe active
5295
5296       subroutine ASTEM_flux_mix_case3a(ibin)    ! TOUCH
5297 !      implicit none
5298 !      include 'mosaic.h'
5299 ! subr arguments
5300       integer ibin
5301 ! local variables
5302       integer iactive_nh4no3, iactive_nh4cl
5303
5304
5305 ! set default values for flags
5306       iactive_nh4no3 = mYES
5307       iactive_nh4cl  = mYES
5308
5309
5310 ! nh4no3 (solid)
5311       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
5312                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
5313
5314 ! nh4cl (liquid)
5315       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
5316       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
5317
5318
5319 !-------------------
5320 ! now determine if nh4no3 and/or nh4cl are active or significant
5321 ! nh4no3 solid
5322       if( abs(phi_nh4no3_s) .le. rtol_eqb_ASTEM )then
5323         iactive_nh4no3 = mNO
5324       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
5325              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
5326         iactive_nh4no3 = mNO
5327         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
5328           call degas_solid_nh4no3(ibin)
5329         endif
5330       endif
5331
5332 ! nh4cl aq
5333       if( gas(inh3_g)*gas(ihcl_g).eq.0. .or. Keq_nh4cl.eq.0. )then
5334         iactive_nh4cl = mNO
5335       endif
5336
5337
5338 !---------------------------------
5339       if(iactive_nh4no3 .eq. mYES)then
5340
5341         jphase(ibin) = jsolid
5342         call ASTEM_flux_dry_case4a(ibin)        ! NH4NO3 (solid)
5343
5344         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5345           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5346           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5347         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5348           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5349           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5350         else
5351           mc(jc_h,ibin) = sqrt(Keq_ll(3))
5352         endif
5353
5354       endif
5355
5356
5357       if(iactive_nh4cl .eq. mYES)then
5358
5359         jphase(ibin) = jliquid
5360         call ASTEM_flux_wet_case3b(ibin)        ! NH4Cl (liquid)
5361
5362         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5363           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5364           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5365         else
5366           mc(jc_h,ibin) = sqrt(Keq_ll(3))
5367         endif
5368
5369       endif
5370
5371
5372       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
5373         jphase(ibin) = jtotal
5374       endif
5375
5376
5377
5378       return
5379       end subroutine ASTEM_flux_mix_case3a
5380
5381
5382
5383
5384
5385
5386
5387
5388 !------------------------------------------------------------------
5389 ! Mix Case 3b: NH4Cl solid maybe active. NH4NO3 aq may or maybe active
5390
5391       subroutine ASTEM_flux_mix_case3b(ibin)    ! TOUCH
5392 !      implicit none
5393 !      include 'mosaic.h'
5394 ! subr arguments
5395       integer ibin
5396 ! local variables
5397       integer iactive_nh4no3, iactive_nh4cl
5398
5399
5400 ! set default values for flags
5401       iactive_nh4cl  = mYES
5402       iactive_nh4no3 = mYES
5403
5404
5405 ! nh4cl (solid)
5406       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
5407                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
5408
5409 ! nh4no3 (liquid)
5410       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
5411       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
5412
5413
5414 !-------------------
5415 ! now determine if nh4no3 and/or nh4cl are active or significant
5416 ! nh4cl (solid)
5417       if( abs(phi_nh4cl_s) .le. rtol_eqb_ASTEM )then
5418         iactive_nh4cl = mNO
5419       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
5420              epercent(jnh4cl,jsolid,ibin) .le. ptol_mol_ASTEM)then
5421         iactive_nh4cl = mNO
5422         if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0)then
5423           call degas_solid_nh4cl(ibin)
5424         endif
5425       endif
5426
5427 ! nh4no3 (liquid)
5428       if( gas(inh3_g)*gas(ihno3_g).eq.0. .or. Keq_nh4no3.eq.0. )then
5429         iactive_nh4no3 = mNO
5430       endif
5431
5432
5433 !---------------------------------
5434       if(iactive_nh4cl .eq. mYES)then
5435
5436         jphase(ibin) = jsolid
5437         call ASTEM_flux_dry_case4b(ibin)        ! NH4Cl (solid)
5438
5439         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
5440           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
5441           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
5442         elseif(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5443           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5444           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5445         else
5446           mc(jc_h,ibin) = sqrt(Keq_ll(3))
5447         endif
5448
5449       endif
5450
5451
5452       if(iactive_nh4no3 .eq. mYES)then
5453
5454         jphase(ibin) = jliquid
5455         call ASTEM_flux_wet_case3a(ibin)        ! NH4NO3 (liquid)
5456
5457         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
5458           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
5459           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
5460         else
5461           mc(jc_h,ibin) = sqrt(Keq_ll(3))
5462         endif
5463
5464       endif
5465
5466
5467       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
5468         jphase(ibin) = jtotal
5469       endif
5470
5471
5472
5473       return
5474       end subroutine ASTEM_flux_mix_case3b
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486 !***********************************************************************
5487 ! part of ASTEM: condenses h2so4, msa, and nh3 analytically over dtchem [s]
5488 !
5489 ! author: Rahul A. Zaveri
5490 ! update: jan 2007
5491 !-----------------------------------------------------------------------
5492
5493       subroutine ASTEM_non_volatiles(dtchem) ! TOUCH
5494 !      implicit none
5495 !      include 'mosaic.h'
5496 ! subr arguments
5497       real(kind=8) dtchem
5498 ! local variables
5499       integer ibin, iupdate_phase_state
5500       real(kind=8) decay_h2so4, decay_msa,   &
5501            delta_h2so4, delta_tmsa, delta_nh3, delta_hno3, delta_hcl, &
5502            delta_so4(nbin_a), delta_msa(nbin_a), &
5503            delta_nh4(nbin_a)
5504       real(kind=8) XT
5505
5506
5507
5508
5509       sumkg_h2so4 = 0.0
5510       sumkg_msa   = 0.0
5511       sumkg_nh3   = 0.0
5512       sumkg_hno3  = 0.0
5513       sumkg_hcl   = 0.0
5514       do ibin = 1, nbin_a
5515         sumkg_h2so4 = sumkg_h2so4 + kg(ih2so4_g,ibin)
5516         sumkg_msa   = sumkg_msa   + kg(imsa_g,ibin)
5517         sumkg_nh3   = sumkg_nh3   + kg(inh3_g,ibin)
5518         sumkg_hno3  = sumkg_hno3  + kg(ihno3_g,ibin)
5519         sumkg_hcl   = sumkg_hcl   + kg(ihcl_g,ibin)
5520       enddo
5521
5522
5523
5524 !--------------------------------------
5525 ! H2SO4
5526       if(gas(ih2so4_g) .gt. 1.e-14)then
5527
5528 ! integrate h2so4 condensation analytically
5529         decay_h2so4   = exp(-sumkg_h2so4*dtchem)
5530         delta_h2so4   = gas(ih2so4_g)*(1.0 - decay_h2so4)
5531         gas(ih2so4_g) = gas(ih2so4_g)*decay_h2so4
5532
5533
5534 ! now distribute delta_h2so4 to each bin and conform the particle (may degas by massbal)
5535         do ibin = 1, nbin_a
5536           if(jaerosolstate(ibin) .ne. no_aerosol)then
5537             delta_so4(ibin) = delta_h2so4*kg(ih2so4_g,ibin)/sumkg_h2so4
5538             aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
5539                                       delta_so4(ibin)
5540           endif
5541         enddo
5542
5543       else
5544
5545         delta_h2so4 = 0.0
5546         do ibin = 1, nbin_a
5547             delta_so4(ibin) = 0.0
5548         enddo
5549
5550       endif
5551 ! h2so4 condensation is now complete
5552 !--------------------------------------
5553
5554
5555
5556 ! MSA
5557       if(gas(imsa_g) .gt. 1.e-14)then
5558
5559 ! integrate msa condensation analytically
5560         decay_msa   = exp(-sumkg_msa*dtchem)
5561         delta_tmsa  = gas(imsa_g)*(1.0 - decay_msa)
5562         gas(imsa_g) = gas(imsa_g)*decay_msa
5563
5564 ! now distribute delta_msa to each bin and conform the particle (may degas by massbal)
5565         do ibin = 1, nbin_a
5566           if(jaerosolstate(ibin) .ne. no_aerosol)then
5567             delta_msa(ibin) = delta_tmsa*kg(imsa_g,ibin)/sumkg_msa
5568             aer(imsa_a,jtotal,ibin) = aer(imsa_a,jtotal,ibin) + &
5569                                       delta_msa(ibin)
5570           endif
5571         enddo
5572
5573       else
5574
5575         delta_tmsa = 0.0
5576         do ibin = 1, nbin_a
5577             delta_msa(ibin) = 0.0
5578         enddo
5579
5580       endif
5581 ! msa condensation is now complete
5582 !-------------------------------------
5583
5584
5585
5586 ! compute max allowable nh3, hno3, and hcl condensation
5587       delta_nh3 = gas(inh3_g) *(1.0 - exp(-sumkg_nh3*dtchem))
5588       delta_hno3= gas(ihno3_g)*(1.0 - exp(-sumkg_hno3*dtchem))
5589       delta_hcl = gas(ihcl_g) *(1.0 - exp(-sumkg_hcl*dtchem))
5590
5591 ! compute max possible nh4 condensation for each bin
5592       do ibin = 1, nbin_a
5593         if(jaerosolstate(ibin) .ne. no_aerosol)then
5594           delta_nh3_max(ibin) = delta_nh3*kg(inh3_g,ibin)/sumkg_nh3
5595           delta_hno3_max(ibin)= delta_hno3*kg(ihno3_g,ibin)/sumkg_hno3
5596           delta_hcl_max(ibin) = delta_hcl*kg(ihcl_g,ibin)/sumkg_hcl
5597         endif
5598       enddo
5599
5600
5601       if(delta_h2so4 .eq. 0.0 .and. delta_tmsa .eq. 0.0)then
5602         iupdate_phase_state = mNO
5603         goto 100
5604       endif
5605
5606
5607 ! now condense appropriate amounts of nh3 to each bin
5608       do ibin = 1, nbin_a
5609
5610         if(epercent(jnacl,jtotal,ibin)  .eq. 0.0 .and. &
5611            epercent(jcacl2,jtotal,ibin) .eq. 0.0 .and. &
5612            epercent(jnano3,jtotal,ibin) .eq. 0.0 .and. &
5613            epercent(jcano3,jtotal,ibin) .eq. 0.0 .and. &
5614            epercent(jcaco3,jtotal,ibin) .eq. 0.0 .and. &
5615            jaerosolstate(ibin) .ne. no_aerosol)then
5616
5617           delta_nh4(ibin)=min( (2.*delta_so4(ibin)+delta_msa(ibin)), &
5618                                 delta_nh3_max(ibin) )
5619
5620           aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) + & ! update aer-phase
5621                                     delta_nh4(ibin)
5622
5623           gas(inh3_g) = gas(inh3_g) - delta_nh4(ibin)           ! update gas-phase
5624
5625         else
5626
5627           delta_nh4(ibin)     = 0.0
5628
5629         endif
5630
5631       enddo
5632
5633       iupdate_phase_state = mYES
5634
5635
5636 ! recompute phase equilibrium
5637 100   if(iupdate_phase_state .eq. mYES)then
5638         do ibin = 1, nbin_a
5639           if(jaerosolstate(ibin) .ne. no_aerosol)then
5640             call conform_electrolytes(jtotal,ibin,XT)
5641             call aerosol_phase_state(ibin)
5642           endif
5643         enddo
5644       endif
5645
5646       return
5647       end subroutine ASTEM_non_volatiles
5648
5649
5650
5651
5652
5653
5654
5655 !***********************************************************************
5656 ! computes mass transfer coefficients for each condensing species for
5657 ! all the aerosol bins
5658 !
5659 ! author: rahul a. zaveri
5660 ! update: jan 2005
5661 !-----------------------------------------------------------------------
5662       subroutine aerosolmtc
5663
5664       use module_data_mosaic_asect
5665
5666 !     implicit none
5667 !     include 'v33com9a'
5668 !     include 'mosaic.h'
5669 ! local variables
5670       integer nghq
5671       parameter (nghq = 2)              ! gauss-hermite quadrature order
5672       integer ibin, iq, iv
5673       real(kind=8) tworootpi, root2, beta
5674       parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
5675       real(kind=8) cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed,   &
5676            sumghq
5677       real(kind=8) xghq(nghq), wghq(nghq)                       ! quadrature abscissae and weights
5678       real(kind=8) mw_vol(ngas_volatile), v_molar(ngas_volatile),                    &  ! mw and molar vols of volatile species
5679            freepath(ngas_volatile), accom(ngas_volatile),   &
5680            dg(ngas_volatile)                            ! keep local
5681 !     real(kind=8) fuchs_sutugin                                ! mosaic func
5682 !     real(kind=8) gas_diffusivity                              ! mosaic func
5683 !     real(kind=8) mean_molecular_speed                         ! mosaic func
5684
5685
5686
5687
5688
5689 ! molecular weights
5690       mw_vol(ih2so4_g) = 98.0
5691       mw_vol(ihno3_g)  = 63.0
5692       mw_vol(ihcl_g)   = 36.5
5693       mw_vol(inh3_g)   = 17.0
5694       mw_vol(imsa_g)   = 96.0
5695       mw_vol(iaro1_g)  = 150.0
5696       mw_vol(iaro2_g)  = 150.0
5697       mw_vol(ialk1_g)  = 140.0
5698       mw_vol(iole1_g)  = 140.0
5699       mw_vol(iapi1_g)  = 184.0
5700       mw_vol(iapi2_g)  = 184.0
5701       mw_vol(ilim1_g)  = 200.0
5702       mw_vol(ilim2_g)  = 200.0
5703
5704       v_molar(ih2so4_g)= 42.88
5705       v_molar(ihno3_g) = 24.11
5706       v_molar(ihcl_g)  = 21.48
5707       v_molar(inh3_g)  = 14.90
5708       v_molar(imsa_g)  = 58.00
5709
5710 ! mass accommodation coefficients
5711       accom(ih2so4_g)  = 0.1
5712       accom(ihno3_g)   = 0.1
5713       accom(ihcl_g)    = 0.1
5714       accom(inh3_g)    = 0.1
5715       accom(imsa_g)    = 0.1
5716       accom(iaro1_g)   = 0.1
5717       accom(iaro2_g)   = 0.1
5718       accom(ialk1_g)   = 0.1
5719       accom(iole1_g)   = 0.1
5720       accom(iapi1_g)   = 0.1
5721       accom(iapi2_g)   = 0.1
5722       accom(ilim1_g)   = 0.1
5723       accom(ilim2_g)   = 0.1
5724
5725 ! quadrature weights
5726       xghq(1) =  0.70710678
5727       xghq(2) = -0.70710678
5728       wghq(1) =  0.88622693
5729       wghq(2) =  0.88622693
5730
5731
5732
5733 ! calculate gas diffusivity and mean free path for condensing gases
5734 ! ioa
5735       do iv = 1, ngas_ioa
5736         speed  = mean_molecular_speed(t_k,mw_vol(iv))   ! cm/s
5737         dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
5738         freepath(iv) = 3.*dg(iv)/speed                  ! cm
5739       enddo
5740
5741 ! soa
5742       do iv = iaro1_g, ngas_volatile
5743         speed = mean_molecular_speed(t_k,mw_vol(iv))    ! cm/s
5744         dg(iv) = 0.02                                   ! cm^2/s
5745         freepath(iv) = 3.*dg(iv)/speed
5746       enddo
5747
5748
5749 ! calc mass transfer coefficients for gases over various aerosol bins
5750
5751       if (msize_framework .eq. mmodal) then
5752
5753 ! for modal approach
5754       do 10 ibin = 1, nbin_a
5755
5756         if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
5757         call calc_dry_n_wet_aerosol_props(ibin)
5758
5759         dpgn_a(ibin) = dp_wet_a(ibin)   ! cm
5760
5761         lnsg   = log(sigmag_a(ibin))
5762         lndpgn = log(dpgn_a(ibin))
5763         cdum   = tworootpi*num_a(ibin)*   &
5764                  exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
5765
5766         do 20 iv = 1, ngas_volatile
5767
5768           sumghq = 0.0
5769           do 30 iq = 1, nghq    ! sum over gauss-hermite quadrature points
5770             lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
5771             dp = exp(lndp)
5772             kn = 2.*freepath(iv)/dp
5773             fkn = fuchs_sutugin(kn,accom(iv))
5774             sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
5775 30        continue
5776
5777         kg(iv,ibin) = cdum*dg(iv)*sumghq                ! 1/s
5778 20      continue
5779 10    continue
5780
5781       elseif(msize_framework .eq. msection)then
5782
5783 ! for sectional approach
5784       do 11 ibin = 1, nbin_a
5785
5786         if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
5787
5788         call calc_dry_n_wet_aerosol_props(ibin)
5789
5790         dp_avg = dp_wet_a(ibin)
5791         cdum  = 6.283185*dp_avg*num_a(ibin)
5792
5793         do 21 iv = 1, ngas_volatile
5794           kn = 2.*freepath(iv)/dp_avg
5795           fkn = fuchs_sutugin(kn,accom(iv))
5796           kg(iv,ibin) = cdum*dg(iv)*fkn         ! 1/s
5797 21      continue
5798
5799 11    continue
5800
5801       else
5802
5803         if (iprint_mosaic_fe1 .gt. 0) then
5804           write(6,*)'error in the choice of msize_framework'
5805           write(6,*)'mosaic fatal error in subr. aerosolmtc'
5806         endif
5807 !       stop
5808         istat_mosaic_fe1 = -1900
5809         return
5810
5811       endif
5812
5813
5814       return
5815       end subroutine aerosolmtc
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828 !***********************************************************************
5829 ! calculates dry and wet aerosol properties: density, refractive indices
5830 !
5831 ! author: rahul a. zaveri
5832 ! update: jan 2005
5833 !-----------------------------------------------------------------------
5834       subroutine calc_dry_n_wet_aerosol_props(ibin)
5835
5836       use module_data_mosaic_asect
5837
5838 !     implicit none
5839 !     include 'v33com9a'
5840 !     include 'mosaic.h'
5841 ! subr arguments
5842       integer ibin
5843 ! local variables
5844       integer jc, je, iaer, isize, itype
5845       real(kind=8) aer_H
5846       complex(kind=8) ri_dum
5847
5848
5849 ! calculate dry mass and dry volume of a bin
5850       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
5851       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
5852       area_dry_a(ibin) = 0.0            ! initialize to 0.0
5853
5854       if(jaerosolstate(ibin) .ne. no_aerosol)then
5855
5856         aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
5857                     aer(ino3_a,jtotal,ibin) +  &
5858                     aer(icl_a,jtotal,ibin)  +  &
5859                     aer(imsa_a,jtotal,ibin) +  &
5860                  2.*aer(ico3_a,jtotal,ibin))-  &
5861                 (2.*aer(ica_a,jtotal,ibin)  +  &
5862                     aer(ina_a,jtotal,ibin)  +  &
5863                     aer(inh4_a,jtotal,ibin))
5864
5865       do iaer = 1, naer
5866         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
5867                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
5868         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
5869         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
5870       enddo
5871         mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
5872         vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
5873
5874       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
5875       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! cc(aer)/cc(air)
5876
5877 ! wet mass and wet volume
5878         mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3       ! g/cc(air)
5879         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3        ! cc(aer)/cc(air)
5880
5881 ! calculate mean dry and wet particle densities
5882         dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
5883         dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
5884
5885 ! calculate mean dry and wet particle surface areas
5886         area_dry_a(ibin)= 0.785398*num_a(ibin)*Dp_dry_a(ibin)**2        ! cm^2/cc(air)
5887         area_wet_a(ibin)= 0.785398*num_a(ibin)*Dp_wet_a(ibin)**2        ! cm^2/cc(air)
5888
5889 ! calculate mean dry and wet particle diameters
5890         dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
5891         dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
5892
5893 ! calculate volume average refractive index
5894 !   load comp_a array
5895         do je = 1, nelectrolyte
5896           comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15   ! g/cc(air)
5897         enddo
5898         comp_a(joc)  = aer(ioc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
5899         comp_a(jbc)  = aer(ibc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
5900         comp_a(join) = aer(ioin_a,jtotal,ibin)*mw_comp_a(je)*1.e-15     ! g/cc(air)
5901         comp_a(jaro1)= aer(iaro1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5902         comp_a(jaro2)= aer(iaro2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5903         comp_a(jalk1)= aer(ialk1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5904         comp_a(jole1)= aer(iole1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5905         comp_a(japi1)= aer(iapi1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5906         comp_a(japi2)= aer(iapi2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5907         comp_a(jlim1)= aer(ilim1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5908         comp_a(jlim2)= aer(ilim2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15    ! g/cc(air)
5909         comp_a(jh2o) = water_a(ibin)*1.e-3                              ! g/cc(air)
5910
5911         ri_dum = (0.0,0.0)
5912         do jc = 1, naercomp
5913           ri_dum = ri_dum + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
5914         enddo
5915
5916         ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
5917
5918       else      ! use defaults
5919
5920         dens_dry_a(ibin) = 1.0   ! g/cc(aerosol)
5921         dens_wet_a(ibin) = 1.0   ! g/cc(aerosol)
5922
5923         call isize_itype_from_ibin( ibin, isize, itype )
5924         dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
5925         dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
5926
5927         ri_avg_a(ibin) = (1.5,0.0)
5928       endif
5929
5930
5931       return
5932       end subroutine calc_dry_n_wet_aerosol_props
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953 !***********************************************************************
5954 ! computes activities
5955 !
5956 ! author: rahul a. zaveri
5957 ! update: jan 2005
5958 !-----------------------------------------------------------------------
5959       subroutine compute_activities(ibin)
5960 !     implicit none
5961 !     include 'mosaic.h'
5962 ! subr arguments
5963       integer ibin
5964 ! local variables
5965       integer jp, ja
5966       real(kind=8) xt, xmol(nelectrolyte), sum_elec, dumK, c_bal, a_c
5967       real(kind=8) quad, aq, bq, cq, xq, dum
5968 ! function
5969 !     real(kind=8) aerosol_water
5970
5971
5972       water_a(ibin) = aerosol_water(jliquid,ibin)       ! kg/m^3(air)
5973       if(water_a(ibin) .eq. 0.0)return
5974
5975
5976       call calculate_xt(ibin,jliquid,xt)
5977
5978       if(xt.gt.2.0 .or. xt.lt.0.)then
5979 ! sulfate poor: fully dissociated electrolytes
5980
5981
5982 ! anion molalities (mol/kg water)
5983       ma(ja_so4,ibin)  = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
5984       ma(ja_hso4,ibin) = 0.0
5985       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5986       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5987       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
5988
5989 ! cation molalities (mol/kg water)
5990       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5991       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5992       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5993       a_c              = ( 2.d0*ma(ja_so4,ibin)+  &
5994                                 ma(ja_no3,ibin)+  &
5995                                 ma(ja_cl,ibin) +  &
5996                                 ma(ja_msa,ibin) ) - &
5997                          ( 2.d0*mc(jc_ca,ibin) +  &
5998                                 mc(jc_nh4,ibin)+  &
5999                                 mc(jc_na,ibin) )
6000       mc(jc_h,ibin) = 0.5*a_c + sqrt(a_c**2 + 4.*Keq_ll(3))
6001
6002       if(mc(jc_h,ibin) .eq. 0.0)then
6003         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6004       endif
6005
6006
6007       jp = jliquid
6008
6009
6010       sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) +  &
6011                  2.*electrolyte(jnh4cl,jp,ibin)  +  &
6012                  3.*electrolyte(jnh4so4,jp,ibin) +  &
6013                  3.*electrolyte(jna2so4,jp,ibin) +  &
6014                  2.*electrolyte(jnano3,jp,ibin)  +  &
6015                  2.*electrolyte(jnacl,jp,ibin)   +  &
6016                  3.*electrolyte(jcano3,jp,ibin)  +  &
6017                  3.*electrolyte(jcacl2,jp,ibin)  +  &
6018                  2.*electrolyte(jhno3,jp,ibin)   +  &
6019                  2.*electrolyte(jhcl,jp,ibin)
6020
6021       if(sum_elec .eq. 0.0)then
6022         do ja = 1, nelectrolyte
6023           gam(ja,ibin) = 1.0
6024         enddo
6025         goto 10
6026       endif
6027
6028
6029 ! ionic mole fractions
6030       xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
6031       xmol(jnh4cl)  = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
6032       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6033       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6034       xmol(jnano3)  = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
6035       xmol(jnacl)   = 2.*electrolyte(jnacl,jp,ibin)  /sum_elec
6036       xmol(jcano3)  = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
6037       xmol(jcacl2)  = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
6038       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)  /sum_elec
6039       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)   /sum_elec
6040
6041
6042       ja = jnh4so4
6043       if(xmol(ja).gt.0.0)then
6044       log_gam(ja) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6045                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6046                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6047                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6048                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6049                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6050                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6051                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6052                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6053                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6054       gam(jA,ibin) = 10.**log_gam(jA)
6055       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6056                                gam(jnh4so4,ibin)**3
6057       endif
6058
6059
6060
6061       jA = jnh4no3
6062       if(xmol(jA).gt.0.0)then
6063       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6064                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6065                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6066                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6067                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6068                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6069                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6070                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6071                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6072                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6073       gam(jA,ibin) = 10.**log_gam(jA)
6074       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
6075                                gam(jnh4no3,ibin)**2
6076       endif
6077
6078
6079       jA = jnh4cl
6080       if(xmol(jA).gt.0.0)then
6081       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6082                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6083                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6084                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6085                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6086                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6087                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6088                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6089                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6090                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6091       gam(jA,ibin) = 10.**log_gam(jA)
6092       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin)* &
6093                                gam(jnh4cl,ibin)**2
6094       endif
6095
6096
6097       jA = jna2so4
6098       if(xmol(jA).gt.0.0)then
6099       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6100                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6101                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6102                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6103                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6104                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6105                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6106                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6107                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6108                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6109       gam(jA,ibin) = 10.**log_gam(jA)
6110       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6111                                gam(jna2so4,ibin)**3
6112       endif
6113
6114
6115       jA = jnano3
6116       if(xmol(jA).gt.0.0)then
6117       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6118                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6119                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6120                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6121                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6122                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6123                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6124                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6125                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6126                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6127       gam(jA,ibin) = 10.**log_gam(jA)
6128       activity(jnano3,ibin)  = mc(jc_na,ibin)*ma(ja_no3,ibin)* &
6129                                gam(jnano3,ibin)**2
6130       endif
6131
6132
6133
6134       jA = jnacl
6135       if(xmol(jA).gt.0.0)then
6136       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6137                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6138                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6139                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6140                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6141                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6142                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6143                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6144                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6145                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6146       gam(jA,ibin) = 10.**log_gam(jA)
6147       activity(jnacl,ibin)   = mc(jc_na,ibin)*ma(ja_cl,ibin)* &
6148                                gam(jnacl,ibin)**2
6149       endif
6150
6151
6152
6153 !      jA = jcano3
6154 !      if(xmol(jA).gt.0.0)then
6155 !      gam(jA,ibin) = 1.0
6156 !      activity(jcano3,ibin)  = 1.0
6157 !      endif
6158
6159
6160
6161 !      jA = jcacl2
6162 !      if(xmol(jA).gt.0.0)then
6163 !      gam(jA,ibin) = 1.0
6164 !      activity(jcacl2,ibin)  = 1.0
6165 !      endif
6166
6167       jA = jcano3
6168       if(xmol(jA).gt.0.0)then
6169       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6170                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6171                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6172                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6173                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6174                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6175                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6176                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6177                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6178                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6179       gam(jA,ibin) = 10.**log_gam(jA)
6180       activity(jcano3,ibin)  = mc(jc_ca,ibin)*ma(ja_no3,ibin)**2* &
6181                                gam(jcano3,ibin)**3
6182       endif
6183
6184
6185
6186       jA = jcacl2
6187       if(xmol(jA).gt.0.0)then
6188       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6189                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6190                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6191                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6192                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6193                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6194                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6195                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6196                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6197                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6198       gam(jA,ibin) = 10.**log_gam(jA)
6199       activity(jcacl2,ibin)  = mc(jc_ca,ibin)*ma(ja_cl,ibin)**2* &
6200                                gam(jcacl2,ibin)**3
6201       endif
6202
6203
6204       jA = jhno3
6205       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6206                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6207                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6208                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6209                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6210                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6211                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6212                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6213                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6214                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6215       gam(jA,ibin) = 10.**log_gam(jA)
6216       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6217                                gam(jhno3,ibin)**2
6218
6219
6220       jA = jhcl
6221       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
6222                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
6223                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
6224                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
6225                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
6226                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
6227                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
6228                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
6229                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
6230                     xmol(jhcl)   *log_gamZ(jA,jhcl)
6231       gam(jA,ibin) = 10.**log_gam(jA)
6232       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6233                                gam(jhcl,ibin)**2
6234
6235 !----
6236 10    gam(jlvcite,ibin) = 1.0
6237
6238       gam(jnh4hso4,ibin)= 1.0
6239
6240       gam(jnh4msa,ibin) = 1.0
6241
6242       gam(jna3hso4,ibin) = 1.0
6243
6244       gam(jnahso4,ibin) = 1.0
6245
6246       gam(jnamsa,ibin)  = 1.0
6247
6248       activity(jlvcite,ibin) = 0.0
6249
6250       activity(jnh4hso4,ibin)= 0.0
6251
6252       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6253                                gam(jnh4msa,ibin)**2
6254
6255       activity(jna3hso4,ibin)= 0.0
6256
6257       activity(jnahso4,ibin) = 0.0
6258
6259       activity(jnh4msa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
6260                                gam(jnamsa,ibin)**2
6261
6262       gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
6263
6264
6265       else
6266 !  SULFATE-RICH: solve for SO4= and HSO4- ions
6267
6268       jp = jliquid
6269
6270       sum_elec = 3.*electrolyte(jh2so4,jp,ibin)    +  &
6271                  2.*electrolyte(jnh4hso4,jp,ibin)  +  &
6272                  5.*electrolyte(jlvcite,jp,ibin)   +  &
6273                  3.*electrolyte(jnh4so4,jp,ibin)   +  &
6274                  2.*electrolyte(jnahso4,jp,ibin)   +  &
6275                  5.*electrolyte(jna3hso4,jp,ibin)  +  &
6276                  3.*electrolyte(jna2so4,jp,ibin)   +  &
6277                  2.*electrolyte(jhno3,jp,ibin)     +  &
6278                  2.*electrolyte(jhcl,jp,ibin)
6279
6280
6281       if(sum_elec .eq. 0.0)then
6282         do jA = 1, nelectrolyte
6283           gam(jA,ibin) = 1.0
6284         enddo
6285         goto 20
6286       endif
6287
6288
6289       xmol(jh2so4)  = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
6290       xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
6291       xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
6292       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
6293       xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
6294       xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
6295       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
6296       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
6297       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
6298
6299
6300 ! 2H.SO4
6301       jA = jh2so4
6302       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6303                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6304                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6305                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6306                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6307                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6308                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6309                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6310                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6311       gam(jA,ibin) = 10.**log_gam(jA)
6312
6313
6314 ! H.HSO4
6315       jA = jhhso4
6316       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6317                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6318                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6319                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6320                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6321                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6322                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6323                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6324                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6325       gam(jA,ibin) = 10.**log_gam(jA)
6326
6327
6328 ! NH4HSO4
6329       jA = jnh4hso4
6330       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6331                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6332                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6333                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6334                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6335                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6336                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6337                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6338                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6339       gam(jA,ibin) = 10.**log_gam(jA)
6340
6341
6342 ! LETOVICITE
6343       jA = jlvcite
6344       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6345                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6346                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6347                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6348                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6349                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6350                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6351                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6352                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6353       gam(jA,ibin) = 10.**log_gam(jA)
6354
6355
6356 ! (NH4)2SO4
6357       jA = jnh4so4
6358       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6359                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6360                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6361                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6362                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6363                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6364                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6365                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6366                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6367       gam(jA,ibin) = 10.**log_gam(jA)
6368
6369
6370 ! NaHSO4
6371       jA = jnahso4
6372       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6373                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6374                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6375                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6376                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6377                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6378                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6379                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6380                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6381       gam(jA,ibin) = 10.**log_gam(jA)
6382
6383
6384 ! Na3H(SO4)2
6385       jA = jna3hso4
6386 !      log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6387 !                    xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6388 !                    xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6389 !                    xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6390 !                    xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6391 !                    xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6392 !                    xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6393 !                    xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6394 !                    xmol(jhcl)    *log_gamZ(jA,jhcl)
6395 !      gam(jA,ibin) = 10.**log_gam(jA)
6396       gam(jA,ibin) = 1.0
6397
6398
6399 ! Na2SO4
6400       jA = jna2so4
6401       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6402                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6403                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6404                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6405                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6406                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6407                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6408                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6409                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6410       gam(jA,ibin) = 10.**log_gam(jA)
6411
6412
6413 ! HNO3
6414       jA = jhno3
6415       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6416                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6417                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6418                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6419                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6420                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6421                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6422                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6423                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6424       gam(jA,ibin) = 10.**log_gam(jA)
6425
6426
6427 ! HCl
6428       jA = jhcl
6429       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
6430                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
6431                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
6432                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
6433                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
6434                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
6435                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
6436                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
6437                     xmol(jhcl)    *log_gamZ(jA,jhcl)
6438       gam(jA,ibin) = 10.**log_gam(jA)
6439
6440
6441 20    gam(jnh4no3,ibin) = 1.0
6442       gam(jnh4cl,ibin)  = 1.0
6443       gam(jnano3,ibin)  = 1.0
6444       gam(jnacl,ibin)   = 1.0
6445       gam(jcano3,ibin)  = 1.0
6446       gam(jcacl2,ibin)  = 1.0
6447
6448       gam(jnh4msa,ibin) = 1.0
6449       gam(jnamsa,ibin)  = 1.0
6450
6451
6452
6453 ! compute equilibrium pH
6454 ! cation molalities (mol/kg water)
6455       mc(jc_ca,ibin)   = 0.0    ! aqueous ca never exists in sulfate rich cases
6456       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
6457       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
6458
6459 ! anion molalities (mol/kg water)
6460       mSULF            = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
6461       ma(ja_hso4,ibin) = 0.0
6462       ma(ja_so4,ibin)  = 0.0
6463       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
6464       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
6465       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
6466
6467       gam_ratio(ibin)  = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
6468       dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
6469
6470       c_bal =  mc(jc_nh4,ibin) + mc(jc_na,ibin)  &
6471          - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
6472
6473       aq = 1.0
6474       bq = dumK + c_bal
6475       cq = dumK*(c_bal - mSULF)
6476
6477
6478 !--quadratic solution
6479         if(bq .ne. 0.0)then
6480         xq = 4.*(1./bq)*(cq/bq)
6481         else
6482         xq = 1.e+6
6483         endif
6484
6485         if(abs(xq) .lt. 1.e-6)then
6486           dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
6487           quad = (-0.5*bq/aq)*dum
6488           if(quad .lt. 0.)then
6489             quad = -bq/aq - quad
6490           endif
6491         else
6492           quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
6493         endif
6494 !--end of quadratic solution
6495
6496       mc(jc_h,ibin) = max(quad, 1.D-7)
6497       ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
6498       ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
6499
6500
6501       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
6502                                gam(jnh4so4,ibin)**3
6503
6504       activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3*ma(ja_hso4,ibin)* &
6505                                ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
6506
6507       activity(jnh4hso4,ibin)= mc(jc_nh4,ibin)*ma(ja_hso4,ibin)* &
6508                                gam(jnh4hso4,ibin)**2
6509
6510       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
6511                                gam(jnh4msa,ibin)**2
6512
6513       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
6514                                gam(jna2so4,ibin)**3
6515
6516       activity(jnahso4,ibin) = mc(jc_na,ibin)*ma(ja_hso4,ibin)* &
6517                                gam(jnahso4,ibin)**2
6518
6519       activity(jnamsa,ibin)  = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
6520                                gam(jnamsa,ibin)**2
6521
6522 !      activity(jna3hso4,ibin)= mc(jc_na,ibin)**3*ma(ja_hso4,ibin)* &
6523 !                               ma(ja_so4,ibin)*gam(jna3hso4,ibin)**5
6524
6525       activity(jna3hso4,ibin)= 0.0
6526
6527       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
6528                                gam(jhno3,ibin)**2
6529
6530       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
6531                                gam(jhcl,ibin)**2
6532
6533       activity(jmsa,ibin)    = mc(jc_h,ibin)*ma(ja_msa,ibin)* &
6534                                gam(jmsa,ibin)**2
6535
6536
6537 ! sulfate-poor species
6538       activity(jnh4no3,ibin) = 0.0
6539
6540       activity(jnh4cl,ibin)  = 0.0
6541
6542       activity(jnano3,ibin)  = 0.0
6543
6544       activity(jnacl,ibin)   = 0.0
6545
6546       activity(jcano3,ibin)  = 0.0
6547
6548       activity(jcacl2,ibin)  = 0.0
6549
6550
6551       endif
6552
6553
6554
6555
6556       return
6557       end subroutine compute_activities
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570 !***********************************************************************
6571 ! computes mtem ternary parameters only once per transport time-step
6572 ! for a given ah2o (= rh)
6573 !
6574 ! author: rahul a. zaveri
6575 ! update: jan 2005
6576 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
6577 ! a new method for multicomponent activity coefficients of electrolytes
6578 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
6579 !-----------------------------------------------------------------------
6580       subroutine mtem_compute_log_gamz
6581 !     implicit none
6582 !     include 'mosaic.h'
6583 ! local variables
6584       integer ja
6585 ! functions
6586 !     real(kind=8) fnlog_gamz, bin_molality
6587
6588
6589 ! sulfate-poor species
6590       ja = jhno3
6591       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6592       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6593       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6594       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6595       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6596       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6597       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6598       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6599       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6600       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6601       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6602       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6603       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6604       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6605       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6606
6607
6608       ja = jhcl
6609       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6610       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6611       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6612       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6613       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6614       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6615       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6616       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6617       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6618       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6619       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6620       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6621       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6622       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6623       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6624
6625
6626       ja = jnh4so4
6627       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6628       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6629       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6630       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6631       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6632       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6633       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6634       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6635       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6636       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6637       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6638       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6639       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6640       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6641       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6642
6643
6644       ja = jnh4no3
6645       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6646       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6647       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6648       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6649       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6650       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6651       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6652       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6653       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6654       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6655
6656
6657       ja = jnh4cl
6658       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6659       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6660       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6661       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6662       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6663       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6664       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6665       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6666       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6667       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6668
6669
6670       ja = jna2so4
6671       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6672       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6673       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6674       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6675       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6676       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6677       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6678       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6679       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6680       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6681       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6682       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6683       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6684       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6685       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6686
6687
6688       ja = jnano3
6689       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6690       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6691       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6692       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6693       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6694       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6695       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6696       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6697       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6698       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6699
6700
6701       ja = jnacl
6702       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6703       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6704       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6705       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6706       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6707       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6708       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6709       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6710       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6711       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6712
6713
6714       ja = jcano3
6715       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6716       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6717       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6718       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6719       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6720       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6721       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6722       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6723       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6724       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6725
6726
6727       ja = jcacl2
6728       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6729       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
6730       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
6731       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6732       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
6733       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
6734       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
6735       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
6736       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6737       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6738
6739
6740 ! sulfate-rich species
6741       ja = jh2so4
6742       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6743       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6744       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6745       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6746       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6747       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6748       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6749       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6750       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6751
6752
6753       ja = jhhso4
6754       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6755       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6756       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6757       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6758       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6759       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6760       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6761       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6762       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6763
6764
6765       ja = jnh4hso4
6766       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6767       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6768       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6769       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6770       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6771       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6772       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6773       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6774       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6775
6776
6777       ja = jlvcite
6778       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6779       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6780       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6781       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6782       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6783       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6784       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6785       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6786       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6787
6788
6789       ja = jnahso4
6790       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6791       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6792       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6793       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6794       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6795       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6796       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6797       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6798       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6799
6800
6801       ja = jna3hso4
6802       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
6803       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
6804       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
6805       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
6806       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
6807       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
6808       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
6809       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
6810       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
6811
6812       return
6813       end subroutine mtem_compute_log_gamz
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842 !***********************************************************************
6843 ! computes sulfate ratio
6844 !
6845 ! author: rahul a. zaveri
6846 ! update: dec 1999
6847 !-----------------------------------------------------------------------
6848       subroutine calculate_xt(ibin,jp,xt)
6849 !     implicit none
6850 !     include 'mosaic.h'
6851 ! subr arguments
6852       integer ibin, jp
6853       real(kind=8) xt
6854
6855
6856       if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
6857         xt   = ( aer(inh4_a,jp,ibin) +   &
6858      &           aer(ina_a,jp,ibin)  +   &
6859      &        2.*aer(ica_a,jp,ibin) )/   &
6860      &         (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
6861       else
6862         xt   = -1.0
6863       endif
6864
6865
6866       return
6867       end subroutine calculate_xt
6868
6869
6870
6871
6872
6873 !***********************************************************************
6874 ! computes ions from electrolytes
6875 !
6876 ! author: rahul a. zaveri
6877 ! update: jan 2005
6878 !-----------------------------------------------------------------------
6879       subroutine electrolytes_to_ions(jp,ibin)
6880 !     implicit none
6881 !     include 'mosaic.h'
6882 ! subr arguments
6883       integer jp, ibin
6884 ! local variables
6885       real(kind=8) sum_dum
6886
6887
6888       aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
6889                             electrolyte(jna2so4,jp,ibin) +   &
6890                          2.*electrolyte(jna3hso4,jp,ibin)+   &
6891                             electrolyte(jnahso4,jp,ibin) +   &
6892                             electrolyte(jnh4so4,jp,ibin) +   &
6893                          2.*electrolyte(jlvcite,jp,ibin) +   &
6894                             electrolyte(jnh4hso4,jp,ibin)+   &
6895                             electrolyte(jh2so4,jp,ibin)
6896
6897       aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
6898                          2.*electrolyte(jcano3,jp,ibin)  +   &
6899                             electrolyte(jnh4no3,jp,ibin) +   &
6900                             electrolyte(jhno3,jp,ibin)
6901
6902       aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
6903                          2.*electrolyte(jcacl2,jp,ibin)  +   &
6904                             electrolyte(jnh4cl,jp,ibin)  +   &
6905                             electrolyte(jhcl,jp,ibin)
6906
6907       aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) +   &
6908                             electrolyte(jnamsa,jp,ibin)  +   &
6909                          2.*electrolyte(jcamsa2,jp,ibin) +   &
6910                             electrolyte(jmsa,jp,ibin)
6911
6912       aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
6913
6914       aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
6915                             electrolyte(jcano3,jp,ibin)  +   &
6916                             electrolyte(jcacl2,jp,ibin)  +   &
6917                             electrolyte(jcaco3,jp,ibin)  +   &
6918                             electrolyte(jcamsa2,jp,ibin)
6919
6920       aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
6921                             electrolyte(jnacl,jp,ibin)   +   &
6922                          2.*electrolyte(jna2so4,jp,ibin) +   &
6923                          3.*electrolyte(jna3hso4,jp,ibin)+   &
6924                             electrolyte(jnahso4,jp,ibin) +   &
6925                             electrolyte(jnamsa,jp,ibin)
6926
6927       aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
6928                             electrolyte(jnh4cl,jp,ibin)  +   &
6929                          2.*electrolyte(jnh4so4,jp,ibin) +   &
6930                          3.*electrolyte(jlvcite,jp,ibin) +   &
6931                             electrolyte(jnh4hso4,jp,ibin)+   &
6932                             electrolyte(jnh4msa,jp,ibin)
6933
6934
6935       sum_dum = aer(ica_a,jp,ibin) +   &
6936                 aer(ina_a,jp,ibin) +   &
6937                 aer(inh4_a,jp,ibin)+   &
6938                 aer(iso4_a,jp,ibin)+   &
6939                 aer(ino3_a,jp,ibin)+   &
6940                 aer(icl_a,jp,ibin) +   &
6941                 aer(imsa_a,jp,ibin)+   &
6942                 aer(ico3_a,jp,ibin)
6943
6944       if(sum_dum .eq. 0.)sum_dum = 1.0
6945       aer_sum(jp,ibin) = sum_dum
6946
6947       aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
6948       aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
6949       aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
6950       aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
6951       aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
6952       aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
6953       aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
6954       aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
6955
6956
6957       return
6958       end subroutine electrolytes_to_ions
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969 !***********************************************************************
6970 ! combinatorial method for computing electrolytes from ions
6971 !
6972 ! notes:
6973 !  - to be used for liquid-phase or total-phase only
6974 !  - transfers caso4 and caco3 from liquid to solid phase
6975 !
6976 ! author: rahul a. zaveri (based on code provided by a.s. wexler
6977 ! update: apr 2005
6978 !-----------------------------------------------------------------------
6979       subroutine ions_to_electrolytes(jp,ibin,xt)
6980 !     implicit none
6981 !     include 'mosaic.h'
6982 ! subr arguments
6983       integer ibin, jp
6984       real(kind=8) xt
6985 ! local variables
6986       integer iaer, je, jc, ja, icase
6987       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
6988            f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
6989       real(kind=8) nc(ncation), na(nanion)
6990
6991
6992
6993
6994       if(jp .ne. jliquid)then
6995         if (iprint_mosaic_fe1 .gt. 0) then
6996           write(6,*)' jp must be jliquid'
6997           write(6,*)' in ions_to_electrolytes sub'
6998           write(6,*)' wrong jp = ', jp
6999           write(6,*)' mosaic fatal error in ions_to_electrolytes'
7000         endif
7001 !       stop
7002         istat_mosaic_fe1 = -2000
7003         return
7004       endif
7005
7006 ! remove negative concentrations, if any
7007       do iaer = 1, naer
7008       aer(iaer,jp,ibin) = max(0.0D0, aer(iaer,jp,ibin))
7009       enddo
7010
7011
7012 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
7013       store(ica_a)  = aer(ica_a, jp,ibin)
7014       store(iso4_a) = aer(iso4_a,jp,ibin)
7015
7016       call form_caso4(store,jp,ibin)
7017
7018       if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
7019         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) -   &
7020                                   electrolyte(jcaso4,jliquid,ibin)
7021
7022         aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)-   &
7023                                   electrolyte(jcaso4,jliquid,ibin)
7024
7025         aer(ica_a,jsolid,ibin)  = aer(ica_a,jsolid,ibin) +   &
7026                                   electrolyte(jcaso4,jliquid,ibin)
7027
7028         aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) +   &
7029                                   electrolyte(jcaso4,jliquid,ibin)
7030
7031         electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
7032                                        +electrolyte(jcaso4,jliquid,ibin)
7033         electrolyte(jcaso4,jliquid,ibin)= 0.0
7034       endif
7035
7036
7037 ! calculate sulfate ratio
7038       call calculate_xt(ibin,jp,xt)
7039
7040       if(xt .ge. 1.9999 .or. xt.lt.0.)then
7041        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
7042       else
7043        icase = 2        ! acidic (acidity is caused by excess so4)
7044       endif
7045
7046
7047 ! initialize to zero
7048       do je = 1, nelectrolyte
7049         electrolyte(je,jp,ibin) = 0.0
7050       enddo
7051 !
7052 !---------------------------------------------------------
7053 ! initialize moles of ions depending on the sulfate domain
7054
7055       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
7056
7057         na(ja_hso4)= 0.0
7058         na(ja_so4) = aer(iso4_a,jp,ibin)
7059         na(ja_no3) = aer(ino3_a,jp,ibin)
7060         na(ja_cl)  = aer(icl_a, jp,ibin)
7061         na(ja_msa) = aer(imsa_a,jp,ibin)
7062
7063         nc(jc_ca)  = aer(ica_a, jp,ibin)
7064         nc(jc_na)  = aer(ina_a, jp,ibin)
7065         nc(jc_nh4) = aer(inh4_a,jp,ibin)
7066
7067         cat_net =&
7068                  ( 2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) )- &
7069                  ( 2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
7070
7071         if(cat_net .lt. 0.0)then
7072
7073           nc(jc_h) = 0.0
7074
7075         else  ! cat_net must be 0.0 or positive
7076
7077           nc(jc_h) = cat_net
7078
7079         endif
7080
7081
7082 ! now compute equivalent fractions
7083       sum_naza = 0.0
7084       do ja = 1, nanion
7085         sum_naza = sum_naza + na(ja)*za(ja)
7086       enddo
7087
7088       sum_nczc = 0.0
7089       do jc = 1, ncation
7090         sum_nczc = sum_nczc + nc(jc)*zc(jc)
7091       enddo
7092
7093       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
7094         if (iprint_mosaic_diag1 .gt. 0) then
7095           write(6,*)'mosaic ions_to_electrolytes'
7096           write(6,*)'ionic concentrations are zero'
7097           write(6,*)'sum_naza = ', sum_naza
7098           write(6,*)'sum_nczc = ', sum_nczc
7099         endif
7100         return
7101       endif
7102
7103       do ja = 1, nanion
7104         xeq_a(ja) = na(ja)*za(ja)/sum_naza
7105       enddo
7106
7107       do jc = 1, ncation
7108         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
7109       enddo
7110
7111       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
7112       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
7113       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
7114       na_ma(ja_msa) = na(ja_msa) *mw_a(ja_msa)
7115       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
7116
7117       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
7118       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
7119       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
7120       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
7121
7122
7123 ! now compute electrolyte moles
7124       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7125         electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
7126                                         xeq_a(ja_so4)*nc_mc(jc_na))/  &
7127                                          mw_electrolyte(jna2so4)
7128       endif
7129
7130       electrolyte(jnahso4,jp,ibin) = 0.0
7131
7132       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7133         electrolyte(jnamsa,jp,ibin)  = (xeq_c(jc_na) *na_Ma(ja_msa) + &
7134                                         xeq_a(ja_msa)*nc_Mc(jc_na))/  &
7135                                          mw_electrolyte(jnamsa)
7136       endif
7137
7138       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7139         electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
7140                                         xeq_a(ja_no3)*nc_mc(jc_na))/  &
7141                                          mw_electrolyte(jnano3)
7142       endif
7143
7144       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7145         electrolyte(jnacl,  jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) +  &
7146                                         xeq_a(ja_cl) *nc_mc(jc_na))/  &
7147                                          mw_electrolyte(jnacl)
7148       endif
7149
7150       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
7151         electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
7152                                         xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
7153                                          mw_electrolyte(jnh4so4)
7154       endif
7155
7156       electrolyte(jnh4hso4,jp,ibin)= 0.0
7157
7158       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7159         electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) + &
7160                                         xeq_a(ja_msa)*nc_Mc(jc_nh4))/ &
7161                                          mw_electrolyte(jnh4msa)
7162       endif
7163
7164       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7165         electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
7166                                         xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
7167                                          mw_electrolyte(jnh4no3)
7168       endif
7169
7170       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7171         electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) +  &
7172                                         xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
7173                                          mw_electrolyte(jnh4cl)
7174       endif
7175
7176       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
7177         electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
7178                                         xeq_a(ja_no3)*nc_mc(jc_ca))/  &
7179                                          mw_electrolyte(jcano3)
7180       endif
7181
7182       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7183         electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) +  &
7184                                         xeq_a(ja_cl) *nc_mc(jc_ca))/  &
7185                                          mw_electrolyte(jcacl2)
7186       endif
7187
7188       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7189         electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) + &
7190                                         xeq_a(ja_msa) *nc_Mc(jc_ca))/ &
7191                                          mw_electrolyte(jcamsa2)
7192       endif
7193
7194       electrolyte(jh2so4, jp,ibin) = 0.0
7195
7196       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
7197       electrolyte(jhno3,  jp,ibin) = (xeq_c(jc_h)  *na_ma(ja_no3) +   &
7198                                       xeq_a(ja_no3)*nc_mc(jc_h))/     &
7199                                        mw_electrolyte(jhno3)
7200       endif
7201
7202       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
7203         electrolyte(jhcl,   jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) +   &
7204                                         xeq_a(ja_cl)*nc_mc(jc_h))/    &
7205                                          mw_electrolyte(jhcl)
7206       endif
7207
7208       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
7209         electrolyte(jmsa,jp,ibin)    = (xeq_c(jc_h) *na_ma(ja_msa) +  &
7210                                         xeq_a(ja_msa)*nc_mc(jc_h))/   &
7211                                          mw_electrolyte(jmsa)
7212       endif
7213
7214 !--------------------------------------------------------------------
7215
7216       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
7217
7218         store(imsa_a) = aer(imsa_a,jp,ibin)
7219         store(ica_a)  = aer(ica_a, jp,ibin)
7220
7221         call form_camsa2(store,jp,ibin)
7222
7223         sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
7224
7225         if(sum_na_nh4 .gt. 0.0)then
7226           f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
7227           f_na  = aer(ina_a,jp,ibin)/sum_na_nh4
7228         else
7229           f_nh4 = 0.0
7230           f_na  = 0.0
7231         endif
7232
7233 ! first form msa electrolytes
7234         if(sum_na_nh4 .gt. store(imsa_a))then
7235           electrolyte(jnamsa,jp,ibin)  = f_na *store(imsa_a)
7236           electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
7237           rem_na = aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin)  ! remaining na
7238           rem_nh4= aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin) ! remaining nh4
7239         else
7240           electrolyte(jnamsa,jp,ibin)  = aer(ina_a,jp,ibin)
7241           electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
7242           electrolyte(jmsa,jp,ibin)    = store(imsa_a) - sum_na_nh4
7243           rem_nh4 = 0.0  ! remaining nh4
7244           rem_na  = 0.0  ! remaining na
7245         endif
7246
7247
7248 ! recompute xt
7249         if(aer(iso4_a,jp,ibin).gt.0.0)then
7250           xt = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
7251         else
7252           goto 10
7253         endif
7254
7255         if(xt .le. 1.0)then     ! h2so4 + bisulfate
7256           xh = (1.0 - xt)
7257           xb = xt
7258           electrolyte(jh2so4,jp,ibin)   = xh*aer(iso4_a,jp,ibin)
7259           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7260           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
7261         elseif(xt .le. 1.5)then ! bisulfate + letovicite
7262           xb = 3.0 - 2.0*xt
7263           xl = xt - 1.0
7264           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
7265           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
7266           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
7267           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7268         else                    ! letovicite + sulfate
7269           xl = 2.0 - xt
7270           xs = 2.0*xt - 3.0
7271           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
7272           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
7273           electrolyte(jnh4so4,jp,ibin)  = xs*f_nh4*aer(iso4_a,jp,ibin)
7274           electrolyte(jna2so4,jp,ibin)  = xs*f_na *aer(iso4_a,jp,ibin)
7275         endif
7276
7277         electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
7278         electrolyte(jhcl,jp,ibin)  = aer(icl_a,jp,ibin)
7279
7280       endif
7281 !---------------------------------------------------------
7282 !
7283 ! calculate % composition
7284 10    sum_dum = 0.0
7285       do je = 1, nelectrolyte
7286         sum_dum = sum_dum + electrolyte(je,jp,ibin)
7287       enddo
7288
7289       if(sum_dum .eq. 0.)sum_dum = 1.0
7290       electrolyte_sum(jp,ibin) = sum_dum
7291
7292       do je = 1, nelectrolyte
7293         epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7294       enddo
7295
7296       sum_dum = aer(ica_a,jp,ibin) +   &
7297                 aer(ina_a,jp,ibin) +   &
7298                 aer(inh4_a,jp,ibin)+   &
7299                 aer(iso4_a,jp,ibin)+   &
7300                 aer(ino3_a,jp,ibin)+   &
7301                 aer(icl_a,jp,ibin) +   &
7302                 aer(imsa_a,jp,ibin)+   &
7303                 aer(ico3_a,jp,ibin)
7304
7305       if(sum_dum .eq. 0.)sum_dum = 1.0
7306       aer_sum(jp,ibin) = sum_dum
7307
7308       aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7309       aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7310       aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7311       aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7312       aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7313       aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7314       aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7315       aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7316
7317
7318
7319       return
7320       end subroutine ions_to_electrolytes
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348 !***********************************************************************
7349 ! conforms aerosol generic species to a valid electrolyte composition
7350 !
7351 ! author: rahul a. zaveri
7352 ! update: june 2000
7353 !-----------------------------------------------------------------------
7354       subroutine conform_electrolytes(jp,ibin,xt)
7355 !     implicit none
7356 !     include 'mosaic.h'
7357 ! subr arguments
7358       integer ibin, jp
7359       real(kind=8) xt
7360 ! local variables
7361       integer i, ixt_case, je
7362       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7363       real(kind=8) store(naer)
7364
7365 ! remove negative concentrations, if any
7366       do i=1,naer
7367       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7368       enddo
7369
7370
7371       call calculate_xt(ibin,jp,xt)
7372
7373       if(xt .ge. 1.9999 .or. xt.lt.0.)then
7374        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
7375       else
7376        ixt_case = 2     ! acidic (acidity is caused by excess so4)
7377       endif
7378
7379 ! initialize
7380 !
7381 ! put total aer(*) into store(*)
7382       store(iso4_a) = aer(iso4_a,jp,ibin)
7383       store(ino3_a) = aer(ino3_a,jp,ibin)
7384       store(icl_a)  = aer(icl_a, jp,ibin)
7385       store(imsa_a) = aer(imsa_a,jp,ibin)
7386       store(ico3_a) = aer(ico3_a,jp,ibin)
7387       store(inh4_a) = aer(inh4_a,jp,ibin)
7388       store(ina_a)  = aer(ina_a, jp,ibin)
7389       store(ica_a)  = aer(ica_a, jp,ibin)
7390
7391       do je=1,nelectrolyte
7392       electrolyte(je,jp,ibin) = 0.0
7393       enddo
7394 !
7395 !---------------------------------------------------------
7396 !
7397       if(ixt_case.eq.1)then
7398
7399 ! xt >= 2   : sulfate deficient
7400
7401         call form_caso4(store,jp,ibin)
7402         call form_camsa2(store,jp,ibin)
7403         call form_na2so4(store,jp,ibin)
7404         call form_namsa(store,jp,ibin)
7405         call form_cano3(store,jp,ibin)
7406         call form_nano3(store,jp,ibin)
7407         call form_nacl(store,jp,ibin)
7408         call form_cacl2(store,jp,ibin)
7409         call form_caco3(store,jp,ibin)
7410         call form_nh4so4(store,jp,ibin)
7411         call form_nh4msa(store,jp,ibin)
7412         call form_nh4no3(store,jp,ibin)
7413         call form_nh4cl(store,jp,ibin)
7414         call form_msa(store,jp,ibin)
7415         call degas_hno3(store,jp,ibin)
7416         call degas_hcl(store,jp,ibin)
7417         call degas_nh3(store,jp,ibin)
7418
7419       elseif(ixt_case.eq.2)then
7420
7421 ! xt < 2   : sulfate enough or sulfate excess
7422
7423         call form_caso4(store,jp,ibin)
7424         call form_camsa2(store,jp,ibin)
7425         call form_namsa(store,jp,ibin)
7426         call form_nh4msa(store,jp,ibin)
7427         call form_msa(store,jp,ibin)
7428
7429         if(store(iso4_a).eq.0.0)goto 10
7430
7431
7432         xt_prime =(store(ina_a)+store(inh4_a))/   &
7433                         store(iso4_a)
7434         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7435
7436         if(xt_prime.ge.xna_prime)then
7437           call form_na2so4(store,jp,ibin)
7438           xnh4_prime = 0.0
7439           if(store(iso4_a).gt.1.e-15)then
7440             xnh4_prime = store(inh4_a)/store(iso4_a)
7441           endif
7442
7443           if(xnh4_prime .ge. 1.5)then
7444             call form_nh4so4_lvcite(store,jp,ibin)
7445           else
7446             call form_lvcite_nh4hso4(store,jp,ibin)
7447           endif
7448
7449         elseif(xt_prime.ge.1.)then
7450           call form_nh4hso4(store,jp,ibin)
7451           call form_na2so4_nahso4(store,jp,ibin)
7452         elseif(xt_prime.lt.1.)then
7453           call form_nahso4(store,jp,ibin)
7454           call form_nh4hso4(store,jp,ibin)
7455           call form_h2so4(store,jp,ibin)
7456         endif
7457
7458 10    call degas_hno3(store,jp,ibin)
7459       call degas_hcl(store,jp,ibin)
7460       call degas_nh3(store,jp,ibin)
7461
7462       endif ! case 1, 2
7463
7464
7465 ! re-calculate ions to eliminate round-off errors
7466       call electrolytes_to_ions(jp, ibin)
7467 !---------------------------------------------------------
7468 !
7469 ! calculate % composition
7470       sum_dum = 0.0
7471       do je = 1, nelectrolyte
7472         electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7473         sum_dum = sum_dum + electrolyte(je,jp,ibin)
7474       enddo
7475
7476       if(sum_dum .eq. 0.)sum_dum = 1.0
7477       electrolyte_sum(jp,ibin) = sum_dum
7478
7479       do je = 1, nelectrolyte
7480         epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7481       enddo
7482
7483
7484       sum_dum = aer(ica_a,jp,ibin) +   &
7485                 aer(ina_a,jp,ibin) +   &
7486                 aer(inh4_a,jp,ibin)+   &
7487                 aer(iso4_a,jp,ibin)+   &
7488                 aer(ino3_a,jp,ibin)+   &
7489                 aer(icl_a,jp,ibin) +   &
7490                 aer(imsa_a,jp,ibin)+   &
7491                 aer(ico3_a,jp,ibin)
7492
7493       if(sum_dum .eq. 0.)sum_dum = 1.0
7494       aer_sum(jp,ibin) = sum_dum
7495
7496       aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7497       aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7498       aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7499       aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7500       aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7501       aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7502       aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7503       aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7504
7505       return
7506       end subroutine conform_electrolytes
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518 !***********************************************************************
7519 ! forms electrolytes from ions
7520 !
7521 ! author: rahul a. zaveri
7522 ! update: june 2000
7523 !-----------------------------------------------------------------------
7524       subroutine form_electrolytes(jp,ibin,xt)
7525 !     implicit none
7526 !     include 'mosaic.h'
7527 ! subr arguments
7528       integer ibin, jp
7529       real(kind=8) xt
7530 ! local variables
7531       integer i, ixt_case, j, je
7532       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
7533       real(kind=8) store(naer)
7534
7535 ! remove negative concentrations, if any
7536       do i=1,naer
7537       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
7538       enddo
7539
7540
7541       call calculate_xt(ibin,jp,xt)
7542
7543       if(xt .ge. 1.9999 .or. xt.lt.0.)then
7544        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
7545       else
7546        ixt_case = 2     ! acidic (acidity is caused by excess so4)
7547       endif
7548
7549 ! initialize
7550 !
7551 ! put total aer(*) into store(*)
7552       store(iso4_a) = aer(iso4_a,jp,ibin)
7553       store(ino3_a) = aer(ino3_a,jp,ibin)
7554       store(icl_a)  = aer(icl_a, jp,ibin)
7555       store(imsa_a) = aer(imsa_a,jp,ibin)
7556       store(ico3_a) = aer(ico3_a,jp,ibin)
7557       store(inh4_a) = aer(inh4_a,jp,ibin)
7558       store(ina_a)  = aer(ina_a, jp,ibin)
7559       store(ica_a)  = aer(ica_a, jp,ibin)
7560 !
7561       do j=1,nelectrolyte
7562       electrolyte(j,jp,ibin) = 0.0
7563       enddo
7564 !
7565 !---------------------------------------------------------
7566 !
7567       if(ixt_case.eq.1)then
7568
7569 ! xt >= 2   : sulfate deficient
7570         call form_caso4(store,jp,ibin)
7571         call form_camsa2(store,jp,ibin)
7572         call form_na2so4(store,jp,ibin)
7573         call form_namsa(store,jp,ibin)
7574         call form_cano3(store,jp,ibin)
7575         call form_nano3(store,jp,ibin)
7576         call form_nacl(store,jp,ibin)
7577         call form_cacl2(store,jp,ibin)
7578         call form_caco3(store,jp,ibin)
7579         call form_nh4so4(store,jp,ibin)
7580         call form_nh4msa(store,jp,ibin)
7581         call form_nh4no3(store,jp,ibin)
7582         call form_nh4cl(store,jp,ibin)
7583         call form_msa(store,jp,ibin)
7584
7585         if(jp .eq. jsolid)then
7586           call degas_hno3(store,jp,ibin)
7587           call degas_hcl(store,jp,ibin)
7588           call degas_nh3(store,jp,ibin)
7589         else
7590           call form_hno3(store,jp,ibin)
7591           call form_hcl(store,jp,ibin)
7592           call degas_nh3(store,jp,ibin)
7593         endif
7594
7595
7596
7597       elseif(ixt_case.eq.2)then
7598
7599 ! xt < 2   : sulfate enough or sulfate excess
7600
7601         call form_caso4(store,jp,ibin)
7602         call form_camsa2(store,jp,ibin)
7603         call form_namsa(store,jp,ibin)
7604         call form_nh4msa(store,jp,ibin)
7605         call form_msa(store,jp,ibin)
7606
7607         if(store(iso4_a).eq.0.0)goto 10
7608
7609
7610         xt_prime =(store(ina_a)+store(inh4_a))/   &
7611                         store(iso4_a)
7612         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
7613
7614         if(xt_prime.ge.xna_prime)then
7615           call form_na2so4(store,jp,ibin)
7616           xnh4_prime = 0.0
7617           if(store(iso4_a).gt.1.e-15)then
7618             xnh4_prime = store(inh4_a)/store(iso4_a)
7619           endif
7620
7621           if(xnh4_prime .ge. 1.5)then
7622             call form_nh4so4_lvcite(store,jp,ibin)
7623           else
7624             call form_lvcite_nh4hso4(store,jp,ibin)
7625           endif
7626
7627         elseif(xt_prime.ge.1.)then
7628           call form_nh4hso4(store,jp,ibin)
7629           call form_na2so4_nahso4(store,jp,ibin)
7630         elseif(xt_prime.lt.1.)then
7631           call form_nahso4(store,jp,ibin)
7632           call form_nh4hso4(store,jp,ibin)
7633           call form_h2so4(store,jp,ibin)
7634         endif
7635
7636 10      if(jp .eq. jsolid)then
7637           call degas_hno3(store,jp,ibin)
7638           call degas_hcl(store,jp,ibin)
7639           call degas_nh3(store,jp,ibin)
7640         else
7641           call form_hno3(store,jp,ibin)
7642           call form_hcl(store,jp,ibin)
7643           call degas_nh3(store,jp,ibin)
7644         endif
7645
7646       endif ! case 1, 2
7647
7648
7649 ! re-calculate ions to eliminate round-off errors
7650       call electrolytes_to_ions(jp, ibin)
7651 !---------------------------------------------------------
7652 !
7653 ! calculate % composition
7654       sum_dum = 0.0
7655       do je = 1, nelectrolyte
7656         electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
7657         sum_dum = sum_dum + electrolyte(je,jp,ibin)
7658       enddo
7659
7660       if(sum_dum .eq. 0.)sum_dum = 1.0
7661       electrolyte_sum(jp,ibin) = sum_dum
7662
7663       do je = 1, nelectrolyte
7664         epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
7665       enddo
7666
7667       sum_dum = aer(ica_a,jp,ibin) +   &
7668                 aer(ina_a,jp,ibin) +   &
7669                 aer(inh4_a,jp,ibin)+   &
7670                 aer(iso4_a,jp,ibin)+   &
7671                 aer(ino3_a,jp,ibin)+   &
7672                 aer(icl_a,jp,ibin) +   &
7673                 aer(imsa_a,jp,ibin)+   &
7674                 aer(ico3_a,jp,ibin)
7675
7676       if(sum_dum .eq. 0.)sum_dum = 1.0
7677       aer_sum(jp,ibin) = sum_dum
7678
7679       aer_percent(ica_a,jp,ibin) = 100.*aer(ica_a,jp,ibin)/sum_dum
7680       aer_percent(ina_a,jp,ibin) = 100.*aer(ina_a,jp,ibin)/sum_dum
7681       aer_percent(inh4_a,jp,ibin)= 100.*aer(inh4_a,jp,ibin)/sum_dum
7682       aer_percent(iso4_a,jp,ibin)= 100.*aer(iso4_a,jp,ibin)/sum_dum
7683       aer_percent(ino3_a,jp,ibin)= 100.*aer(ino3_a,jp,ibin)/sum_dum
7684       aer_percent(icl_a,jp,ibin) = 100.*aer(icl_a,jp,ibin)/sum_dum
7685       aer_percent(imsa_a,jp,ibin)= 100.*aer(imsa_a,jp,ibin)/sum_dum
7686       aer_percent(ico3_a,jp,ibin)= 100.*aer(ico3_a,jp,ibin)/sum_dum
7687
7688       return
7689       end subroutine form_electrolytes
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704 !***********************************************************************
7705 ! electrolyte formation subroutines
7706 !
7707 ! author: rahul a. zaveri
7708 ! update: june 2000
7709 !-----------------------------------------------------------------------
7710       subroutine form_caso4(store,jp,ibin)
7711 !     implicit none
7712 !     include 'mosaic.h'
7713 ! subr arguments
7714       integer jp, ibin
7715       real(kind=8) store(naer)
7716
7717       electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
7718       store(ica_a)  = store(ica_a) - electrolyte(jcaso4,jp,ibin)
7719       store(iso4_a) = store(iso4_a) - electrolyte(jcaso4,jp,ibin)
7720       store(ica_a)  = max(0.D0, store(ica_a))
7721       store(iso4_a) = max(0.D0, store(iso4_a))
7722
7723       return
7724       end subroutine form_caso4
7725
7726
7727
7728       subroutine form_camsa2(store,jp,ibin)
7729 !      implicit none
7730 !      include 'mosaic.h'
7731 ! subr arguments
7732       integer jp, ibin
7733       real(kind=8) store(naer)
7734
7735       electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
7736       store(ica_a)  = store(ica_a) - electrolyte(jcamsa2,jp,ibin)
7737       store(imsa_a) = store(imsa_a) - 2.d0*electrolyte(jcamsa2,jp,ibin)
7738       store(ica_a)  = max(0.D0, store(ica_a))
7739       store(imsa_a) = max(0.D0, store(imsa_a))
7740
7741       return
7742       end subroutine form_camsa2
7743
7744
7745
7746       subroutine form_cano3(store,jp,ibin)      ! ca(no3)2
7747 !     implicit none
7748 !     include 'mosaic.h'
7749 ! subr arguments
7750       integer jp, ibin
7751       real(kind=8) store(naer)
7752
7753       electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
7754
7755       store(ica_a)  = store(ica_a) - electrolyte(jcano3,jp,ibin)
7756       store(ino3_a) = store(ino3_a) - 2.*electrolyte(jcano3,jp,ibin)
7757       store(ica_a)  = max(0.D0, store(ica_a))
7758       store(ino3_a) = max(0.D0, store(ino3_a))
7759
7760       return
7761       end subroutine form_cano3
7762
7763
7764       subroutine form_cacl2(store,jp,ibin)
7765 !     implicit none
7766 !     include 'mosaic.h'
7767 ! subr arguments
7768       integer jp, ibin
7769       real(kind=8) store(naer)
7770
7771       electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
7772
7773       store(ica_a)  = store(ica_a) - electrolyte(jcacl2,jp,ibin)
7774       store(icl_a)  = store(icl_a) - 2.*electrolyte(jcacl2,jp,ibin)
7775       store(ica_a)  = max(0.D0, store(ica_a))
7776       store(icl_a)  = max(0.D0, store(icl_a))
7777
7778       return
7779       end subroutine form_cacl2
7780
7781
7782       subroutine form_caco3(store,jp,ibin)
7783 !     implicit none
7784 !     include 'mosaic.h'
7785 ! subr arguments
7786       integer jp, ibin
7787       real(kind=8) store(naer)
7788
7789       if(jp.eq.jtotal .or. jp.eq.jsolid)then
7790       electrolyte(jcaco3,jp,ibin) = store(ica_a)
7791
7792       aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin)  ! force co3 = caco3
7793
7794       store(ica_a) = 0.0
7795       store(ico3_a)= 0.0
7796       endif
7797
7798       return
7799       end subroutine form_caco3
7800
7801
7802       subroutine form_na2so4(store,jp,ibin)
7803 !     implicit none
7804 !     include 'mosaic.h'
7805 ! subr arguments
7806       integer jp, ibin
7807       real(kind=8) store(naer)
7808
7809       electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a),   &
7810                                             store(iso4_a))
7811       store(ina_a) = store(ina_a) - 2.*electrolyte(jna2so4,jp,ibin)
7812       store(iso4_a)= store(iso4_a) - electrolyte(jna2so4,jp,ibin)
7813       store(ina_a) = max(0.D0, store(ina_a))
7814       store(iso4_a)= max(0.D0, store(iso4_a))
7815
7816       return
7817       end subroutine form_na2so4
7818
7819
7820
7821       subroutine form_nahso4(store,jp,ibin)
7822 !     implicit none
7823 !     include 'mosaic.h'
7824 ! subr arguments
7825       integer jp, ibin
7826       real(kind=8) store(naer)
7827
7828       electrolyte(jnahso4,jp,ibin) = min(store(ina_a),   &
7829                                          store(iso4_a))
7830       store(ina_a)  = store(ina_a) - electrolyte(jnahso4,jp,ibin)
7831       store(iso4_a) = store(iso4_a) - electrolyte(jnahso4,jp,ibin)
7832       store(ina_a)  = max(0.D0, store(ina_a))
7833       store(iso4_a) = max(0.D0, store(iso4_a))
7834
7835       return
7836       end subroutine form_nahso4
7837
7838
7839
7840       subroutine form_namsa(store,jp,ibin)
7841 !      implicit none
7842 !      include 'mosaic.h'
7843 ! subr arguments
7844       integer jp, ibin
7845       real(kind=8) store(naer)
7846
7847       electrolyte(jnamsa,jp,ibin) = min(store(ina_a), &
7848                                         store(imsa_a))
7849       store(ina_a)  = store(ina_a) - electrolyte(jnamsa,jp,ibin)
7850       store(imsa_a) = store(imsa_a) - electrolyte(jnamsa,jp,ibin)
7851       store(ina_a)  = max(0.D0, store(ina_a))
7852       store(imsa_a) = max(0.D0, store(imsa_a))
7853
7854       return
7855       end subroutine form_namsa
7856
7857
7858
7859       subroutine form_nano3(store,jp,ibin)
7860 !     implicit none
7861 !     include 'mosaic.h'
7862 ! subr arguments
7863       integer jp, ibin
7864       real(kind=8) store(naer)
7865
7866       electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
7867       store(ina_a)  = store(ina_a) - electrolyte(jnano3,jp,ibin)
7868       store(ino3_a) = store(ino3_a) - electrolyte(jnano3,jp,ibin)
7869       store(ina_a)  = max(0.D0, store(ina_a))
7870       store(ino3_a) = max(0.D0, store(ino3_a))
7871
7872       return
7873       end subroutine form_nano3
7874
7875
7876
7877       subroutine form_nacl(store,jp,ibin)
7878 !     implicit none
7879 !     include 'mosaic.h'
7880 ! subr arguments
7881       integer jp, ibin
7882       real(kind=8) store(naer)
7883
7884       electrolyte(jnacl,jp,ibin) = store(ina_a)
7885
7886       store(ina_a) = 0.0
7887       store(icl_a) = store(icl_a) - electrolyte(jnacl,jp,ibin)
7888
7889       if(store(icl_a) .lt. 0.)then                              ! cl deficit in aerosol. take some from gas
7890         aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a)    ! update aer(icl_a)
7891
7892         if(jp .ne. jtotal)then
7893           aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ &            ! update for jtotal
7894                                   aer(icl_a,jsolid,ibin)
7895         endif
7896
7897         gas(ihcl_g) = gas(ihcl_g) + store(icl_a)                        ! update gas(ihcl_g)
7898
7899         if(gas(ihcl_g) .lt. 0.0)then
7900           total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g)   ! update total_species
7901           tot_cl_in = tot_cl_in - gas(ihcl_g)                           ! update tot_cl_in
7902         endif
7903
7904         gas(ihcl_g) = max(0.D0, gas(ihcl_g))                            ! restrict gas(ihcl_g) to >= 0.
7905         store(icl_a) = 0.                                       ! force store(icl_a) to 0.
7906
7907       endif
7908
7909       store(icl_a) = max(0.D0, store(icl_a))
7910
7911       return
7912       end subroutine form_nacl
7913
7914
7915
7916       subroutine form_nh4so4(store,jp,ibin)     ! (nh4)2so4
7917 !     implicit none
7918 !     include 'mosaic.h'
7919 ! subr arguments
7920       integer jp, ibin
7921       real(kind=8) store(naer)
7922
7923       electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a),   &
7924                                            store(iso4_a))
7925       store(inh4_a)= store(inh4_a) - 2.*electrolyte(jnh4so4,jp,ibin)
7926       store(iso4_a)= store(iso4_a) - electrolyte(jnh4so4,jp,ibin)
7927       store(inh4_a) = max(0.D0, store(inh4_a))
7928       store(iso4_a) = max(0.D0, store(iso4_a))
7929
7930       return
7931       end subroutine form_nh4so4
7932
7933
7934
7935       subroutine form_nh4hso4(store,jp,ibin)    ! nh4hso4
7936 !     implicit none
7937 !     include 'mosaic.h'
7938 ! subr arguments
7939       integer jp, ibin
7940       real(kind=8) store(naer)
7941
7942       electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a),   &
7943                                           store(iso4_a))
7944       store(inh4_a)= store(inh4_a) - electrolyte(jnh4hso4,jp,ibin)
7945       store(iso4_a)= store(iso4_a) - electrolyte(jnh4hso4,jp,ibin)
7946       store(inh4_a) = max(0.D0, store(inh4_a))
7947       store(iso4_a) = max(0.D0, store(iso4_a))
7948
7949       return
7950       end subroutine form_nh4hso4
7951
7952
7953
7954       subroutine form_nh4msa(store,jp,ibin)
7955 !      implicit none
7956 !      include 'mosaic.h'
7957 ! subr arguments
7958       integer jp, ibin
7959       real(kind=8) store(naer)
7960
7961       electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a), &
7962                                          store(imsa_a))
7963       store(inh4_a) = store(inh4_a) - electrolyte(jnh4msa,jp,ibin)
7964       store(imsa_a) = store(imsa_a) - electrolyte(jnh4msa,jp,ibin)
7965       store(inh4_a) = max(0.D0, store(inh4_a))
7966       store(imsa_a) = max(0.D0, store(imsa_a))
7967
7968       return
7969       end subroutine form_nh4msa
7970
7971
7972
7973       subroutine form_nh4cl(store,jp,ibin)
7974 !     implicit none
7975 !     include 'mosaic.h'
7976 ! subr arguments
7977       integer jp, ibin
7978       real(kind=8) store(naer)
7979
7980       electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a),   &
7981                                         store(icl_a))
7982       store(inh4_a) = store(inh4_a) - electrolyte(jnh4cl,jp,ibin)
7983       store(icl_a)  = store(icl_a) - electrolyte(jnh4cl,jp,ibin)
7984       store(inh4_a) = max(0.D0, store(inh4_a))
7985       store(icl_a)  = max(0.D0, store(icl_a))
7986
7987       return
7988       end subroutine form_nh4cl
7989
7990
7991
7992       subroutine form_nh4no3(store,jp,ibin)
7993 !     implicit none
7994 !     include 'mosaic.h'
7995 ! subr arguments
7996       integer jp, ibin
7997       real(kind=8) store(naer)
7998
7999       electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a),   &
8000                                          store(ino3_a))
8001       store(inh4_a) = store(inh4_a) - electrolyte(jnh4no3,jp,ibin)
8002       store(ino3_a) = store(ino3_a) - electrolyte(jnh4no3,jp,ibin)
8003       store(inh4_a) = max(0.D0, store(inh4_a))
8004       store(ino3_a) = max(0.D0, store(ino3_a))
8005
8006       return
8007       end subroutine form_nh4no3
8008
8009
8010
8011       subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
8012 !     implicit none
8013 !     include 'mosaic.h'
8014 ! subr arguments
8015       integer jp, ibin
8016       real(kind=8) store(naer)
8017
8018       electrolyte(jnh4so4,jp,ibin)= 2.*store(inh4_a) - 3.*store(iso4_a)
8019       electrolyte(jlvcite,jp,ibin)= 2.*store(iso4_a) - store(inh4_a)
8020       electrolyte(jnh4so4,jp,ibin)= max(0.D0,   &
8021                                     electrolyte(jnh4so4,jp,ibin))
8022       electrolyte(jlvcite,jp,ibin)= max(0.D0,   &
8023                                     electrolyte(jlvcite,jp,ibin))
8024       store(inh4_a) = 0.
8025       store(iso4_a) = 0.
8026
8027       return
8028       end subroutine form_nh4so4_lvcite
8029
8030
8031
8032       subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
8033 !     implicit none
8034 !     include 'mosaic.h'
8035 ! subr arguments
8036       integer jp, ibin
8037       real(kind=8) store(naer)
8038
8039       electrolyte(jlvcite,jp,ibin) = store(inh4_a) - store(iso4_a)
8040       electrolyte(jnh4hso4,jp,ibin)= 3.*store(iso4_a) - 2.*store(inh4_a)
8041       electrolyte(jlvcite,jp,ibin) = max(0.D0,   &
8042                                       electrolyte(jlvcite,jp,ibin))
8043       electrolyte(jnh4hso4,jp,ibin)= max(0.D0,   &
8044                                       electrolyte(jnh4hso4,jp,ibin))
8045       store(inh4_a) = 0.
8046       store(iso4_a) = 0.
8047
8048       return
8049       end subroutine form_lvcite_nh4hso4
8050
8051
8052
8053       subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
8054 !     implicit none
8055 !     include 'mosaic.h'
8056 ! subr arguments
8057       integer jp, ibin
8058       real(kind=8) store(naer)
8059
8060       electrolyte(jna2so4,jp,ibin)= store(ina_a) - store(iso4_a)
8061       electrolyte(jnahso4,jp,ibin)= 2.*store(iso4_a) - store(ina_a)
8062       electrolyte(jna2so4,jp,ibin)= max(0.D0,   &
8063                                     electrolyte(jna2so4,jp,ibin))
8064       electrolyte(jnahso4,jp,ibin)= max(0.D0,   &
8065                                     electrolyte(jnahso4,jp,ibin))
8066       store(ina_a)  = 0.
8067       store(iso4_a) = 0.
8068
8069 !       write(6,*)'na2so4 + nahso4'
8070
8071       return
8072       end subroutine form_na2so4_nahso4
8073
8074
8075
8076
8077       subroutine form_h2so4(store,jp,ibin)
8078 !     implicit none
8079 !     include 'mosaic.h'
8080 ! subr arguments
8081       integer jp, ibin
8082       real(kind=8) store(naer)
8083
8084       electrolyte(jh2so4,jp,ibin) = max(0.0D0, store(iso4_a))
8085       store(iso4_a) = 0.0
8086
8087       return
8088       end subroutine form_h2so4
8089
8090
8091
8092
8093       subroutine form_msa(store,jp,ibin)
8094 !      implicit none
8095 !      include 'mosaic.h'
8096 ! subr arguments
8097       integer jp, ibin
8098       real(kind=8) store(naer)
8099
8100       electrolyte(jmsa,jp,ibin) = max(0.0D0, store(imsa_a))
8101       store(imsa_a) = 0.0
8102
8103       return
8104       end subroutine form_msa
8105
8106
8107
8108       subroutine form_hno3(store,jp,ibin)
8109 !     implicit none
8110 !     include 'mosaic.h'
8111 ! subr arguments
8112       integer jp, ibin
8113       real(kind=8) store(naer)
8114
8115       electrolyte(jhno3,jp,ibin) = max(0.0D0, store(ino3_a))
8116       store(ino3_a) = 0.0
8117
8118       return
8119       end subroutine form_hno3
8120
8121
8122
8123
8124       subroutine form_hcl(store,jp,ibin)
8125 !     implicit none
8126 !     include 'mosaic.h'
8127 ! subr arguments
8128       integer jp, ibin
8129       real(kind=8) store(naer)
8130
8131       electrolyte(jhcl,jp,ibin) = max(0.0D0, store(icl_a))
8132       store(icl_a) = 0.0
8133
8134       return
8135       end subroutine form_hcl
8136
8137
8138
8139
8140       subroutine degas_hno3(store,jp,ibin)
8141 !     implicit none
8142 !     include 'mosaic.h'
8143 ! subr arguments
8144       integer jp, ibin
8145       real(kind=8) store(naer)
8146
8147       store(ino3_a) = max(0.0D0, store(ino3_a))
8148       gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
8149       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - store(ino3_a)
8150       aer(ino3_a,jp,ibin) = max(0.0D0,aer(ino3_a,jp,ibin))
8151
8152 ! also do it for jtotal
8153       if(jp .ne. jtotal)then
8154         aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) +   &
8155                                   aer(ino3_a,jliquid,ibin)
8156       endif
8157
8158       electrolyte(jhno3,jp,ibin) = 0.0
8159       store(ino3_a) = 0.0
8160
8161       return
8162       end subroutine degas_hno3
8163
8164
8165
8166       subroutine degas_hcl(store,jp,ibin)
8167 !     implicit none
8168 !     include 'mosaic.h'
8169 ! subr arguments
8170       integer jp, ibin
8171       real(kind=8) store(naer)
8172
8173       store(icl_a) = max(0.0D0, store(icl_a))
8174       gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
8175       aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - store(icl_a)
8176       aer(icl_a,jp,ibin) = max(0.0D0,aer(icl_a,jp,ibin))
8177
8178 ! also do it for jtotal
8179       if(jp .ne. jtotal)then
8180         aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) +   &
8181                                  aer(icl_a,jliquid,ibin)
8182       endif
8183
8184       electrolyte(jhcl,jp,ibin) = 0.0
8185       store(icl_a) = 0.0
8186
8187       return
8188       end subroutine degas_hcl
8189
8190
8191
8192       subroutine degas_nh3(store,jp,ibin)
8193 !     implicit none
8194 !     include 'mosaic.h'
8195 ! subr arguments
8196       integer jp, ibin
8197       real(kind=8) store(naer)
8198
8199       store(inh4_a) = max(0.0D0, store(inh4_a))
8200       gas(inh3_g) = gas(inh3_g) + store(inh4_a)
8201       aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - store(inh4_a)
8202       aer(inh4_a,jp,ibin) = max(0.0D0,aer(inh4_a,jp,ibin))
8203
8204 ! also do it for jtotal
8205       if(jp .ne. jtotal)then
8206         aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) +   &
8207                                  aer(inh4_a,jliquid,ibin)
8208       endif
8209
8210       store(inh4_a) = 0.0
8211
8212       return
8213       end subroutine degas_nh3
8214
8215
8216
8217
8218
8219
8220
8221
8222
8223       subroutine degas_acids(jp,ibin,xt)
8224 !     implicit none
8225 !     include 'mosaic.h'
8226 ! subr arguments
8227       integer jp, ibin
8228       real(kind=8) xt
8229 ! local variables
8230       real(kind=8) ehno3, ehcl
8231
8232
8233
8234       if(jp .ne. jliquid)then
8235         if (iprint_mosaic_diag1 .gt. 0) then
8236           write(6,*)'mosaic - error in degas_acids'
8237           write(6,*)'wrong jp'
8238         endif
8239       endif
8240
8241       ehno3 = electrolyte(jhno3,jp,ibin)
8242       ehcl  = electrolyte(jhcl,jp,ibin)
8243
8244 ! add to gas
8245       gas(ihno3_g) = gas(ihno3_g) + ehno3
8246       gas(ihcl_g)  = gas(ihcl_g)  + ehcl
8247
8248 ! remove from aer
8249       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
8250       aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
8251
8252 ! update jtotal
8253       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
8254                                 aer(ino3_a,jsolid, ibin)
8255
8256       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
8257                                 aer(icl_a,jsolid, ibin)
8258
8259       electrolyte(jhno3,jp,ibin) = 0.0
8260       electrolyte(jhcl,jp,ibin)  = 0.0
8261
8262       return
8263       end subroutine degas_acids
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278 !***********************************************************************
8279 ! subroutines to evaporate solid volatile species
8280 !
8281 ! author: rahul a. zaveri
8282 ! update: sep 2004
8283 !-----------------------------------------------------------------------
8284 !
8285 ! nh4no3 (solid)
8286       subroutine degas_solid_nh4no3(ibin)
8287 !     implicit none
8288 !     include 'mosaic.h'
8289 ! subr arguments
8290       integer ibin
8291 ! local variables
8292       integer jp
8293       real(kind=8) a, b, c, xgas, xt
8294 !     real(kind=8) quadratic                                    ! mosaic func
8295
8296
8297       jp = jsolid
8298
8299       a = 1.0
8300       b = gas(inh3_g) + gas(ihno3_g)
8301       c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
8302       xgas = quadratic(a,b,c)
8303
8304       if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
8305
8306           gas(inh3_g) = gas(inh3_g)  + electrolyte(jnh4no3,jp,ibin)
8307           gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
8308           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
8309                                 electrolyte(jnh4no3,jp,ibin)
8310           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) -   &
8311                                 electrolyte(jnh4no3,jp,ibin)
8312
8313       else      ! degas only xgas amount of nh4no3
8314
8315           gas(inh3_g) = gas(inh3_g)  + xgas
8316           gas(ihno3_g)= gas(ihno3_g) + xgas
8317           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8318           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
8319       endif
8320
8321
8322 ! update jtotal
8323       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8324                                  aer(inh4_a,jliquid,ibin)
8325       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
8326                                  aer(ino3_a,jliquid,ibin)
8327
8328       return
8329       end subroutine degas_solid_nh4no3
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339 ! nh4cl (solid)
8340       subroutine degas_solid_nh4cl(ibin)
8341 !     implicit none
8342 !     include 'mosaic.h'
8343 ! subr arguments
8344       integer ibin
8345 ! local variables
8346       integer jp
8347       real(kind=8) a, b, c, xgas, xt
8348 !     real(kind=8) quadratic                                    ! mosaic func
8349
8350
8351       jp = jsolid
8352
8353       a = 1.0
8354       b = gas(inh3_g) + gas(ihcl_g)
8355       c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
8356       xgas = quadratic(a,b,c)
8357
8358       if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
8359
8360           gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
8361           gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
8362           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
8363                                 electrolyte(jnh4cl,jp,ibin)
8364           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin) -   &
8365                                 electrolyte(jnh4cl,jp,ibin)
8366
8367       else      ! degas only xgas amount of nh4cl
8368
8369           gas(inh3_g) = gas(inh3_g) + xgas
8370           gas(ihcl_g) = gas(ihcl_g) + xgas
8371           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
8372           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin)  - xgas
8373
8374       endif
8375
8376
8377 ! update jtotal
8378       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8379                                  aer(inh4_a,jliquid,ibin)
8380       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
8381                                  aer(icl_a,jliquid,ibin)
8382
8383       return
8384       end subroutine degas_solid_nh4cl
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396 !***********************************************************************
8397 ! subroutines to absorb and degas small amounts of volatile species
8398 !
8399 ! author: rahul a. zaveri
8400 ! update: jun 2002
8401 !-----------------------------------------------------------------------
8402 !
8403 ! nh4no3 (liquid)
8404       subroutine absorb_tiny_nh4no3(ibin)
8405 !     implicit none
8406 !     include 'mosaic.h'
8407 ! subr arguments
8408       integer ibin
8409 ! local variables
8410       real(kind=8) small_aer, small_gas, small_amt
8411
8412       small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
8413       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8414       if(small_aer .eq. 0.0)small_aer = small_gas
8415
8416       small_amt = min(small_gas, small_aer)
8417
8418       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8419       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8420
8421 ! update jtotal
8422       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8423                                  aer(inh4_a,jliquid,ibin)
8424       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
8425                                  aer(ino3_a,jliquid,ibin)
8426
8427 ! update gas
8428       gas(inh3_g)    = gas(inh3_g) - small_amt
8429       gas(ihno3_g)   = gas(ihno3_g) - small_amt
8430
8431       return
8432       end subroutine absorb_tiny_nh4no3
8433
8434
8435
8436
8437
8438
8439 !--------------------------------------------------------------------
8440 ! nh4cl (liquid)
8441       subroutine absorb_tiny_nh4cl(ibin)
8442 !     implicit none
8443 !     include 'mosaic.h'
8444 ! subr arguments
8445       integer ibin
8446 ! local variables
8447       real(kind=8) small_aer, small_gas, small_amt
8448
8449       small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
8450       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
8451       if(small_aer .eq. 0.0)small_aer = small_gas
8452
8453       small_amt = min(small_gas, small_aer)
8454
8455       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
8456       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin)  + small_amt
8457
8458 ! update jtotal
8459       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8460                                  aer(inh4_a,jliquid,ibin)
8461       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
8462                                  aer(icl_a,jliquid,ibin)
8463
8464 ! update gas
8465       gas(inh3_g)   = gas(inh3_g) - small_amt
8466       gas(ihcl_g)   = gas(ihcl_g) - small_amt
8467
8468       return
8469       end subroutine absorb_tiny_nh4cl
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483 !--------------------------------------------------------------
8484 ! nh4no3 (liquid)
8485       subroutine degas_tiny_nh4no3(ibin)
8486 !     implicit none
8487 !     include 'mosaic.h'
8488 ! subr arguments
8489       integer ibin
8490 ! local variables
8491       real(kind=8) small_amt
8492
8493       small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
8494
8495       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8496       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8497
8498 ! update jtotal
8499       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8500                                  aer(inh4_a,jliquid,ibin)
8501       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
8502                                  aer(ino3_a,jliquid,ibin)
8503
8504 ! update gas
8505       gas(inh3_g)  = gas(inh3_g)  + small_amt
8506       gas(ihno3_g) = gas(ihno3_g) + small_amt
8507
8508       return
8509       end subroutine degas_tiny_nh4no3
8510
8511
8512
8513
8514 !--------------------------------------------------------------------
8515 ! liquid nh4cl (liquid)
8516       subroutine degas_tiny_nh4cl(ibin)
8517 !     implicit none
8518 !     include 'mosaic.h'
8519 ! subr arguments
8520       integer ibin
8521 ! local variables
8522       real(kind=8) small_amt
8523
8524
8525       small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
8526
8527       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
8528       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
8529
8530 ! update jtotal
8531       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
8532                                  aer(inh4_a,jliquid,ibin)
8533       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
8534                                  aer(icl_a,jliquid,ibin)
8535
8536 ! update gas
8537       gas(inh3_g) = gas(inh3_g) + small_amt
8538       gas(ihcl_g) = gas(ihcl_g) + small_amt
8539
8540       return
8541       end subroutine degas_tiny_nh4cl
8542
8543
8544
8545
8546
8547
8548
8549 !--------------------------------------------------------------------
8550 ! hcl (liquid)
8551       subroutine absorb_tiny_hcl(ibin)  ! and degas tiny hno3
8552 !     implicit none
8553 !     include 'mosaic.h'
8554 ! subr arguments
8555       integer ibin
8556 ! local variables
8557       real(kind=8) small_aer, small_amt, small_gas
8558
8559       small_gas = 0.01 * gas(ihcl_g)
8560       small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
8561
8562       small_amt = min(small_gas, small_aer)
8563
8564 ! absorb tiny hcl
8565       aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
8566       aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) +   &
8567                                aer(icl_a,jliquid,ibin)
8568       gas(ihcl_g) = gas(ihcl_g) - small_amt
8569
8570 ! degas tiny hno3
8571       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
8572       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
8573                                  aer(ino3_a,jliquid,ibin)
8574
8575 ! update gas
8576       gas(ihno3_g) = gas(ihno3_g) + small_amt
8577
8578       return
8579       end subroutine absorb_tiny_hcl
8580
8581
8582
8583 !--------------------------------------------------------------------
8584 ! hno3 (liquid)
8585       subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
8586 !     implicit none
8587 !     include 'mosaic.h'
8588 ! subr arguments
8589       integer ibin
8590 ! local variables
8591       real(kind=8) small_aer, small_amt, small_gas
8592
8593       small_gas = 0.01 * gas(ihno3_g)
8594       small_aer = 0.01 * aer(icl_a,jliquid,ibin)
8595
8596       small_amt = min(small_gas, small_aer)
8597
8598 ! absorb tiny hno3
8599       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
8600       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
8601                                  aer(ino3_a,jliquid,ibin)
8602       gas(ihno3_g) = gas(ihno3_g) - small_amt
8603
8604 ! degas tiny hcl
8605       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
8606       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin) +   &
8607                                  aer(icl_a,jliquid,ibin)
8608
8609 ! update gas
8610       gas(ihcl_g) = gas(ihcl_g) + small_amt
8611
8612       return
8613       end subroutine absorb_tiny_hno3
8614
8615
8616
8617
8618
8619
8620
8621
8622
8623 !***********************************************************************
8624 ! subroutines to equilibrate volatile acids
8625 !
8626 ! author: rahul a. zaveri
8627 ! update: may 2002
8628 !-----------------------------------------------------------------------
8629       subroutine equilibrate_acids(ibin)
8630 !     implicit none
8631 !     include 'mosaic.h'
8632 ! subr arguments
8633       integer ibin
8634
8635
8636
8637       if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
8638         call equilibrate_hcl_and_hno3(ibin)
8639       elseif(gas(ihcl_g) .gt. 0.)then
8640         call equilibrate_hcl(ibin)
8641       elseif(gas(ihno3_g) .gt. 0.)then
8642         call equilibrate_hno3(ibin)
8643       endif
8644
8645
8646       return
8647       end subroutine equilibrate_acids
8648
8649
8650
8651
8652
8653
8654
8655
8656 ! only hcl
8657       subroutine equilibrate_hcl(ibin)
8658 !     implicit none
8659 !     include 'mosaic.h'
8660 ! subr arguments
8661       integer ibin
8662 ! local variables
8663       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl,   &
8664         w, xt, z
8665 !     real(kind=8) quadratic                                    ! mosaic func
8666
8667       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8668       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8669
8670       tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g)               ! nmol/m^3(air)
8671       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
8672       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
8673               aer(inh4_a,jliquid,ibin) +   &
8674            2.*aer(ica_a, jliquid,ibin) ) -   &
8675           (2.*aerso4  +   &
8676               aerhso4 +   &
8677               aer(ino3_a,jliquid,ibin) )
8678
8679
8680       w     = water_a(ibin)                             ! kg/m^3(air)
8681
8682       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
8683       a = 1.0
8684       b = (kdash_hcl*w + z/w)*1.e-9
8685       c = kdash_hcl*(z - tcl)*1.e-18
8686
8687
8688       dum = b*b - 4.*a*c
8689       if (dum .lt. 0.) return           ! no real root
8690
8691
8692       if(c .lt. 0.)then
8693         mh = quadratic(a,b,c)   ! mol/kg(water)
8694         aerh = mh*w*1.e+9
8695         aer(icl_a,jliquid,ibin) = aerh + z
8696       else
8697         mh = sqrt(keq_ll(3))
8698       endif
8699
8700       call form_electrolytes(jliquid,ibin,xt)
8701
8702 ! update gas phase concentration
8703       gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
8704
8705
8706 ! update the following molalities
8707       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
8708       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8709       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8710       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8711
8712       mc(jc_h,ibin)    = mh
8713       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8714       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8715       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8716
8717
8718 ! update the following activities
8719       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
8720                                gam(jhcl,ibin)**2
8721
8722       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
8723                                gam(jhno3,ibin)**2
8724
8725       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
8726                                gam(jnh4cl,ibin)**2
8727
8728
8729 ! also update xyz(jtotal)
8730       aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) +   &
8731                                aer(icl_a,jsolid,ibin)
8732
8733       electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
8734
8735       return
8736       end subroutine equilibrate_hcl
8737
8738
8739
8740
8741 ! only hno3
8742       subroutine equilibrate_hno3(ibin)
8743 !     implicit none
8744 !     include 'mosaic.h'
8745 ! subr arguments
8746       integer ibin
8747 ! local variables
8748       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh,   &
8749         tno3, w, xt, z
8750 !     real(kind=8) quadratic                                    ! mosaic func
8751
8752       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8753       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8754
8755       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
8756       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
8757       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
8758               aer(inh4_a,jliquid,ibin) +   &
8759            2.*aer(ica_a, jliquid,ibin) ) -   &
8760           (2.*aerso4  +   &
8761               aerhso4 +   &
8762               aer(icl_a,jliquid,ibin) )
8763
8764
8765       w     = water_a(ibin)                             ! kg/m^3(air)
8766
8767       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
8768       a = 1.0
8769       b = (kdash_hno3*w + z/w)*1.e-9
8770       c = kdash_hno3*(z - tno3)*1.e-18
8771
8772       dum = b*b - 4.*a*c
8773       if (dum .lt. 0.) return           ! no real root
8774
8775
8776
8777       if(c .lt. 0.)then
8778         mh = quadratic(a,b,c)   ! mol/kg(water)
8779         aerh = mh*w*1.e+9
8780         aer(ino3_a,jliquid,ibin) = aerh + z
8781       else
8782         mh = sqrt(keq_ll(3))
8783       endif
8784
8785       call form_electrolytes(jliquid,ibin,xt)
8786
8787 ! update gas phase concentration
8788       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8789
8790
8791 ! update the following molalities
8792       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
8793       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8794       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8795       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8796
8797       mc(jc_h,ibin)    = mh
8798       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8799       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8800       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8801
8802
8803 ! update the following activities
8804       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
8805                                gam(jhcl,ibin)**2
8806
8807       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
8808                                gam(jhno3,ibin)**2
8809
8810       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) *   &
8811                                gam(jnh4no3,ibin)**2
8812
8813
8814 ! also update xyz(jtotal)
8815       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
8816                                 aer(ino3_a,jsolid,ibin)
8817
8818       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8819
8820       return
8821       end subroutine equilibrate_hno3
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832 ! both hcl and hno3
8833       subroutine equilibrate_hcl_and_hno3(ibin)
8834 !     implicit none
8835 !     include 'mosaic.h'
8836 ! subr arguments
8837       integer ibin
8838 ! local variables
8839       real(kind=8) aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3,   &
8840         mh, p, q, r, tcl, tno3, w, xt, z
8841 !     real(kind=8) cubic                                        ! mosaic func
8842
8843
8844       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
8845       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
8846
8847       tcl  = aer(icl_a,jliquid,ibin)  + gas(ihcl_g)     ! nmol/m^3(air)
8848       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
8849
8850       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
8851       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
8852
8853       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
8854               aer(inh4_a,jliquid,ibin) +   &
8855            2.*aer(ica_a, jliquid,ibin) ) -   &
8856           (2.*aerso4 + aerhso4 )
8857
8858
8859       w = water_a(ibin)
8860
8861       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
8862       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
8863
8864       p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
8865
8866       q = 1.e-18*kdash_hcl*kdash_hno3*w**2  +   &
8867           1.e-18*z*(kdash_hcl + kdash_hno3) -   &
8868           1.e-18*kdash_hcl*tcl -   &
8869           1.e-18*kdash_hno3*tno3
8870
8871       r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
8872
8873       mh = cubic(p,q,r)
8874
8875       if(mh .gt. 0.0)then
8876         aerh = mh*w*1.e+9
8877         aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/   &
8878                                   (aerh + kdash_hno3*w*w)
8879         aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/   &
8880                                   (aerh + kdash_hcl*w*w)
8881       else
8882         mh = sqrt(keq_ll(3))
8883       endif
8884
8885       call form_electrolytes(jliquid,ibin,xt)
8886
8887 ! update gas phase concentration
8888       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
8889       gas(ihcl_g) = tcl  - aer(icl_a,jliquid,ibin)
8890
8891
8892 ! update the following molalities
8893       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
8894       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
8895       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8896       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8897
8898       mc(jc_h,ibin)    = mh
8899       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8900       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8901       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8902
8903
8904 ! update the following activities
8905       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)   *   &
8906                                gam(jhcl,ibin)**2
8907
8908       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)  *   &
8909                                gam(jhno3,ibin)**2
8910
8911       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)*   &
8912                                gam(jnh4no3,ibin)**2
8913
8914       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
8915                                gam(jnh4cl,ibin)**2
8916
8917
8918 ! also update xyz(jtotal)
8919       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
8920                                 aer(icl_a,jsolid,ibin)
8921
8922       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
8923                                 aer(ino3_a,jsolid,ibin)
8924
8925       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
8926       electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
8927
8928       return
8929       end subroutine equilibrate_hcl_and_hno3
8930
8931
8932
8933
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943 !***********************************************************************
8944 ! called only once per entire simulation to load gas and aerosol
8945 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
8946 !
8947 ! author: rahul a. zaveri
8948 ! update: jan 2005
8949 !-----------------------------------------------------------------------
8950       subroutine load_mosaic_parameters
8951 !     implicit none
8952 !     include 'v33com2'
8953 !     include 'mosaic.h'
8954 ! local variables
8955       integer iaer, je, ja, j_index, ibin
8956 !     logical first
8957 !     save first
8958 !     data first/.true./
8959       logical, save :: first = .true.
8960
8961
8962
8963       if(first)then
8964         first=.false.
8965
8966 !----------------------------------------------------------------
8967 ! control settings
8968       msize_framework = msection        ! mmodal or msection
8969       mgas_aer_xfer   = myes            ! myes, mno
8970
8971 ! astem parameters
8972       nmax_astem      = 200             ! max number of time steps in astem
8973       alpha_astem     = 0.5             ! choose a value between 0.01 and 1.0
8974       rtol_eqb_astem  = 0.01            ! equilibrium tolerance in astem
8975       ptol_mol_astem  = 0.01            ! mol percent tolerance in astem
8976
8977 ! mesa parameters
8978       nmax_mesa       = 80              ! max number of iterations in mesa_ptc
8979       rtol_mesa       = 0.01            ! mesa equilibrium tolerance
8980 !----------------------------------------------------------------
8981 !
8982 ! set gas and aerosol indices
8983 !
8984 ! gas (local)
8985       ih2so4_g  = 1     ! ioa (inorganic aerosol)
8986       ihno3_g   = 2     ! ioa
8987       ihcl_g    = 3     ! ioa
8988       inh3_g    = 4     ! ioa
8989       imsa_g    = 5     ! ioa
8990       iaro1_g   = 6     ! soa (secondary organic aerosol)
8991       iaro2_g   = 7     ! soa
8992       ialk1_g   = 8     ! soa
8993       iole1_g   = 9     ! soa
8994       iapi1_g   = 10    ! soa
8995       iapi2_g   = 11    ! soa
8996       ilim1_g   = 12    ! soa
8997       ilim2_g   = 13    ! soa
8998
8999 !      ico2_g   = 14    ! currently not used
9000 !
9001 ! aerosol (local): used for total species
9002       iso4_a    =  1    ! <-> ih2so4_g
9003       ino3_a    =  2    ! <-> ihno3_g
9004       icl_a     =  3    ! <-> ihcl_g
9005       inh4_a    =  4    ! <-> inh3_g
9006       imsa_a    =  5    ! <-> imsa_g
9007       iaro1_a   =  6    ! <-> iaro1_g
9008       iaro2_a   =  7    ! <-> iaro2_g
9009       ialk1_a   =  8    ! <-> ialk1_g
9010       iole1_a   =  9    ! <-> iole1_g
9011       iapi1_a   = 10    ! <-> iapi1_g
9012       iapi2_a   = 11    ! <-> iapi2_g
9013       ilim1_a   = 12    ! <-> ilim1_g
9014       ilim2_a   = 13    ! <-> ilim2_g
9015       ico3_a    = 14    ! <-> ico2_g
9016       ina_a     = 15
9017       ica_a     = 16
9018       ioin_a    = 17
9019       ioc_a     = 18
9020       ibc_a     = 19
9021
9022
9023 ! electrolyte indices (used for water content calculations)
9024 ! these indices are order sensitive
9025       jnh4so4   =  1    ! soluble
9026       jlvcite   =  2    ! soluble
9027       jnh4hso4  =  3    ! soluble
9028       jnh4msa   =  4    ! soluble new
9029       jnh4no3   =  5    ! soluble
9030       jnh4cl    =  6    ! soluble
9031       jna2so4   =  7    ! soluble
9032       jna3hso4  =  8    ! soluble
9033       jnahso4   =  9    ! soluble
9034       jnamsa    = 10    ! soluble new
9035       jnano3    = 11    ! soluble
9036       jnacl     = 12    ! soluble
9037       jcano3    = 13    ! soluble
9038       jcacl2    = 14    ! soluble
9039       jcamsa2   = 15    ! soluble new     nsalt
9040       jh2so4    = 16    ! soluble
9041       jmsa      = 17    ! soluble new
9042       jhno3     = 18    ! soluble
9043       jhcl      = 19    ! soluble
9044       jhhso4    = 20    ! soluble
9045       jcaso4    = 21    ! insoluble
9046       jcaco3    = 22    ! insoluble
9047       joc       = 23    ! insoluble - part of naercomp
9048       jbc       = 24    ! insoluble - part of naercomp
9049       join      = 25    ! insoluble - part of naercomp
9050       jaro1     = 26    ! insoluble - part of naercomp
9051       jaro2     = 27    ! insoluble - part of naercomp
9052       jalk1     = 28    ! insoluble - part of naercomp
9053       jole1     = 29    ! insoluble - part of naercomp
9054       japi1     = 30    ! insoluble - part of naercomp
9055       japi2     = 31    ! insoluble - part of naercomp
9056       jlim1     = 32    ! insoluble - part of naercomp
9057       jlim2     = 33    ! insoluble - part of naercomp
9058       jh2o      = 34    ! water - part of naercomp
9059
9060
9061 ! local aerosol ions
9062 ! cations
9063       jc_h      =  1
9064       jc_nh4    =  2
9065       jc_na     =  3
9066       jc_ca     =  4
9067 !
9068 ! anions
9069       ja_hso4   =  1
9070       ja_so4    =  2
9071       ja_no3    =  3
9072       ja_cl     =  4
9073       ja_msa    =  5
9074 !     ja_co3    =  6
9075
9076 !--------------------------------------------------------------------
9077 ! phase state names
9078 !      phasestate(no_aerosol) = "NOAERO"
9079 !      phasestate(all_solid)  = "SOLID "
9080 !      phasestate(all_liquid) = "LIQUID"
9081 !      phasestate(mixed)      = "MIXED "
9082
9083 ! names of aer species
9084       aer_name(iso4_a) = 'so4'
9085       aer_name(ino3_a) = 'no3'
9086       aer_name(icl_a)  = 'cl '
9087       aer_name(inh4_a) = 'nh4'
9088       aer_name(ioc_a)  = 'oc '
9089       aer_name(imsa_a) = 'msa'
9090       aer_name(ico3_a) = 'co3'
9091       aer_name(ina_a)  = 'na '
9092       aer_name(ica_a)  = 'ca '
9093       aer_name(ibc_a)  = 'bc '
9094       aer_name(ioin_a) = 'oin'
9095       aer_name(iaro1_a)= 'aro1'
9096       aer_name(iaro2_a)= 'aro2'
9097       aer_name(ialk1_a)= 'alk1'
9098       aer_name(iole1_a)= 'ole1'
9099       aer_name(iapi1_a)= 'api1'
9100       aer_name(iapi2_a)= 'api2'
9101       aer_name(ilim1_a)= 'lim1'
9102       aer_name(ilim2_a)= 'lim2'
9103
9104 ! names of gas species
9105       gas_name(ih2so4_g) = 'h2so4'
9106       gas_name(ihno3_g)  = 'hno3 '
9107       gas_name(ihcl_g)   = 'hcl  '
9108       gas_name(inh3_g)   = 'nh3  '
9109       gas_name(imsa_g)   = "msa  "
9110       gas_name(iaro1_g)  = "aro1 "
9111       gas_name(iaro2_g)  = "aro2 "
9112       gas_name(ialk1_g)  = "alk1 "
9113       gas_name(iole1_g)  = "ole1 "
9114       gas_name(iapi1_g)  = "api1 "
9115       gas_name(iapi2_g)  = "api2 "
9116       gas_name(ilim1_g)  = "lim1 "
9117       gas_name(ilim2_g)  = "lim2 "
9118
9119 ! names of electrolytes
9120       ename(jnh4so4) = 'amso4'
9121       ename(jlvcite) = '(nh4)3h(so4)2'
9122       ename(jnh4hso4)= 'nh4hso4'
9123       ename(jnh4msa) = "ch3so3nh4"
9124       ename(jnh4no3) = 'nh4no3'
9125       ename(jnh4cl)  = 'nh4cl'
9126       ename(jnacl)   = 'nacl'
9127       ename(jnano3)  = 'nano3'
9128       ename(jna2so4) = 'na2so4'
9129       ename(jna3hso4)= 'na3h(so4)2'
9130       ename(jnamsa)  = "ch3so3na"
9131       ename(jnahso4) = 'nahso4'
9132       ename(jcaso4)  = 'caso4'
9133       ename(jcamsa2) = "(ch3so3)2ca"
9134       ename(jcano3)  = 'ca(no3)2'
9135       ename(jcacl2)  = 'cacl2'
9136       ename(jcaco3)  = 'caco3'
9137       ename(jh2so4)  = 'h2so4'
9138       ename(jhhso4)  = 'hhso4'
9139       ename(jhno3)   = 'hno3'
9140       ename(jhcl)    = 'hcl'
9141       ename(jmsa)    = "ch3so3h"
9142
9143 ! molecular weights of electrolytes
9144       mw_electrolyte(jnh4so4) = 132.0
9145       mw_electrolyte(jlvcite) = 247.0
9146       mw_electrolyte(jnh4hso4)= 115.0
9147       mw_electrolyte(jnh4msa) = 113.0
9148       mw_electrolyte(jnh4no3) = 80.0
9149       mw_electrolyte(jnh4cl)  = 53.5
9150       mw_electrolyte(jnacl)   = 58.5
9151       mw_electrolyte(jnano3)  = 85.0
9152       mw_electrolyte(jna2so4) = 142.0
9153       mw_electrolyte(jna3hso4)= 262.0
9154       mw_electrolyte(jnahso4) = 120.0
9155       mw_electrolyte(jnamsa)  = 118.0
9156       mw_electrolyte(jcaso4)  = 136.0
9157       mw_electrolyte(jcamsa2) = 230.0
9158       mw_electrolyte(jcano3)  = 164.0
9159       mw_electrolyte(jcacl2)  = 111.0
9160       mw_electrolyte(jcaco3)  = 100.0
9161       mw_electrolyte(jh2so4)  = 98.0
9162       mw_electrolyte(jhno3)   = 63.0
9163       mw_electrolyte(jhcl)    = 36.5
9164       mw_electrolyte(jmsa)    = 96.0
9165
9166
9167 ! molecular weights of ions [g/mol]
9168       mw_c(jc_h)  =  1.0
9169       mw_c(jc_nh4)= 18.0
9170       mw_c(jc_na) = 23.0
9171       mw_c(jc_ca) = 40.0
9172
9173       mw_a(ja_so4) = 96.0
9174       mw_a(ja_hso4)= 97.0
9175       mw_a(ja_no3) = 62.0
9176       mw_a(ja_cl)  = 35.5
9177       MW_a(ja_msa) = 95.0
9178
9179
9180 ! magnitude of the charges on ions
9181       zc(jc_h)   = 1
9182       zc(jc_nh4) = 1
9183       zc(jc_na)  = 1
9184       zc(jc_ca)  = 2
9185
9186       za(ja_hso4)= 1
9187       za(ja_so4) = 2
9188       za(ja_no3) = 1
9189       za(ja_cl)  = 1
9190       za(ja_msa) = 1
9191
9192
9193 ! densities of pure electrolytes in g/cc
9194       dens_electrolyte(jnh4so4)  = 1.8
9195       dens_electrolyte(jlvcite)  = 1.8
9196       dens_electrolyte(jnh4hso4) = 1.8
9197       dens_electrolyte(jnh4msa)  = 1.8 ! assumed same as nh4hso4
9198       dens_electrolyte(jnh4no3)  = 1.8
9199       dens_electrolyte(jnh4cl)   = 1.8
9200       dens_electrolyte(jnacl)    = 2.2
9201       dens_electrolyte(jnano3)   = 2.2
9202       dens_electrolyte(jna2so4)  = 2.2
9203       dens_electrolyte(jna3hso4) = 2.2
9204       dens_electrolyte(jnahso4)  = 2.2
9205       dens_electrolyte(jnamsa)   = 2.2 ! assumed same as nahso4
9206       dens_electrolyte(jcaso4)   = 2.6
9207       dens_electrolyte(jcamsa2)  = 2.6  ! assumed same as caso4
9208       dens_electrolyte(jcano3)   = 2.6
9209       dens_electrolyte(jcacl2)   = 2.6
9210       dens_electrolyte(jcaco3)   = 2.6
9211       dens_electrolyte(jh2so4)   = 1.8
9212       dens_electrolyte(jhhso4)   = 1.8
9213       dens_electrolyte(jhno3)    = 1.8
9214       dens_electrolyte(jhcl)     = 1.8
9215       dens_electrolyte(jmsa)     = 1.8 ! assumed same as h2so4
9216
9217
9218 ! densities of compounds in g/cc
9219       dens_comp_a(jnh4so4)  = 1.8
9220       dens_comp_a(jlvcite)  = 1.8
9221       dens_comp_a(jnh4hso4) = 1.8
9222       dens_comp_a(jnh4msa)  = 1.8       ! assumed same as nh4hso4
9223       dens_comp_a(jnh4no3)  = 1.7
9224       dens_comp_a(jnh4cl)   = 1.5
9225       dens_comp_a(jnacl)    = 2.2
9226       dens_comp_a(jnano3)   = 2.2
9227       dens_comp_a(jna2so4)  = 2.2
9228       dens_comp_a(jna3hso4) = 2.2
9229       dens_comp_a(jnahso4)  = 2.2
9230       dens_comp_a(jnamsa)   = 2.2       ! assumed same as nahso4
9231       dens_comp_a(jcaso4)   = 2.6
9232       dens_comp_a(jcamsa2)  = 2.6       ! assumed same as caso4
9233       dens_comp_a(jcano3)   = 2.6
9234       dens_comp_a(jcacl2)   = 2.6
9235       dens_comp_a(jcaco3)   = 2.6
9236       dens_comp_a(jh2so4)   = 1.8
9237       dens_comp_a(jhhso4)   = 1.8
9238       dens_comp_a(jhno3)    = 1.8
9239       dens_comp_a(jhcl)     = 1.8
9240       dens_comp_a(jmsa)     = 1.8       ! assumed same as h2so4
9241       dens_comp_a(joc)      = 1.0
9242       dens_comp_a(jbc)      = 1.8
9243       dens_comp_a(join)     = 2.6
9244       dens_comp_a(jaro1)    = 1.0
9245       dens_comp_a(jaro2)    = 1.0
9246       dens_comp_a(jalk1)    = 1.0
9247       dens_comp_a(jole1)    = 1.0
9248       dens_comp_a(japi1)    = 1.0
9249       dens_comp_a(japi2)    = 1.0
9250       dens_comp_a(jlim1)    = 1.0
9251       dens_comp_a(jlim2)    = 1.0
9252       dens_comp_a(jh2o)     = 1.0
9253
9254
9255 ! molecular weights of generic aerosol species
9256       mw_aer_mac(iso4_a) = 96.0
9257       mw_aer_mac(ino3_a) = 62.0
9258       mw_aer_mac(icl_a)  = 35.5
9259       mw_aer_mac(imsa_a) = 95.0 ! ch3so3
9260       mw_aer_mac(ico3_a) = 60.0
9261       mw_aer_mac(inh4_a) = 18.0
9262       mw_aer_mac(ina_a)  = 23.0
9263       mw_aer_mac(ica_a)  = 40.0
9264       mw_aer_mac(ioin_a) = 1.0          ! not used
9265       mw_aer_mac(ibc_a)  = 1.0          ! not used
9266       mw_aer_mac(ioc_a)  = 1.0  ! 200 assumed for primary organics
9267       mw_aer_mac(iaro1_a)= 150.0
9268       mw_aer_mac(iaro2_a)= 150.0
9269       mw_aer_mac(ialk1_a)= 140.0
9270       mw_aer_mac(iole1_a)= 140.0
9271       mw_aer_mac(iapi1_a)= 184.0
9272       mw_aer_mac(iapi2_a)= 184.0
9273       mw_aer_mac(ilim1_a)= 200.0
9274       mw_aer_mac(ilim2_a)= 200.0
9275
9276 ! molecular weights of compounds
9277       mw_comp_a(jnh4so4) = 132.0
9278       mw_comp_a(jlvcite) = 247.0
9279       mw_comp_a(jnh4hso4)= 115.0
9280       mw_comp_a(jnh4msa) = 113.0
9281       mw_comp_a(jnh4no3) = 80.0
9282       mw_comp_a(jnh4cl)  = 53.5
9283       mw_comp_a(jnacl)   = 58.5
9284       mw_comp_a(jnano3)  = 85.0
9285       mw_comp_a(jna2so4) = 142.0
9286       mw_comp_a(jna3hso4)= 262.0
9287       mw_comp_a(jnahso4) = 120.0
9288       mw_comp_a(jnamsa)  = 118.0
9289       mw_comp_a(jcaso4)  = 136.0
9290       mw_comp_a(jcamsa2) = 230.0
9291       mw_comp_a(jcano3)  = 164.0
9292       mw_comp_a(jcacl2)  = 111.0
9293       mw_comp_a(jcaco3)  = 100.0
9294       mw_comp_a(jh2so4)  = 98.0
9295       mw_comp_a(jhhso4)  = 98.0
9296       mw_comp_a(jhno3)   = 63.0
9297       mw_comp_a(jhcl)    = 36.5
9298       mw_comp_a(jmsa)    = 96.0
9299       mw_comp_a(joc)     = 1.0
9300       mw_comp_a(jbc)     = 1.0
9301       mw_comp_a(join)    = 1.0
9302       mw_comp_a(jaro1)   = 150.0
9303       mw_comp_a(jaro2)   = 150.0
9304       mw_comp_a(jalk1)   = 140.0
9305       mw_comp_a(jole1)   = 140.0
9306       mw_comp_a(japi1)   = 184.0
9307       mw_comp_a(japi2)   = 184.0
9308       mw_comp_a(jlim1)   = 200.0
9309       mw_comp_a(jlim2)   = 200.0
9310       mw_comp_a(jh2o)    = 18.0
9311
9312 ! densities of generic aerosol species
9313       dens_aer_mac(iso4_a) = 1.8        ! used
9314       dens_aer_mac(ino3_a) = 1.8        ! used
9315       dens_aer_mac(icl_a)  = 2.2        ! used
9316       dens_aer_mac(imsa_a) = 1.8        ! used
9317       dens_aer_mac(ico3_a) = 2.6        ! used
9318       dens_aer_mac(inh4_a) = 1.8        ! used
9319       dens_aer_mac(ina_a)  = 2.2        ! used
9320       dens_aer_mac(ica_a)  = 2.6        ! used
9321       dens_aer_mac(ioin_a) = 2.6        ! used
9322       dens_aer_mac(ioc_a)  = 1.0        ! used
9323       dens_aer_mac(ibc_a)  = 1.7        ! used
9324       dens_aer_mac(iaro1_a)= 1.0
9325       dens_aer_mac(iaro2_a)= 1.0
9326       dens_aer_mac(ialk1_a)= 1.0
9327       dens_aer_mac(iole1_a)= 1.0
9328       dens_aer_mac(iapi1_a)= 1.0
9329       dens_aer_mac(iapi2_a)= 1.0
9330       dens_aer_mac(ilim1_a)= 1.0
9331       dens_aer_mac(ilim2_a)= 1.0
9332
9333
9334 ! partial molar volumes of condensing species
9335       partial_molar_vol(ih2so4_g) = 51.83
9336       partial_molar_vol(ihno3_g)  = 31.45
9337       partial_molar_vol(ihcl_g)   = 20.96
9338       partial_molar_vol(inh3_g)   = 24.03
9339       partial_molar_vol(imsa_g)   = 53.33
9340       partial_molar_vol(iaro1_g)  = 150.0
9341       partial_molar_vol(iaro2_g)  = 150.0
9342       partial_molar_vol(ialk1_g)  = 140.0
9343       partial_molar_vol(iole1_g)  = 140.0
9344       partial_molar_vol(iapi1_g)  = 184.0
9345       partial_molar_vol(iapi2_g)  = 184.0
9346       partial_molar_vol(ilim1_g)  = 200.0
9347       partial_molar_vol(ilim2_g)  = 200.0
9348
9349
9350 ! refractive index
9351       ref_index_a(jnh4so4) = cmplx(1.52,0.)
9352       ref_index_a(jlvcite) = cmplx(1.50,0.)
9353       ref_index_a(jnh4hso4)= cmplx(1.47,0.)
9354       ref_index_a(jnh4msa) = cmplx(1.50,0.)     ! assumed
9355       ref_index_a(jnh4no3) = cmplx(1.50,0.)
9356       ref_index_a(jnh4cl)  = cmplx(1.50,0.)
9357       ref_index_a(jnacl)   = cmplx(1.45,0.)
9358       ref_index_a(jnano3)  = cmplx(1.50,0.)
9359       ref_index_a(jna2so4) = cmplx(1.50,0.)
9360       ref_index_a(jna3hso4)= cmplx(1.50,0.)
9361       ref_index_a(jnahso4) = cmplx(1.50,0.)
9362       ref_index_a(jnamsa)  = cmplx(1.50,0.)     ! assumed
9363       ref_index_a(jcaso4)  = cmplx(1.56,0.006)
9364       ref_index_a(jcamsa2) = cmplx(1.56,0.006)  ! assumed
9365       ref_index_a(jcano3)  = cmplx(1.56,0.006)
9366       ref_index_a(jcacl2)  = cmplx(1.52,0.006)
9367       ref_index_a(jcaco3)  = cmplx(1.68,0.006)
9368       ref_index_a(jh2so4)  = cmplx(1.43,0.)
9369       ref_index_a(jhhso4)  = cmplx(1.43,0.)
9370       ref_index_a(jhno3)   = cmplx(1.50,0.)
9371       ref_index_a(jhcl)    = cmplx(1.50,0.)
9372       ref_index_a(jmsa)    = cmplx(1.43,0.)     ! assumed
9373       ref_index_a(joc)     = cmplx(1.45,0.)
9374       ref_index_a(jbc)     = cmplx(1.82,0.74)
9375       ref_index_a(join)    = cmplx(1.55,0.006)
9376       ref_index_a(jaro1)   = cmplx(1.45,0.)
9377       ref_index_a(jaro2)   = cmplx(1.45,0.)
9378       ref_index_a(jalk1)   = cmplx(1.45,0.)
9379       ref_index_a(jole1)   = cmplx(1.45,0.)
9380       ref_index_a(japi1)   = cmplx(1.45,0.)
9381       ref_index_a(japi2)   = cmplx(1.45,0.)
9382       ref_index_a(jlim1)   = cmplx(1.45,0.)
9383       ref_index_a(jlim2)   = cmplx(1.45,0.)
9384       ref_index_a(jh2o)    = cmplx(1.33,0.)
9385
9386 ! jsalt_index
9387       jsalt_index(jnh4so4) = 5          ! as
9388       jsalt_index(jlvcite) = 2          ! lv
9389       jsalt_index(jnh4hso4)= 1          ! ab
9390       jsalt_index(jnh4no3) = 2          ! an
9391       jsalt_index(jnh4cl)  = 1          ! ac
9392       jsalt_index(jna2so4) = 60         ! ss
9393       jsalt_index(jnahso4) = 10         ! sb
9394       jsalt_index(jnano3)  = 40         ! sn
9395       jsalt_index(jnacl)   = 10         ! sc
9396       jsalt_index(jcano3)  = 120        ! cn
9397       jsalt_index(jcacl2)  = 80         ! cc
9398       jsalt_index(jnh4msa) = 0          ! AM    zero for now
9399       jsalt_index(jnamsa)  = 0          ! SM    zero for now
9400       jsalt_index(jcamsa2) = 0          ! CM    zero for now
9401
9402
9403 ! aerosol indices
9404 !  ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
9405 !  ab = 1, lv = 2, sb = 10
9406 !
9407 ! sulfate-poor domain
9408       jsulf_poor(1)   =         1       !       ac
9409       jsulf_poor(2)   =         2       !       an
9410       jsulf_poor(5)   =         3       !       as
9411       jsulf_poor(10)  =         4       !       sc
9412       jsulf_poor(40)  =         5       !       sn
9413       jsulf_poor(60)  =         6       !       ss
9414       jsulf_poor(80)  =         7       !       cc
9415       jsulf_poor(120) =         8       !       cn
9416       jsulf_poor(3)   =         9       !       an + ac
9417       jsulf_poor(6)   =         10      !       as + ac
9418       jsulf_poor(7)   =         11      !       as + an
9419       jsulf_poor(8)   =         12      !       as + an + ac
9420       jsulf_poor(11)  =         13      !       sc + ac
9421       jsulf_poor(41)  =         14      !       sn + ac
9422       jsulf_poor(42)  =         15      !       sn + an
9423       jsulf_poor(43)  =         16      !       sn + an + ac
9424       jsulf_poor(50)  =         17      !       sn + sc
9425       jsulf_poor(51)  =         18      !       sn + sc + ac
9426       jsulf_poor(61)  =         19      !       ss + ac
9427       jsulf_poor(62)  =         20      !       ss + an
9428       jsulf_poor(63)  =         21      !       ss + an + ac
9429       jsulf_poor(65)  =         22      !       ss + as
9430       jsulf_poor(66)  =         23      !       ss + as + ac
9431       jsulf_poor(67)  =         24      !       ss + as + an
9432       jsulf_poor(68)  =         25      !       ss + as + an + ac
9433       jsulf_poor(70)  =         26      !       ss + sc
9434       jsulf_poor(71)  =         27      !       ss + sc + ac
9435       jsulf_poor(100) =         28      !       ss + sn
9436       jsulf_poor(101) =         29      !       ss + sn + ac
9437       jsulf_poor(102) =         30      !       ss + sn + an
9438       jsulf_poor(103) =         31      !       ss + sn + an + ac
9439       jsulf_poor(110) =         32      !       ss + sn + sc
9440       jsulf_poor(111) =         33      !       ss + sn + sc + ac
9441       jsulf_poor(81)  =         34      !       cc + ac
9442       jsulf_poor(90)  =         35      !       cc + sc
9443       jsulf_poor(91)  =         36      !       cc + sc + ac
9444       jsulf_poor(121) =         37      !       cn + ac
9445       jsulf_poor(122) =         38      !       cn + an
9446       jsulf_poor(123) =         39      !       cn + an + ac
9447       jsulf_poor(130) =         40      !       cn + sc
9448       jsulf_poor(131) =         41      !       cn + sc + ac
9449       jsulf_poor(160) =         42      !       cn + sn
9450       jsulf_poor(161) =         43      !       cn + sn + ac
9451       jsulf_poor(162) =         44      !       cn + sn + an
9452       jsulf_poor(163) =         45      !       cn + sn + an + ac
9453       jsulf_poor(170) =         46      !       cn + sn + sc
9454       jsulf_poor(171) =         47      !       cn + sn + sc + ac
9455       jsulf_poor(200) =         48      !       cn + cc
9456       jsulf_poor(201) =         49      !       cn + cc + ac
9457       jsulf_poor(210) =         50      !       cn + cc + sc
9458       jsulf_poor(211) =         51      !       cn + cc + sc + ac
9459 !
9460 ! sulfate-rich domain
9461       jsulf_rich(1)   =         52      !       ab
9462       jsulf_rich(2)   =         53      !       lv
9463       jsulf_rich(10)  =         54      !       sb
9464       jsulf_rich(3)   =         55      !       ab + lv
9465       jsulf_rich(7)   =         56      !       as + lv
9466       jsulf_rich(70)  =         57      !       ss + sb
9467       jsulf_rich(62)  =         58      !       ss + lv
9468       jsulf_rich(67)  =         59      !       ss + as + lv
9469       jsulf_rich(61)  =         60      !       ss + ab
9470       jsulf_rich(63)  =         61      !       ss + lv + ab
9471       jsulf_rich(11)  =         62      !       sb + ab
9472       jsulf_rich(71)  =         63      !       ss + sb + ab
9473       jsulf_rich(5)   =         3       !       as
9474       jsulf_rich(60)  =         6       !       ss
9475       jsulf_rich(65)  =         22      !       ss + as
9476
9477
9478
9479 !
9480 ! polynomial coefficients for binary molality (used in zsr equation)
9481 !
9482 !
9483 ! a_zsr for aw < 0.97
9484 !
9485 ! (nh4)2so4
9486       je = jnh4so4
9487       a_zsr(1,je)  =  1.30894
9488       a_zsr(2,je)  = -7.09922
9489       a_zsr(3,je)  =  20.62831
9490       a_zsr(4,je)  = -32.19965
9491       a_zsr(5,je)  =  25.17026
9492       a_zsr(6,je)  = -7.81632
9493       aw_min(je)   = 0.1
9494 !
9495 ! (nh4)3h(so4)2
9496       je = jlvcite
9497       a_zsr(1,je)  =  1.10725
9498       a_zsr(2,je)  = -5.17978
9499       a_zsr(3,je)  =  12.29534
9500       a_zsr(4,je)  = -16.32545
9501       a_zsr(5,je)  =  11.29274
9502       a_zsr(6,je)  = -3.19164
9503       aw_min(je)   = 0.1
9504 !
9505 ! nh4hso4
9506       je = jnh4hso4
9507       a_zsr(1,je)  =  1.15510
9508       a_zsr(2,je)  = -3.20815
9509       a_zsr(3,je)  =  2.71141
9510       a_zsr(4,je)  =  2.01155
9511       a_zsr(5,je)  = -4.71014
9512       a_zsr(6,je)  =  2.04616
9513       aw_min(je)   = 0.1
9514 !
9515 ! nh4msa (assumed same as nh4hso4)
9516       je = jnh4msa
9517       a_zsr(1,je)  =  1.15510
9518       a_zsr(2,je)  = -3.20815
9519       a_zsr(3,je)  =  2.71141
9520       a_zsr(4,je)  =  2.01155
9521       a_zsr(5,je)  = -4.71014
9522       a_zsr(6,je)  =  2.04616
9523       aw_min(je)   = 0.1
9524 !
9525 ! nh4no3
9526       je = jnh4no3
9527       a_zsr(1,je)  =  0.43507
9528       a_zsr(2,je)  =  6.38220
9529       a_zsr(3,je)  = -30.19797
9530       a_zsr(4,je)  =  53.36470
9531       a_zsr(5,je)  = -43.44203
9532       a_zsr(6,je)  =  13.46158
9533       aw_min(je)   = 0.1
9534 !
9535 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
9536       je = jnh4cl
9537       a_zsr(1,je)  =  0.45309
9538       a_zsr(2,je)  =  2.65606
9539       a_zsr(3,je)  = -14.7730
9540       a_zsr(4,je)  =  26.2936
9541       a_zsr(5,je)  = -20.5735
9542       a_zsr(6,je)  =  5.94255
9543       aw_min(je)   = 0.1
9544 !
9545 ! nacl
9546       je = jnacl
9547       a_zsr(1,je)  =  0.42922
9548       a_zsr(2,je)  = -1.17718
9549       a_zsr(3,je)  =  2.80208
9550       a_zsr(4,je)  = -4.51097
9551       a_zsr(5,je)  =  3.76963
9552       a_zsr(6,je)  = -1.31359
9553       aw_min(je)   = 0.1
9554 !
9555 ! nano3
9556       je = jnano3
9557       a_zsr(1,je)  =  1.34966
9558       a_zsr(2,je)  = -5.20116
9559       a_zsr(3,je)  =  11.49011
9560       a_zsr(4,je)  = -14.41380
9561       a_zsr(5,je)  =  9.07037
9562       a_zsr(6,je)  = -2.29769
9563       aw_min(je)   = 0.1
9564 !
9565 ! na2so4
9566       je = jna2so4
9567       a_zsr(1,je)  =  0.39888
9568       a_zsr(2,je)  = -1.27150
9569       a_zsr(3,je)  =  3.42792
9570       a_zsr(4,je)  = -5.92632
9571       a_zsr(5,je)  =  5.33351
9572       a_zsr(6,je)  = -1.96541
9573       aw_min(je)   = 0.1
9574 !
9575 ! na3h(so4)2  added on 1/14/2004
9576       je = jna3hso4
9577       a_zsr(1,je)  =  0.31480
9578       a_zsr(2,je)  = -1.01087
9579       a_zsr(3,je)  =  2.44029
9580       a_zsr(4,je)  = -3.66095
9581       a_zsr(5,je)  =  2.77632
9582       a_zsr(6,je)  = -0.86058
9583       aw_min(je)   = 0.1
9584 !
9585 ! nahso4
9586       je = jnahso4
9587       a_zsr(1,je)  =  0.62764
9588       a_zsr(2,je)  = -1.63520
9589       a_zsr(3,je)  =  4.62531
9590       a_zsr(4,je)  = -10.06925
9591       a_zsr(5,je)  =  10.33547
9592       a_zsr(6,je)  = -3.88729
9593       aw_min(je)   = 0.1
9594 !
9595 ! namsa (assumed same as nahso4)
9596       je = jnamsa
9597       a_zsr(1,je)  =  0.62764
9598       a_zsr(2,je)  = -1.63520
9599       a_zsr(3,je)  =  4.62531
9600       a_zsr(4,je)  = -10.06925
9601       a_zsr(5,je)  =  10.33547
9602       a_zsr(6,je)  = -3.88729
9603       aw_min(je)   = 0.1
9604 !
9605 ! ca(no3)2
9606       je = jcano3
9607       a_zsr(1,je)  =  0.38895
9608       a_zsr(2,je)  = -1.16013
9609       a_zsr(3,je)  =  2.16819
9610       a_zsr(4,je)  = -2.23079
9611       a_zsr(5,je)  =  1.00268
9612       a_zsr(6,je)  = -0.16923
9613       aw_min(je)   = 0.1
9614 !
9615 ! cacl2: kim and seinfeld
9616       je = jcacl2
9617       a_zsr(1,je)  =  0.29891
9618       a_zsr(2,je)  = -1.31104
9619       a_zsr(3,je)  =  3.68759
9620       a_zsr(4,je)  = -5.81708
9621       a_zsr(5,je)  =  4.67520
9622       a_zsr(6,je)  = -1.53223
9623       aw_min(je)   = 0.1
9624 !
9625 ! h2so4
9626       je = jh2so4
9627       a_zsr(1,je) =  0.32751
9628       a_zsr(2,je) = -1.00692
9629       a_zsr(3,je) =  2.59750
9630       a_zsr(4,je) = -4.40014
9631       a_zsr(5,je) =  3.88212
9632       a_zsr(6,je) = -1.39916
9633       aw_min(je)  = 0.1
9634 !
9635 ! msa (assumed same as h2so4)
9636       je = jmsa
9637       a_zsr(1,je) =  0.32751
9638       a_zsr(2,je) = -1.00692
9639       a_zsr(3,je) =  2.59750
9640       a_zsr(4,je) = -4.40014
9641       a_zsr(5,je) =  3.88212
9642       a_zsr(6,je) = -1.39916
9643       aw_min(je)  = 0.1
9644 !
9645 ! hhso4
9646       je = jhhso4
9647       a_zsr(1,je) =  0.32751
9648       a_zsr(2,je) = -1.00692
9649       a_zsr(3,je) =  2.59750
9650       a_zsr(4,je) = -4.40014
9651       a_zsr(5,je) =  3.88212
9652       a_zsr(6,je) = -1.39916
9653       aw_min(je)  = 1.0
9654 !
9655 ! hno3
9656       je = jhno3
9657       a_zsr(1,je) =  0.75876
9658       a_zsr(2,je) = -3.31529
9659       a_zsr(3,je) =  9.26392
9660       a_zsr(4,je) = -14.89799
9661       a_zsr(5,je) =  12.08781
9662       a_zsr(6,je) = -3.89958
9663       aw_min(je)  = 0.1
9664 !
9665 ! hcl
9666       je = jhcl
9667       a_zsr(1,je) =  0.31133
9668       a_zsr(2,je) = -0.79688
9669       a_zsr(3,je) =  1.93995
9670       a_zsr(4,je) = -3.31582
9671       a_zsr(5,je) =  2.93513
9672       a_zsr(6,je) = -1.07268
9673       aw_min(je)  = 0.1
9674 !
9675 ! caso4
9676       je = jcaso4
9677       a_zsr(1,je)  =  0.0
9678       a_zsr(2,je)  =  0.0
9679       a_zsr(3,je)  =  0.0
9680       a_zsr(4,je)  =  0.0
9681       a_zsr(5,je)  =  0.0
9682       a_zsr(6,je)  =  0.0
9683       aw_min(je)   = 1.0
9684 !
9685 ! ca(msa)2 (assumed same as ca(no3)2)
9686       je = jcamsa2
9687       a_zsr(1,je)  =  0.38895
9688       a_zsr(2,je)  = -1.16013
9689       a_zsr(3,je)  =  2.16819
9690       a_zsr(4,je)  = -2.23079
9691       a_zsr(5,je)  =  1.00268
9692       a_zsr(6,je)  = -0.16923
9693       aw_min(je)   = 0.1
9694 !
9695 ! caco3
9696       je = jcaco3
9697       a_zsr(1,je)  =  0.0
9698       a_zsr(2,je)  =  0.0
9699       a_zsr(3,je)  =  0.0
9700       a_zsr(4,je)  =  0.0
9701       a_zsr(5,je)  =  0.0
9702       a_zsr(6,je)  =  0.0
9703       aw_min(je)   = 1.0
9704
9705
9706
9707 !-------------------------------------------
9708 ! b_zsr for aw => 0.97 to 0.99999
9709 !
9710 ! (nh4)2so4
9711       b_zsr(jnh4so4)  = 28.0811
9712 !
9713 ! (nh4)3h(so4)2
9714       b_zsr(jlvcite)  = 14.7178
9715 !
9716 ! nh4hso4
9717       b_zsr(jnh4hso4) = 29.4779
9718 !
9719 ! nh4msa
9720       b_zsr(jnh4msa)  = 29.4779 ! assumed same as nh4hso4
9721 !
9722 ! nh4no3
9723       b_zsr(jnh4no3)  = 33.4049
9724 !
9725 ! nh4cl
9726       b_zsr(jnh4cl)   = 30.8888
9727 !
9728 ! nacl
9729       b_zsr(jnacl)    = 29.8375
9730 !
9731 ! nano3
9732       b_zsr(jnano3)   = 32.2756
9733 !
9734 ! na2so4
9735       b_zsr(jna2so4)  = 27.6889
9736 !
9737 ! na3h(so4)2
9738       b_zsr(jna3hso4) = 14.2184
9739 !
9740 ! nahso4
9741       b_zsr(jnahso4)  = 28.3367
9742 !
9743 ! namsa
9744       b_zsr(jnamsa)   = 28.3367 ! assumed same as nahso4
9745 !
9746 ! ca(no3)2
9747       b_zsr(jcano3)   = 18.3661
9748 !
9749 ! cacl2
9750       b_zsr(jcacl2)   = 20.8792
9751 !
9752 ! h2so4
9753       b_zsr(jh2so4)   = 26.7347
9754 !
9755 ! hhso4
9756       b_zsr(jhhso4)   = 26.7347
9757 !
9758 ! hno3
9759       b_zsr(jhno3)    = 28.8257
9760 !
9761 ! hcl
9762       b_zsr(jhcl)     = 27.7108
9763 !
9764 ! msa
9765       b_zsr(jmsa)     = 26.7347 ! assumed same as h2so4
9766 !
9767 ! caso4
9768       b_zsr(jcaso4)   = 0.0
9769 !
9770 ! ca(msa)2
9771       b_zsr(jcamsa2)  = 18.3661 ! assumed same as Ca(NO3)2
9772 !
9773 ! caco3
9774       b_zsr(jcaco3)   = 0.0
9775
9776
9777
9778
9779
9780
9781
9782 !----------------------------------------------------------------
9783 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
9784 ! log_gamz(ja,je)   a in e
9785 !----------------------------------------------------------------
9786 !
9787 ! (nh4)2so4 in e
9788       ja = jnh4so4
9789
9790 ! in (nh4)2so4
9791       je = jnh4so4
9792       b_mtem(1,ja,je) = -2.94685
9793       b_mtem(2,ja,je) = 17.3328
9794       b_mtem(3,ja,je) = -64.8441
9795       b_mtem(4,ja,je) = 122.7070
9796       b_mtem(5,ja,je) = -114.4373
9797       b_mtem(6,ja,je) = 41.6811
9798
9799 ! in nh4no3
9800       je = jnh4no3
9801       b_mtem(1,ja,je) = -2.7503
9802       b_mtem(2,ja,je) = 4.3806
9803       b_mtem(3,ja,je) = -1.1110
9804       b_mtem(4,ja,je) = -1.7005
9805       b_mtem(5,ja,je) = -4.4207
9806       b_mtem(6,ja,je) = 5.1990
9807
9808 ! in nh4cl (revised on 11/15/2003)
9809       je = jnh4cl
9810       b_mtem(1,ja,je) = -2.06952
9811       b_mtem(2,ja,je) = 7.1240
9812       b_mtem(3,ja,je) = -24.4274
9813       b_mtem(4,ja,je) = 51.1458
9814       b_mtem(5,ja,je) = -54.2056
9815       b_mtem(6,ja,je) = 22.0606
9816
9817 ! in na2so4
9818       je = jna2so4
9819       b_mtem(1,ja,je) = -2.17361
9820       b_mtem(2,ja,je) = 15.9919
9821       b_mtem(3,ja,je) = -69.0952
9822       b_mtem(4,ja,je) = 139.8860
9823       b_mtem(5,ja,je) = -134.9890
9824       b_mtem(6,ja,je) = 49.8877
9825
9826 ! in nano3
9827       je = jnano3
9828       b_mtem(1,ja,je) = -4.4370
9829       b_mtem(2,ja,je) = 24.0243
9830       b_mtem(3,ja,je) = -76.2437
9831       b_mtem(4,ja,je) = 128.6660
9832       b_mtem(5,ja,je) = -110.0900
9833       b_mtem(6,ja,je) = 37.7414
9834
9835 ! in nacl
9836       je = jnacl
9837       b_mtem(1,ja,je) = -1.5394
9838       b_mtem(2,ja,je) = 5.8671
9839       b_mtem(3,ja,je) = -22.7726
9840       b_mtem(4,ja,je) = 47.0547
9841       b_mtem(5,ja,je) = -47.8266
9842       b_mtem(6,ja,je) = 18.8489
9843
9844 ! in hno3
9845       je = jhno3
9846       b_mtem(1,ja,je) = -0.35750
9847       b_mtem(2,ja,je) = -3.82466
9848       b_mtem(3,ja,je) = 4.55462
9849       b_mtem(4,ja,je) = 5.05402
9850       b_mtem(5,ja,je) = -14.7476
9851       b_mtem(6,ja,je) = 8.8009
9852
9853 ! in hcl
9854       je = jhcl
9855       b_mtem(1,ja,je) = -2.15146
9856       b_mtem(2,ja,je) = 5.50205
9857       b_mtem(3,ja,je) = -19.1476
9858       b_mtem(4,ja,je) = 39.1880
9859       b_mtem(5,ja,je) = -39.9460
9860       b_mtem(6,ja,je) = 16.0700
9861
9862 ! in h2so4
9863       je = jh2so4
9864       b_mtem(1,ja,je) = -2.52604
9865       b_mtem(2,ja,je) = 9.76022
9866       b_mtem(3,ja,je) = -35.2540
9867       b_mtem(4,ja,je) = 71.2981
9868       b_mtem(5,ja,je) = -71.8207
9869       b_mtem(6,ja,je) = 28.0758
9870
9871 !
9872 ! in nh4hso4
9873       je = jnh4hso4
9874       b_mtem(1,ja,je) = -4.13219
9875       b_mtem(2,ja,je) = 13.8863
9876       b_mtem(3,ja,je) = -34.5387
9877       b_mtem(4,ja,je) = 56.5012
9878       b_mtem(5,ja,je) = -51.8702
9879       b_mtem(6,ja,je) = 19.6232
9880
9881 !
9882 ! in (nh4)3h(so4)2
9883       je = jlvcite
9884       b_mtem(1,ja,je) = -2.53482
9885       b_mtem(2,ja,je) = 12.3333
9886       b_mtem(3,ja,je) = -46.1020
9887       b_mtem(4,ja,je) = 90.4775
9888       b_mtem(5,ja,je) = -88.1254
9889       b_mtem(6,ja,je) = 33.4715
9890
9891 !
9892 ! in nahso4
9893       je = jnahso4
9894       b_mtem(1,ja,je) = -3.23425
9895       b_mtem(2,ja,je) = 18.7842
9896       b_mtem(3,ja,je) = -78.7807
9897       b_mtem(4,ja,je) = 161.517
9898       b_mtem(5,ja,je) = -154.940
9899       b_mtem(6,ja,je) = 56.2252
9900
9901 !
9902 ! in na3h(so4)2
9903       je = jna3hso4
9904       b_mtem(1,ja,je) = -1.25316
9905       b_mtem(2,ja,je) = 7.40960
9906       b_mtem(3,ja,je) = -34.8929
9907       b_mtem(4,ja,je) = 72.8853
9908       b_mtem(5,ja,je) = -72.4503
9909       b_mtem(6,ja,je) = 27.7706
9910
9911
9912 !-----------------
9913 ! nh4no3 in e
9914       ja = jnh4no3
9915
9916 ! in (nh4)2so4
9917       je = jnh4so4
9918       b_mtem(1,ja,je) = -3.5201
9919       b_mtem(2,ja,je) = 21.6584
9920       b_mtem(3,ja,je) = -72.1499
9921       b_mtem(4,ja,je) = 126.7000
9922       b_mtem(5,ja,je) = -111.4550
9923       b_mtem(6,ja,je) = 38.5677
9924
9925 ! in nh4no3
9926       je = jnh4no3
9927       b_mtem(1,ja,je) = -2.2630
9928       b_mtem(2,ja,je) = -0.1518
9929       b_mtem(3,ja,je) = 17.0898
9930       b_mtem(4,ja,je) = -36.7832
9931       b_mtem(5,ja,je) = 29.8407
9932       b_mtem(6,ja,je) = -7.9314
9933
9934 ! in nh4cl (revised on 11/15/2003)
9935       je = jnh4cl
9936       b_mtem(1,ja,je) = -1.3851
9937       b_mtem(2,ja,je) = -0.4462
9938       b_mtem(3,ja,je) = 8.4567
9939       b_mtem(4,ja,je) = -11.5988
9940       b_mtem(5,ja,je) = 2.9802
9941       b_mtem(6,ja,je) = 1.8132
9942
9943 ! in na2so4
9944       je = jna2so4
9945       b_mtem(1,ja,je) = -1.7602
9946       b_mtem(2,ja,je) = 10.4044
9947       b_mtem(3,ja,je) = -35.5894
9948       b_mtem(4,ja,je) = 64.3584
9949       b_mtem(5,ja,je) = -57.8931
9950       b_mtem(6,ja,je) = 20.2141
9951
9952 ! in nano3
9953       je = jnano3
9954       b_mtem(1,ja,je) = -3.24346
9955       b_mtem(2,ja,je) = 16.2794
9956       b_mtem(3,ja,je) = -48.7601
9957       b_mtem(4,ja,je) = 79.2246
9958       b_mtem(5,ja,je) = -65.8169
9959       b_mtem(6,ja,je) = 22.1500
9960
9961 ! in nacl
9962       je = jnacl
9963       b_mtem(1,ja,je) = -1.75658
9964       b_mtem(2,ja,je) = 7.71384
9965       b_mtem(3,ja,je) = -22.7984
9966       b_mtem(4,ja,je) = 39.1532
9967       b_mtem(5,ja,je) = -34.6165
9968       b_mtem(6,ja,je) = 12.1283
9969
9970 ! in ca(no3)2
9971       je = jcano3
9972       b_mtem(1,ja,je) = -0.97178
9973       b_mtem(2,ja,je) = 6.61964
9974       b_mtem(3,ja,je) = -26.2353
9975       b_mtem(4,ja,je) = 50.5259
9976       b_mtem(5,ja,je) = -47.6586
9977       b_mtem(6,ja,je) = 17.5074
9978
9979 ! in cacl2 added on 12/22/2003
9980       je = jcacl2
9981       b_mtem(1,ja,je) = -0.41515
9982       b_mtem(2,ja,je) = 6.44101
9983       b_mtem(3,ja,je) = -26.4473
9984       b_mtem(4,ja,je) = 49.0718
9985       b_mtem(5,ja,je) = -44.2631
9986       b_mtem(6,ja,je) = 15.3771
9987
9988 ! in hno3
9989       je = jhno3
9990       b_mtem(1,ja,je) = -1.20644
9991       b_mtem(2,ja,je) = 5.70117
9992       b_mtem(3,ja,je) = -18.2783
9993       b_mtem(4,ja,je) = 31.7199
9994       b_mtem(5,ja,je) = -27.8703
9995       b_mtem(6,ja,je) = 9.7299
9996
9997 ! in hcl
9998       je = jhcl
9999       b_mtem(1,ja,je) = -0.680862
10000       b_mtem(2,ja,je) = 3.59456
10001       b_mtem(3,ja,je) = -10.7969
10002       b_mtem(4,ja,je) = 17.8434
10003       b_mtem(5,ja,je) = -15.3165
10004       b_mtem(6,ja,je) = 5.17123
10005
10006
10007 !----------
10008 ! nh4cl in e
10009       ja = jnh4cl
10010
10011 ! in (nh4)2so4
10012       je = jnh4so4
10013       b_mtem(1,ja,je) = -2.8850
10014       b_mtem(2,ja,je) = 20.6970
10015       b_mtem(3,ja,je) = -70.6810
10016       b_mtem(4,ja,je) = 124.3690
10017       b_mtem(5,ja,je) = -109.2880
10018       b_mtem(6,ja,je) = 37.5831
10019
10020 ! in nh4no3
10021       je = jnh4no3
10022       b_mtem(1,ja,je) = -1.9386
10023       b_mtem(2,ja,je) = 1.3238
10024       b_mtem(3,ja,je) = 11.8500
10025       b_mtem(4,ja,je) = -28.1168
10026       b_mtem(5,ja,je) = 21.8543
10027       b_mtem(6,ja,je) = -5.1671
10028
10029 ! in nh4cl (revised on 11/15/2003)
10030       je = jnh4cl
10031       b_mtem(1,ja,je) = -0.9559
10032       b_mtem(2,ja,je) = 0.8121
10033       b_mtem(3,ja,je) = 4.3644
10034       b_mtem(4,ja,je) = -8.9258
10035       b_mtem(5,ja,je) = 4.2362
10036       b_mtem(6,ja,je) = 0.2891
10037
10038 ! in na2so4
10039       je = jna2so4
10040       b_mtem(1,ja,je) = 0.0377
10041       b_mtem(2,ja,je) = 6.0752
10042       b_mtem(3,ja,je) = -30.8641
10043       b_mtem(4,ja,je) = 63.3095
10044       b_mtem(5,ja,je) = -61.0070
10045       b_mtem(6,ja,je) = 22.1734
10046
10047 ! in nano3
10048       je = jnano3
10049       b_mtem(1,ja,je) = -1.8336
10050       b_mtem(2,ja,je) = 12.8160
10051       b_mtem(3,ja,je) = -42.3388
10052       b_mtem(4,ja,je) = 71.1816
10053       b_mtem(5,ja,je) = -60.5708
10054       b_mtem(6,ja,je) = 20.5853
10055
10056 ! in nacl
10057       je = jnacl
10058       b_mtem(1,ja,je) = -0.1429
10059       b_mtem(2,ja,je) = 2.3561
10060       b_mtem(3,ja,je) = -10.4425
10061       b_mtem(4,ja,je) = 20.8951
10062       b_mtem(5,ja,je) = -20.7739
10063       b_mtem(6,ja,je) = 7.9355
10064
10065 ! in ca(no3)2
10066       je = jcano3
10067       b_mtem(1,ja,je) = 0.76235
10068       b_mtem(2,ja,je) = 3.08323
10069       b_mtem(3,ja,je) = -23.6772
10070       b_mtem(4,ja,je) = 53.7415
10071       b_mtem(5,ja,je) = -55.4043
10072       b_mtem(6,ja,je) = 21.2944
10073
10074 ! in cacl2 (revised on 11/27/2003)
10075       je = jcacl2
10076       b_mtem(1,ja,je) = 1.13864
10077       b_mtem(2,ja,je) = -0.340539
10078       b_mtem(3,ja,je) = -8.67025
10079       b_mtem(4,ja,je) = 22.8008
10080       b_mtem(5,ja,je) = -24.5181
10081       b_mtem(6,ja,je) = 9.3663
10082
10083 ! in hno3
10084       je = jhno3
10085       b_mtem(1,ja,je) = 2.42532
10086       b_mtem(2,ja,je) = -14.1755
10087       b_mtem(3,ja,je) = 38.804
10088       b_mtem(4,ja,je) = -58.2437
10089       b_mtem(5,ja,je) = 43.5431
10090       b_mtem(6,ja,je) = -12.5824
10091
10092 ! in hcl
10093       je = jhcl
10094       b_mtem(1,ja,je) = 0.330337
10095       b_mtem(2,ja,je) = 0.0778934
10096       b_mtem(3,ja,je) = -2.30492
10097       b_mtem(4,ja,je) = 4.73003
10098       b_mtem(5,ja,je) = -4.80849
10099       b_mtem(6,ja,je) = 1.78866
10100
10101
10102 !----------
10103 ! na2so4 in e
10104       ja = jna2so4
10105
10106 ! in (nh4)2so4
10107       je = jnh4so4
10108       b_mtem(1,ja,je) = -2.6982
10109       b_mtem(2,ja,je) = 22.9875
10110       b_mtem(3,ja,je) = -98.9840
10111       b_mtem(4,ja,je) = 198.0180
10112       b_mtem(5,ja,je) = -188.7270
10113       b_mtem(6,ja,je) = 69.0548
10114
10115 ! in nh4no3
10116       je = jnh4no3
10117       b_mtem(1,ja,je) = -2.4844
10118       b_mtem(2,ja,je) = 6.5420
10119       b_mtem(3,ja,je) = -9.8998
10120       b_mtem(4,ja,je) = 11.3884
10121       b_mtem(5,ja,je) = -13.6842
10122       b_mtem(6,ja,je) = 7.7411
10123
10124 ! in nh4cl (revised on 11/15/2003)
10125       je = jnh4cl
10126       b_mtem(1,ja,je) = -1.3325
10127       b_mtem(2,ja,je) = 13.0406
10128       b_mtem(3,ja,je) = -56.1935
10129       b_mtem(4,ja,je) = 107.1170
10130       b_mtem(5,ja,je) = -97.3721
10131       b_mtem(6,ja,je) = 34.3763
10132
10133 ! in na2so4
10134       je = jna2so4
10135       b_mtem(1,ja,je) = -1.2832
10136       b_mtem(2,ja,je) = 12.8526
10137       b_mtem(3,ja,je) = -62.2087
10138       b_mtem(4,ja,je) = 130.3876
10139       b_mtem(5,ja,je) = -128.2627
10140       b_mtem(6,ja,je) = 48.0340
10141
10142 ! in nano3
10143       je = jnano3
10144       b_mtem(1,ja,je) = -3.5384
10145       b_mtem(2,ja,je) = 21.3758
10146       b_mtem(3,ja,je) = -70.7638
10147       b_mtem(4,ja,je) = 121.1580
10148       b_mtem(5,ja,je) = -104.6230
10149       b_mtem(6,ja,je) = 36.0557
10150
10151 ! in nacl
10152       je = jnacl
10153       b_mtem(1,ja,je) = 0.2175
10154       b_mtem(2,ja,je) = -0.5648
10155       b_mtem(3,ja,je) = -8.0288
10156       b_mtem(4,ja,je) = 25.9734
10157       b_mtem(5,ja,je) = -32.3577
10158       b_mtem(6,ja,je) = 14.3924
10159
10160 ! in hno3
10161       je = jhno3
10162       b_mtem(1,ja,je) = -0.309617
10163       b_mtem(2,ja,je) = -1.82899
10164       b_mtem(3,ja,je) = -1.5505
10165       b_mtem(4,ja,je) = 13.3847
10166       b_mtem(5,ja,je) = -20.1284
10167       b_mtem(6,ja,je) = 9.93163
10168
10169 ! in hcl
10170       je = jhcl
10171       b_mtem(1,ja,je) = -0.259455
10172       b_mtem(2,ja,je) = -0.819366
10173       b_mtem(3,ja,je) = -4.28964
10174       b_mtem(4,ja,je) = 16.4305
10175       b_mtem(5,ja,je) = -21.8546
10176       b_mtem(6,ja,je) = 10.3044
10177
10178 ! in h2so4
10179       je = jh2so4
10180       b_mtem(1,ja,je) = -1.84257
10181       b_mtem(2,ja,je) = 7.85788
10182       b_mtem(3,ja,je) = -29.9275
10183       b_mtem(4,ja,je) = 61.7515
10184       b_mtem(5,ja,je) = -63.2308
10185       b_mtem(6,ja,je) = 24.9542
10186
10187 ! in nh4hso4
10188       je = jnh4hso4
10189       b_mtem(1,ja,je) = -1.05891
10190       b_mtem(2,ja,je) = 2.84831
10191       b_mtem(3,ja,je) = -21.1827
10192       b_mtem(4,ja,je) = 57.5175
10193       b_mtem(5,ja,je) = -64.8120
10194       b_mtem(6,ja,je) = 26.1986
10195
10196 ! in (nh4)3h(so4)2
10197       je = jlvcite
10198       b_mtem(1,ja,je) = -1.16584
10199       b_mtem(2,ja,je) = 8.50075
10200       b_mtem(3,ja,je) = -44.3420
10201       b_mtem(4,ja,je) = 97.3974
10202       b_mtem(5,ja,je) = -98.4549
10203       b_mtem(6,ja,je) = 37.6104
10204
10205 ! in nahso4
10206       je = jnahso4
10207       b_mtem(1,ja,je) = -1.95805
10208       b_mtem(2,ja,je) = 6.62417
10209       b_mtem(3,ja,je) = -31.8072
10210       b_mtem(4,ja,je) = 77.8603
10211       b_mtem(5,ja,je) = -84.6458
10212       b_mtem(6,ja,je) = 33.4963
10213
10214 ! in na3h(so4)2
10215       je = jna3hso4
10216       b_mtem(1,ja,je) = -0.36045
10217       b_mtem(2,ja,je) = 3.55223
10218       b_mtem(3,ja,je) = -24.0327
10219       b_mtem(4,ja,je) = 54.4879
10220       b_mtem(5,ja,je) = -56.6531
10221       b_mtem(6,ja,je) = 22.4956
10222
10223
10224 !----------
10225 ! nano3 in e
10226       ja = jnano3
10227
10228 ! in (nh4)2so4
10229       je = jnh4so4
10230       b_mtem(1,ja,je) = -2.5888
10231       b_mtem(2,ja,je) = 17.6192
10232       b_mtem(3,ja,je) = -63.2183
10233       b_mtem(4,ja,je) = 115.3520
10234       b_mtem(5,ja,je) = -104.0860
10235       b_mtem(6,ja,je) = 36.7390
10236
10237 ! in nh4no3
10238       je = jnh4no3
10239       b_mtem(1,ja,je) = -2.0669
10240       b_mtem(2,ja,je) = 1.4792
10241       b_mtem(3,ja,je) = 10.5261
10242       b_mtem(4,ja,je) = -27.0987
10243       b_mtem(5,ja,je) = 23.0591
10244       b_mtem(6,ja,je) = -6.0938
10245
10246 ! in nh4cl (revised on 11/15/2003)
10247       je = jnh4cl
10248       b_mtem(1,ja,je) = -0.8325
10249       b_mtem(2,ja,je) = 3.9933
10250       b_mtem(3,ja,je) = -15.3789
10251       b_mtem(4,ja,je) = 30.4050
10252       b_mtem(5,ja,je) = -29.4204
10253       b_mtem(6,ja,je) = 11.0597
10254
10255 ! in na2so4
10256       je = jna2so4
10257       b_mtem(1,ja,je) = -1.1233
10258       b_mtem(2,ja,je) = 8.3998
10259       b_mtem(3,ja,je) = -31.9002
10260       b_mtem(4,ja,je) = 60.1450
10261       b_mtem(5,ja,je) = -55.5503
10262       b_mtem(6,ja,je) = 19.7757
10263
10264 ! in nano3
10265       je = jnano3
10266       b_mtem(1,ja,je) = -2.5386
10267       b_mtem(2,ja,je) = 13.9039
10268       b_mtem(3,ja,je) = -42.8467
10269       b_mtem(4,ja,je) = 69.7442
10270       b_mtem(5,ja,je) = -57.8988
10271       b_mtem(6,ja,je) = 19.4635
10272
10273 ! in nacl
10274       je = jnacl
10275       b_mtem(1,ja,je) = -0.4351
10276       b_mtem(2,ja,je) = 2.8311
10277       b_mtem(3,ja,je) = -11.4485
10278       b_mtem(4,ja,je) = 22.7201
10279       b_mtem(5,ja,je) = -22.4228
10280       b_mtem(6,ja,je) = 8.5792
10281
10282 ! in ca(no3)2
10283       je = jcano3
10284       b_mtem(1,ja,je) = -0.72060
10285       b_mtem(2,ja,je) = 5.64915
10286       b_mtem(3,ja,je) = -23.5020
10287       b_mtem(4,ja,je) = 46.0078
10288       b_mtem(5,ja,je) = -43.8075
10289       b_mtem(6,ja,je) = 16.1652
10290
10291 ! in cacl2
10292       je = jcacl2
10293       b_mtem(1,ja,je) = 0.003928
10294       b_mtem(2,ja,je) = 3.54724
10295       b_mtem(3,ja,je) = -18.6057
10296       b_mtem(4,ja,je) = 38.1445
10297       b_mtem(5,ja,je) = -36.7745
10298       b_mtem(6,ja,je) = 13.4529
10299
10300 ! in hno3
10301       je = jhno3
10302       b_mtem(1,ja,je) = -1.1712
10303       b_mtem(2,ja,je) = 7.20907
10304       b_mtem(3,ja,je) = -22.9215
10305       b_mtem(4,ja,je) = 38.1257
10306       b_mtem(5,ja,je) = -32.0759
10307       b_mtem(6,ja,je) = 10.6443
10308
10309 ! in hcl
10310       je = jhcl
10311       b_mtem(1,ja,je) = 0.738022
10312       b_mtem(2,ja,je) = -1.14313
10313       b_mtem(3,ja,je) = 0.32251
10314       b_mtem(4,ja,je) = 0.838679
10315       b_mtem(5,ja,je) = -1.81747
10316       b_mtem(6,ja,je) = 0.873986
10317
10318
10319 !----------
10320 ! nacl in e
10321       ja = jnacl
10322
10323 ! in (nh4)2so4
10324       je = jnh4so4
10325       b_mtem(1,ja,je) = -1.9525
10326       b_mtem(2,ja,je) = 16.6433
10327       b_mtem(3,ja,je) = -61.7090
10328       b_mtem(4,ja,je) = 112.9910
10329       b_mtem(5,ja,je) = -101.9370
10330       b_mtem(6,ja,je) = 35.7760
10331
10332 ! in nh4no3
10333       je = jnh4no3
10334       b_mtem(1,ja,je) = -1.7525
10335       b_mtem(2,ja,je) = 3.0713
10336       b_mtem(3,ja,je) = 4.8063
10337       b_mtem(4,ja,je) = -17.5334
10338       b_mtem(5,ja,je) = 14.2872
10339       b_mtem(6,ja,je) = -3.0690
10340
10341 ! in nh4cl (revised on 11/15/2003)
10342       je = jnh4cl
10343       b_mtem(1,ja,je) = -0.4021
10344       b_mtem(2,ja,je) = 5.2399
10345       b_mtem(3,ja,je) = -19.4278
10346       b_mtem(4,ja,je) = 33.0027
10347       b_mtem(5,ja,je) = -28.1020
10348       b_mtem(6,ja,je) = 9.5159
10349
10350 ! in na2so4
10351       je = jna2so4
10352       b_mtem(1,ja,je) = 0.6692
10353       b_mtem(2,ja,je) = 4.1207
10354       b_mtem(3,ja,je) = -27.3314
10355       b_mtem(4,ja,je) = 59.3112
10356       b_mtem(5,ja,je) = -58.7998
10357       b_mtem(6,ja,je) = 21.7674
10358
10359 ! in nano3
10360       je = jnano3
10361       b_mtem(1,ja,je) = -1.17444
10362       b_mtem(2,ja,je) = 10.9927
10363       b_mtem(3,ja,je) = -38.9013
10364       b_mtem(4,ja,je) = 66.8521
10365       b_mtem(5,ja,je) = -57.6564
10366       b_mtem(6,ja,je) = 19.7296
10367
10368 ! in nacl
10369       je = jnacl
10370       b_mtem(1,ja,je) = 1.17679
10371       b_mtem(2,ja,je) = -2.5061
10372       b_mtem(3,ja,je) = 0.8508
10373       b_mtem(4,ja,je) = 4.4802
10374       b_mtem(5,ja,je) = -8.4945
10375       b_mtem(6,ja,je) = 4.3182
10376
10377 ! in ca(no3)2
10378       je = jcano3
10379       b_mtem(1,ja,je) = 1.01450
10380       b_mtem(2,ja,je) = 2.10260
10381       b_mtem(3,ja,je) = -20.9036
10382       b_mtem(4,ja,je) = 49.1481
10383       b_mtem(5,ja,je) = -51.4867
10384       b_mtem(6,ja,je) = 19.9301
10385
10386 ! in cacl2 (psc92: revised on 11/27/2003)
10387       je = jcacl2
10388       b_mtem(1,ja,je) = 1.55463
10389       b_mtem(2,ja,je) = -3.20122
10390       b_mtem(3,ja,je) = -0.957075
10391       b_mtem(4,ja,je) = 12.103
10392       b_mtem(5,ja,je) = -17.221
10393       b_mtem(6,ja,je) = 7.50264
10394
10395 ! in hno3
10396       je = jhno3
10397       b_mtem(1,ja,je) = 2.46187
10398       b_mtem(2,ja,je) = -12.6845
10399       b_mtem(3,ja,je) = 34.2383
10400       b_mtem(4,ja,je) = -51.9992
10401       b_mtem(5,ja,je) = 39.4934
10402       b_mtem(6,ja,je) = -11.7247
10403
10404 ! in hcl
10405       je = jhcl
10406       b_mtem(1,ja,je) = 1.74915
10407       b_mtem(2,ja,je) = -4.65768
10408       b_mtem(3,ja,je) = 8.80287
10409       b_mtem(4,ja,je) = -12.2503
10410       b_mtem(5,ja,je) = 8.668751
10411       b_mtem(6,ja,je) = -2.50158
10412
10413
10414 !----------
10415 ! ca(no3)2 in e
10416       ja = jcano3
10417
10418 ! in nh4no3
10419       je = jnh4no3
10420       b_mtem(1,ja,je) = -1.86260
10421       b_mtem(2,ja,je) = 11.6178
10422       b_mtem(3,ja,je) = -30.9069
10423       b_mtem(4,ja,je) = 41.7578
10424       b_mtem(5,ja,je) = -33.7338
10425       b_mtem(6,ja,je) = 12.7541
10426
10427 ! in nh4cl (revised on 11/15/2003)
10428       je = jnh4cl
10429       b_mtem(1,ja,je) = -1.1798
10430       b_mtem(2,ja,je) = 25.9608
10431       b_mtem(3,ja,je) = -98.9373
10432       b_mtem(4,ja,je) = 160.2300
10433       b_mtem(5,ja,je) = -125.9540
10434       b_mtem(6,ja,je) = 39.5130
10435
10436 ! in nano3
10437       je = jnano3
10438       b_mtem(1,ja,je) = -1.44384
10439       b_mtem(2,ja,je) = 13.6044
10440       b_mtem(3,ja,je) = -54.4300
10441       b_mtem(4,ja,je) = 100.582
10442       b_mtem(5,ja,je) = -91.2364
10443       b_mtem(6,ja,je) = 32.5970
10444
10445 ! in nacl
10446       je = jnacl
10447       b_mtem(1,ja,je) = -0.099114
10448       b_mtem(2,ja,je) = 2.84091
10449       b_mtem(3,ja,je) = -16.9229
10450       b_mtem(4,ja,je) = 37.4839
10451       b_mtem(5,ja,je) = -39.5132
10452       b_mtem(6,ja,je) = 15.8564
10453
10454 ! in ca(no3)2
10455       je = jcano3
10456       b_mtem(1,ja,je) = 0.055116
10457       b_mtem(2,ja,je) = 4.58610
10458       b_mtem(3,ja,je) = -27.6629
10459       b_mtem(4,ja,je) = 60.8288
10460       b_mtem(5,ja,je) = -61.4988
10461       b_mtem(6,ja,je) = 23.3136
10462
10463 ! in cacl2 (psc92: revised on 11/27/2003)
10464       je = jcacl2
10465       b_mtem(1,ja,je) = 1.57155
10466       b_mtem(2,ja,je) = -3.18486
10467       b_mtem(3,ja,je) = -3.35758
10468       b_mtem(4,ja,je) = 18.7501
10469       b_mtem(5,ja,je) = -24.5604
10470       b_mtem(6,ja,je) = 10.3798
10471
10472 ! in hno3
10473       je = jhno3
10474       b_mtem(1,ja,je) = 1.04446
10475       b_mtem(2,ja,je) = -3.19066
10476       b_mtem(3,ja,je) = 2.44714
10477       b_mtem(4,ja,je) = 2.07218
10478       b_mtem(5,ja,je) = -6.43949
10479       b_mtem(6,ja,je) = 3.66471
10480
10481 ! in hcl
10482       je = jhcl
10483       b_mtem(1,ja,je) = 1.05723
10484       b_mtem(2,ja,je) = -1.46826
10485       b_mtem(3,ja,je) = -1.0713
10486       b_mtem(4,ja,je) = 4.64439
10487       b_mtem(5,ja,je) = -6.32402
10488       b_mtem(6,ja,je) = 2.78202
10489
10490
10491 !----------
10492 ! cacl2 in e
10493       ja = jcacl2
10494
10495 ! in nh4no3 (psc92: revised on 12/22/2003)
10496       je = jnh4no3
10497       b_mtem(1,ja,je) = -1.43626
10498       b_mtem(2,ja,je) = 13.6598
10499       b_mtem(3,ja,je) = -38.2068
10500       b_mtem(4,ja,je) = 53.9057
10501       b_mtem(5,ja,je) = -44.9018
10502       b_mtem(6,ja,je) = 16.6120
10503
10504 ! in nh4cl (psc92: revised on 11/27/2003)
10505       je = jnh4cl
10506       b_mtem(1,ja,je) = -0.603965
10507       b_mtem(2,ja,je) = 27.6027
10508       b_mtem(3,ja,je) = -104.258
10509       b_mtem(4,ja,je) = 163.553
10510       b_mtem(5,ja,je) = -124.076
10511       b_mtem(6,ja,je) = 37.4153
10512
10513 ! in nano3 (psc92: revised on 12/22/2003)
10514       je = jnano3
10515       b_mtem(1,ja,je) = 0.44648
10516       b_mtem(2,ja,je) = 8.8850
10517       b_mtem(3,ja,je) = -45.5232
10518       b_mtem(4,ja,je) = 89.3263
10519       b_mtem(5,ja,je) = -83.8604
10520       b_mtem(6,ja,je) = 30.4069
10521
10522 ! in nacl (psc92: revised on 11/27/2003)
10523       je = jnacl
10524       b_mtem(1,ja,je) = 1.61927
10525       b_mtem(2,ja,je) = 0.247547
10526       b_mtem(3,ja,je) = -18.1252
10527       b_mtem(4,ja,je) = 45.2479
10528       b_mtem(5,ja,je) = -48.6072
10529       b_mtem(6,ja,je) = 19.2784
10530
10531 ! in ca(no3)2 (psc92: revised on 11/27/2003)
10532       je = jcano3
10533       b_mtem(1,ja,je) = 2.36667
10534       b_mtem(2,ja,je) = -0.123309
10535       b_mtem(3,ja,je) = -24.2723
10536       b_mtem(4,ja,je) = 65.1486
10537       b_mtem(5,ja,je) = -71.8504
10538       b_mtem(6,ja,je) = 28.3696
10539
10540 ! in cacl2 (psc92: revised on 11/27/2003)
10541       je = jcacl2
10542       b_mtem(1,ja,je) = 3.64023
10543       b_mtem(2,ja,je) = -12.1926
10544       b_mtem(3,ja,je) = 20.2028
10545       b_mtem(4,ja,je) = -16.0056
10546       b_mtem(5,ja,je) = 1.52355
10547       b_mtem(6,ja,je) = 2.44709
10548
10549 ! in hno3
10550       je = jhno3
10551       b_mtem(1,ja,je) = 5.88794
10552       b_mtem(2,ja,je) = -29.7083
10553       b_mtem(3,ja,je) = 78.6309
10554       b_mtem(4,ja,je) = -118.037
10555       b_mtem(5,ja,je) = 88.932
10556       b_mtem(6,ja,je) = -26.1407
10557
10558 ! in hcl
10559       je = jhcl
10560       b_mtem(1,ja,je) = 2.40628
10561       b_mtem(2,ja,je) = -6.16566
10562       b_mtem(3,ja,je) = 10.2851
10563       b_mtem(4,ja,je) = -12.9035
10564       b_mtem(5,ja,je) = 7.7441
10565       b_mtem(6,ja,je) = -1.74821
10566
10567
10568 !----------
10569 ! hno3 in e
10570       ja = jhno3
10571
10572 ! in (nh4)2so4
10573       je = jnh4so4
10574       b_mtem(1,ja,je) = -3.57598
10575       b_mtem(2,ja,je) = 21.5469
10576       b_mtem(3,ja,je) = -77.4111
10577       b_mtem(4,ja,je) = 144.136
10578       b_mtem(5,ja,je) = -132.849
10579       b_mtem(6,ja,je) = 47.9412
10580
10581 ! in nh4no3
10582       je = jnh4no3
10583       b_mtem(1,ja,je) = -2.00209
10584       b_mtem(2,ja,je) = -3.48399
10585       b_mtem(3,ja,je) = 34.9906
10586       b_mtem(4,ja,je) = -68.6653
10587       b_mtem(5,ja,je) = 54.0992
10588       b_mtem(6,ja,je) = -15.1343
10589
10590 ! in nh4cl revised on 12/22/2003
10591       je = jnh4cl
10592       b_mtem(1,ja,je) = -0.63790
10593       b_mtem(2,ja,je) = -1.67730
10594       b_mtem(3,ja,je) = 10.1727
10595       b_mtem(4,ja,je) = -14.9097
10596       b_mtem(5,ja,je) = 7.67410
10597       b_mtem(6,ja,je) = -0.79586
10598
10599 ! in nacl
10600       je = jnacl
10601       b_mtem(1,ja,je) = 1.3446
10602       b_mtem(2,ja,je) = -2.5578
10603       b_mtem(3,ja,je) = 1.3464
10604       b_mtem(4,ja,je) = 2.90537
10605       b_mtem(5,ja,je) = -6.53014
10606       b_mtem(6,ja,je) = 3.31339
10607
10608 ! in nano3
10609       je = jnano3
10610       b_mtem(1,ja,je) = -0.546636
10611       b_mtem(2,ja,je) = 10.3127
10612       b_mtem(3,ja,je) = -39.9603
10613       b_mtem(4,ja,je) = 71.4609
10614       b_mtem(5,ja,je) = -63.4958
10615       b_mtem(6,ja,je) = 22.0679
10616
10617 ! in na2so4
10618       je = jna2so4
10619       b_mtem(1,ja,je) = 1.35059
10620       b_mtem(2,ja,je) = 4.34557
10621       b_mtem(3,ja,je) = -35.8425
10622       b_mtem(4,ja,je) = 80.9868
10623       b_mtem(5,ja,je) = -81.6544
10624       b_mtem(6,ja,je) = 30.4841
10625
10626 ! in ca(no3)2
10627       je = jcano3
10628       b_mtem(1,ja,je) = 0.869414
10629       b_mtem(2,ja,je) = 2.98486
10630       b_mtem(3,ja,je) = -22.255
10631       b_mtem(4,ja,je) = 50.1863
10632       b_mtem(5,ja,je) = -51.214
10633       b_mtem(6,ja,je) = 19.2235
10634
10635 ! in cacl2 (km) revised on 12/22/2003
10636       je = jcacl2
10637       b_mtem(1,ja,je) = 1.42800
10638       b_mtem(2,ja,je) = -1.78959
10639       b_mtem(3,ja,je) = -2.49075
10640       b_mtem(4,ja,je) = 10.1877
10641       b_mtem(5,ja,je) = -12.1948
10642       b_mtem(6,ja,je) = 4.64475
10643
10644 ! in hno3 (added on 12/06/2004)
10645       je = jhno3
10646       b_mtem(1,ja,je) = 0.22035
10647       b_mtem(2,ja,je) = 2.94973
10648       b_mtem(3,ja,je) = -12.1469
10649       b_mtem(4,ja,je) = 20.4905
10650       b_mtem(5,ja,je) = -17.3966
10651       b_mtem(6,ja,je) = 5.70779
10652
10653 ! in hcl (added on 12/06/2004)
10654       je = jhcl
10655       b_mtem(1,ja,je) = 1.55503
10656       b_mtem(2,ja,je) = -3.61226
10657       b_mtem(3,ja,je) = 6.28265
10658       b_mtem(4,ja,je) = -8.69575
10659       b_mtem(5,ja,je) = 6.09372
10660       b_mtem(6,ja,je) = -1.80898
10661
10662 ! in h2so4
10663       je = jh2so4
10664       b_mtem(1,ja,je) = 1.10783
10665       b_mtem(2,ja,je) = -1.3363
10666       b_mtem(3,ja,je) = -1.83525
10667       b_mtem(4,ja,je) = 7.47373
10668       b_mtem(5,ja,je) = -9.72954
10669       b_mtem(6,ja,je) = 4.12248
10670
10671 ! in nh4hso4
10672       je = jnh4hso4
10673       b_mtem(1,ja,je) = -0.851026
10674       b_mtem(2,ja,je) = 12.2515
10675       b_mtem(3,ja,je) = -49.788
10676       b_mtem(4,ja,je) = 91.6215
10677       b_mtem(5,ja,je) = -81.4877
10678       b_mtem(6,ja,je) = 28.0002
10679
10680 ! in (nh4)3h(so4)2
10681       je = jlvcite
10682       b_mtem(1,ja,je) = -3.09464
10683       b_mtem(2,ja,je) = 14.9303
10684       b_mtem(3,ja,je) = -43.0454
10685       b_mtem(4,ja,je) = 72.6695
10686       b_mtem(5,ja,je) = -65.2140
10687       b_mtem(6,ja,je) = 23.4814
10688
10689 ! in nahso4
10690       je = jnahso4
10691       b_mtem(1,ja,je) = 1.22973
10692       b_mtem(2,ja,je) = 2.82702
10693       b_mtem(3,ja,je) = -17.5869
10694       b_mtem(4,ja,je) = 28.9564
10695       b_mtem(5,ja,je) = -23.5814
10696       b_mtem(6,ja,je) = 7.91153
10697
10698 ! in na3h(so4)2
10699       je = jna3hso4
10700       b_mtem(1,ja,je) = 1.64773
10701       b_mtem(2,ja,je) = 0.94188
10702       b_mtem(3,ja,je) = -19.1242
10703       b_mtem(4,ja,je) = 46.9887
10704       b_mtem(5,ja,je) = -50.9494
10705       b_mtem(6,ja,je) = 20.2169
10706
10707
10708 !----------
10709 ! hcl in e
10710       ja = jhcl
10711
10712 ! in (nh4)2so4
10713       je = jnh4so4
10714       b_mtem(1,ja,je) = -2.93783
10715       b_mtem(2,ja,je) = 20.5546
10716       b_mtem(3,ja,je) = -75.8548
10717       b_mtem(4,ja,je) = 141.729
10718       b_mtem(5,ja,je) = -130.697
10719       b_mtem(6,ja,je) = 46.9905
10720
10721 ! in nh4no3
10722       je = jnh4no3
10723       b_mtem(1,ja,je) = -1.69063
10724       b_mtem(2,ja,je) = -1.85303
10725       b_mtem(3,ja,je) = 29.0927
10726       b_mtem(4,ja,je) = -58.7401
10727       b_mtem(5,ja,je) = 44.999
10728       b_mtem(6,ja,je) = -11.9988
10729
10730 ! in nh4cl (revised on 11/15/2003)
10731       je = jnh4cl
10732       b_mtem(1,ja,je) = -0.2073
10733       b_mtem(2,ja,je) = -0.4322
10734       b_mtem(3,ja,je) = 6.1271
10735       b_mtem(4,ja,je) = -12.3146
10736       b_mtem(5,ja,je) = 8.9919
10737       b_mtem(6,ja,je) = -2.3388
10738
10739 ! in nacl
10740       je = jnacl
10741       b_mtem(1,ja,je) = 2.95913
10742       b_mtem(2,ja,je) = -7.92254
10743       b_mtem(3,ja,je) = 13.736
10744       b_mtem(4,ja,je) = -15.433
10745       b_mtem(5,ja,je) = 7.40386
10746       b_mtem(6,ja,je) = -0.918641
10747
10748 ! in nano3
10749       je = jnano3
10750       b_mtem(1,ja,je) = 0.893272
10751       b_mtem(2,ja,je) = 6.53768
10752       b_mtem(3,ja,je) = -32.3458
10753       b_mtem(4,ja,je) = 61.2834
10754       b_mtem(5,ja,je) = -56.4446
10755       b_mtem(6,ja,je) = 19.9202
10756
10757 ! in na2so4
10758       je = jna2so4
10759       b_mtem(1,ja,je) = 3.14484
10760       b_mtem(2,ja,je) = 0.077019
10761       b_mtem(3,ja,je) = -31.4199
10762       b_mtem(4,ja,je) = 80.5865
10763       b_mtem(5,ja,je) = -85.392
10764       b_mtem(6,ja,je) = 32.6644
10765
10766 ! in ca(no3)2
10767       je = jcano3
10768       b_mtem(1,ja,je) = 2.60432
10769       b_mtem(2,ja,je) = -0.55909
10770       b_mtem(3,ja,je) = -19.6671
10771       b_mtem(4,ja,je) = 53.3446
10772       b_mtem(5,ja,je) = -58.9076
10773       b_mtem(6,ja,je) = 22.9927
10774
10775 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
10776       je = jcacl2
10777       b_mtem(1,ja,je) = 2.98036
10778       b_mtem(2,ja,je) = -8.55365
10779       b_mtem(3,ja,je) = 15.2108
10780       b_mtem(4,ja,je) = -15.9359
10781       b_mtem(5,ja,je) = 7.41772
10782       b_mtem(6,ja,je) = -1.32143
10783
10784 ! in hno3 (added on 12/06/2004)
10785       je = jhno3
10786       b_mtem(1,ja,je) = 3.8533
10787       b_mtem(2,ja,je) = -16.9427
10788       b_mtem(3,ja,je) = 45.0056
10789       b_mtem(4,ja,je) = -69.6145
10790       b_mtem(5,ja,je) = 54.1491
10791       b_mtem(6,ja,je) = -16.6513
10792
10793 ! in hcl (added on 12/06/2004)
10794       je = jhcl
10795       b_mtem(1,ja,je) = 2.56665
10796       b_mtem(2,ja,je) = -7.13585
10797       b_mtem(3,ja,je) = 14.8103
10798       b_mtem(4,ja,je) = -21.8881
10799       b_mtem(5,ja,je) = 16.6808
10800       b_mtem(6,ja,je) = -5.22091
10801
10802 ! in h2so4
10803       je = jh2so4
10804       b_mtem(1,ja,je) = 2.50179
10805       b_mtem(2,ja,je) = -6.69364
10806       b_mtem(3,ja,je) = 11.6551
10807       b_mtem(4,ja,je) = -13.6897
10808       b_mtem(5,ja,je) = 7.36796
10809       b_mtem(6,ja,je) = -1.33245
10810
10811 ! in nh4hso4
10812       je = jnh4hso4
10813       b_mtem(1,ja,je) = 0.149955
10814       b_mtem(2,ja,je) = 11.8213
10815       b_mtem(3,ja,je) = -53.9164
10816       b_mtem(4,ja,je) = 101.574
10817       b_mtem(5,ja,je) = -91.4123
10818       b_mtem(6,ja,je) = 31.5487
10819
10820 ! in (nh4)3h(so4)2
10821       je = jlvcite
10822       b_mtem(1,ja,je) = -2.36927
10823       b_mtem(2,ja,je) = 14.8359
10824       b_mtem(3,ja,je) = -44.3443
10825       b_mtem(4,ja,je) = 73.6229
10826       b_mtem(5,ja,je) = -65.3366
10827       b_mtem(6,ja,je) = 23.3250
10828
10829 ! in nahso4
10830       je = jnahso4
10831       b_mtem(1,ja,je) = 2.72993
10832       b_mtem(2,ja,je) = -0.23406
10833       b_mtem(3,ja,je) = -10.4103
10834       b_mtem(4,ja,je) = 13.1586
10835       b_mtem(5,ja,je) = -7.79925
10836       b_mtem(6,ja,je) = 2.30843
10837
10838 ! in na3h(so4)2
10839       je = jna3hso4
10840       b_mtem(1,ja,je) = 3.51258
10841       b_mtem(2,ja,je) = -3.95107
10842       b_mtem(3,ja,je) = -11.0175
10843       b_mtem(4,ja,je) = 38.8617
10844       b_mtem(5,ja,je) = -48.1575
10845       b_mtem(6,ja,je) = 20.4717
10846
10847
10848 !----------
10849 ! 2h.so4 in e
10850       ja = jh2so4
10851
10852 ! in h2so4
10853       je = jh2so4
10854       b_mtem(1,ja,je) = 0.76734
10855       b_mtem(2,ja,je) = -1.12263
10856       b_mtem(3,ja,je) = -9.08728
10857       b_mtem(4,ja,je) = 30.3836
10858       b_mtem(5,ja,je) = -38.4133
10859       b_mtem(6,ja,je) = 17.0106
10860
10861 ! in nh4hso4
10862       je = jnh4hso4
10863       b_mtem(1,ja,je) = -2.03879
10864       b_mtem(2,ja,je) = 15.7033
10865       b_mtem(3,ja,je) = -58.7363
10866       b_mtem(4,ja,je) = 109.242
10867       b_mtem(5,ja,je) = -102.237
10868       b_mtem(6,ja,je) = 37.5350
10869
10870 ! in (nh4)3h(so4)2
10871       je = jlvcite
10872       b_mtem(1,ja,je) = -3.10228
10873       b_mtem(2,ja,je) = 16.6920
10874       b_mtem(3,ja,je) = -59.1522
10875       b_mtem(4,ja,je) = 113.487
10876       b_mtem(5,ja,je) = -110.890
10877       b_mtem(6,ja,je) = 42.4578
10878
10879 ! in (nh4)2so4
10880       je = jnh4so4
10881       b_mtem(1,ja,je) = -3.43885
10882       b_mtem(2,ja,je) = 21.0372
10883       b_mtem(3,ja,je) = -84.7026
10884       b_mtem(4,ja,je) = 165.324
10885       b_mtem(5,ja,je) = -156.101
10886       b_mtem(6,ja,je) = 57.3101
10887
10888 ! in nahso4
10889       je = jnahso4
10890       b_mtem(1,ja,je) = 0.33164
10891       b_mtem(2,ja,je) = 6.55864
10892       b_mtem(3,ja,je) = -33.5876
10893       b_mtem(4,ja,je) = 65.1798
10894       b_mtem(5,ja,je) = -63.2046
10895       b_mtem(6,ja,je) = 24.1783
10896
10897 ! in na3h(so4)2
10898       je = jna3hso4
10899       b_mtem(1,ja,je) = 3.06830
10900       b_mtem(2,ja,je) = -3.18408
10901       b_mtem(3,ja,je) = -19.6332
10902       b_mtem(4,ja,je) = 61.3657
10903       b_mtem(5,ja,je) = -73.4438
10904       b_mtem(6,ja,je) = 31.2334
10905
10906 ! in na2so4
10907       je = jna2so4
10908       b_mtem(1,ja,je) = 2.58649
10909       b_mtem(2,ja,je) = 0.87921
10910       b_mtem(3,ja,je) = -39.3023
10911       b_mtem(4,ja,je) = 101.603
10912       b_mtem(5,ja,je) = -109.469
10913       b_mtem(6,ja,je) = 43.0188
10914
10915 ! in hno3
10916       je = jhno3
10917       b_mtem(1,ja,je) = 1.54587
10918       b_mtem(2,ja,je) = -7.50976
10919       b_mtem(3,ja,je) = 12.8237
10920       b_mtem(4,ja,je) = -10.1452
10921       b_mtem(5,ja,je) = -0.541956
10922       b_mtem(6,ja,je) = 3.34536
10923
10924 ! in hcl
10925       je = jhcl
10926       b_mtem(1,ja,je) = 0.829757
10927       b_mtem(2,ja,je) = -4.11316
10928       b_mtem(3,ja,je) = 3.67111
10929       b_mtem(4,ja,je) = 3.6833
10930       b_mtem(5,ja,je) = -11.2711
10931       b_mtem(6,ja,je) = 6.71421
10932
10933
10934 !----------
10935 ! h.hso4 in e
10936       ja = jhhso4
10937
10938 ! in h2so4
10939       je = jh2so4
10940       b_mtem(1,ja,je) = 2.63953
10941       b_mtem(2,ja,je) = -6.01532
10942       b_mtem(3,ja,je) = 10.0204
10943       b_mtem(4,ja,je) = -12.4840
10944       b_mtem(5,ja,je) = 7.78853
10945       b_mtem(6,ja,je) = -2.12638
10946
10947 ! in nh4hso4
10948       je = jnh4hso4
10949       b_mtem(1,ja,je) = -0.77412
10950       b_mtem(2,ja,je) = 14.1656
10951       b_mtem(3,ja,je) = -53.4087
10952       b_mtem(4,ja,je) = 93.2013
10953       b_mtem(5,ja,je) = -80.5723
10954       b_mtem(6,ja,je) = 27.1577
10955
10956 ! in (nh4)3h(so4)2
10957       je = jlvcite
10958       b_mtem(1,ja,je) = -2.98882
10959       b_mtem(2,ja,je) = 14.4436
10960       b_mtem(3,ja,je) = -40.1774
10961       b_mtem(4,ja,je) = 67.5937
10962       b_mtem(5,ja,je) = -61.5040
10963       b_mtem(6,ja,je) = 22.3695
10964
10965 ! in (nh4)2so4
10966       je = jnh4so4
10967       b_mtem(1,ja,je) = -1.15502
10968       b_mtem(2,ja,je) = 8.12309
10969       b_mtem(3,ja,je) = -38.4726
10970       b_mtem(4,ja,je) = 80.8861
10971       b_mtem(5,ja,je) = -80.1644
10972       b_mtem(6,ja,je) = 30.4717
10973
10974 ! in nahso4
10975       je = jnahso4
10976       b_mtem(1,ja,je) = 1.99641
10977       b_mtem(2,ja,je) = -2.96061
10978       b_mtem(3,ja,je) = 5.54778
10979       b_mtem(4,ja,je) = -14.5488
10980       b_mtem(5,ja,je) = 14.8492
10981       b_mtem(6,ja,je) = -5.1389
10982
10983 ! in na3h(so4)2
10984       je = jna3hso4
10985       b_mtem(1,ja,je) = 2.23816
10986       b_mtem(2,ja,je) = -3.20847
10987       b_mtem(3,ja,je) = -4.82853
10988       b_mtem(4,ja,je) = 20.9192
10989       b_mtem(5,ja,je) = -27.2819
10990       b_mtem(6,ja,je) = 11.8655
10991
10992 ! in na2so4
10993       je = jna2so4
10994       b_mtem(1,ja,je) = 2.56907
10995       b_mtem(2,ja,je) = 1.13444
10996       b_mtem(3,ja,je) = -34.6853
10997       b_mtem(4,ja,je) = 87.9775
10998       b_mtem(5,ja,je) = -93.2330
10999       b_mtem(6,ja,je) = 35.9260
11000
11001 ! in hno3
11002       je = jhno3
11003       b_mtem(1,ja,je) = 2.00024
11004       b_mtem(2,ja,je) = -4.80868
11005       b_mtem(3,ja,je) = 8.29222
11006       b_mtem(4,ja,je) = -11.0849
11007       b_mtem(5,ja,je) = 7.51262
11008       b_mtem(6,ja,je) = -2.07654
11009
11010 ! in hcl
11011       je = jhcl
11012       b_mtem(1,ja,je) = 2.8009
11013       b_mtem(2,ja,je) = -6.98416
11014       b_mtem(3,ja,je) = 14.3146
11015       b_mtem(4,ja,je) = -22.0068
11016       b_mtem(5,ja,je) = 17.5557
11017       b_mtem(6,ja,je) = -5.84917
11018
11019
11020 !----------
11021 ! nh4hso4 in e
11022       ja = jnh4hso4
11023
11024 ! in h2so4
11025       je = jh2so4
11026       b_mtem(1,ja,je) = 0.169160
11027       b_mtem(2,ja,je) = 2.15094
11028       b_mtem(3,ja,je) = -9.62904
11029       b_mtem(4,ja,je) = 18.2631
11030       b_mtem(5,ja,je) = -17.3333
11031       b_mtem(6,ja,je) = 6.19835
11032
11033 ! in nh4hso4
11034       je = jnh4hso4
11035       b_mtem(1,ja,je) = -2.34457
11036       b_mtem(2,ja,je) = 12.8035
11037       b_mtem(3,ja,je) = -35.2513
11038       b_mtem(4,ja,je) = 53.6153
11039       b_mtem(5,ja,je) = -42.7655
11040       b_mtem(6,ja,je) = 13.7129
11041
11042 ! in (nh4)3h(so4)2
11043       je = jlvcite
11044       b_mtem(1,ja,je) = -2.56109
11045       b_mtem(2,ja,je) = 11.1414
11046       b_mtem(3,ja,je) = -30.2361
11047       b_mtem(4,ja,je) = 50.0320
11048       b_mtem(5,ja,je) = -44.1586
11049       b_mtem(6,ja,je) = 15.5393
11050
11051 ! in (nh4)2so4
11052       je = jnh4so4
11053       b_mtem(1,ja,je) = -0.97315
11054       b_mtem(2,ja,je) = 7.06295
11055       b_mtem(3,ja,je) = -29.3032
11056       b_mtem(4,ja,je) = 57.6101
11057       b_mtem(5,ja,je) = -54.9020
11058       b_mtem(6,ja,je) = 20.2222
11059
11060 ! in nahso4
11061       je = jnahso4
11062       b_mtem(1,ja,je) = -0.44450
11063       b_mtem(2,ja,je) = 3.33451
11064       b_mtem(3,ja,je) = -15.2791
11065       b_mtem(4,ja,je) = 30.1413
11066       b_mtem(5,ja,je) = -26.7710
11067       b_mtem(6,ja,je) = 8.78462
11068
11069 ! in na3h(so4)2
11070       je = jna3hso4
11071       b_mtem(1,ja,je) = -0.99780
11072       b_mtem(2,ja,je) = 4.69200
11073       b_mtem(3,ja,je) = -16.1219
11074       b_mtem(4,ja,je) = 29.3100
11075       b_mtem(5,ja,je) = -26.3383
11076       b_mtem(6,ja,je) = 9.20695
11077
11078 ! in na2so4
11079       je = jna2so4
11080       b_mtem(1,ja,je) = -0.52694
11081       b_mtem(2,ja,je) = 7.02684
11082       b_mtem(3,ja,je) = -33.7508
11083       b_mtem(4,ja,je) = 70.0565
11084       b_mtem(5,ja,je) = -68.3226
11085       b_mtem(6,ja,je) = 25.2692
11086
11087 ! in hno3
11088       je = jhno3
11089       b_mtem(1,ja,je) = 0.572926
11090       b_mtem(2,ja,je) = -2.04791
11091       b_mtem(3,ja,je) = 2.1134
11092       b_mtem(4,ja,je) = 0.246654
11093       b_mtem(5,ja,je) = -3.06019
11094       b_mtem(6,ja,je) = 1.98126
11095
11096 ! in hcl
11097       je = jhcl
11098       b_mtem(1,ja,je) = 0.56514
11099       b_mtem(2,ja,je) = 0.22287
11100       b_mtem(3,ja,je) = -2.76973
11101       b_mtem(4,ja,je) = 4.54444
11102       b_mtem(5,ja,je) = -3.86549
11103       b_mtem(6,ja,je) = 1.13441
11104
11105
11106 !----------
11107 ! (nh4)3h(so4)2 in e
11108       ja = jlvcite
11109
11110 ! in h2so4
11111       je = jh2so4
11112       b_mtem(1,ja,je) = -1.44811
11113       b_mtem(2,ja,je) = 6.71815
11114       b_mtem(3,ja,je) = -25.0141
11115       b_mtem(4,ja,je) = 50.1109
11116       b_mtem(5,ja,je) = -50.0561
11117       b_mtem(6,ja,je) = 19.3370
11118
11119 ! in nh4hso4
11120       je = jnh4hso4
11121       b_mtem(1,ja,je) = -3.41707
11122       b_mtem(2,ja,je) = 13.4496
11123       b_mtem(3,ja,je) = -34.8018
11124       b_mtem(4,ja,je) = 55.2987
11125       b_mtem(5,ja,je) = -48.1839
11126       b_mtem(6,ja,je) = 17.2444
11127
11128 ! in (nh4)3h(so4)2
11129       je = jlvcite
11130       b_mtem(1,ja,je) = -2.54479
11131       b_mtem(2,ja,je) = 11.8501
11132       b_mtem(3,ja,je) = -39.7286
11133       b_mtem(4,ja,je) = 74.2479
11134       b_mtem(5,ja,je) = -70.4934
11135       b_mtem(6,ja,je) = 26.2836
11136
11137 ! in (nh4)2so4
11138       je = jnh4so4
11139       b_mtem(1,ja,je) = -2.30561
11140       b_mtem(2,ja,je) = 14.5806
11141       b_mtem(3,ja,je) = -55.1238
11142       b_mtem(4,ja,je) = 103.451
11143       b_mtem(5,ja,je) = -95.2571
11144       b_mtem(6,ja,je) = 34.2218
11145
11146 ! in nahso4
11147       je = jnahso4
11148       b_mtem(1,ja,je) = -2.20809
11149       b_mtem(2,ja,je) = 13.6391
11150       b_mtem(3,ja,je) = -57.8246
11151       b_mtem(4,ja,je) = 117.907
11152       b_mtem(5,ja,je) = -112.154
11153       b_mtem(6,ja,je) = 40.3058
11154
11155 ! in na3h(so4)2
11156       je = jna3hso4
11157       b_mtem(1,ja,je) = -1.15099
11158       b_mtem(2,ja,je) = 6.32269
11159       b_mtem(3,ja,je) = -27.3860
11160       b_mtem(4,ja,je) = 55.4592
11161       b_mtem(5,ja,je) = -54.0100
11162       b_mtem(6,ja,je) = 20.3469
11163
11164 ! in na2so4
11165       je = jna2so4
11166       b_mtem(1,ja,je) = -1.15678
11167       b_mtem(2,ja,je) = 8.28718
11168       b_mtem(3,ja,je) = -37.3231
11169       b_mtem(4,ja,je) = 76.6124
11170       b_mtem(5,ja,je) = -74.9307
11171       b_mtem(6,ja,je) = 28.0559
11172
11173 ! in hno3
11174       je = jhno3
11175       b_mtem(1,ja,je) = 0.01502
11176       b_mtem(2,ja,je) = -3.1197
11177       b_mtem(3,ja,je) = 3.61104
11178       b_mtem(4,ja,je) = 3.05196
11179       b_mtem(5,ja,je) = -9.98957
11180       b_mtem(6,ja,je) = 6.04155
11181
11182 ! in hcl
11183       je = jhcl
11184       b_mtem(1,ja,je) = -1.06477
11185       b_mtem(2,ja,je) = 3.38801
11186       b_mtem(3,ja,je) = -12.5784
11187       b_mtem(4,ja,je) = 25.2823
11188       b_mtem(5,ja,je) = -25.4611
11189       b_mtem(6,ja,je) = 10.0754
11190
11191
11192 !----------
11193 ! nahso4 in e
11194       ja = jnahso4
11195
11196 ! in h2so4
11197       je = jh2so4
11198       b_mtem(1,ja,je) = 0.68259
11199       b_mtem(2,ja,je) = 0.71468
11200       b_mtem(3,ja,je) = -5.59003
11201       b_mtem(4,ja,je) = 11.0089
11202       b_mtem(5,ja,je) = -10.7983
11203       b_mtem(6,ja,je) = 3.82335
11204
11205 ! in nh4hso4
11206       je = jnh4hso4
11207       b_mtem(1,ja,je) = -0.03956
11208       b_mtem(2,ja,je) = 4.52828
11209       b_mtem(3,ja,je) = -25.2557
11210       b_mtem(4,ja,je) = 54.4225
11211       b_mtem(5,ja,je) = -52.5105
11212       b_mtem(6,ja,je) = 18.6562
11213
11214 ! in (nh4)3h(so4)2
11215       je = jlvcite
11216       b_mtem(1,ja,je) = -1.53503
11217       b_mtem(2,ja,je) = 8.27608
11218       b_mtem(3,ja,je) = -28.9539
11219       b_mtem(4,ja,je) = 55.2876
11220       b_mtem(5,ja,je) = -51.9563
11221       b_mtem(6,ja,je) = 18.6576
11222
11223 ! in (nh4)2so4
11224       je = jnh4so4
11225       b_mtem(1,ja,je) = -0.38793
11226       b_mtem(2,ja,je) = 7.14680
11227       b_mtem(3,ja,je) = -38.7201
11228       b_mtem(4,ja,je) = 84.3965
11229       b_mtem(5,ja,je) = -84.7453
11230       b_mtem(6,ja,je) = 32.1283
11231
11232 ! in nahso4
11233       je = jnahso4
11234       b_mtem(1,ja,je) = -0.41982
11235       b_mtem(2,ja,je) = 4.26491
11236       b_mtem(3,ja,je) = -20.2351
11237       b_mtem(4,ja,je) = 42.6764
11238       b_mtem(5,ja,je) = -40.7503
11239       b_mtem(6,ja,je) = 14.2868
11240
11241 ! in na3h(so4)2
11242       je = jna3hso4
11243       b_mtem(1,ja,je) = -0.32912
11244       b_mtem(2,ja,je) = 1.80808
11245       b_mtem(3,ja,je) = -8.01286
11246       b_mtem(4,ja,je) = 15.5791
11247       b_mtem(5,ja,je) = -14.5494
11248       b_mtem(6,ja,je) = 5.27052
11249
11250 ! in na2so4
11251       je = jna2so4
11252       b_mtem(1,ja,je) = 0.10271
11253       b_mtem(2,ja,je) = 5.09559
11254       b_mtem(3,ja,je) = -30.3295
11255       b_mtem(4,ja,je) = 66.2975
11256       b_mtem(5,ja,je) = -66.3458
11257       b_mtem(6,ja,je) = 24.9443
11258
11259 ! in hno3
11260       je = jhno3
11261       b_mtem(1,ja,je) = 0.608309
11262       b_mtem(2,ja,je) = -0.541905
11263       b_mtem(3,ja,je) = -2.52084
11264       b_mtem(4,ja,je) = 6.63297
11265       b_mtem(5,ja,je) = -7.24599
11266       b_mtem(6,ja,je) = 2.88811
11267
11268 ! in hcl
11269       je = jhcl
11270       b_mtem(1,ja,je) = 1.98399
11271       b_mtem(2,ja,je) = -4.51562
11272       b_mtem(3,ja,je) = 8.36059
11273       b_mtem(4,ja,je) = -12.4948
11274       b_mtem(5,ja,je) = 9.67514
11275       b_mtem(6,ja,je) = -3.18004
11276
11277
11278 !----------
11279 ! na3h(so4)2 in e
11280       ja = jna3hso4
11281
11282 ! in h2so4
11283       je = jh2so4
11284       b_mtem(1,ja,je) = -0.83214
11285       b_mtem(2,ja,je) = 4.99572
11286       b_mtem(3,ja,je) = -20.1697
11287       b_mtem(4,ja,je) = 41.4066
11288       b_mtem(5,ja,je) = -42.2119
11289       b_mtem(6,ja,je) = 16.4855
11290
11291 ! in nh4hso4
11292       je = jnh4hso4
11293       b_mtem(1,ja,je) = -0.65139
11294       b_mtem(2,ja,je) = 3.52300
11295       b_mtem(3,ja,je) = -22.8220
11296       b_mtem(4,ja,je) = 56.2956
11297       b_mtem(5,ja,je) = -59.9028
11298       b_mtem(6,ja,je) = 23.1844
11299
11300 ! in (nh4)3h(so4)2
11301       je = jlvcite
11302       b_mtem(1,ja,je) = -1.31331
11303       b_mtem(2,ja,je) = 8.40835
11304       b_mtem(3,ja,je) = -38.1757
11305       b_mtem(4,ja,je) = 80.5312
11306       b_mtem(5,ja,je) = -79.8346
11307       b_mtem(6,ja,je) = 30.0219
11308
11309 ! in (nh4)2so4
11310       je = jnh4so4
11311       b_mtem(1,ja,je) = -1.03054
11312       b_mtem(2,ja,je) = 8.08155
11313       b_mtem(3,ja,je) = -38.1046
11314       b_mtem(4,ja,je) = 78.7168
11315       b_mtem(5,ja,je) = -77.2263
11316       b_mtem(6,ja,je) = 29.1521
11317
11318 ! in nahso4
11319       je = jnahso4
11320       b_mtem(1,ja,je) = -1.90695
11321       b_mtem(2,ja,je) = 11.6241
11322       b_mtem(3,ja,je) = -50.3175
11323       b_mtem(4,ja,je) = 105.884
11324       b_mtem(5,ja,je) = -103.258
11325       b_mtem(6,ja,je) = 37.6588
11326
11327 ! in na3h(so4)2
11328       je = jna3hso4
11329       b_mtem(1,ja,je) = -0.34780
11330       b_mtem(2,ja,je) = 2.85363
11331       b_mtem(3,ja,je) = -17.6224
11332       b_mtem(4,ja,je) = 38.9220
11333       b_mtem(5,ja,je) = -39.8106
11334       b_mtem(6,ja,je) = 15.6055
11335
11336 ! in na2so4
11337       je = jna2so4
11338       b_mtem(1,ja,je) = -0.75230
11339       b_mtem(2,ja,je) = 10.0140
11340       b_mtem(3,ja,je) = -50.5677
11341       b_mtem(4,ja,je) = 106.941
11342       b_mtem(5,ja,je) = -105.534
11343       b_mtem(6,ja,je) = 39.5196
11344
11345 ! in hno3
11346       je = jhno3
11347       b_mtem(1,ja,je) = 0.057456
11348       b_mtem(2,ja,je) = -1.31264
11349       b_mtem(3,ja,je) = -1.94662
11350       b_mtem(4,ja,je) = 10.7024
11351       b_mtem(5,ja,je) = -14.9946
11352       b_mtem(6,ja,je) = 7.12161
11353
11354 ! in hcl
11355       je = jhcl
11356       b_mtem(1,ja,je) = 0.637894
11357       b_mtem(2,ja,je) = -2.29719
11358       b_mtem(3,ja,je) = 0.765361
11359       b_mtem(4,ja,je) = 4.8748
11360       b_mtem(5,ja,je) = -9.25978
11361       b_mtem(6,ja,je) = 4.91773
11362 !
11363 !
11364 !
11365 !----------------------------------------------------------
11366 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3    (t in kelvin)
11367 ! valid temperature range: 240 - 320 k
11368 !----------------------------------------------------------
11369 !
11370 ! sulfate-poor systems
11371 ! ac
11372       j_index = 1
11373       d_mdrh(j_index,1) = -58.00268351
11374       d_mdrh(j_index,2) = 2.031077573
11375       d_mdrh(j_index,3) = -0.008281218
11376       d_mdrh(j_index,4) = 1.00447e-05
11377
11378 ! an
11379       j_index = 2
11380       d_mdrh(j_index,1) = 1039.137773
11381       d_mdrh(j_index,2) = -11.47847095
11382       d_mdrh(j_index,3) = 0.047702786
11383       d_mdrh(j_index,4) = -6.77675e-05
11384
11385 ! as
11386       j_index = 3
11387       d_mdrh(j_index,1) = 115.8366357
11388       d_mdrh(j_index,2) = 0.491881663
11389       d_mdrh(j_index,3) = -0.00422807
11390       d_mdrh(j_index,4) = 7.29274e-06
11391
11392 ! sc
11393       j_index = 4
11394       d_mdrh(j_index,1) = 253.2424151
11395       d_mdrh(j_index,2) = -1.429957864
11396       d_mdrh(j_index,3) = 0.003727554
11397       d_mdrh(j_index,4) = -3.13037e-06
11398
11399 ! sn
11400       j_index = 5
11401       d_mdrh(j_index,1) = -372.4306506
11402       d_mdrh(j_index,2) = 5.3955633
11403       d_mdrh(j_index,3) = -0.019804438
11404       d_mdrh(j_index,4) = 2.25662e-05
11405
11406 ! ss
11407       j_index = 6
11408       d_mdrh(j_index,1) = 286.1271416
11409       d_mdrh(j_index,2) = -1.670787758
11410       d_mdrh(j_index,3) = 0.004431373
11411       d_mdrh(j_index,4) = -3.57757e-06
11412
11413 ! cc
11414       j_index = 7
11415       d_mdrh(j_index,1) = -1124.07059
11416       d_mdrh(j_index,2) = 14.26364209
11417       d_mdrh(j_index,3) = -0.054816822
11418       d_mdrh(j_index,4) = 6.70107e-05
11419
11420 ! cn
11421       j_index = 8
11422       d_mdrh(j_index,1) = 1855.413934
11423       d_mdrh(j_index,2) = -20.29219473
11424       d_mdrh(j_index,3) = 0.07807482
11425       d_mdrh(j_index,4) = -1.017887858e-4
11426
11427 ! an + ac
11428       j_index = 9
11429       d_mdrh(j_index,1) = 1761.176886
11430       d_mdrh(j_index,2) = -19.29811062
11431       d_mdrh(j_index,3) = 0.075676987
11432       d_mdrh(j_index,4) = -1.0116959e-4
11433
11434 ! as + ac
11435       j_index = 10
11436       d_mdrh(j_index,1) = 122.1074303
11437       d_mdrh(j_index,2) = 0.429692122
11438       d_mdrh(j_index,3) = -0.003928277
11439       d_mdrh(j_index,4) = 6.43275e-06
11440
11441 ! as + an
11442       j_index = 11
11443       d_mdrh(j_index,1) = 2424.634678
11444       d_mdrh(j_index,2) = -26.54031307
11445       d_mdrh(j_index,3) = 0.101625387
11446       d_mdrh(j_index,4) = -1.31544547798e-4
11447
11448 ! as + an + ac
11449       j_index = 12
11450       d_mdrh(j_index,1) = 2912.082599
11451       d_mdrh(j_index,2) = -31.8894185
11452       d_mdrh(j_index,3) = 0.121185849
11453       d_mdrh(j_index,4) = -1.556534623e-4
11454
11455 ! sc + ac
11456       j_index = 13
11457       d_mdrh(j_index,1) = 172.2596493
11458       d_mdrh(j_index,2) = -0.511006195
11459       d_mdrh(j_index,3) = 4.27244597e-4
11460       d_mdrh(j_index,4) = 4.12797e-07
11461
11462 ! sn + ac
11463       j_index = 14
11464       d_mdrh(j_index,1) = 1596.184935
11465       d_mdrh(j_index,2) = -16.37945565
11466       d_mdrh(j_index,3) = 0.060281218
11467       d_mdrh(j_index,4) = -7.6161e-05
11468
11469 ! sn + an
11470       j_index = 15
11471       d_mdrh(j_index,1) = 1916.072988
11472       d_mdrh(j_index,2) = -20.85594868
11473       d_mdrh(j_index,3) = 0.081140141
11474       d_mdrh(j_index,4) = -1.07954274796e-4
11475
11476 ! sn + an + ac
11477       j_index = 16
11478       d_mdrh(j_index,1) = 1467.165935
11479       d_mdrh(j_index,2) = -16.01166196
11480       d_mdrh(j_index,3) = 0.063505582
11481       d_mdrh(j_index,4) = -8.66722e-05
11482
11483 ! sn + sc
11484       j_index = 17
11485       d_mdrh(j_index,1) = 158.447059
11486       d_mdrh(j_index,2) = -0.628167358
11487       d_mdrh(j_index,3) = 0.002014448
11488       d_mdrh(j_index,4) = -3.13037e-06
11489
11490 ! sn + sc + ac
11491       j_index = 18
11492       d_mdrh(j_index,1) = 1115.892468
11493       d_mdrh(j_index,2) = -11.76936534
11494       d_mdrh(j_index,3) = 0.045577399
11495       d_mdrh(j_index,4) = -6.05779e-05
11496
11497 ! ss + ac
11498       j_index = 19
11499       d_mdrh(j_index,1) = 269.5432407
11500       d_mdrh(j_index,2) = -1.319963885
11501       d_mdrh(j_index,3) = 0.002592363
11502       d_mdrh(j_index,4) = -1.44479e-06
11503
11504 ! ss + an
11505       j_index = 20
11506       d_mdrh(j_index,1) = 2841.334784
11507       d_mdrh(j_index,2) = -31.1889487
11508       d_mdrh(j_index,3) = 0.118809274
11509       d_mdrh(j_index,4) = -1.53007e-4
11510
11511 ! ss + an + ac
11512       j_index = 21
11513       d_mdrh(j_index,1) = 2199.36914
11514       d_mdrh(j_index,2) = -24.11926569
11515       d_mdrh(j_index,3) = 0.092932361
11516       d_mdrh(j_index,4) = -1.21774e-4
11517
11518 ! ss + as
11519       j_index = 22
11520       d_mdrh(j_index,1) = 395.0051604
11521       d_mdrh(j_index,2) = -2.521101657
11522       d_mdrh(j_index,3) = 0.006139319
11523       d_mdrh(j_index,4) = -4.43756e-06
11524
11525 ! ss + as + ac
11526       j_index = 23
11527       d_mdrh(j_index,1) = 386.5150675
11528       d_mdrh(j_index,2) = -2.4632138
11529       d_mdrh(j_index,3) = 0.006139319
11530       d_mdrh(j_index,4) = -4.98796e-06
11531
11532 ! ss + as + an
11533       j_index = 24
11534       d_mdrh(j_index,1) = 3101.538491
11535       d_mdrh(j_index,2) = -34.19978105
11536       d_mdrh(j_index,3) = 0.130118605
11537       d_mdrh(j_index,4) = -1.66873e-4
11538
11539 ! ss + as + an + ac
11540       j_index = 25
11541       d_mdrh(j_index,1) = 2307.579403
11542       d_mdrh(j_index,2) = -25.43136774
11543       d_mdrh(j_index,3) = 0.098064728
11544       d_mdrh(j_index,4) = -1.28301e-4
11545
11546 ! ss + sc
11547       j_index = 26
11548       d_mdrh(j_index,1) = 291.8309602
11549       d_mdrh(j_index,2) = -1.828912974
11550       d_mdrh(j_index,3) = 0.005053148
11551       d_mdrh(j_index,4) = -4.57516e-06
11552
11553 ! ss + sc + ac
11554       j_index = 27
11555       d_mdrh(j_index,1) = 188.3914345
11556       d_mdrh(j_index,2) = -0.631345031
11557       d_mdrh(j_index,3) = 0.000622807
11558       d_mdrh(j_index,4) = 4.47196e-07
11559
11560 ! ss + sn
11561       j_index = 28
11562       d_mdrh(j_index,1) = -167.1252839
11563       d_mdrh(j_index,2) = 2.969828002
11564       d_mdrh(j_index,3) = -0.010637255
11565       d_mdrh(j_index,4) = 1.13175e-05
11566
11567 ! ss + sn + ac
11568       j_index = 29
11569       d_mdrh(j_index,1) = 1516.782768
11570       d_mdrh(j_index,2) = -15.7922661
11571       d_mdrh(j_index,3) = 0.058942209
11572       d_mdrh(j_index,4) = -7.5301e-05
11573
11574 ! ss + sn + an
11575       j_index = 30
11576       d_mdrh(j_index,1) = 1739.963163
11577       d_mdrh(j_index,2) = -19.06576022
11578       d_mdrh(j_index,3) = 0.07454963
11579       d_mdrh(j_index,4) = -9.94302e-05
11580
11581 ! ss + sn + an + ac
11582       j_index = 31
11583       d_mdrh(j_index,1) = 2152.104877
11584       d_mdrh(j_index,2) = -23.74998008
11585       d_mdrh(j_index,3) = 0.092256654
11586       d_mdrh(j_index,4) = -1.21953e-4
11587
11588 ! ss + sn + sc
11589       j_index = 32
11590       d_mdrh(j_index,1) = 221.9976265
11591       d_mdrh(j_index,2) = -1.311331272
11592       d_mdrh(j_index,3) = 0.004406089
11593       d_mdrh(j_index,4) = -5.88235e-06
11594
11595 ! ss + sn + sc + ac
11596       j_index = 33
11597       d_mdrh(j_index,1) = 1205.645615
11598       d_mdrh(j_index,2) = -12.71353459
11599       d_mdrh(j_index,3) = 0.048803922
11600       d_mdrh(j_index,4) = -6.41899e-05
11601
11602 ! cc + ac
11603       j_index = 34
11604       d_mdrh(j_index,1) = 506.6737879
11605       d_mdrh(j_index,2) = -3.723520818
11606       d_mdrh(j_index,3) = 0.010814242
11607       d_mdrh(j_index,4) = -1.21087e-05
11608
11609 ! cc + sc
11610       j_index = 35
11611       d_mdrh(j_index,1) = -1123.523841
11612       d_mdrh(j_index,2) = 14.08345977
11613       d_mdrh(j_index,3) = -0.053687823
11614       d_mdrh(j_index,4) = 6.52219e-05
11615
11616 ! cc + sc + ac
11617       j_index = 36
11618       d_mdrh(j_index,1) = -1159.98607
11619       d_mdrh(j_index,2) = 14.44309169
11620       d_mdrh(j_index,3) = -0.054841073
11621       d_mdrh(j_index,4) = 6.64259e-05
11622
11623 ! cn + ac
11624       j_index = 37
11625       d_mdrh(j_index,1) = 756.0747916
11626       d_mdrh(j_index,2) = -8.546826257
11627       d_mdrh(j_index,3) = 0.035798677
11628       d_mdrh(j_index,4) = -5.06629e-05
11629
11630 ! cn + an
11631       j_index = 38
11632       d_mdrh(j_index,1) = 338.668191
11633       d_mdrh(j_index,2) = -2.971223403
11634       d_mdrh(j_index,3) = 0.012294866
11635       d_mdrh(j_index,4) = -1.87558e-05
11636
11637 ! cn + an + ac
11638       j_index = 39
11639       d_mdrh(j_index,1) = -53.18033508
11640       d_mdrh(j_index,2) = 0.663911748
11641       d_mdrh(j_index,3) = 9.16326e-4
11642       d_mdrh(j_index,4) = -6.70354e-06
11643
11644 ! cn + sc
11645       j_index = 40
11646       d_mdrh(j_index,1) = 3623.831129
11647       d_mdrh(j_index,2) = -39.27226457
11648       d_mdrh(j_index,3) = 0.144559515
11649       d_mdrh(j_index,4) = -1.78159e-4
11650
11651 ! cn + sc + ac
11652       j_index = 41
11653       d_mdrh(j_index,1) = 3436.656743
11654       d_mdrh(j_index,2) = -37.16192684
11655       d_mdrh(j_index,3) = 0.136641377
11656       d_mdrh(j_index,4) = -1.68262e-4
11657
11658 ! cn + sn
11659       j_index = 42
11660       d_mdrh(j_index,1) = 768.608476
11661       d_mdrh(j_index,2) = -8.051517149
11662       d_mdrh(j_index,3) = 0.032342332
11663       d_mdrh(j_index,4) = -4.52224e-05
11664
11665 ! cn + sn + ac
11666       j_index = 43
11667       d_mdrh(j_index,1) = 33.58027951
11668       d_mdrh(j_index,2) = -0.308772182
11669       d_mdrh(j_index,3) = 0.004713639
11670       d_mdrh(j_index,4) = -1.19658e-05
11671
11672 ! cn + sn + an
11673       j_index = 44
11674       d_mdrh(j_index,1) = 57.80183041
11675       d_mdrh(j_index,2) = 0.215264604
11676       d_mdrh(j_index,3) = 4.11406e-4
11677       d_mdrh(j_index,4) = -4.30702e-06
11678
11679 ! cn + sn + an + ac
11680       j_index = 45
11681       d_mdrh(j_index,1) = -234.368984
11682       d_mdrh(j_index,2) = 2.721045204
11683       d_mdrh(j_index,3) = -0.006688341
11684       d_mdrh(j_index,4) = 2.31729e-06
11685
11686 ! cn + sn + sc
11687       j_index = 46
11688       d_mdrh(j_index,1) = 3879.080557
11689       d_mdrh(j_index,2) = -42.13562874
11690       d_mdrh(j_index,3) = 0.155235005
11691       d_mdrh(j_index,4) = -1.91387e-4
11692
11693 ! cn + sn + sc + ac
11694       j_index = 47
11695       d_mdrh(j_index,1) = 3600.576985
11696       d_mdrh(j_index,2) = -39.0283489
11697       d_mdrh(j_index,3) = 0.143710316
11698       d_mdrh(j_index,4) = -1.77167e-4
11699
11700 ! cn + cc
11701       j_index = 48
11702       d_mdrh(j_index,1) = -1009.729826
11703       d_mdrh(j_index,2) = 12.9145339
11704       d_mdrh(j_index,3) = -0.049811146
11705       d_mdrh(j_index,4) = 6.09563e-05
11706
11707 ! cn + cc + ac
11708       j_index = 49
11709       d_mdrh(j_index,1) = -577.0919514
11710       d_mdrh(j_index,2) = 8.020324227
11711       d_mdrh(j_index,3) = -0.031469556
11712       d_mdrh(j_index,4) = 3.82181e-05
11713
11714 ! cn + cc + sc
11715       j_index = 50
11716       d_mdrh(j_index,1) = -728.9983499
11717       d_mdrh(j_index,2) = 9.849458215
11718       d_mdrh(j_index,3) = -0.03879257
11719       d_mdrh(j_index,4) = 4.78844e-05
11720
11721 ! cn + cc + sc + ac
11722       j_index = 51
11723       d_mdrh(j_index,1) = -803.7026845
11724       d_mdrh(j_index,2) = 10.61881494
11725       d_mdrh(j_index,3) = -0.041402993
11726       d_mdrh(j_index,4) = 5.08084e-05
11727
11728 !
11729 ! sulfate-rich systems
11730 ! ab
11731       j_index = 52
11732       d_mdrh(j_index,1) = -493.6190458
11733       d_mdrh(j_index,2) = 6.747053851
11734       d_mdrh(j_index,3) = -0.026955267
11735       d_mdrh(j_index,4) = 3.45118e-05
11736
11737 ! lv
11738       j_index = 53
11739       d_mdrh(j_index,1) = 53.37874093
11740       d_mdrh(j_index,2) = 1.01368249
11741       d_mdrh(j_index,3) = -0.005887513
11742       d_mdrh(j_index,4) = 8.94393e-06
11743
11744 ! sb
11745       j_index = 54
11746       d_mdrh(j_index,1) = 206.619047
11747       d_mdrh(j_index,2) = -1.342735684
11748       d_mdrh(j_index,3) = 0.003197691
11749       d_mdrh(j_index,4) = -1.93603e-06
11750
11751 ! ab + lv
11752       j_index = 55
11753       d_mdrh(j_index,1) = -493.6190458
11754       d_mdrh(j_index,2) = 6.747053851
11755       d_mdrh(j_index,3) = -0.026955267
11756       d_mdrh(j_index,4) = 3.45118e-05
11757
11758 ! as + lv
11759       j_index = 56
11760       d_mdrh(j_index,1) = 53.37874093
11761       d_mdrh(j_index,2) = 1.01368249
11762       d_mdrh(j_index,3) = -0.005887513
11763       d_mdrh(j_index,4) = 8.94393e-06
11764
11765 ! ss + sb
11766       j_index = 57
11767       d_mdrh(j_index,1) = 206.619047
11768       d_mdrh(j_index,2) = -1.342735684
11769       d_mdrh(j_index,3) = 0.003197691
11770       d_mdrh(j_index,4) = -1.93603e-06
11771
11772 ! ss + lv
11773       j_index = 58
11774       d_mdrh(j_index,1) = 41.7619047
11775       d_mdrh(j_index,2) = 1.303872053
11776       d_mdrh(j_index,3) = -0.007647908
11777       d_mdrh(j_index,4) = 1.17845e-05
11778
11779 ! ss + as + lv
11780       j_index = 59
11781       d_mdrh(j_index,1) = 41.7619047
11782       d_mdrh(j_index,2) = 1.303872053
11783       d_mdrh(j_index,3) = -0.007647908
11784       d_mdrh(j_index,4) = 1.17845e-05
11785
11786 ! ss + ab
11787       j_index = 60
11788       d_mdrh(j_index,1) = -369.7142842
11789       d_mdrh(j_index,2) = 5.512878771
11790       d_mdrh(j_index,3) = -0.02301948
11791       d_mdrh(j_index,4) = 3.0303e-05
11792
11793 ! ss + lv + ab
11794       j_index = 61
11795       d_mdrh(j_index,1) = -369.7142842
11796       d_mdrh(j_index,2) = 5.512878771
11797       d_mdrh(j_index,3) = -0.02301948
11798       d_mdrh(j_index,4) = 3.0303e-05
11799
11800 ! sb + ab
11801       j_index = 62
11802       d_mdrh(j_index,1) = -162.8095232
11803       d_mdrh(j_index,2) = 2.399326592
11804       d_mdrh(j_index,3) = -0.009336219
11805       d_mdrh(j_index,4) = 1.17845e-05
11806
11807 ! ss + sb + ab
11808       j_index = 63
11809       d_mdrh(j_index,1) = -735.4285689
11810       d_mdrh(j_index,2) = 8.885521857
11811       d_mdrh(j_index,3) = -0.033488456
11812       d_mdrh(j_index,4) = 4.12458e-05
11813
11814
11815       endif ! first
11816
11817       return
11818       end subroutine load_mosaic_parameters
11819
11820
11821
11822
11823
11824
11825
11826
11827
11828
11829
11830 !***********************************************************************
11831 ! updates all temperature dependent thermodynamic parameters
11832 !
11833 ! author: rahul a. zaveri
11834 ! update: jan 2005
11835 !-----------------------------------------------------------------------
11836       subroutine update_thermodynamic_constants
11837 !     implicit none
11838 !     include 'mosaic.h'
11839 ! local variables
11840       integer iv, j_index, ibin, je
11841       real(kind=8) tr, rt, term
11842 ! function
11843 !     real(kind=8) fn_keq, fn_po, drh_mutual, bin_molality
11844
11845
11846       tr = 298.15                       ! reference temperature
11847       rt = 82.056*t_k/(1.e9*1.e6)       ! [m^3 atm/nmol]
11848
11849 ! gas-liquid
11850       keq_gl(1)= 1.0                                     ! kelvin effect (default)
11851       keq_gl(2)= fn_keq(57.64d0 , 13.79d0, -5.39d0,t_k)*rt     ! nh3(g)  <=> nh3(l)
11852       keq_gl(3)= fn_keq(2.63d6, 29.17d0, 16.83d0,t_k)*rt     ! hno3(g) <=> no3- + h+
11853       keq_gl(4)= fn_keq(2.00d6, 30.20d0, 19.91d0,t_k)*rt     ! hcl(g)  <=> cl- + h+
11854
11855 ! liquid-liquid
11856       keq_ll(1)= fn_keq(1.0502d-2, 8.85d0, 25.14d0,t_k)      ! hso4- <=> so4= + h+
11857       keq_ll(2)= fn_keq(1.805d-5, -1.50d0, 26.92d0,t_k)      ! nh3(l) + h2o = nh4+ + oh-
11858       keq_ll(3)= fn_keq(1.01d-14,-22.52d0, 26.92d0,t_k)      ! h2o(l) <=> h+ + oh-
11859
11860
11861       kp_nh3   = keq_ll(3)/(keq_ll(2)*keq_gl(2))
11862       kp_nh4no3= kp_nh3/keq_gl(3)
11863       kp_nh4cl = kp_nh3/keq_gl(4)
11864
11865
11866 ! solid-gas
11867       keq_sg(1)= fn_keq(4.72d-17,-74.38d0,6.12d0,t_k)/rt**2  ! nh4no3<=>nh3(g)+hno3(g)
11868       keq_sg(2)= fn_keq(8.43d-17,-71.00d0,2.40d0,t_k)/rt**2  ! nh4cl <=>nh3(g)+hcl(g)
11869
11870
11871 ! solid-liquid
11872       keq_sl(jnh4so4) = fn_keq(1.040d0,-2.65d0, 38.57d0, t_k)  ! amso4(s) = 2nh4+ + so4=
11873       keq_sl(jlvcite) = fn_keq(11.8d0, -5.19d0, 54.40d0, t_k)  ! lvcite(s)= 3nh4+ + hso4- + so4=
11874       keq_sl(jnh4hso4)= fn_keq(117.0d0,-2.87d0, 15.83d0, t_k)  ! amhso4(s)= nh4+ + hso4-
11875       keq_sl(jnh4msa) = 1.e15                            ! NH4MSA(s)= NH4+ + MSA-
11876       keq_sl(jnh4no3) = fn_keq(12.21d0,-10.4d0, 17.56d0, t_k)  ! nh4no3(s)= nh4+ + no3-
11877       keq_sl(jnh4cl)  = fn_keq(17.37d0,-6.03d0, 16.92d0, t_k)  ! nh4cl(s) = nh4+ + cl-
11878       keq_sl(jna2so4) = fn_keq(0.491d0, 0.98d0, 39.75d0, t_k)  ! na2so4(s)= 2na+ + so4=
11879       keq_sl(jnahso4) = fn_keq(313.0d0, 0.8d0,  14.79d0, t_k)  ! nahso4(s)= na+ + hso4-
11880       keq_sl(jna3hso4)= 1.e15                            ! na3h(so4)2(s) = 2na+ + hso4- + so4=
11881       keq_sl(jnamsa)  = 1.e15                            ! NaMSA(s) = Na+ + MSA-
11882       keq_sl(jnano3)  = fn_keq(11.95d0,-8.22d0, 16.01d0, t_k)  ! nano3(s) = na+ + no3-
11883       keq_sl(jnacl)   = fn_keq(38.28d0,-1.52d0, 16.89d0, t_k)  ! nacl(s)  = na+ + cl-
11884       keq_sl(jcacl2)  = fn_keq(8.0d11,32.84d0,44.79d0, t_k)*1.e5  ! cacl2(s) = ca++ + 2cl-
11885       keq_sl(jcano3)  = fn_keq(4.31d5, 7.83d0,42.01d0, t_k)*1.e5  ! ca(no3)2(s) = ca++ + 2no3-
11886       keq_sl(jcamsa2) = 1.e15                            ! CaMSA2(s)= Ca+ + 2MSA-
11887
11888 ! vapor pressures of soa species
11889       po_soa(iaro1_g) = fn_po(5.7d-5, 156.0d0, t_k)     ! [pascal]
11890       po_soa(iaro2_g) = fn_po(1.6d-3, 156.0d0, t_k)     ! [pascal]
11891       po_soa(ialk1_g) = fn_po(5.0d-6, 156.0d0, t_k)     ! [pascal]
11892       po_soa(iole1_g) = fn_po(5.0d-6, 156.0d0, t_k)     ! [pascal]
11893       po_soa(iapi1_g) = fn_po(4.0d-6, 156.0d0, t_k)     ! [pascal]
11894       po_soa(iapi2_g) = fn_po(1.7d-4, 156.0d0, t_k)     ! [pascal]
11895       po_soa(ilim1_g) = fn_po(2.5d-5, 156.0d0, t_k)     ! [pascal]
11896       po_soa(ilim2_g) = fn_po(1.2d-4, 156.0d0, t_k)     ! [pascal]
11897
11898       do iv = iaro1_g, ngas_volatile
11899         sat_soa(iv) = 1.e9*po_soa(iv)/(8.314*t_k)       ! [nmol/m^3(air)]
11900       enddo
11901
11902 ! water surface tension
11903       term = (647.15 - t_k)/647.15
11904       sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
11905
11906 ! mdrh(t)
11907       do j_index = 1, 63
11908         mdrh_t(j_index) = drh_mutual(j_index)
11909       enddo
11910
11911
11912
11913 ! rh dependent parameters
11914       do ibin = 1, nbin_a
11915         ah2o_a(ibin) = ah2o                     ! initialize
11916       enddo
11917
11918       call mtem_compute_log_gamz                ! function of ah2o and t
11919
11920
11921       return
11922       end subroutine update_thermodynamic_constants
11923
11924
11925
11926
11927 !***********************************************************************
11928 ! functions used in mosaic
11929 !
11930 ! author: rahul a. zaveri
11931 ! update: jan 2005
11932 !-----------------------------------------------------------------------
11933
11934
11935
11936 !----------------------------------------------------------
11937       real(kind=8) function fn_keq(keq_298, a, b, t)
11938 !     implicit none
11939 ! subr. arguments
11940       real(kind=8) keq_298, a, b, t
11941 ! local variables
11942       real(kind=8) tt
11943
11944
11945         tt = 298.15/t
11946         fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+log(tt)-tt))
11947
11948       return
11949       end function fn_keq
11950 !----------------------------------------------------------
11951
11952
11953
11954
11955
11956 !----------------------------------------------------------
11957       real(kind=8) function fn_po(po_298, dh, t)        ! touch
11958 !     implicit none
11959 ! subr. arguments
11960       real(kind=8) po_298, dh, t
11961 ! local variables
11962
11963         fn_po = po_298*exp(-(dh/8.314e-3)*(1./t - 3.354016435e-3))
11964
11965       return
11966       end function fn_po
11967 !----------------------------------------------------------
11968
11969
11970
11971
11972
11973 !----------------------------------------------------------
11974       real(kind=8) function drh_mutual(j_index)
11975 !     implicit none
11976 !     include 'mosaic.h'
11977 ! subr. arguments
11978       integer j_index
11979 ! local variables
11980       integer j
11981
11982
11983       j = j_index
11984
11985       if(j_index .eq. 7 .or. j_index .eq. 8 .or.   &
11986         (j_index.ge. 34 .and. j_index .le. 51))then
11987
11988         drh_mutual = 10.0  ! cano3 or cacl2 containing mixtures
11989
11990       else
11991
11992         drh_mutual =  d_mdrh(j,1) + t_k*   &
11993                      (d_mdrh(j,2) + t_k*   &
11994                      (d_mdrh(j,3) + t_k*   &
11995                       d_mdrh(j,4) )) + 1.0
11996
11997       endif
11998
11999
12000       return
12001       end function drh_mutual
12002 !----------------------------------------------------------
12003
12004
12005
12006
12007
12008
12009 !----------------------------------------------------------
12010 ! zsr method at 60% rh
12011 !
12012       real(kind=8) function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
12013 !     implicit none
12014 !     include 'mosaic.h'
12015 ! subr. arguments
12016       integer ibin
12017 ! local variables
12018       integer jp, je
12019       real(kind=8) dum
12020 ! function
12021 !     real(kind=8) bin_molality_60
12022
12023
12024       jp = jtotal
12025       dum = 0.0
12026
12027       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
12028         dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
12029       enddo
12030
12031       aerosol_water_up = dum
12032
12033       return
12034       end function aerosol_water_up
12035 !----------------------------------------------------------
12036
12037
12038
12039
12040
12041
12042 !----------------------------------------------------------
12043 ! zsr method
12044       real(kind=8) function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
12045 !     implicit none
12046 !     include 'mosaic.h'
12047 ! subr. arguments
12048       integer jp, ibin
12049 ! local variables
12050       integer je
12051       real(kind=8) dum
12052 ! function
12053 !     real(kind=8) bin_molality
12054
12055
12056
12057       dum = 0.0
12058       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
12059         dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality(je,ibin)
12060       enddo
12061
12062       aerosol_water = dum
12063
12064       if(aerosol_water .le. 0.0)then
12065         if (iprint_mosaic_diag1 .gt. 0) then
12066           write(6,*)'mosaic aerosol_water - water .le. 0'
12067           write(6,*)'iclm  jclm  ibin  jp = ',   &
12068                      iclm_aer, jclm_aer, ibin, jp
12069           write(6,*)'ah2o, water = ', ah2o, aerosol_water
12070           write(6,*)'dry mass = ', mass_dry_a(ibin)
12071           write(6,*)'soluble mass = ', mass_soluble_a(ibin)
12072           write(6,*)'number = ', num_a(ibin)
12073           do je = 1, nsoluble
12074             write(6,44)ename(je), electrolyte(je,jp,ibin)
12075           enddo
12076           write(6,*)'error in water calculation'
12077           write(6,*)'ibin = ', ibin
12078           write(6,*)'water content cannot be negative or zero'
12079           write(6,*)'setting jaerosolstate to all_solid'
12080         endif
12081
12082         call print_input
12083
12084         jaerosolstate(ibin) = all_solid
12085         jphase(ibin)    = jsolid
12086         jhyst_leg(ibin) = jhyst_lo
12087
12088 !c        write(6,*)'stopping execution in function aerosol_water'
12089 !c        stop
12090       endif
12091
12092 44    format(a7, 2x, e11.3)
12093
12094
12095       return
12096       end function aerosol_water
12097 !----------------------------------------------------------
12098
12099
12100
12101
12102
12103 !----------------------------------------------------------
12104       real(kind=8) function bin_molality(je,ibin)
12105 !     implicit none
12106 !     include 'mosaic.h'
12107 ! subr. arguments
12108       integer je, ibin
12109 ! local variables
12110       real(kind=8) aw, xm
12111
12112
12113       aw = max(ah2o_a(ibin), aw_min(je))
12114       aw = min(aw, 0.999999D0)
12115
12116
12117       if(aw .lt. 0.97)then
12118
12119         xm =     a_zsr(1,je) +   &
12120              aw*(a_zsr(2,je) +   &
12121              aw*(a_zsr(3,je) +   &
12122              aw*(a_zsr(4,je) +   &
12123              aw*(a_zsr(5,je) +   &
12124              aw* a_zsr(6,je) ))))
12125
12126         bin_molality = 55.509*xm/(1. - xm)
12127
12128       else
12129
12130         bin_molality = -b_zsr(je)*log(aw)
12131
12132       endif
12133
12134
12135       return
12136       end function bin_molality
12137 !----------------------------------------------------------
12138
12139
12140
12141
12142
12143 !----------------------------------------------------------
12144       real(kind=8) function bin_molality_60(je)
12145 !     implicit none
12146 !     include 'mosaic.h'
12147 ! subr. arguments
12148       integer je
12149 ! local variables
12150       real(kind=8) aw, xm
12151
12152
12153       aw = 0.6
12154
12155         xm =  a_zsr(1,je) + aw*   &
12156              (a_zsr(2,je) + aw*   &
12157              (a_zsr(3,je) + aw*   &
12158              (a_zsr(4,je) + aw*   &
12159              (a_zsr(5,je) + aw*   &
12160               a_zsr(6,je) ))))
12161
12162       bin_molality_60 = 55.509*xm/(1. - xm)
12163
12164       return
12165       end function bin_molality_60
12166 !----------------------------------------------------------
12167
12168
12169
12170
12171
12172 !----------------------------------------------------------
12173       real(kind=8) function fnlog_gamz(ja,je)   ! ja in je
12174 !     implicit none
12175 !     include 'mosaic.h'
12176 ! subr. arguments
12177       integer ja, je
12178 ! local variables
12179       real(kind=8) aw
12180
12181
12182       aw = max(ah2o, aw_min(je))
12183
12184       fnlog_gamz = b_mtem(1,ja,je) + aw*   &
12185                   (b_mtem(2,ja,je) + aw*   &
12186                   (b_mtem(3,ja,je) + aw*   &
12187                   (b_mtem(4,ja,je) + aw*   &
12188                   (b_mtem(5,ja,je) + aw*   &
12189                    b_mtem(6,ja,je) ))))
12190
12191       return
12192       end function fnlog_gamz
12193 !----------------------------------------------------------
12194
12195
12196
12197
12198 !----------------------------------------------------------
12199       real(kind=8) function mean_molecular_speed(t, mw) ! in cm/s
12200 !     implicit none
12201 ! subr. arguments
12202       real(kind=8) t, mw        ! t(k)
12203
12204         mean_molecular_speed = 1.455e4 * sqrt(t/mw)
12205
12206       return
12207       end function mean_molecular_speed
12208 !----------------------------------------------------------
12209
12210
12211
12212
12213 !----------------------------------------------------------
12214       real(kind=8) function gas_diffusivity(t, p, mw, vm)       ! in cm^2/s
12215 !     implicit none
12216 ! subr. arguments
12217       real(kind=8) mw, vm, t, p ! t(k), p(atm)
12218
12219
12220       gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/   &
12221                              (p * (vm**0.333333 + 2.7189)**2)
12222
12223
12224       return
12225       end function gas_diffusivity
12226 !----------------------------------------------------------
12227
12228
12229
12230
12231 !----------------------------------------------------------
12232       real(kind=8) function fuchs_sutugin(rkn,a)
12233 !     implicit none
12234 ! subr. arguments
12235       real(kind=8) rkn, a
12236 ! local variables
12237       real(kind=8) rnum, denom
12238
12239
12240       rnum  = 0.75*a*(1. + rkn)
12241       denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
12242       fuchs_sutugin = rnum/denom
12243
12244       return
12245       end function fuchs_sutugin
12246 !----------------------------------------------------------
12247
12248
12249
12250
12251
12252 !----------------------------------------------------------
12253 ! solution to x^3 + px^2 + qx + r = 0
12254 !
12255       real(kind=8) function cubic( p, q, r )
12256 !     implicit none
12257 ! subr arguments
12258       real(kind=8), intent(in) :: p, q, r
12259 ! local variables
12260       real(kind=8) a, b, d, m, n, third, y
12261       real(kind=8) k, phi, thesign, x(3), duma
12262       integer icase, kk
12263
12264       third = 1.d0/3.d0
12265
12266       a = (1.d0/3.d0)*((3.d0*q) - (p*p))
12267       b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
12268
12269       d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
12270
12271       if(d .gt. 0.)then !       => 1 real and 2 complex roots
12272         icase = 1
12273       elseif(d .eq. 0.)then !   => 3 real roots, atleast 2 identical
12274         icase = 2
12275       else      ! d < 0         => 3 distinct real roots
12276         icase = 3
12277       endif
12278
12279
12280       goto (1,2,3), icase
12281
12282 ! case 1: d > 0
12283 1     thesign = 1.
12284       if(b .gt. 0.)then
12285         b = -b
12286         thesign = -1.
12287       endif
12288
12289       m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
12290       n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
12291
12292       cubic = real( (m) + (n) - (p/3.d0) )
12293       return
12294
12295 ! case 2: d = 0
12296 2     thesign = 1.
12297       if(b .gt. 0.)then
12298         b = -b
12299         thesign = -1.
12300       endif
12301
12302       m = thesign*(-b/2.d0)**third
12303       n = m
12304
12305       x(1) = real( (m) + (n) - (p/3.d0) )
12306       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12307       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
12308
12309       cubic = 0.
12310       do kk = 1, 3
12311         if(x(kk).gt.cubic) cubic = x(kk)
12312       enddo
12313       return
12314
12315 ! case 3: d < 0
12316 3     if(b.gt.0.)then
12317         thesign = -1.
12318       elseif(b.lt.0.)then
12319         thesign = 1.
12320       endif
12321
12322 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
12323 !     phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) ))     ! radians
12324       duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
12325       duma = min( duma, +1.0D0 )
12326       duma = max( duma, -1.0D0 )
12327       phi  = acos( duma )       ! radians
12328
12329
12330       cubic = 0.
12331       do kk = 1, 3
12332         k = kk-1
12333         y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
12334         x(kk) = real((y) - (p/3.d0))
12335         if(x(kk).gt.cubic) cubic = x(kk)
12336       enddo
12337       return
12338
12339       end function cubic
12340 !----------------------------------------------------------
12341
12342
12343
12344
12345 !----------------------------------------------------------
12346       real(kind=8) function quadratic(a,b,c)
12347 !     implicit none
12348 ! subr. arguments
12349       real(kind=8) a, b, c
12350 ! local variables
12351       real(kind=8) x, dum, quad1, quad2
12352
12353
12354         if(b .ne. 0.0)then
12355         x = 4.*(a/b)*(c/b)
12356         else
12357         x = 1.e+6
12358         endif
12359
12360         if(abs(x) .lt. 1.e-6)then
12361           dum = (0.5*x) +   &
12362                 (0.125*x**2) +   &
12363                 (0.0625*x**3)
12364
12365           quadratic = (-0.5*b/a)*dum
12366
12367           if(quadratic .lt. 0.)then
12368             quadratic = -b/a - quadratic
12369           endif
12370
12371         else
12372           quad1 = (-b+sqrt(b*b-4.*a*c))/(2.*a)
12373           quad2 = (-b-sqrt(b*b-4.*a*c))/(2.*a)
12374
12375           quadratic = max(quad1, quad2)
12376         endif
12377
12378       return
12379       end function quadratic
12380 !----------------------------------------------------------
12381
12382
12383
12384 !----------------------------------------------------------
12385 ! currently not used
12386
12387 ! two roots of a quadratic equation
12388
12389       subroutine quadratix(a,b,c, qx1,qx2)
12390 !      implicit none
12391 ! subr. arguments
12392       real(kind=8) a, b, c, qx1, qx2
12393 ! local variables
12394       real(kind=8) x, dum
12395
12396
12397       if(b .ne. 0.0)then
12398         x = 4.*(a/b)*(c/b)
12399         else
12400         x = 1.e+6
12401       endif
12402
12403       if(abs(x) .lt. 1.e-6)then
12404         dum = (0.5*x) +   &
12405               (0.125*x**2) +   &
12406               (0.0625*x**3)
12407
12408         qx1 = (-0.5*b/a)*dum
12409         qx2 = -b/a - qx1
12410
12411       else
12412
12413         qx1 = (-b+sqrt(b*b - 4.*a*c))/(2.*a)
12414         qx2 = (-b-sqrt(b*b - 4.*a*c))/(2.*a)
12415
12416       endif
12417
12418       return
12419       end subroutine quadratix
12420
12421
12422 !=====================================================================
12423
12424
12425
12426
12427
12428
12429
12430
12431
12432
12433
12434
12435
12436
12437
12438
12439
12440 !***********************************************************************
12441 ! computes aerosol optical properties
12442 !
12443 ! author: rahul a. zaveri
12444 ! update: jan 2005
12445 !-----------------------------------------------------------------------
12446       subroutine aerosol_optical_properties(iclm, jclm, nz, refindx, &
12447         radius_wet, number_bin)
12448 ! changed to use rsub instead of rclm 7-8-04 egc
12449       use module_data_mosaic_asect
12450       use module_data_mosaic_other
12451       use module_state_description, only:  param_first_scalar
12452
12453 !     implicit none
12454
12455 ! subr arguments
12456       integer, intent(in   ) :: iclm, jclm, nz
12457       real, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12458             number_bin, radius_wet
12459       complex, dimension (1:nbin_a_maxd, 1:kmaxd), intent(inout ) :: &
12460             refindx
12461
12462 ! local variables
12463       integer iaer, ibin, iphase, isize, itype, je, k, l, m
12464       integer ilaporte, jlaporte
12465       integer p1st
12466       real(kind=8) xt
12467
12468
12469 ! if a species index is less than this value, then the species is not defined
12470         p1st = param_first_scalar
12471
12472 ! fix number of subareas at 1
12473         nsubareas = 1
12474
12475         lunerr_aer = lunerr
12476         ncorecnt_aer = ncorecnt
12477
12478       call load_mosaic_parameters
12479
12480       iclm_aer = iclm
12481       jclm_aer = jclm
12482
12483       do 110 m = 1, nsubareas
12484       do 100 k = 1, nz
12485
12486         mclm_aer = m
12487         kclm_aer = k
12488
12489         cair_mol_m3 = cairclm(k)*1.e6   ! cairclm(k) is in mol/cc
12490         cair_mol_cc = cairclm(k)
12491
12492         conv1a = cair_mol_m3*1.e9               ! converts q/mol(air) to nq/m^3 (q = mol or g)
12493         conv1b = 1./conv1a                      ! converts nq/m^3 to q/mol(air)
12494         conv2a = cair_mol_m3*18.*1.e-3          ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
12495         conv2b = 1./conv2a                      ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
12496
12497
12498 ! initialize to zero
12499         do ibin = 1, nbin_a
12500           do iaer = 1, naer
12501             aer(iaer,jtotal,ibin)  = 0.0
12502           enddo
12503
12504           do je = 1, nelectrolyte
12505             electrolyte(je,jtotal,ibin)  = 0.0
12506           enddo
12507
12508           jaerosolstate(ibin) = -1      ! initialize to default value
12509
12510         enddo
12511
12512
12513 ! rce 18-nov-2004 - map (transfer) aerosol mass/water/number from rsub
12514 !   to mosaic arrays (aer, watr_a, num_a)
12515 ! always map so4 and number,
12516 !   but only map other species when (lptr_xxx .ge. p1st)
12517 ! (the mapping is identical to that done in mapgasaerspecies)
12518
12519         iphase = ai_phase
12520         ibin = 0
12521         do 90 itype = 1, ntype_aer
12522         do 90 isize = 1, nsize_aer(itype)
12523         ibin = ibin + 1
12524
12525 ! aer array units are nmol/(m^3 air)
12526         l = lptr_so4_aer(isize,itype,iphase)
12527         if (l .ge. p1st) then
12528             aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12529         else
12530             aer(iso4_a,jtotal,ibin)=0.0
12531         end if
12532
12533         l = lptr_no3_aer(isize,itype,iphase)
12534         if (l .ge. p1st) then
12535             aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12536         else
12537             aer(ino3_a,jtotal,ibin)=0.0
12538         end if
12539
12540         l = lptr_cl_aer(isize,itype,iphase)
12541         if (l .ge. p1st) then
12542             aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12543         else
12544             aer(icl_a,jtotal,ibin)=0.0
12545         end if
12546
12547         l = lptr_nh4_aer(isize,itype,iphase)
12548         if (l .ge. p1st) then
12549             aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12550         else
12551             aer(inh4_a,jtotal,ibin)=0.0
12552         end if
12553
12554         l = lptr_oc_aer(isize,itype,iphase)
12555         if (l .ge. p1st) then
12556             aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12557         else
12558             aer(ioc_a,jtotal,ibin)=0.0
12559         end if
12560
12561         l = lptr_bc_aer(isize,itype,iphase)
12562         if (l .ge. p1st) then
12563             aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12564         else
12565             aer(ibc_a,jtotal,ibin)=0.0
12566         end if
12567
12568         l = lptr_na_aer(isize,itype,iphase)
12569         if (l .ge. p1st) then
12570             aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12571         else
12572             aer(ina_a,jtotal,ibin)=0.0
12573         end if
12574
12575         l = lptr_oin_aer(isize,itype,iphase)
12576         if (l .ge. p1st) then
12577             aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12578         else
12579             aer(ioin_a,jtotal,ibin)=0.0
12580         end if
12581
12582         l = lptr_msa_aer(isize,itype,iphase)
12583         if (l .ge. p1st) then
12584             aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12585         else
12586             aer(imsa_a,jtotal,ibin)=0.0
12587         end if
12588
12589         l = lptr_co3_aer(isize,itype,iphase)
12590         if (l .ge. p1st) then
12591             aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12592         else
12593             aer(ico3_a,jtotal,ibin)=0.0
12594         end if
12595
12596         l = lptr_ca_aer(isize,itype,iphase)
12597         if (l .ge. p1st) then
12598             aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12599         else
12600             aer(ica_a,jtotal,ibin)=0.0
12601         end if
12602
12603 ! soa aerosol-phase species -- currently deactivated
12604 !       l = lptr_aro1_aer(isize,itype,iphase)
12605 !       if (l .ge. p1st) then
12606 !           aer(iaro1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12607 !       else
12608             aer(iaro1_a,jtotal,ibin)=0.0
12609 !       end if
12610
12611 !       l = lptr_aro2_aer(isize,itype,iphase)
12612 !       if (l .ge. p1st) then
12613 !           aer(iaro2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12614 !       else
12615             aer(iaro2_a,jtotal,ibin)=0.0
12616 !       end if
12617
12618 !       l = lptr_alk1_aer(isize,itype,iphase)
12619 !       if (l .ge. p1st) then
12620 !           aer(ialk1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12621 !       else
12622             aer(ialk1_a,jtotal,ibin)=0.0
12623 !       end if
12624
12625 !       l = lptr_ole1_aer(isize,itype,iphase)
12626 !       if (l .ge. p1st) then
12627 !           aer(iole1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12628 !       else
12629             aer(iole1_a,jtotal,ibin)=0.0
12630 !       end if
12631
12632 !       l = lptr_api1_aer(isize,itype,iphase)
12633 !       if (l .ge. p1st) then
12634 !           aer(iapi1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12635 !       else
12636             aer(iapi1_a,jtotal,ibin)=0.0
12637 !       end if
12638
12639 !       l = lptr_api2_aer(isize,itype,iphase)
12640 !       if (l .ge. p1st) then
12641 !           aer(iapi2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12642 !       else
12643             aer(iapi2_a,jtotal,ibin)=0.0
12644 !       end if
12645
12646 !       l = lptr_lim1_aer(isize,itype,iphase)
12647 !       if (l .ge. p1st) then
12648 !           aer(ilim1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12649 !       else
12650             aer(ilim1_a,jtotal,ibin)=0.0
12651 !       end if
12652
12653 !       l = lptr_lim2_aer(isize,itype,iphase)
12654 !       if (l .ge. p1st) then
12655 !           aer(ilim2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
12656 !       else
12657             aer(ilim2_a,jtotal,ibin)=0.0
12658 !       end if
12659
12660 ! water_a and water_a_hyst units are kg/(m^3 air)
12661         l = hyswptr_aer(isize,itype)
12662         if (l .ge. p1st) then
12663             water_a_hyst(ibin)=rsub(l,k,m)*conv2a
12664         else
12665             water_a_hyst(ibin)=0.0
12666         end if
12667
12668 ! water_a units are kg/(m^3 air)
12669         l = waterptr_aer(isize,itype)
12670         if (l .ge. p1st) then
12671             water_a(ibin)=rsub(l,k,m)*conv2a
12672         else
12673             water_a(ibin)=0.0
12674         end if
12675
12676 ! num_a units are #/(cm^3 air)
12677         l = numptr_aer(isize,itype,iphase)
12678         num_a(ibin) = rsub(l,k,m)*cair_mol_cc
12679
12680
12681           call check_aerosol_mass(ibin)
12682           if(jaerosolstate(ibin) .eq. no_aerosol)goto 90        ! ignore this bin
12683           call conform_electrolytes(jtotal,ibin,xt)                     ! conforms aer(jtotal) to a valid aerosol
12684           call check_aerosol_mass(ibin)                         ! check mass again after conform_electrolytes
12685           if(jaerosolstate(ibin) .eq. no_aerosol)goto 90        ! ignore this bin
12686           call conform_aerosol_number(ibin)                     ! adjusts number conc so that it conforms with bin mass and diameter
12687           call calc_dry_n_wet_aerosol_props(ibin)               ! calc dp_wet, ref index
12688
12689
12690
12691           refindx(ibin,k)    = ri_avg_a(ibin)                   ! vol avg ref index
12692           radius_wet(ibin,k) = dp_wet_a(ibin)/2.0               ! wet radius (cm)
12693           number_bin(ibin,k) = num_a(ibin)                      ! #/cc air
12694
12695 90      continue
12696
12697 100   continue  ! k levels
12698 110   continue  ! m subareas
12699
12700
12701       return
12702       end subroutine aerosol_optical_properties
12703
12704
12705
12706
12707
12708
12709
12710
12711
12712
12713 !***********************************************************************
12714 !  save aerosol drymass and drydens before aerosol mass transfer is
12715 !  calculated this subr is called from within subr mosaic_dynamic_solver,
12716 !  after the initial calls to check_aerosol_mass, conform_electrolytes,
12717 !  conform_aerosol_number, and aerosol_phase_state, but before the mass
12718 !  transfer is calculated
12719 !
12720 ! author: richard c. easter
12721 !-----------------------------------------------------------------------
12722       subroutine save_pregrow_props
12723
12724       use module_data_mosaic_asect
12725       use module_data_mosaic_other
12726
12727 !     implicit none
12728 !     include 'v33com'
12729 !     include 'v33com9a'
12730 !     include 'v33com9b'
12731 !     include 'mosaic.h'
12732
12733 !   subr arguments (none)
12734
12735 !   local variables
12736       integer ibin, isize, itype
12737
12738
12739 ! air conc in mol/cm^3
12740       cair_mol_cc = cairclm(kclm_aer)
12741
12742 ! compute then save drymass and drydens for each bin
12743       do ibin = 1, nbin_a
12744
12745       call calc_dry_n_wet_aerosol_props( ibin )
12746
12747       call isize_itype_from_ibin( ibin, isize, itype )
12748       drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc       ! g/mol(air)
12749       if(jaerosolstate(ibin) .eq. no_aerosol) then
12750           drydens_pregrow(isize,itype) = -1.
12751       else
12752           drydens_pregrow(isize,itype) = dens_dry_a(ibin)               ! g/cc
12753       end if
12754
12755       end do
12756
12757       return
12758       end subroutine save_pregrow_props
12759
12760
12761
12762
12763
12764
12765
12766 !***********************************************************************
12767 ! special output
12768 !
12769 ! author: richard c. easter
12770 !-----------------------------------------------------------------------
12771         subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
12772
12773 !       implicit none
12774
12775         integer iclm, jclm, kclm, msub
12776         character*(*) fromwhere
12777
12778         return
12779         end subroutine specialoutaa
12780
12781
12782
12783
12784 !***********************************************************************
12785 ! box model test output
12786 !
12787 ! author: richard c. easter
12788 !-----------------------------------------------------------------------
12789         subroutine aerchem_boxtest_output(   &
12790                 iflag, iclm, jclm, kclm, msub, dtchem )
12791
12792         use module_data_mosaic_asect
12793         use module_data_mosaic_other
12794 !       implicit none
12795
12796 !       include 'v33com'
12797 !       include 'v33com2'
12798 !       include 'v33com9a'
12799
12800         integer iflag, iclm, jclm, kclm, msub
12801         real(kind=8) dtchem
12802
12803 !   local variables
12804         integer lun
12805         parameter (lun=83)
12806         integer, save :: ientryno = -13579
12807         integer icomp, iphase, isize, itype, k, l, m, n
12808
12809         real(kind=8) dtchem_sv1
12810         save dtchem_sv1
12811         real(kind=8) rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
12812
12813
12814 !   bypass unless maerchem_boxtest_output > 0
12815         if (maerchem_boxtest_output .le. 0) return
12816
12817
12818
12819 !
12820 ! *** currently this only works for ntype_aer = 1
12821 !
12822         itype = 1
12823         iphase = ai_phase
12824
12825 !   do initial output
12826         if (ientryno .ne. -13579) goto 1000
12827
12828         ientryno = +1
12829         call peg_message( lunerr, '***' )
12830         call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
12831         call peg_message( lunerr, '***' )
12832
12833         write(lun) ltot, ltot2, itot, jtot, ktot
12834         write(lun) (name(l), l=1,ltot2)
12835
12836         write(lun) maerocoag, maerchem, maeroptical
12837         write(lun) msectional, maerosolincw
12838
12839         write(lun) nsize_aer(itype), ntot_mastercomp_aer
12840
12841         do icomp = 1, ntot_mastercomp_aer
12842             write(lun)   &
12843                 name_mastercomp_aer(icomp)
12844             write(lun)   &
12845                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
12846         end do
12847
12848         do isize = 1, nsize_aer(itype)
12849             write(lun)   &
12850                 ncomp_plustracer_aer(itype),   &
12851                 ncomp_aer(itype),   &
12852                 waterptr_aer(isize,itype),   &
12853                 numptr_aer(isize,itype,iphase),   &
12854                 mprognum_aer(isize,itype,iphase)
12855             write(lun)   &
12856               ( mastercompptr_aer(l,itype),   &
12857                 massptr_aer(l,isize,itype,iphase),   &
12858                 l=1,ncomp_plustracer_aer(itype) )
12859             write(lun)   &
12860                 volumcen_sect(isize,itype),   &
12861                 volumlo_sect(isize,itype),   &
12862                 volumhi_sect(isize,itype),   &
12863                 dcen_sect(isize,itype),   &
12864                 dlo_sect(isize,itype),   &
12865                 dhi_sect(isize,itype)
12866             write(lun)   &
12867                 lptr_so4_aer(isize,itype,iphase),   &
12868                 lptr_msa_aer(isize,itype,iphase),   &
12869                 lptr_no3_aer(isize,itype,iphase),   &
12870                 lptr_cl_aer(isize,itype,iphase),   &
12871                 lptr_co3_aer(isize,itype,iphase),   &
12872                 lptr_nh4_aer(isize,itype,iphase),   &
12873                 lptr_na_aer(isize,itype,iphase),   &
12874                 lptr_ca_aer(isize,itype,iphase),   &
12875                 lptr_oin_aer(isize,itype,iphase),   &
12876                 lptr_oc_aer(isize,itype,iphase),   &
12877                 lptr_bc_aer(isize,itype,iphase),   &
12878                 hyswptr_aer(isize,itype)
12879         end do
12880
12881 !
12882 !   test iflag
12883 !
12884 1000    continue
12885         if (iflag .eq. 1) goto 1010
12886         if (iflag .eq. 2) goto 2000
12887         if (iflag .eq. 3) goto 3000
12888         return
12889
12890 !
12891 !   iflag=1 -- save initial values
12892 !
12893 1010    continue
12894         dtchem_sv1 = dtchem
12895         do m = 1, nsubareas
12896         do k = 1, ktot
12897         do l = 1, ltot2
12898             rsub_sv1(l,k,m) = rsub(l,k,m)
12899         end do
12900         end do
12901         end do
12902
12903         return
12904
12905 !
12906 !   iflag=2 -- save intermediate values before doing move_sections
12907 !   (this is deactivated for now)
12908 !
12909 2000    continue
12910         return
12911
12912
12913 !
12914 !   iflag=3 -- do output
12915 !
12916 3000    continue
12917         do m = 1, nsubareas
12918         do k = 1, ktot
12919
12920         write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
12921         write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
12922                 ptotclm(k), afracsubarea(k,m)
12923
12924         write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
12925
12926         end do
12927         end do
12928
12929
12930         return
12931         end subroutine aerchem_boxtest_output
12932
12933
12934
12935 !***********************************************************************
12936 ! 'debugging' output when mosaic encounters 'fatal error' situation
12937 !
12938 ! author: richard c. easter
12939 !-----------------------------------------------------------------------
12940         subroutine mosaic_aerchem_error_dump( istop, ibin, luna, msga )
12941 !
12942 !   dumps current column information when a fatal computational error occurs
12943 !   when istop>0, the simulation is halted
12944 !
12945         use module_data_mosaic_asect
12946         use module_data_mosaic_other
12947 !       implicit none
12948
12949 !   arguments
12950         integer istop, ibin, luna
12951         character*(*) msga
12952
12953 !   local variables
12954         integer icomp, iphase, isize, itype, k, l, lunb, m, n
12955         real(kind=8) dtchem_sv1
12956
12957
12958 !
12959 ! *** currently this only works for ntype_aer = 1
12960 !
12961         itype = 1
12962
12963
12964         lunb = luna
12965         if (lunb .le. 0) lunb = 6
12966
12967 9000    format( a )
12968 9010    format( 7i10 )
12969 9020    format( 3(1pe19.11) )
12970
12971         write(lunb,9000)
12972         write(lunb,9000) 'begin mosaic_aerchem_error_dump - msga ='
12973         write(lunb,9000) msga
12974         write(lunb,9000) 'i, j, k, msub,ibin ='
12975         write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
12976
12977         write(lunb,9010) ltot, ltot2, itot, jtot, ktot
12978         write(lunb,9000) (name(l), l=1,ltot2)
12979
12980         write(lunb,9010) maerocoag, maerchem, maeroptical
12981         write(lunb,9010) msectional, maerosolincw
12982
12983         write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
12984
12985         do icomp = 1, ntot_mastercomp_aer
12986             write(lunb,9000)   &
12987                 name_mastercomp_aer(icomp)
12988             write(lunb,9020)   &
12989                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
12990         end do
12991
12992         do isize = 1, nsize_aer(itype)
12993             write(lunb,9010)   &
12994                 ncomp_plustracer_aer(itype),   &
12995                 ncomp_aer(itype),   &
12996                 waterptr_aer(isize,itype),   &
12997                 numptr_aer(isize,itype,iphase),   &
12998                 mprognum_aer(isize,itype,iphase)
12999             write(lunb,9010)   &
13000               ( mastercompptr_aer(l,itype),   &
13001                 massptr_aer(l,isize,itype,iphase),   &
13002                 l=1,ncomp_plustracer_aer(itype) )
13003             write(lunb,9020)   &
13004                 volumcen_sect(isize,itype),   &
13005                 volumlo_sect(isize,itype),   &
13006                 volumhi_sect(isize,itype),   &
13007                 dcen_sect(isize,itype),   &
13008                 dlo_sect(isize,itype),   &
13009                 dhi_sect(isize,itype)
13010             write(lunb,9010)   &
13011                 lptr_so4_aer(isize,itype,iphase),   &
13012                 lptr_msa_aer(isize,itype,iphase),   &
13013                 lptr_no3_aer(isize,itype,iphase),   &
13014                 lptr_cl_aer(isize,itype,iphase),   &
13015                 lptr_co3_aer(isize,itype,iphase),   &
13016                 lptr_nh4_aer(isize,itype,iphase),   &
13017                 lptr_na_aer(isize,itype,iphase),   &
13018                 lptr_ca_aer(isize,itype,iphase),   &
13019                 lptr_oin_aer(isize,itype,iphase),   &
13020                 lptr_oc_aer(isize,itype,iphase),   &
13021                 lptr_bc_aer(isize,itype,iphase),   &
13022                 hyswptr_aer(isize,itype)
13023         end do
13024
13025
13026         dtchem_sv1 = -1.0
13027         do m = 1, nsubareas
13028         do k = 1, ktot
13029
13030         write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
13031         write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
13032                 ptotclm(k), afracsubarea(k,m)
13033
13034         write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
13035
13036         end do
13037         end do
13038
13039         write(lunb,9000) 'end mosaic_aerchem_error_dump'
13040
13041
13042         if (istop .gt. 0) call peg_error_fatal( luna, msga )
13043
13044         return
13045         end subroutine mosaic_aerchem_error_dump
13046 !-----------------------------------------------------------------------
13047
13048       end module module_mosaic_therm