chem/module_mosaic_therm.F

   1 !************************************************************************
   2 ! This computer software was prepared by Battelle Memorial Institute,
   3 ! hereinafter the Contractor, under Contract No. DE-AC05-76RL0 1830 with
   4 ! the Department of Energy (DOE). NEITHER THE GOVERNMENT NOR THE
   5 ! CONTRACTOR MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY
   6 ! LIABILITY FOR THE USE OF THIS SOFTWARE.
   7 !
   8 ! MOSAIC module: see module_mosaic_driver.F for references and terms of
   9 ! use
  10 !************************************************************************
  11       module module_mosaic_therm
  12
  13
  14
  15       use module_data_mosaic_therm
  16       use module_peg_util
  17
  18
  19
  20       implicit none
  21
  22       intrinsic max, min
  23
  24       contains
  25
  26
  27
  28 !   zz01aerchemistry.f (mosaic.28.0)
  29 !   5/21/2014  raz - updated subr. aerosol_phase_state and function aerosol_water.
  30 !                    All particles are forced to be metastable (or stable) for RH > 35%
  31 !                    OC (POA), SOA, OIN, BC are now included in water content calculation using kappa-Kohler theory.
  32 !                    The kappa values are hardcoded in function aerosol_water.
  33 !   11/13/2008 raz - updated calculation of "epercent" variable
  34 !   6/25/2008  raz - updated nh4no3 and nh4cl condensation algorithm
  35 !   30-apr-07 raz - made about a dozen changes/bug fixes. search for "raz-30apr07" to see the changes
  36 !   05-feb-07 wig - converted to double
  37 !   10-jan-07 raz - contains major revisions and updates. new module ASTEM replaces ASTEEM.
  38 !   04-aug-06 raz - fixed bugs in asteem_flux_mix_case3a and asteem_flux_mix_case3b
  39 !                   revised treatment of kelvin effect.
  40 !   06-jun-06 rce - changed dens_aer_mac(ica_a) & (ico3_a) from 2.5 to 2.6
  41 !   31-may-06 rce - got latest version from
  42 !                       nirvana:/home/zaveri/rahul/pegasus/pegasus.3.1.1/src
  43 !                   in subr map_mosaic_species, turned off mapping
  44 !                       of soa species
  45 !   18-may-06 raz - major revisions in asteem and minor changes in mesa
  46 !   22-jan-06 raz - revised nh4no3 and nh4cl condensation algorithm
  47 !   07-jan-06 raz - improved asteem algorithm
  48 !   28-apr-05 raz - reversed calls to form_cacl2 and form_nacl
  49 !                   fixed caco3 error in subr. electrolytes_to_ions
  50 !                   renamed dens_aer to dens_aer_mac; mw_aer to mw_aer_mac
  51 !   27-apr-05 raz - updated dry_mass calculation approach in mesa_convergence
  52 !   22-apr-05 raz - fixed caso4 mass balance problem and updated algorithm to
  53 !                   calculate phi_volatile for nh3, hno3, and hcl.
  54 !   20-apr-05 raz - updated asceem
  55 !   19-apr-05 raz - updated the algorithm to constrain the nh4 concentration
  56 !                   during simultaneous nh3, hno3, and hcl integration such
  57 !                   that it does not exceed the max possible value for a given bin
  58 !   14-apr-05 raz - fixed asteem_flux_wet_case3 and asteem_flux_dry_case3c
  59 !   11-jan-05 raz - major updates to many subroutines
  60 !   18-nov-04 rce - make sure that acos argument is between +/-1.0
  61 !   28-jan-04 rce - added subr aerchem_boxtest_output;
  62 !       eliminated some unnecessary 'include v33com-'
  63 !   01-dec-03 rce - added 'implicit none' to many routines;
  64 !       eliminated some unnecessary 'include v33com-'
  65 !   05-oct-03 raz - added hysteresis treatment
  66 !   02-sep-03 raz - implemented asteem
  67 !   10-jul-03 raz - changed ix to ixd in interp. subrs fast*_up and fast*_lo
  68 !   08-jul-03 raz - implemented asteem (adaptive step time-split
  69 !                   explicit euler method)
  70 !   26-jun-03 raz - updated almost all the subrs. this version contains
  71 !       options for rigorous and fast solvers (including lsode solver)
  72 !
  73 !   07-oct-02 raz - made zx and zm integers in activity coeff subs.
  74 !   16-sep-02 raz - updated many subrs to treat calcium salts
  75 !   19-aug-02 raz - inlcude v33com9a in subr aerosolmtc
  76 !   14-aug-02 rce - '(msectional.eq.0)' changed to '(msectional.le.0)'
  77 !   07-aug-02 rce - this is rahul's latest version from freshair
  78 !       after adding 'real mean_molecular_speed' wherever it is used
  79 !   01-apr-02 raz - made final tests and gave the code to jerome
  80 !
  81 !   04--14-dec-01 rce - several minor changes during initial testing/debug
  82 !       in 3d los angeles simulation
  83 !       (see earlier versions for details about these changes)
  84 !-----------------------------------------------------------------------
  85 !23456789012345678901234567890123456789012345678901234567890123456789012
  86
  87 !***********************************************************************
  88 ! interface to mosaic
  89 !
  90 ! author: rahul a. zaveri
  91 ! update: jan 2005
  92 !-----------------------------------------------------------------------
  93       subroutine aerchemistry( iclm, jclm, kclm_calcbgn, kclm_calcend,    &
  94                                dtchem_sngl, idiagaa,vbs_nbin,             &
  95                                ph_aer1, ph_aer2, ph_aer3, ph_aer4,kms,kme )
  96
  97       use module_data_mosaic_asect
  98       use module_data_mosaic_other
  99       use module_mosaic_movesect, only:  move_sections
 100
 101 !     implicit none
 102 !     include 'v33com'
 103 !     include 'v33com2'
 104 !     include 'v33com3'
 105 !     include 'mosaic.h'
 106 !   subr arguments
 107       integer iclm, jclm, kclm_calcbgn, kclm_calcend, idiagaa,vbs_nbin(1)
 108       real dtchem_sngl
 109       integer kms, kme
 110       real, intent(out), dimension(kms:kme) ::                       &
 111             ph_aer1, ph_aer2, ph_aer3, ph_aer4       ! pH of the aerosols
 112 !   local variables
 113       real(kind=8) :: dtchem
 114       integer k, m
 115
 116
 117
 118       dtchem = dtchem_sngl
 119
 120       lunerr_aer = lunerr
 121       ncorecnt_aer = ncorecnt
 122
 123 !   special output for solver testing
 124       call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
 125
 126       iclm_aer = iclm
 127       jclm_aer = jclm
 128       kclm_aer_calcbgn = kclm_calcbgn
 129       kclm_aer_calcend = kclm_calcend
 130
 131
 132       do 200 m = 1, nsubareas
 133         mclm_aer = m
 134
 135         do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
 136           kclm_aer = k
 137           if (afracsubarea(k,m) .lt. 1.e-4) goto 100
 138
 139           istat_mosaic_fe1 = 1
 140
 141           call mosaic( k, m, dtchem,vbs_nbin)
 142
 143           if (istat_mosaic_fe1 .lt. 0) then
 144              nfe1_mosaic_cur = nfe1_mosaic_cur + 1
 145              nfe1_mosaic_tot = nfe1_mosaic_tot + 1
 146              if (iprint_mosaic_fe1 .gt. 0) then
 147                 write(6,*) 'mosaic aerchemistry fatal error - i/j/k/m =',   &
 148                    iclm_aer, jclm_aer, kclm_aer, mclm_aer
 149                 call print_input
 150                 if (iprint_mosaic_fe1 .ge. 10)   &
 151                    call mosaic_aerchem_error_dump( 0, 0, lunerr_aer,   &
 152                       'aerchemistry fatal error' )
 153              end if
 154              goto 100
 155           end if
 156
 157           call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
 158           call move_sections( 1, iclm, jclm, k, m)
 159           call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
 160
 161           ph_aer1(k) = mc(1,1)
 162           ph_aer2(k) = mc(1,2)
 163           ph_aer3(k) = mc(1,3)
 164           ph_aer4(k) = mc(1,4)
 165
 166 100     continue        ! k levels
 167
 168 200   continue          ! subareas
 169
 170
 171 !   special output for solver testing
 172       call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
 173
 174       return
 175       end subroutine aerchemistry
 176
 177
 178
 179
 180
 181
 182
 183
 184
 185
 186 !***********************************************************************
 187 ! mosaic (model for simulating aerosol interactions and chemistry)
 188 !
 189 ! author: rahul a. zaveri
 190 ! update: dec 2004
 191 !-----------------------------------------------------------------------
 192       subroutine mosaic(k, m, dtchem,vbs_nbin)
 193
 194       use module_data_mosaic_asect
 195       use module_data_mosaic_other
 196
 197 !     implicit none
 198 !     include 'v33com'
 199 !     include 'v33com3'
 200 !     include 'mosaic.h'
 201 !   subr arguments
 202       integer k, m,vbs_nbin(1)
 203       real(kind=8) dtchem
 204 !   local variables
 205       real(kind=8) yh2o, dumdum
 206       integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
 207 !     data iclm_debug /28/
 208 !     data jclm_debug /1/
 209 !     data kclm_debug /9/
 210 !     data ncnt_debug /6/
 211       iclm_debug=-28; jclm_debug=1; kclm_debug=9; ncnt_debug=6
 212
 213
 214
 215       if(iclm_aer .eq. iclm_debug .and.   &
 216          jclm_aer .eq. jclm_debug .and.   &
 217          kclm_aer .eq. kclm_debug  .and.   &
 218          ncorecnt_aer .eq. ncnt_debug)then
 219         dumdum = 0.0
 220       endif
 221
 222
 223 ! overwrite inputs
 224          if(1.eq.0)then
 225            call hijack_input(k,m)
 226          endif
 227
 228
 229           t_k = rsub(ktemp,k,m)                 ! update temperature  = k
 230           p_atm = ptotclm(k) /1.032d6           ! update pressure = atm
 231           yh2o = rsub(kh2o,k,m)                 ! mol(h2o)/mol(air)
 232           rh_pc = 100.*relhumclm(k)             ! rh (%)
 233           ah2o = relhumclm(k)                   ! fractional rh
 234
 235
 236           call load_mosaic_parameters           ! sets up indices and other stuff once per simulation
 237
 238           call initialize_mosaic_variables
 239
 240           call update_thermodynamic_constants(vbs_nbin) ! update t and rh dependent constants
 241
 242           call map_mosaic_species(k, m, 0)
 243
 244
 245           call overall_massbal_in ! save input mass over all bins
 246           iprint_input = myes     ! reset to default
 247
 248
 249           call mosaic_dynamic_solver( dtchem,vbs_nbin )
 250           if (istat_mosaic_fe1 .lt. 0) return
 251
 252
 253           call overall_massbal_out(0) ! check mass balance after integration
 254
 255           call map_mosaic_species(k, m, 1)
 256
 257 !      write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
 258
 259       return
 260       end subroutine mosaic
 261
 262
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273 !***********************************************************************
 274 ! interface to asceem and asteem dynamic gas-particle exchange solvers
 275 !
 276 ! author: rahul a. zaveri
 277 ! update: jan 2005
 278 !-----------------------------------------------------------------------
 279       subroutine mosaic_dynamic_solver( dtchem,vbs_nbin )
 280 !     implicit none
 281 !     include 'v33com'
 282 !     include 'mosaic.h'
 283 ! subr arguments
 284       real(kind=8) dtchem
 285 ! local variables
 286       integer ibin, iv, k, m,vbs_nbin(1)
 287       real(kind=8) xt, dumdum
 288 !     real(kind=8) aerosol_water_up                             ! mosaic func
 289
 290
 291 !      if(iclm_aer .eq. 21 .and.   &
 292 !         jclm_aer .eq. 17 .and.   &
 293 !         kclm_aer .eq. 3  .and.   &
 294 !         ncorecnt_aer .eq. 4)then
 295 !        dumdum = 0.0
 296 !      endif
 297
 298
 299       do 500 ibin = 1, nbin_a
 300
 301         call check_aerosol_mass(ibin)
 302         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
 303
 304         call conform_electrolytes(jtotal,ibin,xt)       ! conforms aer(jtotal) to a valid aerosol
 305
 306         call check_aerosol_mass(ibin)                   ! check mass again after conform_electrolytes
 307         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
 308
 309         call conform_aerosol_number(ibin)               ! adjusts number conc so that it conforms with bin mass and diameter
 310
 311 500   continue
 312
 313
 314
 315 ! box
 316 !        call initial_aer_print_box     ! box
 317
 318       call save_pregrow_props
 319
 320       call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77,   &
 321                 'after_conform' )
 322 !
 323 !-------------------------------------
 324 ! do dynamic gas-aerosol mass transfer
 325
 326       if(mgas_aer_xfer .eq. mon)then
 327
 328         call astem(dtchem,vbs_nbin)
 329
 330       endif
 331
 332 !-------------------------------------
 333 ! box
 334 ! grows or shrinks size depending on mass increase or decrease
 335 !
 336 !      do ibin = 1, nbin_a
 337 !        if(jaerosolstate(ibin) .ne. no_aerosol)then
 338 !          call conform_particle_size(ibin)     ! box
 339 !        endif
 340 !      enddo
 341
 342
 343
 344       do 600 ibin = 1, nbin_a
 345         if(jaerosolstate(ibin).eq.no_aerosol) goto 600
 346
 347         if(jhyst_leg(ibin) .eq. jhyst_lo)then
 348           water_a_hyst(ibin) = 0.0
 349         elseif(jhyst_leg(ibin) .eq. jhyst_up)then
 350           water_a_up(ibin)   = aerosol_water_up(ibin)   ! at 60% rh
 351           water_a_hyst(ibin) = water_a_up(ibin)
 352         endif
 353
 354         call calc_dry_n_wet_aerosol_props(ibin)         ! compute final mass and density
 355 600   continue
 356
 357       return
 358       end subroutine mosaic_dynamic_solver
 359
 360
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373       subroutine hijack_input(k, m)
 374
 375       use module_data_mosaic_asect
 376       use module_data_mosaic_other
 377
 378 !     implicit none
 379 !     include 'v33com'
 380 !     include 'v33com3'
 381 !     include 'v33com9a'
 382 !     include 'v33com9b'
 383 !     include 'mosaic.h'
 384 ! subr arguments
 385       integer k, m
 386 ! local variables
 387       integer ibin, igas, iphase, isize, itype
 388       real(kind=8) t_kdum, p_atmdum, rhdum, cairclmdum
 389       real(kind=8) gasdum(4), aerdum(14,8)
 390
 391
 392
 393
 394 ! read inputs----------------
 395       open(92, file = 'box.txt')
 396
 397       read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
 398 !      do igas = 1, 4
 399         read(92,*)gasdum(1),gasdum(2),gasdum(3),gasdum(4)
 400 !      enddo
 401
 402       do ibin = 1, nbin_a
 403         read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin),   &
 404                   aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin),   &
 405                   aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin),   &
 406                   aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin),   &
 407                   aerdum(13,ibin),aerdum(14,ibin)
 408       enddo
 409
 410       close(92)
 411 !----------------------------
 412
 413
 414
 415       rsub(ktemp,k,m) = t_kdum                  ! update temperature  = k
 416       ptotclm(k)      = p_atmdum*1.032d6! update pressure = atm
 417       relhumclm(k)    = rhdum/100.0             ! fractional rh
 418       cairclm(k)      = cairclmdum              ! mol/cc
 419
 420
 421 ! 3-d
 422 ! calculate air conc in mol/m^3
 423       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 424       cair_mol_cc = cairclm(k)
 425
 426 ! 3-d
 427 ! define conversion factors
 428       conv1a = cair_mol_m3*1.e9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 429       conv1b = 1./conv1a                ! converts nq/m^3 to q/mol(air)
 430       conv2a = cair_mol_m3*18.*1.e-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 431       conv2b = 1./conv2a                ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 432
 433
 434 ! read rsub (mol/mol(air))
 435 ! gas
 436         rsub(kh2so4,k,m) = gasdum(1)
 437         rsub(khno3,k,m)  = gasdum(2)
 438         rsub(khcl,k,m)   = gasdum(3)
 439         rsub(knh3,k,m)   = gasdum(4)
 440
 441
 442 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
 443         iphase = ai_phase
 444         ibin = 0
 445         do 10 itype = 1, ntype_aer
 446         do 10 isize = 1, nsize_aer(itype)
 447         ibin = ibin + 1
 448
 449         rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
 450         rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
 451         rsub(lptr_cl_aer(isize,itype,iphase),k,m)  = aerdum(3,ibin)
 452         rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
 453         rsub(lptr_oc_aer(isize,itype,iphase),k,m)  = aerdum(5,ibin)
 454         rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
 455         rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
 456         rsub(lptr_bc_aer(isize,itype,iphase),k,m)  = aerdum(8,ibin)
 457         rsub(lptr_na_aer(isize,itype,iphase),k,m)  = aerdum(9,ibin)
 458         rsub(lptr_ca_aer(isize,itype,iphase),k,m)  = aerdum(10,ibin)
 459         rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
 460
 461         rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
 462         rsub(waterptr_aer(isize,itype),k,m)       = aerdum(13,ibin)     ! kg/m^3(air)
 463         rsub(numptr_aer(isize,itype,iphase),k,m)          = aerdum(14,ibin)     ! num_a is in #/cc
 464 10    continue
 465
 466       return
 467       end subroutine hijack_input
 468
 469
 470
 471
 472
 473 !***********************************************************************
 474 ! intializes all the mosaic variables to zero or their default values.
 475 !
 476 ! author: rahul a. zaveri
 477 ! update: jun 2003
 478 !-----------------------------------------------------------------------
 479       subroutine initialize_mosaic_variables
 480 !     implicit none
 481 !     include 'mosaic.h'
 482 ! local variables
 483       integer iaer, ibin, iv, ja, jc, je
 484
 485
 486
 487       do iv = 1, ngas_ioa
 488           gas(iv)           = 0.0
 489       enddo
 490
 491 ! initialize to zero
 492       do ibin = 1, nbin_a
 493
 494         num_a(ibin)          = 0.0
 495         mass_dry_a(ibin)     = 0.0
 496         mass_soluble_a(ibin) = 0.0
 497
 498         do iaer = 1, naer
 499           aer(iaer,jtotal,ibin)  = 0.0
 500           aer(iaer,jsolid,ibin)  = 0.0
 501           aer(iaer,jliquid,ibin) = 0.0
 502         enddo
 503
 504         do je = 1, nelectrolyte
 505           electrolyte(je,jtotal,ibin)  = 0.0
 506           electrolyte(je,jsolid,ibin)  = 0.0
 507           electrolyte(je,jliquid,ibin) = 0.0
 508           epercent(je,jtotal,ibin)     = 0.0    ! raz update 11/13/2008
 509           epercent(je,jsolid,ibin)     = 0.0    ! raz update 11/13/2008
 510           epercent(je,jliquid,ibin)    = 0.0    ! raz update 11/13/2008
 511           activity(je,ibin)            = 0.0
 512           gam(je,ibin)                 = 0.0
 513         enddo
 514
 515           gam_ratio(ibin)   = 0.0
 516
 517         do iv = 1, ngas_ioa
 518           flux_s(iv,ibin)   = 0.0
 519           flux_l(iv,ibin)   = 0.0
 520           kg(iv,ibin)       = 0.0
 521 !          fraceq(iv,ibin)   =0.0
 522           phi_volatile_s(iv,ibin) = 0.0
 523           phi_volatile_l(iv,ibin) = 0.0
 524           df_gas_s(iv,ibin)   = 0.0
 525           df_gas_l(iv,ibin)   = 0.0
 526           volatile_s(iv,ibin) = 0.0
 527         enddo
 528
 529
 530         jaerosolstate(ibin) = -1        ! initialize to default value
 531         jphase(ibin) = 0
 532
 533         do jc = 1, ncation
 534           mc(jc,ibin) = 0.0
 535         enddo
 536
 537         do ja = 1, nanion
 538           ma(ja,ibin) = 0.0
 539         enddo
 540
 541       enddo     ! ibin
 542
 543
 544       return
 545       end subroutine initialize_mosaic_variables
 546
 547
 548
 549
 550
 551
 552 !***********************************************************************
 553 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
 554 !
 555 ! author: rahul a. zaveri
 556 ! update: nov 2001
 557 !-------------------------------------------------------------------------
 558       subroutine map_mosaic_species(k, m, imap)
 559
 560       use module_data_mosaic_asect
 561       use module_data_mosaic_other
 562       use module_state_description, only:  param_first_scalar
 563
 564 !     implicit none
 565
 566 !     include 'v33com'
 567 !     include 'v33com3'
 568 !     include 'v33com9a'
 569 !     include 'v33com9b'
 570
 571 ! subr arguments
 572       integer k, m, imap
 573 ! local variables
 574       integer ibin, iphase, isize, itsi, itype, l, p1st
 575
 576
 577 ! if a species index is less than this value, then the species is not defined
 578       p1st = param_first_scalar
 579
 580 ! 3-d
 581 ! calculate air conc in mol/m^3
 582       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 583       cair_mol_cc = cairclm(k)
 584
 585 ! 3-d
 586 ! define conversion factors
 587       conv1a = cair_mol_m3*1.d9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 588       conv1b = 1.d0/conv1a              ! converts nq/m^3 to q/mol(air)
 589       conv2a = cair_mol_m3*18.*1.d-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 590       conv2b = 1.d0/conv2a              ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 591
 592
 593 ! box
 594 !      conv1 = 1.d15/avogad     ! converts (molec/cc) to (nmol/m^3)
 595 !      conv2 = 1.d0/conv1         ! converts (nmol/m^3) to (molec/cc)
 596 !      kaerstart = ngas_max
 597
 598
 599       if(imap.eq.0)then    ! map rsub (mol/mol(air)) into aer (nmol/m^3)
 600 ! gas
 601         if (kh2so4 .ge. p1st) then
 602             gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a     ! nmol/m^3
 603         else
 604             gas(ih2so4_g) = 0.0
 605         end if
 606         if (khno3 .ge. p1st) then
 607             gas(ihno3_g)  = rsub(khno3,k,m)*conv1a
 608         else
 609             gas(ihno3_g) = 0.0
 610         end if
 611         if (khcl .ge. p1st) then
 612             gas(ihcl_g)   = rsub(khcl,k,m)*conv1a
 613         else
 614             gas(ihcl_g) = 0.0
 615         end if
 616         if (knh3 .ge. p1st) then
 617             gas(inh3_g)   = rsub(knh3,k,m)*conv1a
 618         else
 619             gas(inh3_g) = 0.0
 620         end if
 621         if (kn2o5 .ge. p1st) then
 622             gas(in2o5_g)   = rsub(kn2o5,k,m)*conv1a
 623         else
 624             gas(in2o5_g) = 0.0
 625         end if
 626         if (kclno2 .ge. p1st) then
 627             gas(iclno2_g)   = rsub(kclno2,k,m)*conv1a
 628         else
 629             gas(iclno2_g) = 0.0
 630         end if
 631
 632 ! soa gas-phase species -- currently deactivated
 633         if (kpcg1_b_c .ge. p1st) then
 634             gas(ipcg1_b_c_g)   = rsub(kpcg1_b_c,k,m)*conv1a
 635         else
 636         gas(ipcg1_b_c_g) = 0.0
 637         end if
 638         if (kpcg2_b_c .ge. p1st) then
 639             gas(ipcg2_b_c_g)   = rsub(kpcg2_b_c,k,m)*conv1a
 640         else
 641         gas(ipcg2_b_c_g) = 0.0
 642         end if
 643         if (kpcg3_b_c .ge. p1st) then
 644             gas(ipcg3_b_c_g)   = rsub(kpcg3_b_c,k,m)*conv1a
 645         else
 646         gas(ipcg3_b_c_g) = 0.0
 647         end if
 648         if (kpcg4_b_c .ge. p1st) then
 649             gas(ipcg4_b_c_g)   = rsub(kpcg4_b_c,k,m)*conv1a
 650         else
 651         gas(ipcg4_b_c_g) = 0.0
 652         end if
 653         if (kpcg5_b_c .ge. p1st) then
 654             gas(ipcg5_b_c_g)   = rsub(kpcg5_b_c,k,m)*conv1a
 655         else
 656         gas(ipcg5_b_c_g) = 0.0
 657         end if
 658         if (kpcg6_b_c .ge. p1st) then
 659             gas(ipcg6_b_c_g)   = rsub(kpcg6_b_c,k,m)*conv1a
 660         else
 661         gas(ipcg6_b_c_g) = 0.0
 662         end if
 663         if (kpcg7_b_c .ge. p1st) then
 664             gas(ipcg7_b_c_g)   = rsub(kpcg7_b_c,k,m)*conv1a
 665         else
 666         gas(ipcg7_b_c_g) = 0.0
 667         end if
 668         if (kpcg8_b_c .ge. p1st) then
 669             gas(ipcg8_b_c_g)   = rsub(kpcg8_b_c,k,m)*conv1a
 670         else
 671         gas(ipcg8_b_c_g) = 0.0
 672         end if
 673         if (kpcg9_b_c .ge. p1st) then
 674             gas(ipcg9_b_c_g)   = rsub(kpcg9_b_c,k,m)*conv1a
 675         else
 676         gas(ipcg9_b_c_g) = 0.0
 677         end if
 678         if (kpcg1_b_o .ge. p1st) then
 679             gas(ipcg1_b_o_g)   = rsub(kpcg1_b_o,k,m)*conv1a
 680         else
 681         gas(ipcg1_b_o_g) = 0.0
 682         end if
 683         if (kpcg2_b_o .ge. p1st) then
 684             gas(ipcg2_b_o_g)   = rsub(kpcg2_b_o,k,m)*conv1a
 685         else
 686         gas(ipcg2_b_o_g) = 0.0
 687         end if
 688         if (kpcg3_b_o .ge. p1st) then
 689             gas(ipcg3_b_o_g)   = rsub(kpcg3_b_o,k,m)*conv1a
 690         else
 691         gas(ipcg3_b_o_g) = 0.0
 692         end if
 693         if (kpcg4_b_o .ge. p1st) then
 694             gas(ipcg4_b_o_g)   = rsub(kpcg4_b_o,k,m)*conv1a
 695         else
 696         gas(ipcg4_b_o_g) = 0.0
 697         end if
 698         if (kpcg5_b_o .ge. p1st) then
 699             gas(ipcg5_b_o_g)   = rsub(kpcg5_b_o,k,m)*conv1a
 700         else
 701         gas(ipcg5_b_o_g) = 0.0
 702         end if
 703         if (kpcg6_b_o .ge. p1st) then
 704             gas(ipcg6_b_o_g)   = rsub(kpcg6_b_o,k,m)*conv1a
 705         else
 706         gas(ipcg6_b_o_g) = 0.0
 707         end if
 708         if (kpcg7_b_o .ge. p1st) then
 709             gas(ipcg7_b_o_g)   = rsub(kpcg7_b_o,k,m)*conv1a
 710         else
 711         gas(ipcg7_b_o_g) = 0.0
 712         end if
 713         if (kpcg8_b_o .ge. p1st) then
 714             gas(ipcg8_b_o_g)   = rsub(kpcg8_b_o,k,m)*conv1a
 715         else
 716         gas(ipcg8_b_o_g) = 0.0
 717         end if
 718         if (kpcg9_b_o .ge. p1st) then
 719             gas(ipcg9_b_o_g)   = rsub(kpcg9_b_o,k,m)*conv1a
 720         else
 721         gas(ipcg9_b_o_g) = 0.0
 722         end if
 723         if (kopcg1_b_c .ge. p1st) then
 724             gas(iopcg1_b_c_g)   = rsub(kopcg1_b_c,k,m)*conv1a
 725         else
 726         gas(iopcg1_b_c_g) = 0.0
 727         end if
 728         if (kopcg2_b_c .ge. p1st) then
 729             gas(iopcg2_b_c_g)   = rsub(kopcg2_b_c,k,m)*conv1a
 730         else
 731         gas(iopcg2_b_c_g) = 0.0
 732         end if
 733         if (kopcg3_b_c .ge. p1st) then
 734             gas(iopcg3_b_c_g)   = rsub(kopcg3_b_c,k,m)*conv1a
 735         else
 736         gas(iopcg3_b_c_g) = 0.0
 737         end if
 738         if (kopcg4_b_c .ge. p1st) then
 739             gas(iopcg4_b_c_g)   = rsub(kopcg4_b_c,k,m)*conv1a
 740         else
 741         gas(iopcg4_b_c_g) = 0.0
 742         end if
 743         if (kopcg5_b_c .ge. p1st) then
 744             gas(iopcg5_b_c_g)   = rsub(kopcg5_b_c,k,m)*conv1a
 745         else
 746         gas(iopcg5_b_c_g) = 0.0
 747         end if
 748         if (kopcg6_b_c .ge. p1st) then
 749             gas(iopcg6_b_c_g)   = rsub(kopcg6_b_c,k,m)*conv1a
 750         else
 751         gas(iopcg6_b_c_g) = 0.0
 752         end if
 753         if (kopcg7_b_c .ge. p1st) then
 754             gas(iopcg7_b_c_g)   = rsub(kopcg7_b_c,k,m)*conv1a
 755         else
 756         gas(iopcg7_b_c_g) = 0.0
 757         end if
 758         if (kopcg8_b_c .ge. p1st) then
 759             gas(iopcg8_b_c_g)   = rsub(kopcg8_b_c,k,m)*conv1a
 760         else
 761         gas(iopcg8_b_c_g) = 0.0
 762         end if
 763         if (kopcg1_b_o .ge. p1st) then
 764             gas(iopcg1_b_o_g)   = rsub(kopcg1_b_o,k,m)*conv1a
 765         else
 766         gas(iopcg1_b_o_g) = 0.0
 767         end if
 768         if (kopcg2_b_o .ge. p1st) then
 769             gas(iopcg2_b_o_g)   = rsub(kopcg2_b_o,k,m)*conv1a
 770         else
 771         gas(iopcg2_b_o_g) = 0.0
 772         end if
 773         if (kopcg3_b_o .ge. p1st) then
 774             gas(iopcg3_b_o_g)   = rsub(kopcg3_b_o,k,m)*conv1a
 775         else
 776         gas(iopcg3_b_o_g) = 0.0
 777         end if
 778         if (kopcg4_b_o .ge. p1st) then
 779             gas(iopcg4_b_o_g)   = rsub(kopcg4_b_o,k,m)*conv1a
 780         else
 781         gas(iopcg4_b_o_g) = 0.0
 782         end if
 783         if (kopcg5_b_o .ge. p1st) then
 784             gas(iopcg5_b_o_g)   = rsub(kopcg5_b_o,k,m)*conv1a
 785         else
 786         gas(iopcg5_b_o_g) = 0.0
 787         end if
 788         if (kopcg6_b_o .ge. p1st) then
 789             gas(iopcg6_b_o_g)   = rsub(kopcg6_b_o,k,m)*conv1a
 790         else
 791         gas(iopcg6_b_o_g) = 0.0
 792         end if
 793         if (kopcg7_b_o .ge. p1st) then
 794             gas(iopcg7_b_o_g)   = rsub(kopcg7_b_o,k,m)*conv1a
 795         else
 796         gas(iopcg7_b_o_g) = 0.0
 797         end if
 798         if (kopcg8_b_o .ge. p1st) then
 799             gas(iopcg8_b_o_g)   = rsub(kopcg8_b_o,k,m)*conv1a
 800         else
 801         gas(iopcg8_b_o_g) = 0.0
 802         end if
 803         if (kpcg1_f_c .ge. p1st) then
 804             gas(ipcg1_f_c_g)   = rsub(kpcg1_f_c,k,m)*conv1a
 805         else
 806         gas(ipcg1_f_c_g) = 0.0
 807         end if
 808         if (kpcg2_f_c .ge. p1st) then
 809             gas(ipcg2_f_c_g)   = rsub(kpcg2_f_c,k,m)*conv1a
 810         else
 811         gas(ipcg2_f_c_g) = 0.0
 812         end if
 813         if (kpcg3_f_c .ge. p1st) then
 814             gas(ipcg3_f_c_g)   = rsub(kpcg3_f_c,k,m)*conv1a
 815         else
 816         gas(ipcg3_f_c_g) = 0.0
 817         end if
 818         if (kpcg4_f_c .ge. p1st) then
 819             gas(ipcg4_f_c_g)   = rsub(kpcg4_f_c,k,m)*conv1a
 820         else
 821         gas(ipcg4_f_c_g) = 0.0
 822         end if
 823         if (kpcg5_f_c .ge. p1st) then
 824             gas(ipcg5_f_c_g)   = rsub(kpcg5_f_c,k,m)*conv1a
 825         else
 826         gas(ipcg5_f_c_g) = 0.0
 827         end if
 828         if (kpcg6_f_c .ge. p1st) then
 829             gas(ipcg6_f_c_g)   = rsub(kpcg6_f_c,k,m)*conv1a
 830         else
 831         gas(ipcg6_f_c_g) = 0.0
 832         end if
 833         if (kpcg7_f_c .ge. p1st) then
 834             gas(ipcg7_f_c_g)   = rsub(kpcg7_f_c,k,m)*conv1a
 835         else
 836         gas(ipcg7_f_c_g) = 0.0
 837         end if
 838         if (kpcg8_f_c .ge. p1st) then
 839             gas(ipcg8_f_c_g)   = rsub(kpcg8_f_c,k,m)*conv1a
 840         else
 841         gas(ipcg8_f_c_g) = 0.0
 842         end if
 843         if (kpcg9_f_c .ge. p1st) then
 844             gas(ipcg9_f_c_g)   = rsub(kpcg9_f_c,k,m)*conv1a
 845         else
 846         gas(ipcg9_f_c_g) = 0.0
 847         end if
 848         if (kpcg1_f_o .ge. p1st) then
 849             gas(ipcg1_f_o_g)   = rsub(kpcg1_f_o,k,m)*conv1a
 850         else
 851         gas(ipcg1_f_o_g) = 0.0
 852         end if
 853         if (kpcg2_f_o .ge. p1st) then
 854             gas(ipcg2_f_o_g)   = rsub(kpcg2_f_o,k,m)*conv1a
 855         else
 856         gas(ipcg2_f_o_g) = 0.0
 857         end if
 858         if (kpcg3_f_o .ge. p1st) then
 859             gas(ipcg3_f_o_g)   = rsub(kpcg3_f_o,k,m)*conv1a
 860         else
 861         gas(ipcg3_f_o_g) = 0.0
 862         end if
 863         if (kpcg4_f_o .ge. p1st) then
 864             gas(ipcg4_f_o_g)   = rsub(kpcg4_f_o,k,m)*conv1a
 865         else
 866         gas(ipcg4_f_o_g) = 0.0
 867         end if
 868         if (kpcg5_f_o .ge. p1st) then
 869             gas(ipcg5_f_o_g)   = rsub(kpcg5_f_o,k,m)*conv1a
 870         else
 871         gas(ipcg5_f_o_g) = 0.0
 872         end if
 873         if (kpcg6_f_o .ge. p1st) then
 874             gas(ipcg6_f_o_g)   = rsub(kpcg6_f_o,k,m)*conv1a
 875         else
 876         gas(ipcg6_f_o_g) = 0.0
 877         end if
 878         if (kpcg7_f_o .ge. p1st) then
 879             gas(ipcg7_f_o_g)   = rsub(kpcg7_f_o,k,m)*conv1a
 880         else
 881         gas(ipcg7_f_o_g) = 0.0
 882         end if
 883         if (kpcg8_f_o .ge. p1st) then
 884             gas(ipcg8_f_o_g)   = rsub(kpcg8_f_o,k,m)*conv1a
 885         else
 886         gas(ipcg8_f_o_g) = 0.0
 887         end if
 888         if (kpcg9_f_o .ge. p1st) then
 889             gas(ipcg9_f_o_g)   = rsub(kpcg9_f_o,k,m)*conv1a
 890         else
 891         gas(ipcg9_f_o_g) = 0.0
 892         end if
 893         if (kopcg1_f_c .ge. p1st) then
 894             gas(iopcg1_f_c_g)   = rsub(kopcg1_f_c,k,m)*conv1a
 895         else
 896         gas(iopcg1_f_c_g) = 0.0
 897         end if
 898         if (kopcg2_f_c .ge. p1st) then
 899             gas(iopcg2_f_c_g)   = rsub(kopcg2_f_c,k,m)*conv1a
 900         else
 901         gas(iopcg2_f_c_g) = 0.0
 902         end if
 903         if (kopcg3_f_c .ge. p1st) then
 904             gas(iopcg3_f_c_g)   = rsub(kopcg3_f_c,k,m)*conv1a
 905         else
 906         gas(iopcg3_f_c_g) = 0.0
 907         end if
 908         if (kopcg4_f_c .ge. p1st) then
 909             gas(iopcg4_f_c_g)   = rsub(kopcg4_f_c,k,m)*conv1a
 910         else
 911         gas(iopcg4_f_c_g) = 0.0
 912         end if
 913         if (kopcg5_f_c .ge. p1st) then
 914             gas(iopcg5_f_c_g)   = rsub(kopcg5_f_c,k,m)*conv1a
 915         else
 916         gas(iopcg5_f_c_g) = 0.0
 917         end if
 918         if (kopcg6_f_c .ge. p1st) then
 919             gas(iopcg6_f_c_g)   = rsub(kopcg6_f_c,k,m)*conv1a
 920         else
 921         gas(iopcg6_f_c_g) = 0.0
 922         end if
 923         if (kopcg7_f_c .ge. p1st) then
 924             gas(iopcg7_f_c_g)   = rsub(kopcg7_f_c,k,m)*conv1a
 925         else
 926         gas(iopcg7_f_c_g) = 0.0
 927         end if
 928         if (kopcg8_f_c .ge. p1st) then
 929             gas(iopcg8_f_c_g)   = rsub(kopcg8_f_c,k,m)*conv1a
 930         else
 931         gas(iopcg8_f_c_g) = 0.0
 932         end if
 933         if (kopcg1_f_o .ge. p1st) then
 934             gas(iopcg1_f_o_g)   = rsub(kopcg1_f_o,k,m)*conv1a
 935         else
 936         gas(iopcg1_f_o_g) = 0.0
 937         end if
 938         if (kopcg2_f_o .ge. p1st) then
 939             gas(iopcg2_f_o_g)   = rsub(kopcg2_f_o,k,m)*conv1a
 940         else
 941         gas(iopcg2_f_o_g) = 0.0
 942         end if
 943         if (kopcg3_f_o .ge. p1st) then
 944             gas(iopcg3_f_o_g)   = rsub(kopcg3_f_o,k,m)*conv1a
 945         else
 946         gas(iopcg3_f_o_g) = 0.0
 947         end if
 948         if (kopcg4_f_o .ge. p1st) then
 949             gas(iopcg4_f_o_g)   = rsub(kopcg4_f_o,k,m)*conv1a
 950         else
 951         gas(iopcg4_f_o_g) = 0.0
 952         end if
 953         if (kopcg5_f_o .ge. p1st) then
 954             gas(iopcg5_f_o_g)   = rsub(kopcg5_f_o,k,m)*conv1a
 955         else
 956         gas(iopcg5_f_o_g) = 0.0
 957         end if
 958         if (kopcg6_f_o .ge. p1st) then
 959             gas(iopcg6_f_o_g)   = rsub(kopcg6_f_o,k,m)*conv1a
 960         else
 961         gas(iopcg6_f_o_g) = 0.0
 962         end if
 963         if (kopcg7_f_o .ge. p1st) then
 964             gas(iopcg7_f_o_g)   = rsub(kopcg7_f_o,k,m)*conv1a
 965         else
 966         gas(iopcg7_f_o_g) = 0.0
 967         end if
 968         if (kopcg8_f_o .ge. p1st) then
 969             gas(iopcg8_f_o_g)   = rsub(kopcg8_f_o,k,m)*conv1a
 970         else
 971         gas(iopcg8_f_o_g) = 0.0
 972         end if
 973
 974        if (ksmpa .ge. p1st) then
 975             gas(ismpa_g)   = rsub(ksmpa,k,m)*conv1a
 976         else
 977         gas(ismpa_g) = 0.0
 978         end if
 979         if (ksmpbb .ge. p1st) then
 980             gas(ismpbb_g)   = rsub(ksmpbb,k,m)*conv1a
 981         else
 982         gas(ismpbb_g) = 0.0
 983         end if
 984        if (kgly .ge. p1st) then
 985             gas(igly)   = rsub(kgly,k,m)*conv1a
 986         else
 987         gas(igly) = 0.0
 988         end if
 989         if (koh .ge. p1st) then
 990             gas(iho)   = rsub(koh,k,m)*conv1a
 991         else
 992         gas(koh) = 0.0
 993         end if
 994
 995
 996         if (kant1_c .ge. p1st) then
 997             gas(iant1_c_g)   = rsub(kant1_c,k,m)*conv1a
 998         else
 999         gas(iant1_c_g) = 0.0
1000         end if
1001         if (kant2_c .ge. p1st) then
1002             gas(iant2_c_g)   = rsub(kant2_c,k,m)*conv1a
1003         else
1004         gas(iant2_c_g) = 0.0
1005         end if
1006         if (kant3_c .ge. p1st) then
1007             gas(iant3_c_g)   = rsub(kant3_c,k,m)*conv1a
1008         else
1009         gas(iant3_c_g) = 0.0
1010         end if
1011         if (kant4_c .ge. p1st) then
1012             gas(iant4_c_g)   = rsub(kant4_c,k,m)*conv1a
1013         else
1014         gas(iant4_c_g) = 0.0
1015         end if
1016
1017         if (kant1_o .ge. p1st) then
1018             gas(iant1_o_g)   = rsub(kant1_o,k,m)*conv1a
1019         else
1020         gas(iant1_o_g) = 0.0
1021         end if
1022         if (kant2_o .ge. p1st) then
1023             gas(iant2_o_g)   = rsub(kant2_o,k,m)*conv1a
1024         else
1025         gas(iant2_o_g) = 0.0
1026         end if
1027         if (kant3_o .ge. p1st) then
1028             gas(iant3_o_g)   = rsub(kant3_o,k,m)*conv1a
1029         else
1030         gas(iant3_o_g) = 0.0
1031         end if
1032         if (kant4_o .ge. p1st) then
1033             gas(iant4_o_g)   = rsub(kant4_o,k,m)*conv1a
1034         else
1035         gas(iant4_o_g) = 0.0
1036         end if
1037
1038         if (kbiog1_c .ge. p1st) then
1039             gas(ibiog1_c_g)   = rsub(kbiog1_c,k,m)*conv1a
1040         else
1041         gas(ibiog1_c_g) = 0.0
1042         end if
1043         if (kbiog2_c .ge. p1st) then
1044             gas(ibiog2_c_g)   = rsub(kbiog2_c,k,m)*conv1a
1045         else
1046         gas(ibiog2_c_g) = 0.0
1047         end if
1048         if (kbiog3_c .ge. p1st) then
1049             gas(ibiog3_c_g)   = rsub(kbiog3_c,k,m)*conv1a
1050         else
1051         gas(ibiog3_c_g) = 0.0
1052         end if
1053         if (kbiog4_c .ge. p1st) then
1054             gas(ibiog4_c_g)   = rsub(kbiog4_c,k,m)*conv1a
1055         else
1056         gas(ibiog4_c_g) = 0.0
1057         end if
1058
1059         if (kbiog1_o .ge. p1st) then
1060             gas(ibiog1_o_g)   = rsub(kbiog1_o,k,m)*conv1a
1061         else
1062         gas(ibiog1_o_g) = 0.0
1063         end if
1064         if (kbiog2_o .ge. p1st) then
1065             gas(ibiog2_o_g)   = rsub(kbiog2_o,k,m)*conv1a
1066         else
1067         gas(ibiog2_o_g) = 0.0
1068         end if
1069         if (kbiog3_o .ge. p1st) then
1070             gas(ibiog3_o_g)   = rsub(kbiog3_o,k,m)*conv1a
1071         else
1072         gas(ibiog3_o_g) = 0.0
1073         end if
1074         if (kbiog4_o .ge. p1st) then
1075             gas(ibiog4_o_g)   = rsub(kbiog4_o,k,m)*conv1a
1076         else
1077         gas(ibiog4_o_g) = 0.0
1078         end if
1079
1080         if (kasoaX .ge. p1st) then
1081             gas(iasoaX_g)   = rsub(kasoaX,k,m)*conv1a
1082         else
1083         gas(iasoaX_g) = 0.0
1084         end if
1085
1086         if (kasoa1 .ge. p1st) then
1087             gas(iasoa1_g)   = rsub(kasoa1,k,m)*conv1a
1088         else
1089         gas(iasoa1_g) = 0.0
1090         end if
1091
1092         if (kasoa2 .ge. p1st) then
1093             gas(iasoa2_g)   = rsub(kasoa2,k,m)*conv1a
1094         else
1095         gas(iasoa2_g) = 0.0
1096         end if
1097
1098         if (kasoa3 .ge. p1st) then
1099             gas(iasoa3_g)   = rsub(kasoa3,k,m)*conv1a
1100         else
1101         gas(iasoa3_g) = 0.0
1102         end if
1103
1104         if (kasoa4 .ge. p1st) then
1105             gas(iasoa4_g)   = rsub(kasoa4,k,m)*conv1a
1106         else
1107         gas(iasoa4_g) = 0.0
1108         end if
1109
1110         if (kbsoaX .ge. p1st) then
1111             gas(ibsoaX_g)   = rsub(kbsoaX,k,m)*conv1a
1112         else
1113         gas(ibsoaX_g) = 0.0
1114         end if
1115
1116         if (kbsoa1 .ge. p1st) then
1117             gas(ibsoa1_g)   = rsub(kbsoa1,k,m)*conv1a
1118         else
1119         gas(ibsoa1_g) = 0.0
1120         end if
1121
1122         if (kbsoa2 .ge. p1st) then
1123             gas(ibsoa2_g)   = rsub(kbsoa2,k,m)*conv1a
1124         else
1125         gas(ibsoa2_g) = 0.0
1126         end if
1127
1128         if (kbsoa3 .ge. p1st) then
1129             gas(ibsoa3_g)   = rsub(kbsoa3,k,m)*conv1a
1130         else
1131         gas(ibsoa3_g) = 0.0
1132         end if
1133
1134         if (kbsoa4 .ge. p1st) then
1135             gas(ibsoa4_g)   = rsub(kbsoa4,k,m)*conv1a
1136         else
1137         gas(ibsoa4_g) = 0.0
1138         end if
1139
1140
1141
1142
1143
1144 ! aerosol
1145         iphase = ai_phase
1146         ibin = 0
1147         do 10 itype = 1, ntype_aer
1148         do 10 isize = 1, nsize_aer(itype)
1149         ibin = ibin + 1
1150
1151 ! aer array units are nmol/(m^3 air)
1152
1153 ! rce 18-nov-2004 - always map so4 and number,
1154 ! but only map other species when (lptr_xxx .ge. p1st)
1155 ! rce 11-may-2006 - so4 mapping now optional
1156         l = lptr_so4_aer(isize,itype,iphase)
1157         if (l .ge. p1st) then
1158             aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1159         else
1160             aer(iso4_a,jtotal,ibin)=0.0
1161         end if
1162
1163         l = lptr_no3_aer(isize,itype,iphase)
1164         if (l .ge. p1st) then
1165             aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1166         else
1167             aer(ino3_a,jtotal,ibin)=0.0
1168         end if
1169
1170         l = lptr_cl_aer(isize,itype,iphase)
1171         if (l .ge. p1st) then
1172             aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1173         else
1174             aer(icl_a,jtotal,ibin)=0.0
1175         end if
1176
1177         l = lptr_nh4_aer(isize,itype,iphase)
1178         if (l .ge. p1st) then
1179             aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1180         else
1181             aer(inh4_a,jtotal,ibin)=0.0
1182         end if
1183
1184         l = lptr_oc_aer(isize,itype,iphase)
1185         if (l .ge. p1st) then
1186             aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1187         else
1188             aer(ioc_a,jtotal,ibin)=0.0
1189         end if
1190
1191         l = lptr_bc_aer(isize,itype,iphase)
1192         if (l .ge. p1st) then
1193             aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1194         else
1195             aer(ibc_a,jtotal,ibin)=0.0
1196         end if
1197
1198         l = lptr_na_aer(isize,itype,iphase)
1199         if (l .ge. p1st) then
1200             aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1201         else
1202             aer(ina_a,jtotal,ibin)=0.0
1203         end if
1204
1205         l = lptr_oin_aer(isize,itype,iphase)
1206         if (l .ge. p1st) then
1207             aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1208         else
1209             aer(ioin_a,jtotal,ibin)=0.0
1210         end if
1211
1212         l = lptr_msa_aer(isize,itype,iphase)
1213         if (l .ge. p1st) then
1214             aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1215         else
1216             aer(imsa_a,jtotal,ibin)=0.0
1217         end if
1218
1219         l = lptr_co3_aer(isize,itype,iphase)
1220         if (l .ge. p1st) then
1221             aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1222         else
1223             aer(ico3_a,jtotal,ibin)=0.0
1224         end if
1225
1226         l = lptr_ca_aer(isize,itype,iphase)
1227         if (l .ge. p1st) then
1228             aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1229         else
1230             aer(ica_a,jtotal,ibin)=0.0
1231         end if
1232
1233 ! soa aerosol-phase species -- currently deactivated
1234
1235        l = lptr_pcg1_b_c_aer(isize,itype,iphase)
1236        if (l .ge. p1st) then
1237            aer(ipcg1_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1238        else
1239             aer(ipcg1_b_c_a,jtotal,ibin)=0.0
1240        end if
1241        l = lptr_pcg2_b_c_aer(isize,itype,iphase)
1242        if (l .ge. p1st) then
1243            aer(ipcg2_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1244        else
1245             aer(ipcg2_b_c_a,jtotal,ibin)=0.0
1246        end if
1247        l = lptr_pcg3_b_c_aer(isize,itype,iphase)
1248        if (l .ge. p1st) then
1249            aer(ipcg3_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1250        else
1251             aer(ipcg3_b_c_a,jtotal,ibin)=0.0
1252        end if
1253        l = lptr_pcg4_b_c_aer(isize,itype,iphase)
1254        if (l .ge. p1st) then
1255            aer(ipcg4_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1256        else
1257             aer(ipcg4_b_c_a,jtotal,ibin)=0.0
1258        end if
1259        l = lptr_pcg5_b_c_aer(isize,itype,iphase)
1260        if (l .ge. p1st) then
1261            aer(ipcg5_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1262        else
1263             aer(ipcg5_b_c_a,jtotal,ibin)=0.0
1264        end if
1265        l = lptr_pcg6_b_c_aer(isize,itype,iphase)
1266        if (l .ge. p1st) then
1267            aer(ipcg6_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1268        else
1269             aer(ipcg6_b_c_a,jtotal,ibin)=0.0
1270        end if
1271        l = lptr_pcg7_b_c_aer(isize,itype,iphase)
1272        if (l .ge. p1st) then
1273            aer(ipcg7_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1274        else
1275             aer(ipcg7_b_c_a,jtotal,ibin)=0.0
1276        end if
1277        l = lptr_pcg8_b_c_aer(isize,itype,iphase)
1278        if (l .ge. p1st) then
1279            aer(ipcg8_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1280        else
1281             aer(ipcg8_b_c_a,jtotal,ibin)=0.0
1282        end if
1283        l = lptr_pcg9_b_c_aer(isize,itype,iphase)
1284        if (l .ge. p1st) then
1285            aer(ipcg9_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1286        else
1287             aer(ipcg9_b_c_a,jtotal,ibin)=0.0
1288        end if
1289        l = lptr_pcg1_b_o_aer(isize,itype,iphase)
1290        if (l .ge. p1st) then
1291            aer(ipcg1_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1292        else
1293             aer(ipcg1_b_o_a,jtotal,ibin)=0.0
1294        end if
1295        l = lptr_pcg2_b_o_aer(isize,itype,iphase)
1296        if (l .ge. p1st) then
1297            aer(ipcg2_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1298        else
1299             aer(ipcg2_b_o_a,jtotal,ibin)=0.0
1300        end if
1301        l = lptr_pcg3_b_o_aer(isize,itype,iphase)
1302        if (l .ge. p1st) then
1303            aer(ipcg3_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1304        else
1305             aer(ipcg3_b_o_a,jtotal,ibin)=0.0
1306        end if
1307        l = lptr_pcg4_b_o_aer(isize,itype,iphase)
1308        if (l .ge. p1st) then
1309            aer(ipcg4_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1310        else
1311             aer(ipcg4_b_o_a,jtotal,ibin)=0.0
1312        end if
1313        l = lptr_pcg5_b_o_aer(isize,itype,iphase)
1314        if (l .ge. p1st) then
1315            aer(ipcg5_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1316        else
1317             aer(ipcg5_b_o_a,jtotal,ibin)=0.0
1318        end if
1319        l = lptr_pcg6_b_o_aer(isize,itype,iphase)
1320        if (l .ge. p1st) then
1321            aer(ipcg6_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1322        else
1323             aer(ipcg6_b_o_a,jtotal,ibin)=0.0
1324        end if
1325        l = lptr_pcg7_b_o_aer(isize,itype,iphase)
1326        if (l .ge. p1st) then
1327            aer(ipcg7_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1328        else
1329             aer(ipcg7_b_o_a,jtotal,ibin)=0.0
1330        end if
1331        l = lptr_pcg8_b_o_aer(isize,itype,iphase)
1332        if (l .ge. p1st) then
1333            aer(ipcg8_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1334        else
1335             aer(ipcg8_b_o_a,jtotal,ibin)=0.0
1336        end if
1337        l = lptr_pcg9_b_o_aer(isize,itype,iphase)
1338        if (l .ge. p1st) then
1339            aer(ipcg9_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1340        else
1341             aer(ipcg9_b_o_a,jtotal,ibin)=0.0
1342        end if
1343        l = lptr_opcg1_b_c_aer(isize,itype,iphase)
1344        if (l .ge. p1st) then
1345            aer(iopcg1_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1346        else
1347             aer(iopcg1_b_c_a,jtotal,ibin)=0.0
1348        end if
1349        l = lptr_opcg2_b_c_aer(isize,itype,iphase)
1350        if (l .ge. p1st) then
1351            aer(iopcg2_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1352        else
1353             aer(iopcg2_b_c_a,jtotal,ibin)=0.0
1354        end if
1355        l = lptr_opcg3_b_c_aer(isize,itype,iphase)
1356        if (l .ge. p1st) then
1357            aer(iopcg3_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1358        else
1359             aer(iopcg3_b_c_a,jtotal,ibin)=0.0
1360        end if
1361        l = lptr_opcg4_b_c_aer(isize,itype,iphase)
1362        if (l .ge. p1st) then
1363            aer(iopcg4_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1364        else
1365             aer(iopcg4_b_c_a,jtotal,ibin)=0.0
1366        end if
1367        l = lptr_opcg5_b_c_aer(isize,itype,iphase)
1368        if (l .ge. p1st) then
1369            aer(iopcg5_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1370        else
1371             aer(iopcg5_b_c_a,jtotal,ibin)=0.0
1372        end if
1373        l = lptr_opcg6_b_c_aer(isize,itype,iphase)
1374        if (l .ge. p1st) then
1375            aer(iopcg6_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1376        else
1377             aer(iopcg6_b_c_a,jtotal,ibin)=0.0
1378        end if
1379        l = lptr_opcg7_b_c_aer(isize,itype,iphase)
1380        if (l .ge. p1st) then
1381            aer(iopcg7_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1382        else
1383             aer(iopcg7_b_c_a,jtotal,ibin)=0.0
1384        end if
1385        l = lptr_opcg8_b_c_aer(isize,itype,iphase)
1386        if (l .ge. p1st) then
1387            aer(iopcg8_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1388        else
1389             aer(iopcg8_b_c_a,jtotal,ibin)=0.0
1390        end if
1391        l = lptr_opcg1_b_o_aer(isize,itype,iphase)
1392        if (l .ge. p1st) then
1393            aer(iopcg1_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1394        else
1395             aer(iopcg1_b_o_a,jtotal,ibin)=0.0
1396        end if
1397        l = lptr_opcg2_b_o_aer(isize,itype,iphase)
1398        if (l .ge. p1st) then
1399            aer(iopcg2_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1400        else
1401             aer(iopcg2_b_o_a,jtotal,ibin)=0.0
1402        end if
1403        l = lptr_opcg3_b_o_aer(isize,itype,iphase)
1404        if (l .ge. p1st) then
1405            aer(iopcg3_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1406        else
1407             aer(iopcg3_b_o_a,jtotal,ibin)=0.0
1408        end if
1409        l = lptr_opcg4_b_o_aer(isize,itype,iphase)
1410        if (l .ge. p1st) then
1411            aer(iopcg4_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1412        else
1413             aer(iopcg4_b_o_a,jtotal,ibin)=0.0
1414        end if
1415        l = lptr_opcg5_b_o_aer(isize,itype,iphase)
1416        if (l .ge. p1st) then
1417            aer(iopcg5_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1418        else
1419             aer(iopcg5_b_o_a,jtotal,ibin)=0.0
1420        end if
1421        l = lptr_opcg6_b_o_aer(isize,itype,iphase)
1422        if (l .ge. p1st) then
1423            aer(iopcg6_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1424        else
1425             aer(iopcg6_b_o_a,jtotal,ibin)=0.0
1426        end if
1427        l = lptr_opcg7_b_o_aer(isize,itype,iphase)
1428        if (l .ge. p1st) then
1429            aer(iopcg7_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1430        else
1431             aer(iopcg7_b_o_a,jtotal,ibin)=0.0
1432        end if
1433        l = lptr_opcg8_b_o_aer(isize,itype,iphase)
1434        if (l .ge. p1st) then
1435            aer(iopcg8_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1436        else
1437             aer(iopcg8_b_o_a,jtotal,ibin)=0.0
1438        end if
1439        l = lptr_pcg1_f_c_aer(isize,itype,iphase)
1440        if (l .ge. p1st) then
1441            aer(ipcg1_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1442        else
1443             aer(ipcg1_f_c_a,jtotal,ibin)=0.0
1444        end if
1445        l = lptr_pcg2_f_c_aer(isize,itype,iphase)
1446        if (l .ge. p1st) then
1447            aer(ipcg2_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1448        else
1449             aer(ipcg2_f_c_a,jtotal,ibin)=0.0
1450        end if
1451        l = lptr_pcg3_f_c_aer(isize,itype,iphase)
1452        if (l .ge. p1st) then
1453            aer(ipcg3_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1454        else
1455             aer(ipcg3_f_c_a,jtotal,ibin)=0.0
1456        end if
1457        l = lptr_pcg4_f_c_aer(isize,itype,iphase)
1458        if (l .ge. p1st) then
1459            aer(ipcg4_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1460        else
1461             aer(ipcg4_f_c_a,jtotal,ibin)=0.0
1462        end if
1463        l = lptr_pcg5_f_c_aer(isize,itype,iphase)
1464        if (l .ge. p1st) then
1465            aer(ipcg5_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1466        else
1467             aer(ipcg5_f_c_a,jtotal,ibin)=0.0
1468        end if
1469        l = lptr_pcg6_f_c_aer(isize,itype,iphase)
1470        if (l .ge. p1st) then
1471            aer(ipcg6_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1472        else
1473             aer(ipcg6_f_c_a,jtotal,ibin)=0.0
1474        end if
1475        l = lptr_pcg7_f_c_aer(isize,itype,iphase)
1476        if (l .ge. p1st) then
1477            aer(ipcg7_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1478        else
1479             aer(ipcg7_f_c_a,jtotal,ibin)=0.0
1480        end if
1481        l = lptr_pcg8_f_c_aer(isize,itype,iphase)
1482        if (l .ge. p1st) then
1483            aer(ipcg8_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1484        else
1485             aer(ipcg8_f_c_a,jtotal,ibin)=0.0
1486        end if
1487        l = lptr_pcg9_f_c_aer(isize,itype,iphase)
1488        if (l .ge. p1st) then
1489            aer(ipcg9_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1490        else
1491             aer(ipcg9_f_c_a,jtotal,ibin)=0.0
1492        end if
1493        l = lptr_pcg1_f_o_aer(isize,itype,iphase)
1494        if (l .ge. p1st) then
1495            aer(ipcg1_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1496        else
1497             aer(ipcg1_f_o_a,jtotal,ibin)=0.0
1498        end if
1499        l = lptr_pcg2_f_o_aer(isize,itype,iphase)
1500        if (l .ge. p1st) then
1501            aer(ipcg2_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1502        else
1503             aer(ipcg2_f_o_a,jtotal,ibin)=0.0
1504        end if
1505        l = lptr_pcg3_f_o_aer(isize,itype,iphase)
1506        if (l .ge. p1st) then
1507            aer(ipcg3_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1508        else
1509             aer(ipcg3_f_o_a,jtotal,ibin)=0.0
1510        end if
1511        l = lptr_pcg4_f_o_aer(isize,itype,iphase)
1512        if (l .ge. p1st) then
1513            aer(ipcg4_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1514        else
1515             aer(ipcg4_f_o_a,jtotal,ibin)=0.0
1516        end if
1517        l = lptr_pcg5_f_o_aer(isize,itype,iphase)
1518        if (l .ge. p1st) then
1519            aer(ipcg5_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1520        else
1521             aer(ipcg5_f_o_a,jtotal,ibin)=0.0
1522        end if
1523        l = lptr_pcg6_f_o_aer(isize,itype,iphase)
1524        if (l .ge. p1st) then
1525            aer(ipcg6_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1526        else
1527             aer(ipcg6_f_o_a,jtotal,ibin)=0.0
1528        end if
1529        l = lptr_pcg7_f_o_aer(isize,itype,iphase)
1530        if (l .ge. p1st) then
1531            aer(ipcg7_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1532        else
1533             aer(ipcg7_f_o_a,jtotal,ibin)=0.0
1534        end if
1535        l = lptr_pcg8_f_o_aer(isize,itype,iphase)
1536        if (l .ge. p1st) then
1537            aer(ipcg8_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1538        else
1539             aer(ipcg8_f_o_a,jtotal,ibin)=0.0
1540        end if
1541        l = lptr_pcg9_f_o_aer(isize,itype,iphase)
1542        if (l .ge. p1st) then
1543            aer(ipcg9_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1544        else
1545             aer(ipcg9_f_o_a,jtotal,ibin)=0.0
1546        end if
1547        l = lptr_opcg1_f_c_aer(isize,itype,iphase)
1548        if (l .ge. p1st) then
1549            aer(iopcg1_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1550        else
1551             aer(iopcg1_f_c_a,jtotal,ibin)=0.0
1552        end if
1553        l = lptr_opcg2_f_c_aer(isize,itype,iphase)
1554        if (l .ge. p1st) then
1555            aer(iopcg2_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1556        else
1557             aer(iopcg2_f_c_a,jtotal,ibin)=0.0
1558        end if
1559        l = lptr_opcg3_f_c_aer(isize,itype,iphase)
1560        if (l .ge. p1st) then
1561            aer(iopcg3_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1562        else
1563             aer(iopcg3_f_c_a,jtotal,ibin)=0.0
1564        end if
1565        l = lptr_opcg4_f_c_aer(isize,itype,iphase)
1566        if (l .ge. p1st) then
1567            aer(iopcg4_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1568        else
1569             aer(iopcg4_f_c_a,jtotal,ibin)=0.0
1570        end if
1571        l = lptr_opcg5_f_c_aer(isize,itype,iphase)
1572        if (l .ge. p1st) then
1573            aer(iopcg5_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1574        else
1575             aer(iopcg5_f_c_a,jtotal,ibin)=0.0
1576        end if
1577        l = lptr_opcg6_f_c_aer(isize,itype,iphase)
1578        if (l .ge. p1st) then
1579            aer(iopcg6_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1580        else
1581             aer(iopcg6_f_c_a,jtotal,ibin)=0.0
1582        end if
1583        l = lptr_opcg7_f_c_aer(isize,itype,iphase)
1584        if (l .ge. p1st) then
1585            aer(iopcg7_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1586        else
1587             aer(iopcg7_f_c_a,jtotal,ibin)=0.0
1588        end if
1589        l = lptr_opcg8_f_c_aer(isize,itype,iphase)
1590        if (l .ge. p1st) then
1591            aer(iopcg8_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1592        else
1593             aer(iopcg8_f_c_a,jtotal,ibin)=0.0
1594        end if
1595        l = lptr_opcg1_f_o_aer(isize,itype,iphase)
1596        if (l .ge. p1st) then
1597            aer(iopcg1_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1598        else
1599             aer(iopcg1_f_o_a,jtotal,ibin)=0.0
1600        end if
1601        l = lptr_opcg2_f_o_aer(isize,itype,iphase)
1602        if (l .ge. p1st) then
1603            aer(iopcg2_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1604        else
1605             aer(iopcg2_f_o_a,jtotal,ibin)=0.0
1606        end if
1607        l = lptr_opcg3_f_o_aer(isize,itype,iphase)
1608        if (l .ge. p1st) then
1609            aer(iopcg3_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1610        else
1611             aer(iopcg3_f_o_a,jtotal,ibin)=0.0
1612        end if
1613        l = lptr_opcg4_f_o_aer(isize,itype,iphase)
1614        if (l .ge. p1st) then
1615            aer(iopcg4_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1616        else
1617             aer(iopcg4_f_o_a,jtotal,ibin)=0.0
1618        end if
1619        l = lptr_opcg5_f_o_aer(isize,itype,iphase)
1620        if (l .ge. p1st) then
1621            aer(iopcg5_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1622        else
1623             aer(iopcg5_f_o_a,jtotal,ibin)=0.0
1624        end if
1625        l = lptr_opcg6_f_o_aer(isize,itype,iphase)
1626        if (l .ge. p1st) then
1627            aer(iopcg6_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1628        else
1629             aer(iopcg6_f_o_a,jtotal,ibin)=0.0
1630        end if
1631        l = lptr_opcg7_f_o_aer(isize,itype,iphase)
1632        if (l .ge. p1st) then
1633            aer(iopcg7_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1634        else
1635             aer(iopcg7_f_o_a,jtotal,ibin)=0.0
1636        end if
1637        l = lptr_opcg8_f_o_aer(isize,itype,iphase)
1638        if (l .ge. p1st) then
1639            aer(iopcg8_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1640        else
1641             aer(iopcg8_f_o_a,jtotal,ibin)=0.0
1642        end if
1643
1644        l = lptr_smpa_aer(isize,itype,iphase)
1645        if (l .ge. p1st) then
1646            aer(ismpa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1647        else
1648             aer(ismpa_a,jtotal,ibin)=0.0
1649        end if
1650        l = lptr_smpbb_aer(isize,itype,iphase)
1651        if (l .ge. p1st) then
1652            aer(ismpbb_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1653        else
1654             aer(ismpbb_a,jtotal,ibin)=0.0
1655        end if
1656
1657        l = lptr_glysoa_r1_aer(isize,itype,iphase)
1658        if (l .ge. p1st) then
1659            aer(iglysoa_r1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1660        else
1661             aer(iglysoa_r1_a,jtotal,ibin)=0.0
1662        end if
1663
1664        l = lptr_glysoa_r2_aer(isize,itype,iphase)
1665        if (l .ge. p1st) then
1666            aer(iglysoa_r2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1667        else
1668             aer(iglysoa_r2_a,jtotal,ibin)=0.0
1669        end if
1670
1671        l = lptr_glysoa_sfc_aer(isize,itype,iphase)
1672        if (l .ge. p1st) then
1673            aer(iglysoa_sfc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1674        else
1675             aer(iglysoa_sfc_a,jtotal,ibin)=0.0
1676        end if
1677
1678        l = lptr_glysoa_nh4_aer(isize,itype,iphase)
1679        if (l .ge. p1st) then
1680            aer(iglysoa_nh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1681        else
1682             aer(iglysoa_nh4_a,jtotal,ibin)=0.0
1683        end if
1684
1685        l = lptr_glysoa_oh_aer(isize,itype,iphase)
1686        if (l .ge. p1st) then
1687            aer(iglysoa_oh_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1688        else
1689             aer(iglysoa_oh_a,jtotal,ibin)=0.0
1690        end if
1691
1692        l = lptr_ant1_c_aer(isize,itype,iphase)
1693        if (l .ge. p1st) then
1694            aer(iant1_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1695        else
1696             aer(iant1_c_a,jtotal,ibin)=0.0
1697        end if
1698
1699        l = lptr_ant2_c_aer(isize,itype,iphase)
1700        if (l .ge. p1st) then
1701            aer(iant2_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1702        else
1703             aer(iant2_c_a,jtotal,ibin)=0.0
1704        end if
1705
1706        l = lptr_ant3_c_aer(isize,itype,iphase)
1707        if (l .ge. p1st) then
1708            aer(iant3_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1709        else
1710             aer(iant3_c_a,jtotal,ibin)=0.0
1711        end if
1712
1713        l = lptr_ant4_c_aer(isize,itype,iphase)
1714        if (l .ge. p1st) then
1715            aer(iant4_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1716        else
1717             aer(iant4_c_a,jtotal,ibin)=0.0
1718        end if
1719
1720        l = lptr_ant1_o_aer(isize,itype,iphase)
1721        if (l .ge. p1st) then
1722            aer(iant1_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1723        else
1724             aer(iant1_o_a,jtotal,ibin)=0.0
1725        end if
1726
1727        l = lptr_ant2_o_aer(isize,itype,iphase)
1728        if (l .ge. p1st) then
1729            aer(iant2_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1730        else
1731             aer(iant2_o_a,jtotal,ibin)=0.0
1732        end if
1733
1734        l = lptr_ant3_o_aer(isize,itype,iphase)
1735        if (l .ge. p1st) then
1736            aer(iant3_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1737        else
1738             aer(iant3_o_a,jtotal,ibin)=0.0
1739        end if
1740
1741        l = lptr_ant4_o_aer(isize,itype,iphase)
1742        if (l .ge. p1st) then
1743            aer(iant4_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1744        else
1745             aer(iant4_o_a,jtotal,ibin)=0.0
1746        end if
1747
1748        l = lptr_biog1_c_aer(isize,itype,iphase)
1749        if (l .ge. p1st) then
1750            aer(ibiog1_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1751        else
1752             aer(ibiog1_c_a,jtotal,ibin)=0.0
1753        end if
1754
1755        l = lptr_biog2_c_aer(isize,itype,iphase)
1756        if (l .ge. p1st) then
1757            aer(ibiog2_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1758        else
1759             aer(ibiog2_c_a,jtotal,ibin)=0.0
1760        end if
1761
1762        l = lptr_biog3_c_aer(isize,itype,iphase)
1763        if (l .ge. p1st) then
1764            aer(ibiog3_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1765        else
1766             aer(ibiog3_c_a,jtotal,ibin)=0.0
1767        end if
1768
1769        l = lptr_biog4_c_aer(isize,itype,iphase)
1770        if (l .ge. p1st) then
1771            aer(ibiog4_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1772        else
1773             aer(ibiog4_c_a,jtotal,ibin)=0.0
1774        end if
1775
1776        l = lptr_biog1_o_aer(isize,itype,iphase)
1777        if (l .ge. p1st) then
1778            aer(ibiog1_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1779        else
1780             aer(ibiog1_o_a,jtotal,ibin)=0.0
1781        end if
1782
1783        l = lptr_biog2_o_aer(isize,itype,iphase)
1784        if (l .ge. p1st) then
1785            aer(ibiog2_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1786        else
1787             aer(ibiog2_o_a,jtotal,ibin)=0.0
1788        end if
1789
1790        l = lptr_biog3_o_aer(isize,itype,iphase)
1791        if (l .ge. p1st) then
1792            aer(ibiog3_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1793        else
1794             aer(ibiog3_o_a,jtotal,ibin)=0.0
1795        end if
1796
1797        l = lptr_biog4_o_aer(isize,itype,iphase)
1798        if (l .ge. p1st) then
1799            aer(ibiog4_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1800        else
1801             aer(ibiog4_o_a,jtotal,ibin)=0.0
1802        end if
1803
1804        l = lptr_asoaX_aer(isize,itype,iphase)
1805        if (l .ge. p1st) then
1806            aer(iasoaX_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1807        else
1808             aer(iasoaX_a,jtotal,ibin)=0.0
1809        end if
1810
1811        l = lptr_asoa1_aer(isize,itype,iphase)
1812        if (l .ge. p1st) then
1813            aer(iasoa1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1814        else
1815             aer(iasoa1_a,jtotal,ibin)=0.0
1816        end if
1817
1818        l = lptr_asoa2_aer(isize,itype,iphase)
1819        if (l .ge. p1st) then
1820            aer(iasoa2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1821        else
1822             aer(iasoa2_a,jtotal,ibin)=0.0
1823        end if
1824
1825        l = lptr_asoa3_aer(isize,itype,iphase)
1826        if (l .ge. p1st) then
1827            aer(iasoa3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1828        else
1829             aer(iasoa3_a,jtotal,ibin)=0.0
1830        end if
1831
1832        l = lptr_asoa4_aer(isize,itype,iphase)
1833        if (l .ge. p1st) then
1834            aer(iasoa4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1835        else
1836             aer(iasoa4_a,jtotal,ibin)=0.0
1837        end if
1838
1839        l = lptr_bsoaX_aer(isize,itype,iphase)
1840        if (l .ge. p1st) then
1841            aer(ibsoaX_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1842        else
1843             aer(ibsoaX_a,jtotal,ibin)=0.0
1844        end if
1845
1846        l = lptr_bsoa1_aer(isize,itype,iphase)
1847        if (l .ge. p1st) then
1848            aer(ibsoa1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1849        else
1850             aer(ibsoa1_a,jtotal,ibin)=0.0
1851        end if
1852
1853        l = lptr_bsoa2_aer(isize,itype,iphase)
1854        if (l .ge. p1st) then
1855            aer(ibsoa2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1856        else
1857             aer(ibsoa2_a,jtotal,ibin)=0.0
1858        end if
1859
1860        l = lptr_bsoa3_aer(isize,itype,iphase)
1861        if (l .ge. p1st) then
1862            aer(ibsoa3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1863        else
1864             aer(ibsoa3_a,jtotal,ibin)=0.0
1865        end if
1866
1867        l = lptr_bsoa4_aer(isize,itype,iphase)
1868        if (l .ge. p1st) then
1869            aer(ibsoa4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1870        else
1871             aer(ibsoa4_a,jtotal,ibin)=0.0
1872        end if
1873
1874 ! water_a and water_a_hyst units are kg/(m^3 air)
1875         l = hyswptr_aer(isize,itype)
1876         if (l .ge. p1st) then
1877             water_a_hyst(ibin)=rsub(l,k,m)*conv2a
1878         else
1879             water_a_hyst(ibin)=0.0
1880         end if
1881
1882 ! water_a units are kg/(m^3 air)
1883         l = waterptr_aer(isize,itype)
1884         if (l .ge. p1st) then
1885             water_a(ibin)=rsub(l,k,m)*conv2a
1886         else
1887             water_a(ibin)=0.0
1888         end if
1889
1890 ! num_a units are #/(cm^3 air)
1891         l = numptr_aer(isize,itype,iphase)
1892         num_a(ibin) = rsub(l,k,m)*cair_mol_cc
1893
1894 ! other bin parameters (fixed for now)
1895         sigmag_a(ibin)  = 1.02
1896
1897 10      continue
1898
1899
1900
1901
1902 !---------------------------------------------------------------------
1903
1904
1905       else                 ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
1906
1907
1908
1909 ! gas
1910         if (kh2so4 .ge. p1st)   &
1911             rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
1912         if (khno3 .ge. p1st)   &
1913             rsub(khno3,k,m)  = gas(ihno3_g)*conv1b
1914         if (khcl .ge. p1st)   &
1915             rsub(khcl,k,m)   = gas(ihcl_g)*conv1b
1916         if (knh3 .ge. p1st)   &
1917             rsub(knh3,k,m)   = gas(inh3_g)*conv1b
1918         if (kn2o5 .ge. p1st)   &
1919             rsub(kn2o5,k,m)   = gas(in2o5_g)*conv1b
1920         if (kclno2 .ge. p1st)   &
1921             rsub(kclno2,k,m)   = gas(iclno2_g)*conv1b
1922
1923 ! soa gas-phase species -- currently deactivated
1924         if (kpcg1_b_c .ge. p1st)   &
1925             rsub(kpcg1_b_c,k,m)   = gas(ipcg1_b_c_g)*conv1b
1926         if (kpcg2_b_c .ge. p1st)   &
1927             rsub(kpcg2_b_c,k,m)   = gas(ipcg2_b_c_g)*conv1b
1928         if (kpcg3_b_c .ge. p1st)   &
1929             rsub(kpcg3_b_c,k,m)   = gas(ipcg3_b_c_g)*conv1b
1930         if (kpcg4_b_c .ge. p1st)   &
1931             rsub(kpcg4_b_c,k,m)   = gas(ipcg4_b_c_g)*conv1b
1932         if (kpcg5_b_c .ge. p1st)   &
1933             rsub(kpcg5_b_c,k,m)   = gas(ipcg5_b_c_g)*conv1b
1934         if (kpcg6_b_c .ge. p1st)   &
1935             rsub(kpcg6_b_c,k,m)   = gas(ipcg6_b_c_g)*conv1b
1936         if (kpcg7_b_c .ge. p1st)   &
1937             rsub(kpcg7_b_c,k,m)   = gas(ipcg7_b_c_g)*conv1b
1938         if (kpcg8_b_c .ge. p1st)   &
1939             rsub(kpcg8_b_c,k,m)   = gas(ipcg8_b_c_g)*conv1b
1940         if (kpcg9_b_c .ge. p1st)   &
1941             rsub(kpcg9_b_c,k,m)   = gas(ipcg9_b_c_g)*conv1b
1942         if (kpcg1_b_o .ge. p1st)   &
1943             rsub(kpcg1_b_o,k,m)   = gas(ipcg1_b_o_g)*conv1b
1944         if (kpcg2_b_o .ge. p1st)   &
1945             rsub(kpcg2_b_o,k,m)   = gas(ipcg2_b_o_g)*conv1b
1946         if (kpcg3_b_o .ge. p1st)   &
1947             rsub(kpcg3_b_o,k,m)   = gas(ipcg3_b_o_g)*conv1b
1948         if (kpcg4_b_o .ge. p1st)   &
1949             rsub(kpcg4_b_o,k,m)   = gas(ipcg4_b_o_g)*conv1b
1950         if (kpcg5_b_o .ge. p1st)   &
1951             rsub(kpcg5_b_o,k,m)   = gas(ipcg5_b_o_g)*conv1b
1952         if (kpcg6_b_o .ge. p1st)   &
1953             rsub(kpcg6_b_o,k,m)   = gas(ipcg6_b_o_g)*conv1b
1954         if (kpcg7_b_o .ge. p1st)   &
1955             rsub(kpcg7_b_o,k,m)   = gas(ipcg7_b_o_g)*conv1b
1956         if (kpcg8_b_o .ge. p1st)   &
1957             rsub(kpcg8_b_o,k,m)   = gas(ipcg8_b_o_g)*conv1b
1958         if (kpcg9_b_o .ge. p1st)   &
1959             rsub(kpcg9_b_o,k,m)   = gas(ipcg9_b_o_g)*conv1b
1960         if (kopcg1_b_c .ge. p1st)   &
1961             rsub(kopcg1_b_c,k,m)   = gas(iopcg1_b_c_g)*conv1b
1962         if (kopcg2_b_c .ge. p1st)   &
1963             rsub(kopcg2_b_c,k,m)   = gas(iopcg2_b_c_g)*conv1b
1964         if (kopcg3_b_c .ge. p1st)   &
1965             rsub(kopcg3_b_c,k,m)   = gas(iopcg3_b_c_g)*conv1b
1966         if (kopcg4_b_c .ge. p1st)   &
1967             rsub(kopcg4_b_c,k,m)   = gas(iopcg4_b_c_g)*conv1b
1968         if (kopcg5_b_c .ge. p1st)   &
1969             rsub(kopcg5_b_c,k,m)   = gas(iopcg5_b_c_g)*conv1b
1970         if (kopcg6_b_c .ge. p1st)   &
1971             rsub(kopcg6_b_c,k,m)   = gas(iopcg6_b_c_g)*conv1b
1972         if (kopcg7_b_c .ge. p1st)   &
1973             rsub(kopcg7_b_c,k,m)   = gas(iopcg7_b_c_g)*conv1b
1974         if (kopcg8_b_c .ge. p1st)   &
1975             rsub(kopcg8_b_c,k,m)   = gas(iopcg8_b_c_g)*conv1b
1976         if (kopcg1_b_o .ge. p1st)   &
1977             rsub(kopcg1_b_o,k,m)   = gas(iopcg1_b_o_g)*conv1b
1978         if (kopcg2_b_o .ge. p1st)   &
1979             rsub(kopcg2_b_o,k,m)   = gas(iopcg2_b_o_g)*conv1b
1980         if (kopcg3_b_o .ge. p1st)   &
1981             rsub(kopcg3_b_o,k,m)   = gas(iopcg3_b_o_g)*conv1b
1982         if (kopcg4_b_o .ge. p1st)   &
1983             rsub(kopcg4_b_o,k,m)   = gas(iopcg4_b_o_g)*conv1b
1984         if (kopcg5_b_o .ge. p1st)   &
1985             rsub(kopcg5_b_o,k,m)   = gas(iopcg5_b_o_g)*conv1b
1986         if (kopcg6_b_o .ge. p1st)   &
1987             rsub(kopcg6_b_o,k,m)   = gas(iopcg6_b_o_g)*conv1b
1988         if (kopcg7_b_o .ge. p1st)   &
1989             rsub(kopcg7_b_o,k,m)   = gas(iopcg7_b_o_g)*conv1b
1990         if (kopcg8_b_o .ge. p1st)   &
1991             rsub(kopcg8_b_o,k,m)   = gas(iopcg8_b_o_g)*conv1b
1992         if (kpcg1_f_c .ge. p1st)   &
1993             rsub(kpcg1_f_c,k,m)   = gas(ipcg1_f_c_g)*conv1b
1994         if (kpcg2_f_c .ge. p1st)   &
1995             rsub(kpcg2_f_c,k,m)   = gas(ipcg2_f_c_g)*conv1b
1996         if (kpcg3_f_c .ge. p1st)   &
1997             rsub(kpcg3_f_c,k,m)   = gas(ipcg3_f_c_g)*conv1b
1998         if (kpcg4_f_c .ge. p1st)   &
1999             rsub(kpcg4_f_c,k,m)   = gas(ipcg4_f_c_g)*conv1b
2000         if (kpcg5_f_c .ge. p1st)   &
2001             rsub(kpcg5_f_c,k,m)   = gas(ipcg5_f_c_g)*conv1b
2002         if (kpcg6_f_c .ge. p1st)   &
2003             rsub(kpcg6_f_c,k,m)   = gas(ipcg6_f_c_g)*conv1b
2004         if (kpcg7_f_c .ge. p1st)   &
2005             rsub(kpcg7_f_c,k,m)   = gas(ipcg7_f_c_g)*conv1b
2006         if (kpcg8_f_c .ge. p1st)   &
2007             rsub(kpcg8_f_c,k,m)   = gas(ipcg8_f_c_g)*conv1b
2008         if (kpcg9_f_c .ge. p1st)   &
2009             rsub(kpcg9_f_c,k,m)   = gas(ipcg9_f_c_g)*conv1b
2010         if (kpcg1_f_o .ge. p1st)   &
2011             rsub(kpcg1_f_o,k,m)   = gas(ipcg1_f_o_g)*conv1b
2012         if (kpcg2_f_o .ge. p1st)   &
2013             rsub(kpcg2_f_o,k,m)   = gas(ipcg2_f_o_g)*conv1b
2014         if (kpcg3_f_o .ge. p1st)   &
2015             rsub(kpcg3_f_o,k,m)   = gas(ipcg3_f_o_g)*conv1b
2016         if (kpcg4_f_o .ge. p1st)   &
2017             rsub(kpcg4_f_o,k,m)   = gas(ipcg4_f_o_g)*conv1b
2018         if (kpcg5_f_o .ge. p1st)   &
2019             rsub(kpcg5_f_o,k,m)   = gas(ipcg5_f_o_g)*conv1b
2020         if (kpcg6_f_o .ge. p1st)   &
2021             rsub(kpcg6_f_o,k,m)   = gas(ipcg6_f_o_g)*conv1b
2022         if (kpcg7_f_o .ge. p1st)   &
2023             rsub(kpcg7_f_o,k,m)   = gas(ipcg7_f_o_g)*conv1b
2024         if (kpcg8_f_o .ge. p1st)   &
2025             rsub(kpcg8_f_o,k,m)   = gas(ipcg8_f_o_g)*conv1b
2026         if (kpcg9_f_o .ge. p1st)   &
2027             rsub(kpcg9_f_o,k,m)   = gas(ipcg9_f_o_g)*conv1b
2028         if (kopcg1_f_c .ge. p1st)   &
2029             rsub(kopcg1_f_c,k,m)   = gas(iopcg1_f_c_g)*conv1b
2030         if (kopcg2_f_c .ge. p1st)   &
2031             rsub(kopcg2_f_c,k,m)   = gas(iopcg2_f_c_g)*conv1b
2032         if (kopcg3_f_c .ge. p1st)   &
2033             rsub(kopcg3_f_c,k,m)   = gas(iopcg3_f_c_g)*conv1b
2034         if (kopcg4_f_c .ge. p1st)   &
2035             rsub(kopcg4_f_c,k,m)   = gas(iopcg4_f_c_g)*conv1b
2036         if (kopcg5_f_c .ge. p1st)   &
2037             rsub(kopcg5_f_c,k,m)   = gas(iopcg5_f_c_g)*conv1b
2038         if (kopcg6_f_c .ge. p1st)   &
2039             rsub(kopcg6_f_c,k,m)   = gas(iopcg6_f_c_g)*conv1b
2040         if (kopcg7_f_c .ge. p1st)   &
2041             rsub(kopcg7_f_c,k,m)   = gas(iopcg7_f_c_g)*conv1b
2042         if (kopcg8_f_c .ge. p1st)   &
2043             rsub(kopcg8_f_c,k,m)   = gas(iopcg8_f_c_g)*conv1b
2044         if (kopcg1_f_o .ge. p1st)   &
2045             rsub(kopcg1_f_o,k,m)   = gas(iopcg1_f_o_g)*conv1b
2046         if (kopcg2_f_o .ge. p1st)   &
2047             rsub(kopcg2_f_o,k,m)   = gas(iopcg2_f_o_g)*conv1b
2048         if (kopcg3_f_o .ge. p1st)   &
2049             rsub(kopcg3_f_o,k,m)   = gas(iopcg3_f_o_g)*conv1b
2050         if (kopcg4_f_o .ge. p1st)   &
2051             rsub(kopcg4_f_o,k,m)   = gas(iopcg4_f_o_g)*conv1b
2052         if (kopcg5_f_o .ge. p1st)   &
2053             rsub(kopcg5_f_o,k,m)   = gas(iopcg5_f_o_g)*conv1b
2054         if (kopcg6_f_o .ge. p1st)   &
2055             rsub(kopcg6_f_o,k,m)   = gas(iopcg6_f_o_g)*conv1b
2056         if (kopcg7_f_o .ge. p1st)   &
2057             rsub(kopcg7_f_o,k,m)   = gas(iopcg7_f_o_g)*conv1b
2058         if (kopcg8_f_o .ge. p1st)   &
2059             rsub(kopcg8_f_o,k,m)   = gas(iopcg8_f_o_g)*conv1b
2060         if (ksmpa .ge. p1st)   &
2061             rsub(ksmpa,k,m)   = gas(ismpa_g)*conv1b
2062         if (kgly .ge. p1st)   &
2063             rsub(kgly,k,m)   = gas(igly)*conv1b
2064         ! CK 20120913 OH is only used as scaling quantity, not returned to gas array
2065 !!        if (koh .ge. p1st)   &
2066 !!            rsub(koh,k,m)   = gas(iho)*conv1b
2067         if (ksmpbb .ge. p1st)   &
2068             rsub(ksmpbb,k,m)   = gas(ismpbb_g)*conv1b
2069         if (kant1_c .ge. p1st)   &
2070             rsub(kant1_c,k,m)   = gas(iant1_c_g)*conv1b
2071         if (kant2_c .ge. p1st)   &
2072             rsub(kant2_c,k,m)   = gas(iant2_c_g)*conv1b
2073         if (kant3_c .ge. p1st)   &
2074             rsub(kant3_c,k,m)   = gas(iant3_c_g)*conv1b
2075         if (kant4_c .ge. p1st)   &
2076             rsub(kant4_c,k,m)   = gas(iant4_c_g)*conv1b
2077         if (kant1_o .ge. p1st)   &
2078             rsub(kant1_o,k,m)   = gas(iant1_o_g)*conv1b
2079         if (kant2_o .ge. p1st)   &
2080             rsub(kant2_o,k,m)   = gas(iant2_o_g)*conv1b
2081         if (kant3_o .ge. p1st)   &
2082             rsub(kant3_o,k,m)   = gas(iant3_o_g)*conv1b
2083         if (kant4_o .ge. p1st)   &
2084             rsub(kant4_o,k,m)   = gas(iant4_o_g)*conv1b
2085         if (kbiog1_c .ge. p1st)   &
2086             rsub(kbiog1_c,k,m)   = gas(ibiog1_c_g)*conv1b
2087         if (kbiog2_c .ge. p1st)   &
2088             rsub(kbiog2_c,k,m)   = gas(ibiog2_c_g)*conv1b
2089         if (kbiog3_c .ge. p1st)   &
2090             rsub(kbiog3_c,k,m)   = gas(ibiog3_c_g)*conv1b
2091         if (kbiog4_c .ge. p1st)   &
2092             rsub(kbiog4_c,k,m)   = gas(ibiog4_c_g)*conv1b
2093         if (kbiog1_o .ge. p1st)   &
2094             rsub(kbiog1_o,k,m)   = gas(ibiog1_o_g)*conv1b
2095         if (kbiog2_o .ge. p1st)   &
2096             rsub(kbiog2_o,k,m)   = gas(ibiog2_o_g)*conv1b
2097         if (kbiog3_o .ge. p1st)   &
2098             rsub(kbiog3_o,k,m)   = gas(ibiog3_o_g)*conv1b
2099         if (kbiog4_o .ge. p1st)   &
2100             rsub(kbiog4_o,k,m)   = gas(ibiog4_o_g)*conv1b
2101         if (kasoaX .ge. p1st)   &
2102             rsub(kasoaX,k,m)   = gas(iasoaX_g)*conv1b
2103         if (kasoa1 .ge. p1st)   &
2104             rsub(kasoa1,k,m)   = gas(iasoa1_g)*conv1b
2105         if (kasoa2 .ge. p1st)   &
2106             rsub(kasoa2,k,m)   = gas(iasoa2_g)*conv1b
2107         if (kasoa3 .ge. p1st)   &
2108             rsub(kasoa3,k,m)   = gas(iasoa3_g)*conv1b
2109         if (kasoa4 .ge. p1st)   &
2110             rsub(kasoa4,k,m)   = gas(iasoa4_g)*conv1b
2111         if (kbsoaX .ge. p1st)   &
2112             rsub(kbsoaX,k,m)   = gas(ibsoaX_g)*conv1b
2113         if (kbsoa1 .ge. p1st)   &
2114             rsub(kbsoa1,k,m)   = gas(ibsoa1_g)*conv1b
2115         if (kbsoa2 .ge. p1st)   &
2116             rsub(kbsoa2,k,m)   = gas(ibsoa2_g)*conv1b
2117         if (kbsoa3 .ge. p1st)   &
2118             rsub(kbsoa3,k,m)   = gas(ibsoa3_g)*conv1b
2119         if (kbsoa4 .ge. p1st)   &
2120             rsub(kbsoa4,k,m)   = gas(ibsoa4_g)*conv1b
2121
2122 ! aerosol
2123         iphase = ai_phase
2124         ibin = 0
2125         do 20 itype = 1, ntype_aer
2126         do 20 isize = 1, nsize_aer(itype)
2127         ibin = ibin + 1
2128
2129
2130 ! rce 18-nov-2004 - always map so4 and number,
2131 ! but only map other species when (lptr_xxx .ge. p1st)
2132         l = lptr_so4_aer(isize,itype,iphase)
2133         rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
2134
2135         l = lptr_no3_aer(isize,itype,iphase)
2136         if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
2137
2138         l = lptr_cl_aer(isize,itype,iphase)
2139         if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
2140
2141         l = lptr_nh4_aer(isize,itype,iphase)
2142         if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
2143
2144         l = lptr_oc_aer(isize,itype,iphase)
2145         if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
2146
2147         l = lptr_bc_aer(isize,itype,iphase)
2148         if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
2149
2150         l = lptr_na_aer(isize,itype,iphase)
2151         if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
2152
2153         l = lptr_oin_aer(isize,itype,iphase)
2154         if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
2155
2156         l = lptr_msa_aer(isize,itype,iphase)
2157         if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
2158
2159         l = lptr_co3_aer(isize,itype,iphase)
2160         if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
2161
2162         l = lptr_ca_aer(isize,itype,iphase)
2163         if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
2164
2165 ! soa aerosol-phase species -- currently deactivated
2166
2167        l = lptr_pcg1_b_c_aer(isize,itype,iphase)
2168        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_b_c_a,jtotal,ibin)*conv1b
2169        l = lptr_pcg2_b_c_aer(isize,itype,iphase)
2170        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_b_c_a,jtotal,ibin)*conv1b
2171        l = lptr_pcg3_b_c_aer(isize,itype,iphase)
2172        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_b_c_a,jtotal,ibin)*conv1b
2173        l = lptr_pcg4_b_c_aer(isize,itype,iphase)
2174        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_b_c_a,jtotal,ibin)*conv1b
2175        l = lptr_pcg5_b_c_aer(isize,itype,iphase)
2176        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_b_c_a,jtotal,ibin)*conv1b
2177        l = lptr_pcg6_b_c_aer(isize,itype,iphase)
2178        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_b_c_a,jtotal,ibin)*conv1b
2179        l = lptr_pcg7_b_c_aer(isize,itype,iphase)
2180        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_b_c_a,jtotal,ibin)*conv1b
2181        l = lptr_pcg8_b_c_aer(isize,itype,iphase)
2182        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_b_c_a,jtotal,ibin)*conv1b
2183        l = lptr_pcg9_b_c_aer(isize,itype,iphase)
2184        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_b_c_a,jtotal,ibin)*conv1b
2185        l = lptr_pcg1_b_o_aer(isize,itype,iphase)
2186        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_b_o_a,jtotal,ibin)*conv1b
2187        l = lptr_pcg2_b_o_aer(isize,itype,iphase)
2188        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_b_o_a,jtotal,ibin)*conv1b
2189        l = lptr_pcg3_b_o_aer(isize,itype,iphase)
2190        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_b_o_a,jtotal,ibin)*conv1b
2191        l = lptr_pcg4_b_o_aer(isize,itype,iphase)
2192        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_b_o_a,jtotal,ibin)*conv1b
2193        l = lptr_pcg5_b_o_aer(isize,itype,iphase)
2194        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_b_o_a,jtotal,ibin)*conv1b
2195        l = lptr_pcg6_b_o_aer(isize,itype,iphase)
2196        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_b_o_a,jtotal,ibin)*conv1b
2197        l = lptr_pcg7_b_o_aer(isize,itype,iphase)
2198        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_b_o_a,jtotal,ibin)*conv1b
2199        l = lptr_pcg8_b_o_aer(isize,itype,iphase)
2200        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_b_o_a,jtotal,ibin)*conv1b
2201        l = lptr_pcg9_b_o_aer(isize,itype,iphase)
2202        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_b_o_a,jtotal,ibin)*conv1b
2203        l = lptr_opcg1_b_c_aer(isize,itype,iphase)
2204        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_b_c_a,jtotal,ibin)*conv1b
2205        l = lptr_opcg2_b_c_aer(isize,itype,iphase)
2206        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_b_c_a,jtotal,ibin)*conv1b
2207        l = lptr_opcg3_b_c_aer(isize,itype,iphase)
2208        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_b_c_a,jtotal,ibin)*conv1b
2209        l = lptr_opcg4_b_c_aer(isize,itype,iphase)
2210        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_b_c_a,jtotal,ibin)*conv1b
2211        l = lptr_opcg5_b_c_aer(isize,itype,iphase)
2212        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_b_c_a,jtotal,ibin)*conv1b
2213        l = lptr_opcg6_b_c_aer(isize,itype,iphase)
2214        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_b_c_a,jtotal,ibin)*conv1b
2215        l = lptr_opcg7_b_c_aer(isize,itype,iphase)
2216        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_b_c_a,jtotal,ibin)*conv1b
2217        l = lptr_opcg8_b_c_aer(isize,itype,iphase)
2218        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_b_c_a,jtotal,ibin)*conv1b
2219        l = lptr_opcg1_b_o_aer(isize,itype,iphase)
2220        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_b_o_a,jtotal,ibin)*conv1b
2221        l = lptr_opcg2_b_o_aer(isize,itype,iphase)
2222        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_b_o_a,jtotal,ibin)*conv1b
2223        l = lptr_opcg3_b_o_aer(isize,itype,iphase)
2224        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_b_o_a,jtotal,ibin)*conv1b
2225        l = lptr_opcg4_b_o_aer(isize,itype,iphase)
2226        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_b_o_a,jtotal,ibin)*conv1b
2227        l = lptr_opcg5_b_o_aer(isize,itype,iphase)
2228        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_b_o_a,jtotal,ibin)*conv1b
2229        l = lptr_opcg6_b_o_aer(isize,itype,iphase)
2230        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_b_o_a,jtotal,ibin)*conv1b
2231        l = lptr_opcg7_b_o_aer(isize,itype,iphase)
2232        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_b_o_a,jtotal,ibin)*conv1b
2233        l = lptr_opcg8_b_o_aer(isize,itype,iphase)
2234        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_b_o_a,jtotal,ibin)*conv1b
2235        l = lptr_pcg1_f_c_aer(isize,itype,iphase)
2236        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_f_c_a,jtotal,ibin)*conv1b
2237        l = lptr_pcg2_f_c_aer(isize,itype,iphase)
2238        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_f_c_a,jtotal,ibin)*conv1b
2239        l = lptr_pcg3_f_c_aer(isize,itype,iphase)
2240        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_f_c_a,jtotal,ibin)*conv1b
2241        l = lptr_pcg4_f_c_aer(isize,itype,iphase)
2242        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_f_c_a,jtotal,ibin)*conv1b
2243        l = lptr_pcg5_f_c_aer(isize,itype,iphase)
2244        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_f_c_a,jtotal,ibin)*conv1b
2245        l = lptr_pcg6_f_c_aer(isize,itype,iphase)
2246        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_f_c_a,jtotal,ibin)*conv1b
2247        l = lptr_pcg7_f_c_aer(isize,itype,iphase)
2248        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_f_c_a,jtotal,ibin)*conv1b
2249        l = lptr_pcg8_f_c_aer(isize,itype,iphase)
2250        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_f_c_a,jtotal,ibin)*conv1b
2251        l = lptr_pcg9_f_c_aer(isize,itype,iphase)
2252        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_f_c_a,jtotal,ibin)*conv1b
2253        l = lptr_pcg1_f_o_aer(isize,itype,iphase)
2254        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_f_o_a,jtotal,ibin)*conv1b
2255        l = lptr_pcg2_f_o_aer(isize,itype,iphase)
2256        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_f_o_a,jtotal,ibin)*conv1b
2257        l = lptr_pcg3_f_o_aer(isize,itype,iphase)
2258        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_f_o_a,jtotal,ibin)*conv1b
2259        l = lptr_pcg4_f_o_aer(isize,itype,iphase)
2260        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_f_o_a,jtotal,ibin)*conv1b
2261        l = lptr_pcg5_f_o_aer(isize,itype,iphase)
2262        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_f_o_a,jtotal,ibin)*conv1b
2263        l = lptr_pcg6_f_o_aer(isize,itype,iphase)
2264        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_f_o_a,jtotal,ibin)*conv1b
2265        l = lptr_pcg7_f_o_aer(isize,itype,iphase)
2266        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_f_o_a,jtotal,ibin)*conv1b
2267        l = lptr_pcg8_f_o_aer(isize,itype,iphase)
2268        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_f_o_a,jtotal,ibin)*conv1b
2269        l = lptr_pcg9_f_o_aer(isize,itype,iphase)
2270        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_f_o_a,jtotal,ibin)*conv1b
2271        l = lptr_opcg1_f_c_aer(isize,itype,iphase)
2272        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_f_c_a,jtotal,ibin)*conv1b
2273        l = lptr_opcg2_f_c_aer(isize,itype,iphase)
2274        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_f_c_a,jtotal,ibin)*conv1b
2275        l = lptr_opcg3_f_c_aer(isize,itype,iphase)
2276        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_f_c_a,jtotal,ibin)*conv1b
2277        l = lptr_opcg4_f_c_aer(isize,itype,iphase)
2278        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_f_c_a,jtotal,ibin)*conv1b
2279        l = lptr_opcg5_f_c_aer(isize,itype,iphase)
2280        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_f_c_a,jtotal,ibin)*conv1b
2281        l = lptr_opcg6_f_c_aer(isize,itype,iphase)
2282        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_f_c_a,jtotal,ibin)*conv1b
2283        l = lptr_opcg7_f_c_aer(isize,itype,iphase)
2284        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_f_c_a,jtotal,ibin)*conv1b
2285        l = lptr_opcg8_f_c_aer(isize,itype,iphase)
2286        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_f_c_a,jtotal,ibin)*conv1b
2287        l = lptr_opcg1_f_o_aer(isize,itype,iphase)
2288        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_f_o_a,jtotal,ibin)*conv1b
2289        l = lptr_opcg2_f_o_aer(isize,itype,iphase)
2290        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_f_o_a,jtotal,ibin)*conv1b
2291        l = lptr_opcg3_f_o_aer(isize,itype,iphase)
2292        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_f_o_a,jtotal,ibin)*conv1b
2293        l = lptr_opcg4_f_o_aer(isize,itype,iphase)
2294        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_f_o_a,jtotal,ibin)*conv1b
2295        l = lptr_opcg5_f_o_aer(isize,itype,iphase)
2296        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_f_o_a,jtotal,ibin)*conv1b
2297        l = lptr_opcg6_f_o_aer(isize,itype,iphase)
2298        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_f_o_a,jtotal,ibin)*conv1b
2299        l = lptr_opcg7_f_o_aer(isize,itype,iphase)
2300        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_f_o_a,jtotal,ibin)*conv1b
2301        l = lptr_opcg8_f_o_aer(isize,itype,iphase)
2302        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_f_o_a,jtotal,ibin)*conv1b
2303
2304        l = lptr_smpa_aer(isize,itype,iphase)
2305        if (l .ge. p1st) rsub(l,k,m) = aer(ismpa_a,jtotal,ibin)*conv1b
2306        l = lptr_smpbb_aer(isize,itype,iphase)
2307        if (l .ge. p1st) rsub(l,k,m) = aer(ismpbb_a,jtotal,ibin)*conv1b
2308        l = lptr_glysoa_r1_aer(isize,itype,iphase)
2309        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_r1_a,jtotal,ibin)*conv1b
2310        l = lptr_glysoa_r2_aer(isize,itype,iphase)
2311        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_r2_a,jtotal,ibin)*conv1b
2312        l = lptr_glysoa_sfc_aer(isize,itype,iphase)
2313        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_sfc_a,jtotal,ibin)*conv1b
2314        l = lptr_glysoa_nh4_aer(isize,itype,iphase)
2315        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_nh4_a,jtotal,ibin)*conv1b
2316        l = lptr_glysoa_oh_aer(isize,itype,iphase)
2317        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_oh_a,jtotal,ibin)*conv1b
2318
2319        l = lptr_ant1_c_aer(isize,itype,iphase)
2320        if (l .ge. p1st) rsub(l,k,m) = aer(iant1_c_a,jtotal,ibin)*conv1b
2321        l = lptr_ant2_c_aer(isize,itype,iphase)
2322        if (l .ge. p1st) rsub(l,k,m) = aer(iant2_c_a,jtotal,ibin)*conv1b
2323        l = lptr_ant3_c_aer(isize,itype,iphase)
2324        if (l .ge. p1st) rsub(l,k,m) = aer(iant3_c_a,jtotal,ibin)*conv1b
2325        l = lptr_ant4_c_aer(isize,itype,iphase)
2326        if (l .ge. p1st) rsub(l,k,m) = aer(iant4_c_a,jtotal,ibin)*conv1b
2327        l = lptr_ant1_o_aer(isize,itype,iphase)
2328        if (l .ge. p1st) rsub(l,k,m) = aer(iant1_o_a,jtotal,ibin)*conv1b
2329        l = lptr_ant2_o_aer(isize,itype,iphase)
2330        if (l .ge. p1st) rsub(l,k,m) = aer(iant2_o_a,jtotal,ibin)*conv1b
2331        l = lptr_ant3_o_aer(isize,itype,iphase)
2332        if (l .ge. p1st) rsub(l,k,m) = aer(iant3_o_a,jtotal,ibin)*conv1b
2333        l = lptr_ant4_o_aer(isize,itype,iphase)
2334        if (l .ge. p1st) rsub(l,k,m) = aer(iant4_o_a,jtotal,ibin)*conv1b
2335        l = lptr_biog1_c_aer(isize,itype,iphase)
2336        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog1_c_a,jtotal,ibin)*conv1b
2337        l = lptr_biog2_c_aer(isize,itype,iphase)
2338        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog2_c_a,jtotal,ibin)*conv1b
2339        l = lptr_biog3_c_aer(isize,itype,iphase)
2340        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog3_c_a,jtotal,ibin)*conv1b
2341        l = lptr_biog4_c_aer(isize,itype,iphase)
2342        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog4_c_a,jtotal,ibin)*conv1b
2343        l = lptr_biog1_o_aer(isize,itype,iphase)
2344        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog1_o_a,jtotal,ibin)*conv1b
2345        l = lptr_biog2_o_aer(isize,itype,iphase)
2346        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog2_o_a,jtotal,ibin)*conv1b
2347        l = lptr_biog3_o_aer(isize,itype,iphase)
2348        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog3_o_a,jtotal,ibin)*conv1b
2349        l = lptr_biog4_o_aer(isize,itype,iphase)
2350        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog4_o_a,jtotal,ibin)*conv1b
2351
2352        l = lptr_asoaX_aer(isize,itype,iphase)
2353        if (l .ge. p1st) rsub(l,k,m) = aer(iasoaX_a,jtotal,ibin)*conv1b
2354        l = lptr_asoa1_aer(isize,itype,iphase)
2355        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa1_a,jtotal,ibin)*conv1b
2356        l = lptr_asoa2_aer(isize,itype,iphase)
2357        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa2_a,jtotal,ibin)*conv1b
2358        l = lptr_asoa3_aer(isize,itype,iphase)
2359        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa3_a,jtotal,ibin)*conv1b
2360        l = lptr_asoa4_aer(isize,itype,iphase)
2361        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa4_a,jtotal,ibin)*conv1b
2362        l = lptr_bsoaX_aer(isize,itype,iphase)
2363        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoaX_a,jtotal,ibin)*conv1b
2364        l = lptr_bsoa1_aer(isize,itype,iphase)
2365        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa1_a,jtotal,ibin)*conv1b
2366        l = lptr_bsoa2_aer(isize,itype,iphase)
2367        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa2_a,jtotal,ibin)*conv1b
2368        l = lptr_bsoa3_aer(isize,itype,iphase)
2369        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa3_a,jtotal,ibin)*conv1b
2370        l = lptr_bsoa4_aer(isize,itype,iphase)
2371        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa4_a,jtotal,ibin)*conv1b
2372
2373
2374
2375
2376         l = hyswptr_aer(isize,itype)
2377         if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
2378
2379         l = waterptr_aer(isize,itype)
2380         if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
2381
2382         l = numptr_aer(isize,itype,iphase)
2383         if (l .ge. p1st) rsub(l,k,m) =  num_a(ibin)/cair_mol_cc
2384
2385
2386         drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
2387         if(jaerosolstate(ibin) .eq. no_aerosol) then
2388             drydens_aftgrow(isize,itype) = -1.
2389         else
2390             drydens_aftgrow(isize,itype) = dens_dry_a(ibin)         ! g/cc
2391         end if
2392
2393 20      continue
2394
2395       endif
2396
2397       return
2398       end subroutine map_mosaic_species
2399
2400
2401
2402
2403
2404       subroutine isize_itype_from_ibin( ibin, isize, itype )
2405 !
2406 ! inside of mosaic, the '2d' (isize,itype) indexing is replaced
2407 !     by '1d' (ibin) indexing
2408 ! this routine gives (isize,itype) corresponding to (ibin)
2409 !
2410       use module_data_mosaic_asect
2411       use module_data_mosaic_other, only:  lunerr
2412 !     implicit none
2413
2414 ! subr arguments
2415       integer ibin, isize, itype
2416 ! local variables
2417       integer jdum_bin, jdum_size, jdum_type
2418       character*80 msg
2419
2420       isize = -999888777
2421       itype = -999888777
2422
2423       jdum_bin = 0
2424       do jdum_type = 1, ntype_aer
2425       do jdum_size = 1, nsize_aer(jdum_type)
2426           jdum_bin = jdum_bin + 1
2427           if (ibin .eq. jdum_bin) then
2428               isize = jdum_size
2429               itype = jdum_type
2430           end if
2431       end do
2432       end do
2433
2434       if (isize .le. 0) then
2435           write(msg,'(a,1x,i5)')   &
2436               '*** subr isize_itype_from_ibin - bad ibin =', ibin
2437           call peg_error_fatal( lunerr, msg )
2438       end if
2439
2440       return
2441       end subroutine isize_itype_from_ibin
2442
2443
2444
2445
2446       subroutine overall_massbal_in
2447
2448       use module_data_mosaic_asect
2449       use module_data_mosaic_other
2450
2451 !     implicit none
2452 !     include 'mosaic.h'
2453       integer ibin
2454
2455       tot_so4_in = gas(ih2so4_g)
2456       tot_no3_in = gas(ihno3_g)
2457       tot_cl_in  = gas(ihcl_g)
2458       tot_nh4_in = gas(inh3_g)
2459       tot_na_in  = 0.0
2460       tot_ca_in  = 0.0
2461
2462
2463       do ibin = 1, nbin_a
2464         tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
2465         tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
2466         tot_cl_in  = tot_cl_in  + aer(icl_a, jtotal,ibin)
2467         tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
2468         tot_na_in  = tot_na_in  + aer(ina_a,jtotal,ibin)
2469         tot_ca_in  = tot_ca_in  + aer(ica_a,jtotal,ibin)
2470       enddo
2471
2472
2473         total_species(inh3_g) = tot_nh4_in
2474         total_species(ihno3_g)= tot_no3_in
2475         total_species(ihcl_g) = tot_cl_in
2476
2477
2478       return
2479       end subroutine overall_massbal_in
2480
2481
2482
2483       subroutine overall_massbal_out(mbin)
2484 !     implicit none
2485 !      include 'v33com'
2486 !      include 'v33com3'
2487 !      include 'v33com9a'
2488 !      include 'v33com9b'
2489 !     include 'mosaic.h'
2490
2491 ! subr. agrument
2492       integer mbin
2493 ! local variables
2494       integer ibin
2495
2496
2497
2498         tot_so4_out = gas(ih2so4_g)
2499         tot_no3_out = gas(ihno3_g)
2500         tot_cl_out  = gas(ihcl_g)
2501         tot_nh4_out = gas(inh3_g)
2502         tot_na_out  = 0.0
2503         tot_ca_out  = 0.0
2504
2505         do ibin = 1, nbin_a
2506           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
2507           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
2508           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
2509           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
2510           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
2511           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
2512         enddo
2513
2514         diff_so4 = tot_so4_out - tot_so4_in
2515         diff_no3 = tot_no3_out - tot_no3_in
2516         diff_cl  = tot_cl_out  - tot_cl_in
2517         diff_nh4 = tot_nh4_out - tot_nh4_in
2518         diff_na  = tot_na_out  - tot_na_in
2519         diff_ca  = tot_ca_out  - tot_ca_in
2520
2521
2522         reldiff_so4 = 0.0
2523         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
2524           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
2525         endif
2526
2527         reldiff_no3 = 0.0
2528         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
2529           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
2530         endif
2531
2532         reldiff_cl = 0.0
2533         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
2534           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
2535         endif
2536
2537         reldiff_nh4 = 0.0
2538         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
2539           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
2540         endif
2541
2542         reldiff_na = 0.0
2543         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
2544           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
2545         endif
2546
2547         reldiff_ca = 0.0
2548         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
2549           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
2550         endif
2551
2552
2553
2554       if(  abs(reldiff_so4) .gt. 1.e-4 .or.   &
2555            abs(reldiff_no3) .gt. 1.e-4 .or.   &
2556            abs(reldiff_cl)  .gt. 1.e-4 .or.   &
2557            abs(reldiff_nh4) .gt. 1.e-4 .or.   &
2558            abs(reldiff_na)  .gt. 1.e-4 .or.   &
2559            abs(reldiff_ca)  .gt. 1.e-4)then
2560
2561
2562         if (iprint_mosaic_diag1 .gt. 0) then
2563           if (iprint_input .eq. myes) then
2564             write(6,*)'*** mbin = ', mbin, '  isteps = ', isteps_ASTEM
2565             write(6,*)'reldiff_so4 = ', reldiff_so4
2566             write(6,*)'reldiff_no3 = ', reldiff_no3
2567             write(6,*)'reldiff_cl  = ', reldiff_cl
2568             write(6,*)'reldiff_nh4 = ', reldiff_nh4
2569             write(6,*)'reldiff_na  = ', reldiff_na
2570             write(6,*)'reldiff_ca  = ', reldiff_ca
2571             call print_input
2572             iprint_input = mno
2573           endif
2574         endif
2575
2576       endif
2577
2578
2579       return
2580       end subroutine overall_massbal_out
2581
2582
2583
2584
2585
2586
2587
2588       subroutine print_input
2589
2590       use module_data_mosaic_asect
2591       use module_data_mosaic_other
2592
2593 !     implicit none
2594 !     include 'v33com'
2595 !     include 'v33com3'
2596 !     include 'v33com9a'
2597 !     include 'v33com9b'
2598 !     include 'mosaic.h'
2599 ! subr arguments
2600       integer k, m
2601 ! local variables
2602       integer ibin, iphase, isize, itype
2603       integer ipasstmp, luntmp
2604
2605
2606 ! check for print_input allowed and not already done
2607         if (iprint_mosaic_input_ok .le. 0) return
2608         if (iprint_input .ne. myes) return
2609         iprint_input = mno
2610
2611         k = kclm_aer
2612         m = mclm_aer
2613
2614
2615         tot_so4_out = gas(ih2so4_g)
2616         tot_no3_out = gas(ihno3_g)
2617         tot_cl_out  = gas(ihcl_g)
2618         tot_nh4_out = gas(inh3_g)
2619         tot_na_out  = 0.0
2620         tot_ca_out  = 0.0
2621
2622         do ibin = 1, nbin_a
2623           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
2624           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
2625           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
2626           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
2627           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
2628           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
2629         enddo
2630
2631         diff_so4 = tot_so4_out - tot_so4_in
2632         diff_no3 = tot_no3_out - tot_no3_in
2633         diff_cl  = tot_cl_out  - tot_cl_in
2634         diff_nh4 = tot_nh4_out - tot_nh4_in
2635         diff_na  = tot_na_out  - tot_na_in
2636         diff_ca  = tot_ca_out  - tot_ca_in
2637
2638
2639         reldiff_so4 = 0.0
2640         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
2641           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
2642         endif
2643
2644         reldiff_no3 = 0.0
2645         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
2646           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
2647         endif
2648
2649         reldiff_cl = 0.0
2650         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
2651           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
2652         endif
2653
2654         reldiff_nh4 = 0.0
2655         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
2656           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
2657         endif
2658
2659         reldiff_na = 0.0
2660         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
2661           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
2662         endif
2663
2664         reldiff_ca = 0.0
2665         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
2666           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
2667         endif
2668
2669
2670         do 2900 ipasstmp = 1, 2
2671
2672         if (ipasstmp .eq. 1) then
2673            luntmp = 6     ! write to standard output
2674         else
2675            luntmp = 67    ! write to fort.67
2676 !           goto 2900      ! skip this
2677         endif
2678
2679 ! write to monitor screen
2680           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
2681           write(luntmp,*)'i j k n = ', iclm_aer, jclm_aer, kclm_aer,   &
2682                                   ncorecnt_aer
2683           write(luntmp,*)'relative so4 mass bal = ', reldiff_so4
2684           write(luntmp,*)'relative no3 mass bal = ', reldiff_no3
2685           write(luntmp,*)'relative cl  mass bal = ', reldiff_cl
2686           write(luntmp,*)'relative nh4 mass bal = ', reldiff_nh4
2687           write(luntmp,*)'relative na  mass bal = ', reldiff_na
2688           write(luntmp,*)'relative ca  mass bal = ', reldiff_ca
2689           write(luntmp,*)'inputs:'
2690           write(luntmp,*)'t (k), p (atm), rh (%), cair (mol/cc) = '
2691           write(luntmp,44) t_k, p_atm, rh_pc, cairclm(k)
2692           write(luntmp,*)'gas h2so4, hno3, hcl, nh3 (mol/mol)'
2693           write(luntmp,44)rsub(kh2so4,k,m), rsub(khno3,k,m),   &
2694                           rsub(khcl,k,m), rsub(knh3,k,m)
2695
2696
2697           iphase = ai_phase
2698           ibin = 0
2699           do itype = 1, ntype_aer
2700           do isize = 1, nsize_aer(itype)
2701           ibin = ibin + 1
2702
2703           write(luntmp,44) rsub(lptr_so4_aer(ibin,itype,iphase),k,m),   &
2704                       rsub(lptr_no3_aer(ibin,itype,iphase),k,m),   &
2705                       rsub(lptr_cl_aer(ibin,itype,iphase),k,m),   &
2706                       rsub(lptr_nh4_aer(ibin,itype,iphase),k,m),   &
2707                       rsub(lptr_oc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
2708                       rsub(lptr_co3_aer(ibin,itype,iphase),k,m),   &
2709                       rsub(lptr_msa_aer(ibin,itype,iphase),k,m),   &
2710                       rsub(lptr_bc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
2711                       rsub(lptr_na_aer(ibin,itype,iphase),k,m),   &
2712                       rsub(lptr_ca_aer(ibin,itype,iphase),k,m),   &
2713                       rsub(lptr_oin_aer(ibin,itype,iphase),k,m),           &
2714                       rsub(hyswptr_aer(ibin,itype),k,m),   &
2715                       rsub(waterptr_aer(ibin,itype),k,m),   &
2716                       rsub(numptr_aer(ibin,itype,iphase),k,m)
2717           enddo
2718           enddo
2719
2720           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
2721
2722 2900    continue
2723
2724
2725 44      format(14e20.10)
2726
2727 !c      stop
2728
2729       return
2730       end subroutine print_input
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749 !***********************************************************************
2750 ! checks if aerosol mass is too low to be of any significance
2751 ! and determine jaerosolstate
2752 !
2753 ! author: rahul a. zaveri
2754 ! update: jan 2005
2755 !-----------------------------------------------------------------------
2756       subroutine check_aerosol_mass(ibin)
2757 !     implicit none
2758 !     include 'mosaic.h'
2759 ! subr arguments
2760       integer ibin
2761 ! local variables
2762       integer iaer
2763       real(kind=8) drymass, aer_H
2764
2765       mass_dry_a(ibin) = 0.0
2766
2767       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2768                   aer(ino3_a,jtotal,ibin) +  &
2769                   aer(icl_a,jtotal,ibin)  +  &
2770                   aer(imsa_a,jtotal,ibin) +  &
2771                2.*aer(ico3_a,jtotal,ibin))-  &
2772               (2.*aer(ica_a,jtotal,ibin)  +  &
2773                   aer(ina_a,jtotal,ibin)  +  &
2774                   aer(inh4_a,jtotal,ibin))
2775
2776
2777       do iaer = 1, naer
2778         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
2779                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
2780       enddo
2781       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
2782
2783       drymass = mass_dry_a(ibin)                        ! ng/m^3(air)
2784       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15        ! g/cc(air)
2785
2786       if(drymass .lt. mass_cutoff)then                  ! bin mass is too small
2787         jaerosolstate(ibin) = no_aerosol
2788         jphase(ibin) = 0
2789         if(drymass .eq. 0.)num_a(ibin) = 0.0
2790       endif
2791
2792       return
2793       end subroutine check_aerosol_mass
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805 !***********************************************************************
2806 ! checks and conforms number according to the mass and bin size range
2807 !
2808 ! author: rahul a. zaveri
2809 ! update: jan 2005
2810 !-----------------------------------------------------------------------
2811       subroutine conform_aerosol_number(ibin)
2812
2813       use module_data_mosaic_asect
2814
2815 !     implicit none
2816 !     include 'v33com'
2817 !     include 'v33com3'
2818 !     include 'v33com9a'
2819 !     include 'mosaic.h'
2820 ! subr arguments
2821       integer ibin
2822 ! local variables
2823       integer je, l, iaer, isize, itype
2824       real(kind=8) num_at_dlo, num_at_dhi, numold
2825       real(kind=8) aer_H
2826
2827       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
2828
2829       if(jaerosolstate(ibin) .eq. no_aerosol) return
2830
2831       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2832                   aer(ino3_a,jtotal,ibin) +  &
2833                   aer(icl_a,jtotal,ibin)  +  &
2834                   aer(imsa_a,jtotal,ibin) +  &
2835                2.*aer(ico3_a,jtotal,ibin))-  &
2836               (2.*aer(ica_a,jtotal,ibin)  +  &
2837                   aer(ina_a,jtotal,ibin)  +  &
2838                   aer(inh4_a,jtotal,ibin))
2839
2840       do iaer = 1, naer
2841         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
2842         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)  ! ng/m^3(air)
2843       enddo
2844       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
2845
2846       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15  ! cc(aer)/cc(air)
2847
2848 ! conform number
2849       call isize_itype_from_ibin( ibin, isize, itype )
2850       num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
2851       num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
2852
2853       numold = num_a(ibin)
2854       num_a(ibin) = min(num_a(ibin), num_at_dlo) ! #/cc(air)
2855       num_a(ibin) = max(num_a(ibin), num_at_dhi) ! #/cc(air)
2856
2857 !     if (numold .ne. num_a(ibin)) then
2858 !       write(*,*) 'conform number - i, vol, mass, numold/new', ibin,
2859 !     &       vol_dry_a(ibin), mass_dry_temp, numold, num_a(ibin)
2860 !       write(*,*) 'conform i,j,k', iclm_aer, jclm_aer, kclm_aer
2861 !       if (nsubareas .gt. 0) then
2862 !       write(*,'(a,1pe14.4)') (name(l), rsub(l,kclm_aer,1), l=1,ltot2)
2863 !       else
2864 !       write(*,'(a,1pe14.4)') (name(l), rclm(kclm_aer,l), l=1,ltot2)
2865 !       end if
2866 !      stop
2867 !      end if
2868
2869       return
2870       end subroutine conform_aerosol_number
2871
2872
2873
2874
2875
2876 !***********************************************************************
2877 ! determines phase state of an aerosol bin. includes kelvin effect.
2878 !
2879 ! author: rahul a. zaveri
2880 ! update: jan 2005
2881 !-----------------------------------------------------------------------
2882       subroutine aerosol_phase_state(ibin)
2883 !     implicit none
2884 !     include 'mosaic.h'
2885 ! subr arguments
2886       integer ibin
2887 ! local variables
2888       integer js, je, iaer, iv, iter_kelvin
2889       real(kind=8) ah2o_a_new, rel_err
2890 !     real(kind=8) aerosol_water_up, bin_molality               ! mosaic func
2891       real(kind=8) kelvin_toler, term
2892       real(kind=8) aer_H
2893
2894
2895       ah2o = rh_pc*0.01
2896       ah2o_a(ibin) = ah2o
2897       kelvin(ibin) = 1.0
2898       do iv = 1, ngas_volatile+ngas_het
2899         kel(iv,ibin) = 1.0
2900       enddo
2901
2902       if(rh_pc .le. 99)then
2903         kelvin_toler = 1.e-2
2904       else
2905         kelvin_toler = 1.e-6
2906       endif
2907
2908 ! calculate dry mass and dry volume of a bin
2909       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
2910       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
2911
2912       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2913                   aer(ino3_a,jtotal,ibin) +  &
2914                   aer(icl_a,jtotal,ibin)  +  &
2915                   aer(imsa_a,jtotal,ibin) +  &
2916                2.*aer(ico3_a,jtotal,ibin))-  &
2917               (2.*aer(ica_a,jtotal,ibin)  +  &
2918                   aer(ina_a,jtotal,ibin)  +  &
2919                   aer(inh4_a,jtotal,ibin))
2920
2921       do iaer = 1, naer
2922         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
2923                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
2924         vol_dry_a(ibin)  = vol_dry_a(ibin) +   &
2925         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
2926       enddo
2927       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
2928       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
2929
2930       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
2931       vol_dry_a(ibin)  = vol_dry_a(ibin)*1.e-15                         ! cc(aer)/cc(air) or m^3/m^3(air)
2932
2933 ! wet mass and wet volume
2934       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
2935       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
2936
2937
2938       water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
2939
2940       iter_kelvin = 0
2941
2942 10    iter_kelvin = iter_kelvin + 1
2943       do je = 1, nelectrolyte
2944         molality0(je) = bin_molality(je,ibin)   ! compute ah2o dependent binary molalities
2945       enddo
2946
2947       call mesa(ibin)
2948       if(jaerosolstate(ibin) .eq. all_solid)then
2949         return
2950       endif
2951       if (istat_mosaic_fe1 .lt. 0) return
2952
2953 ! new wet mass and wet volume
2954       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
2955       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
2956
2957       call calculate_kelvin(ibin)
2958
2959       ah2o_a_new = rh_pc*0.01/kelvin(ibin)
2960
2961       rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
2962
2963       if(rel_err .gt. kelvin_toler .and. iter_kelvin.le.10)then
2964         ah2o_a(ibin) = ah2o_a_new
2965         goto 10
2966       endif
2967
2968       if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
2969
2970 ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
2971       do iv = 1,  ngas_volatile+ngas_het
2972         term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/  &
2973                        (8.3144e7*T_K*DpmV(ibin))
2974         kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
2975       enddo
2976
2977
2978       return
2979       end subroutine aerosol_phase_state
2980
2981
2982
2983
2984
2985
2986 !***********************************************************************
2987 ! computes kelvin effect term (kelvin => 1.0)
2988 !
2989 ! author: rahul a. zaveri
2990 ! update: jan 2005
2991 !-----------------------------------------------------------------------
2992       subroutine calculate_kelvin(ibin)
2993 !     implicit none
2994 !     include 'mosaic.h'
2995 ! subr arguments
2996       integer ibin
2997 ! local variables
2998       real(kind=8) term
2999
3000
3001
3002       volume_a(ibin) = vol_wet_a(ibin)                                  ! [cc/cc(air)]
3003       dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.)   ! [cm]
3004       sigma_soln(ibin) = sigma_water + 49.0*(1. - ah2o_a(ibin))         ! [dyn/cm]
3005       term = 72.*sigma_soln(ibin)/(8.3144e7*t_k*dpmv(ibin))             ! [-]
3006 !      kelvin(ibin) = exp(term)
3007       kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
3008
3009
3010       return
3011       end subroutine calculate_kelvin
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027 !***********************************************************************
3028 ! mesa: multicomponent equilibrium solver for aerosols.
3029 ! computes equilibrum solid and liquid phases by integrating
3030 ! pseudo-transient dissolution and precipitation reactions
3031 !
3032 ! author: rahul a. zaveri
3033 ! update: jan 2005
3034 ! update: 21 may 2014 - revised code to force metastable or stable state (upper curve) for RH > 35%
3035 !
3036 !-----------------------------------------------------------------------
3037       subroutine mesa(ibin)     ! touch
3038 !     implicit none
3039 !     include 'mosaic.h'
3040 ! subr arguments
3041       integer ibin
3042
3043 ! local variables
3044       integer idissolved, j_index, jdum, js, je         ! raz update 11/13/2008
3045       real(kind=8) crh, solids, sum_soluble, sum_insoluble, xt
3046 !     real(kind=8) aerosol_water                                ! mosaic func
3047 !     real(kind=8) drh_mutual                                   ! mosaic func
3048       real(kind=8) h_ion, sum_dum                               ! raz update 11/13/2008
3049
3050
3051 ! calculate percent composition ! raz update 11/13/2008
3052       sum_dum = 0.0
3053       do je = 1, nelectrolyte
3054         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
3055       enddo
3056
3057       if(sum_dum .eq. 0.)sum_dum = 1.0
3058
3059       do je = 1, nelectrolyte
3060         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
3061       enddo
3062
3063
3064       call calculate_xt(ibin,jtotal,xt)
3065
3066       crh = 0.35  ! raz-30apr07
3067
3068 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
3069       if( (ah2o_a(ibin) .lt. crh)   .and. &
3070           (xt.gt.1.0 .or. xt.lt.0.) .and. &
3071           (epercent(jcano3,jtotal,ibin) .le. ptol_mol_astem) .and. &
3072           (epercent(jcacl2,jtotal,ibin) .le. ptol_mol_astem) )then     ! raz-30apr07
3073         jaerosolstate(ibin) = all_solid
3074         jphase(ibin)    = jsolid
3075         jhyst_leg(ibin) = jhyst_lo
3076         call adjust_solid_aerosol(ibin)
3077         return
3078       endif
3079
3080
3081 ! step 2: check for supersaturation/metastable state
3082 !     jdum = 1 ! 1 = forced metastable. 0 = maybe stable               ! RAZ 5/21/2014
3083 !     if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin) .or. jdum .eq. 1)then
3084
3085 ! 2017.12.03 water hysteresis changes
3086       if (mhyst_method .eq. mhyst_uporlo_waterhyst) then
3087          jdum = 0
3088          if (water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin)) jdum = 1
3089       else if (mhyst_method .eq. mhyst_force_up) then
3090          jdum = 1
3091       else ! if (mhyst_method .eq. mhyst_force_lo) then
3092          jdum = 0
3093       end if
3094
3095       if (jdum .eq. 1) then
3096
3097         call do_full_deliquescence(ibin)
3098
3099 !       sum_soluble = 0.0
3100 !       do js = 1, nsoluble
3101 !         sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
3102 !       enddo
3103
3104 !       solids = electrolyte(jcaso4,jtotal,ibin) +   &
3105 !                electrolyte(jcaco3,jtotal,ibin) +   &
3106 !                aer(ioin_a ,jtotal,ibin)
3107 !
3108 !
3109 !       if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
3110 !
3111 !         jaerosolstate(ibin) = all_solid ! no soluble material present
3112 !         jphase(ibin) = jsolid
3113 !         call adjust_solid_aerosol(ibin)
3114 !
3115 ! new wet mass and wet volume
3116 !         mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
3117 !         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
3118 !         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
3119 !
3120 !         return
3121 !
3122 !       elseif(sum_soluble .gt. 0.0 .and. solids .eq. 0.0)then
3123
3124           jaerosolstate(ibin) = all_liquid
3125           jhyst_leg(ibin) = jhyst_up
3126           jphase(ibin) = jliquid
3127           water_a(ibin) = aerosol_water(jtotal,ibin)
3128
3129           if(water_a(ibin) .lt. 0.0)then    ! one last attempt to catch bad input
3130             jaerosolstate(ibin) = all_solid ! no soluble material present
3131             jphase(ibin)    = jsolid
3132             jhyst_leg(ibin) = jhyst_lo
3133             call adjust_solid_aerosol(ibin)
3134           else
3135             call adjust_liquid_aerosol(ibin)
3136             call compute_activities(ibin)
3137           endif
3138
3139 ! new wet mass and wet volume
3140           mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
3141           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
3142           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
3143
3144           return
3145
3146 !       endif
3147
3148       endif
3149
3150
3151
3152
3153 ! step 3: diagnose mdrh
3154       if(xt .lt. 1. .and. xt .gt. 0. )goto 10   ! excess sulfate domain - no mdrh exists
3155
3156       jdum = 0
3157       do js = 1, nsalt
3158         jsalt_present(js) = 0                   ! default value - salt absent
3159
3160         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
3161           jsalt_present(js) = 1                 ! salt present
3162           jdum = jdum + jsalt_index(js)
3163         endif
3164       enddo
3165
3166       if(jdum .eq. 0)then
3167         jaerosolstate(ibin) = all_solid ! no significant soluble material present
3168         jphase(ibin) = jsolid
3169         call adjust_solid_aerosol(ibin)
3170         return
3171       endif
3172
3173       if(xt .ge. 2.0 .or. xt .lt. 0.0)then
3174         j_index = jsulf_poor(jdum)
3175       else
3176         j_index = jsulf_rich(jdum)
3177       endif
3178
3179       mdrh(ibin) = mdrh_t(j_index)
3180
3181       if(ah2o_a(ibin)*100. .lt. mdrh(ibin)) then
3182         jaerosolstate(ibin) = all_solid
3183         jphase(ibin) = jsolid
3184         jhyst_leg(ibin) = jhyst_lo
3185         call adjust_solid_aerosol(ibin)
3186         return
3187       endif
3188
3189
3190 ! step 4: none of the above means it must be sub-saturated or mixed-phase
3191 10    call do_full_deliquescence(ibin)
3192       call mesa_ptc(ibin)       ! determines jaerosolstate(ibin)
3193       if (istat_mosaic_fe1 .lt. 0) return
3194
3195
3196
3197       return
3198       end subroutine mesa
3199
3200
3201
3202
3203
3204
3205
3206
3207 !***********************************************************************
3208 ! this subroutine completely deliquesces an aerosol and partitions
3209 ! all the soluble electrolytes into the liquid phase and insoluble
3210 ! ones into the solid phase. it also calculates the corresponding
3211 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
3212 ! concentrations
3213 !
3214 ! author: rahul a. zaveri
3215 ! update: jan 2005
3216 !-----------------------------------------------------------------------
3217       subroutine do_full_deliquescence(ibin)    ! touch
3218 !     implicit none
3219 !     include 'mosaic.h'
3220 ! subr arguments
3221       integer ibin
3222 ! local variables
3223       integer js
3224
3225
3226
3227
3228 ! partition all electrolytes into liquid phase
3229       do js = 1, nelectrolyte
3230        electrolyte(js,jsolid,ibin)  = 0.0
3231        electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
3232       enddo
3233 !
3234 ! except these electrolytes, which always remain in the solid phase
3235       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
3236       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
3237       electrolyte(jcaco3,jliquid,ibin)= 0.0
3238       electrolyte(jcaso4,jliquid,ibin)= 0.0
3239
3240
3241 ! partition all the generic aer species into solid and liquid phases
3242 ! solid phase
3243       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
3244       aer(ino3_a,jsolid,ibin) = 0.0
3245       aer(icl_a, jsolid,ibin) = 0.0
3246       aer(inh4_a,jsolid,ibin) = 0.0
3247       aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
3248       aer(imsa_a,jsolid,ibin) = 0.0
3249       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
3250       aer(ina_a, jsolid,ibin) = 0.0
3251       aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) +   &
3252                                 electrolyte(jcaso4,jsolid,ibin)
3253       aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
3254       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
3255       aer(ipcg1_b_c_a,jsolid,ibin)= aer(ipcg1_b_c_a,jtotal,ibin)
3256       aer(ipcg2_b_c_a,jsolid,ibin)= aer(ipcg2_b_c_a,jtotal,ibin)
3257       aer(ipcg3_b_c_a,jsolid,ibin)= aer(ipcg3_b_c_a,jtotal,ibin)
3258       aer(ipcg4_b_c_a,jsolid,ibin)= aer(ipcg4_b_c_a,jtotal,ibin)
3259       aer(ipcg5_b_c_a,jsolid,ibin)= aer(ipcg5_b_c_a,jtotal,ibin)
3260       aer(ipcg6_b_c_a,jsolid,ibin)= aer(ipcg6_b_c_a,jtotal,ibin)
3261       aer(ipcg7_b_c_a,jsolid,ibin)= aer(ipcg7_b_c_a,jtotal,ibin)
3262       aer(ipcg8_b_c_a,jsolid,ibin)= aer(ipcg8_b_c_a,jtotal,ibin)
3263       aer(ipcg9_b_c_a,jsolid,ibin)= aer(ipcg9_b_c_a,jtotal,ibin)
3264       aer(ipcg1_b_o_a,jsolid,ibin)= aer(ipcg1_b_o_a,jtotal,ibin)
3265       aer(ipcg2_b_o_a,jsolid,ibin)= aer(ipcg2_b_o_a,jtotal,ibin)
3266       aer(ipcg3_b_o_a,jsolid,ibin)= aer(ipcg3_b_o_a,jtotal,ibin)
3267       aer(ipcg4_b_o_a,jsolid,ibin)= aer(ipcg4_b_o_a,jtotal,ibin)
3268       aer(ipcg5_b_o_a,jsolid,ibin)= aer(ipcg5_b_o_a,jtotal,ibin)
3269       aer(ipcg6_b_o_a,jsolid,ibin)= aer(ipcg6_b_o_a,jtotal,ibin)
3270       aer(ipcg7_b_o_a,jsolid,ibin)= aer(ipcg7_b_o_a,jtotal,ibin)
3271       aer(ipcg8_b_o_a,jsolid,ibin)= aer(ipcg8_b_o_a,jtotal,ibin)
3272       aer(ipcg9_b_o_a,jsolid,ibin)= aer(ipcg9_b_o_a,jtotal,ibin)
3273       aer(iopcg1_b_c_a,jsolid,ibin)= aer(iopcg1_b_c_a,jtotal,ibin)
3274       aer(iopcg2_b_c_a,jsolid,ibin)= aer(iopcg2_b_c_a,jtotal,ibin)
3275       aer(iopcg3_b_c_a,jsolid,ibin)= aer(iopcg3_b_c_a,jtotal,ibin)
3276       aer(iopcg4_b_c_a,jsolid,ibin)= aer(iopcg4_b_c_a,jtotal,ibin)
3277       aer(iopcg5_b_c_a,jsolid,ibin)= aer(iopcg5_b_c_a,jtotal,ibin)
3278       aer(iopcg6_b_c_a,jsolid,ibin)= aer(iopcg6_b_c_a,jtotal,ibin)
3279       aer(iopcg7_b_c_a,jsolid,ibin)= aer(iopcg7_b_c_a,jtotal,ibin)
3280       aer(iopcg8_b_c_a,jsolid,ibin)= aer(iopcg8_b_c_a,jtotal,ibin)
3281       aer(iopcg1_b_o_a,jsolid,ibin)= aer(iopcg1_b_o_a,jtotal,ibin)
3282       aer(iopcg2_b_o_a,jsolid,ibin)= aer(iopcg2_b_o_a,jtotal,ibin)
3283       aer(iopcg3_b_o_a,jsolid,ibin)= aer(iopcg3_b_o_a,jtotal,ibin)
3284       aer(iopcg4_b_o_a,jsolid,ibin)= aer(iopcg4_b_o_a,jtotal,ibin)
3285       aer(iopcg5_b_o_a,jsolid,ibin)= aer(iopcg5_b_o_a,jtotal,ibin)
3286       aer(iopcg6_b_o_a,jsolid,ibin)= aer(iopcg6_b_o_a,jtotal,ibin)
3287       aer(iopcg7_b_o_a,jsolid,ibin)= aer(iopcg7_b_o_a,jtotal,ibin)
3288       aer(iopcg8_b_o_a,jsolid,ibin)= aer(iopcg8_b_o_a,jtotal,ibin)
3289       aer(ipcg1_f_c_a,jsolid,ibin)= aer(ipcg1_f_c_a,jtotal,ibin)
3290       aer(ipcg2_f_c_a,jsolid,ibin)= aer(ipcg2_f_c_a,jtotal,ibin)
3291       aer(ipcg3_f_c_a,jsolid,ibin)= aer(ipcg3_f_c_a,jtotal,ibin)
3292       aer(ipcg4_f_c_a,jsolid,ibin)= aer(ipcg4_f_c_a,jtotal,ibin)
3293       aer(ipcg5_f_c_a,jsolid,ibin)= aer(ipcg5_f_c_a,jtotal,ibin)
3294       aer(ipcg6_f_c_a,jsolid,ibin)= aer(ipcg6_f_c_a,jtotal,ibin)
3295       aer(ipcg7_f_c_a,jsolid,ibin)= aer(ipcg7_f_c_a,jtotal,ibin)
3296       aer(ipcg8_f_c_a,jsolid,ibin)= aer(ipcg8_f_c_a,jtotal,ibin)
3297       aer(ipcg9_f_c_a,jsolid,ibin)= aer(ipcg9_f_c_a,jtotal,ibin)
3298       aer(ipcg1_f_o_a,jsolid,ibin)= aer(ipcg1_f_o_a,jtotal,ibin)
3299       aer(ipcg2_f_o_a,jsolid,ibin)= aer(ipcg2_f_o_a,jtotal,ibin)
3300       aer(ipcg3_f_o_a,jsolid,ibin)= aer(ipcg3_f_o_a,jtotal,ibin)
3301       aer(ipcg4_f_o_a,jsolid,ibin)= aer(ipcg4_f_o_a,jtotal,ibin)
3302       aer(ipcg5_f_o_a,jsolid,ibin)= aer(ipcg5_f_o_a,jtotal,ibin)
3303       aer(ipcg6_f_o_a,jsolid,ibin)= aer(ipcg6_f_o_a,jtotal,ibin)
3304       aer(ipcg7_f_o_a,jsolid,ibin)= aer(ipcg7_f_o_a,jtotal,ibin)
3305       aer(ipcg8_f_o_a,jsolid,ibin)= aer(ipcg8_f_o_a,jtotal,ibin)
3306       aer(ipcg9_f_o_a,jsolid,ibin)= aer(ipcg9_f_o_a,jtotal,ibin)
3307       aer(iopcg1_f_c_a,jsolid,ibin)= aer(iopcg1_f_c_a,jtotal,ibin)
3308       aer(iopcg2_f_c_a,jsolid,ibin)= aer(iopcg2_f_c_a,jtotal,ibin)
3309       aer(iopcg3_f_c_a,jsolid,ibin)= aer(iopcg3_f_c_a,jtotal,ibin)
3310       aer(iopcg4_f_c_a,jsolid,ibin)= aer(iopcg4_f_c_a,jtotal,ibin)
3311       aer(iopcg5_f_c_a,jsolid,ibin)= aer(iopcg5_f_c_a,jtotal,ibin)
3312       aer(iopcg6_f_c_a,jsolid,ibin)= aer(iopcg6_f_c_a,jtotal,ibin)
3313       aer(iopcg7_f_c_a,jsolid,ibin)= aer(iopcg7_f_c_a,jtotal,ibin)
3314       aer(iopcg8_f_c_a,jsolid,ibin)= aer(iopcg8_f_c_a,jtotal,ibin)
3315       aer(iopcg1_f_o_a,jsolid,ibin)= aer(iopcg1_f_o_a,jtotal,ibin)
3316       aer(iopcg2_f_o_a,jsolid,ibin)= aer(iopcg2_f_o_a,jtotal,ibin)
3317       aer(iopcg3_f_o_a,jsolid,ibin)= aer(iopcg3_f_o_a,jtotal,ibin)
3318       aer(iopcg4_f_o_a,jsolid,ibin)= aer(iopcg4_f_o_a,jtotal,ibin)
3319       aer(iopcg5_f_o_a,jsolid,ibin)= aer(iopcg5_f_o_a,jtotal,ibin)
3320       aer(iopcg6_f_o_a,jsolid,ibin)= aer(iopcg6_f_o_a,jtotal,ibin)
3321       aer(iopcg7_f_o_a,jsolid,ibin)= aer(iopcg7_f_o_a,jtotal,ibin)
3322       aer(iopcg8_f_o_a,jsolid,ibin)= aer(iopcg8_f_o_a,jtotal,ibin)
3323       aer(ismpa_a,jsolid,ibin)= aer(ismpa_a,jtotal,ibin)
3324       aer(ismpbb_a,jsolid,ibin)= aer(ismpbb_a,jtotal,ibin)
3325       aer(iglysoa_r1_a,jsolid,ibin)= aer(iglysoa_r1_a,jtotal,ibin)
3326       aer(iglysoa_r2_a,jsolid,ibin)= aer(iglysoa_r2_a,jtotal,ibin)
3327       aer(iglysoa_sfc_a,jsolid,ibin)= aer(iglysoa_sfc_a,jtotal,ibin)
3328       aer(iglysoa_nh4_a,jsolid,ibin)= aer(iglysoa_nh4_a,jtotal,ibin)
3329       aer(iglysoa_oh_a,jsolid,ibin)= aer(iglysoa_oh_a,jtotal,ibin)
3330       aer(iant1_c_a,jsolid,ibin)= aer(iant1_c_a,jtotal,ibin)
3331       aer(iant2_c_a,jsolid,ibin)= aer(iant2_c_a,jtotal,ibin)
3332       aer(iant3_c_a,jsolid,ibin)= aer(iant3_c_a,jtotal,ibin)
3333       aer(iant4_c_a,jsolid,ibin)= aer(iant4_c_a,jtotal,ibin)
3334       aer(iant1_o_a,jsolid,ibin)= aer(iant1_o_a,jtotal,ibin)
3335       aer(iant2_o_a,jsolid,ibin)= aer(iant2_o_a,jtotal,ibin)
3336       aer(iant3_o_a,jsolid,ibin)= aer(iant3_o_a,jtotal,ibin)
3337       aer(iant4_o_a,jsolid,ibin)= aer(iant4_o_a,jtotal,ibin)
3338       aer(ibiog1_c_a,jsolid,ibin)= aer(ibiog1_c_a,jtotal,ibin)
3339       aer(ibiog2_c_a,jsolid,ibin)= aer(ibiog2_c_a,jtotal,ibin)
3340       aer(ibiog3_c_a,jsolid,ibin)= aer(ibiog3_c_a,jtotal,ibin)
3341       aer(ibiog4_c_a,jsolid,ibin)= aer(ibiog4_c_a,jtotal,ibin)
3342       aer(ibiog1_o_a,jsolid,ibin)= aer(ibiog1_o_a,jtotal,ibin)
3343       aer(ibiog2_o_a,jsolid,ibin)= aer(ibiog2_o_a,jtotal,ibin)
3344       aer(ibiog3_o_a,jsolid,ibin)= aer(ibiog3_o_a,jtotal,ibin)
3345       aer(ibiog4_o_a,jsolid,ibin)= aer(ibiog4_o_a,jtotal,ibin)
3346       aer(iasoaX_a,jsolid,ibin)= aer(iasoaX_a,jtotal,ibin)
3347       aer(iasoa1_a,jsolid,ibin)= aer(iasoa1_a,jtotal,ibin)
3348       aer(iasoa2_a,jsolid,ibin)= aer(iasoa2_a,jtotal,ibin)
3349       aer(iasoa3_a,jsolid,ibin)= aer(iasoa3_a,jtotal,ibin)
3350       aer(iasoa4_a,jsolid,ibin)= aer(iasoa4_a,jtotal,ibin)
3351       aer(ibsoaX_a,jsolid,ibin)= aer(ibsoaX_a,jtotal,ibin)
3352       aer(ibsoa1_a,jsolid,ibin)= aer(ibsoa1_a,jtotal,ibin)
3353       aer(ibsoa2_a,jsolid,ibin)= aer(ibsoa2_a,jtotal,ibin)
3354       aer(ibsoa3_a,jsolid,ibin)= aer(ibsoa3_a,jtotal,ibin)
3355       aer(ibsoa4_a,jsolid,ibin)= aer(ibsoa4_a,jtotal,ibin)
3356
3357 ! liquid-phase
3358       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) -   &
3359                                  electrolyte(jcaso4,jsolid,ibin)
3360       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
3361       aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
3362       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
3363       aer(ioc_a, jliquid,ibin) = 0.0
3364       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
3365       aer(ico3_a,jliquid,ibin) = 0.0
3366       aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
3367       aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) +   &
3368                                  electrolyte(jcacl2,jtotal,ibin)
3369       aer(ibc_a, jliquid,ibin) = 0.0
3370       aer(ioin_a,jliquid,ibin) = 0.0
3371       aer(ipcg1_b_c_a,jliquid,ibin)= 0.0
3372       aer(ipcg2_b_c_a,jliquid,ibin)= 0.0
3373       aer(ipcg3_b_c_a,jliquid,ibin)= 0.0
3374       aer(ipcg4_b_c_a,jliquid,ibin)= 0.0
3375       aer(ipcg5_b_c_a,jliquid,ibin)= 0.0
3376       aer(ipcg6_b_c_a,jliquid,ibin)= 0.0
3377       aer(ipcg7_b_c_a,jliquid,ibin)= 0.0
3378       aer(ipcg8_b_c_a,jliquid,ibin)= 0.0
3379       aer(ipcg9_b_c_a,jliquid,ibin)= 0.0
3380       aer(ipcg1_b_o_a,jliquid,ibin)= 0.0
3381       aer(ipcg2_b_o_a,jliquid,ibin)= 0.0
3382       aer(ipcg3_b_o_a,jliquid,ibin)= 0.0
3383       aer(ipcg4_b_o_a,jliquid,ibin)= 0.0
3384       aer(ipcg5_b_o_a,jliquid,ibin)= 0.0
3385       aer(ipcg6_b_o_a,jliquid,ibin)= 0.0
3386       aer(ipcg7_b_o_a,jliquid,ibin)= 0.0
3387       aer(ipcg8_b_o_a,jliquid,ibin)= 0.0
3388       aer(ipcg9_b_o_a,jliquid,ibin)= 0.0
3389       aer(iopcg1_b_c_a,jliquid,ibin)= 0.0
3390       aer(iopcg2_b_c_a,jliquid,ibin)= 0.0
3391       aer(iopcg3_b_c_a,jliquid,ibin)= 0.0
3392       aer(iopcg4_b_c_a,jliquid,ibin)= 0.0
3393       aer(iopcg5_b_c_a,jliquid,ibin)= 0.0
3394       aer(iopcg6_b_c_a,jliquid,ibin)= 0.0
3395       aer(iopcg7_b_c_a,jliquid,ibin)= 0.0
3396       aer(iopcg8_b_c_a,jliquid,ibin)= 0.0
3397       aer(iopcg1_b_o_a,jliquid,ibin)= 0.0
3398       aer(iopcg2_b_o_a,jliquid,ibin)= 0.0
3399       aer(iopcg3_b_o_a,jliquid,ibin)= 0.0
3400       aer(iopcg4_b_o_a,jliquid,ibin)= 0.0
3401       aer(iopcg5_b_o_a,jliquid,ibin)= 0.0
3402       aer(iopcg6_b_o_a,jliquid,ibin)= 0.0
3403       aer(iopcg7_b_o_a,jliquid,ibin)= 0.0
3404       aer(iopcg8_b_o_a,jliquid,ibin)= 0.0
3405       aer(ipcg1_f_c_a,jliquid,ibin)= 0.0
3406       aer(ipcg2_f_c_a,jliquid,ibin)= 0.0
3407       aer(ipcg3_f_c_a,jliquid,ibin)= 0.0
3408       aer(ipcg4_f_c_a,jliquid,ibin)= 0.0
3409       aer(ipcg5_f_c_a,jliquid,ibin)= 0.0
3410       aer(ipcg6_f_c_a,jliquid,ibin)= 0.0
3411       aer(ipcg7_f_c_a,jliquid,ibin)= 0.0
3412       aer(ipcg8_f_c_a,jliquid,ibin)= 0.0
3413       aer(ipcg9_f_c_a,jliquid,ibin)= 0.0
3414       aer(ipcg1_f_o_a,jliquid,ibin)= 0.0
3415       aer(ipcg2_f_o_a,jliquid,ibin)= 0.0
3416       aer(ipcg3_f_o_a,jliquid,ibin)= 0.0
3417       aer(ipcg4_f_o_a,jliquid,ibin)= 0.0
3418       aer(ipcg5_f_o_a,jliquid,ibin)= 0.0
3419       aer(ipcg6_f_o_a,jliquid,ibin)= 0.0
3420       aer(ipcg7_f_o_a,jliquid,ibin)= 0.0
3421       aer(ipcg8_f_o_a,jliquid,ibin)= 0.0
3422       aer(ipcg9_f_o_a,jliquid,ibin)= 0.0
3423       aer(iopcg1_f_c_a,jliquid,ibin)= 0.0
3424       aer(iopcg2_f_c_a,jliquid,ibin)= 0.0
3425       aer(iopcg3_f_c_a,jliquid,ibin)= 0.0
3426       aer(iopcg4_f_c_a,jliquid,ibin)= 0.0
3427       aer(iopcg5_f_c_a,jliquid,ibin)= 0.0
3428       aer(iopcg6_f_c_a,jliquid,ibin)= 0.0
3429       aer(iopcg7_f_c_a,jliquid,ibin)= 0.0
3430       aer(iopcg8_f_c_a,jliquid,ibin)= 0.0
3431       aer(iopcg1_f_o_a,jliquid,ibin)= 0.0
3432       aer(iopcg2_f_o_a,jliquid,ibin)= 0.0
3433       aer(iopcg3_f_o_a,jliquid,ibin)= 0.0
3434       aer(iopcg4_f_o_a,jliquid,ibin)= 0.0
3435       aer(iopcg5_f_o_a,jliquid,ibin)= 0.0
3436       aer(iopcg6_f_o_a,jliquid,ibin)= 0.0
3437       aer(iopcg7_f_o_a,jliquid,ibin)= 0.0
3438       aer(iopcg8_f_o_a,jliquid,ibin)= 0.0
3439       aer(ismpa_a,jliquid,ibin)= 0.0
3440       aer(ismpbb_a,jliquid,ibin)= 0.0
3441       aer(iglysoa_r1_a,jliquid,ibin)= 0.0
3442       aer(iglysoa_r2_a,jliquid,ibin)= 0.0
3443       aer(iglysoa_sfc_a,jliquid,ibin)= 0.0
3444       aer(iglysoa_nh4_a,jliquid,ibin)= 0.0
3445       aer(iglysoa_oh_a,jliquid,ibin)= 0.0
3446       aer(iant1_c_a,jliquid,ibin)= 0.0
3447       aer(iant2_c_a,jliquid,ibin)= 0.0
3448       aer(iant3_c_a,jliquid,ibin)= 0.0
3449       aer(iant4_c_a,jliquid,ibin)= 0.0
3450       aer(iant1_o_a,jliquid,ibin)= 0.0
3451       aer(iant2_o_a,jliquid,ibin)= 0.0
3452       aer(iant3_o_a,jliquid,ibin)= 0.0
3453       aer(iant4_o_a,jliquid,ibin)= 0.0
3454       aer(ibiog1_c_a,jliquid,ibin)= 0.0
3455       aer(ibiog2_c_a,jliquid,ibin)= 0.0
3456       aer(ibiog3_c_a,jliquid,ibin)= 0.0
3457       aer(ibiog4_c_a,jliquid,ibin)= 0.0
3458       aer(ibiog1_o_a,jliquid,ibin)= 0.0
3459       aer(ibiog2_o_a,jliquid,ibin)= 0.0
3460       aer(ibiog3_o_a,jliquid,ibin)= 0.0
3461       aer(ibiog4_o_a,jliquid,ibin)= 0.0
3462       aer(iasoaX_a,jliquid,ibin)= 0.0
3463       aer(iasoa1_a,jliquid,ibin)= 0.0
3464       aer(iasoa2_a,jliquid,ibin)= 0.0
3465       aer(iasoa3_a,jliquid,ibin)= 0.0
3466       aer(iasoa4_a,jliquid,ibin)= 0.0
3467       aer(ibsoaX_a,jliquid,ibin)= 0.0
3468       aer(ibsoa1_a,jliquid,ibin)= 0.0
3469       aer(ibsoa2_a,jliquid,ibin)= 0.0
3470       aer(ibsoa3_a,jliquid,ibin)= 0.0
3471       aer(ibsoa4_a,jliquid,ibin)= 0.0
3472
3473
3474
3475
3476
3477       return
3478       end subroutine do_full_deliquescence
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501 !***********************************************************************
3502 ! mesa: multicomponent equilibrium solver for aerosol-phase
3503 ! computes equilibrum solid and liquid phases by integrating
3504 ! pseudo-transient dissolution and precipitation reactions
3505 !
3506 ! author: rahul a. zaveri
3507 ! update: jan 2005
3508 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
3509 !-----------------------------------------------------------------------
3510       subroutine mesa_ptc(ibin)         ! touch
3511 !     implicit none
3512 !     include 'mosaic.h'
3513 ! subr arguments
3514       integer ibin
3515 ! local variables
3516       integer iaer, iconverge, iconverge_flux, iconverge_mass,   &
3517            idissolved, itdum, js, je, jp                        ! raz update 11/13/2008
3518       real(kind=8) tau_p(nsalt), tau_d(nsalt)
3519       real(kind=8) hsalt_min
3520       real(kind=8) phi_prod, alpha_fac, sum_dum         ! raz update 11/13/2008
3521       real(kind=8) aer_H
3522 ! function
3523 !     real(kind=8) aerosol_water
3524
3525
3526
3527 ! initialize
3528       itdum = 0         ! initialize time
3529       hsalt_max = 1.e25
3530
3531
3532
3533       do js = 1, nsalt
3534         hsalt(js)     = 0.0
3535         sat_ratio(js) = 0.0
3536         phi_salt(js)  = 0.0
3537         flux_sl(js)   = 0.0
3538       enddo
3539
3540
3541 ! calculate percent composition ! raz update 11/13/2008
3542       sum_dum = 0.0
3543       do je = 1, nelectrolyte
3544         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
3545       enddo
3546
3547       if(sum_dum .eq. 0.)sum_dum = 1.0
3548
3549       do je = 1, nelectrolyte
3550         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
3551       enddo
3552
3553
3554
3555       do js = 1, nsalt
3556         jsalt_present(js) = 0                   ! default value - salt absent
3557         if(epercent(js,jtotal,ibin) .gt. 1.0)then
3558           jsalt_present(js) = 1                 ! salt present
3559         endif
3560       enddo
3561
3562
3563       mass_dry_a(ibin) = 0.0
3564
3565       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
3566                   aer(ino3_a,jtotal,ibin) +  &
3567                   aer(icl_a,jtotal,ibin)  +  &
3568                   aer(imsa_a,jtotal,ibin) +  &
3569                2.*aer(ico3_a,jtotal,ibin))-  &
3570               (2.*aer(ica_a,jtotal,ibin)  +  &
3571                   aer(ina_a,jtotal,ibin)  +  &
3572                   aer(inh4_a,jtotal,ibin))
3573       aer_H = max(aer_H, 0.0d0)         ! raz update 11/13/2008
3574
3575       do iaer = 1, naer
3576        mass_dry_a(ibin) = mass_dry_a(ibin) +  &
3577           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)        ! [ng/m^3(air)]
3578         vol_dry_a(ibin)  = vol_dry_a(ibin) +  &
3579           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)     ! ncc/m^3(air)
3580       enddo
3581       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
3582       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
3583
3584       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! [g/cc(air)]
3585       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! [cc(aer)/cc(air)]
3586
3587       mass_dry_salt(ibin) = 0.0         ! soluble salts only
3588       do je = 1, nsalt
3589         mass_dry_salt(ibin) = mass_dry_salt(ibin) +  &
3590               electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15     ! g/cc(air)
3591       enddo
3592
3593       nmesa_call = nmesa_call + 1
3594
3595 !----begin pseudo time continuation loop-------------------------------
3596
3597       do 500 itdum = 1, nmax_mesa
3598
3599
3600 ! compute new salt fluxes
3601       call mesa_flux_salt(ibin)
3602       if (istat_mosaic_fe1 .lt. 0) return
3603
3604
3605 ! check convergence
3606       call mesa_convergence_criterion(ibin,      &
3607                                       iconverge_mass,   &
3608                                       iconverge_flux,   &
3609                                       idissolved)
3610
3611       if(iconverge_mass .eq. myes)then
3612         iter_mesa(ibin) = iter_mesa(ibin) + itdum
3613         niter_mesa = niter_mesa + itdum
3614         niter_mesa_max = max(niter_mesa_max, itdum)
3615         jaerosolstate(ibin) = all_solid
3616         call adjust_solid_aerosol(ibin)
3617         jhyst_leg(ibin) = jhyst_lo
3618         growth_factor(ibin) = 1.0
3619         return
3620       elseif(iconverge_flux .eq. myes)then
3621         iter_mesa(ibin) = iter_mesa(ibin)+ itdum
3622         niter_mesa = niter_mesa + itdum
3623         niter_mesa_max = max(niter_mesa_max, itdum)
3624         mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
3625         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3                ! cc(aer)/cc(air) or m^3/m^3(air)
3626         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)         ! mass growth factor
3627
3628         if(idissolved .eq. myes)then
3629           jaerosolstate(ibin) = all_liquid
3630 !          jhyst_leg(ibin) = jhyst_up  ! do this later (to avoid tripping kelvin iterations)
3631         else
3632           jaerosolstate(ibin) = mixed
3633           jhyst_leg(ibin) = jhyst_lo
3634         endif
3635
3636 ! calculate epercent(jsolid) composition in mixed-phase aerosol
3637         sum_dum = 0.0
3638         jp = jsolid
3639         do je = 1, nelectrolyte
3640           electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
3641           sum_dum = sum_dum + electrolyte(je,jp,ibin)
3642         enddo
3643         electrolyte_sum(jp,ibin) = sum_dum
3644         if(sum_dum .eq. 0.)sum_dum = 1.0
3645         do je = 1, nelectrolyte
3646           epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
3647         enddo
3648
3649         return
3650       endif
3651
3652
3653 ! calculate hsalt(js)   ! time step
3654       hsalt_min = 1.e25
3655       do js = 1, nsalt
3656
3657         phi_prod = phi_salt(js) * phi_salt_old(js)
3658
3659         if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
3660           phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/   &
3661                                     alpha_salt(js)
3662         else
3663           phi_bar(js) = 0.0                     ! oscillating, or phi_salt and/or phi_salt_old may be zero
3664         endif
3665
3666         if(phi_bar(js) .lt. 0.0)then            ! good. phi getting lower. maybe able to take bigger alphas
3667           phi_bar(js) = max(phi_bar(js), -10.0D0)
3668           alpha_fac = 3.0*exp(phi_bar(js))
3669           alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9D0)
3670         elseif(phi_bar(js) .gt. 0.0)then        ! bad - phi is getting bigger. so be conservative with alpha
3671            alpha_salt(js) = min(abs(phi_salt(js)), 0.5D0)
3672         else                                    ! very bad - phi is oscillating. be very conservative
3673            alpha_salt(js) = min(abs(phi_salt(js))/3.0, 0.5D0)
3674         endif
3675
3676 !        alpha_salt(js) = max(alpha_salt(js), 0.01D0)
3677
3678         phi_salt_old(js) = phi_salt(js)         ! update old array
3679
3680
3681         if(flux_sl(js) .gt. 0.)then
3682
3683           tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
3684           if(tau_p(js) .eq. 0.0)then
3685             hsalt(js) = 1.e25
3686             flux_sl(js) = 0.0
3687             phi_salt(js)= 0.0
3688           else
3689             hsalt(js) = alpha_salt(js)*tau_p(js)
3690           endif
3691
3692         elseif(flux_sl(js) .lt. 0.)then
3693
3694           tau_p(js) = -eleliquid(js)/flux_sl(js)        ! precipitation time scale
3695           tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
3696           if(tau_p(js) .eq. 0.0)then
3697             hsalt(js) = alpha_salt(js)*tau_d(js)
3698           else
3699             hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
3700           endif
3701
3702         else
3703
3704           hsalt(js) = 1.e25
3705
3706         endif
3707
3708           hsalt_min = min(hsalt(js), hsalt_min)
3709
3710       enddo
3711
3712 !---------------------------------
3713
3714 ! integrate electrolyte(solid)
3715       do js = 1, nsalt
3716         electrolyte(js,jsolid,ibin) =    &
3717                          electrolyte(js,jsolid,ibin)  +   &
3718                          hsalt(js) * flux_sl(js)
3719       enddo
3720
3721
3722 ! compute aer(solid) from electrolyte(solid)
3723       call electrolytes_to_ions(jsolid,ibin)
3724
3725
3726 ! compute new electrolyte(liquid) from mass balance
3727       do iaer = 1, naer
3728         aer(iaer,jliquid,ibin) = aer(iaer,jtotal,ibin) -   &
3729                                        aer(iaer,jsolid,ibin)
3730       enddo
3731
3732 !---------------------------------
3733
3734
3735
3736 500   continue  ! end time continuation loop
3737 !--------------------------------------------------------------------
3738       nmesa_fail = nmesa_fail + 1
3739       iter_mesa(ibin) = iter_mesa(ibin) + itdum
3740       niter_mesa = niter_mesa + itdum
3741       jaerosolstate(ibin) = mixed
3742       jhyst_leg(ibin) = jhyst_lo
3743       mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3      ! g/cc(air)
3744       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
3745       growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)           ! mass growth factor
3746
3747       return
3748       end subroutine mesa_ptc
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759 !***********************************************************************
3760 ! part of mesa: calculates solid-liquid fluxes of soluble salts
3761 !
3762 ! author: rahul a. zaveri
3763 ! update: jan 2005
3764 !-----------------------------------------------------------------------
3765       subroutine mesa_flux_salt(ibin)   ! touch
3766 !     implicit none
3767 !     include 'mosaic.h'
3768 ! subr arguments
3769       integer ibin
3770 ! local variables
3771       integer js, je                                            ! raz update 11/13/2008
3772       real(kind=8) xt, calcium, sum_salt, sum_dum       ! raz update 11/13/2008
3773
3774
3775 ! compute activities and water content
3776       call ions_to_electrolytes(jliquid,ibin,xt)
3777       if (istat_mosaic_fe1 .lt. 0) return
3778       call compute_activities(ibin)
3779       activity(jna3hso4,ibin)   = 0.0
3780
3781       if(water_a(ibin) .le. 0.0)then
3782         do js = 1, nsalt
3783          flux_sl(js) = 0.0
3784         enddo
3785         return
3786       endif
3787
3788
3789       call mesa_estimate_eleliquid(ibin,xt)
3790
3791       calcium = aer(ica_a,jliquid,ibin)
3792
3793
3794
3795 ! calculate percent composition ! raz update 11/13/2008
3796       sum_dum = 0.0
3797       do je = 1, nelectrolyte
3798         sum_dum = sum_dum + electrolyte(je,jliquid,ibin)
3799       enddo
3800
3801       if(sum_dum .eq. 0.)sum_dum = 1.0
3802
3803       do je = 1, nelectrolyte
3804         epercent(je,jliquid,ibin) = 100.*electrolyte(je,jliquid,ibin)/sum_dum
3805       enddo
3806
3807
3808
3809 ! calculate % electrolyte composition in the solid and liquid phases
3810       sum_salt = 0.0
3811       do js = 1, nsalt
3812         sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
3813       enddo
3814       electrolyte_sum(jsolid,ibin) = sum_salt
3815       if(sum_salt .eq. 0.0)sum_salt = 1.0
3816       do js = 1, nsalt
3817         frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
3818         frac_salt_liq(js)   = epercent(js,jliquid,ibin)/100.
3819       enddo
3820
3821
3822
3823 ! compute salt fluxes
3824       do js = 1, nsalt          ! soluble solid salts
3825
3826 ! compute new saturation ratio
3827         sat_ratio(js) = activity(js,ibin)/keq_sl(js)
3828 ! compute relative driving force
3829         phi_salt(js)  = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0D0)
3830
3831 ! check if too little solid-phase salt is trying to dissolve
3832         if(sat_ratio(js)       .lt. 1.00 .and.   &
3833            frac_salt_solid(js) .lt. 0.01 .and.   &
3834            frac_salt_solid(js) .gt. 0.0)then
3835           call mesa_dissolve_small_salt(ibin,js)
3836           call mesa_estimate_eleliquid(ibin,xt)
3837           sat_ratio(js) = activity(js,ibin)/keq_sl(js)
3838         endif
3839
3840 ! compute flux
3841         flux_sl(js) = sat_ratio(js) - 1.0
3842
3843 ! apply heaviside function
3844         if( (sat_ratio(js)               .lt. 1.0 .and.   &
3845              electrolyte(js,jsolid,ibin) .eq. 0.0) .or.   &
3846             (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or.   &
3847             (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
3848           flux_sl(js) = 0.0
3849           phi_salt(js)= 0.0
3850         endif
3851
3852       enddo
3853
3854
3855 ! force cacl2 and cano3 fluxes to zero
3856       sat_ratio(jcano3) = 1.0
3857       phi_salt(jcano3)  = 0.0
3858       flux_sl(jcano3)   = 0.0
3859
3860       sat_ratio(jcacl2) = 1.0
3861       phi_salt(jcacl2)  = 0.0
3862       flux_sl(jcacl2)   = 0.0
3863
3864
3865       return
3866       end subroutine mesa_flux_salt
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879 !***********************************************************************
3880 ! part of mesa: calculates liquid electrolytes from ions
3881 !
3882 ! notes:
3883 !  - this subroutine is to be used for liquid-phase or total-phase only
3884 !  - this sub transfers caso4 and caco3 from liquid to solid phase
3885 !
3886 ! author: rahul a. zaveri
3887 ! update: jan 2005
3888 !-----------------------------------------------------------------------
3889       subroutine mesa_estimate_eleliquid(ibin,xt)       ! touch
3890 !     implicit none
3891 !     include 'mosaic.h'
3892 ! subr arguments
3893       integer ibin, jp
3894       real(kind=8) xt
3895 ! local variables
3896       integer iaer, je, jc, ja, icase
3897       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
3898            f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d,   &
3899            xdum, dum, cat_net
3900       real(kind=8) nc(ncation), na(nanion)
3901       real(kind=8) dum_ca, dum_no3, dum_cl, cano3, cacl2
3902
3903
3904
3905 ! remove negative concentrations, if any
3906       do iaer =  1, naer
3907       aer(iaer,jliquid,ibin) = max(0.0D0, aer(iaer,jliquid,ibin))
3908       enddo
3909
3910
3911 ! calculate sulfate ratio
3912       call calculate_xt(ibin,jliquid,xt)
3913
3914       if(xt .ge. 2.0 .or. xt.lt.0.)then
3915        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
3916       else
3917        icase = 2        ! acidic (acidity is caused by excess so4)
3918       endif
3919
3920
3921 ! initialize to zero
3922       do je = 1, nelectrolyte
3923         eleliquid(je) = 0.0
3924       enddo
3925 !
3926 !---------------------------------------------------------
3927 ! initialize moles of ions depending on the sulfate domain
3928
3929       jp = jliquid
3930
3931       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
3932
3933         dum_ca  = aer(ica_a,jp,ibin)
3934         dum_no3 = aer(ino3_a,jp,ibin)
3935         dum_cl  = aer(icl_a,jp,ibin)
3936
3937         cano3   = min(dum_ca, 0.5*dum_no3)
3938         dum_ca  = max(0.D0, dum_ca - cano3)
3939         dum_no3 = max(0.D0, dum_no3 - 2.*cano3)
3940
3941         cacl2   = min(dum_ca, 0.5*dum_cl)
3942         dum_ca  = max(0.D0, dum_ca - cacl2)
3943         dum_cl  = max(0.D0, dum_cl - 2.*cacl2)
3944
3945         na(ja_hso4)= 0.0
3946         na(ja_so4) = aer(iso4_a,jp,ibin)
3947         na(ja_no3) = aer(ino3_a,jp,ibin)
3948         na(ja_cl)  = aer(icl_a, jp,ibin)
3949         na(ja_msa) = aer(imsa_a,jp,ibin)
3950
3951         nc(jc_ca)  = aer(ica_a, jp,ibin)
3952         nc(jc_na)  = aer(ina_a, jp,ibin)
3953         nc(jc_nh4) = aer(inh4_a,jp,ibin)
3954
3955         cat_net =     &
3956             ( 2.d0*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) ) -  &
3957             ( nc(jc_h)+2.d0*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
3958
3959         if(cat_net .lt. 0.0)then
3960
3961           nc(jc_h) = 0.0
3962
3963         else  ! cat_net must be 0.0 or positive
3964
3965           nc(jc_h) = cat_net
3966
3967         endif
3968
3969
3970 ! now compute equivalent fractions
3971       sum_naza = 0.0
3972       do ja = 1, nanion
3973         sum_naza = sum_naza + na(ja)*za(ja)
3974       enddo
3975
3976       sum_nczc = 0.0
3977       do jc = 1, ncation
3978         sum_nczc = sum_nczc + nc(jc)*zc(jc)
3979       enddo
3980
3981       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
3982         if (iprint_mosaic_diag1 .gt. 0) then
3983           write(6,*)'subroutine mesa_estimate_eleliquid'
3984           write(6,*)'ionic concentrations are zero'
3985           write(6,*)'sum_naza = ', sum_naza
3986           write(6,*)'sum_nczc = ', sum_nczc
3987         endif
3988         return
3989       endif
3990
3991       do ja = 1, nanion
3992         xeq_a(ja) = na(ja)*za(ja)/sum_naza
3993       enddo
3994
3995       do jc = 1, ncation
3996         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
3997       enddo
3998
3999       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
4000       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
4001       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
4002       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
4003       na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
4004
4005       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
4006       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
4007       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
4008       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
4009
4010
4011 ! now compute electrolyte moles
4012       eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) +  &
4013                             xeq_a(ja_so4)*nc_mc(jc_na))/   &
4014                              mw_electrolyte(jna2so4)
4015
4016       eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) +  &
4017                             xeq_a(ja_hso4)*nc_mc(jc_na))/   &
4018                              mw_electrolyte(jnahso4)
4019
4020       eleliquid(jnamsa)  = (xeq_c(jc_na) *na_ma(ja_msa) + &
4021                             xeq_a(ja_msa)*nc_mc(jc_na))/  &
4022                              mw_electrolyte(jnamsa)
4023
4024       eleliquid(jnano3)  = (xeq_c(jc_na) *na_ma(ja_no3) +  &
4025                             xeq_a(ja_no3)*nc_mc(jc_na))/   &
4026                              mw_electrolyte(jnano3)
4027
4028       eleliquid(jnacl)   = (xeq_c(jc_na) *na_ma(ja_cl) +   &
4029                             xeq_a(ja_cl) *nc_mc(jc_na))/   &
4030                              mw_electrolyte(jnacl)
4031
4032       eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) +   &
4033                             xeq_a(ja_so4)*nc_mc(jc_nh4))/   &
4034                              mw_electrolyte(jnh4so4)
4035
4036       eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) +   &
4037                             xeq_a(ja_hso4)*nc_mc(jc_nh4))/   &
4038                              mw_electrolyte(jnh4hso4)
4039
4040       eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_ma(ja_msa) +  &
4041                             xeq_a(ja_msa)*nc_mc(jc_nh4))/   &
4042                              mw_electrolyte(jnh4msa)
4043
4044       eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) +   &
4045                             xeq_a(ja_no3)*nc_mc(jc_nh4))/   &
4046                              mw_electrolyte(jnh4no3)
4047
4048       eleliquid(jnh4cl)  = (xeq_c(jc_nh4)*na_ma(ja_cl) +   &
4049                             xeq_a(ja_cl) *nc_mc(jc_nh4))/  &
4050                              mw_electrolyte(jnh4cl)
4051
4052       eleliquid(jcano3)  = (xeq_c(jc_ca) *na_ma(ja_no3) +  &
4053                             xeq_a(ja_no3)*nc_mc(jc_ca))/   &
4054                              mw_electrolyte(jcano3)
4055
4056       eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_ma(ja_msa) +  &
4057                             xeq_a(ja_msa)*nc_mc(jc_ca))/   &
4058                              mw_electrolyte(jcamsa2)
4059
4060       eleliquid(jcacl2)  = (xeq_c(jc_ca) *na_ma(ja_cl) +   &
4061                             xeq_a(ja_cl) *nc_mc(jc_ca))/   &
4062                              mw_electrolyte(jcacl2)
4063
4064       eleliquid(jh2so4)  = (xeq_c(jc_h)  *na_ma(ja_hso4) + &
4065                             xeq_a(ja_hso4)*nc_mc(jc_h))/   &
4066                              mw_electrolyte(jh2so4)
4067
4068       eleliquid(jhno3)   = (xeq_c(jc_h)  *na_ma(ja_no3) +  &
4069                             xeq_a(ja_no3)*nc_mc(jc_h))/    &
4070                              mw_electrolyte(jhno3)
4071
4072       eleliquid(jhcl)    = (xeq_c(jc_h) *na_ma(ja_cl) +   &
4073                             xeq_a(ja_cl)*nc_mc(jc_h))/    &
4074                              mw_electrolyte(jhcl)
4075
4076       eleliquid(jmsa)    = (xeq_c(jc_h)  *na_ma(ja_msa) + &
4077                             xeq_a(ja_msa)*nc_mc(jc_h))/   &
4078                              mw_electrolyte(jmsa)
4079
4080 !--------------------------------------------------------------------
4081
4082       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
4083
4084         jp = jliquid
4085
4086         store(iso4_a) = aer(iso4_a,jp,ibin)
4087         store(imsa_a) = aer(imsa_a,jp,ibin)
4088         store(inh4_a) = aer(inh4_a,jp,ibin)
4089         store(ina_a)  = aer(ina_a, jp,ibin)
4090         store(ica_a)  = aer(ica_a, jp,ibin)
4091
4092         call form_camsa2(store,jp,ibin)
4093
4094         sum_na_nh4 = store(ina_a) + store(inh4_a)
4095         if(sum_na_nh4 .gt. 0.0)then
4096           f_nh4 = store(inh4_a)/sum_na_nh4
4097           f_na  = store(ina_a)/sum_na_nh4
4098         else
4099           f_nh4 = 0.0
4100           f_na  = 0.0
4101         endif
4102
4103 ! first form msa electrolytes
4104         if(sum_na_nh4 .gt. store(imsa_a))then
4105           eleliquid(jnh4msa) = f_nh4*store(imsa_a)
4106           eleliquid(jnamsa)  = f_na *store(imsa_a)
4107           store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
4108           store(ina_a) = store(ina_a) -eleliquid(jnamsa)  ! remaining na
4109         else
4110           eleliquid(jnh4msa) = store(inh4_a)
4111           eleliquid(jnamsa)  = store(ina_a)
4112           eleliquid(jmsa)    = store(imsa_a) - sum_na_nh4
4113           store(inh4_a)= 0.0  ! remaining nh4
4114           store(ina_a) = 0.0  ! remaining na
4115         endif
4116
4117         if(store(iso4_a).eq.0.0)goto 10
4118
4119         xt_d  = xt
4120         xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
4121         xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
4122
4123         dum = 2.d0*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin)
4124         if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
4125           xnh4_d = 2.*aer(inh4_a,jp,ibin)/   &
4126                   (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
4127         else
4128           xnh4_d = 0.0
4129         endif
4130
4131
4132         if(aer(inh4_a,jp,ibin) .gt. 0.0)then
4133
4134
4135         if(xt_d .ge. xna_d)then
4136           eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
4137
4138           if(xnh4_d .ge. 5./3.)then
4139             eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin)   &
4140                                - 3.*xdum - aer(inh4_a,jp,ibin)
4141             eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin)   &
4142                                - aer(ina_a,jp,ibin)
4143           elseif(xnh4_d .ge. 1.5)then
4144             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
4145             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
4146           elseif(xnh4_d .ge. 1.0)then
4147             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
4148             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
4149             eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
4150           endif
4151
4152         elseif(xt_d .gt. 1.0)then
4153           eleliquid(jnh4so4)  = aer(inh4_a,jp,ibin)/6.
4154           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
4155           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
4156           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/3.
4157           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/3.
4158         elseif(xt_d .le. 1.0)then
4159           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/4.
4160           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/2.
4161           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
4162           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
4163         endif
4164
4165         else
4166
4167         if(xt_d .gt. 1.0)then
4168           eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
4169           eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) -   &
4170                                   aer(ina_a,jp,ibin)
4171         else
4172           eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
4173           eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
4174         endif
4175
4176
4177         endif
4178
4179
4180
4181       endif
4182 !---------------------------------------------------------
4183
4184 10    return
4185       end subroutine mesa_estimate_eleliquid
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196 !***********************************************************************
4197 ! part of mesa: completely dissolves small amounts of soluble salts
4198 !
4199 ! author: rahul a. zaveri
4200 ! update: jan 2005
4201 !-----------------------------------------------------------------------
4202       subroutine mesa_dissolve_small_salt(ibin,js)
4203 !     implicit none
4204 !     include 'mosaic.h'
4205 ! subr arguments
4206       integer ibin, js, jp
4207
4208       jp = jsolid
4209
4210
4211       if(js .eq. jnh4so4)then
4212         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4213                            2.*electrolyte(js,jsolid,ibin)
4214         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4215                               electrolyte(js,jsolid,ibin)
4216
4217         electrolyte(js,jsolid,ibin) = 0.0
4218
4219         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4220                             electrolyte(jnh4cl,jp,ibin)  +   &
4221                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4222                          3.*electrolyte(jlvcite,jp,ibin) +   &
4223                             electrolyte(jnh4hso4,jp,ibin)+   &
4224                             electrolyte(jnh4msa,jp,ibin)
4225
4226         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4227                             electrolyte(jna2so4,jp,ibin) +   &
4228                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4229                             electrolyte(jnahso4,jp,ibin) +   &
4230                             electrolyte(jnh4so4,jp,ibin) +   &
4231                          2.*electrolyte(jlvcite,jp,ibin) +   &
4232                             electrolyte(jnh4hso4,jp,ibin)+   &
4233                             electrolyte(jh2so4,jp,ibin)
4234         return
4235       endif
4236
4237
4238       if(js .eq. jlvcite)then
4239         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4240                            3.*electrolyte(js,jsolid,ibin)
4241         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4242                            2.*electrolyte(js,jsolid,ibin)
4243
4244         electrolyte(js,jsolid,ibin) = 0.0
4245
4246         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4247                             electrolyte(jnh4cl,jp,ibin)  +   &
4248                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4249                          3.*electrolyte(jlvcite,jp,ibin) +   &
4250                             electrolyte(jnh4hso4,jp,ibin)+   &
4251                             electrolyte(jnh4msa,jp,ibin)
4252
4253         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4254                             electrolyte(jna2so4,jp,ibin) +   &
4255                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4256                             electrolyte(jnahso4,jp,ibin) +   &
4257                             electrolyte(jnh4so4,jp,ibin) +   &
4258                          2.*electrolyte(jlvcite,jp,ibin) +   &
4259                             electrolyte(jnh4hso4,jp,ibin)+   &
4260                             electrolyte(jh2so4,jp,ibin)
4261         return
4262       endif
4263
4264
4265       if(js .eq. jnh4hso4)then
4266         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4267                               electrolyte(js,jsolid,ibin)
4268         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4269                              electrolyte(js,jsolid,ibin)
4270
4271         electrolyte(js,jsolid,ibin) = 0.0
4272
4273         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4274                             electrolyte(jnh4cl,jp,ibin)  +   &
4275                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4276                          3.*electrolyte(jlvcite,jp,ibin) +   &
4277                             electrolyte(jnh4hso4,jp,ibin)+   &
4278                             electrolyte(jnh4msa,jp,ibin)
4279
4280         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4281                             electrolyte(jna2so4,jp,ibin) +   &
4282                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4283                             electrolyte(jnahso4,jp,ibin) +   &
4284                             electrolyte(jnh4so4,jp,ibin) +   &
4285                          2.*electrolyte(jlvcite,jp,ibin) +   &
4286                             electrolyte(jnh4hso4,jp,ibin)+   &
4287                             electrolyte(jh2so4,jp,ibin)
4288         return
4289       endif
4290
4291
4292       if(js .eq. jna2so4)then
4293         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4294                            2.*electrolyte(js,jsolid,ibin)
4295         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4296                               electrolyte(js,jsolid,ibin)
4297
4298         electrolyte(js,jsolid,ibin) = 0.0
4299
4300         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4301                             electrolyte(jnacl,jp,ibin)   +   &
4302                          2.*electrolyte(jna2so4,jp,ibin) +   &
4303                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4304                             electrolyte(jnahso4,jp,ibin) +   &
4305                             electrolyte(jnamsa,jp,ibin)
4306
4307         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4308                             electrolyte(jna2so4,jp,ibin) +   &
4309                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4310                             electrolyte(jnahso4,jp,ibin) +   &
4311                             electrolyte(jnh4so4,jp,ibin) +   &
4312                          2.*electrolyte(jlvcite,jp,ibin) +   &
4313                             electrolyte(jnh4hso4,jp,ibin)+   &
4314                             electrolyte(jh2so4,jp,ibin)
4315         return
4316       endif
4317
4318
4319       if(js .eq. jna3hso4)then
4320         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4321                            3.*electrolyte(js,jsolid,ibin)
4322         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4323                            2.*electrolyte(js,jsolid,ibin)
4324
4325         electrolyte(js,jsolid,ibin) = 0.0
4326
4327         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4328                             electrolyte(jnacl,jp,ibin)   +   &
4329                          2.*electrolyte(jna2so4,jp,ibin) +   &
4330                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4331                             electrolyte(jnahso4,jp,ibin) +   &
4332                             electrolyte(jnamsa,jp,ibin)
4333
4334         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4335                             electrolyte(jna2so4,jp,ibin) +   &
4336                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4337                             electrolyte(jnahso4,jp,ibin) +   &
4338                             electrolyte(jnh4so4,jp,ibin) +   &
4339                          2.*electrolyte(jlvcite,jp,ibin) +   &
4340                             electrolyte(jnh4hso4,jp,ibin)+   &
4341                             electrolyte(jh2so4,jp,ibin)
4342         return
4343       endif
4344
4345
4346       if(js .eq. jnahso4)then
4347         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4348                               electrolyte(js,jsolid,ibin)
4349         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4350                               electrolyte(js,jsolid,ibin)
4351
4352         electrolyte(js,jsolid,ibin) = 0.0
4353
4354         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4355                             electrolyte(jnacl,jp,ibin)   +   &
4356                          2.*electrolyte(jna2so4,jp,ibin) +   &
4357                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4358                             electrolyte(jnahso4,jp,ibin) +   &
4359                             electrolyte(jnamsa,jp,ibin)
4360
4361         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4362                             electrolyte(jna2so4,jp,ibin) +   &
4363                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4364                             electrolyte(jnahso4,jp,ibin) +   &
4365                             electrolyte(jnh4so4,jp,ibin) +   &
4366                          2.*electrolyte(jlvcite,jp,ibin) +   &
4367                             electrolyte(jnh4hso4,jp,ibin)+   &
4368                             electrolyte(jh2so4,jp,ibin)
4369         return
4370       endif
4371
4372
4373       if(js .eq. jnh4no3)then
4374         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4375                               electrolyte(js,jsolid,ibin)
4376         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4377                               electrolyte(js,jsolid,ibin)
4378
4379         electrolyte(js,jsolid,ibin) = 0.0
4380
4381         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4382                             electrolyte(jnh4cl,jp,ibin)  +   &
4383                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4384                          3.*electrolyte(jlvcite,jp,ibin) +   &
4385                             electrolyte(jnh4hso4,jp,ibin)+   &
4386                             electrolyte(jnh4msa,jp,ibin)
4387
4388         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4389                          2.*electrolyte(jcano3,jp,ibin)  +   &
4390                             electrolyte(jnh4no3,jp,ibin) +   &
4391                             electrolyte(jhno3,jp,ibin)
4392         return
4393       endif
4394
4395
4396       if(js .eq. jnh4cl)then
4397         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4398                               electrolyte(js,jsolid,ibin)
4399         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
4400                               electrolyte(js,jsolid,ibin)
4401
4402         electrolyte(js,jsolid,ibin) = 0.0
4403
4404         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4405                             electrolyte(jnh4cl,jp,ibin)  +   &
4406                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4407                          3.*electrolyte(jlvcite,jp,ibin) +   &
4408                             electrolyte(jnh4hso4,jp,ibin)+   &
4409                             electrolyte(jnh4msa,jp,ibin)
4410
4411         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4412                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4413                             electrolyte(jnh4cl,jp,ibin)  +   &
4414                             electrolyte(jhcl,jp,ibin)
4415         return
4416       endif
4417
4418
4419       if(js .eq. jnano3)then
4420         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4421                               electrolyte(js,jsolid,ibin)
4422         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4423                               electrolyte(js,jsolid,ibin)
4424
4425         electrolyte(js,jsolid,ibin) = 0.0
4426
4427         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4428                             electrolyte(jnacl,jp,ibin)   +   &
4429                          2.*electrolyte(jna2so4,jp,ibin) +   &
4430                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4431                             electrolyte(jnahso4,jp,ibin) +   &
4432                             electrolyte(jnamsa,jp,ibin)
4433
4434         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4435                          2.*electrolyte(jcano3,jp,ibin)  +   &
4436                             electrolyte(jnh4no3,jp,ibin) +   &
4437                             electrolyte(jhno3,jp,ibin)
4438         return
4439       endif
4440
4441
4442       if(js .eq. jnacl)then
4443         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4444                               electrolyte(js,jsolid,ibin)
4445         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
4446                               electrolyte(js,jsolid,ibin)
4447
4448         electrolyte(js,jsolid,ibin) = 0.0
4449
4450         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4451                             electrolyte(jnacl,jp,ibin)   +   &
4452                          2.*electrolyte(jna2so4,jp,ibin) +   &
4453                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4454                             electrolyte(jnahso4,jp,ibin) +   &
4455                             electrolyte(jnamsa,jp,ibin)
4456
4457         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4458                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4459                             electrolyte(jnh4cl,jp,ibin)  +   &
4460                             electrolyte(jhcl,jp,ibin)
4461         return
4462       endif
4463
4464
4465       if(js .eq. jcano3)then
4466         aer(ica_a,jliquid,ibin)  = aer(ica_a,jliquid,ibin) +   &
4467                               electrolyte(js,jsolid,ibin)
4468         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4469                             2.*electrolyte(js,jsolid,ibin)
4470
4471         electrolyte(js,jsolid,ibin) = 0.0
4472
4473         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
4474                             electrolyte(jcano3,jp,ibin)  +   &
4475                             electrolyte(jcacl2,jp,ibin)  +   &
4476                             electrolyte(jcaco3,jp,ibin)  +   &
4477                             electrolyte(jcamsa2,jp,ibin)
4478
4479         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4480                          2.*electrolyte(jcano3,jp,ibin)  +   &
4481                             electrolyte(jnh4no3,jp,ibin) +   &
4482                             electrolyte(jhno3,jp,ibin)
4483         return
4484       endif
4485
4486
4487       if(js .eq. jcacl2)then
4488         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) +   &
4489                               electrolyte(js,jsolid,ibin)
4490         aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) +   &
4491                             2.*electrolyte(js,jsolid,ibin)
4492
4493         electrolyte(js,jsolid,ibin) = 0.0
4494
4495         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
4496                             electrolyte(jcano3,jp,ibin)  +   &
4497                             electrolyte(jcacl2,jp,ibin)  +   &
4498                             electrolyte(jcaco3,jp,ibin)  +   &
4499                             electrolyte(jcamsa2,jp,ibin)
4500
4501         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4502                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4503                             electrolyte(jnh4cl,jp,ibin)  +   &
4504                             electrolyte(jhcl,jp,ibin)
4505         return
4506       endif
4507
4508
4509
4510       return
4511       end subroutine mesa_dissolve_small_salt
4512
4513
4514
4515
4516
4517
4518 !***********************************************************************
4519 ! part of mesa: checks mesa convergence
4520 !
4521 ! author: rahul a. zaveri
4522 ! update: jan 2005
4523 !         Oct 2009: William.Gustafson@pnl.gov - zero salt bug fixed
4524 !-----------------------------------------------------------------------
4525       subroutine mesa_convergence_criterion(ibin,  &  ! touch
4526                                        iconverge_mass,    &
4527                                        iconverge_flux,    &
4528                                        idissolved)
4529 !     implicit none
4530 !     include 'mosaic.h'
4531 ! subr arguments
4532       integer ibin, iconverge_mass, iconverge_flux, idissolved
4533 ! local variables
4534       integer je, js, iaer
4535       real(kind=8) mass_solid, mass_solid_salt, frac_solid, xt, h_ion, &
4536            crustal_solids, sumflux
4537
4538
4539       idissolved = mno          ! default = not completely dissolved
4540
4541 ! check mass convergence
4542       iconverge_mass = mno      ! default value = no convergence
4543
4544 !      call electrolytes_to_ions(jsolid,ibin)
4545 !      mass_solid = 0.0
4546 !      do iaer = 1, naer
4547 !        mass_solid = mass_solid +   &
4548 !                     aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15     ! g/cc(air)
4549 !      enddo
4550
4551       mass_solid_salt = 0.0
4552       do je = 1, nsalt
4553         mass_solid_salt = mass_solid_salt + &
4554              electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15      ! g/cc(air)
4555       enddo
4556
4557
4558
4559 !      frac_solid = mass_solid/mass_dry_a(ibin)
4560
4561 !!$      frac_solid = mass_solid_salt/mass_dry_salt(ibin)
4562 !!$
4563 !!$      if(frac_solid .ge. 0.98)then
4564 !!$        iconverge_mass = myes
4565 !!$        return
4566 !!$      endif
4567 !beg: Modified above logic to handle zero salts, wig 28-Oct-2009
4568 ! If mass of salts is zero, then this will force jaerosolstate to solid
4569 ! in mesa_ptc.
4570       if( mass_dry_salt(ibin) < 1e-30 ) then
4571          iconverge_mass = myes
4572          return
4573       else
4574          frac_solid = mass_solid_salt/mass_dry_salt(ibin)
4575          if(frac_solid .ge. 0.98)then
4576             iconverge_mass = myes
4577             return
4578          endif
4579       end if
4580 !end wig
4581
4582 ! check relative driving force convergence
4583       iconverge_flux = myes
4584       do js = 1, nsalt
4585         if(abs(phi_salt(js)).gt. rtol_mesa)then
4586           iconverge_flux = mno
4587           return
4588         endif
4589       enddo
4590
4591
4592
4593 ! check if all the fluxes are zero
4594
4595       sumflux = 0.0
4596       do js = 1, nsalt
4597         sumflux = sumflux + abs(flux_sl(js))
4598       enddo
4599
4600 ! 2017.12.03 implement xhyst_up_crustal_thresh
4601 !     crustal_solids = electrolyte(jcaco3,jsolid,ibin) +  &
4602 !                      electrolyte(jcaso4,jsolid,ibin) +  &
4603 !                      aer(ioin_a,jsolid,ibin)
4604       crustal_solids = electrolyte(jcaco3,jsolid,ibin)*mw_electrolyte(jcaco3) +  &
4605                        electrolyte(jcaso4,jsolid,ibin)*mw_electrolyte(jcaso4) +  &
4606                        aer(ioin_a,jsolid,ibin)*mw_aer_mac(ioin_a)
4607
4608 !     if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
4609       if ( sumflux .eq. 0.0 .and. &
4610            crustal_solids .le. xhyst_up_crustal_thresh*(mass_dry_a(ibin)*1.0e15) ) then
4611          ! crustal_solids is ng/m^3, mass_dry_a is g/cm^3
4612         idissolved = myes
4613       endif
4614
4615
4616
4617       return
4618       end subroutine mesa_convergence_criterion
4619
4620
4621
4622
4623
4624
4625
4626
4627 !***********************************************************************
4628 ! called when aerosol bin is completely solid.
4629 !
4630 ! author: rahul a. zaveri
4631 ! update: jan 2005
4632 !-----------------------------------------------------------------------
4633       subroutine adjust_solid_aerosol(ibin)
4634 !     implicit none
4635 !     include 'mosaic.h'
4636 ! subr arguments
4637       integer ibin
4638 ! local variables
4639       integer iaer, je
4640
4641
4642       jphase(ibin)    = jsolid
4643       jhyst_leg(ibin) = jhyst_lo        ! lower curve
4644       water_a(ibin)   = 0.0
4645
4646 ! transfer aer(jtotal) to aer(jsolid)
4647       do iaer = 1, naer
4648         aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
4649         aer(iaer, jliquid,ibin) = 0.0
4650       enddo
4651
4652 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
4653       do je = 1, nelectrolyte
4654         electrolyte(je,jliquid,ibin) = 0.0
4655         epercent(je,jliquid,ibin)    = 0.0
4656         electrolyte(je,jsolid,ibin)  = electrolyte(je,jtotal,ibin)
4657         epercent(je,jsolid,ibin)     = epercent(je,jtotal,ibin)
4658       enddo
4659
4660 ! update aer(jtotal) that may have been affected above
4661       aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
4662       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
4663       aer(icl_a,jtotal,ibin)  = aer(icl_a,jsolid,ibin)
4664
4665 ! update electrolyte(jtotal)
4666       do je = 1, nelectrolyte
4667         electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
4668         epercent(je,jtotal,ibin)    = epercent(je,jsolid,ibin)
4669       enddo
4670
4671       return
4672       end subroutine adjust_solid_aerosol
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682 !***********************************************************************
4683 ! called when aerosol bin is completely liquid.
4684 !
4685 ! author: rahul a. zaveri
4686 ! update: jan 2005
4687 !-----------------------------------------------------------------------
4688       subroutine adjust_liquid_aerosol(ibin)
4689 !     implicit none
4690 !     include 'mosaic.h'
4691 ! subr arguments
4692       integer ibin
4693 ! local variables
4694       integer je
4695
4696
4697
4698
4699       jphase(ibin)    = jliquid
4700       jhyst_leg(ibin) = jhyst_up        ! upper curve
4701
4702 ! partition all electrolytes into liquid phase
4703       do je = 1, nelectrolyte
4704         electrolyte(je,jsolid,ibin)  = 0.0
4705         epercent(je,jsolid,ibin)     = 0.0
4706         electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
4707         epercent(je,jliquid,ibin)    = epercent(je,jtotal,ibin)
4708       enddo
4709 ! except these electrolytes, which always remain in the solid phase
4710       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
4711       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
4712       epercent(jcaco3,jsolid,ibin)    = epercent(jcaco3,jtotal,ibin)
4713       epercent(jcaso4,jsolid,ibin)    = epercent(jcaso4,jtotal,ibin)
4714       electrolyte(jcaco3,jliquid,ibin)= 0.0
4715       electrolyte(jcaso4,jliquid,ibin)= 0.0
4716       epercent(jcaco3,jliquid,ibin)   = 0.0
4717       epercent(jcaso4,jliquid,ibin)   = 0.0
4718
4719
4720 ! partition all the aer species into
4721 ! solid phase
4722       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
4723       aer(ino3_a,jsolid,ibin) = 0.0
4724       aer(icl_a,jsolid,ibin)  = 0.0
4725       aer(inh4_a,jsolid,ibin) = 0.0
4726       aer(ioc_a,jsolid,ibin)  = aer(ioc_a,jtotal,ibin)
4727       aer(imsa_a,jsolid,ibin) = 0.0
4728       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
4729       aer(ina_a,jsolid,ibin)  = 0.0
4730       aer(ica_a,jsolid,ibin)  = electrolyte(jcaco3,jsolid,ibin) + &
4731                                 electrolyte(jcaso4,jsolid,ibin)
4732       aer(ibc_a,jsolid,ibin)  = aer(ibc_a,jtotal,ibin)
4733       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
4734       aer(ipcg1_b_c_a,jsolid,ibin)= aer(ipcg1_b_c_a,jtotal,ibin)
4735       aer(ipcg2_b_c_a,jsolid,ibin)= aer(ipcg2_b_c_a,jtotal,ibin)
4736       aer(ipcg3_b_c_a,jsolid,ibin)= aer(ipcg3_b_c_a,jtotal,ibin)
4737       aer(ipcg4_b_c_a,jsolid,ibin)= aer(ipcg4_b_c_a,jtotal,ibin)
4738       aer(ipcg5_b_c_a,jsolid,ibin)= aer(ipcg5_b_c_a,jtotal,ibin)
4739       aer(ipcg6_b_c_a,jsolid,ibin)= aer(ipcg6_b_c_a,jtotal,ibin)
4740       aer(ipcg7_b_c_a,jsolid,ibin)= aer(ipcg7_b_c_a,jtotal,ibin)
4741       aer(ipcg8_b_c_a,jsolid,ibin)= aer(ipcg8_b_c_a,jtotal,ibin)
4742       aer(ipcg9_b_c_a,jsolid,ibin)= aer(ipcg9_b_c_a,jtotal,ibin)
4743       aer(ipcg1_b_o_a,jsolid,ibin)= aer(ipcg1_b_o_a,jtotal,ibin)
4744       aer(ipcg2_b_o_a,jsolid,ibin)= aer(ipcg2_b_o_a,jtotal,ibin)
4745       aer(ipcg3_b_o_a,jsolid,ibin)= aer(ipcg3_b_o_a,jtotal,ibin)
4746       aer(ipcg4_b_o_a,jsolid,ibin)= aer(ipcg4_b_o_a,jtotal,ibin)
4747       aer(ipcg5_b_o_a,jsolid,ibin)= aer(ipcg5_b_o_a,jtotal,ibin)
4748       aer(ipcg6_b_o_a,jsolid,ibin)= aer(ipcg6_b_o_a,jtotal,ibin)
4749       aer(ipcg7_b_o_a,jsolid,ibin)= aer(ipcg7_b_o_a,jtotal,ibin)
4750       aer(ipcg8_b_o_a,jsolid,ibin)= aer(ipcg8_b_o_a,jtotal,ibin)
4751       aer(ipcg9_b_o_a,jsolid,ibin)= aer(ipcg9_b_o_a,jtotal,ibin)
4752       aer(iopcg1_b_c_a,jsolid,ibin)= aer(iopcg1_b_c_a,jtotal,ibin)
4753       aer(iopcg2_b_c_a,jsolid,ibin)= aer(iopcg2_b_c_a,jtotal,ibin)
4754       aer(iopcg3_b_c_a,jsolid,ibin)= aer(iopcg3_b_c_a,jtotal,ibin)
4755       aer(iopcg4_b_c_a,jsolid,ibin)= aer(iopcg4_b_c_a,jtotal,ibin)
4756       aer(iopcg5_b_c_a,jsolid,ibin)= aer(iopcg5_b_c_a,jtotal,ibin)
4757       aer(iopcg6_b_c_a,jsolid,ibin)= aer(iopcg6_b_c_a,jtotal,ibin)
4758       aer(iopcg7_b_c_a,jsolid,ibin)= aer(iopcg7_b_c_a,jtotal,ibin)
4759       aer(iopcg8_b_c_a,jsolid,ibin)= aer(iopcg8_b_c_a,jtotal,ibin)
4760       aer(iopcg1_b_o_a,jsolid,ibin)= aer(iopcg1_b_o_a,jtotal,ibin)
4761       aer(iopcg2_b_o_a,jsolid,ibin)= aer(iopcg2_b_o_a,jtotal,ibin)
4762       aer(iopcg3_b_o_a,jsolid,ibin)= aer(iopcg3_b_o_a,jtotal,ibin)
4763       aer(iopcg4_b_o_a,jsolid,ibin)= aer(iopcg4_b_o_a,jtotal,ibin)
4764       aer(iopcg5_b_o_a,jsolid,ibin)= aer(iopcg5_b_o_a,jtotal,ibin)
4765       aer(iopcg6_b_o_a,jsolid,ibin)= aer(iopcg6_b_o_a,jtotal,ibin)
4766       aer(iopcg7_b_o_a,jsolid,ibin)= aer(iopcg7_b_o_a,jtotal,ibin)
4767       aer(iopcg8_b_o_a,jsolid,ibin)= aer(iopcg8_b_o_a,jtotal,ibin)
4768       aer(ipcg1_f_c_a,jsolid,ibin)= aer(ipcg1_f_c_a,jtotal,ibin)
4769       aer(ipcg2_f_c_a,jsolid,ibin)= aer(ipcg2_f_c_a,jtotal,ibin)
4770       aer(ipcg3_f_c_a,jsolid,ibin)= aer(ipcg3_f_c_a,jtotal,ibin)
4771       aer(ipcg4_f_c_a,jsolid,ibin)= aer(ipcg4_f_c_a,jtotal,ibin)
4772       aer(ipcg5_f_c_a,jsolid,ibin)= aer(ipcg5_f_c_a,jtotal,ibin)
4773       aer(ipcg6_f_c_a,jsolid,ibin)= aer(ipcg6_f_c_a,jtotal,ibin)
4774       aer(ipcg7_f_c_a,jsolid,ibin)= aer(ipcg7_f_c_a,jtotal,ibin)
4775       aer(ipcg8_f_c_a,jsolid,ibin)= aer(ipcg8_f_c_a,jtotal,ibin)
4776       aer(ipcg9_f_c_a,jsolid,ibin)= aer(ipcg9_f_c_a,jtotal,ibin)
4777       aer(ipcg1_f_o_a,jsolid,ibin)= aer(ipcg1_f_o_a,jtotal,ibin)
4778       aer(ipcg2_f_o_a,jsolid,ibin)= aer(ipcg2_f_o_a,jtotal,ibin)
4779       aer(ipcg3_f_o_a,jsolid,ibin)= aer(ipcg3_f_o_a,jtotal,ibin)
4780       aer(ipcg4_f_o_a,jsolid,ibin)= aer(ipcg4_f_o_a,jtotal,ibin)
4781       aer(ipcg5_f_o_a,jsolid,ibin)= aer(ipcg5_f_o_a,jtotal,ibin)
4782       aer(ipcg6_f_o_a,jsolid,ibin)= aer(ipcg6_f_o_a,jtotal,ibin)
4783       aer(ipcg7_f_o_a,jsolid,ibin)= aer(ipcg7_f_o_a,jtotal,ibin)
4784       aer(ipcg8_f_o_a,jsolid,ibin)= aer(ipcg8_f_o_a,jtotal,ibin)
4785       aer(ipcg9_f_o_a,jsolid,ibin)= aer(ipcg9_f_o_a,jtotal,ibin)
4786       aer(iopcg1_f_c_a,jsolid,ibin)= aer(iopcg1_f_c_a,jtotal,ibin)
4787       aer(iopcg2_f_c_a,jsolid,ibin)= aer(iopcg2_f_c_a,jtotal,ibin)
4788       aer(iopcg3_f_c_a,jsolid,ibin)= aer(iopcg3_f_c_a,jtotal,ibin)
4789       aer(iopcg4_f_c_a,jsolid,ibin)= aer(iopcg4_f_c_a,jtotal,ibin)
4790       aer(iopcg5_f_c_a,jsolid,ibin)= aer(iopcg5_f_c_a,jtotal,ibin)
4791       aer(iopcg6_f_c_a,jsolid,ibin)= aer(iopcg6_f_c_a,jtotal,ibin)
4792       aer(iopcg7_f_c_a,jsolid,ibin)= aer(iopcg7_f_c_a,jtotal,ibin)
4793       aer(iopcg8_f_c_a,jsolid,ibin)= aer(iopcg8_f_c_a,jtotal,ibin)
4794       aer(iopcg1_f_o_a,jsolid,ibin)= aer(iopcg1_f_o_a,jtotal,ibin)
4795       aer(iopcg2_f_o_a,jsolid,ibin)= aer(iopcg2_f_o_a,jtotal,ibin)
4796       aer(iopcg3_f_o_a,jsolid,ibin)= aer(iopcg3_f_o_a,jtotal,ibin)
4797       aer(iopcg4_f_o_a,jsolid,ibin)= aer(iopcg4_f_o_a,jtotal,ibin)
4798       aer(iopcg5_f_o_a,jsolid,ibin)= aer(iopcg5_f_o_a,jtotal,ibin)
4799       aer(iopcg6_f_o_a,jsolid,ibin)= aer(iopcg6_f_o_a,jtotal,ibin)
4800       aer(iopcg7_f_o_a,jsolid,ibin)= aer(iopcg7_f_o_a,jtotal,ibin)
4801       aer(iopcg8_f_o_a,jsolid,ibin)= aer(iopcg8_f_o_a,jtotal,ibin)
4802       aer(ismpa_a,jsolid,ibin)= aer(ismpa_a,jtotal,ibin)
4803       aer(ismpbb_a,jsolid,ibin)= aer(ismpbb_a,jtotal,ibin)
4804       aer(iglysoa_r1_a,jsolid,ibin)= aer(iglysoa_r1_a,jtotal,ibin)
4805       aer(iglysoa_r2_a,jsolid,ibin)= aer(iglysoa_r2_a,jtotal,ibin)
4806       aer(iglysoa_sfc_a,jsolid,ibin)= aer(iglysoa_sfc_a,jtotal,ibin)
4807       aer(iglysoa_nh4_a,jsolid,ibin)= aer(iglysoa_nh4_a,jtotal,ibin)
4808       aer(iglysoa_oh_a,jsolid,ibin)= aer(iglysoa_oh_a,jtotal,ibin)
4809       aer(iant1_c_a,jsolid,ibin)= aer(iant1_c_a,jtotal,ibin)
4810       aer(iant2_c_a,jsolid,ibin)= aer(iant2_c_a,jtotal,ibin)
4811       aer(iant3_c_a,jsolid,ibin)= aer(iant3_c_a,jtotal,ibin)
4812       aer(iant4_c_a,jsolid,ibin)= aer(iant4_c_a,jtotal,ibin)
4813       aer(iant1_o_a,jsolid,ibin)= aer(iant1_o_a,jtotal,ibin)
4814       aer(iant2_o_a,jsolid,ibin)= aer(iant2_o_a,jtotal,ibin)
4815       aer(iant3_o_a,jsolid,ibin)= aer(iant3_o_a,jtotal,ibin)
4816       aer(iant4_o_a,jsolid,ibin)= aer(iant4_o_a,jtotal,ibin)
4817       aer(ibiog1_c_a,jsolid,ibin)= aer(ibiog1_c_a,jtotal,ibin)
4818       aer(ibiog2_c_a,jsolid,ibin)= aer(ibiog2_c_a,jtotal,ibin)
4819       aer(ibiog3_c_a,jsolid,ibin)= aer(ibiog3_c_a,jtotal,ibin)
4820       aer(ibiog4_c_a,jsolid,ibin)= aer(ibiog4_c_a,jtotal,ibin)
4821       aer(ibiog1_o_a,jsolid,ibin)= aer(ibiog1_o_a,jtotal,ibin)
4822       aer(ibiog2_o_a,jsolid,ibin)= aer(ibiog2_o_a,jtotal,ibin)
4823       aer(ibiog3_o_a,jsolid,ibin)= aer(ibiog3_o_a,jtotal,ibin)
4824       aer(ibiog4_o_a,jsolid,ibin)= aer(ibiog4_o_a,jtotal,ibin)
4825       aer(iasoaX_a,jsolid,ibin)= aer(iasoaX_a,jtotal,ibin)
4826       aer(iasoa1_a,jsolid,ibin)= aer(iasoa1_a,jtotal,ibin)
4827       aer(iasoa2_a,jsolid,ibin)= aer(iasoa2_a,jtotal,ibin)
4828       aer(iasoa3_a,jsolid,ibin)= aer(iasoa3_a,jtotal,ibin)
4829       aer(iasoa4_a,jsolid,ibin)= aer(iasoa4_a,jtotal,ibin)
4830       aer(ibsoaX_a,jsolid,ibin)= aer(ibsoaX_a,jtotal,ibin)
4831       aer(ibsoa1_a,jsolid,ibin)= aer(ibsoa1_a,jtotal,ibin)
4832       aer(ibsoa2_a,jsolid,ibin)= aer(ibsoa2_a,jtotal,ibin)
4833       aer(ibsoa3_a,jsolid,ibin)= aer(ibsoa3_a,jtotal,ibin)
4834       aer(ibsoa4_a,jsolid,ibin)= aer(ibsoa4_a,jtotal,ibin)
4835
4836
4837
4838
4839 ! liquid-phase
4840       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
4841                                  aer(iso4_a,jsolid,ibin)
4842       aer(iso4_a,jliquid,ibin) = max(0.D0, aer(iso4_a,jliquid,ibin))
4843       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
4844       aer(icl_a,jliquid,ibin)  = aer(icl_a,jtotal,ibin)
4845       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
4846       aer(ioc_a,jliquid,ibin)  = 0.0
4847       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
4848       aer(ico3_a,jliquid,ibin) = 0.0
4849       aer(ina_a,jliquid,ibin)  = aer(ina_a,jtotal,ibin)
4850       aer(ica_a,jliquid,ibin)  = aer(ica_a,jtotal,ibin) - &
4851                                  aer(ica_a,jsolid,ibin)
4852       aer(ica_a,jliquid,ibin)  = max(0.D0, aer(ica_a,jliquid,ibin))
4853       aer(ibc_a,jliquid,ibin)  = 0.0
4854       aer(ioin_a,jliquid,ibin) = 0.0
4855       aer(ipcg1_b_c_a,jliquid,ibin)= 0.0
4856       aer(ipcg2_b_c_a,jliquid,ibin)= 0.0
4857       aer(ipcg3_b_c_a,jliquid,ibin)= 0.0
4858       aer(ipcg4_b_c_a,jliquid,ibin)= 0.0
4859       aer(ipcg5_b_c_a,jliquid,ibin)= 0.0
4860       aer(ipcg6_b_c_a,jliquid,ibin)= 0.0
4861       aer(ipcg7_b_c_a,jliquid,ibin)= 0.0
4862       aer(ipcg8_b_c_a,jliquid,ibin)= 0.0
4863       aer(ipcg9_b_c_a,jliquid,ibin)= 0.0
4864       aer(ipcg1_b_o_a,jliquid,ibin)= 0.0
4865       aer(ipcg2_b_o_a,jliquid,ibin)= 0.0
4866       aer(ipcg3_b_o_a,jliquid,ibin)= 0.0
4867       aer(ipcg4_b_o_a,jliquid,ibin)= 0.0
4868       aer(ipcg5_b_o_a,jliquid,ibin)= 0.0
4869       aer(ipcg6_b_o_a,jliquid,ibin)= 0.0
4870       aer(ipcg7_b_o_a,jliquid,ibin)= 0.0
4871       aer(ipcg8_b_o_a,jliquid,ibin)= 0.0
4872       aer(ipcg9_b_o_a,jliquid,ibin)= 0.0
4873       aer(iopcg1_b_c_a,jliquid,ibin)= 0.0
4874       aer(iopcg2_b_c_a,jliquid,ibin)= 0.0
4875       aer(iopcg3_b_c_a,jliquid,ibin)= 0.0
4876       aer(iopcg4_b_c_a,jliquid,ibin)= 0.0
4877       aer(iopcg5_b_c_a,jliquid,ibin)= 0.0
4878       aer(iopcg6_b_c_a,jliquid,ibin)= 0.0
4879       aer(iopcg7_b_c_a,jliquid,ibin)= 0.0
4880       aer(iopcg8_b_c_a,jliquid,ibin)= 0.0
4881       aer(iopcg1_b_o_a,jliquid,ibin)= 0.0
4882       aer(iopcg2_b_o_a,jliquid,ibin)= 0.0
4883       aer(iopcg3_b_o_a,jliquid,ibin)= 0.0
4884       aer(iopcg4_b_o_a,jliquid,ibin)= 0.0
4885       aer(iopcg5_b_o_a,jliquid,ibin)= 0.0
4886       aer(iopcg6_b_o_a,jliquid,ibin)= 0.0
4887       aer(iopcg7_b_o_a,jliquid,ibin)= 0.0
4888       aer(iopcg8_b_o_a,jliquid,ibin)= 0.0
4889       aer(ipcg1_f_c_a,jliquid,ibin)= 0.0
4890       aer(ipcg2_f_c_a,jliquid,ibin)= 0.0
4891       aer(ipcg3_f_c_a,jliquid,ibin)= 0.0
4892       aer(ipcg4_f_c_a,jliquid,ibin)= 0.0
4893       aer(ipcg5_f_c_a,jliquid,ibin)= 0.0
4894       aer(ipcg6_f_c_a,jliquid,ibin)= 0.0
4895       aer(ipcg7_f_c_a,jliquid,ibin)= 0.0
4896       aer(ipcg8_f_c_a,jliquid,ibin)= 0.0
4897       aer(ipcg9_f_c_a,jliquid,ibin)= 0.0
4898       aer(ipcg1_f_o_a,jliquid,ibin)= 0.0
4899       aer(ipcg2_f_o_a,jliquid,ibin)= 0.0
4900       aer(ipcg3_f_o_a,jliquid,ibin)= 0.0
4901       aer(ipcg4_f_o_a,jliquid,ibin)= 0.0
4902       aer(ipcg5_f_o_a,jliquid,ibin)= 0.0
4903       aer(ipcg6_f_o_a,jliquid,ibin)= 0.0
4904       aer(ipcg7_f_o_a,jliquid,ibin)= 0.0
4905       aer(ipcg8_f_o_a,jliquid,ibin)= 0.0
4906       aer(ipcg9_f_o_a,jliquid,ibin)= 0.0
4907       aer(iopcg1_f_c_a,jliquid,ibin)= 0.0
4908       aer(iopcg2_f_c_a,jliquid,ibin)= 0.0
4909       aer(iopcg3_f_c_a,jliquid,ibin)= 0.0
4910       aer(iopcg4_f_c_a,jliquid,ibin)= 0.0
4911       aer(iopcg5_f_c_a,jliquid,ibin)= 0.0
4912       aer(iopcg6_f_c_a,jliquid,ibin)= 0.0
4913       aer(iopcg7_f_c_a,jliquid,ibin)= 0.0
4914       aer(iopcg8_f_c_a,jliquid,ibin)= 0.0
4915       aer(iopcg1_f_o_a,jliquid,ibin)= 0.0
4916       aer(iopcg2_f_o_a,jliquid,ibin)= 0.0
4917       aer(iopcg3_f_o_a,jliquid,ibin)= 0.0
4918       aer(iopcg4_f_o_a,jliquid,ibin)= 0.0
4919       aer(iopcg5_f_o_a,jliquid,ibin)= 0.0
4920       aer(iopcg6_f_o_a,jliquid,ibin)= 0.0
4921       aer(iopcg7_f_o_a,jliquid,ibin)= 0.0
4922       aer(iopcg8_f_o_a,jliquid,ibin)= 0.0
4923       aer(ismpa_a,jliquid,ibin)= 0.0
4924       aer(ismpbb_a,jliquid,ibin)= 0.0
4925       aer(iglysoa_r1_a,jliquid,ibin)= 0.0
4926       aer(iglysoa_r2_a,jliquid,ibin)= 0.0
4927       aer(iglysoa_sfc_a,jliquid,ibin)= 0.0
4928       aer(iglysoa_nh4_a,jliquid,ibin)= 0.0
4929       aer(iglysoa_oh_a,jliquid,ibin)= 0.0
4930       aer(iant1_c_a,jliquid,ibin)= 0.0
4931       aer(iant2_c_a,jliquid,ibin)= 0.0
4932       aer(iant3_c_a,jliquid,ibin)= 0.0
4933       aer(iant4_c_a,jliquid,ibin)= 0.0
4934       aer(iant1_o_a,jliquid,ibin)= 0.0
4935       aer(iant2_o_a,jliquid,ibin)= 0.0
4936       aer(iant3_o_a,jliquid,ibin)= 0.0
4937       aer(iant4_o_a,jliquid,ibin)= 0.0
4938       aer(ibiog1_c_a,jliquid,ibin)= 0.0
4939       aer(ibiog2_c_a,jliquid,ibin)= 0.0
4940       aer(ibiog3_c_a,jliquid,ibin)= 0.0
4941       aer(ibiog4_c_a,jliquid,ibin)= 0.0
4942       aer(ibiog1_o_a,jliquid,ibin)= 0.0
4943       aer(ibiog2_o_a,jliquid,ibin)= 0.0
4944       aer(ibiog3_o_a,jliquid,ibin)= 0.0
4945       aer(ibiog4_o_a,jliquid,ibin)= 0.0
4946       aer(iasoaX_a,jliquid,ibin)= 0.0
4947       aer(iasoa1_a,jliquid,ibin)= 0.0
4948       aer(iasoa2_a,jliquid,ibin)= 0.0
4949       aer(iasoa3_a,jliquid,ibin)= 0.0
4950       aer(iasoa4_a,jliquid,ibin)= 0.0
4951       aer(ibsoaX_a,jliquid,ibin)= 0.0
4952       aer(ibsoa1_a,jliquid,ibin)= 0.0
4953       aer(ibsoa2_a,jliquid,ibin)= 0.0
4954       aer(ibsoa3_a,jliquid,ibin)= 0.0
4955       aer(ibsoa4_a,jliquid,ibin)= 0.0
4956
4957
4958
4959
4960
4961       return
4962       end subroutine adjust_liquid_aerosol
4963
4964
4965
4966
4967
4968
4969
4970 ! end of mesa package
4971 !=======================================================================
4972
4973
4974
4975
4976
4977
4978
4979
4980 !***********************************************************************
4981 ! ASTEM: Adaptive Step Time-Split Euler Method
4982 !
4983 ! author: Rahul A. Zaveri
4984 ! update: jan 2007
4985 !-----------------------------------------------------------------------
4986       subroutine ASTEM(dtchem,vbs_nbin)
4987
4988       USE module_mosaic_gly, only : glysoa_complex, glysoa_simple
4989
4990 !      implicit none
4991 !      include 'chemistry.com'
4992 !      include 'mosaic.h'
4993 ! subr arguments
4994       real(kind=8) dtchem
4995 ! local variables
4996       integer ibin
4997       real(kind=8) dumdum
4998       integer vbs_nbin(1)
4999       integer start_svoc, Nsoa
5000 !      logical first
5001 !      save first
5002 !      data first/.true./
5003
5004       integer, save :: iclm_debug, jclm_debug, kclm_debug, ncnt_debug
5005       data iclm_debug /25/
5006       data jclm_debug /1/
5007       data kclm_debug /9/
5008       data ncnt_debug /2/
5009
5010
5011
5012       if(iclm_aer .eq. iclm_debug .and.   &
5013          jclm_aer .eq. jclm_debug .and.   &
5014          kclm_aer .eq. kclm_debug  .and.   &
5015          ncorecnt_aer .eq. ncnt_debug)then
5016         dumdum = 0.0
5017       endif
5018
5019
5020
5021 ! update ASTEM call counter
5022       nASTEM_call  = nASTEM_call + 1
5023
5024 ! reset input print flag
5025       iprint_input = mYES
5026
5027
5028
5029
5030 ! compute aerosol phase state before starting integration
5031       do ibin = 1, nbin_a
5032         if(jaerosolstate(ibin) .ne. no_aerosol)then
5033           call aerosol_phase_state(ibin)
5034           if (istat_mosaic_fe1 .lt. 0) return
5035           call calc_dry_n_wet_aerosol_props(ibin)
5036         endif
5037 !      endif ! added by Manish Shrivastav 12/7/09
5038       enddo
5039
5040
5041 !      if(first)then
5042 !        first=.false.
5043 !        call print_aer(0)              ! BOX
5044 !      endif
5045
5046
5047 ! compute new gas-aerosol mass transfer coefficients
5048       call aerosolmtc(vbs_nbin)
5049       if (istat_mosaic_fe1 .lt. 0) return
5050
5051 ! condense h2so4, msa, and nh3 only
5052       call ASTEM_non_volatiles(dtchem)  ! analytical solution
5053       if (istat_mosaic_fe1 .lt. 0) return
5054
5055 ! DL - 20/11/2012 - recalculate the mass balance to take account of
5056 !                   NO3- and Cl- changes from N2O5 het reactions
5057           call overall_massbal_in ! save input mass over all bins
5058
5059
5060 ! condense inorganic semi-volatile gases hno3, hcl, nh3, and co2
5061       call ASTEM_semi_volatiles(dtchem) ! semi-implicit + explicit euler
5062       if (istat_mosaic_fe1 .lt. 0) return
5063
5064       if (glysoa_param == glysoa_param_simple)  call glysoa_simple(dtchem)
5065       if (glysoa_param == glysoa_param_complex) call glysoa_complex(dtchem)
5066
5067 ! condense secondary organic gases (8 sorgam species)
5068       if (istat_mosaic_fe1 .lt. 0) return
5069
5070       start_svoc = 1
5071       Nsoa       = 0
5072       ! simple version, Hodzic and Jimenez, GMD, 2011
5073       if (vbs_nbin(1).eq.0) then
5074         start_svoc = ismpa_g
5075       ! 4-bin version, Knote et al., ACPD, 2014
5076       else if (vbs_nbin(1).eq.4) then
5077         start_svoc = iasoaX_g
5078       ! 9-bin version
5079       else
5080         start_svoc = ipcg1_b_c_g
5081 !        Nsoa = ngas_volatile-start_svoc
5082       end if
5083       Nsoa       = ngas_ioa + ngas_soa - start_svoc + 1
5084
5085       call equilibrium(start_svoc,Nsoa)
5086
5087 !!BSINGH (PNNL)- Following 3 lines are commented due to array out of bound error in equilibrium_smp
5088 !      !if (vbs_nbin.eq.0) then
5089 !      !call equilibrium_smp
5090 !      !else
5091 !      call equilibrium
5092 !      !Bend if
5093 !
5094
5095 ! template for error status checking
5096 !        if (iprint_mosaic_fe1 .gt. 0) then
5097 !          write(6,*)'error in computing dtmax for soa'
5098 !          write(6,*)'mosaic fatal error in astem_soa_dtmax'
5099 !       stop
5100 !       endif
5101 !        istat_mosaic_fe1 = -1800
5102 !        return
5103 !      endif
5104
5105       return
5106       end subroutine astem
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116       subroutine print_mosaic_stats( iflag1 )
5117 !     implicit none
5118 !     include 'mosaic.h'
5119 ! subr arguments
5120       integer iflag1
5121 ! local variables
5122       integer ibin
5123       real(kind=8) p_mesa_fails, p_astem_fails, dumcnt
5124
5125
5126       if (iflag1 .le. 0) goto 2000
5127
5128 ! print mesa and astem statistics
5129
5130       dumcnt = float(max(nmesa_call,1))
5131       p_mesa_fails  = 100.*float(nmesa_fail)/dumcnt
5132       niter_mesa_avg = float(niter_mesa)/dumcnt
5133
5134       dumcnt = float(max(nastem_call,1))
5135       p_astem_fails = 100.*float(nastem_fail)/dumcnt
5136       nsteps_astem_avg = float(nsteps_astem)/dumcnt
5137
5138
5139       if (iprint_mosaic_perform_stats .gt. 0) then
5140         write(6,*)'------------------------------------------------'
5141         write(6,*)'     astem performance statistics'
5142         write(6,*)'number of astem calls=', nastem_call
5143         write(6,*)'percent astem fails  =', nastem_fail
5144         write(6,*)'avg steps per dtchem =', nsteps_astem_avg
5145         write(6,*)'max steps per dtchem =', nsteps_astem_max
5146         write(6,*)'  '
5147         write(6,*)'     mesa performance statistics'
5148         write(6,*)'number of mesa calls =', nmesa_call
5149         write(6,*)'total mesa fails     =', nmesa_fail
5150         write(6,*)'percent mesa fails   =', p_mesa_fails
5151         write(6,*)'avg iterations/call  =', niter_mesa_avg
5152         write(6,*)'max iterations/call  =', niter_mesa_max
5153         write(6,*)'  '
5154       endif
5155
5156       if (iprint_mosaic_fe1 .gt. 0) then
5157          if ((nfe1_mosaic_cur .gt. 0) .or.   &
5158              (iprint_mosaic_fe1 .ge. 100)) then
5159             write(6,*)'-----------------------------------------'
5160             write(6,*)'mosaic failure count (current step) =',   &
5161                nfe1_mosaic_cur
5162             write(6,*)'mosaic failure count (all step tot) =',   &
5163                nfe1_mosaic_tot
5164             write(6,*)'  '
5165          endif
5166       endif
5167
5168       if (nfe1_mosaic_tot .gt. 9999) then
5169          write(6,'(a)') "MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!"
5170          call peg_error_fatal( lunerr_aer, &
5171               "---> MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!" )
5172       endif
5173
5174 2000  continue
5175
5176 ! reset counters
5177       nfe1_mosaic_cur = 0
5178
5179       nmesa_call   = 0
5180       nmesa_fail   = 0
5181       niter_mesa   = 0.0
5182       niter_mesa_max = 0
5183
5184       nastem_call = 0
5185       nastem_fail = 0
5186
5187       nsteps_astem = 0.0
5188       nsteps_astem_max = 0.0
5189
5190
5191       return
5192       end subroutine print_mosaic_stats
5193
5194
5195
5196
5197
5198 ! Calculates the equilibrium gas-particle partitioning for SOA species
5199         subroutine  equilibrium(start_ind,N)
5200 !        subroutine  equilibrium
5201 ! This routine was implemented by Manish Shrivastava on 12/24/2009 to do gas-particle partitioning of SOA assuming thermodynamic equilibrium.
5202 ! Modified by Alma Hodzic 12/2012 to implement the partitioning for mozart-mosaic species (based on the initial code implemented by Manish Shrivastava and originated from CAMx)
5203 ! This would give MOSAIC cpabilities of running both dynamic and equilibrium gas-particle partitioning
5204 ! Calls the subroutine soap. Subroutine soap calls subroutine spfcn
5205 !        use module_data_mosaic_main
5206 !        use module_data_mosaic_aero
5207
5208         implicit none
5209         real(kind=8), parameter :: tinys=1.0d-15
5210         integer, intent(in) :: start_ind, N
5211 !        integer, parameter :: N=ngas_soa !Total number of soa species
5212         integer, parameter :: itermax=2000
5213         integer idxfresh(N),idxaged(N)   !counter for fresh and aged soa species
5214         real(kind=8) :: dq,frqfresh(nbin_a),frqaged(nbin_a)
5215         real(kind=8) :: frqtotfresh,frqtotaged,frt
5216         real(kind=8) :: xsumfresh(nbin_a),xsumaged(nbin_a)
5217         real(kind=8) :: mnkfresh,mxkfresh,mnkaged,mxkaged
5218         real betak
5219 !        integer :: flagsoap(N) ! flagsoap determines if the species 'i' is fresh (flagsoap(i)=2) or aged(flagsoap(i)=1
5220         real(kind=8) ::  Csatfresh(N), Ctotfresh(N)
5221         real(kind=8) ::  Cgasfresh(N),Caerfresh(N) ! Csat: Saturation conc., Ctot: Total organic mass
5222 !       in gas+aerosol phase, Cgas:gas phase, Caer: Particle
5223         real(kind=8) ::    Csataged(N), Ctotaged(N)
5224         real(kind=8) ::  Cgasaged(N),Caeraged(N)
5225         integer nsolfresh,nsolaged,ntrack,icontfresh,icontaged ! counters corresponding to fresh and aged species for mapping
5226         real(kind=8) :: cpxfresh,cpxaged !Moles of pre-existing fresh and aged particle phase organic mass
5227         integer ibin,iter ! Bin nos.
5228 ! local variables
5229         integer iv, jp
5230          real(kind=8) :: dum, sum_dum, sum_soa, small_oc
5231
5232 !        real, parameter :: tolmin = 1.E-12^M
5233 !        real, parameter :: conmin = 1.E-20^M
5234 !        real totOA,minitw !total OA in particle phase^M
5235         real(kind=8) :: cpx !pre-existing OA umol/m3^M
5236         real(kind=8) :: Ctot(N),Caer(N),Cgas(N),Csat(N)
5237         real(kind=8) :: Paer(ngas_volatile)
5238         integer :: i
5239 !       LOGICAL check
5240         jp=jtotal
5241         iter=0
5242          cpxaged=0.0
5243         cpxfresh=0.0 ! Assume no pres-existing OA forms a solution
5244         nsolfresh=0
5245          nsolaged=0
5246          icontfresh=0
5247          icontaged=0
5248          dq=0.0
5249 ! Paer holds the organic aerosol values in each volatility bin (sum of all size bins)
5250           do iv=1,ngas_volatile
5251            Paer(iv)=0.0
5252           enddo
5253 ! Initialize flagsoap
5254           do i=1,N
5255              flagsoap(i)=1
5256              Ctot(i) = 0.0
5257              Ctotaged(i) = 0.0
5258              Ctotfresh(i) = 0.0
5259              Caer(i) = 0.0
5260              Caeraged(i) = 0.0
5261              Caerfresh(i) = 0.0
5262              Cgas(i) = 0.0
5263              Cgasaged(i) = 0.0
5264              Cgasfresh(i) = 0.0
5265              Csat(i) = 0.0
5266              Csataged(i) = 0.0
5267              Csatfresh(i) = 0.0
5268           enddo
5269 ! Calculate Ctot and Paer
5270 !              do iv = ipcg1_b_c_g, ngas_volatile
5271 !              do iv = start_ind, ngas_ioa + ngas_soa
5272               do iv = start_ind, (start_ind + N - 1)
5273         total_species(iv) = gas(iv)
5274         do ibin = 1, nbin_a
5275           total_species(iv) = total_species(iv) + aer(iv,jtotal,ibin)
5276            Paer(iv)=Paer(iv)+aer(iv,jtotal,ibin)
5277         enddo
5278       enddo
5279 ! Calculate pre-existing moles of OA (cpx) as sum of all size bins
5280         do ibin=1,nbin_a
5281         cpxaged= cpxaged+aer(ioc_a,jp,ibin)
5282          enddo
5283
5284 !  Maps arrays starting from start_ind or ipcg1_b_c_g on to corresponding arrays starting from 1 for just soa species
5285         do i=1,N
5286            Ctot(i)=total_species(start_ind+i-1)
5287            Caer(i)=Paer(start_ind+i-1)
5288            Csat(i)=sat_soa(start_ind+i-1)
5289            Cgas(i)=gas(start_ind+i-1)
5290          enddo
5291
5292 ! Initialize mapping array indices
5293           do i=1,N
5294             idxfresh(i)=0
5295             idxaged(i)=0
5296           enddo
5297 !     Seperate the fresh and aged species and treat them as 2 different solutions. Note this approach differes from PMCAMx
5298 !     In PMCAMx if flagsoap(i) was set to zero those species were not considered solution forming.
5299
5300          do i=1,N
5301             flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5302          enddo
5303
5304
5305 !         do i=1,9
5306 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5307 !          enddo
5308 !         do i=10,18
5309 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5310 !          enddo
5311 !        do i=19,26
5312 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5313 !          enddo
5314 !        do i=27,34
5315 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5316 !          enddo
5317 !        do i=35,43
5318 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5319 !          enddo
5320 !         do i=44,52
5321 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5322 !          enddo
5323 !        do i=53,60
5324 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5325 !          enddo
5326 !      do i=61,68
5327 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5328 !          enddo
5329 !        do i=69,84
5330 !            flagsoap(i)=1 !Oxidized fossil oxygen
5331 !        enddo
5332
5333       do i=1,N
5334          if (flagsoap(i).eq.2) then ! fresh primary species forming 1 solution
5335            icontfresh=icontfresh+1  ! count the number of fresh species
5336             idxfresh(icontfresh) = i  !Map the species
5337             Csatfresh(icontfresh)=Csat(i)
5338             Ctotfresh(icontfresh)=Ctot(i)
5339             Caerfresh(icontfresh)=Caer(i)
5340             Cgasfresh(icontfresh)=Cgas(i)
5341             nsolfresh=nsolfresh+1
5342          elseif (flagsoap(i).eq.1) then                       ! Aged SOA species forming another solution
5343             icontaged=icontaged+1
5344             idxaged(icontaged) = i
5345             Csataged(icontaged)=Csat(i)
5346             Ctotaged(icontaged)=Ctot(i)
5347             Caeraged(icontaged)=Caer(i)
5348             Cgasaged(icontaged)=Cgas(i)
5349             nsolaged=nsolaged+1
5350          endif
5351       enddo
5352
5353 !      Caluclate the initial equilibrium partitioning by the bisection method (CMU PMCAMx approach)
5354 !       If all fresh abd aged species form a solution
5355 !         call soap(ngas_soa,Ctot,Csat,Caer,Cgas,cpx)
5356
5357 !       if fresh and aged species form seperate solutions
5358       if (nsolfresh.gt.0)  call soap(nsolfresh,Ctotfresh, &
5359                     Csatfresh,Caerfresh,Cgasfresh,cpxfresh)
5360       if (nsolaged.gt.0)  call soap(nsolaged,Ctotaged, &
5361                   Csataged,Caeraged,Cgasaged,cpxaged)
5362
5363 !     Map the fresh and aged species back into original arrays
5364 !     Now assign the equilibrium gas-particle partitioning arrays
5365         ntrack=0
5366        do i=1,N ! Map the fresh and aged species back into array from 1 to N after calculating equilibrium
5367          if (idxfresh(i).gt.0) then
5368          Caer(idxfresh(i))= Caerfresh(i)
5369          Cgas(idxfresh(i))= Cgasfresh(i)
5370          Ctot(idxfresh(i))= Ctotfresh(i)
5371          ntrack=ntrack+1
5372          endif
5373          if (idxaged(i).gt.0) then
5374          Caer(idxaged(i))= Caeraged(i)
5375          Cgas(idxaged(i))= Cgasaged(i)
5376          Ctot(idxaged(i))= Ctotaged(i)
5377          ntrack=ntrack+1
5378          endif
5379        enddo
5380 !       Check for total number of species
5381         if (ntrack.ne.N) then
5382         call wrf_error_fatal('Error in mapping fresh and primary species arrays')
5383         endif
5384 ! From here on distribute the organic aerosol in size bins following Koo et al. 2003 " Integrated approaches to modeling
5385 ! the organic and inorganic atmospheric aerosol components"
5386 ! The original code from PMCAMx was modified to include 2 solutions for fresh and primary species
5387 ! by Manish Shrivastava on 01/11/2010
5388 ! Calculate total organic aerosol OA(in nmoles/m3) in each bin for either of fresh and aged aerosols
5389
5390          do ibin=1,nbin_a
5391            xsumfresh(ibin)=0.0
5392            xsumaged(ibin)=0.0
5393               xsumaged(ibin)= xsumaged(ibin)+aer(ioc_a,jp,ibin)!Caluclate pre-existing primary in each bin for aged aerosol
5394 !         do iv = start_ind, ngas_ioa + ngas_soa
5395          do iv = start_ind, (start_ind + N - 1)
5396            if (flagsoap(iv-start_ind+1).eq.2) then
5397                xsumfresh(ibin)= xsumfresh(ibin)+aer(iv,jtotal,ibin)
5398            elseif (flagsoap(iv-start_ind+1).eq.1) then
5399               xsumaged(ibin)= xsumaged(ibin)+aer(iv,jtotal,ibin)
5400                 elseif (flagsoap(iv-start_ind+1).eq.0) then
5401                  print *, 'Error in mapping flagsoap to start_ind'
5402            endif
5403          enddo
5404 !         do iv = ipcg1_b_c_g, ngas_volatile
5405 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5406 !               xsumfresh(ibin)= xsumfresh(ibin)+aer(iv,jtotal,ibin)
5407 !           elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5408 !              xsumaged(ibin)= xsumaged(ibin)+aer(iv,jtotal,ibin)
5409 !                elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.0) then
5410 !                 print *, 'Error in mapping flagsoap to ipcg1_b_c_g'
5411 !           endif
5412 !         enddo
5413
5414 ! Give a small non-zero value to xsum if it is zero in the section
5415           if (xsumfresh(ibin).eq.0.0) xsumfresh(ibin)=tinys
5416           if (xsumaged(ibin).eq.0.0) xsumaged(ibin)=tinys
5417         enddo
5418
5419
5420 ! Calculate dq as (gas concentration) G(t)-G(t+h):
5421 ! Caluclate driving force at previous time step (Cgas,i-XiCsati) for both fresh and aged solutions
5422 !          do iv = start_ind, ngas_ioa + ngas_soa
5423           do iv = start_ind, (start_ind + N - 1)
5424            if (Ctot(iv-start_ind+1).lt.1d-10) goto 120 ! If a given species concentration is too low skip
5425             dq=gas(iv)-Cgas(iv-start_ind+1) !Since both fresh and aged species have been remapped to an array going from 1 to N
5426 !          do iv = ipcg1_b_c_g, ngas_volatile
5427 !           if (Ctot(iv-ipcg1_b_c_g+1).lt.1d-10) goto 120 ! If a given species concentration is too low skip
5428 !            dq=gas(iv)-Cgas(iv-ipcg1_b_c_g+1) !Since both fresh and aged species have been remapped to an array going from 1 to N
5429            frqtotfresh=0.0d0
5430            frqtotaged=0.0d0
5431            mnkfresh=0.0d0
5432            mnkaged=0.0d0
5433            mxkfresh=0.0d0
5434            mxkaged=0.0d0
5435              do ibin=1,nbin_a
5436 ! fraceq(iv,ibin) is calculated as the rate of mass transfer
5437 ! The weighting fractions frqfresh(ibin) amd frqaged(ibin) are caluclated assuming mole fractions from previous time step
5438 ! This assumtion could be relaxed by iterativetely solving this equation
5439            if (flagsoap(iv-start_ind+1).eq.2) then
5440               frqfresh(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5441               -(aer(iv,jtotal,ibin))/xsumfresh(ibin) &
5442               *Csat(iv-start_ind+1))
5443           endif
5444
5445            if (flagsoap(iv-start_ind+1).eq.1) then
5446               frqaged(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5447              -(aer(iv,jtotal,ibin))/xsumaged(ibin) &
5448               *Csat(iv-start_ind+1))
5449           endif
5450
5451 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5452 !              frqfresh(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5453 !              -(aer(iv,jtotal,ibin))/xsumfresh(ibin) &
5454 !              *Csat(iv-ipcg1_b_c_g+1))
5455 !          endif
5456 !
5457 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5458 !              frqaged(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5459 !             -(aer(iv,jtotal,ibin))/xsumaged(ibin) &
5460 !              *Csat(iv-ipcg1_b_c_g+1))
5461 !          endif
5462             mnkfresh=min(mnkfresh,frqfresh(ibin))
5463             mnkaged=min(mnkaged,frqaged(ibin))
5464
5465             mxkfresh=max(mxkfresh,frqfresh(ibin))
5466             mxkaged=max(mxkaged,frqaged(ibin))
5467           enddo ! for ibin
5468 !          Repeat code from this point on for aged aerosol species
5469             if (flagsoap(iv-start_ind+1).eq.2) then
5470 !            if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5471 ! Condensation is favored in the next time step in this bin
5472           if(dq.gt.0.and.mnkfresh.lt.0.and.mxkfresh.gt.0) then
5473              do ibin=1,nbin_a
5474                frqfresh(ibin)=max(frqfresh(ibin)-mnkfresh,0.0d0)
5475               enddo
5476 ! evaporation is favored in the next time step in this bin
5477           elseif(dq.lt.0.and.mxkfresh.gt.0.and.mnkfresh.lt.0) then
5478               do ibin=1,nbin_a
5479               frqfresh(ibin)=min(frqfresh(ibin)-mxkfresh,0.0d0)
5480               enddo
5481            endif
5482            do ibin=1,nbin_a
5483             frqtotfresh=frqtotfresh+frqfresh(ibin)
5484            enddo
5485 ! Re-normalize frqfresh(ibin)
5486 ! Additional code to check for frqtotfresh and frqtotaged
5487 ! Added by Manish Shrivastava on 02/19/2010
5488
5489           do ibin=1,nbin_a
5490            frqfresh(ibin)=frqfresh(ibin)/frqtotfresh
5491            enddo
5492
5493             elseif(flagsoap(iv-start_ind+1).eq.1) then
5494 !            elseif(flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5495           if(dq.gt.0.and.mnkaged.lt.0.and.mxkaged.gt.0) then
5496              do ibin=1,nbin_a
5497                frqaged(ibin)=max(frqaged(ibin)-mnkaged,0.0d0)
5498               enddo
5499           elseif(dq.lt.0.and.mxkaged.gt.0.and.mnkaged.lt.0) then
5500               do ibin=1,nbin_a
5501               frqaged(ibin)=min(frqaged(ibin)-mxkaged,0.0d0)
5502               enddo
5503            endif
5504
5505            do ibin=1,nbin_a
5506             frqtotaged=frqtotaged+frqaged(ibin)
5507            enddo
5508
5509            do ibin=1,nbin_a
5510            frqaged(ibin)=frqaged(ibin)/frqtotaged
5511            enddo
5512
5513            endif ! for flagsoap
5514 !     Condense all condensing species
5515            if(dq.gt.0.0d0) then
5516
5517             !  Map the species back into the original MOSAIC arrays
5518              do ibin=1,nbin_a
5519                  if (flagsoap(iv-start_ind+1).eq.2) then
5520                  aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqfresh(ibin)
5521                  endif
5522                 if (flagsoap(iv-start_ind+1).eq.1) then
5523                 aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqaged(ibin)
5524                 endif
5525              enddo
5526 ! Set the gas phase species to equilibrium value
5527                 gas(iv)=Cgas(iv-start_ind+1)
5528
5529 !             do ibin=1,nbin_a
5530 !                 if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5531 !                 aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqfresh(ibin)
5532 !                 endif
5533 !                if (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5534 !                aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqaged(ibin)
5535 !                endif
5536 !             enddo
5537 !! Set the gas phase species to equilibrium value
5538 !                gas(iv)=Cgas(iv-ipcg1_b_c_g+1)
5539
5540 !     Evaporate all evaporating species
5541          elseif(dq.lt.0.0d0) then
5542             iter=0
5543 100         frt=1.0d0
5544                do ibin=1,nbin_a
5545                    if (flagsoap(iv-start_ind+1).eq.2) then
5546 !                   if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5547 ! Cannot evaporate more than whats in the bin ie ratio (aer(iv,jtotal,ibin)/dq*frqfresh(ibin)) should be less than equal to 1
5548                  if(frqfresh(ibin).gt.0.0d0) &
5549          frt=MAX(MIN(aer(iv,jtotal,ibin)/abs(-dq*frqfresh(ibin)),frt),0.0d0)
5550 !                  elseif(flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5551                   elseif(flagsoap(iv-start_ind+1).eq.1) then
5552                if(frqaged(ibin).gt.0.0d0) &
5553          frt=MAX(MIN(aer(iv,jtotal,ibin)/abs(-dq*frqaged(ibin)),frt),0.0d0)
5554                   endif ! for flagsoap
5555                enddo ! for ibin
5556
5557
5558
5559          frqtotfresh=0.0d0
5560          frqtotaged=0.0d0
5561
5562              do ibin=1,nbin_a
5563         if (flagsoap(iv-start_ind+1).eq.2) then
5564 !        if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5565                aer(iv,jtotal,ibin)= &
5566 ! Since dq is negative this is evaporating aerosols
5567                MAX(aer(iv,jtotal,ibin)+frt*dq*frqfresh(ibin),0.0d0)
5568          if(aer(iv,jtotal,ibin).lt.tinys) frqfresh(ibin)=0.0d0
5569               frqtotfresh=frqtotfresh+frqfresh(ibin)
5570 !        elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5571         elseif (flagsoap(iv-start_ind+1).eq.1) then
5572                aer(iv,jtotal,ibin)= &
5573                MAX(aer(iv,jtotal,ibin)+frt*dq*frqaged(ibin),0.0d0)
5574          if(aer(iv,jtotal,ibin).lt.tinys) frqaged(ibin)=0.0d0
5575               frqtotaged=frqtotaged+frqaged(ibin)
5576          endif ! for flagsoap
5577              enddo ! for ibin
5578
5579 ! Check if we should evaporate more
5580           dq=(1.0d0-frt)*dq
5581 !         if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5582          if (flagsoap(iv-start_ind+1).eq.2) then
5583            if(dq.lt.-1.d-8) then ! check if d-8 is better
5584              if(frqtotfresh.gt.tinys) then ! we have sections which are not empty
5585               if(iter.le.itermax) then ! check infinite loop
5586                 iter = iter + 1
5587                 do ibin = 1,nbin_a
5588                   frqfresh(ibin) = frqfresh(ibin) / frqtotfresh
5589                 enddo ! for ibin
5590              goto 100
5591             endif ! for iter
5592           endif ! frqtotfresh.gt.tinys
5593            endif ! dq.lt.-1.d-7
5594 !          elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5595           elseif (flagsoap(iv-start_ind+1).eq.1) then
5596            if(dq.lt.-1.d-8) then
5597              if(frqtotaged.gt.tinys) then ! we have sections which are not empty
5598               if(iter.le.itermax) then ! check infinite loop
5599                 iter = iter + 1
5600                 do ibin = 1,nbin_a
5601                   frqaged(ibin) = frqaged(ibin) / frqtotaged
5602                 enddo
5603                goto 100
5604           endif
5605             endif
5606             endif
5607
5608             ! we need to evaporate more to achieve equilibrium
5609             ! but we completely evaporated the species in all sections
5610             ! or exceeded itermax
5611            endif ! for flagsoap
5612
5613 ! now set the gas species concentration conservatively
5614 !           gas(iv)=Ctot(iv-ipcg1_b_c_g+1)
5615            gas(iv)=Ctot(iv-start_ind+1)
5616              do ibin=1,nbin_a
5617                gas(iv)=gas(iv)-aer(iv,jtotal,ibin)
5618              enddo
5619         endif ! if dq.gt.0
5620
5621 120       continue
5622            enddo ! for iv=start_ind
5623
5624        end subroutine equilibrium
5625
5626
5627 !---------------------------------
5628 ! Calculates the equilibrium gas-particle partitioning for SOA species when MOZART_MOSAIC_4BIN_KPP is used
5629 ! This routine was modified by Alma Hodzic based on the initial code implemented by Manish Shrivastava and originated from CAMx
5630
5631 !++ alma - removed the subroutine  equilibrium_smp
5632 !        subroutine  equilibrium_smp
5633 !..
5634 !       end subroutine equilibrium_smp
5635 !--
5636
5637 !    This subroutine spfcn calculates the objective function fval to solve gas-particle partitioning of SOA
5638 !    Subroutine spfcn is called from within the subroutine soap
5639         subroutine spfcn(N,Ctot,Csat,Ca,cpx,tom,fval)
5640 !        use module_data_mosaic_main
5641 !        use module_data_mosaic_aero
5642       implicit none
5643        real(kind=8):: Ctot(N),Csat(N),Ca(N),tom,fval,cpx
5644
5645          integer i,N
5646         fval=0.0
5647          do i=1, N
5648          Ca(i)=Ctot(i)*tom/(tom+Csat(i)/1)! Replace the divisor 1 by Molecular Weights if the units for Csat(i) are ug/m3 or ng/m3
5649         fval=fval+Ca(i)/1 ! The divisor is set to 1 as the species are in nmol/m3
5650         enddo
5651           fval=fval+cpx-tom
5652         return
5653
5654        end subroutine spfcn
5655
5656
5657         subroutine soap(N,Ctot,Csat,Ca,Cgas,cpx)
5658 ! SOAP calculates the gas-partitioning of SOA. Adapted from PMCAMx and uses the bisection approach.
5659 ! SOAP calls subroutine spfcn which calculates the objective function for solving gas-particle partitioning
5660 !        use module_data_mosaic_main
5661 !        use module_data_mosaic_aero
5662
5663         real(kind=8),  parameter :: xtol = 5.0e-5
5664           real(kind=8):: Ctot(N),Csat(N),cpx,Ca(N),Cgas(N)
5665           real(kind=8):: xend,dx,xmid,fend,fmid,sun
5666          integer i,N,znum
5667
5668          sun=0.0
5669           do i=1,N
5670             if (Csat(i).gt.0) then
5671             sun=sun+Ctot(i)/Csat(i) !If a species does not exist its Csat is zero
5672            else
5673            endif
5674           enddo
5675          if(cpx.lt.1e-9.and.sun.le.1.0) then !if ctots for all species are less than corr. csats and cpre is negligible
5676            do i=1,N
5677              Cgas(i)=Ctot(i)
5678              Ca(i)=0.0
5679            enddo
5680          goto 900
5681         endif
5682
5683        xend=0.0
5684        do i=1, N
5685          xend=xend+Ctot(i)/1 ! Replace the divisor 1 by molecular weight if the units of Ctot(i) are in ng/m3 or ug/m3
5686          enddo
5687         xend=xend+cpx ! total number of moles
5688        if (xend.gt.1e-10) then
5689            call spfcn(N,Ctot,Csat,Ca,cpx,xend,fend) ! Calculates the objective function
5690         else
5691 !          write (2,*) "Total no of moles less than 1e-10 bypassing soap"
5692               goto 100
5693       endif
5694           if(abs(fend).le.xtol*xend) goto 99 ! Check for tolerance
5695           if (fend.gt.0.0) then ! The objective function is supposed to be less than equal to zero
5696          write (2,*) "Error in SOAP"
5697          goto 50
5698         endif
5699            dx=xend-cpx
5700         do znum=1,200
5701         dx=0.5*dx
5702          xmid=xend-dx ! Find the midpoint following the bisection approach
5703            call spfcn (N,Ctot,Csat,Ca,cpx,xmid,fmid) ! Re-calculate the objective function
5704           if(abs(fmid).le.xtol*xmid.or.dx.le.xtol*xmid) goto 100 ! converged
5705            if (fmid.lt.0.0) xend=xmid
5706          enddo
5707 50       call wrf_message("Error in SOAP")
5708          call wrf_error_fatal("Error: max number of iterations reached")
5709
5710
5711 99     xmid=xend
5712 100    continue
5713         do i=1, N
5714         Ca(i)=min(Ctot(i), Ca(i))
5715         Cgas(i)=Ctot(i)-Ca(i)
5716        enddo
5717 900   continue
5718
5719
5720 !     write(2,*) xmid
5721      return
5722
5723        end subroutine soap
5724
5725
5726
5727 !***********************************************************************
5728 ! part of ASTEM: integrates semi-volatile inorganic gases
5729 !
5730 ! author: Rahul A. Zaveri
5731 ! update: jan 2007
5732 !-----------------------------------------------------------------------
5733       subroutine ASTEM_semi_volatiles(dtchem)
5734 !      implicit none
5735 !      include 'chemistry.com'
5736 !      include 'mosaic.h'
5737 ! subr arguments
5738       real(kind=8) dtchem
5739 ! local variables
5740       integer ibin, iv, jp
5741       real(kind=8) dtmax, t_new, t_old, t_out, xt
5742       real(kind=8) sum1, sum2, sum3, sum4, sum4a, sum4b, h_flux_s
5743
5744
5745 ! initialize time
5746       t_old = 0.0
5747       t_out = dtchem
5748
5749 ! reset ASTEM time steps and MESA iterations counters to zero
5750       isteps_ASTEM = 0
5751       do ibin = 1, nbin_a
5752         iter_MESA(ibin) = 0
5753       enddo
5754
5755 !--------------------------------
5756 ! overall integration loop begins over dtchem seconds
5757
5758 10    isteps_ASTEM = isteps_ASTEM + 1
5759
5760 ! compute new fluxes
5761       phi_nh4no3_s = 0.0
5762       phi_nh4cl_s  = 0.0
5763       ieqblm_ASTEM = mYES                       ! reset to default
5764
5765       do 501 ibin = 1, nbin_a
5766
5767         idry_case3a(ibin) = mNO                 ! reset to default
5768 ! default fluxes and other stuff
5769         do iv = 1, ngas_ioa
5770           sfc_a(iv)                  = gas(iv)
5771           df_gas_s(iv,ibin)          = 0.0
5772           df_gas_l(iv,ibin)          = 0.0
5773           flux_s(iv,ibin)            = 0.0
5774           flux_l(iv,ibin)            = 0.0
5775           Heff(iv,ibin)              = 0.0
5776           volatile_s(iv,ibin)        = 0.0
5777           phi_volatile_s(iv,ibin)    = 0.0
5778           phi_volatile_l(iv,ibin)    = 0.0
5779           integrate(iv,jsolid,ibin)  = mNO      ! reset to default
5780           integrate(iv,jliquid,ibin) = mNO      ! reset to default
5781         enddo
5782
5783
5784         if(jaerosolstate(ibin) .eq. all_solid)then
5785           jphase(ibin) = jsolid
5786           call ASTEM_flux_dry(ibin)
5787         elseif(jaerosolstate(ibin) .eq. all_liquid)then
5788           jphase(ibin) = jliquid
5789           call ASTEM_flux_wet(ibin)
5790         elseif(jaerosolstate(ibin) .eq. mixed)then
5791
5792           if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
5793               electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
5794             call ASTEM_flux_mix(ibin)   ! jphase(ibin) will be determined in this subr.
5795           else
5796             jphase(ibin) = jliquid
5797             call ASTEM_flux_wet(ibin)
5798           endif
5799
5800         endif
5801
5802 501   continue
5803
5804       if(ieqblm_ASTEM .eq. mYES)goto 30 ! all bins have reached eqblm, so quit.
5805
5806 !-------------------------
5807
5808
5809 ! calculate maximum possible internal time-step
5810 11    call ASTEM_calculate_dtmax(dtchem, dtmax)
5811       t_new = t_old + dtmax     ! update time
5812       if(t_new .gt. t_out)then  ! check if the new time step is too large
5813         dtmax = t_out - t_old
5814         t_new = t_out*1.01
5815       endif
5816
5817
5818 !------------------------------------------
5819 ! do internal time-step (dtmax) integration
5820
5821       do 20 iv = 2, 4
5822
5823         sum1 = 0.0
5824         sum2 = 0.0
5825         sum3 = 0.0
5826         sum4 = 0.0
5827         sum4a= 0.0
5828         sum4b= 0.0
5829
5830         do 21 ibin = 1, nbin_a
5831           if(jaerosolstate(ibin) .eq. no_aerosol)goto 21
5832
5833           jp = jliquid
5834           sum1 = sum1 + aer(iv,jp,ibin)/ &
5835           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
5836
5837           sum2 = sum2 + kg(iv,ibin)*integrate(iv,jp,ibin)/ &
5838           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
5839
5840           jp = jsolid
5841           sum3 = sum3 + aer(iv,jp,ibin)
5842
5843           if(flux_s(iv,ibin) .gt. 0.)then
5844             h_flux_s = dtmax*flux_s(iv,ibin)
5845             sum4a = sum4a + h_flux_s
5846             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
5847           elseif(flux_s(iv,ibin) .lt. 0.)then
5848             h_flux_s = min(h_s_i_m(iv,ibin),dtmax)*flux_s(iv,ibin)
5849             sum4b = sum4b + h_flux_s
5850             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
5851             aer(iv,jp,ibin) = max(aer(iv,jp,ibin), 0.0D0)
5852           endif
5853
5854 21      continue
5855
5856         sum4 = sum4a + sum4b
5857
5858
5859 ! first update gas concentration
5860         gas(iv) = (total_species(iv) - (sum1 + sum3 + sum4) )/ &
5861                               (1. + dtmax*sum2)
5862         gas(iv) = max(gas(iv), 0.0D0)
5863
5864 !        if(gas(iv) .lt. 0.)write(6,*) gas(iv)
5865
5866 ! now update aer concentration in the liquid phase
5867         do 22 ibin = 1, nbin_a
5868
5869           if(integrate(iv,jliquid,ibin) .eq. mYES)then
5870             aer(iv,jliquid,ibin) =  &
5871              (aer(iv,jliquid,ibin) + dtmax*kg(iv,ibin)*gas(iv))/ &
5872                   (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin))
5873
5874           endif
5875
5876 22      continue
5877
5878
5879 20    continue
5880 !------------------------------------------
5881 ! sub-step integration done
5882
5883
5884 !------------------------------------------
5885 ! now update aer(jtotal) and update internal phase equilibrium
5886 ! also do integration of species by mass balance if necessary
5887
5888       do 40 ibin = 1, nbin_a
5889         if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
5890
5891         if(jphase(ibin) .eq. jsolid)then
5892           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
5893         elseif(jphase(ibin) .eq. jliquid)then
5894           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
5895         elseif(jphase(ibin) .eq. jtotal)then
5896           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
5897           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
5898         endif
5899
5900 !========================
5901 ! now update jtotal
5902         do iv = 2, ngas_ioa
5903           aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
5904         enddo
5905 !========================
5906
5907
5908         call form_electrolytes(jtotal,ibin,XT)  ! for MDRH diagnosis
5909
5910
5911
5912 ! update internal phase equilibrium
5913         if(jhyst_leg(ibin) .eq. jhyst_lo)then
5914           call ASTEM_update_phase_eqblm(ibin)
5915         else
5916           call do_full_deliquescence(ibin)              ! simply do liquid <-- total
5917         endif
5918
5919
5920 40    continue
5921 !------------------------------------------
5922
5923 ! update time
5924       t_old = t_new
5925
5926
5927       if(isteps_astem .ge. nmax_astem)then
5928         nastem_fail = nastem_fail + 1
5929         write(6,*)'ASTEM internal steps exceeded', nmax_astem
5930         if(iprint_input .eq. mYES)then
5931           write(67,*)'ASTEM internal steps exceeded', nmax_astem
5932           call print_input
5933           iprint_input = mNO
5934         endif
5935         goto 30
5936       elseif(t_new .lt. t_out)then
5937         goto 10
5938       endif
5939
5940
5941 ! check if end of dtchem reached
5942       if(t_new .lt. 0.9999*t_out) goto 10
5943
5944 30    nsteps_astem = nsteps_astem + isteps_astem                ! cumulative steps
5945       nsteps_astem_max = max(nsteps_astem_max, isteps_astem)    ! max steps in a dtchem time-step
5946
5947 !================================================
5948 ! end of overall integration loop over dtchem seconds
5949
5950
5951
5952 ! call subs to calculate fluxes over mixed-phase particles to update H+ ions,
5953 ! which were wiped off during update_phase_eqblm
5954 !      do ibin = 1, nbin_a
5955 !
5956 !        if(jaerosolstate(ibin) .eq. mixed)then
5957 !          if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
5958 !              electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
5959 !            call ASTEM_flux_mix(ibin)          ! jphase(ibin) will be determined in this subr.
5960 !          else
5961 !            jphase(ibin) = jliquid
5962 !            call ASTEM_flux_wet(ibin)
5963 !          endif
5964 !        endif
5965 !
5966 !      enddo
5967
5968
5969
5970       return
5971       end subroutine ASTEM_semi_volatiles
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984 !***********************************************************************
5985 ! part of ASTEM: computes max time step for gas-aerosol integration
5986 !
5987 ! author: Rahul A. Zaveri
5988 ! update: jan 2005
5989 !-----------------------------------------------------------------------
5990       subroutine ASTEM_calculate_dtmax(dtchem, dtmax)
5991        use module_data_mosaic_other, only:  lunerr
5992 !      implicit none
5993 !      include 'mosaic.h'
5994 ! subr arguments
5995       real(kind=8) dtchem, dtmax
5996 ! local variables
5997       integer ibin, iv
5998       real(kind=8) alpha, h_gas, h_sub_max,  &
5999            h_gas_i(ngas_ioa), h_gas_l, h_gas_s,  &
6000            sum_kg_phi, sumflux_s
6001
6002
6003       h_sub_max = 100.0 ! sec  raz update 4/30/2007
6004
6005
6006 ! gas-side
6007
6008 ! solid-phase
6009 ! calculate h_gas_i and h_gas_l
6010
6011       h_gas_s = 2.e16
6012
6013       do 5 iv = 2, ngas_ioa
6014         h_gas_i(iv) = 1.e16
6015         sumflux_s = 0.0
6016         do ibin = 1, nbin_a
6017           if(flux_s(iv,ibin) .gt. 0.0)then
6018             sumflux_s = sumflux_s + flux_s(iv,ibin)
6019           endif
6020         enddo
6021
6022         if(sumflux_s .gt. 0.0)then
6023           h_gas_i(iv) = 0.1*gas(iv)/sumflux_s     ! raz-30apr07
6024           h_gas_s     = min(h_gas_s, h_gas_i(iv))
6025         endif
6026
6027 5     continue
6028
6029
6030 ! liquid-phase
6031 ! calculate h_gas_s and h_gas_l
6032
6033       h_gas_l = 2.e16
6034
6035       do 6 iv = 2, ngas_ioa
6036         h_gas_i(iv) = 1.e16
6037         sum_kg_phi = 0.0
6038         do ibin = 1, nbin_a
6039           if(integrate(iv,jliquid,ibin) .eq. mYES)then
6040           sum_kg_phi = sum_kg_phi +  &
6041                        abs(phi_volatile_l(iv,ibin))*kg(iv,ibin)
6042           endif
6043         enddo
6044
6045         if(sum_kg_phi .gt. 0.0)then
6046           h_gas_i(iv) = alpha_astem/sum_kg_phi
6047           h_gas_l     = min(h_gas_l, h_gas_i(iv))
6048         endif
6049
6050 6     continue
6051
6052       h_gas = min(h_gas_s, h_gas_l)
6053       h_gas = min(h_gas, h_sub_max)
6054
6055
6056
6057
6058 ! aerosol-side: solid-phase
6059
6060 ! first load volatile_solid array
6061       do ibin = 1, nbin_a
6062
6063         volatile_s(ino3_a,ibin) = electrolyte(jnh4no3,jsolid,ibin)
6064         volatile_s(inh4_a,ibin) = electrolyte(jnh4cl,jsolid,ibin) +  &
6065                                   electrolyte(jnh4no3,jsolid,ibin)
6066
6067         if(idry_case3a(ibin) .eq. mYES)then
6068           volatile_s(icl_a,ibin)  = aer(icl_a,jsolid,ibin)
6069         else
6070           volatile_s(icl_a,ibin)  = electrolyte(jnh4cl,jsolid,ibin)
6071         endif
6072
6073       enddo
6074
6075
6076 ! next calculate weighted avg_df_gas_s
6077       do iv = 2, ngas_ioa
6078
6079         sum_bin_s(iv) = 0.0
6080         sum_vdf_s(iv) = 0.0
6081         sum_vol_s(iv) = 0.0
6082
6083         do ibin = 1, nbin_a
6084           if(flux_s(iv,ibin) .lt. 0.)then       ! aer -> gas
6085             sum_bin_s(iv) = sum_bin_s(iv) + 1.0
6086             sum_vdf_s(iv) = sum_vdf_s(iv) +  &
6087                             volatile_s(iv,ibin)*df_gas_s(iv,ibin)
6088             sum_vol_s(iv) = sum_vol_s(iv) + volatile_s(iv,ibin)
6089           endif
6090         enddo
6091
6092         if(sum_vol_s(iv) .gt. 0.0)then
6093           avg_df_gas_s(iv) = sum_vdf_s(iv)/sum_vol_s(iv)
6094         else
6095           avg_df_gas_s(iv) = 1.0 ! never used, but set to 1.0 just to be safe
6096         endif
6097
6098       enddo
6099
6100
6101 ! calculate h_s_i_m
6102
6103
6104       do 20 ibin = 1, nbin_a
6105
6106         if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
6107
6108         do 10 iv = 2, ngas_ioa
6109
6110           if(flux_s(iv,ibin) .lt. 0.)then                               ! aer -> gas
6111
6112             alpha = abs(avg_df_gas_s(iv))/  &
6113                    (volatile_s(iv,ibin)*sum_bin_s(iv))
6114             alpha = min(alpha, 1.0D0)
6115
6116             if(idry_case3a(ibin) .eq. mYES)alpha = 1.0D0
6117
6118             h_s_i_m(iv,ibin) =  &
6119                  -alpha*volatile_s(iv,ibin)/flux_s(iv,ibin)
6120
6121           endif
6122
6123 10      continue
6124
6125
6126 20    continue
6127
6128
6129       dtmax = min(dtchem, h_gas)
6130
6131
6132       if(dtmax .eq. 0.0)then
6133         write(6,*)' dtmax = ', dtmax
6134         write(67,*)' dtmax = ', dtmax
6135         call print_input
6136         iprint_input = mNO
6137         call peg_error_fatal( lunerr, " " )
6138       endif
6139
6140       return
6141       end subroutine astem_calculate_dtmax
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157 !***********************************************************************
6158 ! part of ASTEM: updates solid-liquid partitioning after each gas-aerosol
6159 ! mass transfer step
6160 !
6161 ! author: Rahul A. Zaveri
6162 ! update: jan 2005
6163 !-----------------------------------------------------------------------
6164       subroutine ASTEM_update_phase_eqblm(ibin) ! TOUCH
6165 !      implicit none
6166 !      include 'mosaic.h'
6167 ! subr arguments
6168       integer ibin
6169 ! local variables
6170       integer jdum, js, j_index, je     ! raz update 11/13/2008
6171       real(kind=8) XT, sum_dum  ! raz update 11/13/2008
6172
6173
6174
6175 ! calculate percent composition ! raz update 11/13/2008
6176       sum_dum = 0.0
6177       do je = 1, nelectrolyte
6178         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
6179       enddo
6180
6181       if(sum_dum .eq. 0.)sum_dum = 1.0
6182
6183       do je = 1, nelectrolyte
6184         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
6185       enddo
6186
6187
6188 ! calculate overall sulfate ratio
6189       call calculate_XT(ibin,jtotal,XT)         ! calc updated XT
6190
6191 ! now diagnose MDRH
6192       if(XT .lt. 1. .and. XT .gt. 0. )goto 10   ! excess sulfate domain - no MDRH exists
6193
6194       jdum = 0
6195       do js = 1, nsalt
6196         jsalt_present(js) = 0                   ! default value - salt absent
6197
6198         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
6199           jsalt_present(js) = 1                 ! salt present
6200           jdum = jdum + jsalt_index(js)
6201         endif
6202       enddo
6203
6204       if(jdum .eq. 0)then
6205         jaerosolstate(ibin) = all_solid ! no significant soluble material present
6206         jphase(ibin) = jsolid
6207         call adjust_solid_aerosol(ibin)
6208         return
6209       endif
6210
6211       if(XT .ge. 2.0 .or. XT .lt. 0.0)then
6212         j_index = jsulf_poor(jdum)
6213       else
6214         j_index = jsulf_rich(jdum)
6215       endif
6216
6217       MDRH(ibin) = MDRH_T(j_index)
6218
6219       if(aH2O*100. .lt. MDRH(ibin)) then
6220         jaerosolstate(ibin) = all_solid
6221         jphase(ibin) = jsolid
6222         call adjust_solid_aerosol(ibin)
6223         return
6224       endif
6225
6226
6227 ! none of the above means it must be sub-saturated or mixed-phase
6228 10    if(jphase(ibin) .eq. jsolid)then
6229         call do_full_deliquescence(ibin)
6230         call MESA_PTC(ibin)
6231       else
6232         call MESA_PTC(ibin)
6233       endif
6234
6235
6236
6237       return
6238       end subroutine ASTEM_update_phase_eqblm
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251 !==================================================================
6252 !
6253 ! LIQUID PARTICLES
6254 !
6255 !***********************************************************************
6256 ! part of ASTEM: computes fluxes over wet aerosols
6257 !
6258 ! author: Rahul A. Zaveri
6259 ! update: Jan 2007
6260 !-----------------------------------------------------------------------
6261       subroutine ASTEM_flux_wet(ibin)
6262       use module_data_mosaic_other, only:  lunerr
6263 !      implicit none
6264 !      include 'mosaic.h'
6265 ! subr arguments
6266       integer ibin
6267 ! local variables
6268       integer iv, iadjust, iadjust_intermed
6269       real(kind=8) xt, g_nh3_hno3, g_nh3_hcl, a_nh4_no3, a_nh4_cl
6270
6271
6272
6273       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
6274       call compute_activities(ibin)
6275
6276       if(water_a(ibin) .eq. 0.0)then
6277         write(6,*)'Water is zero in liquid phase'
6278         call peg_error_fatal( lunerr, "Stopping in ASTEM_flux_wet" )
6279       endif
6280
6281 !-------------------------------------------------------------------
6282 ! CASE 1: caco3 > 0 absorb acids (and indirectly degas co2)
6283
6284       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
6285         call ASTEM_flux_wet_case1(ibin)
6286         return
6287       endif
6288
6289 !-------------------------------------------------------------------
6290 ! CASE 2: Sulfate-Rich Domain
6291
6292       if(XT.lt.1.9999 .and. XT.ge.0.)then
6293         call ASTEM_flux_wet_case2(ibin)
6294         return
6295       endif
6296
6297 !-------------------------------------------------------------------
6298
6299       if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10  ! no ammonia in the system
6300
6301 !-------------------------------------------------------------------
6302 ! CASE 3: nh4no3 and/or nh4cl maybe active
6303 ! do some small adjustments (if needed) before deciding case 3
6304
6305       iadjust = mNO             ! default
6306       iadjust_intermed = mNO    ! default
6307
6308 ! nh4no3
6309       g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
6310       a_nh4_no3  = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
6311
6312       if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
6313         call absorb_tiny_nh4no3(ibin)
6314         iadjust = mYES
6315         iadjust_intermed = mYES
6316       endif
6317
6318       if(iadjust_intermed .eq. mYES)then
6319         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6320         iadjust_intermed = mNO  ! reset
6321       endif
6322
6323 ! nh4cl
6324       g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
6325       a_nh4_cl  = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
6326
6327       if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
6328         call absorb_tiny_nh4cl(ibin)
6329         iadjust = mYES
6330         iadjust_intermed = mYES
6331       endif
6332
6333       if(iadjust_intermed .eq. mYES)then
6334         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6335       endif
6336
6337       if(iadjust .eq. mYES)then
6338         call compute_activities(ibin)                   ! update after adjustments
6339       endif
6340
6341
6342 ! all adjustments done...
6343
6344 !--------
6345       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
6346       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
6347
6348       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
6349       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
6350
6351       call ASTEM_flux_wet_case3(ibin)
6352
6353       return
6354
6355
6356 !-------------------------------------------------------------------
6357 ! CASE 4: ammonia = 0. hno3 and hcl exchange may happen here
6358 ! do small adjustments (if needed) before deciding case 4
6359
6360 10    iadjust = mNO             ! default
6361       iadjust_intermed = mNO    ! default
6362
6363 ! hno3
6364       if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and. &
6365          aer(icl_a,jliquid,ibin) .gt. 0.0)then
6366         call absorb_tiny_hno3(ibin)     ! and degas tiny hcl
6367         iadjust = mYES
6368         iadjust_intermed = mYES
6369       endif
6370
6371       if(iadjust_intermed .eq. mYES)then
6372         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6373         iadjust_intermed = mNO  ! reset
6374       endif
6375
6376 ! hcl
6377       if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin).eq.0. .and. &
6378          aer(ino3_a,jliquid,ibin) .gt. 0.0)then
6379         call absorb_tiny_hcl(ibin)      ! and degas tiny hno3
6380         iadjust = mYES
6381         iadjust_intermed = mYES
6382       endif
6383
6384       if(iadjust_intermed .eq. mYES)then
6385         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6386       endif
6387
6388       if(iadjust .eq. mYES)then
6389         call compute_activities(ibin)                   ! update after adjustments
6390       endif
6391
6392 ! all adjustments done...
6393
6394       call ASTEM_flux_wet_case4(ibin)
6395
6396
6397       return
6398       end subroutine ASTEM_flux_wet
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411 !***********************************************************************
6412 ! part of ASTEM: subroutines for flux_wet cases
6413 !
6414 ! author: Rahul A. Zaveri
6415 ! update: Jan 2007
6416 !-----------------------------------------------------------------------
6417
6418 ! CASE 1: CaCO3 > 0 absorb all acids (and indirectly degas co2)
6419
6420       subroutine ASTEM_flux_wet_case1(ibin)
6421 !      implicit none
6422 !      include 'mosaic.h'
6423 ! subr arguments
6424       integer ibin
6425 ! local variables
6426       integer iv
6427
6428       mc(jc_h,ibin) = sqrt(Keq_ll(3))
6429
6430 ! same as dry case1
6431       if(gas(ihno3_g) .gt. 1.e-5)then
6432         sfc_a(ihno3_g) = 0.0
6433         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
6434         phi_volatile_s(ihno3_g,ibin) = 1.0
6435         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
6436         integrate(ihno3_g,jsolid,ibin) = mYES
6437         jphase(ibin) = jsolid
6438         ieqblm_ASTEM = mNO
6439       endif
6440
6441       if(gas(ihcl_g) .gt. 1.e-5)then
6442         sfc_a(ihcl_g)  = 0.0
6443         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
6444         phi_volatile_s(ihcl_g,ibin) = 1.0
6445         flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
6446         integrate(ihcl_g,jsolid,ibin)  = mYES
6447         jphase(ibin) = jsolid
6448         ieqblm_ASTEM = mNO
6449       endif
6450
6451       return
6452       end subroutine ASTEM_flux_wet_case1
6453
6454
6455
6456 !--------------------------------------------------------------------
6457 ! CASE 2: Sulfate-Rich Domain
6458
6459       subroutine ASTEM_flux_wet_case2(ibin)
6460 !      implicit none
6461 !      include 'mosaic.h'
6462 ! subr arguments
6463       integer ibin
6464 ! local variables
6465       real(kind=8) dum_hno3, dum_hcl, dum_nh3
6466
6467
6468       sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
6469                        gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
6470                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6471
6472       sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
6473                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
6474                    Keq_gl(3)
6475
6476       sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
6477                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
6478                    Keq_gl(4)
6479
6480       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6481       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6482       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6483
6484
6485 ! compute relative driving forces
6486       if(dum_hno3 .gt. 0.0)then
6487         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6488         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6489       else
6490         phi_volatile_l(ihno3_g,ibin)= 0.0
6491       endif
6492
6493       if(dum_hcl .gt. 0.0)then
6494         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6495         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6496       else
6497         phi_volatile_l(ihcl_g,ibin) = 0.0
6498       endif
6499
6500       if(dum_nh3 .gt. 0.0)then
6501         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6502         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6503       else
6504         phi_volatile_l(inh3_g,ibin) = 0.0
6505       endif
6506
6507
6508       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6509          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6510          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6511
6512         return
6513
6514       endif
6515
6516
6517 ! compute Heff
6518       if(dum_hno3 .gt. 0.0)then
6519         Heff(ihno3_g,ibin)=  &
6520           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6521                        (water_a(ibin)*Keq_gl(3))
6522         integrate(ihno3_g,jliquid,ibin)= mYES
6523         ieqblm_ASTEM = mNO
6524       endif
6525
6526       if(dum_hcl .gt. 0.0)then
6527         Heff(ihcl_g,ibin)=  &
6528           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6529                        (water_a(ibin)*Keq_gl(4))
6530         integrate(ihcl_g,jliquid,ibin) = mYES
6531         ieqblm_ASTEM = mNO
6532       endif
6533
6534       if(dum_nh3 .gt. 0.0)then
6535         Heff(inh3_g,ibin) =  &
6536              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6537              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6538         integrate(inh3_g,jliquid,ibin) = mYES
6539         ieqblm_ASTEM = mNO
6540       endif
6541
6542
6543       return
6544       end subroutine ASTEM_flux_wet_case2
6545
6546
6547
6548
6549
6550
6551
6552
6553 !---------------------------------------------------------------------
6554 ! CASE 3: nh4no3 and/or nh4cl may be active
6555
6556       subroutine ASTEM_flux_wet_case3(ibin)
6557 !      implicit none
6558 !      include 'mosaic.h'
6559 ! subr arguments
6560       integer ibin
6561 ! local variables
6562       real(kind=8) a, b, c, dum_hno3, dum_hcl, dum_nh3
6563 ! function
6564 !      real(kind=8) quadratic
6565
6566       a =   kg(inh3_g,ibin)
6567       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
6568           + kg(ihno3_g,ibin)*gas(ihno3_g)  &
6569           + kg(ihcl_g,ibin)*gas(ihcl_g)
6570       c = -(kg(ihno3_g,ibin)*Keq_nh4no3 + kg(ihcl_g,ibin)*Keq_nh4cl)
6571
6572       sfc_a(inh3_g)  = quadratic(a,b,c)
6573       sfc_a(ihno3_g) = Keq_nh4no3/max(sfc_a(inh3_g),1.D-20)
6574       sfc_a(ihcl_g)  = Keq_nh4cl/max(sfc_a(inh3_g),1.D-20)
6575
6576
6577 ! diagnose mH+
6578       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6579         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6580         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6581       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6582         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6583         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6584       else
6585         call equilibrate_acids(ibin)    ! hno3 and/or hcl may be > 0 in the gas phase
6586         mc(jc_h,ibin)  = max(mc(jc_h,ibin), sqrt(Keq_ll(3)))
6587
6588         sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
6589                          gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
6590                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6591
6592         sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
6593                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
6594                    Keq_gl(3)
6595         sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
6596                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
6597                    Keq_gl(4)
6598       endif
6599
6600
6601
6602       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6603       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6604       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6605
6606 ! compute relative driving forces
6607       if(dum_hno3 .gt. 0.0)then
6608         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6609         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6610       else
6611         phi_volatile_l(ihno3_g,ibin)= 0.0
6612       endif
6613
6614       if(dum_hcl .gt. 0.0)then
6615         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6616         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6617       else
6618         phi_volatile_l(ihcl_g,ibin) = 0.0
6619       endif
6620
6621       if(dum_nh3 .gt. 0.0)then
6622         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6623         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6624       else
6625         phi_volatile_l(inh3_g,ibin) = 0.0
6626       endif
6627
6628
6629
6630       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6631          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6632          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6633
6634         return
6635
6636       endif
6637
6638
6639 ! compute Heff
6640       if(dum_hno3 .gt. 0.0)then
6641         Heff(ihno3_g,ibin)=  &
6642           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6643                        (water_a(ibin)*Keq_gl(3))
6644         integrate(ihno3_g,jliquid,ibin)= mYES
6645         ieqblm_ASTEM = mNO
6646       endif
6647
6648       if(dum_hcl .gt. 0.0)then
6649         Heff(ihcl_g,ibin)=  &
6650           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6651                        (water_a(ibin)*Keq_gl(4))
6652         integrate(ihcl_g,jliquid,ibin) = mYES
6653         ieqblm_ASTEM = mNO
6654       endif
6655
6656       if(dum_nh3 .gt. 0.0)then
6657         Heff(inh3_g,ibin) =  &
6658              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6659              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6660         integrate(inh3_g,jliquid,ibin) = mYES
6661         ieqblm_ASTEM = mNO
6662       endif
6663
6664
6665
6666       return
6667       end subroutine ASTEM_flux_wet_case3
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677 !--------------------------------------------------------------------
6678 ! CASE 3a: only NH4NO3 (aq) active
6679
6680       subroutine ASTEM_flux_wet_case3a(ibin)    ! NH4NO3 (aq)
6681 !      implicit none
6682 !      include 'mosaic.h'
6683 ! subr arguments
6684       integer ibin
6685 ! local variables
6686       real(kind=8) a, b, c, dum_hno3, dum_nh3
6687 ! function
6688 !      real(kind=8) quadratic
6689
6690
6691       a =   kg(inh3_g,ibin)
6692       b = - kg(inh3_g,ibin)*gas(inh3_g) &
6693           + kg(ihno3_g,ibin)*gas(ihno3_g)
6694       c = -(kg(ihno3_g,ibin)*Keq_nh4no3)
6695
6696       sfc_a(inh3_g)  = quadratic(a,b,c)
6697       sfc_a(ihno3_g) = Keq_nh4no3/sfc_a(inh3_g)
6698
6699
6700 ! diagnose mH+
6701       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6702         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6703           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6704       else
6705         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6706       endif
6707
6708
6709 ! compute Heff
6710       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6711       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6712
6713 ! compute relative driving forces
6714       if(dum_hno3 .gt. 0.0)then
6715         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6716         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6717       else
6718         phi_volatile_l(ihno3_g,ibin)= 0.0
6719       endif
6720
6721       if(dum_nh3 .gt. 0.0)then
6722         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6723         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6724       else
6725         phi_volatile_l(inh3_g,ibin) = 0.0
6726       endif
6727
6728
6729       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6730          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6731
6732         return
6733
6734       endif
6735
6736
6737 ! compute Heff
6738       Heff(ihno3_g,ibin)=  &
6739         kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6740                      (water_a(ibin)*Keq_gl(3))
6741       integrate(ihno3_g,jliquid,ibin)= mYES
6742
6743
6744       Heff(inh3_g,ibin) =  &
6745            kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6746            (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6747       integrate(inh3_g,jliquid,ibin) = mYES
6748
6749
6750       ieqblm_ASTEM = mNO
6751
6752
6753       return
6754       end subroutine ASTEM_flux_wet_case3a
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764 !--------------------------------------------------------------------
6765 ! CASE 3b: only NH4Cl (aq) active
6766
6767       subroutine ASTEM_flux_wet_case3b(ibin)    ! NH4Cl (aq)
6768 !      implicit none
6769 !      include 'mosaic.h'
6770 ! subr arguments
6771       integer ibin
6772 ! local variables
6773       real(kind=8) a, b, c, dum_hcl, dum_nh3
6774 ! function
6775 !      real(kind=8) quadratic
6776
6777
6778       a =   kg(inh3_g,ibin)
6779       b = - kg(inh3_g,ibin)*gas(inh3_g) &
6780           + kg(ihcl_g,ibin)*gas(ihcl_g)
6781       c = -(kg(ihcl_g,ibin)*Keq_nh4cl)
6782
6783       sfc_a(inh3_g)  = quadratic(a,b,c)
6784       sfc_a(ihcl_g)  = Keq_nh4cl /sfc_a(inh3_g)
6785
6786
6787 ! diagnose mH+
6788       if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6789         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6790           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6791       else
6792         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6793       endif
6794
6795
6796 ! compute Heff
6797       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6798       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6799
6800
6801 ! compute relative driving forces
6802       if(dum_hcl .gt. 0.0)then
6803         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6804         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6805       else
6806         phi_volatile_l(ihcl_g,ibin) = 0.0
6807       endif
6808
6809       if(dum_nh3 .gt. 0.0)then
6810         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6811         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6812       else
6813         phi_volatile_l(inh3_g,ibin) = 0.0
6814       endif
6815
6816
6817
6818       if(phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6819          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6820
6821         return
6822
6823       endif
6824
6825
6826
6827 ! compute Heff
6828       Heff(ihcl_g,ibin)=  &
6829           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6830                        (water_a(ibin)*Keq_gl(4))
6831       integrate(ihcl_g,jliquid,ibin) = mYES
6832
6833
6834       Heff(inh3_g,ibin) =  &
6835              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6836              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6837       integrate(inh3_g,jliquid,ibin) = mYES
6838
6839
6840       ieqblm_ASTEM = mNO
6841
6842
6843
6844       return
6845       end subroutine ASTEM_flux_wet_case3b
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855 !-----------------------------------------------------------------------
6856 ! CASE 4: NH3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
6857
6858       subroutine ASTEM_flux_wet_case4(ibin)
6859 !      implicit none
6860 !      include 'mosaic.h'
6861 ! subr arguments
6862       integer ibin
6863 ! local variables
6864       real(kind=8) dum_numer, dum_denom, gas_eqb_ratio, dum_hno3, dum_hcl
6865
6866
6867       dum_numer = kel(ihno3_g,ibin)*Keq_gl(4)*ma(ja_no3,ibin)* &
6868                   gam(jhno3,ibin)**2
6869       dum_denom = kel(ihcl_g,ibin)*Keq_gl(3)*ma(ja_cl ,ibin)* &
6870                   gam(jhcl,ibin)**2
6871
6872
6873       if(dum_denom .eq. 0.0 .or. dum_numer .eq. 0.0)then
6874         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6875         return
6876       endif
6877
6878       gas_eqb_ratio = dum_numer/dum_denom       ! Ce,hno3/Ce,hcl
6879
6880
6881 ! compute equilibrium surface concentrations
6882       sfc_a(ihcl_g) =  &
6883        ( kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g) )/ &
6884            ( kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin) )
6885       sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
6886
6887
6888 ! diagnose mH+
6889       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6890         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6891         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6892       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6893         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6894         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6895       else
6896         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6897       endif
6898
6899
6900 ! compute Heff
6901       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g)) ! raz-30apr07
6902       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))   ! raz-30apr07
6903
6904 ! compute relative driving forces
6905       if(dum_hno3 .gt. 0.0)then
6906         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6907         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6908       else
6909         phi_volatile_l(ihno3_g,ibin)= 0.0
6910       endif
6911
6912       if(dum_hcl .gt. 0.0)then
6913         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6914         phi_volatile_l(ihcl_g,ibin)= df_gas_l(ihcl_g,ibin)/dum_hcl
6915       else
6916         phi_volatile_l(ihcl_g,ibin)= 0.0
6917       endif
6918
6919
6920       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6921          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem)then
6922
6923         return
6924
6925       endif
6926
6927
6928
6929 ! compute Heff
6930       Heff(ihno3_g,ibin)=  &
6931           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6932                        (water_a(ibin)*Keq_gl(3))
6933       integrate(ihno3_g,jliquid,ibin)= mYES
6934
6935
6936       Heff(ihcl_g,ibin)=  &
6937           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6938                        (water_a(ibin)*Keq_gl(4))
6939       integrate(ihcl_g,jliquid,ibin) = mYES
6940
6941
6942       ieqblm_ASTEM = mNO
6943
6944
6945
6946       return
6947       end subroutine ASTEM_flux_wet_case4
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962 !===========================================================
6963 !
6964 ! DRY PARTICLES
6965 !
6966 !===========================================================
6967 !***********************************************************************
6968 ! part of ASTEM: computes gas-aerosol fluxes over dry aerosols
6969 !
6970 ! author: Rahul A. Zaveri
6971 ! update: dec 2006
6972 !-----------------------------------------------------------------------
6973       subroutine ASTEM_flux_dry(ibin)
6974 !      implicit none
6975 !      include 'mosaic.h'
6976 ! subr arguments
6977       integer ibin
6978 ! local variables
6979       integer iv
6980       real(kind=8) XT, prod_nh4no3, prod_nh4cl, volatile_cl
6981
6982
6983
6984
6985       call calculate_XT(ibin,jsolid,XT)
6986
6987 !-----------------------------------------------------------------
6988 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
6989
6990       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
6991
6992         call ASTEM_flux_dry_case1(ibin)
6993
6994         return
6995       endif
6996
6997 !-----------------------------------------------------------------
6998 ! CASE 2: Sulfate-Rich Domain
6999
7000       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
7001
7002         call ASTEM_flux_dry_case2(ibin)
7003
7004         return
7005       endif
7006
7007 !-------------------------------------------------------------------
7008 ! CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
7009
7010       volatile_cl  = electrolyte(jnacl,jsolid,ibin) + &
7011                      electrolyte(jcacl2,jsolid,ibin)
7012
7013
7014       if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
7015
7016         call ASTEM_flux_dry_case3a(ibin)
7017
7018         Keq_nh4cl_0  = min(Kp_nh4cl_0,  Keq_sg(2))      ! raz update 6/25/2008
7019
7020         prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_nh4cl_0), 0.0d0) +   &
7021                      electrolyte(jnh4cl, jsolid,ibin)   ! raz update 6/25/2008
7022
7023         if(prod_nh4cl .gt. 0.0)then
7024           call ASTEM_flux_dry_case3b(ibin)
7025         endif
7026
7027         return
7028       endif
7029
7030 !-----------------------------------------------------------------
7031 ! CASE 4: nh4no3 or nh4cl or both may be active
7032
7033       Keq_nh4no3_0 = min(Kp_nh4no3_0, Keq_sg(1))        ! raz update 6/25/2008
7034       Keq_nh4cl_0  = min(Kp_nh4cl_0,  Keq_sg(2))        ! raz update 6/25/2008
7035
7036       prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-Keq_nh4no3_0), 0.0d0) +   &
7037                     electrolyte(jnh4no3,jsolid,ibin)    ! raz update 6/25/2008
7038       prod_nh4cl  = max( (gas(inh3_g)*gas(ihcl_g) -Keq_nh4cl_0), 0.0d0) +   &
7039                     electrolyte(jnh4cl, jsolid,ibin)    ! raz update 6/25/2008
7040
7041       if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
7042         call ASTEM_flux_dry_case4(ibin)
7043         return
7044       endif
7045
7046 !-----------------------------------------------------------------
7047
7048       return
7049       end subroutine ASTEM_flux_dry
7050
7051 !----------------------------------------------------------------------
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065 !***********************************************************************
7066 ! part of ASTEM: subroutines for flux_dry cases
7067 !
7068 ! author: Rahul A. Zaveri
7069 ! update: dec 2006
7070 !-----------------------------------------------------------------------
7071
7072 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
7073
7074       subroutine ASTEM_flux_dry_case1(ibin)
7075 !      implicit none
7076 !      include 'mosaic.h'
7077 ! subr arguments
7078       integer ibin
7079
7080
7081       if(gas(ihno3_g) .gt. 1.e-5)then
7082         sfc_a(ihno3_g) = 0.0
7083         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
7084         phi_volatile_s(ihno3_g,ibin) = 1.0
7085         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
7086         integrate(ihno3_g,jsolid,ibin) = mYES
7087         ieqblm_ASTEM = mNO
7088       endif
7089
7090       if(gas(ihcl_g) .gt. 1.e-5)then
7091         sfc_a(ihcl_g)  = 0.0
7092         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
7093         phi_volatile_s(ihcl_g,ibin) = 1.0
7094         flux_s(ihcl_g,ibin)  = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
7095         integrate(ihcl_g,jsolid,ibin)  = mYES
7096         ieqblm_ASTEM = mNO
7097       endif
7098
7099
7100       return
7101       end subroutine ASTEM_flux_dry_case1
7102
7103
7104
7105 !---------------------------------------------------------------------
7106 ! CASE 2: Sulfate-Rich Domain
7107
7108       subroutine ASTEM_flux_dry_case2(ibin) ! TOUCH
7109 !      implicit none
7110 !      include 'mosaic.h'
7111 ! subr arguments
7112       integer ibin
7113
7114
7115       if(gas(inh3_g).gt.1.e-5)then
7116         sfc_a(inh3_g) = 0.0
7117         df_gas_s(inh3_g,ibin) = gas(inh3_g)
7118         phi_volatile_s(inh3_g,ibin)  = 1.0
7119         flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
7120         integrate(inh3_g,jsolid,ibin) = mYES
7121         ieqblm_ASTEM = mNO
7122       endif
7123
7124
7125       return
7126       end subroutine ASTEM_flux_dry_case2
7127
7128
7129
7130
7131 !---------------------------------------------------------------------
7132 ! CASE 3a: degas hcl from nacl or cacl2 by flux_s balance with hno3
7133
7134       subroutine ASTEM_flux_dry_case3a(ibin)
7135 !      implicit none
7136 !      include 'mosaic.h'
7137 ! subr arguments
7138       integer ibin
7139
7140
7141       if(gas(ihno3_g) .gt. 1.e-5)then
7142         sfc_a(ihno3_g) = 0.0
7143         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
7144
7145         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
7146         df_gas_s(ihcl_g,ibin)  = -aer(icl_a,jsolid,ibin)
7147
7148         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
7149         flux_s(ihcl_g,ibin)  = -flux_s(ihno3_g,ibin)
7150
7151         phi_volatile_s(ihno3_g,ibin) = 1.0
7152         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)
7153
7154         integrate(ihno3_g,jsolid,ibin) = mYES
7155         integrate(ihcl_g,jsolid,ibin)  = mYES
7156
7157         idry_case3a(ibin) = mYES
7158         ieqblm_ASTEM = mNO
7159       endif
7160
7161       return
7162       end subroutine ASTEM_flux_dry_case3a
7163
7164
7165
7166
7167 !---------------------------------------------------------------------
7168 ! CASE 3b: nh4cl may form/evaporate here
7169
7170       subroutine ASTEM_flux_dry_case3b(ibin)    ! TOUCH
7171 !      implicit none
7172 !      include 'mosaic.h'
7173 ! subr arguments
7174       integer ibin
7175 ! local variables
7176       integer iactive_nh4cl, js ! raz update 11/13/2008
7177       real(kind=8) a, b, c, sum_dum     ! raz update 11/13/2008
7178 ! function
7179 !      real(kind=8) quadratic
7180
7181
7182 ! calculate percent composition ! raz update 11/13/2008
7183       sum_dum = 0.0
7184       do js = 1, nsalt
7185         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7186       enddo
7187
7188       if(sum_dum .eq. 0.)sum_dum = 1.0
7189
7190       epercent(jnh4cl,jsolid,ibin) = 100.*electrolyte(jnh4cl,jsolid,ibin)/sum_dum
7191
7192
7193
7194
7195 !-------------------
7196 ! set default values for flags
7197       iactive_nh4cl  = 1
7198
7199
7200 ! compute relative driving force
7201       phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7202                     max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7203
7204
7205 !-------------------
7206 ! now determine if nh4cl is active or significant
7207 ! nh4cl
7208       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
7209         iactive_nh4cl = 0
7210       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7211              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
7212         iactive_nh4cl = 0
7213         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
7214           call degas_solid_nh4cl(ibin)
7215         endif
7216       endif
7217
7218
7219 ! check the outcome
7220       if(iactive_nh4cl .eq. 0)return
7221
7222
7223 !-----------------
7224 ! nh4cl is active
7225
7226
7227       a =   kg(inh3_g,ibin)
7228       b = - kg(inh3_g,ibin)*gas(inh3_g) &
7229           + kg(ihcl_g,ibin)*gas(ihcl_g)
7230       c = -(kg(ihcl_g,ibin)*Keq_sg(2))
7231
7232       sfc_a(inh3_g) = quadratic(a,b,c)
7233       sfc_a(ihcl_g) = Keq_sg(2)/sfc_a(inh3_g)
7234
7235       df_gas_s(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
7236       df_gas_s(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
7237
7238       flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas_s(inh3_g,ibin)
7239       flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) + flux_s(inh3_g,ibin)
7240
7241       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
7242
7243       if(flux_s(ihcl_g,ibin) .gt. 0.0)then
7244         df_gas_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)     ! recompute df_gas
7245         phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
7246       else
7247         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
7248         df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
7249         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)  ! not to be used
7250       endif
7251
7252       integrate(inh3_g,jsolid,ibin) = mYES
7253       integrate(ihcl_g,jsolid,ibin) = mYES      ! integrate HCl with explicit euler
7254
7255       ieqblm_ASTEM = mNO
7256
7257       return
7258       end subroutine ASTEM_flux_dry_case3b
7259
7260
7261
7262
7263 !---------------------------------------------------------------------
7264 ! Case 4: NH4NO3 and/or NH4Cl may be active
7265
7266       subroutine ASTEM_flux_dry_case4(ibin)     ! TOUCH
7267 !      implicit none
7268 !      include 'mosaic.h'
7269 ! subr arguments
7270       integer ibin
7271 ! local variables
7272       integer iactive_nh4no3, iactive_nh4cl, iactive, js        ! raz update 11/13/2008
7273       real(kind=8) a, b, c, sum_dum                                     ! raz update 11/13/2008
7274 ! function
7275 !      real(kind=8) quadratic
7276
7277
7278
7279 ! calculate percent composition ! raz update 11/13/2008
7280       sum_dum = 0.0
7281       do js = 1, nsalt
7282         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7283       enddo
7284
7285       if(sum_dum .eq. 0.)sum_dum = 1.0
7286
7287       epercent(jnh4no3,jsolid,ibin) = 100.*electrolyte(jnh4no3,jsolid,ibin)/sum_dum
7288       epercent(jnh4cl, jsolid,ibin) = 100.*electrolyte(jnh4cl, jsolid,ibin)/sum_dum
7289
7290
7291
7292 !-------------------
7293 ! set default values for flags
7294       iactive_nh4no3 = 1
7295       iactive_nh4cl  = 2
7296
7297
7298 ! compute diagnostic products and ratios
7299       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
7300                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
7301       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7302                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7303
7304
7305 !-------------------
7306 ! now determine if nh4no3 and/or nh4cl are active or significant
7307
7308 ! nh4no3
7309       if( abs(phi_nh4no3_s) .lt. rtol_eqb_ASTEM )then
7310         iactive_nh4no3 = 0
7311       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
7312              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
7313         iactive_nh4no3 = 0
7314         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
7315           call degas_solid_nh4no3(ibin)
7316         endif
7317       endif
7318
7319 ! nh4cl
7320       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
7321         iactive_nh4cl = 0
7322       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7323              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
7324         iactive_nh4cl = 0
7325         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
7326           call degas_solid_nh4cl(ibin)
7327         endif
7328       endif
7329
7330
7331       iactive = iactive_nh4no3 + iactive_nh4cl
7332
7333 ! check the outcome
7334       if(iactive .eq. 0)return
7335
7336
7337       goto (1,2,3),iactive
7338
7339 !---------------------------------
7340 ! only nh4no3 solid is active
7341 1     call ASTEM_flux_dry_case4a(ibin)
7342
7343       return
7344
7345
7346 !-----------------
7347 ! only nh4cl solid is active
7348 2     call ASTEM_flux_dry_case4b(ibin)
7349
7350       return
7351
7352
7353 !-----------------
7354 ! both nh4no3 and nh4cl are active
7355 3     call ASTEM_flux_dry_case4ab(ibin)
7356
7357
7358
7359
7360       return
7361       end subroutine ASTEM_flux_dry_case4
7362
7363
7364
7365
7366
7367
7368
7369 !---------------------------------------------------------------------
7370 ! Case 4a
7371
7372       subroutine ASTEM_flux_dry_case4a(ibin) ! NH4NO3 solid
7373 !      implicit none
7374 !      include 'mosaic.h'
7375 ! subr arguments
7376       integer ibin
7377 ! local variables
7378       real(kind=8) a, b, c
7379 ! function
7380 !      real(kind=8) quadratic
7381
7382
7383
7384       a =   kg(inh3_g,ibin)
7385       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
7386           + kg(ihno3_g,ibin)*gas(ihno3_g)
7387       c = -(kg(ihno3_g,ibin)*Keq_nh4no3_0)      ! raz update 6/25/2008
7388
7389       sfc_a(inh3_g)  = quadratic(a,b,c)
7390       sfc_a(ihno3_g) = Keq_nh4no3_0/sfc_a(inh3_g) ! raz update 6/25/2008
7391
7392       integrate(ihno3_g,jsolid,ibin) = mYES
7393       integrate(inh3_g,jsolid,ibin)  = mYES
7394
7395       df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
7396       df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
7397
7398       phi_volatile_s(ihno3_g,ibin)= phi_nh4no3_s
7399       phi_volatile_s(inh3_g,ibin) = phi_nh4no3_s
7400
7401       flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
7402       flux_s(inh3_g,ibin)  = flux_s(ihno3_g,ibin)
7403
7404       ieqblm_ASTEM = mNO
7405
7406       return
7407       end subroutine ASTEM_flux_dry_case4a
7408
7409
7410
7411
7412 !---------------------------------------------------------
7413 ! Case 4b
7414
7415       subroutine ASTEM_flux_dry_case4b(ibin) ! NH4Cl solid
7416 !      implicit none
7417 !      include 'mosaic.h'
7418 ! subr arguments
7419       integer ibin
7420 ! local variables
7421       real(kind=8) a, b, c
7422 ! function
7423 !      real(kind=8) quadratic
7424
7425
7426       a =   kg(inh3_g,ibin)
7427       b = - kg(inh3_g,ibin)*gas(inh3_g) &
7428           + kg(ihcl_g,ibin)*gas(ihcl_g)
7429       c = -(kg(ihcl_g,ibin)*Keq_nh4cl_0)        ! raz update 6/25/2008
7430
7431       sfc_a(inh3_g) = quadratic(a,b,c)
7432       sfc_a(ihcl_g) = Keq_nh4cl_0 /sfc_a(inh3_g)        ! raz update 6/25/2008
7433
7434       integrate(ihcl_g,jsolid,ibin) = mYES
7435       integrate(inh3_g,jsolid,ibin) = mYES
7436
7437       df_gas_s(ihcl_g,ibin) = gas(ihcl_g)-sfc_a(ihcl_g)
7438       df_gas_s(inh3_g,ibin) = gas(inh3_g)-sfc_a(inh3_g)
7439
7440       phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
7441       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
7442
7443       flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
7444       flux_s(inh3_g,ibin) = flux_s(ihcl_g,ibin)
7445
7446       ieqblm_ASTEM = mNO
7447
7448       return
7449       end subroutine ASTEM_flux_dry_case4b
7450
7451
7452
7453
7454 !-------------------------------------------------------------------
7455 ! Case 4ab
7456
7457       subroutine ASTEM_flux_dry_case4ab(ibin)   ! NH4NO3 + NH4Cl (solid)
7458 !      implicit none
7459 !      include 'mosaic.h'
7460 ! subr arguments
7461       integer ibin
7462 ! local variables
7463       real(kind=8) a, b, c, &
7464            flux_nh3_est, flux_nh3_max, ratio_flux
7465 ! function
7466 !      real(kind=8) quadratic
7467
7468       call ASTEM_flux_dry_case4a(ibin)
7469       call ASTEM_flux_dry_case4b(ibin)
7470
7471
7472 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
7473
7474       flux_nh3_est = flux_s(ihno3_g,ibin)+flux_s(ihcl_g,ibin)
7475       flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
7476
7477
7478       if(flux_nh3_est .le. flux_nh3_max)then
7479
7480         flux_s(inh3_g,ibin) = flux_nh3_est                      ! all ok - no adjustments needed
7481         sfc_a(inh3_g)       = gas(inh3_g) -  &                  ! recompute sfc_a(ihno3_g)
7482                               flux_s(inh3_g,ibin)/kg(inh3_g,ibin)
7483         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
7484                                           abs(phi_nh4cl_s))
7485
7486       else                      ! reduce hno3 and hcl flux_ses as necessary so that nh3 flux_s = flux_s_nh3_max
7487
7488         ratio_flux          = flux_nh3_max/flux_nh3_est
7489         flux_s(inh3_g,ibin) = flux_nh3_max
7490         flux_s(ihno3_g,ibin)= flux_s(ihno3_g,ibin)*ratio_flux
7491         flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) *ratio_flux
7492
7493         sfc_a(inh3_g) = 0.0
7494         sfc_a(ihno3_g)= gas(ihno3_g) -  &       ! recompute sfc_a(ihno3_g)
7495                         flux_s(ihno3_g,ibin)/kg(ihno3_g,ibin)
7496         sfc_a(ihcl_g) = gas(ihcl_g) -   &       ! recompute sfc_a(ihcl_g)
7497                         flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)
7498
7499         df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
7500         df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
7501         df_gas_s(ihcl_g,ibin) =gas(ihcl_g) -sfc_a(ihcl_g)
7502
7503         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
7504                                           abs(phi_nh4cl_s))
7505
7506       endif
7507
7508       ieqblm_ASTEM = mNO
7509
7510       return
7511       end subroutine ASTEM_flux_dry_case4ab
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523 !=======================================================================
7524 !
7525 ! MIXED-PHASE PARTICLES
7526 !
7527 !***********************************************************************
7528 ! part of ASTEM: computes gas-aerosol fluxes over mixed-phase aerosols
7529 !
7530 ! author: Rahul A. Zaveri
7531 ! update: apr 2006
7532 !-----------------------------------------------------------------------
7533
7534       subroutine ASTEM_flux_mix(ibin)
7535       use module_data_mosaic_other, only:  lunerr
7536 !      implicit none
7537 !      include 'mosaic.h'
7538 ! subr arguments
7539       integer ibin
7540 ! local variables
7541       integer iv, iadjust, iadjust_intermed, js         ! raz update 11/13/2008
7542       real(kind=8) XT, g_nh3_hno3, g_nh3_hcl, &
7543            a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
7544            prod_nh4no3, prod_nh4cl
7545       real(kind=8) volatile_cl, sum_dum                 ! raz update 11/13/2008
7546
7547
7548       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
7549       call compute_activities(ibin)
7550
7551       if(water_a(ibin) .eq. 0.0)then
7552         write(6,*)'Water is zero in liquid phase'
7553         call peg_error_fatal( lunerr, "Stopping in ASTEM_flux_wet" )
7554       endif
7555
7556
7557
7558 ! calculate percent composition ! raz update 11/13/2008
7559       sum_dum = 0.0
7560       do js = 1, nsalt
7561         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7562       enddo
7563
7564       if(sum_dum .eq. 0.)sum_dum = 1.0
7565
7566       epercent(jcaco3,jsolid,ibin) = 100.*electrolyte(jcaco3,jsolid,ibin)/sum_dum
7567
7568
7569 ! reset
7570         Keq_nh4no3_0 = Keq_sg(1)        ! raz update 6/25/2008
7571         Keq_nh4cl_0  = Keq_sg(2)        ! raz update 6/25/2008
7572
7573 !-----------------------------------------------------------------
7574 ! MIXED CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
7575
7576       if(epercent(jcaco3,jsolid,ibin) .gt. 0.0)then
7577         jphase(ibin) = jliquid
7578         call ASTEM_flux_wet_case1(ibin)
7579         return
7580       endif
7581
7582 !-----------------------------------------------------------------
7583 ! MIXED CASE 2: Sulfate-Rich Domain
7584
7585       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
7586         jphase(ibin) = jliquid
7587         call ASTEM_flux_wet_case2(ibin)
7588         return
7589       endif
7590
7591 !-------------------------------------------------------------------
7592 ! MIXED CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
7593
7594       volatile_cl  = electrolyte(jnacl,jsolid,ibin) +   &
7595                      electrolyte(jcacl2,jsolid,ibin)
7596
7597
7598       if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
7599
7600         call ASTEM_flux_dry_case3a(ibin)
7601
7602         prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_sg(2)), 0.0d0) +   &
7603                      electrolyte(jnh4cl, jsolid,ibin)
7604
7605         if(prod_nh4cl .gt. 0.0)then
7606           call ASTEM_flux_dry_case3b(ibin)
7607         endif
7608
7609         jphase(ibin) = jsolid
7610
7611         return
7612       endif
7613
7614 !-------------------------------------------------------------------
7615 ! MIXED CASE 4: nh4no3 or nh4cl or both may be active
7616
7617       if( electrolyte(jnh4no3,jsolid,ibin).gt.0. .and. &
7618           electrolyte(jnh4cl,jsolid,ibin) .gt.0. )then
7619         jphase(ibin) = jsolid
7620         call ASTEM_flux_dry_case4(ibin)
7621
7622         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7623           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7624           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7625         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7626           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7627           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7628         else
7629           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7630         endif
7631
7632         return
7633
7634       elseif( electrolyte(jnh4no3,jsolid,ibin).gt.0. )then
7635 ! do small adjustments for nh4cl aq
7636         g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
7637         a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
7638
7639         iadjust = mNO           ! initialize
7640         if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .eq. 0.0)then
7641           call absorb_tiny_nh4cl(ibin)
7642           iadjust = mYES
7643         elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
7644           call degas_tiny_nh4cl(ibin)
7645           iadjust = mYES
7646         endif
7647
7648         if(iadjust .eq. mYES)then
7649           call ions_to_electrolytes(jliquid,ibin,XT)  ! update after adjustments
7650           call compute_activities(ibin)                 ! update after adjustments
7651         endif
7652
7653         call ASTEM_flux_mix_case4a(ibin)        ! nh4no3 solid + nh4cl aq
7654         jphase(ibin) = jtotal
7655         return
7656
7657       elseif( electrolyte(jnh4cl,jsolid,ibin).gt.0.)then
7658 ! do small adjustments for nh4no3 aq
7659         g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
7660         a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
7661
7662         iadjust = mNO           ! initialize
7663         if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .eq. 0.0)then
7664           call absorb_tiny_nh4no3(ibin)
7665           iadjust = mYES
7666         elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
7667           call degas_tiny_nh4no3(ibin)
7668           iadjust = mYES
7669         endif
7670
7671         if(iadjust .eq. mYES)then
7672           call ions_to_electrolytes(jliquid,ibin,XT)    ! update after adjustments
7673           call compute_activities(ibin)                 ! update after adjustments
7674         endif
7675
7676         kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7677         Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3     ! = [NH3]s * [HNO3]s
7678
7679         call ASTEM_flux_mix_case4b(ibin)        ! nh4cl solid + nh4no3 aq
7680         jphase(ibin) = jtotal
7681         return
7682       endif
7683
7684
7685 !-------------------------------------------------------------------
7686
7687       if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10  ! no ammonia in the system
7688
7689 !-------------------------------------------------------------------
7690 ! MIXED CASE 5: liquid nh4no3 and/or nh4cl maybe active
7691 ! do some small adjustments (if needed) before deciding case 3
7692
7693       iadjust = mNO             ! default
7694       iadjust_intermed = mNO    ! default
7695
7696 ! nh4no3
7697       g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
7698       a_nh4_no3  = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
7699
7700       if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
7701         call absorb_tiny_nh4no3(ibin)
7702         iadjust = mYES
7703         iadjust_intermed = mYES
7704       endif
7705
7706       if(iadjust_intermed .eq. mYES)then
7707         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7708         iadjust_intermed = mNO  ! reset
7709       endif
7710
7711 ! nh4cl
7712       g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
7713       a_nh4_cl  = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
7714
7715       if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
7716         call absorb_tiny_nh4cl(ibin)
7717         iadjust = mYES
7718         iadjust_intermed = mYES
7719       endif
7720
7721       if(iadjust_intermed .eq. mYES)then
7722         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7723       endif
7724
7725       if(iadjust .eq. mYES)then
7726         call compute_activities(ibin)                   ! update after adjustments
7727       endif
7728
7729
7730 ! all adjustments done...
7731
7732 !--------
7733       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7734       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
7735
7736       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
7737       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
7738
7739       call ASTEM_flux_wet_case3(ibin)
7740       jphase(ibin) = jliquid
7741
7742       return
7743
7744
7745 !-------------------------------------------------------------------
7746 ! MIXED CASE 6: ammonia = 0. liquid hno3 and hcl exchange may happen here
7747 ! do small adjustments (if needed) before deciding case 4
7748
7749 10    iadjust = mNO             ! default
7750       iadjust_intermed = mNO    ! default
7751
7752 ! hno3
7753       if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and.   &
7754          aer(icl_a,jliquid,ibin) .gt. 0.0)then
7755         call absorb_tiny_hno3(ibin)     ! and degas tiny hcl
7756         iadjust = mYES
7757         iadjust_intermed = mYES
7758       endif
7759
7760       if(iadjust_intermed .eq. mYES)then
7761         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7762         iadjust_intermed = mNO  ! reset
7763       endif
7764
7765 ! hcl
7766       if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin) .eq. 0. .and.   &
7767          aer(ino3_a,jliquid,ibin) .gt. 0.0)then
7768         call absorb_tiny_hcl(ibin)                      ! and degas tiny hno3
7769         iadjust = mYES
7770         iadjust_intermed = mYES
7771       endif
7772
7773       if(iadjust_intermed .eq. mYES)then
7774         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7775       endif
7776
7777       if(iadjust .eq. mYES)then
7778         call compute_activities(ibin)                   ! update after adjustments
7779       endif
7780
7781 ! all adjustments done...
7782
7783       call ASTEM_flux_wet_case4(ibin)
7784       jphase(ibin) = jliquid
7785
7786
7787
7788       return
7789       end subroutine ASTEM_flux_mix
7790
7791 !----------------------------------------------------------------------
7792
7793
7794
7795
7796
7797
7798
7799
7800 !------------------------------------------------------------------
7801 ! Mix Case 4a: NH4NO3 solid maybe active. NH4Cl aq maybe active
7802
7803       subroutine ASTEM_flux_mix_case4a(ibin)    ! TOUCH
7804 !      implicit none
7805 !      include 'mosaic.h'
7806 ! subr arguments
7807       integer ibin
7808 ! local variables
7809       integer iactive_nh4no3, iactive_nh4cl, js ! raz update 11/13/2008
7810       real(kind=8) sum_dum                              ! raz update 11/13/2008
7811
7812
7813 ! set default values for flags
7814       iactive_nh4no3 = mYES
7815       iactive_nh4cl  = mYES
7816
7817
7818 ! calculate percent composition ! raz update 11/13/2008
7819       sum_dum = 0.0
7820       do js = 1, nsalt
7821         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7822       enddo
7823
7824       if(sum_dum .eq. 0.)sum_dum = 1.0
7825
7826       epercent(jnh4no3,jsolid,ibin) = 100.*electrolyte(jnh4no3,jsolid,ibin)/sum_dum
7827
7828
7829
7830 ! nh4no3 (solid)
7831       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
7832                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
7833
7834 ! nh4cl (liquid)
7835       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
7836       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
7837
7838
7839 !-------------------
7840 ! now determine if nh4no3 and/or nh4cl are active or significant
7841 ! nh4no3 solid
7842       if( abs(phi_nh4no3_s) .le. rtol_eqb_ASTEM )then
7843         iactive_nh4no3 = mNO
7844       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
7845              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
7846         iactive_nh4no3 = mNO
7847         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
7848           call degas_solid_nh4no3(ibin)
7849         endif
7850       endif
7851
7852 ! nh4cl aq
7853       if( gas(inh3_g)*gas(ihcl_g).eq.0. .or. Keq_nh4cl.eq.0. )then
7854         iactive_nh4cl = mNO
7855       endif
7856
7857
7858 !---------------------------------
7859       if(iactive_nh4no3 .eq. mYES)then
7860
7861         jphase(ibin) = jsolid
7862         call ASTEM_flux_dry_case4a(ibin)        ! NH4NO3 (solid)
7863
7864         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7865           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7866           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7867         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7868           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7869           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7870         else
7871           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7872         endif
7873
7874       endif
7875
7876
7877       if(iactive_nh4cl .eq. mYES)then
7878
7879         jphase(ibin) = jliquid
7880         call ASTEM_flux_wet_case3b(ibin)        ! NH4Cl (liquid)
7881
7882         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7883           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7884           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7885         else
7886           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7887         endif
7888
7889       endif
7890
7891
7892       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
7893         jphase(ibin) = jtotal
7894       endif
7895
7896
7897
7898       return
7899       end subroutine ASTEM_flux_mix_case4a
7900
7901
7902
7903
7904
7905
7906
7907
7908 !------------------------------------------------------------------
7909 ! Mix Case 4b: NH4Cl solid maybe active. NH4NO3 aq may or maybe active
7910
7911       subroutine ASTEM_flux_mix_case4b(ibin)    ! TOUCH
7912 !      implicit none
7913 !      include 'mosaic.h'
7914 ! subr arguments
7915       integer ibin
7916 ! local variables
7917       integer iactive_nh4no3, iactive_nh4cl, js ! raz update 11/13/2008
7918         real(kind=8) sum_dum                            ! raz update 11/13/2008
7919
7920
7921 ! set default values for flags
7922       iactive_nh4cl  = mYES
7923       iactive_nh4no3 = mYES
7924
7925
7926 ! calculate percent composition ! raz update 11/13/2008
7927       sum_dum = 0.0
7928       do js = 1, nsalt
7929         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7930       enddo
7931
7932       if(sum_dum .eq. 0.)sum_dum = 1.0
7933
7934       epercent(jnh4cl,jsolid,ibin) = 100.*electrolyte(jnh4cl,jsolid,ibin)/sum_dum
7935
7936
7937
7938 ! nh4cl (solid)
7939       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7940                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7941
7942 ! nh4no3 (liquid)
7943       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7944       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
7945
7946
7947 !-------------------
7948 ! now determine if nh4no3 and/or nh4cl are active or significant
7949 ! nh4cl (solid)
7950       if( abs(phi_nh4cl_s) .le. rtol_eqb_ASTEM )then
7951         iactive_nh4cl = mNO
7952       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7953              epercent(jnh4cl,jsolid,ibin) .le. ptol_mol_ASTEM)then
7954         iactive_nh4cl = mNO
7955         if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0)then
7956           call degas_solid_nh4cl(ibin)
7957         endif
7958       endif
7959
7960 ! nh4no3 (liquid)
7961       if( gas(inh3_g)*gas(ihno3_g).eq.0. .or. Keq_nh4no3.eq.0. )then
7962         iactive_nh4no3 = mNO
7963       endif
7964
7965
7966 !---------------------------------
7967       if(iactive_nh4cl .eq. mYES)then
7968
7969         jphase(ibin) = jsolid
7970         call ASTEM_flux_dry_case4b(ibin)        ! NH4Cl (solid)
7971
7972         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7973           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7974           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7975         elseif(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7976           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7977           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7978         else
7979           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7980         endif
7981
7982       endif
7983
7984
7985       if(iactive_nh4no3 .eq. mYES)then
7986
7987         jphase(ibin) = jliquid
7988         call ASTEM_flux_wet_case3a(ibin)        ! NH4NO3 (liquid)
7989
7990         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7991           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7992           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7993         else
7994           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7995         endif
7996
7997       endif
7998
7999
8000       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
8001         jphase(ibin) = jtotal
8002       endif
8003
8004
8005
8006       return
8007       end subroutine ASTEM_flux_mix_case4b
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019 !***********************************************************************
8020 ! part of ASTEM: condenses h2so4, msa, and nh3 analytically over dtchem [s]
8021 !
8022 ! author: Rahul A. Zaveri
8023 ! update: jan 2007
8024 !-----------------------------------------------------------------------
8025
8026       subroutine ASTEM_non_volatiles(dtchem) ! TOUCH
8027 !      implicit none
8028 !      include 'mosaic.h'
8029 ! subr arguments
8030       real(kind=8) dtchem
8031 ! local variables
8032       integer ibin, iupdate_phase_state
8033       real(kind=8) decay_h2so4, decay_msa,   &
8034            delta_h2so4, delta_tmsa, delta_nh3, delta_hno3, delta_hcl, &
8035            delta_so4(nbin_a), delta_msa(nbin_a), &
8036            delta_nh4(nbin_a)
8037                 ! DL (10/7/2012) - move N2O5 het uptake into non-volatile subroutine, so that
8038                 !                       NH3 uptake to balance acid uptake takes place too
8039       real(kind=8) :: decay_n2o5,   &
8040            delta_n2o5, delta_clno2, &
8041            delta_no3_rct1(nbin_a), delta_no3_rct2(nbin_a)
8042       real(kind=8) XT
8043
8044
8045
8046
8047       sumkg_h2so4 = 0.0
8048       sumkg_msa   = 0.0
8049       sumkg_nh3   = 0.0
8050       sumkg_hno3  = 0.0
8051       sumkg_hcl   = 0.0
8052       do ibin = 1, nbin_a
8053         sumkg_h2so4 = sumkg_h2so4 + kg(ih2so4_g,ibin)
8054         sumkg_msa   = sumkg_msa   + kg(imsa_g,ibin)
8055         sumkg_nh3   = sumkg_nh3   + kg(inh3_g,ibin)
8056         sumkg_hno3  = sumkg_hno3  + kg(ihno3_g,ibin)
8057         sumkg_hcl   = sumkg_hcl   + kg(ihcl_g,ibin)
8058       enddo
8059                 ! DL (10/7/2012)
8060       sumkg_n2o5  = 0.0
8061       do ibin = 1, nbin_a
8062         sumkg_n2o5 = sumkg_n2o5 + kg(in2o5_g,ibin)
8063       enddo
8064
8065
8066
8067 !--------------------------------------
8068 ! H2SO4
8069       if(gas(ih2so4_g) .gt. 1.e-14)then
8070
8071 ! integrate h2so4 condensation analytically
8072         decay_h2so4   = exp(-sumkg_h2so4*dtchem)
8073         delta_h2so4   = gas(ih2so4_g)*(1.0 - decay_h2so4)
8074         gas(ih2so4_g) = gas(ih2so4_g)*decay_h2so4
8075
8076
8077 ! now distribute delta_h2so4 to each bin and conform the particle (may degas by massbal)
8078         do ibin = 1, nbin_a
8079           if(jaerosolstate(ibin) .ne. no_aerosol)then
8080             delta_so4(ibin) = delta_h2so4*kg(ih2so4_g,ibin)/sumkg_h2so4
8081             aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
8082                                       delta_so4(ibin)
8083           endif
8084         enddo
8085
8086       else
8087
8088         delta_h2so4 = 0.0
8089         do ibin = 1, nbin_a
8090             delta_so4(ibin) = 0.0
8091         enddo
8092
8093       endif
8094 ! h2so4 condensation is now complete
8095 !--------------------------------------
8096
8097
8098
8099 ! MSA
8100       if(gas(imsa_g) .gt. 1.e-14)then
8101
8102 ! integrate msa condensation analytically
8103         decay_msa   = exp(-sumkg_msa*dtchem)
8104         delta_tmsa  = gas(imsa_g)*(1.0 - decay_msa)
8105         gas(imsa_g) = gas(imsa_g)*decay_msa
8106
8107 ! now distribute delta_msa to each bin and conform the particle (may degas by massbal)
8108         do ibin = 1, nbin_a
8109           if(jaerosolstate(ibin) .ne. no_aerosol)then
8110             delta_msa(ibin) = delta_tmsa*kg(imsa_g,ibin)/sumkg_msa
8111             aer(imsa_a,jtotal,ibin) = aer(imsa_a,jtotal,ibin) + &
8112                                       delta_msa(ibin)
8113           endif
8114         enddo
8115
8116       else
8117
8118         delta_tmsa = 0.0
8119         do ibin = 1, nbin_a
8120             delta_msa(ibin) = 0.0
8121         enddo
8122
8123       endif
8124 ! msa condensation is now complete
8125 !-------------------------------------
8126
8127
8128
8129         if(n2o5_flag .gt. 0) then
8130                 ! DL (10/7/2012) moved from separate subroutine into involatile subroutine
8131                 !--------------------------------------
8132                 ! N2O5 uptake, if there is enough gas, and uptake is non-zero
8133                 !  (currently we only calculate uptake for aqueous particles,
8134                 !    so in some circumstances we could have aerosol but no reaction)
8135                 if(gas(in2o5_g) .gt. 1.e-14 .and. sumkg_n2o5 .gt. 0.0)then
8136
8137                         ! integrate n2o5 condensation analytically
8138                         decay_n2o5   = exp(-sumkg_n2o5*dtchem)
8139                         delta_n2o5   = gas(in2o5_g)*(1.0 - decay_n2o5)
8140                         gas(in2o5_g) = gas(in2o5_g)*decay_n2o5
8141
8142
8143                         ! now distribute delta_n2o5 to each bin and conform the particle (may degas by massbal)
8144                         do ibin = 1, nbin_a
8145                                 if(jaerosolstate(ibin) .ne. no_aerosol)then
8146                                         delta_no3_rct1(ibin) = delta_n2o5*frac_n2o5_h2o(ibin)*kg(in2o5_g,ibin)/sumkg_n2o5
8147                                         delta_no3_rct2(ibin) = delta_n2o5*(1.0-frac_n2o5_h2o(ibin))*kg(in2o5_g,ibin)/sumkg_n2o5
8148
8149                                         aer(ino3_a,jtotal,ibin) = aer(ino3_a,jtotal,ibin) + &
8150                                                                                   (2.0*delta_no3_rct1(ibin)+delta_no3_rct2(ibin))
8151                                         ! check to ensure we don't get negative Cl- concentrations
8152                                         ! - if this will occur then branch the remaining N2O5 to reaction 1
8153                                         if(aer(icl_a,jtotal,ibin).ge.delta_no3_rct2(ibin))then
8154                                                 aer(icl_a,jtotal,ibin)  = aer(icl_a,jtotal,ibin) - &
8155                                                                                                   delta_no3_rct2(ibin)
8156                                                 gas(iclno2_g)           = gas(iclno2_g) + &
8157                                                                                                   delta_no3_rct2(ibin)
8158                                         else
8159                                                 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jtotal,ibin) + &
8160                                                                                                   (delta_no3_rct2(ibin)-aer(icl_a,jtotal,ibin))
8161                                                 gas(iclno2_g)           = gas(iclno2_g) + &
8162                                                                                                   aer(icl_a,jtotal,ibin)
8163
8164                                                 ! record the amount of remaining N2O5 which branches to reaction 1 (this is
8165                                                 ! for the purposes of determining NH3 uptake later)
8166                                                 delta_no3_rct1(ibin) = delta_no3_rct1(ibin) + (delta_no3_rct2(ibin)-aer(icl_a,jtotal,ibin))
8167                                                 delta_no3_rct2(ibin) = aer(icl_a,jtotal,ibin)
8168
8169                                                 aer(icl_a,jtotal,ibin)  = 0.0
8170                                         endif
8171                                 endif
8172                         enddo
8173
8174                 else
8175
8176                         delta_n2o5 = 0.0
8177                         do ibin = 1, nbin_a
8178                                 delta_no3_rct1(ibin) = 0.0
8179                                 delta_no3_rct2(ibin) = 0.0
8180                         enddo
8181
8182                 endif
8183         else
8184                 delta_n2o5 = 0.0        ! if we're not using the N2O5 het scheme then set these to zero for ion balance calculations below
8185                 do ibin = 1, nbin_a
8186                         delta_no3_rct1(ibin) = 0.0
8187                         delta_no3_rct2(ibin) = 0.0
8188                 enddo
8189         endif
8190
8191
8192
8193
8194 ! compute max allowable nh3, hno3, and hcl condensation
8195       delta_nh3 = gas(inh3_g) *(1.0 - exp(-sumkg_nh3*dtchem))
8196       delta_hno3= gas(ihno3_g)*(1.0 - exp(-sumkg_hno3*dtchem))
8197       delta_hcl = gas(ihcl_g) *(1.0 - exp(-sumkg_hcl*dtchem))
8198
8199 ! compute max possible nh4 condensation for each bin
8200       do ibin = 1, nbin_a
8201         if(jaerosolstate(ibin) .ne. no_aerosol)then
8202           delta_nh3_max(ibin) = delta_nh3*kg(inh3_g,ibin)/sumkg_nh3
8203           delta_hno3_max(ibin)= delta_hno3*kg(ihno3_g,ibin)/sumkg_hno3
8204           delta_hcl_max(ibin) = delta_hcl*kg(ihcl_g,ibin)/sumkg_hcl
8205         endif
8206       enddo
8207
8208
8209       if(delta_h2so4 .eq. 0.0 .and. delta_tmsa .eq. 0.0 .and. delta_n2o5 .eq. 0.0)then
8210         iupdate_phase_state = mNO
8211         goto 100
8212       endif
8213
8214
8215 ! now condense appropriate amounts of nh3 to each bin
8216       do ibin = 1, nbin_a
8217
8218         if(epercent(jnacl,jtotal,ibin)  .eq. 0.0 .and. &
8219            epercent(jcacl2,jtotal,ibin) .eq. 0.0 .and. &
8220            epercent(jnano3,jtotal,ibin) .eq. 0.0 .and. &
8221            epercent(jcano3,jtotal,ibin) .eq. 0.0 .and. &
8222            epercent(jcaco3,jtotal,ibin) .eq. 0.0 .and. &
8223            jaerosolstate(ibin) .ne. no_aerosol)then
8224
8225           delta_nh4(ibin)=min( (2.*delta_so4(ibin)+delta_msa(ibin)+2.*delta_no3_rct1(ibin)+delta_no3_rct2(ibin)), &
8226                                 delta_nh3_max(ibin) )
8227
8228           aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) +        &  ! update aer-phase
8229                                     delta_nh4(ibin)
8230
8231           gas(inh3_g) = gas(inh3_g) - delta_nh4(ibin)           ! update gas-phase
8232
8233         else
8234
8235           delta_nh4(ibin) = 0.0
8236
8237         endif
8238
8239       enddo
8240
8241       iupdate_phase_state = mYES
8242
8243
8244 ! recompute phase equilibrium
8245 100   if(iupdate_phase_state .eq. mYES)then
8246         do ibin = 1, nbin_a
8247           if(jaerosolstate(ibin) .ne. no_aerosol)then
8248             call conform_electrolytes(jtotal,ibin,XT)
8249             call aerosol_phase_state(ibin)
8250           endif
8251         enddo
8252       endif
8253
8254       return
8255       end subroutine ASTEM_non_volatiles
8256
8257
8258
8259
8260
8261
8262
8263 !***********************************************************************
8264 ! computes mass transfer coefficients for each condensing species for
8265 ! all the aerosol bins
8266 !
8267 ! author: rahul a. zaveri
8268 ! update: jan 2005
8269 !-----------------------------------------------------------------------
8270       subroutine aerosolmtc(vbs_nbin)
8271
8272       use module_data_mosaic_asect
8273
8274 !     implicit none
8275 !     include 'v33com9a'
8276 !     include 'mosaic.h'
8277 ! local variables
8278       integer nghq,vbs_nbin(1)
8279       integer start_ind
8280       parameter (nghq = 2)              ! gauss-hermite quadrature order
8281       integer ibin, iq, iv
8282       real(kind=8) tworootpi, root2, beta
8283       parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
8284       real(kind=8) cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed,   &
8285            sumghq
8286       real(kind=8) xghq(nghq), wghq(nghq)                       ! quadrature abscissae and weights
8287       real(kind=8) mw_vol(ngas_volatile+ngas_het), v_molar(ngas_volatile+ngas_het),                  &  ! mw and molar vols of volatile species
8288            freepath(ngas_volatile+ngas_het), accom(ngas_volatile+ngas_het),   &
8289            dg(ngas_volatile+ngas_het)                           ! keep local
8290 !     real(kind=8) fuchs_sutugin                                ! mosaic func
8291 !     real(kind=8) gas_diffusivity                              ! mosaic func
8292 !     real(kind=8) mean_molecular_speed                         ! mosaic func
8293
8294
8295
8296
8297
8298 ! molecular weights
8299       mw_vol(ih2so4_g) = 98.0
8300       mw_vol(ihno3_g)  = 63.0
8301       mw_vol(ihcl_g)   = 36.5
8302       mw_vol(inh3_g)   = 17.0
8303       mw_vol(in2o5_g)  = 108.0
8304       mw_vol(iclno2_g) = 81.5
8305       mw_vol(imsa_g)   = 96.0
8306       mw_vol(ipcg1_b_c_g) =250.0
8307       mw_vol(ipcg2_b_c_g) =250.0
8308       mw_vol(ipcg3_b_c_g)=250.0
8309       mw_vol(ipcg4_b_c_g)=250.0
8310       mw_vol(ipcg5_b_c_g)=250.0
8311       mw_vol(ipcg6_b_c_g)=250.0
8312       mw_vol(ipcg7_b_c_g)=250.0
8313       mw_vol(ipcg8_b_c_g)=250.0
8314       mw_vol(ipcg9_b_c_g)=250.0
8315       mw_vol(iopcg1_b_c_g)=250.0
8316       mw_vol(iopcg2_b_c_g)=250.0
8317       mw_vol(iopcg3_b_c_g)=250.0
8318       mw_vol(iopcg4_b_c_g)=250.0
8319       mw_vol(iopcg5_b_c_g)=250.0
8320       mw_vol(iopcg6_b_c_g)=250.0
8321       mw_vol(iopcg7_b_c_g)=250.0
8322       mw_vol(iopcg8_b_c_g)=250.0
8323       mw_vol(ipcg1_b_o_g)=250.0
8324       mw_vol(ipcg2_b_o_g)=250.0
8325       mw_vol(ipcg3_b_o_g)=250.0
8326       mw_vol(ipcg4_b_o_g)=250.0
8327       mw_vol(ipcg5_b_o_g)=250.0
8328       mw_vol(ipcg6_b_o_g)=250.0
8329       mw_vol(ipcg7_b_o_g)=250.0
8330       mw_vol(ipcg8_b_o_g)=250.0
8331       mw_vol(ipcg9_b_o_g)=250.0
8332       mw_vol(iopcg1_b_o_g)=250.0
8333       mw_vol(iopcg2_b_o_g)=250.0
8334       mw_vol(iopcg3_b_o_g)=250.0
8335       mw_vol(iopcg4_b_o_g)=250.0
8336       mw_vol(iopcg5_b_o_g)=250.0
8337       mw_vol(iopcg6_b_o_g)=250.0
8338       mw_vol(iopcg7_b_o_g)=250.0
8339       mw_vol(iopcg8_b_o_g)=250.0
8340       mw_vol(ipcg1_f_c_g) =250.0
8341       mw_vol(ipcg2_f_c_g) =250.0
8342       mw_vol(ipcg3_f_c_g)=250.0
8343       mw_vol(ipcg4_f_c_g)=250.0
8344       mw_vol(ipcg5_f_c_g)=250.0
8345       mw_vol(ipcg6_f_c_g)=250.0
8346       mw_vol(ipcg7_f_c_g)=250.0
8347       mw_vol(ipcg8_f_c_g)=250.0
8348       mw_vol(ipcg9_f_c_g)=250.0
8349       mw_vol(iopcg1_f_c_g)=250.0
8350       mw_vol(iopcg2_f_c_g)=250.0
8351       mw_vol(iopcg3_f_c_g)=250.0
8352       mw_vol(iopcg4_f_c_g)=250.0
8353       mw_vol(iopcg5_f_c_g)=250.0
8354       mw_vol(iopcg6_f_c_g)=250.0
8355       mw_vol(iopcg7_f_c_g)=250.0
8356       mw_vol(iopcg8_f_c_g)=250.0
8357       mw_vol(ipcg1_f_o_g)=250.0
8358       mw_vol(ipcg2_f_o_g)=250.0
8359       mw_vol(ipcg3_f_o_g)=250.0
8360       mw_vol(ipcg4_f_o_g)=250.0
8361       mw_vol(ipcg5_f_o_g)=250.0
8362       mw_vol(ipcg6_f_o_g)=250.0
8363       mw_vol(ipcg7_f_o_g)=250.0
8364       mw_vol(ipcg8_f_o_g)=250.0
8365       mw_vol(ipcg9_f_o_g)=250.0
8366       mw_vol(iopcg1_f_o_g)=250.0
8367       mw_vol(iopcg2_f_o_g)=250.0
8368       mw_vol(iopcg3_f_o_g)=250.0
8369       mw_vol(iopcg4_f_o_g)=250.0
8370       mw_vol(iopcg5_f_o_g)=250.0
8371       mw_vol(iopcg6_f_o_g)=250.0
8372       mw_vol(iopcg7_f_o_g)=250.0
8373       mw_vol(iopcg8_f_o_g)=250.0
8374       mw_vol(ismpa_g)=250.0
8375       mw_vol(ismpbb_g)=250.0
8376       mw_vol(igly)=58.0
8377       mw_vol(iho)=17.0
8378       mw_vol(iant1_c_g)=250.0
8379       mw_vol(iant2_c_g)=250.0
8380       mw_vol(iant3_c_g)=250.0
8381       mw_vol(iant4_c_g)=250.0
8382       mw_vol(iant1_o_g)=250.0
8383       mw_vol(iant2_o_g)=250.0
8384       mw_vol(iant3_o_g)=250.0
8385       mw_vol(iant4_o_g)=250.0
8386       mw_vol(ibiog1_c_g)=250.0
8387       mw_vol(ibiog2_c_g)=250.0
8388       mw_vol(ibiog3_c_g)=250.0
8389       mw_vol(ibiog4_c_g)=250.0
8390       mw_vol(ibiog1_o_g)=250.0
8391       mw_vol(ibiog2_o_g)=250.0
8392       mw_vol(ibiog3_o_g)=250.0
8393       mw_vol(ibiog4_o_g)=250.0
8394       mw_vol(iasoaX_g)=250.0
8395       mw_vol(iasoa1_g)=250.0
8396       mw_vol(iasoa2_g)=250.0
8397       mw_vol(iasoa3_g)=250.0
8398       mw_vol(iasoa4_g)=250.0
8399       mw_vol(ibsoaX_g)=250.0
8400       mw_vol(ibsoa1_g)=250.0
8401       mw_vol(ibsoa2_g)=250.0
8402       mw_vol(ibsoa3_g)=250.0
8403       mw_vol(ibsoa4_g)=250.0
8404
8405
8406
8407
8408
8409       v_molar(ih2so4_g)= 42.88
8410       v_molar(ihno3_g) = 24.11
8411       v_molar(ihcl_g)  = 21.48
8412       v_molar(inh3_g)  = 14.90
8413       v_molar(imsa_g)  = 58.00
8414       v_molar(in2o5_g) = 60.40
8415       v_molar(iclno2_g)= 52.70
8416
8417 ! mass accommodation coefficients
8418       accom(ih2so4_g)  = 0.1
8419       accom(ihno3_g)   = 0.1
8420       accom(ihcl_g)    = 0.1
8421       accom(inh3_g)    = 0.1
8422       accom(in2o5_g)   = 0.1  ! dummy variable - will recalc later..
8423       accom(iclno2_g)  = 0.1  ! dummy - for convenience of calcs
8424       accom(imsa_g)    = 0.1
8425       accom(ipcg1_b_c_g) =0.1
8426       accom(ipcg2_b_c_g) =0.1
8427       accom(ipcg3_b_c_g)=0.1
8428       accom(ipcg4_b_c_g)=0.1
8429       accom(ipcg5_b_c_g)=0.1
8430       accom(ipcg6_b_c_g)=0.1
8431       accom(ipcg7_b_c_g)=0.1
8432       accom(ipcg8_b_c_g)=0.1
8433       accom(ipcg9_b_c_g)=0.1
8434       accom(iopcg1_b_c_g)=0.1
8435       accom(iopcg2_b_c_g)=0.1
8436       accom(iopcg3_b_c_g)=0.1
8437       accom(iopcg4_b_c_g)=0.1
8438       accom(iopcg5_b_c_g)=0.1
8439       accom(iopcg6_b_c_g)=0.1
8440       accom(iopcg7_b_c_g)=0.1
8441       accom(iopcg8_b_c_g)=0.1
8442       accom(ipcg1_b_o_g)=0.1
8443       accom(ipcg2_b_o_g)=0.1
8444       accom(ipcg3_b_o_g)=0.1
8445       accom(ipcg4_b_o_g)=0.1
8446       accom(ipcg5_b_o_g)=0.1
8447       accom(ipcg6_b_o_g)=0.1
8448       accom(ipcg7_b_o_g)=0.1
8449       accom(ipcg8_b_o_g)=0.1
8450       accom(ipcg9_b_o_g)=0.1
8451       accom(iopcg1_b_o_g)=0.1
8452       accom(iopcg2_b_o_g)=0.1
8453       accom(iopcg3_b_o_g)=0.1
8454       accom(iopcg4_b_o_g)=0.1
8455       accom(iopcg5_b_o_g)=0.1
8456       accom(iopcg6_b_o_g)=0.1
8457       accom(iopcg7_b_o_g)=0.1
8458       accom(iopcg8_b_o_g)=0.1
8459       accom(ipcg1_f_c_g) =0.1
8460       accom(ipcg2_f_c_g) =0.1
8461       accom(ipcg3_f_c_g)=0.1
8462       accom(ipcg4_f_c_g)=0.1
8463       accom(ipcg5_f_c_g)=0.1
8464       accom(ipcg6_f_c_g)=0.1
8465       accom(ipcg7_f_c_g)=0.1
8466       accom(ipcg8_f_c_g)=0.1
8467       accom(ipcg9_f_c_g)=0.1
8468       accom(iopcg1_f_c_g)=0.1
8469       accom(iopcg2_f_c_g)=0.1
8470       accom(iopcg3_f_c_g)=0.1
8471       accom(iopcg4_f_c_g)=0.1
8472       accom(iopcg5_f_c_g)=0.1
8473       accom(iopcg6_f_c_g)=0.1
8474       accom(iopcg7_f_c_g)=0.1
8475       accom(iopcg8_f_c_g)=0.1
8476       accom(ipcg1_f_o_g)=0.1
8477       accom(ipcg2_f_o_g)=0.1
8478       accom(ipcg3_f_o_g)=0.1
8479       accom(ipcg4_f_o_g)=0.1
8480       accom(ipcg5_f_o_g)=0.1
8481       accom(ipcg6_f_o_g)=0.1
8482       accom(ipcg7_f_o_g)=0.1
8483       accom(ipcg8_f_o_g)=0.1
8484       accom(ipcg9_f_o_g)=0.1
8485       accom(iopcg1_f_o_g)=0.1
8486       accom(iopcg2_f_o_g)=0.1
8487       accom(iopcg3_f_o_g)=0.1
8488       accom(iopcg4_f_o_g)=0.1
8489       accom(iopcg5_f_o_g)=0.1
8490       accom(iopcg6_f_o_g)=0.1
8491       accom(iopcg7_f_o_g)=0.1
8492       accom(iopcg8_f_o_g)=0.1
8493       accom(ismpa_g)=0.1
8494       accom(ismpbb_g)=0.1
8495       ! added glyoxal, but only for completeness - is hopefully never used
8496       accom(igly)=0.1
8497       accom(iho)=0.1
8498       accom(iant1_c_g)=0.1
8499       accom(iant2_c_g)=0.1
8500       accom(iant3_c_g)=0.1
8501       accom(iant4_c_g)=0.1
8502       accom(iant1_o_g)=0.1
8503       accom(iant2_o_g)=0.1
8504       accom(iant3_o_g)=0.1
8505       accom(iant4_o_g)=0.1
8506       accom(ibiog1_c_g)=0.1
8507       accom(ibiog2_c_g)=0.1
8508       accom(ibiog3_c_g)=0.1
8509       accom(ibiog4_c_g)=0.1
8510       accom(ibiog1_o_g)=0.1
8511       accom(ibiog2_o_g)=0.1
8512       accom(ibiog3_o_g)=0.1
8513       accom(ibiog4_o_g)=0.1
8514       accom(iasoaX_g)=0.1
8515       accom(iasoa1_g)=0.1
8516       accom(iasoa2_g)=0.1
8517       accom(iasoa3_g)=0.1
8518       accom(iasoa4_g)=0.1
8519       accom(ibsoaX_g)=0.1
8520       accom(ibsoa1_g)=0.1
8521       accom(ibsoa2_g)=0.1
8522       accom(ibsoa3_g)=0.1
8523       accom(ibsoa4_g)=0.1
8524
8525
8526
8527
8528 ! quadrature weights
8529       xghq(1) =  0.70710678
8530       xghq(2) = -0.70710678
8531       wghq(1) =  0.88622693
8532       wghq(2) =  0.88622693
8533
8534
8535
8536 ! calculate gas diffusivity and mean free path for condensing gases
8537 ! ioa
8538       do iv = 1, ngas_ioa
8539         speed  = mean_molecular_speed(t_k,mw_vol(iv))   ! cm/s
8540         dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
8541         freepath(iv) = 3.*dg(iv)/speed                  ! cm
8542       enddo
8543
8544 ! soa
8545       start_ind = 1
8546       if(vbs_nbin(1) .eq. 0) then
8547         start_ind = ismpa_g
8548       else if (vbs_nbin(1) .eq. 4) then
8549         start_ind = iasoaX_g
8550       else
8551         start_ind = ipcg1_b_c_g
8552       end if
8553       !BSINGH(03/10/2015): Added 2 in the following do-loop to accomodate oh and gly species.
8554       ! *IMPORTANT*:This is a TEMPORARY fix, we need a better fix for this problem.
8555       do iv = start_ind, ngas_ioa + ngas_soa+2
8556         speed = mean_molecular_speed(t_k,mw_vol(iv))    ! cm/s
8557         dg(iv) = 0.1                                    ! cm^2/s (increased from 0.2 to 0.035 by Manish Shrivastava)
8558         freepath(iv) = 3.*dg(iv)/speed
8559       enddo
8560
8561 ! het-rct gases   ! DL 9/9/2011
8562       do iv = (ngas_volatile+1), (ngas_volatile+ngas_het)
8563         speed = mean_molecular_speed(t_k,mw_vol(iv))    ! cm/s
8564                 dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
8565                 freepath(iv) = 3.*dg(iv)/speed                  ! cm
8566       enddo
8567
8568
8569 ! calc mass transfer coefficients for gases over various aerosol bins
8570
8571       if (msize_framework .eq. mmodal) then
8572
8573 ! for modal approach
8574       do 10 ibin = 1, nbin_a
8575
8576         if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
8577         call calc_dry_n_wet_aerosol_props(ibin)
8578
8579         dpgn_a(ibin) = dp_wet_a(ibin)   ! cm
8580
8581         lnsg   = log(sigmag_a(ibin))
8582         lndpgn = log(dpgn_a(ibin))
8583         cdum   = tworootpi*num_a(ibin)*   &
8584                  exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
8585
8586         do 20 iv = 1, ngas_volatile + ngas_het
8587
8588                   if(iv.eq.in2o5_g)then ! recalculate accom coeff for N2O5
8589                                                                 ! for each different aerosol composition
8590                                                                 ! (use total aerosol composition for now)
8591                         if(n2o5_flag.gt.0)then
8592                                 accom(iv) = acc_n2o5_bert_thorn(water_a(ibin),&
8593                                                                         aer(ino3_a,jtotal,ibin),&
8594                                                                         aer(icl_a,jtotal,ibin),&
8595                                                                         vol_wet_a(ibin))
8596                         else
8597                                 accom(iv) = 0.0
8598                         endif
8599                   end if
8600
8601           sumghq = 0.0
8602           do 30 iq = 1, nghq    ! sum over gauss-hermite quadrature points
8603             lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
8604             dp = exp(lndp)
8605             kn = 2.*freepath(iv)/dp
8606             fkn = fuchs_sutugin(kn,accom(iv))
8607             sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
8608 30        continue
8609
8610         kg(iv,ibin) = cdum*dg(iv)*sumghq                ! 1/s
8611 20      continue
8612
8613                 if(n2o5_flag.gt.0)then
8614                         ! calculate the reaction path splitting for
8615                         ! heterogeneous N2O5 reactions
8616                         frac_n2o5_h2o(ibin) = split_n2o5_bert_thorn(water_a(ibin),&
8617                                                                         aer(icl_a,jtotal,ibin),&
8618                                                                         vol_wet_a(ibin))
8619                 else
8620                         frac_n2o5_h2o(ibin) = 0.0
8621                 endif
8622
8623 10    continue
8624
8625       elseif(msize_framework .eq. msection)then
8626
8627 ! for sectional approach
8628       do 11 ibin = 1, nbin_a
8629
8630         if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
8631
8632         call calc_dry_n_wet_aerosol_props(ibin)
8633
8634         dp_avg = dp_wet_a(ibin)
8635         cdum  = 6.283185*dp_avg*num_a(ibin)
8636
8637         do 21 iv = 1, ngas_volatile+ngas_het
8638                   if(iv.eq.in2o5_g)then ! recalculate accom coeff for N2O5
8639                                                                 ! for each different aerosol composition
8640                                                                 ! (use total aerosol composition for now)
8641                         if(n2o5_flag.gt.0)then
8642                                 accom(iv) = acc_n2o5_bert_thorn(water_a(ibin),&
8643                                                                         aer(ino3_a,jtotal,ibin),&
8644                                                                         aer(icl_a,jtotal,ibin),&
8645                                                                         vol_wet_a(ibin))
8646                         else
8647                                 accom(iv) = 0.0
8648                         end if
8649                   end if
8650           kn = 2.*freepath(iv)/dp_avg
8651           fkn = fuchs_sutugin(kn,accom(iv))
8652           kg(iv,ibin) = cdum*dg(iv)*fkn         ! 1/s!Increased by a factor of 10000 by Manish Shrivastava to force to equilibrium
8653 !           fraceq(iv,ibin)=num_a(ibin)*dp_wet_a(ibin)/(kn/accom(iv)+1)
8654 21      continue
8655                 if(n2o5_flag.gt.0)then
8656                         ! calculate the reaction path splitting for
8657                         ! heterogeneous N2O5 reactions
8658                         frac_n2o5_h2o(ibin) = split_n2o5_bert_thorn(water_a(ibin),&
8659                                                                         aer(icl_a,jtotal,ibin),&
8660                                                                         vol_wet_a(ibin))
8661                 else
8662                         frac_n2o5_h2o(ibin) = 0.0
8663                 end if
8664
8665 11    continue
8666
8667       else
8668
8669         if (iprint_mosaic_fe1 .gt. 0) then
8670           write(6,*)'error in the choice of msize_framework'
8671           write(6,*)'mosaic fatal error in subr. aerosolmtc'
8672         endif
8673 !       stop
8674         istat_mosaic_fe1 = -1900
8675         return
8676
8677       endif
8678
8679
8680       return
8681       end subroutine aerosolmtc
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694 !***********************************************************************
8695 ! calculates dry and wet aerosol properties: density, refractive indices
8696 !
8697 ! author: rahul a. zaveri
8698 ! update: jan 2005
8699 !-----------------------------------------------------------------------
8700       subroutine calc_dry_n_wet_aerosol_props(ibin)
8701
8702       use module_data_mosaic_asect
8703
8704 !     implicit none
8705 !     include 'v33com9a'
8706 !     include 'mosaic.h'
8707 ! subr arguments
8708       integer ibin
8709 ! local variables
8710       integer jc, je, iaer, isize, itype
8711       real(kind=8) aer_H
8712       complex(kind=8) ri_dum
8713
8714
8715 ! calculate dry mass and dry volume of a bin
8716       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
8717       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
8718       area_dry_a(ibin) = 0.0            ! initialize to 0.0
8719
8720       if(jaerosolstate(ibin) .ne. no_aerosol)then
8721
8722         aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
8723                     aer(ino3_a,jtotal,ibin) +  &
8724                     aer(icl_a,jtotal,ibin)  +  &
8725                     aer(imsa_a,jtotal,ibin) +  &
8726                  2.*aer(ico3_a,jtotal,ibin))-  &
8727                 (2.*aer(ica_a,jtotal,ibin)  +  &
8728                     aer(ina_a,jtotal,ibin)  +  &
8729                     aer(inh4_a,jtotal,ibin))
8730
8731       do iaer = 1, naer
8732         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
8733                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
8734         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
8735         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
8736       enddo
8737         mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
8738         vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
8739
8740       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
8741       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! cc(aer)/cc(air)
8742
8743 ! wet mass and wet volume
8744         mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3       ! g/cc(air)
8745         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3        ! cc(aer)/cc(air)
8746
8747 ! calculate mean dry and wet particle densities
8748         dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
8749         dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
8750
8751 ! calculate mean dry and wet particle diameters
8752         dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
8753         dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
8754
8755 ! calculate mean dry and wet particle surface areas
8756         area_dry_a(ibin)= 3.14159*num_a(ibin)*dp_dry_a(ibin)**2 ! cm^2/cc(air)
8757         area_wet_a(ibin)= 3.14159*num_a(ibin)*dp_wet_a(ibin)**2 ! cm^2/cc(air)
8758
8759 ! calculate volume average refractive index
8760 !   load comp_a array
8761         do je = 1, nelectrolyte
8762           comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15   ! g/cc(air)
8763         enddo
8764         comp_a(joc)  = aer(ioc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
8765         comp_a(jbc)  = aer(ibc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
8766         comp_a(join) = aer(ioin_a,jtotal,ibin)*mw_comp_a(je)*1.e-15     ! g/cc(air)
8767          comp_a(jpcg1_b_c)= aer(ipcg1_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8768          comp_a(jpcg2_b_c)= aer(ipcg2_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8769          comp_a(jpcg3_b_c)= aer(ipcg3_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8770          comp_a(jpcg4_b_c)= aer(ipcg4_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8771          comp_a(jpcg5_b_c)= aer(ipcg5_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8772          comp_a(jpcg6_b_c)= aer(ipcg6_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8773          comp_a(jpcg7_b_c)= aer(ipcg7_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8774          comp_a(jpcg8_b_c)= aer(ipcg8_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8775          comp_a(jpcg9_b_c)= aer(ipcg9_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8776          comp_a(jopcg1_b_c)= aer(iopcg1_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8777          comp_a(jopcg2_b_c)= aer(iopcg2_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8778          comp_a(jopcg3_b_c)= aer(iopcg3_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8779          comp_a(jopcg4_b_c)= aer(iopcg4_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8780          comp_a(jopcg5_b_c)= aer(iopcg5_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8781          comp_a(jopcg6_b_c)= aer(iopcg6_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8782          comp_a(jopcg7_b_c)= aer(iopcg7_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8783          comp_a(jopcg8_b_c)= aer(iopcg8_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8784          comp_a(jpcg1_b_o)= aer(ipcg1_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8785          comp_a(jpcg2_b_o)= aer(ipcg2_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8786          comp_a(jpcg3_b_o)= aer(ipcg3_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8787          comp_a(jpcg4_b_o)= aer(ipcg4_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8788          comp_a(jpcg5_b_o)= aer(ipcg5_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8789          comp_a(jpcg6_b_o)= aer(ipcg6_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8790          comp_a(jpcg7_b_o)= aer(ipcg7_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8791          comp_a(jpcg8_b_o)= aer(ipcg8_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8792          comp_a(jpcg9_b_o)= aer(ipcg9_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8793          comp_a(jopcg1_b_o)= aer(iopcg1_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8794          comp_a(jopcg2_b_o)= aer(iopcg2_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8795          comp_a(jopcg3_b_o)= aer(iopcg3_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8796          comp_a(jopcg4_b_o)= aer(iopcg4_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8797          comp_a(jopcg5_b_o)= aer(iopcg5_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8798          comp_a(jopcg6_b_o)= aer(iopcg6_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8799          comp_a(jopcg7_b_o)= aer(iopcg7_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8800          comp_a(jopcg8_b_o)= aer(iopcg8_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8801          comp_a(jpcg1_f_c)= aer(ipcg1_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8802          comp_a(jpcg2_f_c)= aer(ipcg2_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8803          comp_a(jpcg3_f_c)= aer(ipcg3_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8804          comp_a(jpcg4_f_c)= aer(ipcg4_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8805          comp_a(jpcg5_f_c)= aer(ipcg5_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8806          comp_a(jpcg6_f_c)= aer(ipcg6_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8807          comp_a(jpcg7_f_c)= aer(ipcg7_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8808          comp_a(jpcg8_f_c)= aer(ipcg8_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8809          comp_a(jpcg9_f_c)= aer(ipcg9_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8810          comp_a(jopcg1_f_c)= aer(iopcg1_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8811          comp_a(jopcg2_f_c)= aer(iopcg2_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8812          comp_a(jopcg3_f_c)= aer(iopcg3_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8813          comp_a(jopcg4_f_c)= aer(iopcg4_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8814          comp_a(jopcg5_f_c)= aer(iopcg5_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8815          comp_a(jopcg6_f_c)= aer(iopcg6_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8816          comp_a(jopcg7_f_c)= aer(iopcg7_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8817          comp_a(jopcg8_f_c)= aer(iopcg8_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8818          comp_a(jpcg1_f_o)= aer(ipcg1_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8819          comp_a(jpcg2_f_o)= aer(ipcg2_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8820          comp_a(jpcg3_f_o)= aer(ipcg3_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8821          comp_a(jpcg4_f_o)= aer(ipcg4_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8822          comp_a(jpcg5_f_o)= aer(ipcg5_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8823          comp_a(jpcg6_f_o)= aer(ipcg6_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8824          comp_a(jpcg7_f_o)= aer(ipcg7_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8825          comp_a(jpcg8_f_o)= aer(ipcg8_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8826          comp_a(jpcg9_f_o)= aer(ipcg9_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8827          comp_a(jopcg1_f_o)= aer(iopcg1_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8828          comp_a(jopcg2_f_o)= aer(iopcg2_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8829          comp_a(jopcg3_f_o)= aer(iopcg3_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8830          comp_a(jopcg4_f_o)= aer(iopcg4_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8831          comp_a(jopcg5_f_o)= aer(iopcg5_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8832          comp_a(jopcg6_f_o)= aer(iopcg6_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8833          comp_a(jopcg7_f_o)= aer(iopcg7_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8834          comp_a(jopcg8_f_o)= aer(iopcg8_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8835          comp_a(jsmpa)= aer(ismpa_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8836          comp_a(jsmpbb)= aer(ismpbb_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8837          comp_a(jglysoa_r1)= aer(iglysoa_r1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8838          comp_a(jglysoa_r2)= aer(iglysoa_r2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8839          comp_a(jglysoa_sfc)= aer(iglysoa_sfc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8840          comp_a(jglysoa_nh4)= aer(iglysoa_nh4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8841          comp_a(jglysoa_oh)= aer(iglysoa_oh_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8842          comp_a(jant1_c)= aer(iant1_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8843          comp_a(jant2_c)= aer(iant2_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8844          comp_a(jant3_c)= aer(iant3_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8845          comp_a(jant4_c)= aer(iant4_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8846          comp_a(jant1_o)= aer(iant1_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8847          comp_a(jant2_o)= aer(iant2_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8848          comp_a(jant3_o)= aer(iant3_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8849          comp_a(jant4_o)= aer(iant4_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8850          comp_a(jbiog1_c)= aer(ibiog1_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8851          comp_a(jbiog2_c)= aer(ibiog2_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8852          comp_a(jbiog3_c)= aer(ibiog3_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8853          comp_a(jbiog4_c)= aer(ibiog4_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8854          comp_a(jbiog1_o)= aer(ibiog1_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8855          comp_a(jbiog2_o)= aer(ibiog2_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8856          comp_a(jbiog3_o)= aer(ibiog3_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8857          comp_a(jbiog4_o)= aer(ibiog4_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8858          comp_a(jasoaX)= aer(iasoaX_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8859          comp_a(jasoa1)= aer(iasoa1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8860          comp_a(jasoa2)= aer(iasoa2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8861          comp_a(jasoa3)= aer(iasoa3_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8862          comp_a(jasoa4)= aer(iasoa4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8863          comp_a(jbsoaX)= aer(ibsoaX_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8864          comp_a(jbsoa1)= aer(ibsoa1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8865          comp_a(jbsoa2)= aer(ibsoa2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8866          comp_a(jbsoa3)= aer(ibsoa3_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8867          comp_a(jbsoa4)= aer(ibsoa4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8868
8869
8870
8871         comp_a(jh2o) = water_a(ibin)*1.e-3                              ! g/cc(air)
8872
8873         ri_dum = (0.0,0.0)
8874         do jc = 1, naercomp
8875           if (dens_comp_a(jc).gt.0) then
8876           ri_dum = ri_dum + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
8877           endif
8878         enddo
8879
8880         ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
8881
8882       else      ! use defaults
8883
8884         dens_dry_a(ibin) = 1.0   ! g/cc(aerosol)
8885         dens_wet_a(ibin) = 1.0   ! g/cc(aerosol)
8886
8887         call isize_itype_from_ibin( ibin, isize, itype )
8888         dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
8889         dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
8890
8891         ri_avg_a(ibin) = (1.5,0.0)
8892       endif
8893
8894
8895       return
8896       end subroutine calc_dry_n_wet_aerosol_props
8897
8898
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917 !***********************************************************************
8918 ! computes activities
8919 !
8920 ! author: rahul a. zaveri
8921 ! update: jan 2005
8922 !-----------------------------------------------------------------------
8923       subroutine compute_activities(ibin)
8924 !     implicit none
8925 !     include 'mosaic.h'
8926 ! subr arguments
8927       integer ibin
8928 ! local variables
8929       integer jp, ja
8930       real(kind=8) xt, xmol(nelectrolyte), sum_elec, dumK, c_bal, a_c
8931       real(kind=8) quad, aq, bq, cq, xq, dum
8932 ! function
8933 !     real(kind=8) aerosol_water
8934
8935
8936       water_a(ibin) = aerosol_water(jliquid,ibin)       ! kg/m^3(air)
8937       if(water_a(ibin) .eq. 0.0)return
8938
8939
8940       call calculate_xt(ibin,jliquid,xt)
8941
8942       if(xt.gt.2.0 .or. xt.lt.0.)then
8943 ! sulfate poor: fully dissociated electrolytes
8944
8945
8946 ! anion molalities (mol/kg water)
8947       ma(ja_so4,ibin)  = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
8948       ma(ja_hso4,ibin) = 0.0
8949       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8950       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8951       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
8952
8953 ! cation molalities (mol/kg water)
8954       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8955       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8956       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8957       a_c              = ( 2.d0*ma(ja_so4,ibin)+  &
8958                                 ma(ja_no3,ibin)+  &
8959                                 ma(ja_cl,ibin) +  &
8960                                 ma(ja_msa,ibin) ) - &
8961                          ( 2.d0*mc(jc_ca,ibin) +  &
8962                                 mc(jc_nh4,ibin)+  &
8963                                 mc(jc_na,ibin) )
8964       mc(jc_h,ibin) = 0.5*a_c + sqrt(a_c**2 + 4.*Keq_ll(3))
8965
8966       if(mc(jc_h,ibin) .eq. 0.0)then
8967         mc(jc_h,ibin) = sqrt(Keq_ll(3))
8968       endif
8969
8970
8971       jp = jliquid
8972
8973
8974       sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) +  &
8975                  2.*electrolyte(jnh4cl,jp,ibin)  +  &
8976                  3.*electrolyte(jnh4so4,jp,ibin) +  &
8977                  3.*electrolyte(jna2so4,jp,ibin) +  &
8978                  2.*electrolyte(jnano3,jp,ibin)  +  &
8979                  2.*electrolyte(jnacl,jp,ibin)   +  &
8980                  3.*electrolyte(jcano3,jp,ibin)  +  &
8981                  3.*electrolyte(jcacl2,jp,ibin)  +  &
8982                  2.*electrolyte(jhno3,jp,ibin)   +  &
8983                  2.*electrolyte(jhcl,jp,ibin)
8984
8985       if(sum_elec .eq. 0.0)then
8986         do ja = 1, nelectrolyte
8987           gam(ja,ibin) = 1.0
8988         enddo
8989         goto 10
8990       endif
8991
8992
8993 ! ionic mole fractions
8994       xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
8995       xmol(jnh4cl)  = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
8996       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
8997       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
8998       xmol(jnano3)  = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
8999       xmol(jnacl)   = 2.*electrolyte(jnacl,jp,ibin)  /sum_elec
9000       xmol(jcano3)  = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
9001       xmol(jcacl2)  = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
9002       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)  /sum_elec
9003       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)   /sum_elec
9004
9005
9006       ja = jnh4so4
9007       if(xmol(ja).gt.0.0)then
9008       log_gam(ja) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9009                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9010                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9011                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9012                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9013                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9014                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9015                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9016                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9017                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9018       gam(jA,ibin) = 10.**log_gam(jA)
9019       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
9020                                gam(jnh4so4,ibin)**3
9021       endif
9022
9023
9024
9025       jA = jnh4no3
9026       if(xmol(jA).gt.0.0)then
9027       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9028                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9029                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9030                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9031                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9032                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9033                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9034                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9035                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9036                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9037       gam(jA,ibin) = 10.**log_gam(jA)
9038       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
9039                                gam(jnh4no3,ibin)**2
9040       endif
9041
9042
9043       jA = jnh4cl
9044       if(xmol(jA).gt.0.0)then
9045       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9046                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9047                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9048                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9049                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9050                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9051                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9052                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9053                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9054                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9055       gam(jA,ibin) = 10.**log_gam(jA)
9056       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin)* &
9057                                gam(jnh4cl,ibin)**2
9058       endif
9059
9060
9061       jA = jna2so4
9062       if(xmol(jA).gt.0.0)then
9063       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9064                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9065                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9066                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9067                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9068                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9069                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9070                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9071                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9072                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9073       gam(jA,ibin) = 10.**log_gam(jA)
9074       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
9075                                gam(jna2so4,ibin)**3
9076       endif
9077
9078
9079       jA = jnano3
9080       if(xmol(jA).gt.0.0)then
9081       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9082                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9083                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9084                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9085                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9086                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9087                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9088                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9089                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9090                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9091       gam(jA,ibin) = 10.**log_gam(jA)
9092       activity(jnano3,ibin)  = mc(jc_na,ibin)*ma(ja_no3,ibin)* &
9093                                gam(jnano3,ibin)**2
9094       endif
9095
9096
9097
9098       jA = jnacl
9099       if(xmol(jA).gt.0.0)then
9100       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9101                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9102                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9103                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9104                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9105                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9106                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9107                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9108                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9109                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9110       gam(jA,ibin) = 10.**log_gam(jA)
9111       activity(jnacl,ibin)   = mc(jc_na,ibin)*ma(ja_cl,ibin)* &
9112                                gam(jnacl,ibin)**2
9113       endif
9114
9115
9116
9117 !      jA = jcano3
9118 !      if(xmol(jA).gt.0.0)then
9119 !      gam(jA,ibin) = 1.0
9120 !      activity(jcano3,ibin)  = 1.0
9121 !      endif
9122
9123
9124
9125 !      jA = jcacl2
9126 !      if(xmol(jA).gt.0.0)then
9127 !      gam(jA,ibin) = 1.0
9128 !      activity(jcacl2,ibin)  = 1.0
9129 !      endif
9130
9131       jA = jcano3
9132       if(xmol(jA).gt.0.0)then
9133       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9134                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9135                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9136                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9137                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9138                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9139                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9140                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9141                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9142                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9143       gam(jA,ibin) = 10.**log_gam(jA)
9144       activity(jcano3,ibin)  = mc(jc_ca,ibin)*ma(ja_no3,ibin)**2* &
9145                                gam(jcano3,ibin)**3
9146       endif
9147
9148
9149
9150       jA = jcacl2
9151       if(xmol(jA).gt.0.0)then
9152       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9153                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9154                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9155                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9156                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9157                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9158                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9159                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9160                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9161                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9162       gam(jA,ibin) = 10.**log_gam(jA)
9163       activity(jcacl2,ibin)  = mc(jc_ca,ibin)*ma(ja_cl,ibin)**2* &
9164                                gam(jcacl2,ibin)**3
9165       endif
9166
9167
9168       jA = jhno3
9169       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9170                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9171                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9172                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9173                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9174                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9175                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9176                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9177                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9178                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9179       gam(jA,ibin) = 10.**log_gam(jA)
9180       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
9181                                gam(jhno3,ibin)**2
9182
9183
9184       jA = jhcl
9185       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9186                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9187                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9188                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9189                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9190                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9191                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9192                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9193                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9194                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9195       gam(jA,ibin) = 10.**log_gam(jA)
9196       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
9197                                gam(jhcl,ibin)**2
9198
9199 !----
9200 10    gam(jlvcite,ibin) = 1.0
9201
9202       gam(jnh4hso4,ibin)= 1.0
9203
9204       gam(jnh4msa,ibin) = 1.0
9205
9206       gam(jna3hso4,ibin) = 1.0
9207
9208       gam(jnahso4,ibin) = 1.0
9209
9210       gam(jnamsa,ibin)  = 1.0
9211
9212       gam(jcamsa2,ibin) = 1.0  ! raz-30apr07
9213
9214       activity(jlvcite,ibin) = 0.0
9215
9216       activity(jnh4hso4,ibin)= 0.0
9217
9218       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
9219                                gam(jnh4msa,ibin)**2
9220
9221       activity(jna3hso4,ibin)= 0.0
9222
9223       activity(jnahso4,ibin) = 0.0
9224
9225       activity(jnamsa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &  ! raz-30apr07
9226                                gam(jnamsa,ibin)**2
9227
9228       activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * &  ! raz-30apr07
9229                                gam(jcamsa2,ibin)**3
9230
9231       gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
9232
9233
9234       else
9235 !  SULFATE-RICH: solve for SO4= and HSO4- ions
9236
9237       jp = jliquid
9238
9239       sum_elec = 3.*electrolyte(jh2so4,jp,ibin)    +  &
9240                  2.*electrolyte(jnh4hso4,jp,ibin)  +  &
9241                  5.*electrolyte(jlvcite,jp,ibin)   +  &
9242                  3.*electrolyte(jnh4so4,jp,ibin)   +  &
9243                  2.*electrolyte(jnahso4,jp,ibin)   +  &
9244                  5.*electrolyte(jna3hso4,jp,ibin)  +  &
9245                  3.*electrolyte(jna2so4,jp,ibin)   +  &
9246                  2.*electrolyte(jhno3,jp,ibin)     +  &
9247                  2.*electrolyte(jhcl,jp,ibin)
9248
9249
9250       if(sum_elec .eq. 0.0)then
9251         do jA = 1, nelectrolyte
9252           gam(jA,ibin) = 1.0
9253         enddo
9254         goto 20
9255       endif
9256
9257
9258       xmol(jh2so4)  = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
9259       xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
9260       xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
9261       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
9262       xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
9263       xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
9264       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
9265       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
9266       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
9267
9268
9269 ! 2H.SO4
9270       jA = jh2so4
9271       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9272                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9273                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9274                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9275                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9276                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9277                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9278                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9279                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9280       gam(jA,ibin) = 10.**log_gam(jA)
9281
9282
9283 ! H.HSO4
9284       jA = jhhso4
9285       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9286                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9287                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9288                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9289                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9290                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9291                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9292                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9293                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9294       gam(jA,ibin) = 10.**log_gam(jA)
9295
9296
9297 ! NH4HSO4
9298       jA = jnh4hso4
9299       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9300                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9301                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9302                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9303                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9304                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9305                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9306                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9307                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9308       gam(jA,ibin) = 10.**log_gam(jA)
9309
9310
9311 ! LETOVICITE
9312       jA = jlvcite
9313       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9314                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9315                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9316                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9317                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9318                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9319                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9320                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9321                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9322       gam(jA,ibin) = 10.**log_gam(jA)
9323
9324
9325 ! (NH4)2SO4
9326       jA = jnh4so4
9327       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9328                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9329                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9330                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9331                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9332                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9333                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9334                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9335                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9336       gam(jA,ibin) = 10.**log_gam(jA)
9337
9338
9339 ! NaHSO4
9340       jA = jnahso4
9341       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9342                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9343                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9344                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9345                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9346                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9347                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9348                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9349                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9350       gam(jA,ibin) = 10.**log_gam(jA)
9351
9352
9353 ! Na3H(SO4)2
9354       jA = jna3hso4
9355 !      log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9356 !                    xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9357 !                    xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9358 !                    xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9359 !                    xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9360 !                    xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9361 !                    xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9362 !                    xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9363 !                    xmol(jhcl)    *log_gamZ(jA,jhcl)
9364 !      gam(jA,ibin) = 10.**log_gam(jA)
9365       gam(jA,ibin) = 1.0
9366
9367
9368 ! Na2SO4
9369       jA = jna2so4
9370       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9371                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9372                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9373                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9374                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9375                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9376                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9377                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9378                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9379       gam(jA,ibin) = 10.**log_gam(jA)
9380
9381
9382 ! HNO3
9383       jA = jhno3
9384       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9385                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9386                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9387                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9388                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9389                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9390                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9391                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9392                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9393       gam(jA,ibin) = 10.**log_gam(jA)
9394
9395
9396 ! HCl
9397       jA = jhcl
9398       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9399                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9400                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9401                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9402                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9403                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9404                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9405                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9406                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9407       gam(jA,ibin) = 10.**log_gam(jA)
9408
9409
9410 20    gam(jnh4no3,ibin) = 1.0
9411       gam(jnh4cl,ibin)  = 1.0
9412       gam(jnano3,ibin)  = 1.0
9413       gam(jnacl,ibin)   = 1.0
9414       gam(jcano3,ibin)  = 1.0
9415       gam(jcacl2,ibin)  = 1.0
9416
9417       gam(jnh4msa,ibin) = 1.0
9418       gam(jnamsa,ibin)  = 1.0
9419       gam(jcamsa2,ibin) = 1.0  ! raz-30apr07
9420
9421
9422 ! compute equilibrium pH
9423 ! cation molalities (mol/kg water)
9424       mc(jc_ca,ibin)   = 0.0    ! aqueous ca never exists in sulfate rich cases
9425       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
9426       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
9427
9428 ! anion molalities (mol/kg water)
9429       mSULF            = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
9430       ma(ja_hso4,ibin) = 0.0
9431       ma(ja_so4,ibin)  = 0.0
9432       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
9433       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
9434       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
9435
9436       gam_ratio(ibin)  = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
9437       dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
9438
9439       c_bal =  mc(jc_nh4,ibin) + mc(jc_na,ibin) + 2.*mc(jc_ca,ibin) & ! raz-30apr07
9440          - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
9441
9442       aq = 1.0
9443       bq = dumK + c_bal
9444       cq = dumK*(c_bal - mSULF)
9445
9446
9447 !--quadratic solution
9448         if(bq .ne. 0.0)then
9449         xq = 4.*(1./bq)*(cq/bq)
9450         else
9451         xq = 1.e+6
9452         endif
9453
9454         if(abs(xq) .lt. 1.e-6)then
9455           dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
9456           quad = (-0.5*bq/aq)*dum
9457           if(quad .lt. 0.)then
9458             quad = -bq/aq - quad
9459           endif
9460         else
9461           quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
9462         endif
9463 !--end of quadratic solution
9464
9465       mc(jc_h,ibin) = max(quad, 1.D-7)
9466       ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
9467       ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
9468
9469
9470       activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * & ! raz-30apr07
9471                                gam(jcamsa2,ibin)**3
9472
9473       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
9474                                gam(jnh4so4,ibin)**3
9475
9476       activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3*ma(ja_hso4,ibin)* &
9477                                ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
9478
9479       activity(jnh4hso4,ibin)= mc(jc_nh4,ibin)*ma(ja_hso4,ibin)* &
9480                                gam(jnh4hso4,ibin)**2
9481
9482       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
9483                                gam(jnh4msa,ibin)**2
9484
9485       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
9486                                gam(jna2so4,ibin)**3
9487
9488       activity(jnahso4,ibin) = mc(jc_na,ibin)*ma(ja_hso4,ibin)* &
9489                                gam(jnahso4,ibin)**2
9490
9491       activity(jnamsa,ibin)  = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
9492                                gam(jnamsa,ibin)**2
9493
9494 !      activity(jna3hso4,ibin)= mc(jc_na,ibin)**3*ma(ja_hso4,ibin)* &
9495 !                               ma(ja_so4,ibin)*gam(jna3hso4,ibin)**5
9496
9497       activity(jna3hso4,ibin)= 0.0
9498
9499       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
9500                                gam(jhno3,ibin)**2
9501
9502       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
9503                                gam(jhcl,ibin)**2
9504
9505       activity(jmsa,ibin)    = mc(jc_h,ibin)*ma(ja_msa,ibin)* &
9506                                gam(jmsa,ibin)**2
9507
9508
9509 ! sulfate-poor species
9510       activity(jnh4no3,ibin) = 0.0
9511
9512       activity(jnh4cl,ibin)  = 0.0
9513
9514       activity(jnano3,ibin)  = 0.0
9515
9516       activity(jnacl,ibin)   = 0.0
9517
9518       activity(jcano3,ibin)  = 0.0
9519
9520       activity(jcacl2,ibin)  = 0.0
9521
9522
9523       endif
9524
9525
9526
9527
9528       return
9529       end subroutine compute_activities
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542 !***********************************************************************
9543 ! computes mtem ternary parameters only once per transport time-step
9544 ! for a given ah2o (= rh)
9545 !
9546 ! author: rahul a. zaveri
9547 ! update: jan 2005
9548 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
9549 ! a new method for multicomponent activity coefficients of electrolytes
9550 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
9551 !-----------------------------------------------------------------------
9552       subroutine mtem_compute_log_gamz
9553 !     implicit none
9554 !     include 'mosaic.h'
9555 ! local variables
9556       integer ja
9557 ! functions
9558 !     real(kind=8) fnlog_gamz, bin_molality
9559
9560
9561 ! sulfate-poor species
9562       ja = jhno3
9563       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9564       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9565       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9566       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9567       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9568       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9569       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9570       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9571       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9572       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9573       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9574       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9575       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9576       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9577       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9578
9579
9580       ja = jhcl
9581       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9582       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9583       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9584       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9585       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9586       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9587       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9588       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9589       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9590       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9591       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9592       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9593       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9594       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9595       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9596
9597
9598       ja = jnh4so4
9599       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9600       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9601       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9602       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9603       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9604       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9605       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9606       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9607       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9608       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9609       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9610       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9611       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9612       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9613       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9614
9615
9616       ja = jnh4no3
9617       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9618       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9619       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9620       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9621       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9622       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9623       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9624       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9625       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9626       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9627
9628
9629       ja = jnh4cl
9630       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9631       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9632       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9633       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9634       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9635       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9636       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9637       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9638       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9639       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9640
9641
9642       ja = jna2so4
9643       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9644       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9645       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9646       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9647       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9648       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9649       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9650       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9651       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9652       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9653       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9654       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9655       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9656       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9657       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9658
9659
9660       ja = jnano3
9661       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9662       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9663       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9664       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9665       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9666       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9667       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9668       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9669       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9670       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9671
9672
9673       ja = jnacl
9674       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9675       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9676       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9677       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9678       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9679       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9680       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9681       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9682       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9683       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9684
9685
9686       ja = jcano3
9687       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9688       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9689       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9690       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9691       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9692       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9693       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9694       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9695       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9696       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9697
9698
9699       ja = jcacl2
9700       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9701       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9702       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9703       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9704       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9705       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9706       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9707       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9708       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9709       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9710
9711
9712 ! sulfate-rich species
9713       ja = jh2so4
9714       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9715       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9716       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9717       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9718       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9719       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9720       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9721       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9722       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9723
9724
9725       ja = jhhso4
9726       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9727       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9728       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9729       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9730       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9731       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9732       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9733       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9734       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9735
9736
9737       ja = jnh4hso4
9738       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9739       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9740       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9741       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9742       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9743       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9744       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9745       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9746       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9747
9748
9749       ja = jlvcite
9750       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9751       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9752       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9753       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9754       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9755       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9756       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9757       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9758       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9759
9760
9761       ja = jnahso4
9762       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9763       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9764       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9765       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9766       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9767       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9768       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9769       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9770       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9771
9772
9773       ja = jna3hso4
9774       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9775       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9776       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9777       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9778       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9779       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9780       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9781       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9782       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9783
9784       return
9785       end subroutine mtem_compute_log_gamz
9786
9787
9788
9789
9790
9791
9792
9793
9794
9795
9796
9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813
9814 !***********************************************************************
9815 ! computes sulfate ratio
9816 !
9817 ! author: rahul a. zaveri
9818 ! update: dec 1999
9819 !-----------------------------------------------------------------------
9820       subroutine calculate_xt(ibin,jp,xt)
9821 !     implicit none
9822 !     include 'mosaic.h'
9823 ! subr arguments
9824       integer ibin, jp
9825       real(kind=8) xt
9826
9827
9828       if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
9829         xt   = ( aer(inh4_a,jp,ibin) +   &
9830      &           aer(ina_a,jp,ibin)  +   &
9831      &        2.*aer(ica_a,jp,ibin) )/   &
9832      &         (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
9833       else
9834         xt   = -1.0
9835       endif
9836
9837
9838       return
9839       end subroutine calculate_xt
9840
9841
9842
9843
9844
9845 !***********************************************************************
9846 ! computes ions from electrolytes
9847 !
9848 ! author: rahul a. zaveri
9849 ! update: jan 2005
9850 !-----------------------------------------------------------------------
9851       subroutine electrolytes_to_ions(jp,ibin)
9852 !     implicit none
9853 !     include 'mosaic.h'
9854 ! subr arguments
9855       integer jp, ibin
9856
9857
9858       aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
9859                             electrolyte(jna2so4,jp,ibin) +   &
9860                          2.*electrolyte(jna3hso4,jp,ibin)+   &
9861                             electrolyte(jnahso4,jp,ibin) +   &
9862                             electrolyte(jnh4so4,jp,ibin) +   &
9863                          2.*electrolyte(jlvcite,jp,ibin) +   &
9864                             electrolyte(jnh4hso4,jp,ibin)+   &
9865                             electrolyte(jh2so4,jp,ibin)
9866
9867       aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
9868                          2.*electrolyte(jcano3,jp,ibin)  +   &
9869                             electrolyte(jnh4no3,jp,ibin) +   &
9870                             electrolyte(jhno3,jp,ibin)
9871
9872       aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
9873                          2.*electrolyte(jcacl2,jp,ibin)  +   &
9874                             electrolyte(jnh4cl,jp,ibin)  +   &
9875                             electrolyte(jhcl,jp,ibin)
9876
9877       aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) +   &
9878                             electrolyte(jnamsa,jp,ibin)  +   &
9879                          2.*electrolyte(jcamsa2,jp,ibin) +   &
9880                             electrolyte(jmsa,jp,ibin)
9881
9882       aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
9883
9884       aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
9885                             electrolyte(jcano3,jp,ibin)  +   &
9886                             electrolyte(jcacl2,jp,ibin)  +   &
9887                             electrolyte(jcaco3,jp,ibin)  +   &
9888                             electrolyte(jcamsa2,jp,ibin)
9889
9890       aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
9891                             electrolyte(jnacl,jp,ibin)   +   &
9892                          2.*electrolyte(jna2so4,jp,ibin) +   &
9893                          3.*electrolyte(jna3hso4,jp,ibin)+   &
9894                             electrolyte(jnahso4,jp,ibin) +   &
9895                             electrolyte(jnamsa,jp,ibin)
9896
9897       aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
9898                             electrolyte(jnh4cl,jp,ibin)  +   &
9899                          2.*electrolyte(jnh4so4,jp,ibin) +   &
9900                          3.*electrolyte(jlvcite,jp,ibin) +   &
9901                             electrolyte(jnh4hso4,jp,ibin)+   &
9902                             electrolyte(jnh4msa,jp,ibin)
9903
9904
9905       return
9906       end subroutine electrolytes_to_ions
9907
9908
9909
9910
9911
9912
9913
9914
9915
9916
9917 !***********************************************************************
9918 ! combinatorial method for computing electrolytes from ions
9919 !
9920 ! notes:
9921 !  - to be used for liquid-phase or total-phase only
9922 !  - transfers caso4 and caco3 from liquid to solid phase
9923 !
9924 ! author: rahul a. zaveri (based on code provided by a.s. wexler
9925 ! update: apr 2005
9926 !-----------------------------------------------------------------------
9927       subroutine ions_to_electrolytes(jp,ibin,xt)
9928 !     implicit none
9929 !     include 'mosaic.h'
9930 ! subr arguments
9931       integer ibin, jp
9932       real(kind=8) xt
9933 ! local variables
9934       integer iaer, je, jc, ja, icase
9935       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
9936            f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
9937       real(kind=8) nc(ncation), na(nanion)
9938
9939
9940
9941
9942       if(jp .ne. jliquid)then
9943         if (iprint_mosaic_fe1 .gt. 0) then
9944           write(6,*)' jp must be jliquid'
9945           write(6,*)' in ions_to_electrolytes sub'
9946           write(6,*)' wrong jp = ', jp
9947           write(6,*)' mosaic fatal error in ions_to_electrolytes'
9948         endif
9949 !       stop
9950         istat_mosaic_fe1 = -2000
9951         return
9952       endif
9953
9954 ! remove negative concentrations, if any
9955       do iaer = 1, naer
9956       aer(iaer,jp,ibin) = max(0.0D0, aer(iaer,jp,ibin))
9957       enddo
9958
9959
9960 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
9961       store(ica_a)  = aer(ica_a, jp,ibin)
9962       store(iso4_a) = aer(iso4_a,jp,ibin)
9963
9964       call form_caso4(store,jp,ibin)
9965
9966       if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
9967         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) -   &
9968                                   electrolyte(jcaso4,jliquid,ibin)
9969
9970         aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)-   &
9971                                   electrolyte(jcaso4,jliquid,ibin)
9972
9973         aer(ica_a,jsolid,ibin)  = aer(ica_a,jsolid,ibin) +   &
9974                                   electrolyte(jcaso4,jliquid,ibin)
9975
9976         aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) +   &
9977                                   electrolyte(jcaso4,jliquid,ibin)
9978
9979         electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
9980                                        +electrolyte(jcaso4,jliquid,ibin)
9981         electrolyte(jcaso4,jliquid,ibin)= 0.0
9982       endif
9983
9984
9985 ! calculate sulfate ratio
9986       call calculate_xt(ibin,jp,xt)
9987
9988       if(xt .ge. 1.9999 .or. xt.lt.0.)then
9989        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
9990       else
9991        icase = 2        ! acidic (acidity is caused by excess so4)
9992       endif
9993
9994
9995 ! initialize to zero
9996       do je = 1, nelectrolyte
9997         electrolyte(je,jp,ibin) = 0.0
9998       enddo
9999 !
10000 !---------------------------------------------------------
10001 ! initialize moles of ions depending on the sulfate domain
10002
10003       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
10004
10005         na(ja_hso4)= 0.0
10006         na(ja_so4) = aer(iso4_a,jp,ibin)
10007         na(ja_no3) = aer(ino3_a,jp,ibin)
10008         na(ja_cl)  = aer(icl_a, jp,ibin)
10009         na(ja_msa) = aer(imsa_a,jp,ibin)
10010
10011         nc(jc_ca)  = aer(ica_a, jp,ibin)
10012         nc(jc_na)  = aer(ina_a, jp,ibin)
10013         nc(jc_nh4) = aer(inh4_a,jp,ibin)
10014
10015         cat_net =&
10016                  ( 2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) )- &
10017                  ( 2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
10018
10019         if(cat_net .lt. 0.0)then
10020
10021           nc(jc_h) = 0.0
10022
10023         else  ! cat_net must be 0.0 or positive
10024
10025           nc(jc_h) = cat_net
10026
10027         endif
10028
10029
10030 ! now compute equivalent fractions
10031       sum_naza = 0.0
10032       do ja = 1, nanion
10033         sum_naza = sum_naza + na(ja)*za(ja)
10034       enddo
10035
10036       sum_nczc = 0.0
10037       do jc = 1, ncation
10038         sum_nczc = sum_nczc + nc(jc)*zc(jc)
10039       enddo
10040
10041       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
10042         if (iprint_mosaic_diag1 .gt. 0) then
10043           write(6,*)'mosaic ions_to_electrolytes'
10044           write(6,*)'ionic concentrations are zero'
10045           write(6,*)'sum_naza = ', sum_naza
10046           write(6,*)'sum_nczc = ', sum_nczc
10047         endif
10048         return
10049       endif
10050
10051       do ja = 1, nanion
10052         xeq_a(ja) = na(ja)*za(ja)/sum_naza
10053       enddo
10054
10055       do jc = 1, ncation
10056         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
10057       enddo
10058
10059       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
10060       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
10061       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
10062       na_ma(ja_msa) = na(ja_msa) *mw_a(ja_msa)
10063       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
10064
10065       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
10066       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
10067       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
10068       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
10069
10070
10071 ! now compute electrolyte moles
10072       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
10073         electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
10074                                         xeq_a(ja_so4)*nc_mc(jc_na))/  &
10075                                          mw_electrolyte(jna2so4)
10076       endif
10077
10078       electrolyte(jnahso4,jp,ibin) = 0.0
10079
10080       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10081         electrolyte(jnamsa,jp,ibin)  = (xeq_c(jc_na) *na_Ma(ja_msa) + &
10082                                         xeq_a(ja_msa)*nc_Mc(jc_na))/  &
10083                                          mw_electrolyte(jnamsa)
10084       endif
10085
10086       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10087         electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
10088                                         xeq_a(ja_no3)*nc_mc(jc_na))/  &
10089                                          mw_electrolyte(jnano3)
10090       endif
10091
10092       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10093         electrolyte(jnacl,  jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) +  &
10094                                         xeq_a(ja_cl) *nc_mc(jc_na))/  &
10095                                          mw_electrolyte(jnacl)
10096       endif
10097
10098       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
10099         electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
10100                                         xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
10101                                          mw_electrolyte(jnh4so4)
10102       endif
10103
10104       electrolyte(jnh4hso4,jp,ibin)= 0.0
10105
10106       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10107         electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) + &
10108                                         xeq_a(ja_msa)*nc_Mc(jc_nh4))/ &
10109                                          mw_electrolyte(jnh4msa)
10110       endif
10111
10112       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10113         electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
10114                                         xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
10115                                          mw_electrolyte(jnh4no3)
10116       endif
10117
10118       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10119         electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) +  &
10120                                         xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
10121                                          mw_electrolyte(jnh4cl)
10122       endif
10123
10124       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
10125         electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
10126                                         xeq_a(ja_no3)*nc_mc(jc_ca))/  &
10127                                          mw_electrolyte(jcano3)
10128       endif
10129
10130       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10131         electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) +  &
10132                                         xeq_a(ja_cl) *nc_mc(jc_ca))/  &
10133                                          mw_electrolyte(jcacl2)
10134       endif
10135
10136       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10137         electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) + &
10138                                         xeq_a(ja_msa) *nc_Mc(jc_ca))/ &
10139                                          mw_electrolyte(jcamsa2)
10140       endif
10141
10142       electrolyte(jh2so4, jp,ibin) = 0.0
10143
10144       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10145       electrolyte(jhno3,  jp,ibin) = (xeq_c(jc_h)  *na_ma(ja_no3) +   &
10146                                       xeq_a(ja_no3)*nc_mc(jc_h))/     &
10147                                        mw_electrolyte(jhno3)
10148       endif
10149
10150       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10151         electrolyte(jhcl,   jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) +   &
10152                                         xeq_a(ja_cl)*nc_mc(jc_h))/    &
10153                                          mw_electrolyte(jhcl)
10154       endif
10155
10156       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10157         electrolyte(jmsa,jp,ibin)    = (xeq_c(jc_h) *na_ma(ja_msa) +  &
10158                                         xeq_a(ja_msa)*nc_mc(jc_h))/   &
10159                                          mw_electrolyte(jmsa)
10160       endif
10161
10162 !--------------------------------------------------------------------
10163
10164       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
10165
10166         store(imsa_a) = aer(imsa_a,jp,ibin)
10167         store(ica_a)  = aer(ica_a, jp,ibin)
10168
10169         call form_camsa2(store,jp,ibin)
10170
10171         sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
10172
10173         if(sum_na_nh4 .gt. 0.0)then
10174           f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
10175           f_na  = aer(ina_a,jp,ibin)/sum_na_nh4
10176         else
10177           f_nh4 = 0.0
10178           f_na  = 0.0
10179         endif
10180
10181 ! first form msa electrolytes
10182         if(sum_na_nh4 .gt. store(imsa_a))then
10183           electrolyte(jnamsa,jp,ibin)  = f_na *store(imsa_a)
10184           electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
10185           rem_na = aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin)  ! remaining na
10186           rem_nh4= aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin) ! remaining nh4
10187         else
10188           electrolyte(jnamsa,jp,ibin)  = aer(ina_a,jp,ibin)
10189           electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
10190           electrolyte(jmsa,jp,ibin)    = store(imsa_a) - sum_na_nh4
10191           rem_nh4 = 0.0  ! remaining nh4
10192           rem_na  = 0.0  ! remaining na
10193         endif
10194
10195
10196 ! recompute xt
10197         if(aer(iso4_a,jp,ibin).gt.0.0)then
10198           xt = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
10199         else
10200           goto 10
10201         endif
10202
10203         if(xt .le. 1.0)then     ! h2so4 + bisulfate
10204           xh = (1.0 - xt)
10205           xb = xt
10206           electrolyte(jh2so4,jp,ibin)   = xh*aer(iso4_a,jp,ibin)
10207           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10208           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
10209         elseif(xt .le. 1.5)then ! bisulfate + letovicite
10210           xb = 3.0 - 2.0*xt
10211           xl = xt - 1.0
10212           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10213           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
10214           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
10215           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10216         else                    ! letovicite + sulfate
10217           xl = 2.0 - xt
10218           xs = 2.0*xt - 3.0
10219           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
10220           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10221           electrolyte(jnh4so4,jp,ibin)  = xs*f_nh4*aer(iso4_a,jp,ibin)
10222           electrolyte(jna2so4,jp,ibin)  = xs*f_na *aer(iso4_a,jp,ibin)
10223         endif
10224
10225         electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
10226         electrolyte(jhcl,jp,ibin)  = aer(icl_a,jp,ibin)
10227
10228       endif
10229 !---------------------------------------------------------
10230 !
10231 ! calculate % composition
10232 !! 10    sum_dum = 0.0
10233 !!      do je = 1, nelectrolyte
10234 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10235 !!      enddo
10236 !!
10237 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10238 !!      electrolyte_sum(jp,ibin) = sum_dum
10239 !!
10240 !!      do je = 1, nelectrolyte
10241 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10242 !!      enddo
10243
10244 10    return
10245       end subroutine ions_to_electrolytes
10246
10247
10248
10249
10250
10251
10252
10253
10254
10255
10256
10257
10258
10259
10260
10261
10262
10263
10264
10265
10266
10267
10268
10269
10270
10271
10272
10273 !***********************************************************************
10274 ! conforms aerosol generic species to a valid electrolyte composition
10275 !
10276 ! author: rahul a. zaveri
10277 ! update: june 2000
10278 !-----------------------------------------------------------------------
10279       subroutine conform_electrolytes(jp,ibin,xt)
10280 !     implicit none
10281 !     include 'mosaic.h'
10282 ! subr arguments
10283       integer ibin, jp
10284       real(kind=8) xt
10285 ! local variables
10286       integer i, ixt_case, je
10287       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
10288       real(kind=8) store(naer)
10289
10290 ! remove negative concentrations, if any
10291       do i=1,naer
10292       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
10293       enddo
10294
10295
10296       call calculate_xt(ibin,jp,xt)
10297
10298       if(xt .ge. 1.9999 .or. xt.lt.0.)then
10299        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
10300       else
10301        ixt_case = 2     ! acidic (acidity is caused by excess so4)
10302       endif
10303
10304 ! initialize
10305 !
10306 ! put total aer(*) into store(*)
10307       store(iso4_a) = aer(iso4_a,jp,ibin)
10308       store(ino3_a) = aer(ino3_a,jp,ibin)
10309       store(icl_a)  = aer(icl_a, jp,ibin)
10310       store(imsa_a) = aer(imsa_a,jp,ibin)
10311       store(ico3_a) = aer(ico3_a,jp,ibin)
10312       store(inh4_a) = aer(inh4_a,jp,ibin)
10313       store(ina_a)  = aer(ina_a, jp,ibin)
10314       store(ica_a)  = aer(ica_a, jp,ibin)
10315
10316       do je=1,nelectrolyte
10317       electrolyte(je,jp,ibin) = 0.0
10318       enddo
10319 !
10320 !---------------------------------------------------------
10321 !
10322       if(ixt_case.eq.1)then
10323
10324 ! xt >= 2   : sulfate deficient
10325
10326         call form_caso4(store,jp,ibin)
10327         call form_camsa2(store,jp,ibin)
10328         call form_na2so4(store,jp,ibin)
10329         call form_namsa(store,jp,ibin)
10330         call form_cano3(store,jp,ibin)
10331         call form_nano3(store,jp,ibin)
10332         call form_nacl(store,jp,ibin)
10333         call form_cacl2(store,jp,ibin)
10334         call form_caco3(store,jp,ibin)
10335         call form_nh4so4(store,jp,ibin)
10336         call form_nh4msa(store,jp,ibin)
10337         call form_nh4no3(store,jp,ibin)
10338         call form_nh4cl(store,jp,ibin)
10339         call form_msa(store,jp,ibin)
10340         call degas_hno3(store,jp,ibin)
10341         call degas_hcl(store,jp,ibin)
10342         call degas_nh3(store,jp,ibin)
10343
10344       elseif(ixt_case.eq.2)then
10345
10346 ! xt < 2   : sulfate enough or sulfate excess
10347
10348         call form_caso4(store,jp,ibin)
10349         call form_camsa2(store,jp,ibin)
10350         call form_namsa(store,jp,ibin)
10351         call form_nh4msa(store,jp,ibin)
10352         call form_msa(store,jp,ibin)
10353
10354         if(store(iso4_a).eq.0.0)goto 10
10355
10356
10357         xt_prime =(store(ina_a)+store(inh4_a))/   &
10358                         store(iso4_a)
10359         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10360
10361         if(xt_prime.ge.xna_prime)then
10362           call form_na2so4(store,jp,ibin)
10363           xnh4_prime = 0.0
10364           if(store(iso4_a).gt.1.e-15)then
10365             xnh4_prime = store(inh4_a)/store(iso4_a)
10366           endif
10367
10368           if(xnh4_prime .ge. 1.5)then
10369             call form_nh4so4_lvcite(store,jp,ibin)
10370           else
10371             call form_lvcite_nh4hso4(store,jp,ibin)
10372           endif
10373
10374         elseif(xt_prime.ge.1.)then
10375           call form_nh4hso4(store,jp,ibin)
10376           call form_na2so4_nahso4(store,jp,ibin)
10377         elseif(xt_prime.lt.1.)then
10378           call form_nahso4(store,jp,ibin)
10379           call form_nh4hso4(store,jp,ibin)
10380           call form_h2so4(store,jp,ibin)
10381         endif
10382
10383 10    call degas_hno3(store,jp,ibin)
10384       call degas_hcl(store,jp,ibin)
10385       call degas_nh3(store,jp,ibin)
10386
10387       endif ! case 1, 2
10388
10389
10390 ! re-calculate ions to eliminate round-off errors
10391       call electrolytes_to_ions(jp, ibin)
10392 !---------------------------------------------------------
10393 !
10394 ! calculate % composition
10395 !!      sum_dum = 0.0
10396 !!      do je = 1, nelectrolyte
10397 !!        electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
10398 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10399 !!      enddo
10400
10401 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10402 !!      electrolyte_sum(jp,ibin) = sum_dum
10403
10404 !!      do je = 1, nelectrolyte
10405 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10406 !!      enddo
10407
10408       return
10409       end subroutine conform_electrolytes
10410
10411
10412
10413
10414
10415
10416
10417
10418
10419
10420
10421 !***********************************************************************
10422 ! forms electrolytes from ions
10423 !
10424 ! author: rahul a. zaveri
10425 ! update: june 2000
10426 !-----------------------------------------------------------------------
10427       subroutine form_electrolytes(jp,ibin,xt)
10428 !     implicit none
10429 !     include 'mosaic.h'
10430 ! subr arguments
10431       integer ibin, jp
10432       real(kind=8) xt
10433 ! local variables
10434       integer i, ixt_case, j, je
10435       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
10436       real(kind=8) store(naer)
10437
10438 ! remove negative concentrations, if any
10439       do i=1,naer
10440       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
10441       enddo
10442
10443
10444       call calculate_xt(ibin,jp,xt)
10445
10446       if(xt .ge. 1.9999 .or. xt.lt.0.)then
10447        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
10448       else
10449        ixt_case = 2     ! acidic (acidity is caused by excess so4)
10450       endif
10451
10452 ! initialize
10453 !
10454 ! put total aer(*) into store(*)
10455       store(iso4_a) = aer(iso4_a,jp,ibin)
10456       store(ino3_a) = aer(ino3_a,jp,ibin)
10457       store(icl_a)  = aer(icl_a, jp,ibin)
10458       store(imsa_a) = aer(imsa_a,jp,ibin)
10459       store(ico3_a) = aer(ico3_a,jp,ibin)
10460       store(inh4_a) = aer(inh4_a,jp,ibin)
10461       store(ina_a)  = aer(ina_a, jp,ibin)
10462       store(ica_a)  = aer(ica_a, jp,ibin)
10463 !
10464       do j=1,nelectrolyte
10465       electrolyte(j,jp,ibin) = 0.0
10466       enddo
10467 !
10468 !---------------------------------------------------------
10469 !
10470       if(ixt_case.eq.1)then
10471
10472 ! xt >= 2   : sulfate deficient
10473         call form_caso4(store,jp,ibin)
10474         call form_camsa2(store,jp,ibin)
10475         call form_na2so4(store,jp,ibin)
10476         call form_namsa(store,jp,ibin)
10477         call form_cano3(store,jp,ibin)
10478         call form_nano3(store,jp,ibin)
10479         call form_nacl(store,jp,ibin)
10480         call form_cacl2(store,jp,ibin)
10481         call form_caco3(store,jp,ibin)
10482         call form_nh4so4(store,jp,ibin)
10483         call form_nh4msa(store,jp,ibin)
10484         call form_nh4no3(store,jp,ibin)
10485         call form_nh4cl(store,jp,ibin)
10486         call form_msa(store,jp,ibin)
10487
10488         if(jp .eq. jsolid)then
10489           call degas_hno3(store,jp,ibin)
10490           call degas_hcl(store,jp,ibin)
10491           call degas_nh3(store,jp,ibin)
10492         else
10493           call form_hno3(store,jp,ibin)
10494           call form_hcl(store,jp,ibin)
10495           call degas_nh3(store,jp,ibin)
10496         endif
10497
10498
10499
10500       elseif(ixt_case.eq.2)then
10501
10502 ! xt < 2   : sulfate enough or sulfate excess
10503
10504         call form_caso4(store,jp,ibin)
10505         call form_camsa2(store,jp,ibin)
10506         call form_namsa(store,jp,ibin)
10507         call form_nh4msa(store,jp,ibin)
10508         call form_msa(store,jp,ibin)
10509
10510         if(store(iso4_a).eq.0.0)goto 10
10511
10512
10513         xt_prime =(store(ina_a)+store(inh4_a))/   &
10514                         store(iso4_a)
10515         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10516
10517         if(xt_prime.ge.xna_prime)then
10518           call form_na2so4(store,jp,ibin)
10519           xnh4_prime = 0.0
10520           if(store(iso4_a).gt.1.e-15)then
10521             xnh4_prime = store(inh4_a)/store(iso4_a)
10522           endif
10523
10524           if(xnh4_prime .ge. 1.5)then
10525             call form_nh4so4_lvcite(store,jp,ibin)
10526           else
10527             call form_lvcite_nh4hso4(store,jp,ibin)
10528           endif
10529
10530         elseif(xt_prime.ge.1.)then
10531           call form_nh4hso4(store,jp,ibin)
10532           call form_na2so4_nahso4(store,jp,ibin)
10533         elseif(xt_prime.lt.1.)then
10534           call form_nahso4(store,jp,ibin)
10535           call form_nh4hso4(store,jp,ibin)
10536           call form_h2so4(store,jp,ibin)
10537         endif
10538
10539 10      if(jp .eq. jsolid)then
10540           call degas_hno3(store,jp,ibin)
10541           call degas_hcl(store,jp,ibin)
10542           call degas_nh3(store,jp,ibin)
10543         else
10544           call form_hno3(store,jp,ibin)
10545           call form_hcl(store,jp,ibin)
10546           call degas_nh3(store,jp,ibin)
10547         endif
10548
10549       endif ! case 1, 2
10550
10551
10552 ! re-calculate ions to eliminate round-off errors
10553       call electrolytes_to_ions(jp, ibin)
10554 !---------------------------------------------------------
10555 !
10556 ! calculate % composition
10557 !!      sum_dum = 0.0
10558 !!      do je = 1, nelectrolyte
10559 !!        electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
10560 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10561 !!      enddo
10562 !!
10563 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10564 !!      electrolyte_sum(jp,ibin) = sum_dum
10565 !!
10566 !!      do je = 1, nelectrolyte
10567 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10568 !!      enddo
10569
10570       return
10571       end subroutine form_electrolytes
10572
10573
10574
10575
10576
10577
10578
10579
10580
10581
10582
10583
10584
10585
10586 !***********************************************************************
10587 ! electrolyte formation subroutines
10588 !
10589 ! author: rahul a. zaveri
10590 ! update: june 2000
10591 !-----------------------------------------------------------------------
10592       subroutine form_caso4(store,jp,ibin)
10593 !     implicit none
10594 !     include 'mosaic.h'
10595 ! subr arguments
10596       integer jp, ibin
10597       real(kind=8) store(naer)
10598
10599       electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
10600       store(ica_a)  = store(ica_a) - electrolyte(jcaso4,jp,ibin)
10601       store(iso4_a) = store(iso4_a) - electrolyte(jcaso4,jp,ibin)
10602       store(ica_a)  = max(0.D0, store(ica_a))
10603       store(iso4_a) = max(0.D0, store(iso4_a))
10604
10605       return
10606       end subroutine form_caso4
10607
10608
10609
10610       subroutine form_camsa2(store,jp,ibin)
10611 !      implicit none
10612 !      include 'mosaic.h'
10613 ! subr arguments
10614       integer jp, ibin
10615       real(kind=8) store(naer)
10616
10617       electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
10618       store(ica_a)  = store(ica_a) - electrolyte(jcamsa2,jp,ibin)
10619       store(imsa_a) = store(imsa_a) - 2.d0*electrolyte(jcamsa2,jp,ibin)
10620       store(ica_a)  = max(0.D0, store(ica_a))
10621       store(imsa_a) = max(0.D0, store(imsa_a))
10622
10623       return
10624       end subroutine form_camsa2
10625
10626
10627
10628       subroutine form_cano3(store,jp,ibin)      ! ca(no3)2
10629 !     implicit none
10630 !     include 'mosaic.h'
10631 ! subr arguments
10632       integer jp, ibin
10633       real(kind=8) store(naer)
10634
10635       electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
10636
10637       store(ica_a)  = store(ica_a) - electrolyte(jcano3,jp,ibin)
10638       store(ino3_a) = store(ino3_a) - 2.*electrolyte(jcano3,jp,ibin)
10639       store(ica_a)  = max(0.D0, store(ica_a))
10640       store(ino3_a) = max(0.D0, store(ino3_a))
10641
10642       return
10643       end subroutine form_cano3
10644
10645
10646       subroutine form_cacl2(store,jp,ibin)
10647 !     implicit none
10648 !     include 'mosaic.h'
10649 ! subr arguments
10650       integer jp, ibin
10651       real(kind=8) store(naer)
10652
10653       electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
10654
10655       store(ica_a)  = store(ica_a) - electrolyte(jcacl2,jp,ibin)
10656       store(icl_a)  = store(icl_a) - 2.*electrolyte(jcacl2,jp,ibin)
10657       store(ica_a)  = max(0.D0, store(ica_a))
10658       store(icl_a)  = max(0.D0, store(icl_a))
10659
10660       return
10661       end subroutine form_cacl2
10662
10663
10664       subroutine form_caco3(store,jp,ibin)
10665 !     implicit none
10666 !     include 'mosaic.h'
10667 ! subr arguments
10668       integer jp, ibin
10669       real(kind=8) store(naer)
10670
10671       if(jp.eq.jtotal .or. jp.eq.jsolid)then
10672       electrolyte(jcaco3,jp,ibin) = store(ica_a)
10673
10674       aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin)  ! force co3 = caco3
10675
10676       store(ica_a) = 0.0
10677       store(ico3_a)= 0.0
10678       endif
10679
10680       return
10681       end subroutine form_caco3
10682
10683
10684       subroutine form_na2so4(store,jp,ibin)
10685 !     implicit none
10686 !     include 'mosaic.h'
10687 ! subr arguments
10688       integer jp, ibin
10689       real(kind=8) store(naer)
10690
10691       electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a),   &
10692                                             store(iso4_a))
10693       store(ina_a) = store(ina_a) - 2.*electrolyte(jna2so4,jp,ibin)
10694       store(iso4_a)= store(iso4_a) - electrolyte(jna2so4,jp,ibin)
10695       store(ina_a) = max(0.D0, store(ina_a))
10696       store(iso4_a)= max(0.D0, store(iso4_a))
10697
10698       return
10699       end subroutine form_na2so4
10700
10701
10702
10703       subroutine form_nahso4(store,jp,ibin)
10704 !     implicit none
10705 !     include 'mosaic.h'
10706 ! subr arguments
10707       integer jp, ibin
10708       real(kind=8) store(naer)
10709
10710       electrolyte(jnahso4,jp,ibin) = min(store(ina_a),   &
10711                                          store(iso4_a))
10712       store(ina_a)  = store(ina_a) - electrolyte(jnahso4,jp,ibin)
10713       store(iso4_a) = store(iso4_a) - electrolyte(jnahso4,jp,ibin)
10714       store(ina_a)  = max(0.D0, store(ina_a))
10715       store(iso4_a) = max(0.D0, store(iso4_a))
10716
10717       return
10718       end subroutine form_nahso4
10719
10720
10721
10722       subroutine form_namsa(store,jp,ibin)
10723 !      implicit none
10724 !      include 'mosaic.h'
10725 ! subr arguments
10726       integer jp, ibin
10727       real(kind=8) store(naer)
10728
10729       electrolyte(jnamsa,jp,ibin) = min(store(ina_a), &
10730                                         store(imsa_a))
10731       store(ina_a)  = store(ina_a) - electrolyte(jnamsa,jp,ibin)
10732       store(imsa_a) = store(imsa_a) - electrolyte(jnamsa,jp,ibin)
10733       store(ina_a)  = max(0.D0, store(ina_a))
10734       store(imsa_a) = max(0.D0, store(imsa_a))
10735
10736       return
10737       end subroutine form_namsa
10738
10739
10740
10741       subroutine form_nano3(store,jp,ibin)
10742 !     implicit none
10743 !     include 'mosaic.h'
10744 ! subr arguments
10745       integer jp, ibin
10746       real(kind=8) store(naer)
10747
10748       electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
10749       store(ina_a)  = store(ina_a) - electrolyte(jnano3,jp,ibin)
10750       store(ino3_a) = store(ino3_a) - electrolyte(jnano3,jp,ibin)
10751       store(ina_a)  = max(0.D0, store(ina_a))
10752       store(ino3_a) = max(0.D0, store(ino3_a))
10753
10754       return
10755       end subroutine form_nano3
10756
10757
10758
10759       subroutine form_nacl(store,jp,ibin)
10760 !     implicit none
10761 !     include 'mosaic.h'
10762 ! subr arguments
10763       integer jp, ibin
10764       real(kind=8) store(naer)
10765
10766       electrolyte(jnacl,jp,ibin) = store(ina_a)
10767
10768       store(ina_a) = 0.0
10769       store(icl_a) = store(icl_a) - electrolyte(jnacl,jp,ibin)
10770
10771       if(store(icl_a) .lt. 0.)then                              ! cl deficit in aerosol. take some from gas
10772         aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a)    ! update aer(icl_a)
10773
10774         if(jp .ne. jtotal)then
10775           aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ &            ! update for jtotal
10776                                   aer(icl_a,jsolid,ibin)
10777         endif
10778
10779         gas(ihcl_g) = gas(ihcl_g) + store(icl_a)                        ! update gas(ihcl_g)
10780
10781         if(gas(ihcl_g) .lt. 0.0)then
10782           total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g)   ! update total_species
10783           tot_cl_in = tot_cl_in - gas(ihcl_g)                           ! update tot_cl_in
10784         endif
10785
10786         gas(ihcl_g) = max(0.D0, gas(ihcl_g))                            ! restrict gas(ihcl_g) to >= 0.
10787         store(icl_a) = 0.                                       ! force store(icl_a) to 0.
10788
10789       endif
10790
10791       store(icl_a) = max(0.D0, store(icl_a))
10792
10793       return
10794       end subroutine form_nacl
10795
10796
10797
10798       subroutine form_nh4so4(store,jp,ibin)     ! (nh4)2so4
10799 !     implicit none
10800 !     include 'mosaic.h'
10801 ! subr arguments
10802       integer jp, ibin
10803       real(kind=8) store(naer)
10804
10805       electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a),   &
10806                                            store(iso4_a))
10807       store(inh4_a)= store(inh4_a) - 2.*electrolyte(jnh4so4,jp,ibin)
10808       store(iso4_a)= store(iso4_a) - electrolyte(jnh4so4,jp,ibin)
10809       store(inh4_a) = max(0.D0, store(inh4_a))
10810       store(iso4_a) = max(0.D0, store(iso4_a))
10811
10812       return
10813       end subroutine form_nh4so4
10814
10815
10816
10817       subroutine form_nh4hso4(store,jp,ibin)    ! nh4hso4
10818 !     implicit none
10819 !     include 'mosaic.h'
10820 ! subr arguments
10821       integer jp, ibin
10822       real(kind=8) store(naer)
10823
10824       electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a),   &
10825                                           store(iso4_a))
10826       store(inh4_a)= store(inh4_a) - electrolyte(jnh4hso4,jp,ibin)
10827       store(iso4_a)= store(iso4_a) - electrolyte(jnh4hso4,jp,ibin)
10828       store(inh4_a) = max(0.D0, store(inh4_a))
10829       store(iso4_a) = max(0.D0, store(iso4_a))
10830
10831       return
10832       end subroutine form_nh4hso4
10833
10834
10835
10836       subroutine form_nh4msa(store,jp,ibin)
10837 !      implicit none
10838 !      include 'mosaic.h'
10839 ! subr arguments
10840       integer jp, ibin
10841       real(kind=8) store(naer)
10842
10843       electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a), &
10844                                          store(imsa_a))
10845       store(inh4_a) = store(inh4_a) - electrolyte(jnh4msa,jp,ibin)
10846       store(imsa_a) = store(imsa_a) - electrolyte(jnh4msa,jp,ibin)
10847       store(inh4_a) = max(0.D0, store(inh4_a))
10848       store(imsa_a) = max(0.D0, store(imsa_a))
10849
10850       return
10851       end subroutine form_nh4msa
10852
10853
10854
10855       subroutine form_nh4cl(store,jp,ibin)
10856 !     implicit none
10857 !     include 'mosaic.h'
10858 ! subr arguments
10859       integer jp, ibin
10860       real(kind=8) store(naer)
10861
10862       electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a),   &
10863                                         store(icl_a))
10864       store(inh4_a) = store(inh4_a) - electrolyte(jnh4cl,jp,ibin)
10865       store(icl_a)  = store(icl_a) - electrolyte(jnh4cl,jp,ibin)
10866       store(inh4_a) = max(0.D0, store(inh4_a))
10867       store(icl_a)  = max(0.D0, store(icl_a))
10868
10869       return
10870       end subroutine form_nh4cl
10871
10872
10873
10874       subroutine form_nh4no3(store,jp,ibin)
10875 !     implicit none
10876 !     include 'mosaic.h'
10877 ! subr arguments
10878       integer jp, ibin
10879       real(kind=8) store(naer)
10880
10881       electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a),   &
10882                                          store(ino3_a))
10883       store(inh4_a) = store(inh4_a) - electrolyte(jnh4no3,jp,ibin)
10884       store(ino3_a) = store(ino3_a) - electrolyte(jnh4no3,jp,ibin)
10885       store(inh4_a) = max(0.D0, store(inh4_a))
10886       store(ino3_a) = max(0.D0, store(ino3_a))
10887
10888       return
10889       end subroutine form_nh4no3
10890
10891
10892
10893       subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
10894 !     implicit none
10895 !     include 'mosaic.h'
10896 ! subr arguments
10897       integer jp, ibin
10898       real(kind=8) store(naer)
10899
10900       electrolyte(jnh4so4,jp,ibin)= 2.*store(inh4_a) - 3.*store(iso4_a)
10901       electrolyte(jlvcite,jp,ibin)= 2.*store(iso4_a) - store(inh4_a)
10902       electrolyte(jnh4so4,jp,ibin)= max(0.D0,   &
10903                                     electrolyte(jnh4so4,jp,ibin))
10904       electrolyte(jlvcite,jp,ibin)= max(0.D0,   &
10905                                     electrolyte(jlvcite,jp,ibin))
10906       store(inh4_a) = 0.
10907       store(iso4_a) = 0.
10908
10909       return
10910       end subroutine form_nh4so4_lvcite
10911
10912
10913
10914       subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
10915 !     implicit none
10916 !     include 'mosaic.h'
10917 ! subr arguments
10918       integer jp, ibin
10919       real(kind=8) store(naer)
10920
10921       electrolyte(jlvcite,jp,ibin) = store(inh4_a) - store(iso4_a)
10922       electrolyte(jnh4hso4,jp,ibin)= 3.*store(iso4_a) - 2.*store(inh4_a)
10923       electrolyte(jlvcite,jp,ibin) = max(0.D0,   &
10924                                       electrolyte(jlvcite,jp,ibin))
10925       electrolyte(jnh4hso4,jp,ibin)= max(0.D0,   &
10926                                       electrolyte(jnh4hso4,jp,ibin))
10927       store(inh4_a) = 0.
10928       store(iso4_a) = 0.
10929
10930       return
10931       end subroutine form_lvcite_nh4hso4
10932
10933
10934
10935       subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
10936 !     implicit none
10937 !     include 'mosaic.h'
10938 ! subr arguments
10939       integer jp, ibin
10940       real(kind=8) store(naer)
10941
10942       electrolyte(jna2so4,jp,ibin)= store(ina_a) - store(iso4_a)
10943       electrolyte(jnahso4,jp,ibin)= 2.*store(iso4_a) - store(ina_a)
10944       electrolyte(jna2so4,jp,ibin)= max(0.D0,   &
10945                                     electrolyte(jna2so4,jp,ibin))
10946       electrolyte(jnahso4,jp,ibin)= max(0.D0,   &
10947                                     electrolyte(jnahso4,jp,ibin))
10948       store(ina_a)  = 0.
10949       store(iso4_a) = 0.
10950
10951 !       write(6,*)'na2so4 + nahso4'
10952
10953       return
10954       end subroutine form_na2so4_nahso4
10955
10956
10957
10958
10959       subroutine form_h2so4(store,jp,ibin)
10960 !     implicit none
10961 !     include 'mosaic.h'
10962 ! subr arguments
10963       integer jp, ibin
10964       real(kind=8) store(naer)
10965
10966       electrolyte(jh2so4,jp,ibin) = max(0.0D0, store(iso4_a))
10967       store(iso4_a) = 0.0
10968
10969       return
10970       end subroutine form_h2so4
10971
10972
10973
10974
10975       subroutine form_msa(store,jp,ibin)
10976 !      implicit none
10977 !      include 'mosaic.h'
10978 ! subr arguments
10979       integer jp, ibin
10980       real(kind=8) store(naer)
10981
10982       electrolyte(jmsa,jp,ibin) = max(0.0D0, store(imsa_a))
10983       store(imsa_a) = 0.0
10984
10985       return
10986       end subroutine form_msa
10987
10988
10989
10990       subroutine form_hno3(store,jp,ibin)
10991 !     implicit none
10992 !     include 'mosaic.h'
10993 ! subr arguments
10994       integer jp, ibin
10995       real(kind=8) store(naer)
10996
10997       electrolyte(jhno3,jp,ibin) = max(0.0D0, store(ino3_a))
10998       store(ino3_a) = 0.0
10999
11000       return
11001       end subroutine form_hno3
11002
11003
11004
11005
11006       subroutine form_hcl(store,jp,ibin)
11007 !     implicit none
11008 !     include 'mosaic.h'
11009 ! subr arguments
11010       integer jp, ibin
11011       real(kind=8) store(naer)
11012
11013       electrolyte(jhcl,jp,ibin) = max(0.0D0, store(icl_a))
11014       store(icl_a) = 0.0
11015
11016       return
11017       end subroutine form_hcl
11018
11019
11020
11021
11022       subroutine degas_hno3(store,jp,ibin)
11023 !     implicit none
11024 !     include 'mosaic.h'
11025 ! subr arguments
11026       integer jp, ibin
11027       real(kind=8) store(naer)
11028
11029       store(ino3_a) = max(0.0D0, store(ino3_a))
11030       gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
11031       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - store(ino3_a)
11032       aer(ino3_a,jp,ibin) = max(0.0D0,aer(ino3_a,jp,ibin))
11033
11034 ! also do it for jtotal
11035       if(jp .ne. jtotal)then
11036         aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) +   &
11037                                   aer(ino3_a,jliquid,ibin)
11038       endif
11039
11040       electrolyte(jhno3,jp,ibin) = 0.0
11041       store(ino3_a) = 0.0
11042
11043       return
11044       end subroutine degas_hno3
11045
11046
11047
11048       subroutine degas_hcl(store,jp,ibin)
11049 !     implicit none
11050 !     include 'mosaic.h'
11051 ! subr arguments
11052       integer jp, ibin
11053       real(kind=8) store(naer)
11054
11055       store(icl_a) = max(0.0D0, store(icl_a))
11056       gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
11057       aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - store(icl_a)
11058       aer(icl_a,jp,ibin) = max(0.0D0,aer(icl_a,jp,ibin))
11059
11060 ! also do it for jtotal
11061       if(jp .ne. jtotal)then
11062         aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) +   &
11063                                  aer(icl_a,jliquid,ibin)
11064       endif
11065
11066       electrolyte(jhcl,jp,ibin) = 0.0
11067       store(icl_a) = 0.0
11068
11069       return
11070       end subroutine degas_hcl
11071
11072
11073
11074       subroutine degas_nh3(store,jp,ibin)
11075 !     implicit none
11076 !     include 'mosaic.h'
11077 ! subr arguments
11078       integer jp, ibin
11079       real(kind=8) store(naer)
11080
11081       store(inh4_a) = max(0.0D0, store(inh4_a))
11082       gas(inh3_g) = gas(inh3_g) + store(inh4_a)
11083       aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - store(inh4_a)
11084       aer(inh4_a,jp,ibin) = max(0.0D0,aer(inh4_a,jp,ibin))
11085
11086 ! also do it for jtotal
11087       if(jp .ne. jtotal)then
11088         aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) +   &
11089                                  aer(inh4_a,jliquid,ibin)
11090       endif
11091
11092       store(inh4_a) = 0.0
11093
11094       return
11095       end subroutine degas_nh3
11096
11097
11098
11099
11100
11101
11102
11103
11104
11105       subroutine degas_acids(jp,ibin,xt)
11106 !     implicit none
11107 !     include 'mosaic.h'
11108 ! subr arguments
11109       integer jp, ibin
11110       real(kind=8) xt
11111 ! local variables
11112       real(kind=8) ehno3, ehcl
11113
11114
11115
11116       if(jp .ne. jliquid)then
11117         if (iprint_mosaic_diag1 .gt. 0) then
11118           write(6,*)'mosaic - error in degas_acids'
11119           write(6,*)'wrong jp'
11120         endif
11121       endif
11122
11123       ehno3 = electrolyte(jhno3,jp,ibin)
11124       ehcl  = electrolyte(jhcl,jp,ibin)
11125
11126 ! add to gas
11127       gas(ihno3_g) = gas(ihno3_g) + ehno3
11128       gas(ihcl_g)  = gas(ihcl_g)  + ehcl
11129
11130 ! remove from aer
11131       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
11132       aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
11133
11134 ! update jtotal
11135       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11136                                 aer(ino3_a,jsolid, ibin)
11137
11138       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
11139                                 aer(icl_a,jsolid, ibin)
11140
11141       electrolyte(jhno3,jp,ibin) = 0.0
11142       electrolyte(jhcl,jp,ibin)  = 0.0
11143
11144       return
11145       end subroutine degas_acids
11146
11147
11148
11149
11150
11151
11152
11153
11154
11155
11156
11157
11158
11159
11160 !***********************************************************************
11161 ! subroutines to evaporate solid volatile species
11162 !
11163 ! author: rahul a. zaveri
11164 ! update: sep 2004
11165 !-----------------------------------------------------------------------
11166 !
11167 ! nh4no3 (solid)
11168       subroutine degas_solid_nh4no3(ibin)
11169 !     implicit none
11170 !     include 'mosaic.h'
11171 ! subr arguments
11172       integer ibin
11173 ! local variables
11174       integer jp
11175       real(kind=8) a, b, c, xgas, xt
11176 !     real(kind=8) quadratic                                    ! mosaic func
11177
11178
11179       jp = jsolid
11180
11181       a = 1.0
11182       b = gas(inh3_g) + gas(ihno3_g)
11183       c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
11184       xgas = quadratic(a,b,c)
11185
11186       if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
11187
11188           gas(inh3_g) = gas(inh3_g)  + electrolyte(jnh4no3,jp,ibin)
11189           gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
11190           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
11191                                 electrolyte(jnh4no3,jp,ibin)
11192           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) -   &
11193                                 electrolyte(jnh4no3,jp,ibin)
11194
11195       else      ! degas only xgas amount of nh4no3
11196
11197           gas(inh3_g) = gas(inh3_g)  + xgas
11198           gas(ihno3_g)= gas(ihno3_g) + xgas
11199           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
11200           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
11201       endif
11202
11203
11204 ! update jtotal
11205       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11206                                  aer(inh4_a,jliquid,ibin)
11207       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11208                                  aer(ino3_a,jliquid,ibin)
11209
11210       return
11211       end subroutine degas_solid_nh4no3
11212
11213
11214
11215
11216
11217
11218
11219
11220
11221 ! nh4cl (solid)
11222       subroutine degas_solid_nh4cl(ibin)
11223 !     implicit none
11224 !     include 'mosaic.h'
11225 ! subr arguments
11226       integer ibin
11227 ! local variables
11228       integer jp
11229       real(kind=8) a, b, c, xgas, xt
11230 !     real(kind=8) quadratic                                    ! mosaic func
11231
11232
11233       jp = jsolid
11234
11235       a = 1.0
11236       b = gas(inh3_g) + gas(ihcl_g)
11237       c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
11238       xgas = quadratic(a,b,c)
11239
11240       if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
11241
11242           gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
11243           gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
11244           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
11245                                 electrolyte(jnh4cl,jp,ibin)
11246           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin) -   &
11247                                 electrolyte(jnh4cl,jp,ibin)
11248
11249       else      ! degas only xgas amount of nh4cl
11250
11251           gas(inh3_g) = gas(inh3_g) + xgas
11252           gas(ihcl_g) = gas(ihcl_g) + xgas
11253           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
11254           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin)  - xgas
11255
11256       endif
11257
11258
11259 ! update jtotal
11260       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11261                                  aer(inh4_a,jliquid,ibin)
11262       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11263                                  aer(icl_a,jliquid,ibin)
11264
11265       return
11266       end subroutine degas_solid_nh4cl
11267
11268
11269
11270
11271
11272
11273
11274
11275
11276
11277
11278 !***********************************************************************
11279 ! subroutines to absorb and degas small amounts of volatile species
11280 !
11281 ! author: rahul a. zaveri
11282 ! update: jun 2002
11283 !-----------------------------------------------------------------------
11284 !
11285 ! nh4no3 (liquid)
11286       subroutine absorb_tiny_nh4no3(ibin)
11287 !     implicit none
11288 !     include 'mosaic.h'
11289 ! subr arguments
11290       integer ibin
11291 ! local variables
11292       real(kind=8) small_aer, small_gas, small_amt
11293       integer je                                        ! raz update 11/13/2008
11294
11295
11296
11297       electrolyte_sum(jtotal,ibin) = 0.0        ! raz update 11/13/2008
11298       do je = 1, nelectrolyte
11299         electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
11300                                        electrolyte(je,jtotal,ibin)
11301       enddo
11302
11303
11304       small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
11305       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
11306       if(small_aer .eq. 0.0)small_aer = small_gas
11307
11308       small_amt = min(small_gas, small_aer)
11309
11310       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
11311       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
11312
11313 ! update jtotal
11314       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11315                                  aer(inh4_a,jliquid,ibin)
11316       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11317                                  aer(ino3_a,jliquid,ibin)
11318
11319 ! update gas
11320       gas(inh3_g)    = gas(inh3_g) - small_amt
11321       gas(ihno3_g)   = gas(ihno3_g) - small_amt
11322
11323       return
11324       end subroutine absorb_tiny_nh4no3
11325
11326
11327
11328
11329
11330
11331 !--------------------------------------------------------------------
11332 ! nh4cl (liquid)
11333       subroutine absorb_tiny_nh4cl(ibin)
11334 !     implicit none
11335 !     include 'mosaic.h'
11336 ! subr arguments
11337       integer ibin
11338 ! local variables
11339       real(kind=8) small_aer, small_gas, small_amt
11340         integer je                                      ! raz update 11/13/2008
11341
11342
11343
11344       electrolyte_sum(jtotal,ibin) = 0.0        ! raz update 11/13/2008
11345       do je = 1, nelectrolyte
11346         electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
11347                                        electrolyte(je,jtotal,ibin)
11348       enddo
11349
11350
11351       small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
11352       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
11353       if(small_aer .eq. 0.0)small_aer = small_gas
11354
11355       small_amt = min(small_gas, small_aer)
11356
11357       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
11358       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin)  + small_amt
11359
11360 ! update jtotal
11361       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11362                                  aer(inh4_a,jliquid,ibin)
11363       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11364                                  aer(icl_a,jliquid,ibin)
11365
11366 ! update gas
11367       gas(inh3_g)   = gas(inh3_g) - small_amt
11368       gas(ihcl_g)   = gas(ihcl_g) - small_amt
11369
11370       return
11371       end subroutine absorb_tiny_nh4cl
11372
11373
11374
11375
11376
11377
11378
11379
11380
11381
11382
11383
11384
11385 !--------------------------------------------------------------
11386 ! nh4no3 (liquid)
11387       subroutine degas_tiny_nh4no3(ibin)
11388 !     implicit none
11389 !     include 'mosaic.h'
11390 ! subr arguments
11391       integer ibin
11392 ! local variables
11393       real(kind=8) small_amt
11394
11395       small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
11396
11397       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
11398       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
11399
11400 ! update jtotal
11401       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11402                                  aer(inh4_a,jliquid,ibin)
11403       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11404                                  aer(ino3_a,jliquid,ibin)
11405
11406 ! update gas
11407       gas(inh3_g)  = gas(inh3_g)  + small_amt
11408       gas(ihno3_g) = gas(ihno3_g) + small_amt
11409
11410       return
11411       end subroutine degas_tiny_nh4no3
11412
11413
11414
11415
11416 !--------------------------------------------------------------------
11417 ! liquid nh4cl (liquid)
11418       subroutine degas_tiny_nh4cl(ibin)
11419 !     implicit none
11420 !     include 'mosaic.h'
11421 ! subr arguments
11422       integer ibin
11423 ! local variables
11424       real(kind=8) small_amt
11425
11426
11427       small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
11428
11429       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
11430       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
11431
11432 ! update jtotal
11433       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11434                                  aer(inh4_a,jliquid,ibin)
11435       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11436                                  aer(icl_a,jliquid,ibin)
11437
11438 ! update gas
11439       gas(inh3_g) = gas(inh3_g) + small_amt
11440       gas(ihcl_g) = gas(ihcl_g) + small_amt
11441
11442       return
11443       end subroutine degas_tiny_nh4cl
11444
11445
11446
11447
11448
11449
11450
11451 !--------------------------------------------------------------------
11452 ! hcl (liquid)
11453       subroutine absorb_tiny_hcl(ibin)  ! and degas tiny hno3
11454 !     implicit none
11455 !     include 'mosaic.h'
11456 ! subr arguments
11457       integer ibin
11458 ! local variables
11459       real(kind=8) small_aer, small_amt, small_gas
11460
11461       small_gas = 0.01 * gas(ihcl_g)
11462       small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
11463
11464       small_amt = min(small_gas, small_aer)
11465
11466 ! absorb tiny hcl
11467       aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
11468       aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) +   &
11469                                aer(icl_a,jliquid,ibin)
11470       gas(ihcl_g) = gas(ihcl_g) - small_amt
11471
11472 ! degas tiny hno3
11473       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
11474       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11475                                  aer(ino3_a,jliquid,ibin)
11476
11477 ! update gas
11478       gas(ihno3_g) = gas(ihno3_g) + small_amt
11479
11480       return
11481       end subroutine absorb_tiny_hcl
11482
11483
11484
11485 !--------------------------------------------------------------------
11486 ! hno3 (liquid)
11487       subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
11488 !     implicit none
11489 !     include 'mosaic.h'
11490 ! subr arguments
11491       integer ibin
11492 ! local variables
11493       real(kind=8) small_aer, small_amt, small_gas
11494
11495       small_gas = 0.01 * gas(ihno3_g)
11496       small_aer = 0.01 * aer(icl_a,jliquid,ibin)
11497
11498       small_amt = min(small_gas, small_aer)
11499
11500 ! absorb tiny hno3
11501       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
11502       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11503                                  aer(ino3_a,jliquid,ibin)
11504       gas(ihno3_g) = gas(ihno3_g) - small_amt
11505
11506 ! degas tiny hcl
11507       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
11508       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin) +   &
11509                                  aer(icl_a,jliquid,ibin)
11510
11511 ! update gas
11512       gas(ihcl_g) = gas(ihcl_g) + small_amt
11513
11514       return
11515       end subroutine absorb_tiny_hno3
11516
11517
11518
11519
11520
11521
11522
11523
11524
11525 !***********************************************************************
11526 ! subroutines to equilibrate volatile acids
11527 !
11528 ! author: rahul a. zaveri
11529 ! update: may 2002
11530 !-----------------------------------------------------------------------
11531       subroutine equilibrate_acids(ibin)
11532 !     implicit none
11533 !     include 'mosaic.h'
11534 ! subr arguments
11535       integer ibin
11536
11537
11538
11539       if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
11540         call equilibrate_hcl_and_hno3(ibin)
11541       elseif(gas(ihcl_g) .gt. 0.)then
11542         call equilibrate_hcl(ibin)
11543       elseif(gas(ihno3_g) .gt. 0.)then
11544         call equilibrate_hno3(ibin)
11545       endif
11546
11547
11548       return
11549       end subroutine equilibrate_acids
11550
11551
11552
11553
11554
11555
11556
11557
11558 ! only hcl
11559       subroutine equilibrate_hcl(ibin)
11560 !     implicit none
11561 !     include 'mosaic.h'
11562 ! subr arguments
11563       integer ibin
11564 ! local variables
11565       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl,   &
11566         w, xt, z
11567 !     real(kind=8) quadratic                                    ! mosaic func
11568
11569       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11570       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11571
11572       tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g)               ! nmol/m^3(air)
11573       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
11574       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11575               aer(inh4_a,jliquid,ibin) +   &
11576            2.*aer(ica_a, jliquid,ibin) ) -   &
11577           (2.*aerso4  +   &
11578               aerhso4 +   &
11579               aer(ino3_a,jliquid,ibin) )
11580
11581
11582       w     = water_a(ibin)                             ! kg/m^3(air)
11583
11584       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
11585       a = 1.0
11586       b = (kdash_hcl*w + z/w)*1.e-9
11587       c = kdash_hcl*(z - tcl)*1.e-18
11588
11589
11590       dum = b*b - 4.*a*c
11591       if (dum .lt. 0.) return           ! no real root
11592
11593
11594       if(c .lt. 0.)then
11595         mh = quadratic(a,b,c)   ! mol/kg(water)
11596         aerh = mh*w*1.e+9
11597         aer(icl_a,jliquid,ibin) = aerh + z
11598       else
11599         mh = sqrt(keq_ll(3))
11600       endif
11601
11602       call form_electrolytes(jliquid,ibin,xt)
11603
11604 ! update gas phase concentration
11605       gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
11606
11607
11608 ! update the following molalities
11609       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11610       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11611       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11612       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11613
11614       mc(jc_h,ibin)    = mh
11615       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11616       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11617       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11618
11619
11620 ! update the following activities
11621       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
11622                                gam(jhcl,ibin)**2
11623
11624       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
11625                                gam(jhno3,ibin)**2
11626
11627       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
11628                                gam(jnh4cl,ibin)**2
11629
11630
11631 ! also update xyz(jtotal)
11632       aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) +   &
11633                                aer(icl_a,jsolid,ibin)
11634
11635       electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
11636
11637       return
11638       end subroutine equilibrate_hcl
11639
11640
11641
11642
11643 ! only hno3
11644       subroutine equilibrate_hno3(ibin)
11645 !     implicit none
11646 !     include 'mosaic.h'
11647 ! subr arguments
11648       integer ibin
11649 ! local variables
11650       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh,   &
11651         tno3, w, xt, z
11652 !     real(kind=8) quadratic                                    ! mosaic func
11653
11654       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11655       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11656
11657       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
11658       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11659       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11660               aer(inh4_a,jliquid,ibin) +   &
11661            2.*aer(ica_a, jliquid,ibin) ) -   &
11662           (2.*aerso4  +   &
11663               aerhso4 +   &
11664               aer(icl_a,jliquid,ibin) )
11665
11666
11667       w     = water_a(ibin)                             ! kg/m^3(air)
11668
11669       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11670       a = 1.0
11671       b = (kdash_hno3*w + z/w)*1.e-9
11672       c = kdash_hno3*(z - tno3)*1.e-18
11673
11674       dum = b*b - 4.*a*c
11675       if (dum .lt. 0.) return           ! no real root
11676
11677
11678
11679       if(c .lt. 0.)then
11680         mh = quadratic(a,b,c)   ! mol/kg(water)
11681         aerh = mh*w*1.e+9
11682         aer(ino3_a,jliquid,ibin) = aerh + z
11683       else
11684         mh = sqrt(keq_ll(3))
11685       endif
11686
11687       call form_electrolytes(jliquid,ibin,xt)
11688
11689 ! update gas phase concentration
11690       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
11691
11692
11693 ! update the following molalities
11694       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11695       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11696       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11697       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11698
11699       mc(jc_h,ibin)    = mh
11700       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11701       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11702       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11703
11704
11705 ! update the following activities
11706       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
11707                                gam(jhcl,ibin)**2
11708
11709       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
11710                                gam(jhno3,ibin)**2
11711
11712       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) *   &
11713                                gam(jnh4no3,ibin)**2
11714
11715
11716 ! also update xyz(jtotal)
11717       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11718                                 aer(ino3_a,jsolid,ibin)
11719
11720       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
11721
11722       return
11723       end subroutine equilibrate_hno3
11724
11725
11726
11727
11728
11729
11730
11731
11732
11733
11734 ! both hcl and hno3
11735       subroutine equilibrate_hcl_and_hno3(ibin)
11736 !     implicit none
11737 !     include 'mosaic.h'
11738 ! subr arguments
11739       integer ibin
11740 ! local variables
11741       real(kind=8) aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3,   &
11742         mh, p, q, r, tcl, tno3, w, xt, z
11743 !     real(kind=8) cubic                                        ! mosaic func
11744
11745
11746       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11747       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11748
11749       tcl  = aer(icl_a,jliquid,ibin)  + gas(ihcl_g)     ! nmol/m^3(air)
11750       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
11751
11752       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
11753       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11754
11755       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11756               aer(inh4_a,jliquid,ibin) +   &
11757            2.*aer(ica_a, jliquid,ibin) ) -   &
11758           (2.*aerso4 + aerhso4 )
11759
11760
11761       w = water_a(ibin)
11762
11763       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
11764       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11765
11766       p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
11767
11768       q = 1.e-18*kdash_hcl*kdash_hno3*w**2  +   &
11769           1.e-18*z*(kdash_hcl + kdash_hno3) -   &
11770           1.e-18*kdash_hcl*tcl -   &
11771           1.e-18*kdash_hno3*tno3
11772
11773       r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
11774
11775       mh = cubic(p,q,r)
11776
11777       if(mh .gt. 0.0)then
11778         aerh = mh*w*1.e+9
11779         aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/   &
11780                                   (aerh + kdash_hno3*w*w)
11781         aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/   &
11782                                   (aerh + kdash_hcl*w*w)
11783       else
11784         mh = sqrt(keq_ll(3))
11785       endif
11786
11787       call form_electrolytes(jliquid,ibin,xt)
11788
11789 ! update gas phase concentration
11790       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
11791       gas(ihcl_g) = tcl  - aer(icl_a,jliquid,ibin)
11792
11793
11794 ! update the following molalities
11795       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11796       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11797       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11798       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11799
11800       mc(jc_h,ibin)    = mh
11801       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11802       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11803       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11804
11805
11806 ! update the following activities
11807       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)   *   &
11808                                gam(jhcl,ibin)**2
11809
11810       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)  *   &
11811                                gam(jhno3,ibin)**2
11812
11813       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)*   &
11814                                gam(jnh4no3,ibin)**2
11815
11816       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
11817                                gam(jnh4cl,ibin)**2
11818
11819
11820 ! also update xyz(jtotal)
11821       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
11822                                 aer(icl_a,jsolid,ibin)
11823
11824       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11825                                 aer(ino3_a,jsolid,ibin)
11826
11827       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
11828       electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
11829
11830       return
11831       end subroutine equilibrate_hcl_and_hno3
11832
11833
11834
11835
11836
11837
11838
11839
11840
11841
11842
11843
11844
11845 !***********************************************************************
11846 ! called only once per entire simulation to load gas and aerosol
11847 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
11848 !
11849 ! author: rahul a. zaveri
11850 ! update: jan 2005
11851 !-----------------------------------------------------------------------
11852       subroutine load_mosaic_parameters
11853 !     implicit none
11854 !     include 'v33com2'
11855 !     include 'mosaic.h'
11856 ! local variables
11857       integer iaer, je, ja, j_index, ibin
11858 !     logical first
11859 !     save first
11860 !     data first/.true./
11861       logical, save :: first = .true.
11862
11863
11864
11865       if(first)then
11866         first=.false.
11867
11868 !----------------------------------------------------------------
11869 ! control settings
11870       msize_framework = msection        ! mmodal or msection
11871       mgas_aer_xfer   = myes            ! myes, mno
11872
11873 ! astem parameters
11874       nmax_astem      = 200             ! max number of time steps in astem
11875       alpha_astem     = 0.05            ! choose a value between 0.01 and 1.0
11876 ! Changed alpha_astem from 0.5 to 0.05 by Manish Shrivastava on 01/08/2010
11877       rtol_eqb_astem  = 0.01            ! equilibrium tolerance in astem
11878       ptol_mol_astem  = 0.01            ! mol percent tolerance in astem
11879
11880 ! mesa parameters
11881       nmax_mesa       = 80              ! max number of iterations in mesa_ptc
11882       rtol_mesa       = 0.01            ! mesa equilibrium tolerance
11883 !----------------------------------------------------------------
11884 !
11885 ! set gas and aerosol indices
11886 !
11887 ! gas (local)
11888
11889
11890       ih2so4_g  = 1     ! ioa (inorganic aerosol)
11891       ihno3_g   = 2     ! ioa
11892       ihcl_g    = 3     ! ioa
11893       inh3_g    = 4     ! ioa
11894       imsa_g    = 5     ! ioa
11895       ipcg1_b_c_g =6
11896       ipcg2_b_c_g =7
11897       ipcg3_b_c_g =8
11898       ipcg4_b_c_g =9
11899       ipcg5_b_c_g =10
11900       ipcg6_b_c_g =11
11901       ipcg7_b_c_g =12
11902       ipcg8_b_c_g =13
11903       ipcg9_b_c_g =14
11904       ipcg1_b_o_g =15
11905       ipcg2_b_o_g =16
11906       ipcg3_b_o_g =17
11907       ipcg4_b_o_g =18
11908       ipcg5_b_o_g =19
11909       ipcg6_b_o_g =20
11910       ipcg7_b_o_g =21
11911       ipcg8_b_o_g =22
11912       ipcg9_b_o_g =23
11913       iopcg1_b_c_g =24
11914       iopcg2_b_c_g = 25
11915       iopcg3_b_c_g =26
11916       iopcg4_b_c_g =27
11917       iopcg5_b_c_g =28
11918       iopcg6_b_c_g =29
11919       iopcg7_b_c_g =30
11920       iopcg8_b_c_g =31
11921       iopcg1_b_o_g =32
11922       iopcg2_b_o_g =33
11923       iopcg3_b_o_g =34
11924       iopcg4_b_o_g =35
11925       iopcg5_b_o_g =36
11926       iopcg6_b_o_g =37
11927       iopcg7_b_o_g =38
11928       iopcg8_b_o_g =39
11929       ipcg1_f_c_g =40
11930       ipcg2_f_c_g =41
11931       ipcg3_f_c_g =42
11932       ipcg4_f_c_g =43
11933       ipcg5_f_c_g =44
11934       ipcg6_f_c_g =45
11935       ipcg7_f_c_g =46
11936       ipcg8_f_c_g =47
11937       ipcg9_f_c_g =48
11938       ipcg1_f_o_g =49
11939       ipcg2_f_o_g =50
11940       ipcg3_f_o_g =51
11941       ipcg4_f_o_g =52
11942       ipcg5_f_o_g =53
11943       ipcg6_f_o_g =54
11944       ipcg7_f_o_g =55
11945       ipcg8_f_o_g =56
11946       ipcg9_f_o_g =57
11947       iopcg1_f_c_g =58
11948       iopcg2_f_c_g =59
11949       iopcg3_f_c_g =60
11950       iopcg4_f_c_g =61
11951       iopcg5_f_c_g =62
11952       iopcg6_f_c_g =63
11953       iopcg7_f_c_g =64
11954       iopcg8_f_c_g =65
11955       iopcg1_f_o_g =66
11956       iopcg2_f_o_g =67
11957       iopcg3_f_o_g =68
11958       iopcg4_f_o_g =69
11959       iopcg5_f_o_g =70
11960       iopcg6_f_o_g =71
11961       iopcg7_f_o_g =72
11962       iopcg8_f_o_g =73
11963       ismpa_g =74
11964       ismpbb_g =75
11965       iant1_c_g =76
11966       iant2_c_g =77
11967       iant3_c_g =78
11968       iant4_c_g =79
11969       iant1_o_g =80
11970       iant2_o_g =81
11971       iant3_o_g =82
11972       iant4_o_g =83
11973       ibiog1_c_g =84
11974       ibiog2_c_g =85
11975       ibiog3_c_g =86
11976       ibiog4_c_g =87
11977       ibiog1_o_g =88
11978       ibiog2_o_g =89
11979       ibiog3_o_g =90
11980       ibiog4_o_g =91
11981 !      in2o5_g    =92  ! ioa --> NO3-
11982 !      iclno2_g   =93  ! ioa N2O5+Cl- -->
11983 !     the order of species is ngas_ioa, then ngas_soa, then the rest...
11984 !     for the "equilibrium" routine i*_a and i*_g species
11985 !     have to have the same index.
11986       iasoaX_g=92
11987       iasoa1_g=93
11988       iasoa2_g=94
11989       iasoa3_g=95
11990       iasoa4_g=96
11991       ibsoaX_g=97
11992       ibsoa1_g=98
11993       ibsoa2_g=99
11994       ibsoa3_g=100
11995       ibsoa4_g=101
11996       in2o5_g    =102  ! ioa --> NO3-
11997       iclno2_g   =103  ! ioa N2O5+Cl- -->
11998
11999       igly       =104
12000       iho        =105
12001
12002
12003 !      ico2_g   = 14    ! currently not used
12004 !
12005 ! aerosol (local): used for total species
12006       iso4_a    =  1    ! <-> ih2so4_g
12007       ino3_a    =  2    ! <-> ihno3_g
12008       icl_a     =  3    ! <-> ihcl_g
12009       inh4_a    =  4    ! <-> inh3_g
12010       imsa_a    =  5    ! <-> imsa_g
12011       ipcg1_b_c_a =6
12012       ipcg2_b_c_a =7
12013       ipcg3_b_c_a =8
12014       ipcg4_b_c_a =9
12015       ipcg5_b_c_a =10
12016       ipcg6_b_c_a =11
12017       ipcg7_b_c_a =12
12018       ipcg8_b_c_a =13
12019       ipcg9_b_c_a =14
12020       ipcg1_b_o_a =15
12021       ipcg2_b_o_a =16
12022       ipcg3_b_o_a =17
12023       ipcg4_b_o_a =18
12024       ipcg5_b_o_a =19
12025       ipcg6_b_o_a =20
12026       ipcg7_b_o_a =21
12027       ipcg8_b_o_a =22
12028       ipcg9_b_o_a =23
12029       iopcg1_b_c_a =24
12030       iopcg2_b_c_a = 25
12031       iopcg3_b_c_a =26
12032       iopcg4_b_c_a =27
12033       iopcg5_b_c_a =28
12034       iopcg6_b_c_a =29
12035       iopcg7_b_c_a =30
12036       iopcg8_b_c_a =31
12037       iopcg1_b_o_a =32
12038       iopcg2_b_o_a = 33
12039       iopcg3_b_o_a =34
12040       iopcg4_b_o_a =35
12041       iopcg5_b_o_a =36
12042       iopcg6_b_o_a =37
12043       iopcg7_b_o_a =38
12044       iopcg8_b_o_a =39
12045       ipcg1_f_c_a =40
12046       ipcg2_f_c_a =41
12047       ipcg3_f_c_a =42
12048       ipcg4_f_c_a =43
12049       ipcg5_f_c_a =44
12050       ipcg6_f_c_a =45
12051       ipcg7_f_c_a =46
12052       ipcg8_f_c_a =47
12053       ipcg9_f_c_a =48
12054       ipcg1_f_o_a =49
12055       ipcg2_f_o_a =50
12056       ipcg3_f_o_a =51
12057       ipcg4_f_o_a =52
12058       ipcg5_f_o_a =53
12059       ipcg6_f_o_a =54
12060       ipcg7_f_o_a =55
12061       ipcg8_f_o_a =56
12062       ipcg9_f_o_a =57
12063       iopcg1_f_c_a =58
12064       iopcg2_f_c_a =59
12065       iopcg3_f_c_a =60
12066       iopcg4_f_c_a =61
12067       iopcg5_f_c_a =62
12068       iopcg6_f_c_a =63
12069       iopcg7_f_c_a =64
12070       iopcg8_f_c_a =65
12071       iopcg1_f_o_a =66
12072       iopcg2_f_o_a =67
12073       iopcg3_f_o_a =68
12074       iopcg4_f_o_a =69
12075       iopcg5_f_o_a =70
12076       iopcg6_f_o_a =71
12077       iopcg7_f_o_a =72
12078       iopcg8_f_o_a =73
12079       ismpa_a =74
12080       ismpbb_a =75
12081       iant1_c_a =76
12082       iant2_c_a =77
12083       iant3_c_a =78
12084       iant4_c_a =79
12085       iant1_o_a =80
12086       iant2_o_a =81
12087       iant3_o_a =82
12088       iant4_o_a =83
12089       ibiog1_c_a =84
12090       ibiog2_c_a =85
12091       ibiog3_c_a =86
12092       ibiog4_c_a =87
12093       ibiog1_o_a =88
12094       ibiog2_o_a =89
12095       ibiog3_o_a =90
12096       ibiog4_o_a =91
12097 ! for the "equilibrium" routine,
12098 ! i*_g and i*_a species have to have the same index...
12099 !      ico3_a    = 92    ! <-> ico2_g ! ico3_a was 14 earlier, changed to 82 by Manish Shrivastava
12100 !      ina_a     = 93
12101 !      ica_a     = 94
12102 !      ioin_a    = 95
12103 !      ioc_a     = 96
12104 !      ibc_a     = 97
12105       iasoaX_a=92
12106       iasoa1_a=93
12107       iasoa2_a=94
12108       iasoa3_a=95
12109       iasoa4_a=96
12110       ibsoaX_a=97
12111       ibsoa1_a=98
12112       ibsoa2_a=99
12113       ibsoa3_a=100
12114       ibsoa4_a=101
12115       iglysoa_r1_a = 102
12116       iglysoa_r2_a = 103
12117       iglysoa_sfc_a = 104
12118       iglysoa_nh4_a = 105
12119       iglysoa_oh_a = 106
12120
12121       ico3_a    = 107    ! <-> ico2_g ! ico3_a was 14 earlier, changed to 82 by Manish Shrivastava
12122       ina_a     = 108
12123       ica_a     = 109
12124       ioin_a    = 110
12125       ioc_a     = 111
12126       ibc_a     = 112
12127
12128 ! electrolyte indices (used for water content calculations)
12129 ! these indices are order sensitive
12130
12131       jnh4so4   =  1    ! soluble
12132       jlvcite   =  2    ! soluble
12133       jnh4hso4  =  3    ! soluble
12134       jnh4msa   =  4    ! soluble new
12135       jnh4no3   =  5    ! soluble
12136       jnh4cl    =  6    ! soluble
12137       jna2so4   =  7    ! soluble
12138       jna3hso4  =  8    ! soluble
12139       jnahso4   =  9    ! soluble
12140       jnamsa    = 10    ! soluble new
12141       jnano3    = 11    ! soluble
12142       jnacl     = 12    ! soluble
12143       jcano3    = 13    ! soluble
12144       jcacl2    = 14    ! soluble
12145       jcamsa2   = 15    ! soluble new     nsalt
12146       jh2so4    = 16    ! soluble
12147       jmsa      = 17    ! soluble new
12148       jhno3     = 18    ! soluble
12149       jhcl      = 19    ! soluble
12150       jhhso4    = 20    ! soluble
12151       jcaso4    = 21    ! insoluble
12152       jcaco3    = 22    ! insoluble
12153       joc       = 23    ! insoluble - part of naercomp
12154       jbc       = 24    ! insoluble - part of naercomp
12155       join      = 25    ! insoluble - part of naercomp
12156       jpcg1_b_c =26
12157       jpcg2_b_c =27
12158       jpcg3_b_c =28
12159       jpcg4_b_c =29
12160       jpcg5_b_c =30
12161       jpcg6_b_c =31
12162       jpcg7_b_c =32
12163       jpcg8_b_c =33
12164       jpcg9_b_c =34
12165       jpcg1_b_o =35
12166       jpcg2_b_o =36
12167       jpcg3_b_o =37
12168       jpcg4_b_o =38
12169       jpcg5_b_o =39
12170       jpcg6_b_o =40
12171       jpcg7_b_o =41
12172       jpcg8_b_o =42
12173       jpcg9_b_o =43
12174       jopcg1_b_c =44
12175       jopcg2_b_c =45
12176       jopcg3_b_c =46
12177       jopcg4_b_c =47
12178       jopcg5_b_c =48
12179       jopcg6_b_c =49
12180       jopcg7_b_c =50
12181       jopcg8_b_c =51
12182       jopcg1_b_o =52
12183       jopcg2_b_o =53
12184       jopcg3_b_o =54
12185       jopcg4_b_o =55
12186       jopcg5_b_o =56
12187       jopcg6_b_o =57
12188       jopcg7_b_o =58
12189       jopcg8_b_o =59
12190       jpcg1_f_c =60
12191       jpcg2_f_c =61
12192       jpcg3_f_c =62
12193       jpcg4_f_c =63
12194       jpcg5_f_c =64
12195       jpcg6_f_c =65
12196       jpcg7_f_c =66
12197       jpcg8_f_c =67
12198       jpcg9_f_c =68
12199       jpcg1_f_o =69
12200       jpcg2_f_o =70
12201       jpcg3_f_o =71
12202       jpcg4_f_o =72
12203       jpcg5_f_o =73
12204       jpcg6_f_o =74
12205       jpcg7_f_o =75
12206       jpcg8_f_o =76
12207       jpcg9_f_o =77
12208       jopcg1_f_c =78
12209       jopcg2_f_c =79
12210       jopcg3_f_c =80
12211       jopcg4_f_c =81
12212       jopcg5_f_c =82
12213       jopcg6_f_c =83
12214       jopcg7_f_c =84
12215       jopcg8_f_c =85
12216       jopcg1_f_o =86
12217       jopcg2_f_o =87
12218       jopcg3_f_o =88
12219       jopcg4_f_o =89
12220       jopcg5_f_o =90
12221       jopcg6_f_o =91
12222       jopcg7_f_o =92
12223       jopcg8_f_o =93
12224       jsmpa =94
12225       jsmpbb =95
12226       jant1_c =96
12227       jant2_c =97
12228       jant3_c =98
12229       jant4_c =99
12230       jant1_o =100
12231       jant2_o =101
12232       jant3_o =102
12233       jant4_o =103
12234       jbiog1_c =104
12235       jbiog2_c =105
12236       jbiog3_c =106
12237       jbiog4_c =107
12238       jbiog1_o =108
12239       jbiog2_o =109
12240       jbiog3_o =110
12241       jbiog4_o =111
12242 !      jh2o     = 112   ! water - part of naercomp
12243       jasoaX=112
12244       jasoa1=113
12245       jasoa2=114
12246       jasoa3=115
12247       jasoa4=116
12248       jbsoaX=117
12249       jbsoa1=118
12250       jbsoa2=119
12251       jbsoa3=120
12252       jbsoa4=121
12253       jglysoa_r1  = 122
12254       jglysoa_r2  = 123
12255       jglysoa_sfc = 124
12256       jglysoa_nh4 = 125
12257       jglysoa_oh  = 126
12258       jh2o  = 127 ! water - part of naercomp
12259
12260 ! local aerosol ions
12261 ! cations
12262       jc_h      =  1
12263       jc_nh4    =  2
12264       jc_na     =  3
12265       jc_ca     =  4
12266 !
12267 ! anions
12268       ja_hso4   =  1
12269       ja_so4    =  2
12270       ja_no3    =  3
12271       ja_cl     =  4
12272       ja_msa    =  5
12273 !     ja_co3    =  6
12274
12275 !--------------------------------------------------------------------
12276 ! phase state names
12277 !      phasestate(no_aerosol) = "NOAERO"
12278 !      phasestate(all_solid)  = "SOLID "
12279 !      phasestate(all_liquid) = "LIQUID"
12280 !      phasestate(mixed)      = "MIXED "
12281
12282 ! names of aer species
12283       aer_name(iso4_a) = 'so4'
12284       aer_name(ino3_a) = 'no3'
12285       aer_name(icl_a)  = 'cl '
12286       aer_name(inh4_a) = 'nh4'
12287       aer_name(ioc_a)  = 'oc '
12288       aer_name(imsa_a) = 'msa'
12289       aer_name(ico3_a) = 'co3'
12290       aer_name(ina_a)  = 'na '
12291       aer_name(ica_a)  = 'ca '
12292       aer_name(ibc_a)  = 'bc '
12293       aer_name(ioin_a) = 'oin'
12294       aer_name(ipcg1_b_c_a)="pcg1_b_c"
12295       aer_name(ipcg2_b_c_a)="pcg2_b_c"
12296       aer_name(ipcg3_b_c_a)="pcg3_b_c"
12297       aer_name(ipcg4_b_c_a)="pcg4_b_c"
12298       aer_name(ipcg5_b_c_a)="pcg5_b_c"
12299       aer_name(ipcg6_b_c_a)="pcg6_b_c"
12300       aer_name(ipcg7_b_c_a)="pcg7_b_c"
12301       aer_name(ipcg8_b_c_a)="pcg8_b_c"
12302       aer_name(ipcg9_b_c_a)="pcg9_b_c"
12303       aer_name(iopcg1_b_c_a)="opcg1_b_c"
12304       aer_name(iopcg2_b_c_a)="opcg2_b_c"
12305       aer_name(iopcg3_b_c_a)="opcg3_b_c"
12306       aer_name(iopcg4_b_c_a)="opcg4_b_c"
12307       aer_name(iopcg5_b_c_a)="opcg5_b_c"
12308       aer_name(iopcg6_b_c_a)="opcg6_b_c"
12309       aer_name(iopcg7_b_c_a)="opcg7_b_c"
12310       aer_name(iopcg8_b_c_a)="opcg8_b_c"
12311       aer_name(ipcg1_b_o_a)="pcg1_b_o"
12312       aer_name(ipcg2_b_o_a)="pcg2_b_o"
12313       aer_name(ipcg3_b_o_a)="pcg3_b_o"
12314       aer_name(ipcg4_b_o_a)="pcg4_b_o"
12315       aer_name(ipcg5_b_o_a)="pcg5_b_o"
12316       aer_name(ipcg6_b_o_a)="pcg6_b_o"
12317       aer_name(ipcg7_b_o_a)="pcg7_b_o"
12318       aer_name(ipcg8_b_o_a)="pcg8_b_o"
12319       aer_name(ipcg9_b_o_a)="pcg9_b_o"
12320       aer_name(iopcg1_b_o_a)="opcg1_b_o"
12321       aer_name(iopcg2_b_o_a)="opcg2_b_o"
12322       aer_name(iopcg3_b_o_a)="opcg3_b_o"
12323       aer_name(iopcg4_b_o_a)="opcg4_b_o"
12324       aer_name(iopcg5_b_o_a)="opcg5_b_o"
12325       aer_name(iopcg6_b_o_a)="opcg6_b_o"
12326       aer_name(iopcg7_b_o_a)="opcg7_b_o"
12327       aer_name(iopcg8_b_o_a)="opcg8_b_o"
12328       aer_name(ipcg1_f_c_a)="pcg1_f_c"
12329       aer_name(ipcg2_f_c_a)="pcg2_f_c"
12330       aer_name(ipcg3_f_c_a)="pcg3_f_c"
12331       aer_name(ipcg4_f_c_a)="pcg4_f_c"
12332       aer_name(ipcg5_f_c_a)="pcg5_f_c"
12333       aer_name(ipcg6_f_c_a)="pcg6_f_c"
12334       aer_name(ipcg7_f_c_a)="pcg7_f_c"
12335       aer_name(ipcg8_f_c_a)="pcg8_f_c"
12336       aer_name(ipcg9_f_c_a)="pcg9_f_c"
12337       aer_name(iopcg1_f_c_a)="opcg1_f_c"
12338       aer_name(iopcg2_f_c_a)="opcg2_f_c"
12339       aer_name(iopcg3_f_c_a)="opcg3_f_c"
12340       aer_name(iopcg4_f_c_a)="opcg4_f_c"
12341       aer_name(iopcg5_f_c_a)="opcg5_f_c"
12342       aer_name(iopcg6_f_c_a)="opcg6_f_c"
12343       aer_name(iopcg7_f_c_a)="opcg7_f_c"
12344       aer_name(iopcg8_f_c_a)="opcg8_f_c"
12345       aer_name(ipcg1_f_o_a)="pcg1_f_o"
12346       aer_name(ipcg2_f_o_a)="pcg2_f_o"
12347       aer_name(ipcg3_f_o_a)="pcg3_f_o"
12348       aer_name(ipcg4_f_o_a)="pcg4_f_o"
12349       aer_name(ipcg5_f_o_a)="pcg5_f_o"
12350       aer_name(ipcg6_f_o_a)="pcg6_f_o"
12351       aer_name(ipcg7_f_o_a)="pcg7_f_o"
12352       aer_name(ipcg8_f_o_a)="pcg8_f_o"
12353       aer_name(ipcg9_f_o_a)="pcg9_f_o"
12354       aer_name(iopcg1_f_o_a)="opcg1_f_o"
12355       aer_name(iopcg2_f_o_a)="opcg2_f_o"
12356       aer_name(iopcg3_f_o_a)="opcg3_f_o"
12357       aer_name(iopcg4_f_o_a)="opcg4_f_o"
12358       aer_name(iopcg5_f_o_a)="opcg5_f_o"
12359       aer_name(iopcg6_f_o_a)="opcg6_f_o"
12360       aer_name(iopcg7_f_o_a)="opcg7_f_o"
12361       aer_name(iopcg8_f_o_a)="opcg8_f_o"
12362       aer_name(ismpa_a)="smpa"
12363       aer_name(ismpbb_a)="smpbb"
12364       aer_name(iglysoa_r1_a)="glysoa_r1"
12365       aer_name(iglysoa_r2_a)="glysoa_r2"
12366       aer_name(iglysoa_sfc_a)="glysoa_sfc"
12367       aer_name(iglysoa_nh4_a)="glysoa_nh4"
12368       aer_name(iglysoa_oh_a)="glysoa_oh"
12369       aer_name(iant1_c_a)="ant1_c"
12370       aer_name(iant2_c_a)="ant2_c"
12371       aer_name(iant3_c_a)="ant3_c"
12372       aer_name(iant4_c_a)="ant4_c"
12373       aer_name(iant1_o_a)="ant1_o"
12374       aer_name(iant2_o_a)="ant2_o"
12375       aer_name(iant3_o_a)="ant3_o"
12376       aer_name(iant4_o_a)="ant4_o"
12377       aer_name(ibiog1_c_a)="biog1_c"
12378       aer_name(ibiog2_c_a)="biog2_c"
12379       aer_name(ibiog3_c_a)="biog3_c"
12380       aer_name(ibiog4_c_a)="biog4_c"
12381       aer_name(ibiog1_o_a)="biog1_o"
12382       aer_name(ibiog2_o_a)="biog2_o"
12383       aer_name(ibiog3_o_a)="biog3_o"
12384       aer_name(ibiog4_o_a)="biog4_o"
12385       aer_name(iasoaX_a)="asoaX"
12386       aer_name(iasoa1_a)="asoa1"
12387       aer_name(iasoa2_a)="asoa2"
12388       aer_name(iasoa3_a)="asoa3"
12389       aer_name(iasoa4_a)="asoa4"
12390       aer_name(ibsoaX_a)="bsoaX"
12391       aer_name(ibsoa1_a)="bsoa1"
12392       aer_name(ibsoa2_a)="bsoa2"
12393       aer_name(ibsoa3_a)="bsoa3"
12394       aer_name(ibsoa4_a)="bsoa4"
12395
12396 ! names of gas species
12397       gas_name(ih2so4_g) = 'h2so4'
12398       gas_name(ihno3_g)  = 'hno3 '
12399       gas_name(ihcl_g)   = 'hcl  '
12400       gas_name(inh3_g)   = 'nh3  '
12401       gas_name(imsa_g)   = "msa  "
12402       gas_name(ipcg1_b_c_g)="pcg1_b_c"
12403       gas_name(ipcg2_b_c_g)="pcg2_b_c"
12404       gas_name(ipcg3_b_c_g)="pcg3_b_c"
12405       gas_name(ipcg4_b_c_g)="pcg4_b_c"
12406       gas_name(ipcg5_b_c_g)="pcg5_b_c"
12407       gas_name(ipcg6_b_c_g)="pcg6_b_c"
12408       gas_name(ipcg7_b_c_g)="pcg7_b_c"
12409       gas_name(ipcg8_b_c_g)="pcg8_b_c"
12410       gas_name(ipcg9_b_c_g)="pcg9_b_c"
12411       gas_name(iopcg1_b_c_g)="opcg1_b_c"
12412       gas_name(iopcg2_b_c_g)="opcg2_b_c"
12413       gas_name(iopcg3_b_c_g)="opcg3_b_c"
12414       gas_name(iopcg4_b_c_g)="opcg4_b_c"
12415       gas_name(iopcg5_b_c_g)="opcg5_b_c"
12416       gas_name(iopcg6_b_c_g)="opcg6_b_c"
12417       gas_name(iopcg7_b_c_g)="opcg7_b_c"
12418       gas_name(iopcg8_b_c_g)="opcg8_b_c"
12419       gas_name(ipcg1_b_o_g)="pcg1_b_o"
12420       gas_name(ipcg2_b_o_g)="pcg2_b_o"
12421       gas_name(ipcg3_b_o_g)="pcg3_b_o"
12422       gas_name(ipcg4_b_o_g)="pcg4_b_o"
12423       gas_name(ipcg5_b_o_g)="pcg5_b_o"
12424       gas_name(ipcg6_b_o_g)="pcg6_b_o"
12425       gas_name(ipcg7_b_o_g)="pcg7_b_o"
12426       gas_name(ipcg8_b_o_g)="pcg8_b_o"
12427       gas_name(ipcg9_b_o_g)="pcg9_b_o"
12428       gas_name(iopcg1_b_o_g)="opcg1_b_o"
12429       gas_name(iopcg2_b_o_g)="opcg2_b_o"
12430       gas_name(iopcg3_b_o_g)="opcg3_b_o"
12431       gas_name(iopcg4_b_o_g)="opcg4_b_o"
12432       gas_name(iopcg5_b_o_g)="opcg5_b_o"
12433       gas_name(iopcg6_b_o_g)="opcg6_b_o"
12434       gas_name(iopcg7_b_o_g)="opcg7_b_o"
12435       gas_name(iopcg8_b_o_g)="opcg8_b_o"
12436       gas_name(ipcg1_f_c_g)="pcg1_f_c"
12437       gas_name(ipcg2_f_c_g)="pcg2_f_c"
12438       gas_name(ipcg3_f_c_g)="pcg3_f_c"
12439       gas_name(ipcg4_f_c_g)="pcg4_f_c"
12440       gas_name(ipcg5_f_c_g)="pcg5_f_c"
12441       gas_name(ipcg6_f_c_g)="pcg6_f_c"
12442       gas_name(ipcg7_f_c_g)="pcg7_f_c"
12443       gas_name(ipcg8_f_c_g)="pcg8_f_c"
12444       gas_name(ipcg9_f_c_g)="pcg9_f_c"
12445       gas_name(iopcg1_f_c_g)="opcg1_f_c"
12446       gas_name(iopcg2_f_c_g)="opcg2_f_c"
12447       gas_name(iopcg3_f_c_g)="opcg3_f_c"
12448       gas_name(iopcg4_f_c_g)="opcg4_f_c"
12449       gas_name(iopcg5_f_c_g)="opcg5_f_c"
12450       gas_name(iopcg6_f_c_g)="opcg6_f_c"
12451       gas_name(iopcg7_f_c_g)="opcg7_f_c"
12452       gas_name(iopcg8_f_c_g)="opcg8_f_c"
12453       gas_name(ipcg1_f_o_g)="pcg1_f_o"
12454       gas_name(ipcg2_f_o_g)="pcg2_f_o"
12455       gas_name(ipcg3_f_o_g)="pcg3_f_o"
12456       gas_name(ipcg4_f_o_g)="pcg4_f_o"
12457       gas_name(ipcg5_f_o_g)="pcg5_f_o"
12458       gas_name(ipcg6_f_o_g)="pcg6_f_o"
12459       gas_name(ipcg7_f_o_g)="pcg7_f_o"
12460       gas_name(ipcg8_f_o_g)="pcg8_f_o"
12461       gas_name(ipcg9_f_o_g)="pcg9_f_o"
12462       gas_name(iopcg1_f_o_g)="opcg1_f_o"
12463       gas_name(iopcg2_f_o_g)="opcg2_f_o"
12464       gas_name(iopcg3_f_o_g)="opcg3_f_o"
12465       gas_name(iopcg4_f_o_g)="opcg4_f_o"
12466       gas_name(iopcg5_f_o_g)="opcg5_f_o"
12467       gas_name(iopcg6_f_o_g)="opcg6_f_o"
12468       gas_name(iopcg7_f_o_g)="opcg7_f_o"
12469       gas_name(iopcg8_f_o_g)="opcg8_f_o"
12470       gas_name(ismpa_g)="smpa"
12471       gas_name(ismpbb_g)="smpbb"
12472       gas_name(iant1_c_g)="ant1_c"
12473       gas_name(iant2_c_g)="ant2_c"
12474       gas_name(iant3_c_g)="ant3_c"
12475       gas_name(iant4_c_g)="ant4_c"
12476       gas_name(iant1_o_g)="ant1_o"
12477       gas_name(iant2_o_g)="ant2_o"
12478       gas_name(iant3_o_g)="ant3_o"
12479       gas_name(iant4_o_g)="ant4_o"
12480       gas_name(ibiog1_c_g)="biog1_c"
12481       gas_name(ibiog2_c_g)="biog2_c"
12482       gas_name(ibiog3_c_g)="biog3_c"
12483       gas_name(ibiog4_c_g)="biog4_c"
12484       gas_name(ibiog1_o_g)="biog1_o"
12485       gas_name(ibiog2_o_g)="biog2_o"
12486       gas_name(ibiog3_o_g)="biog3_o"
12487       gas_name(ibiog4_o_g)="biog4_o"
12488       gas_name(in2o5_g) = "n2o5 "
12489       gas_name(iclno2_g)= "clno2"
12490       gas_name(iasoaX_g)="asoaX"
12491       gas_name(iasoa1_g)="asoa1"
12492       gas_name(iasoa2_g)="asoa2"
12493       gas_name(iasoa3_g)="asoa3"
12494       gas_name(iasoa4_g)="asoa4"
12495       gas_name(ibsoaX_g)="bsoaX"
12496       gas_name(ibsoa1_g)="bsoa1"
12497       gas_name(ibsoa2_g)="bsoa2"
12498       gas_name(ibsoa3_g)="bsoa3"
12499       gas_name(ibsoa4_g)="bsoa4"
12500       gas_name(igly)="gly"
12501       gas_name(iho)="ho"
12502
12503 ! names of electrolytes
12504       ename(jnh4so4) = 'amso4'
12505       ename(jlvcite) = '(nh4)3h(so4)2'
12506       ename(jnh4hso4)= 'nh4hso4'
12507       ename(jnh4msa) = "ch3so3nh4"
12508       ename(jnh4no3) = 'nh4no3'
12509       ename(jnh4cl)  = 'nh4cl'
12510       ename(jnacl)   = 'nacl'
12511       ename(jnano3)  = 'nano3'
12512       ename(jna2so4) = 'na2so4'
12513       ename(jna3hso4)= 'na3h(so4)2'
12514       ename(jnamsa)  = "ch3so3na"
12515       ename(jnahso4) = 'nahso4'
12516       ename(jcaso4)  = 'caso4'
12517       ename(jcamsa2) = "(ch3so3)2ca"
12518       ename(jcano3)  = 'ca(no3)2'
12519       ename(jcacl2)  = 'cacl2'
12520       ename(jcaco3)  = 'caco3'
12521       ename(jh2so4)  = 'h2so4'
12522       ename(jhhso4)  = 'hhso4'
12523       ename(jhno3)   = 'hno3'
12524       ename(jhcl)    = 'hcl'
12525       ename(jmsa)    = "ch3so3h"
12526
12527 ! molecular weights of electrolytes
12528       mw_electrolyte(jnh4so4) = 132.0
12529       mw_electrolyte(jlvcite) = 247.0
12530       mw_electrolyte(jnh4hso4)= 115.0
12531       mw_electrolyte(jnh4msa) = 113.0
12532       mw_electrolyte(jnh4no3) = 80.0
12533       mw_electrolyte(jnh4cl)  = 53.5
12534       mw_electrolyte(jnacl)   = 58.5
12535       mw_electrolyte(jnano3)  = 85.0
12536       mw_electrolyte(jna2so4) = 142.0
12537       mw_electrolyte(jna3hso4)= 262.0
12538       mw_electrolyte(jnahso4) = 120.0
12539       mw_electrolyte(jnamsa)  = 118.0
12540       mw_electrolyte(jcaso4)  = 136.0
12541       mw_electrolyte(jcamsa2) = 230.0
12542       mw_electrolyte(jcano3)  = 164.0
12543       mw_electrolyte(jcacl2)  = 111.0
12544       mw_electrolyte(jcaco3)  = 100.0
12545       mw_electrolyte(jh2so4)  = 98.0
12546       mw_electrolyte(jhno3)   = 63.0
12547       mw_electrolyte(jhcl)    = 36.5
12548       mw_electrolyte(jmsa)    = 96.0
12549
12550
12551 ! molecular weights of ions [g/mol]
12552       mw_c(jc_h)  =  1.0
12553       mw_c(jc_nh4)= 18.0
12554       mw_c(jc_na) = 23.0
12555       mw_c(jc_ca) = 40.0
12556
12557       mw_a(ja_so4) = 96.0
12558       mw_a(ja_hso4)= 97.0
12559       mw_a(ja_no3) = 62.0
12560       mw_a(ja_cl)  = 35.5
12561       MW_a(ja_msa) = 95.0
12562
12563
12564 ! magnitude of the charges on ions
12565       zc(jc_h)   = 1
12566       zc(jc_nh4) = 1
12567       zc(jc_na)  = 1
12568       zc(jc_ca)  = 2
12569
12570       za(ja_hso4)= 1
12571       za(ja_so4) = 2
12572       za(ja_no3) = 1
12573       za(ja_cl)  = 1
12574       za(ja_msa) = 1
12575
12576
12577 ! densities of pure electrolytes in g/cc
12578       dens_electrolyte(jnh4so4)  = 1.8
12579       dens_electrolyte(jlvcite)  = 1.8
12580       dens_electrolyte(jnh4hso4) = 1.8
12581       dens_electrolyte(jnh4msa)  = 1.8 ! assumed same as nh4hso4
12582       dens_electrolyte(jnh4no3)  = 1.8
12583       dens_electrolyte(jnh4cl)   = 1.8
12584       dens_electrolyte(jnacl)    = 2.2
12585       dens_electrolyte(jnano3)   = 2.2
12586       dens_electrolyte(jna2so4)  = 2.2
12587       dens_electrolyte(jna3hso4) = 2.2
12588       dens_electrolyte(jnahso4)  = 2.2
12589       dens_electrolyte(jnamsa)   = 2.2 ! assumed same as nahso4
12590       dens_electrolyte(jcaso4)   = 2.6
12591       dens_electrolyte(jcamsa2)  = 2.6  ! assumed same as caso4
12592       dens_electrolyte(jcano3)   = 2.6
12593       dens_electrolyte(jcacl2)   = 2.6
12594       dens_electrolyte(jcaco3)   = 2.6
12595       dens_electrolyte(jh2so4)   = 1.8
12596       dens_electrolyte(jhhso4)   = 1.8
12597       dens_electrolyte(jhno3)    = 1.8
12598       dens_electrolyte(jhcl)     = 1.8
12599       dens_electrolyte(jmsa)     = 1.8 ! assumed same as h2so4
12600
12601
12602 ! densities of compounds in g/cc
12603       dens_comp_a(jnh4so4)  = 1.8
12604       dens_comp_a(jlvcite)  = 1.8
12605       dens_comp_a(jnh4hso4) = 1.8
12606       dens_comp_a(jnh4msa)  = 1.8       ! assumed same as nh4hso4
12607       dens_comp_a(jnh4no3)  = 1.7
12608       dens_comp_a(jnh4cl)   = 1.5
12609       dens_comp_a(jnacl)    = 2.2
12610       dens_comp_a(jnano3)   = 2.2
12611       dens_comp_a(jna2so4)  = 2.2
12612       dens_comp_a(jna3hso4) = 2.2
12613       dens_comp_a(jnahso4)  = 2.2
12614       dens_comp_a(jnamsa)   = 2.2       ! assumed same as nahso4
12615       dens_comp_a(jcaso4)   = 2.6
12616       dens_comp_a(jcamsa2)  = 2.6       ! assumed same as caso4
12617       dens_comp_a(jcano3)   = 2.6
12618       dens_comp_a(jcacl2)   = 2.6
12619       dens_comp_a(jcaco3)   = 2.6
12620       dens_comp_a(jh2so4)   = 1.8
12621       dens_comp_a(jhhso4)   = 1.8
12622       dens_comp_a(jhno3)    = 1.8
12623       dens_comp_a(jhcl)     = 1.8
12624       dens_comp_a(jmsa)     = 1.8       ! assumed same as h2so4
12625       dens_comp_a(joc)      = 1.0
12626       dens_comp_a(jbc)      = 1.8
12627       dens_comp_a(join)     = 2.6
12628       dens_comp_a(jh2o)     = 1.0
12629       dens_comp_a(ipcg1_b_c_a) =1.0
12630       dens_comp_a(ipcg2_b_c_a) =1.0
12631       dens_comp_a(ipcg3_b_c_a)=1.0
12632       dens_comp_a(ipcg4_b_c_a)=1.0
12633       dens_comp_a(ipcg5_b_c_a)=1.0
12634       dens_comp_a(ipcg6_b_c_a)=1.0
12635       dens_comp_a(ipcg7_b_c_a)=1.0
12636       dens_comp_a(ipcg8_b_c_a)=1.0
12637       dens_comp_a(ipcg9_b_c_a)=1.0
12638       dens_comp_a(iopcg1_b_c_a)=1.0
12639       dens_comp_a(iopcg2_b_c_a)=1.0
12640       dens_comp_a(iopcg3_b_c_a)=1.0
12641       dens_comp_a(iopcg4_b_c_a)=1.0
12642       dens_comp_a(iopcg5_b_c_a)=1.0
12643       dens_comp_a(iopcg6_b_c_a)=1.0
12644       dens_comp_a(iopcg7_b_c_a)=1.0
12645       dens_comp_a(iopcg8_b_c_a)=1.0
12646       dens_comp_a(ipcg1_b_o_a)=1.0
12647       dens_comp_a(ipcg2_b_o_a)=1.0
12648       dens_comp_a(ipcg3_b_o_a)=1.0
12649       dens_comp_a(ipcg4_b_o_a)=1.0
12650       dens_comp_a(ipcg5_b_o_a)=1.0
12651       dens_comp_a(ipcg6_b_o_a)=1.0
12652       dens_comp_a(ipcg7_b_o_a)=1.0
12653       dens_comp_a(ipcg8_b_o_a)=1.0
12654       dens_comp_a(ipcg9_b_o_a)=1.0
12655       dens_comp_a(iopcg1_b_o_a)=1.0
12656       dens_comp_a(iopcg2_b_o_a)=1.0
12657       dens_comp_a(iopcg3_b_o_a)=1.0
12658       dens_comp_a(iopcg4_b_o_a)=1.0
12659       dens_comp_a(iopcg5_b_o_a)=1.0
12660       dens_comp_a(iopcg6_b_o_a)=1.0
12661       dens_comp_a(iopcg7_b_o_a)=1.0
12662       dens_comp_a(iopcg8_b_o_a)=1.0
12663       dens_comp_a(ipcg1_f_c_a) =1.0
12664       dens_comp_a(ipcg2_f_c_a) =1.0
12665       dens_comp_a(ipcg3_f_c_a)=1.0
12666       dens_comp_a(ipcg4_f_c_a)=1.0
12667       dens_comp_a(ipcg5_f_c_a)=1.0
12668       dens_comp_a(ipcg6_f_c_a)=1.0
12669       dens_comp_a(ipcg7_f_c_a)=1.0
12670       dens_comp_a(ipcg8_f_c_a)=1.0
12671       dens_comp_a(ipcg9_f_c_a)=1.0
12672       dens_comp_a(iopcg1_f_c_a)=1.0
12673       dens_comp_a(iopcg2_f_c_a)=1.0
12674       dens_comp_a(iopcg3_f_c_a)=1.0
12675       dens_comp_a(iopcg4_f_c_a)=1.0
12676       dens_comp_a(iopcg5_f_c_a)=1.0
12677       dens_comp_a(iopcg6_f_c_a)=1.0
12678       dens_comp_a(iopcg7_f_c_a)=1.0
12679       dens_comp_a(iopcg8_f_c_a)=1.0
12680       dens_comp_a(ipcg1_f_o_a)=1.0
12681       dens_comp_a(ipcg2_f_o_a)=1.0
12682       dens_comp_a(ipcg3_f_o_a)=1.0
12683       dens_comp_a(ipcg4_f_o_a)=1.0
12684       dens_comp_a(ipcg5_f_o_a)=1.0
12685       dens_comp_a(ipcg6_f_o_a)=1.0
12686       dens_comp_a(ipcg7_f_o_a)=1.0
12687       dens_comp_a(ipcg8_f_o_a)=1.0
12688       dens_comp_a(ipcg9_f_o_a)=1.0
12689       dens_comp_a(iopcg1_f_o_a)=1.0
12690       dens_comp_a(iopcg2_f_o_a)=1.0
12691       dens_comp_a(iopcg3_f_o_a)=1.0
12692       dens_comp_a(iopcg4_f_o_a)=1.0
12693       dens_comp_a(iopcg5_f_o_a)=1.0
12694       dens_comp_a(iopcg6_f_o_a)=1.0
12695       dens_comp_a(iopcg7_f_o_a)=1.0
12696       dens_comp_a(iopcg8_f_o_a)=1.0
12697       dens_comp_a(ismpa_a)=1.0
12698       dens_comp_a(ismpbb_a)=1.0
12699       dens_comp_a(iglysoa_r1_a)=1.0
12700       dens_comp_a(iglysoa_r2_a)=1.0
12701       dens_comp_a(iglysoa_sfc_a)=1.0
12702       dens_comp_a(iglysoa_nh4_a)=1.0
12703       dens_comp_a(iglysoa_oh_a)=1.0
12704       dens_comp_a(iant1_c_a)=1.0
12705       dens_comp_a(iant2_c_a)=1.0
12706       dens_comp_a(iant3_c_a)=1.0
12707       dens_comp_a(iant4_c_a)=1.0
12708       dens_comp_a(iant1_o_a)=1.0
12709       dens_comp_a(iant2_o_a)=1.0
12710       dens_comp_a(iant3_o_a)=1.0
12711       dens_comp_a(iant4_o_a)=1.0
12712       dens_comp_a(ibiog1_c_a)=1.0
12713       dens_comp_a(ibiog2_c_a)=1.0
12714       dens_comp_a(ibiog3_c_a)=1.0
12715       dens_comp_a(ibiog4_c_a)=1.0
12716       dens_comp_a(ibiog1_o_a)=1.0
12717       dens_comp_a(ibiog2_o_a)=1.0
12718       dens_comp_a(ibiog3_o_a)=1.0
12719       dens_comp_a(ibiog4_o_a)=1.0
12720       dens_comp_a(iasoaX_a)=1.5
12721       dens_comp_a(iasoa1_a)=1.5
12722       dens_comp_a(iasoa2_a)=1.5
12723       dens_comp_a(iasoa3_a)=1.5
12724       dens_comp_a(iasoa4_a)=1.5
12725       dens_comp_a(ibsoaX_a)=1.5
12726       dens_comp_a(ibsoa1_a)=1.5
12727       dens_comp_a(ibsoa2_a)=1.5
12728       dens_comp_a(ibsoa3_a)=1.5
12729       dens_comp_a(ibsoa4_a)=1.5
12730
12731 ! molecular weights of generic aerosol species
12732       mw_aer_mac(iso4_a) = 96.0
12733       mw_aer_mac(ino3_a) = 62.0
12734       mw_aer_mac(icl_a)  = 35.5
12735       mw_aer_mac(imsa_a) = 95.0 ! ch3so3
12736       mw_aer_mac(ico3_a) = 60.0
12737       mw_aer_mac(inh4_a) = 18.0
12738       mw_aer_mac(ina_a)  = 23.0
12739       mw_aer_mac(ica_a)  = 40.0
12740       mw_aer_mac(ioin_a) = 1.0          ! not used
12741       mw_aer_mac(ibc_a)  = 1.0          ! not used
12742       mw_aer_mac(ioc_a)  = 250.0  ! 200 assumed for primary organics
12743       mw_aer_mac(ipcg1_b_c_a) =250.0
12744       mw_aer_mac(ipcg2_b_c_a) =250.0
12745       mw_aer_mac(ipcg3_b_c_a)=250.0
12746       mw_aer_mac(ipcg4_b_c_a)=250.0
12747       mw_aer_mac(ipcg5_b_c_a)=250.0
12748       mw_aer_mac(ipcg6_b_c_a)=250.0
12749       mw_aer_mac(ipcg7_b_c_a)=250.0
12750       mw_aer_mac(ipcg8_b_c_a)=250.0
12751       mw_aer_mac(ipcg9_b_c_a)=250.0
12752       mw_aer_mac(iopcg1_b_c_a)=250.0
12753       mw_aer_mac(iopcg2_b_c_a)=250.0
12754       mw_aer_mac(iopcg3_b_c_a)=250.0
12755       mw_aer_mac(iopcg4_b_c_a)=250.0
12756       mw_aer_mac(iopcg5_b_c_a)=250.0
12757       mw_aer_mac(iopcg6_b_c_a)=250.0
12758       mw_aer_mac(iopcg7_b_c_a)=250.0
12759       mw_aer_mac(iopcg8_b_c_a)=250.0
12760       mw_aer_mac(ipcg1_b_o_a)=250.0
12761       mw_aer_mac(ipcg2_b_o_a)=250.0
12762       mw_aer_mac(ipcg3_b_o_a)=250.0
12763       mw_aer_mac(ipcg4_b_o_a)=250.0
12764       mw_aer_mac(ipcg5_b_o_a)=250.0
12765       mw_aer_mac(ipcg6_b_o_a)=250.0
12766       mw_aer_mac(ipcg7_b_o_a)=250.0
12767       mw_aer_mac(ipcg8_b_o_a)=250.0
12768       mw_aer_mac(ipcg9_b_o_a)=250.0
12769       mw_aer_mac(iopcg1_b_o_a)=250.0
12770       mw_aer_mac(iopcg2_b_o_a)=250.0
12771       mw_aer_mac(iopcg3_b_o_a)=250.0
12772       mw_aer_mac(iopcg4_b_o_a)=250.0
12773       mw_aer_mac(iopcg5_b_o_a)=250.0
12774       mw_aer_mac(iopcg6_b_o_a)=250.0
12775       mw_aer_mac(iopcg7_b_o_a)=250.0
12776       mw_aer_mac(iopcg8_b_o_a)=250.0
12777       mw_aer_mac(ipcg1_f_c_a) =250.0
12778       mw_aer_mac(ipcg2_f_c_a) =250.0
12779       mw_aer_mac(ipcg3_f_c_a)=250.0
12780       mw_aer_mac(ipcg4_f_c_a)=250.0
12781       mw_aer_mac(ipcg5_f_c_a)=250.0
12782       mw_aer_mac(ipcg6_f_c_a)=250.0
12783       mw_aer_mac(ipcg7_f_c_a)=250.0
12784       mw_aer_mac(ipcg8_f_c_a)=250.0
12785       mw_aer_mac(ipcg9_f_c_a)=250.0
12786       mw_aer_mac(iopcg1_f_c_a)=250.0
12787       mw_aer_mac(iopcg2_f_c_a)=250.0
12788       mw_aer_mac(iopcg3_f_c_a)=250.0
12789       mw_aer_mac(iopcg4_f_c_a)=250.0
12790       mw_aer_mac(iopcg5_f_c_a)=250.0
12791       mw_aer_mac(iopcg6_f_c_a)=250.0
12792       mw_aer_mac(iopcg7_f_c_a)=250.0
12793       mw_aer_mac(iopcg8_f_c_a)=250.0
12794       mw_aer_mac(ipcg1_f_o_a)=250.0
12795       mw_aer_mac(ipcg2_f_o_a)=250.0
12796       mw_aer_mac(ipcg3_f_o_a)=250.0
12797       mw_aer_mac(ipcg4_f_o_a)=250.0
12798       mw_aer_mac(ipcg5_f_o_a)=250.0
12799       mw_aer_mac(ipcg6_f_o_a)=250.0
12800       mw_aer_mac(ipcg7_f_o_a)=250.0
12801       mw_aer_mac(ipcg8_f_o_a)=250.0
12802       mw_aer_mac(ipcg9_f_o_a)=250.0
12803       mw_aer_mac(iopcg1_f_o_a)=250.0
12804       mw_aer_mac(iopcg2_f_o_a)=250.0
12805       mw_aer_mac(iopcg3_f_o_a)=250.0
12806       mw_aer_mac(iopcg4_f_o_a)=250.0
12807       mw_aer_mac(iopcg5_f_o_a)=250.0
12808       mw_aer_mac(iopcg6_f_o_a)=250.0
12809       mw_aer_mac(iopcg7_f_o_a)=250.0
12810       mw_aer_mac(iopcg8_f_o_a)=250.0
12811       mw_aer_mac(ismpa_a) = 250.0
12812       mw_aer_mac(ismpbb_a) = 250.0
12813       mw_aer_mac(iglysoa_r1_a) = 250.0
12814       mw_aer_mac(iglysoa_r2_a) = 250.0
12815       mw_aer_mac(iglysoa_sfc_a) = 250.0
12816       mw_aer_mac(iglysoa_nh4_a) = 250.0
12817       mw_aer_mac(iglysoa_oh_a) = 250.0
12818       mw_aer_mac(iant1_c_a) = 250.0
12819       mw_aer_mac(iant2_c_a) = 250.0
12820       mw_aer_mac(iant3_c_a) = 250.0
12821       mw_aer_mac(iant4_c_a) = 250.0
12822       mw_aer_mac(iant1_o_a) = 250.0
12823       mw_aer_mac(iant2_o_a) = 250.0
12824       mw_aer_mac(iant3_o_a) = 250.0
12825       mw_aer_mac(iant4_o_a) = 250.0
12826       mw_aer_mac(ibiog1_c_a) = 250.0
12827       mw_aer_mac(ibiog2_c_a) = 250.0
12828       mw_aer_mac(ibiog3_c_a) = 250.0
12829       mw_aer_mac(ibiog4_c_a) = 250.0
12830       mw_aer_mac(ibiog1_o_a) = 250.0
12831       mw_aer_mac(ibiog2_o_a) = 250.0
12832       mw_aer_mac(ibiog3_o_a) = 250.0
12833       mw_aer_mac(ibiog4_o_a) = 250.0
12834       mw_aer_mac(iasoaX_a) = 250.0
12835       mw_aer_mac(iasoa1_a) = 250.0
12836       mw_aer_mac(iasoa2_a) = 250.0
12837       mw_aer_mac(iasoa3_a) = 250.0
12838       mw_aer_mac(iasoa4_a) = 250.0
12839       mw_aer_mac(ibsoaX_a) = 250.0
12840       mw_aer_mac(ibsoa1_a) = 250.0
12841       mw_aer_mac(ibsoa2_a) = 250.0
12842       mw_aer_mac(ibsoa3_a) = 250.0
12843       mw_aer_mac(ibsoa4_a) = 250.0
12844
12845
12846 ! molecular weights of compounds
12847       mw_comp_a(jnh4so4) = 132.0
12848       mw_comp_a(jlvcite) = 247.0
12849       mw_comp_a(jnh4hso4)= 115.0
12850       mw_comp_a(jnh4msa) = 113.0
12851       mw_comp_a(jnh4no3) = 80.0
12852       mw_comp_a(jnh4cl)  = 53.5
12853       mw_comp_a(jnacl)   = 58.5
12854       mw_comp_a(jnano3)  = 85.0
12855       mw_comp_a(jna2so4) = 142.0
12856       mw_comp_a(jna3hso4)= 262.0
12857       mw_comp_a(jnahso4) = 120.0
12858       mw_comp_a(jnamsa)  = 118.0
12859       mw_comp_a(jcaso4)  = 136.0
12860       mw_comp_a(jcamsa2) = 230.0
12861       mw_comp_a(jcano3)  = 164.0
12862       mw_comp_a(jcacl2)  = 111.0
12863       mw_comp_a(jcaco3)  = 100.0
12864       mw_comp_a(jh2so4)  = 98.0
12865       mw_comp_a(jhhso4)  = 98.0
12866       mw_comp_a(jhno3)   = 63.0
12867       mw_comp_a(jhcl)    = 36.5
12868       mw_comp_a(jmsa)    = 96.0
12869       mw_comp_a(joc)     = 250.0
12870       mw_comp_a(jbc)     = 1.0
12871       mw_comp_a(join)    = 1.0
12872       mw_comp_a(jh2o)    = 18.0
12873       mw_comp_a(jpcg1_b_c) =250.0
12874       mw_comp_a(jpcg2_b_c) =250.0
12875       mw_comp_a(jpcg3_b_c)=250.0
12876       mw_comp_a(jpcg4_b_c)=250.0
12877       mw_comp_a(jpcg5_b_c)=250.0
12878       mw_comp_a(jpcg6_b_c)=250.0
12879       mw_comp_a(jpcg7_b_c)=250.0
12880       mw_comp_a(jpcg8_b_c)=250.0
12881       mw_comp_a(jpcg9_b_c)=250.0
12882       mw_comp_a(jopcg1_b_c)=250.0
12883       mw_comp_a(jopcg2_b_c)=250.0
12884       mw_comp_a(jopcg3_b_c)=250.0
12885       mw_comp_a(jopcg4_b_c)=250.0
12886       mw_comp_a(jopcg5_b_c)=250.0
12887       mw_comp_a(jopcg6_b_c)=250.0
12888       mw_comp_a(jopcg7_b_c)=250.0
12889       mw_comp_a(jopcg8_b_c)=250.0
12890       mw_comp_a(jpcg1_b_o)=250.0
12891       mw_comp_a(jpcg2_b_o)=250.0
12892       mw_comp_a(jpcg3_b_o)=250.0
12893       mw_comp_a(jpcg4_b_o)=250.0
12894       mw_comp_a(jpcg5_b_o)=250.0
12895       mw_comp_a(jpcg6_b_o)=250.0
12896       mw_comp_a(jpcg7_b_o)=250.0
12897       mw_comp_a(jpcg8_b_o)=250.0
12898       mw_comp_a(jpcg9_b_o)=250.0
12899       mw_comp_a(jopcg1_b_o)=250.0
12900       mw_comp_a(jopcg2_b_o)=250.0
12901       mw_comp_a(jopcg3_b_o)=250.0
12902       mw_comp_a(jopcg4_b_o)=250.0
12903       mw_comp_a(jopcg5_b_o)=250.0
12904       mw_comp_a(jopcg6_b_o)=250.0
12905       mw_comp_a(jopcg7_b_o)=250.0
12906       mw_comp_a(jopcg8_b_o)=250.0
12907       mw_comp_a(jpcg1_f_c) =250.0
12908       mw_comp_a(jpcg2_f_c) =250.0
12909       mw_comp_a(jpcg3_f_c)=250.0
12910       mw_comp_a(jpcg4_f_c)=250.0
12911       mw_comp_a(jpcg5_f_c)=250.0
12912       mw_comp_a(jpcg6_f_c)=250.0
12913       mw_comp_a(jpcg7_f_c)=250.0
12914       mw_comp_a(jpcg8_f_c)=250.0
12915       mw_comp_a(jpcg9_f_c)=250.0
12916       mw_comp_a(jopcg1_f_c)=250.0
12917       mw_comp_a(jopcg2_f_c)=250.0
12918       mw_comp_a(jopcg3_f_c)=250.0
12919       mw_comp_a(jopcg4_f_c)=250.0
12920       mw_comp_a(jopcg5_f_c)=250.0
12921       mw_comp_a(jopcg6_f_c)=250.0
12922       mw_comp_a(jopcg7_f_c)=250.0
12923       mw_comp_a(jopcg8_f_c)=250.0
12924       mw_comp_a(jpcg1_f_o)=250.0
12925       mw_comp_a(jpcg2_f_o)=250.0
12926       mw_comp_a(jpcg3_f_o)=250.0
12927       mw_comp_a(jpcg4_f_o)=250.0
12928       mw_comp_a(jpcg5_f_o)=250.0
12929       mw_comp_a(jpcg6_f_o)=250.0
12930       mw_comp_a(jpcg7_f_o)=250.0
12931       mw_comp_a(jpcg8_f_o)=250.0
12932       mw_comp_a(jpcg9_f_o)=250.0
12933       mw_comp_a(jopcg1_f_o)=250.0
12934       mw_comp_a(jopcg2_f_o)=250.0
12935       mw_comp_a(jopcg3_f_o)=250.0
12936       mw_comp_a(jopcg4_f_o)=250.0
12937       mw_comp_a(jopcg5_f_o)=250.0
12938       mw_comp_a(jopcg6_f_o)=250.0
12939       mw_comp_a(jopcg7_f_o)=250.0
12940       mw_comp_a(jopcg8_f_o)=250.0
12941       mw_comp_a(jsmpa)=250.0
12942       mw_comp_a(jsmpbb)=250.0
12943       mw_comp_a(jglysoa_r1)=250.0
12944       mw_comp_a(jglysoa_r2)=250.0
12945       mw_comp_a(jglysoa_sfc)=250.0
12946       mw_comp_a(jglysoa_nh4)=250.0
12947       mw_comp_a(jglysoa_oh)=250.0
12948       mw_comp_a(jant1_c)=250.0
12949       mw_comp_a(jant2_c)=250.0
12950       mw_comp_a(jant3_c)=250.0
12951       mw_comp_a(jant4_c)=250.0
12952       mw_comp_a(jant1_o)=250.0
12953       mw_comp_a(jant2_o)=250.0
12954       mw_comp_a(jant3_o)=250.0
12955       mw_comp_a(jant4_o)=250.0
12956       mw_comp_a(jbiog1_c)=250.0
12957       mw_comp_a(jbiog2_c)=250.0
12958       mw_comp_a(jbiog3_c)=250.0
12959       mw_comp_a(jbiog4_c)=250.0
12960       mw_comp_a(jbiog1_o)=250.0
12961       mw_comp_a(jbiog2_o)=250.0
12962       mw_comp_a(jbiog3_o)=250.0
12963       mw_comp_a(jbiog4_o)=250.0
12964       mw_comp_a(jasoaX)=250.0
12965       mw_comp_a(jasoa1)=250.0
12966       mw_comp_a(jasoa2)=250.0
12967       mw_comp_a(jasoa3)=250.0
12968       mw_comp_a(jasoa4)=250.0
12969       mw_comp_a(jbsoaX)=250.0
12970       mw_comp_a(jbsoa1)=250.0
12971       mw_comp_a(jbsoa2)=250.0
12972       mw_comp_a(jbsoa3)=250.0
12973       mw_comp_a(jbsoa4)=250.0
12974
12975 ! densities of generic aerosol species
12976       dens_aer_mac(iso4_a) = 1.8        ! used
12977       dens_aer_mac(ino3_a) = 1.8        ! used
12978       dens_aer_mac(icl_a)  = 2.2        ! used
12979       dens_aer_mac(imsa_a) = 1.8        ! used
12980       dens_aer_mac(ico3_a) = 2.6        ! used
12981       dens_aer_mac(inh4_a) = 1.8        ! used
12982       dens_aer_mac(ina_a)  = 2.2        ! used
12983       dens_aer_mac(ica_a)  = 2.6        ! used
12984       dens_aer_mac(ioin_a) = 2.6        ! used
12985       dens_aer_mac(ioc_a)  = 1.0        ! used
12986       dens_aer_mac(ibc_a)  = 1.7        ! used
12987       dens_aer_mac(ipcg1_b_c_a) =1.0
12988       dens_aer_mac(ipcg2_b_c_a) =1.0
12989       dens_aer_mac(ipcg3_b_c_a)=1.0
12990       dens_aer_mac(ipcg4_b_c_a)=1.0
12991       dens_aer_mac(ipcg5_b_c_a)=1.0
12992       dens_aer_mac(ipcg6_b_c_a)=1.0
12993       dens_aer_mac(ipcg7_b_c_a)=1.0
12994       dens_aer_mac(ipcg8_b_c_a)=1.0
12995       dens_aer_mac(ipcg9_b_c_a)=1.0
12996       dens_aer_mac(iopcg1_b_c_a)=1.0
12997       dens_aer_mac(iopcg2_b_c_a)=1.0
12998       dens_aer_mac(iopcg3_b_c_a)=1.0
12999       dens_aer_mac(iopcg4_b_c_a)=1.0
13000       dens_aer_mac(iopcg5_b_c_a)=1.0
13001       dens_aer_mac(iopcg6_b_c_a)=1.0
13002       dens_aer_mac(iopcg7_b_c_a)=1.0
13003       dens_aer_mac(iopcg8_b_c_a)=1.0
13004       dens_aer_mac(ipcg1_b_o_a)=1.0
13005       dens_aer_mac(ipcg2_b_o_a)=1.0
13006       dens_aer_mac(ipcg3_b_o_a)=1.0
13007       dens_aer_mac(ipcg4_b_o_a)=1.0
13008       dens_aer_mac(ipcg5_b_o_a)=1.0
13009       dens_aer_mac(ipcg6_b_o_a)=1.0
13010       dens_aer_mac(ipcg7_b_o_a)=1.0
13011       dens_aer_mac(ipcg8_b_o_a)=1.0
13012       dens_aer_mac(ipcg9_b_o_a)=1.0
13013       dens_aer_mac(iopcg1_b_o_a)=1.0
13014       dens_aer_mac(iopcg2_b_o_a)=1.0
13015       dens_aer_mac(iopcg3_b_o_a)=1.0
13016       dens_aer_mac(iopcg4_b_o_a)=1.0
13017       dens_aer_mac(iopcg5_b_o_a)=1.0
13018       dens_aer_mac(iopcg6_b_o_a)=1.0
13019       dens_aer_mac(iopcg7_b_o_a)=1.0
13020       dens_aer_mac(iopcg8_b_o_a)=1.0
13021       dens_aer_mac(ipcg1_f_c_a) =1.0
13022       dens_aer_mac(ipcg2_f_c_a) =1.0
13023       dens_aer_mac(ipcg3_f_c_a)=1.0
13024       dens_aer_mac(ipcg4_f_c_a)=1.0
13025       dens_aer_mac(ipcg5_f_c_a)=1.0
13026       dens_aer_mac(ipcg6_f_c_a)=1.0
13027       dens_aer_mac(ipcg7_f_c_a)=1.0
13028       dens_aer_mac(ipcg8_f_c_a)=1.0
13029       dens_aer_mac(ipcg9_f_c_a)=1.0
13030       dens_aer_mac(iopcg1_f_c_a)=1.0
13031       dens_aer_mac(iopcg2_f_c_a)=1.0
13032       dens_aer_mac(iopcg3_f_c_a)=1.0
13033       dens_aer_mac(iopcg4_f_c_a)=1.0
13034       dens_aer_mac(iopcg5_f_c_a)=1.0
13035       dens_aer_mac(iopcg6_f_c_a)=1.0
13036       dens_aer_mac(iopcg7_f_c_a)=1.0
13037       dens_aer_mac(iopcg8_f_c_a)=1.0
13038       dens_aer_mac(ipcg1_f_o_a)=1.0
13039       dens_aer_mac(ipcg2_f_o_a)=1.0
13040       dens_aer_mac(ipcg3_f_o_a)=1.0
13041       dens_aer_mac(ipcg4_f_o_a)=1.0
13042       dens_aer_mac(ipcg5_f_o_a)=1.0
13043       dens_aer_mac(ipcg6_f_o_a)=1.0
13044       dens_aer_mac(ipcg7_f_o_a)=1.0
13045       dens_aer_mac(ipcg8_f_o_a)=1.0
13046       dens_aer_mac(ipcg9_f_o_a)=1.0
13047       dens_aer_mac(iopcg1_f_o_a)=1.0
13048       dens_aer_mac(iopcg2_f_o_a)=1.0
13049       dens_aer_mac(iopcg3_f_o_a)=1.0
13050       dens_aer_mac(iopcg4_f_o_a)=1.0
13051       dens_aer_mac(iopcg5_f_o_a)=1.0
13052       dens_aer_mac(iopcg6_f_o_a)=1.0
13053       dens_aer_mac(iopcg7_f_o_a)=1.0
13054       dens_aer_mac(iopcg8_f_o_a)=1.0
13055       dens_aer_mac(ismpa_a)=1.0
13056       dens_aer_mac(ismpbb_a)=1.0
13057       dens_aer_mac(iglysoa_r1_a)=1.0
13058       dens_aer_mac(iglysoa_r2_a)=1.0
13059       dens_aer_mac(iglysoa_sfc_a)=1.0
13060       dens_aer_mac(iglysoa_nh4_a)=1.0
13061       dens_aer_mac(iglysoa_oh_a)=1.0
13062       dens_aer_mac(iant1_c_a)=1.0
13063       dens_aer_mac(iant2_c_a)=1.0
13064       dens_aer_mac(iant3_c_a)=1.0
13065       dens_aer_mac(iant4_c_a)=1.0
13066       dens_aer_mac(iant1_o_a)=1.0
13067       dens_aer_mac(iant2_o_a)=1.0
13068       dens_aer_mac(iant3_o_a)=1.0
13069       dens_aer_mac(iant4_o_a)=1.0
13070       dens_aer_mac(ibiog1_c_a)=1.0
13071       dens_aer_mac(ibiog2_c_a)=1.0
13072       dens_aer_mac(ibiog3_c_a)=1.0
13073       dens_aer_mac(ibiog4_c_a)=1.0
13074       dens_aer_mac(ibiog1_o_a)=1.0
13075       dens_aer_mac(ibiog2_o_a)=1.0
13076       dens_aer_mac(ibiog3_o_a)=1.0
13077       dens_aer_mac(ibiog4_o_a)=1.0
13078       dens_aer_mac(iasoaX_a)=1.5
13079       dens_aer_mac(iasoa1_a)=1.5
13080       dens_aer_mac(iasoa2_a)=1.5
13081       dens_aer_mac(iasoa3_a)=1.5
13082       dens_aer_mac(iasoa4_a)=1.5
13083       dens_aer_mac(ibsoaX_a)=1.5
13084       dens_aer_mac(ibsoa1_a)=1.5
13085       dens_aer_mac(ibsoa2_a)=1.5
13086       dens_aer_mac(ibsoa3_a)=1.5
13087       dens_aer_mac(ibsoa4_a)=1.5
13088
13089 ! partial molar volumes of condensing species
13090       partial_molar_vol(ih2so4_g) = 51.83
13091       partial_molar_vol(ihno3_g)  = 31.45
13092       partial_molar_vol(ihcl_g)   = 20.96
13093       partial_molar_vol(inh3_g)   = 24.03
13094       partial_molar_vol(imsa_g)   = 53.33
13095       partial_molar_vol(ipcg1_b_c_g) =250.0
13096       partial_molar_vol(ipcg2_b_c_g) =250.0
13097       partial_molar_vol(ipcg3_b_c_g)=250.0
13098       partial_molar_vol(ipcg4_b_c_g)=250.0
13099       partial_molar_vol(ipcg5_b_c_g)=250.0
13100       partial_molar_vol(ipcg6_b_c_g)=250.0
13101       partial_molar_vol(ipcg7_b_c_g)=250.0
13102       partial_molar_vol(ipcg8_b_c_g)=250.0
13103       partial_molar_vol(ipcg9_b_c_g)=250.0
13104       partial_molar_vol(iopcg1_b_c_g)=250.0
13105       partial_molar_vol(iopcg2_b_c_g)=250.0
13106       partial_molar_vol(iopcg3_b_c_g)=250.0
13107       partial_molar_vol(iopcg4_b_c_g)=250.0
13108       partial_molar_vol(iopcg5_b_c_g)=250.0
13109       partial_molar_vol(iopcg6_b_c_g)=250.0
13110       partial_molar_vol(iopcg7_b_c_g)=250.0
13111       partial_molar_vol(iopcg8_b_c_g)=250.0
13112       partial_molar_vol(ipcg1_b_o_g)=250.0
13113       partial_molar_vol(ipcg2_b_o_g)=250.0
13114       partial_molar_vol(ipcg3_b_o_g)=250.0
13115       partial_molar_vol(ipcg4_b_o_g)=250.0
13116       partial_molar_vol(ipcg5_b_o_g)=250.0
13117       partial_molar_vol(ipcg6_b_o_g)=250.0
13118       partial_molar_vol(ipcg7_b_o_g)=250.0
13119       partial_molar_vol(ipcg8_b_o_g)=250.0
13120       partial_molar_vol(ipcg9_b_o_g)=250.0
13121       partial_molar_vol(iopcg1_b_o_g)=250.0
13122       partial_molar_vol(iopcg2_b_o_g)=250.0
13123       partial_molar_vol(iopcg3_b_o_g)=250.0
13124       partial_molar_vol(iopcg4_b_o_g)=250.0
13125       partial_molar_vol(iopcg5_b_o_g)=250.0
13126       partial_molar_vol(iopcg6_b_o_g)=250.0
13127       partial_molar_vol(iopcg7_b_o_g)=250.0
13128       partial_molar_vol(iopcg8_b_o_g)=250.0
13129       partial_molar_vol(ipcg1_f_c_g) =250.0
13130       partial_molar_vol(ipcg2_f_c_g) =250.0
13131       partial_molar_vol(ipcg3_f_c_g)=250.0
13132       partial_molar_vol(ipcg4_f_c_g)=250.0
13133       partial_molar_vol(ipcg5_f_c_g)=250.0
13134       partial_molar_vol(ipcg6_f_c_g)=250.0
13135       partial_molar_vol(ipcg7_f_c_g)=250.0
13136       partial_molar_vol(ipcg8_f_c_g)=250.0
13137       partial_molar_vol(ipcg9_f_c_g)=250.0
13138       partial_molar_vol(iopcg1_f_c_g)=250.0
13139       partial_molar_vol(iopcg2_f_c_g)=250.0
13140       partial_molar_vol(iopcg3_f_c_g)=250.0
13141       partial_molar_vol(iopcg4_f_c_g)=250.0
13142       partial_molar_vol(iopcg5_f_c_g)=250.0
13143       partial_molar_vol(iopcg6_f_c_g)=250.0
13144       partial_molar_vol(iopcg7_f_c_g)=250.0
13145       partial_molar_vol(iopcg8_f_c_g)=250.0
13146       partial_molar_vol(ipcg1_f_o_g)=250.0
13147       partial_molar_vol(ipcg2_f_o_g)=250.0
13148       partial_molar_vol(ipcg3_f_o_g)=250.0
13149       partial_molar_vol(ipcg4_f_o_g)=250.0
13150       partial_molar_vol(ipcg5_f_o_g)=250.0
13151       partial_molar_vol(ipcg6_f_o_g)=250.0
13152       partial_molar_vol(ipcg7_f_o_g)=250.0
13153       partial_molar_vol(ipcg8_f_o_g)=250.0
13154       partial_molar_vol(ipcg9_f_o_g)=250.0
13155       partial_molar_vol(iopcg1_f_o_g)=250.0
13156       partial_molar_vol(iopcg2_f_o_g)=250.0
13157       partial_molar_vol(iopcg3_f_o_g)=250.0
13158       partial_molar_vol(iopcg4_f_o_g)=250.0
13159       partial_molar_vol(iopcg5_f_o_g)=250.0
13160       partial_molar_vol(iopcg6_f_o_g)=250.0
13161       partial_molar_vol(iopcg7_f_o_g)=250.0
13162       partial_molar_vol(iopcg8_f_o_g)=250.0
13163       partial_molar_vol(ismpa_g)=250.0
13164       partial_molar_vol(ismpbb_g)=250.0
13165       partial_molar_vol(iant1_c_g)=250.0
13166       partial_molar_vol(iant2_c_g)=250.0
13167       partial_molar_vol(iant3_c_g)=250.0
13168       partial_molar_vol(iant4_c_g)=250.0
13169       partial_molar_vol(iant1_o_g)=250.0
13170       partial_molar_vol(iant2_o_g)=250.0
13171       partial_molar_vol(iant3_o_g)=250.0
13172       partial_molar_vol(iant4_o_g)=250.0
13173       partial_molar_vol(ibiog1_c_g)=250.0
13174       partial_molar_vol(ibiog2_c_g)=250.0
13175       partial_molar_vol(ibiog3_c_g)=250.0
13176       partial_molar_vol(ibiog4_c_g)=250.0
13177       partial_molar_vol(ibiog1_o_g)=250.0
13178       partial_molar_vol(ibiog2_o_g)=250.0
13179       partial_molar_vol(ibiog3_o_g)=250.0
13180       partial_molar_vol(ibiog4_o_g)=250.0
13181       partial_molar_vol(in2o5_g)  = 200.0       ! assumed...
13182       partial_molar_vol(iclno2_g) = 200.0       ! assumed...
13183       partial_molar_vol(iasoaX_g)=250.0
13184       partial_molar_vol(iasoa1_g)=250.0
13185       partial_molar_vol(iasoa2_g)=250.0
13186       partial_molar_vol(iasoa3_g)=250.0
13187       partial_molar_vol(iasoa4_g)=250.0
13188       partial_molar_vol(ibsoaX_g)=250.0
13189       partial_molar_vol(ibsoa1_g)=250.0
13190       partial_molar_vol(ibsoa2_g)=250.0
13191       partial_molar_vol(ibsoa3_g)=250.0
13192       partial_molar_vol(ibsoa4_g)=250.0
13193       partial_molar_vol(igly)=58.0
13194       partial_molar_vol(iho)=17.0
13195
13196 ! refractive index
13197       ref_index_a(jnh4so4) = cmplx(1.52,0.)
13198       ref_index_a(jlvcite) = cmplx(1.50,0.)
13199       ref_index_a(jnh4hso4)= cmplx(1.47,0.)
13200       ref_index_a(jnh4msa) = cmplx(1.50,0.)     ! assumed
13201       ref_index_a(jnh4no3) = cmplx(1.50,0.)
13202       ref_index_a(jnh4cl)  = cmplx(1.50,0.)
13203       ref_index_a(jnacl)   = cmplx(1.45,0.)
13204       ref_index_a(jnano3)  = cmplx(1.50,0.)
13205       ref_index_a(jna2so4) = cmplx(1.50,0.)
13206       ref_index_a(jna3hso4)= cmplx(1.50,0.)
13207       ref_index_a(jnahso4) = cmplx(1.50,0.)
13208       ref_index_a(jnamsa)  = cmplx(1.50,0.)     ! assumed
13209       ref_index_a(jcaso4)  = cmplx(1.56,0.006)
13210       ref_index_a(jcamsa2) = cmplx(1.56,0.006)  ! assumed
13211       ref_index_a(jcano3)  = cmplx(1.56,0.006)
13212       ref_index_a(jcacl2)  = cmplx(1.52,0.006)
13213       ref_index_a(jcaco3)  = cmplx(1.68,0.006)
13214       ref_index_a(jh2so4)  = cmplx(1.43,0.)
13215       ref_index_a(jhhso4)  = cmplx(1.43,0.)
13216       ref_index_a(jhno3)   = cmplx(1.50,0.)
13217       ref_index_a(jhcl)    = cmplx(1.50,0.)
13218       ref_index_a(jmsa)    = cmplx(1.43,0.)     ! assumed
13219       ref_index_a(joc)     = cmplx(1.45,0.)
13220       ref_index_a(jbc)     = cmplx(1.82,0.74)
13221       ref_index_a(join)    = cmplx(1.55,0.006)
13222       ref_index_a(jh2o)    = cmplx(1.33,0.)
13223
13224 ! jsalt_index
13225       jsalt_index(jnh4so4) = 5          ! as
13226       jsalt_index(jlvcite) = 2          ! lv
13227       jsalt_index(jnh4hso4)= 1          ! ab
13228       jsalt_index(jnh4no3) = 2          ! an
13229       jsalt_index(jnh4cl)  = 1          ! ac
13230       jsalt_index(jna2so4) = 60         ! ss
13231       jsalt_index(jnahso4) = 10         ! sb
13232       jsalt_index(jnano3)  = 40         ! sn
13233       jsalt_index(jnacl)   = 10         ! sc
13234       jsalt_index(jcano3)  = 120        ! cn
13235       jsalt_index(jcacl2)  = 80         ! cc
13236       jsalt_index(jnh4msa) = 0          ! AM    zero for now
13237       jsalt_index(jnamsa)  = 0          ! SM    zero for now
13238       jsalt_index(jcamsa2) = 0          ! CM    zero for now
13239
13240
13241 ! aerosol indices
13242 !  ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
13243 !  ab = 1, lv = 2, sb = 10
13244 !
13245 ! sulfate-poor domain
13246       jsulf_poor(1)   =         1       !       ac
13247       jsulf_poor(2)   =         2       !       an
13248       jsulf_poor(5)   =         3       !       as
13249       jsulf_poor(10)  =         4       !       sc
13250       jsulf_poor(40)  =         5       !       sn
13251       jsulf_poor(60)  =         6       !       ss
13252       jsulf_poor(80)  =         7       !       cc
13253       jsulf_poor(120) =         8       !       cn
13254       jsulf_poor(3)   =         9       !       an + ac
13255       jsulf_poor(6)   =         10      !       as + ac
13256       jsulf_poor(7)   =         11      !       as + an
13257       jsulf_poor(8)   =         12      !       as + an + ac
13258       jsulf_poor(11)  =         13      !       sc + ac
13259       jsulf_poor(41)  =         14      !       sn + ac
13260       jsulf_poor(42)  =         15      !       sn + an
13261       jsulf_poor(43)  =         16      !       sn + an + ac
13262       jsulf_poor(50)  =         17      !       sn + sc
13263       jsulf_poor(51)  =         18      !       sn + sc + ac
13264       jsulf_poor(61)  =         19      !       ss + ac
13265       jsulf_poor(62)  =         20      !       ss + an
13266       jsulf_poor(63)  =         21      !       ss + an + ac
13267       jsulf_poor(65)  =         22      !       ss + as
13268       jsulf_poor(66)  =         23      !       ss + as + ac
13269       jsulf_poor(67)  =         24      !       ss + as + an
13270       jsulf_poor(68)  =         25      !       ss + as + an + ac
13271       jsulf_poor(70)  =         26      !       ss + sc
13272       jsulf_poor(71)  =         27      !       ss + sc + ac
13273       jsulf_poor(100) =         28      !       ss + sn
13274       jsulf_poor(101) =         29      !       ss + sn + ac
13275       jsulf_poor(102) =         30      !       ss + sn + an
13276       jsulf_poor(103) =         31      !       ss + sn + an + ac
13277       jsulf_poor(110) =         32      !       ss + sn + sc
13278       jsulf_poor(111) =         33      !       ss + sn + sc + ac
13279       jsulf_poor(81)  =         34      !       cc + ac
13280       jsulf_poor(90)  =         35      !       cc + sc
13281       jsulf_poor(91)  =         36      !       cc + sc + ac
13282       jsulf_poor(121) =         37      !       cn + ac
13283       jsulf_poor(122) =         38      !       cn + an
13284       jsulf_poor(123) =         39      !       cn + an + ac
13285       jsulf_poor(130) =         40      !       cn + sc
13286       jsulf_poor(131) =         41      !       cn + sc + ac
13287       jsulf_poor(160) =         42      !       cn + sn
13288       jsulf_poor(161) =         43      !       cn + sn + ac
13289       jsulf_poor(162) =         44      !       cn + sn + an
13290       jsulf_poor(163) =         45      !       cn + sn + an + ac
13291       jsulf_poor(170) =         46      !       cn + sn + sc
13292       jsulf_poor(171) =         47      !       cn + sn + sc + ac
13293       jsulf_poor(200) =         48      !       cn + cc
13294       jsulf_poor(201) =         49      !       cn + cc + ac
13295       jsulf_poor(210) =         50      !       cn + cc + sc
13296       jsulf_poor(211) =         51      !       cn + cc + sc + ac
13297 !
13298 ! sulfate-rich domain
13299       jsulf_rich(1)   =         52      !       ab
13300       jsulf_rich(2)   =         53      !       lv
13301       jsulf_rich(10)  =         54      !       sb
13302       jsulf_rich(3)   =         55      !       ab + lv
13303       jsulf_rich(7)   =         56      !       as + lv
13304       jsulf_rich(70)  =         57      !       ss + sb
13305       jsulf_rich(62)  =         58      !       ss + lv
13306       jsulf_rich(67)  =         59      !       ss + as + lv
13307       jsulf_rich(61)  =         60      !       ss + ab
13308       jsulf_rich(63)  =         61      !       ss + lv + ab
13309       jsulf_rich(11)  =         62      !       sb + ab
13310       jsulf_rich(71)  =         63      !       ss + sb + ab
13311       jsulf_rich(5)   =         3       !       as
13312       jsulf_rich(60)  =         6       !       ss
13313       jsulf_rich(65)  =         22      !       ss + as
13314
13315
13316
13317 !
13318 ! polynomial coefficients for binary molality (used in zsr equation)
13319 !
13320 !
13321 ! a_zsr for aw < 0.97
13322 !
13323 ! (nh4)2so4
13324       je = jnh4so4
13325       a_zsr(1,je)  =  1.30894
13326       a_zsr(2,je)  = -7.09922
13327       a_zsr(3,je)  =  20.62831
13328       a_zsr(4,je)  = -32.19965
13329       a_zsr(5,je)  =  25.17026
13330       a_zsr(6,je)  = -7.81632
13331       aw_min(je)   = 0.1
13332 !
13333 ! (nh4)3h(so4)2
13334       je = jlvcite
13335       a_zsr(1,je)  =  1.10725
13336       a_zsr(2,je)  = -5.17978
13337       a_zsr(3,je)  =  12.29534
13338       a_zsr(4,je)  = -16.32545
13339       a_zsr(5,je)  =  11.29274
13340       a_zsr(6,je)  = -3.19164
13341       aw_min(je)   = 0.1
13342 !
13343 ! nh4hso4
13344       je = jnh4hso4
13345       a_zsr(1,je)  =  1.15510
13346       a_zsr(2,je)  = -3.20815
13347       a_zsr(3,je)  =  2.71141
13348       a_zsr(4,je)  =  2.01155
13349       a_zsr(5,je)  = -4.71014
13350       a_zsr(6,je)  =  2.04616
13351       aw_min(je)   = 0.1
13352 !
13353 ! nh4msa (assumed same as nh4hso4)
13354       je = jnh4msa
13355       a_zsr(1,je)  =  1.15510
13356       a_zsr(2,je)  = -3.20815
13357       a_zsr(3,je)  =  2.71141
13358       a_zsr(4,je)  =  2.01155
13359       a_zsr(5,je)  = -4.71014
13360       a_zsr(6,je)  =  2.04616
13361       aw_min(je)   = 0.1
13362 !
13363 ! nh4no3
13364       je = jnh4no3
13365       a_zsr(1,je)  =  0.43507
13366       a_zsr(2,je)  =  6.38220
13367       a_zsr(3,je)  = -30.19797
13368       a_zsr(4,je)  =  53.36470
13369       a_zsr(5,je)  = -43.44203
13370       a_zsr(6,je)  =  13.46158
13371       aw_min(je)   = 0.1
13372 !
13373 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
13374       je = jnh4cl
13375       a_zsr(1,je)  =  0.45309
13376       a_zsr(2,je)  =  2.65606
13377       a_zsr(3,je)  = -14.7730
13378       a_zsr(4,je)  =  26.2936
13379       a_zsr(5,je)  = -20.5735
13380       a_zsr(6,je)  =  5.94255
13381       aw_min(je)   = 0.1
13382 !
13383 ! nacl
13384       je = jnacl
13385       a_zsr(1,je)  =  0.42922
13386       a_zsr(2,je)  = -1.17718
13387       a_zsr(3,je)  =  2.80208
13388       a_zsr(4,je)  = -4.51097
13389       a_zsr(5,je)  =  3.76963
13390       a_zsr(6,je)  = -1.31359
13391       aw_min(je)   = 0.1
13392 !
13393 ! nano3
13394       je = jnano3
13395       a_zsr(1,je)  =  1.34966
13396       a_zsr(2,je)  = -5.20116
13397       a_zsr(3,je)  =  11.49011
13398       a_zsr(4,je)  = -14.41380
13399       a_zsr(5,je)  =  9.07037
13400       a_zsr(6,je)  = -2.29769
13401       aw_min(je)   = 0.1
13402 !
13403 ! na2so4
13404       je = jna2so4
13405       a_zsr(1,je)  =  0.39888
13406       a_zsr(2,je)  = -1.27150
13407       a_zsr(3,je)  =  3.42792
13408       a_zsr(4,je)  = -5.92632
13409       a_zsr(5,je)  =  5.33351
13410       a_zsr(6,je)  = -1.96541
13411       aw_min(je)   = 0.1
13412 !
13413 ! na3h(so4)2  added on 1/14/2004
13414       je = jna3hso4
13415       a_zsr(1,je)  =  0.31480
13416       a_zsr(2,je)  = -1.01087
13417       a_zsr(3,je)  =  2.44029
13418       a_zsr(4,je)  = -3.66095
13419       a_zsr(5,je)  =  2.77632
13420       a_zsr(6,je)  = -0.86058
13421       aw_min(je)   = 0.1
13422 !
13423 ! nahso4
13424       je = jnahso4
13425       a_zsr(1,je)  =  0.62764
13426       a_zsr(2,je)  = -1.63520
13427       a_zsr(3,je)  =  4.62531
13428       a_zsr(4,je)  = -10.06925
13429       a_zsr(5,je)  =  10.33547
13430       a_zsr(6,je)  = -3.88729
13431       aw_min(je)   = 0.1
13432 !
13433 ! namsa (assumed same as nahso4)
13434       je = jnamsa
13435       a_zsr(1,je)  =  0.62764
13436       a_zsr(2,je)  = -1.63520
13437       a_zsr(3,je)  =  4.62531
13438       a_zsr(4,je)  = -10.06925
13439       a_zsr(5,je)  =  10.33547
13440       a_zsr(6,je)  = -3.88729
13441       aw_min(je)   = 0.1
13442 !
13443 ! ca(no3)2
13444       je = jcano3
13445       a_zsr(1,je)  =  0.38895
13446       a_zsr(2,je)  = -1.16013
13447       a_zsr(3,je)  =  2.16819
13448       a_zsr(4,je)  = -2.23079
13449       a_zsr(5,je)  =  1.00268
13450       a_zsr(6,je)  = -0.16923
13451       aw_min(je)   = 0.1
13452 !
13453 ! cacl2: kim and seinfeld
13454       je = jcacl2
13455       a_zsr(1,je)  =  0.29891
13456       a_zsr(2,je)  = -1.31104
13457       a_zsr(3,je)  =  3.68759
13458       a_zsr(4,je)  = -5.81708
13459       a_zsr(5,je)  =  4.67520
13460       a_zsr(6,je)  = -1.53223
13461       aw_min(je)   = 0.1
13462 !
13463 ! h2so4
13464       je = jh2so4
13465       a_zsr(1,je) =  0.32751
13466       a_zsr(2,je) = -1.00692
13467       a_zsr(3,je) =  2.59750
13468       a_zsr(4,je) = -4.40014
13469       a_zsr(5,je) =  3.88212
13470       a_zsr(6,je) = -1.39916
13471       aw_min(je)  = 0.1
13472 !
13473 ! msa (assumed same as h2so4)
13474       je = jmsa
13475       a_zsr(1,je) =  0.32751
13476       a_zsr(2,je) = -1.00692
13477       a_zsr(3,je) =  2.59750
13478       a_zsr(4,je) = -4.40014
13479       a_zsr(5,je) =  3.88212
13480       a_zsr(6,je) = -1.39916
13481       aw_min(je)  = 0.1
13482 !
13483 ! hhso4
13484       je = jhhso4
13485       a_zsr(1,je) =  0.32751
13486       a_zsr(2,je) = -1.00692
13487       a_zsr(3,je) =  2.59750
13488       a_zsr(4,je) = -4.40014
13489       a_zsr(5,je) =  3.88212
13490       a_zsr(6,je) = -1.39916
13491       aw_min(je)  = 1.0
13492 !
13493 ! hno3
13494       je = jhno3
13495       a_zsr(1,je) =  0.75876
13496       a_zsr(2,je) = -3.31529
13497       a_zsr(3,je) =  9.26392
13498       a_zsr(4,je) = -14.89799
13499       a_zsr(5,je) =  12.08781
13500       a_zsr(6,je) = -3.89958
13501       aw_min(je)  = 0.1
13502 !
13503 ! hcl
13504       je = jhcl
13505       a_zsr(1,je) =  0.31133
13506       a_zsr(2,je) = -0.79688
13507       a_zsr(3,je) =  1.93995
13508       a_zsr(4,je) = -3.31582
13509       a_zsr(5,je) =  2.93513
13510       a_zsr(6,je) = -1.07268
13511       aw_min(je)  = 0.1
13512 !
13513 ! caso4
13514       je = jcaso4
13515       a_zsr(1,je)  =  0.0
13516       a_zsr(2,je)  =  0.0
13517       a_zsr(3,je)  =  0.0
13518       a_zsr(4,je)  =  0.0
13519       a_zsr(5,je)  =  0.0
13520       a_zsr(6,je)  =  0.0
13521       aw_min(je)   = 1.0
13522 !
13523 ! ca(msa)2 (assumed same as ca(no3)2)
13524       je = jcamsa2
13525       a_zsr(1,je)  =  0.38895
13526       a_zsr(2,je)  = -1.16013
13527       a_zsr(3,je)  =  2.16819
13528       a_zsr(4,je)  = -2.23079
13529       a_zsr(5,je)  =  1.00268
13530       a_zsr(6,je)  = -0.16923
13531       aw_min(je)   = 0.1
13532 !
13533 ! caco3
13534       je = jcaco3
13535       a_zsr(1,je)  =  0.0
13536       a_zsr(2,je)  =  0.0
13537       a_zsr(3,je)  =  0.0
13538       a_zsr(4,je)  =  0.0
13539       a_zsr(5,je)  =  0.0
13540       a_zsr(6,je)  =  0.0
13541       aw_min(je)   = 1.0
13542
13543
13544
13545 !-------------------------------------------
13546 ! b_zsr for aw => 0.97 to 0.99999
13547 !
13548 ! (nh4)2so4
13549       b_zsr(jnh4so4)  = 28.0811
13550 !
13551 ! (nh4)3h(so4)2
13552       b_zsr(jlvcite)  = 14.7178
13553 !
13554 ! nh4hso4
13555       b_zsr(jnh4hso4) = 29.4779
13556 !
13557 ! nh4msa
13558       b_zsr(jnh4msa)  = 29.4779 ! assumed same as nh4hso4
13559 !
13560 ! nh4no3
13561       b_zsr(jnh4no3)  = 33.4049
13562 !
13563 ! nh4cl
13564       b_zsr(jnh4cl)   = 30.8888
13565 !
13566 ! nacl
13567       b_zsr(jnacl)    = 29.8375
13568 !
13569 ! nano3
13570       b_zsr(jnano3)   = 32.2756
13571 !
13572 ! na2so4
13573       b_zsr(jna2so4)  = 27.6889
13574 !
13575 ! na3h(so4)2
13576       b_zsr(jna3hso4) = 14.2184
13577 !
13578 ! nahso4
13579       b_zsr(jnahso4)  = 28.3367
13580 !
13581 ! namsa
13582       b_zsr(jnamsa)   = 28.3367 ! assumed same as nahso4
13583 !
13584 ! ca(no3)2
13585       b_zsr(jcano3)   = 18.3661
13586 !
13587 ! cacl2
13588       b_zsr(jcacl2)   = 20.8792
13589 !
13590 ! h2so4
13591       b_zsr(jh2so4)   = 26.7347
13592 !
13593 ! hhso4
13594       b_zsr(jhhso4)   = 26.7347
13595 !
13596 ! hno3
13597       b_zsr(jhno3)    = 28.8257
13598 !
13599 ! hcl
13600       b_zsr(jhcl)     = 27.7108
13601 !
13602 ! msa
13603       b_zsr(jmsa)     = 26.7347 ! assumed same as h2so4
13604 !
13605 ! caso4
13606       b_zsr(jcaso4)   = 0.0
13607 !
13608 ! ca(msa)2
13609       b_zsr(jcamsa2)  = 18.3661 ! assumed same as Ca(NO3)2
13610 !
13611 ! caco3
13612       b_zsr(jcaco3)   = 0.0
13613
13614
13615
13616
13617
13618
13619
13620 !----------------------------------------------------------------
13621 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
13622 ! log_gamz(ja,je)   a in e
13623 !----------------------------------------------------------------
13624 !
13625 ! (nh4)2so4 in e
13626       ja = jnh4so4
13627
13628 ! in (nh4)2so4
13629       je = jnh4so4
13630       b_mtem(1,ja,je) = -2.94685
13631       b_mtem(2,ja,je) = 17.3328
13632       b_mtem(3,ja,je) = -64.8441
13633       b_mtem(4,ja,je) = 122.7070
13634       b_mtem(5,ja,je) = -114.4373
13635       b_mtem(6,ja,je) = 41.6811
13636
13637 ! in nh4no3
13638       je = jnh4no3
13639       b_mtem(1,ja,je) = -2.7503
13640       b_mtem(2,ja,je) = 4.3806
13641       b_mtem(3,ja,je) = -1.1110
13642       b_mtem(4,ja,je) = -1.7005
13643       b_mtem(5,ja,je) = -4.4207
13644       b_mtem(6,ja,je) = 5.1990
13645
13646 ! in nh4cl (revised on 11/15/2003)
13647       je = jnh4cl
13648       b_mtem(1,ja,je) = -2.06952
13649       b_mtem(2,ja,je) = 7.1240
13650       b_mtem(3,ja,je) = -24.4274
13651       b_mtem(4,ja,je) = 51.1458
13652       b_mtem(5,ja,je) = -54.2056
13653       b_mtem(6,ja,je) = 22.0606
13654
13655 ! in na2so4
13656       je = jna2so4
13657       b_mtem(1,ja,je) = -2.17361
13658       b_mtem(2,ja,je) = 15.9919
13659       b_mtem(3,ja,je) = -69.0952
13660       b_mtem(4,ja,je) = 139.8860
13661       b_mtem(5,ja,je) = -134.9890
13662       b_mtem(6,ja,je) = 49.8877
13663
13664 ! in nano3
13665       je = jnano3
13666       b_mtem(1,ja,je) = -4.4370
13667       b_mtem(2,ja,je) = 24.0243
13668       b_mtem(3,ja,je) = -76.2437
13669       b_mtem(4,ja,je) = 128.6660
13670       b_mtem(5,ja,je) = -110.0900
13671       b_mtem(6,ja,je) = 37.7414
13672
13673 ! in nacl
13674       je = jnacl
13675       b_mtem(1,ja,je) = -1.5394
13676       b_mtem(2,ja,je) = 5.8671
13677       b_mtem(3,ja,je) = -22.7726
13678       b_mtem(4,ja,je) = 47.0547
13679       b_mtem(5,ja,je) = -47.8266
13680       b_mtem(6,ja,je) = 18.8489
13681
13682 ! in hno3
13683       je = jhno3
13684       b_mtem(1,ja,je) = -0.35750
13685       b_mtem(2,ja,je) = -3.82466
13686       b_mtem(3,ja,je) = 4.55462
13687       b_mtem(4,ja,je) = 5.05402
13688       b_mtem(5,ja,je) = -14.7476
13689       b_mtem(6,ja,je) = 8.8009
13690
13691 ! in hcl
13692       je = jhcl
13693       b_mtem(1,ja,je) = -2.15146
13694       b_mtem(2,ja,je) = 5.50205
13695       b_mtem(3,ja,je) = -19.1476
13696       b_mtem(4,ja,je) = 39.1880
13697       b_mtem(5,ja,je) = -39.9460
13698       b_mtem(6,ja,je) = 16.0700
13699
13700 ! in h2so4
13701       je = jh2so4
13702       b_mtem(1,ja,je) = -2.52604
13703       b_mtem(2,ja,je) = 9.76022
13704       b_mtem(3,ja,je) = -35.2540
13705       b_mtem(4,ja,je) = 71.2981
13706       b_mtem(5,ja,je) = -71.8207
13707       b_mtem(6,ja,je) = 28.0758
13708
13709 !
13710 ! in nh4hso4
13711       je = jnh4hso4
13712       b_mtem(1,ja,je) = -4.13219
13713       b_mtem(2,ja,je) = 13.8863
13714       b_mtem(3,ja,je) = -34.5387
13715       b_mtem(4,ja,je) = 56.5012
13716       b_mtem(5,ja,je) = -51.8702
13717       b_mtem(6,ja,je) = 19.6232
13718
13719 !
13720 ! in (nh4)3h(so4)2
13721       je = jlvcite
13722       b_mtem(1,ja,je) = -2.53482
13723       b_mtem(2,ja,je) = 12.3333
13724       b_mtem(3,ja,je) = -46.1020
13725       b_mtem(4,ja,je) = 90.4775
13726       b_mtem(5,ja,je) = -88.1254
13727       b_mtem(6,ja,je) = 33.4715
13728
13729 !
13730 ! in nahso4
13731       je = jnahso4
13732       b_mtem(1,ja,je) = -3.23425
13733       b_mtem(2,ja,je) = 18.7842
13734       b_mtem(3,ja,je) = -78.7807
13735       b_mtem(4,ja,je) = 161.517
13736       b_mtem(5,ja,je) = -154.940
13737       b_mtem(6,ja,je) = 56.2252
13738
13739 !
13740 ! in na3h(so4)2
13741       je = jna3hso4
13742       b_mtem(1,ja,je) = -1.25316
13743       b_mtem(2,ja,je) = 7.40960
13744       b_mtem(3,ja,je) = -34.8929
13745       b_mtem(4,ja,je) = 72.8853
13746       b_mtem(5,ja,je) = -72.4503
13747       b_mtem(6,ja,je) = 27.7706
13748
13749
13750 !-----------------
13751 ! nh4no3 in e
13752       ja = jnh4no3
13753
13754 ! in (nh4)2so4
13755       je = jnh4so4
13756       b_mtem(1,ja,je) = -3.5201
13757       b_mtem(2,ja,je) = 21.6584
13758       b_mtem(3,ja,je) = -72.1499
13759       b_mtem(4,ja,je) = 126.7000
13760       b_mtem(5,ja,je) = -111.4550
13761       b_mtem(6,ja,je) = 38.5677
13762
13763 ! in nh4no3
13764       je = jnh4no3
13765       b_mtem(1,ja,je) = -2.2630
13766       b_mtem(2,ja,je) = -0.1518
13767       b_mtem(3,ja,je) = 17.0898
13768       b_mtem(4,ja,je) = -36.7832
13769       b_mtem(5,ja,je) = 29.8407
13770       b_mtem(6,ja,je) = -7.9314
13771
13772 ! in nh4cl (revised on 11/15/2003)
13773       je = jnh4cl
13774       b_mtem(1,ja,je) = -1.3851
13775       b_mtem(2,ja,je) = -0.4462
13776       b_mtem(3,ja,je) = 8.4567
13777       b_mtem(4,ja,je) = -11.5988
13778       b_mtem(5,ja,je) = 2.9802
13779       b_mtem(6,ja,je) = 1.8132
13780
13781 ! in na2so4
13782       je = jna2so4
13783       b_mtem(1,ja,je) = -1.7602
13784       b_mtem(2,ja,je) = 10.4044
13785       b_mtem(3,ja,je) = -35.5894
13786       b_mtem(4,ja,je) = 64.3584
13787       b_mtem(5,ja,je) = -57.8931
13788       b_mtem(6,ja,je) = 20.2141
13789
13790 ! in nano3
13791       je = jnano3
13792       b_mtem(1,ja,je) = -3.24346
13793       b_mtem(2,ja,je) = 16.2794
13794       b_mtem(3,ja,je) = -48.7601
13795       b_mtem(4,ja,je) = 79.2246
13796       b_mtem(5,ja,je) = -65.8169
13797       b_mtem(6,ja,je) = 22.1500
13798
13799 ! in nacl
13800       je = jnacl
13801       b_mtem(1,ja,je) = -1.75658
13802       b_mtem(2,ja,je) = 7.71384
13803       b_mtem(3,ja,je) = -22.7984
13804       b_mtem(4,ja,je) = 39.1532
13805       b_mtem(5,ja,je) = -34.6165
13806       b_mtem(6,ja,je) = 12.1283
13807
13808 ! in ca(no3)2
13809       je = jcano3
13810       b_mtem(1,ja,je) = -0.97178
13811       b_mtem(2,ja,je) = 6.61964
13812       b_mtem(3,ja,je) = -26.2353
13813       b_mtem(4,ja,je) = 50.5259
13814       b_mtem(5,ja,je) = -47.6586
13815       b_mtem(6,ja,je) = 17.5074
13816
13817 ! in cacl2 added on 12/22/2003
13818       je = jcacl2
13819       b_mtem(1,ja,je) = -0.41515
13820       b_mtem(2,ja,je) = 6.44101
13821       b_mtem(3,ja,je) = -26.4473
13822       b_mtem(4,ja,je) = 49.0718
13823       b_mtem(5,ja,je) = -44.2631
13824       b_mtem(6,ja,je) = 15.3771
13825
13826 ! in hno3
13827       je = jhno3
13828       b_mtem(1,ja,je) = -1.20644
13829       b_mtem(2,ja,je) = 5.70117
13830       b_mtem(3,ja,je) = -18.2783
13831       b_mtem(4,ja,je) = 31.7199
13832       b_mtem(5,ja,je) = -27.8703
13833       b_mtem(6,ja,je) = 9.7299
13834
13835 ! in hcl
13836       je = jhcl
13837       b_mtem(1,ja,je) = -0.680862
13838       b_mtem(2,ja,je) = 3.59456
13839       b_mtem(3,ja,je) = -10.7969
13840       b_mtem(4,ja,je) = 17.8434
13841       b_mtem(5,ja,je) = -15.3165
13842       b_mtem(6,ja,je) = 5.17123
13843
13844
13845 !----------
13846 ! nh4cl in e
13847       ja = jnh4cl
13848
13849 ! in (nh4)2so4
13850       je = jnh4so4
13851       b_mtem(1,ja,je) = -2.8850
13852       b_mtem(2,ja,je) = 20.6970
13853       b_mtem(3,ja,je) = -70.6810
13854       b_mtem(4,ja,je) = 124.3690
13855       b_mtem(5,ja,je) = -109.2880
13856       b_mtem(6,ja,je) = 37.5831
13857
13858 ! in nh4no3
13859       je = jnh4no3
13860       b_mtem(1,ja,je) = -1.9386
13861       b_mtem(2,ja,je) = 1.3238
13862       b_mtem(3,ja,je) = 11.8500
13863       b_mtem(4,ja,je) = -28.1168
13864       b_mtem(5,ja,je) = 21.8543
13865       b_mtem(6,ja,je) = -5.1671
13866
13867 ! in nh4cl (revised on 11/15/2003)
13868       je = jnh4cl
13869       b_mtem(1,ja,je) = -0.9559
13870       b_mtem(2,ja,je) = 0.8121
13871       b_mtem(3,ja,je) = 4.3644
13872       b_mtem(4,ja,je) = -8.9258
13873       b_mtem(5,ja,je) = 4.2362
13874       b_mtem(6,ja,je) = 0.2891
13875
13876 ! in na2so4
13877       je = jna2so4
13878       b_mtem(1,ja,je) = 0.0377
13879       b_mtem(2,ja,je) = 6.0752
13880       b_mtem(3,ja,je) = -30.8641
13881       b_mtem(4,ja,je) = 63.3095
13882       b_mtem(5,ja,je) = -61.0070
13883       b_mtem(6,ja,je) = 22.1734
13884
13885 ! in nano3
13886       je = jnano3
13887       b_mtem(1,ja,je) = -1.8336
13888       b_mtem(2,ja,je) = 12.8160
13889       b_mtem(3,ja,je) = -42.3388
13890       b_mtem(4,ja,je) = 71.1816
13891       b_mtem(5,ja,je) = -60.5708
13892       b_mtem(6,ja,je) = 20.5853
13893
13894 ! in nacl
13895       je = jnacl
13896       b_mtem(1,ja,je) = -0.1429
13897       b_mtem(2,ja,je) = 2.3561
13898       b_mtem(3,ja,je) = -10.4425
13899       b_mtem(4,ja,je) = 20.8951
13900       b_mtem(5,ja,je) = -20.7739
13901       b_mtem(6,ja,je) = 7.9355
13902
13903 ! in ca(no3)2
13904       je = jcano3
13905       b_mtem(1,ja,je) = 0.76235
13906       b_mtem(2,ja,je) = 3.08323
13907       b_mtem(3,ja,je) = -23.6772
13908       b_mtem(4,ja,je) = 53.7415
13909       b_mtem(5,ja,je) = -55.4043
13910       b_mtem(6,ja,je) = 21.2944
13911
13912 ! in cacl2 (revised on 11/27/2003)
13913       je = jcacl2
13914       b_mtem(1,ja,je) = 1.13864
13915       b_mtem(2,ja,je) = -0.340539
13916       b_mtem(3,ja,je) = -8.67025
13917       b_mtem(4,ja,je) = 22.8008
13918       b_mtem(5,ja,je) = -24.5181
13919       b_mtem(6,ja,je) = 9.3663
13920
13921 ! in hno3
13922       je = jhno3
13923       b_mtem(1,ja,je) = 2.42532
13924       b_mtem(2,ja,je) = -14.1755
13925       b_mtem(3,ja,je) = 38.804
13926       b_mtem(4,ja,je) = -58.2437
13927       b_mtem(5,ja,je) = 43.5431
13928       b_mtem(6,ja,je) = -12.5824
13929
13930 ! in hcl
13931       je = jhcl
13932       b_mtem(1,ja,je) = 0.330337
13933       b_mtem(2,ja,je) = 0.0778934
13934       b_mtem(3,ja,je) = -2.30492
13935       b_mtem(4,ja,je) = 4.73003
13936       b_mtem(5,ja,je) = -4.80849
13937       b_mtem(6,ja,je) = 1.78866
13938
13939
13940 !----------
13941 ! na2so4 in e
13942       ja = jna2so4
13943
13944 ! in (nh4)2so4
13945       je = jnh4so4
13946       b_mtem(1,ja,je) = -2.6982
13947       b_mtem(2,ja,je) = 22.9875
13948       b_mtem(3,ja,je) = -98.9840
13949       b_mtem(4,ja,je) = 198.0180
13950       b_mtem(5,ja,je) = -188.7270
13951       b_mtem(6,ja,je) = 69.0548
13952
13953 ! in nh4no3
13954       je = jnh4no3
13955       b_mtem(1,ja,je) = -2.4844
13956       b_mtem(2,ja,je) = 6.5420
13957       b_mtem(3,ja,je) = -9.8998
13958       b_mtem(4,ja,je) = 11.3884
13959       b_mtem(5,ja,je) = -13.6842
13960       b_mtem(6,ja,je) = 7.7411
13961
13962 ! in nh4cl (revised on 11/15/2003)
13963       je = jnh4cl
13964       b_mtem(1,ja,je) = -1.3325
13965       b_mtem(2,ja,je) = 13.0406
13966       b_mtem(3,ja,je) = -56.1935
13967       b_mtem(4,ja,je) = 107.1170
13968       b_mtem(5,ja,je) = -97.3721
13969       b_mtem(6,ja,je) = 34.3763
13970
13971 ! in na2so4
13972       je = jna2so4
13973       b_mtem(1,ja,je) = -1.2832
13974       b_mtem(2,ja,je) = 12.8526
13975       b_mtem(3,ja,je) = -62.2087
13976       b_mtem(4,ja,je) = 130.3876
13977       b_mtem(5,ja,je) = -128.2627
13978       b_mtem(6,ja,je) = 48.0340
13979
13980 ! in nano3
13981       je = jnano3
13982       b_mtem(1,ja,je) = -3.5384
13983       b_mtem(2,ja,je) = 21.3758
13984       b_mtem(3,ja,je) = -70.7638
13985       b_mtem(4,ja,je) = 121.1580
13986       b_mtem(5,ja,je) = -104.6230
13987       b_mtem(6,ja,je) = 36.0557
13988
13989 ! in nacl
13990       je = jnacl
13991       b_mtem(1,ja,je) = 0.2175
13992       b_mtem(2,ja,je) = -0.5648
13993       b_mtem(3,ja,je) = -8.0288
13994       b_mtem(4,ja,je) = 25.9734
13995       b_mtem(5,ja,je) = -32.3577
13996       b_mtem(6,ja,je) = 14.3924
13997
13998 ! in hno3
13999       je = jhno3
14000       b_mtem(1,ja,je) = -0.309617
14001       b_mtem(2,ja,je) = -1.82899
14002       b_mtem(3,ja,je) = -1.5505
14003       b_mtem(4,ja,je) = 13.3847
14004       b_mtem(5,ja,je) = -20.1284
14005       b_mtem(6,ja,je) = 9.93163
14006
14007 ! in hcl
14008       je = jhcl
14009       b_mtem(1,ja,je) = -0.259455
14010       b_mtem(2,ja,je) = -0.819366
14011       b_mtem(3,ja,je) = -4.28964
14012       b_mtem(4,ja,je) = 16.4305
14013       b_mtem(5,ja,je) = -21.8546
14014       b_mtem(6,ja,je) = 10.3044
14015
14016 ! in h2so4
14017       je = jh2so4
14018       b_mtem(1,ja,je) = -1.84257
14019       b_mtem(2,ja,je) = 7.85788
14020       b_mtem(3,ja,je) = -29.9275
14021       b_mtem(4,ja,je) = 61.7515
14022       b_mtem(5,ja,je) = -63.2308
14023       b_mtem(6,ja,je) = 24.9542
14024
14025 ! in nh4hso4
14026       je = jnh4hso4
14027       b_mtem(1,ja,je) = -1.05891
14028       b_mtem(2,ja,je) = 2.84831
14029       b_mtem(3,ja,je) = -21.1827
14030       b_mtem(4,ja,je) = 57.5175
14031       b_mtem(5,ja,je) = -64.8120
14032       b_mtem(6,ja,je) = 26.1986
14033
14034 ! in (nh4)3h(so4)2
14035       je = jlvcite
14036       b_mtem(1,ja,je) = -1.16584
14037       b_mtem(2,ja,je) = 8.50075
14038       b_mtem(3,ja,je) = -44.3420
14039       b_mtem(4,ja,je) = 97.3974
14040       b_mtem(5,ja,je) = -98.4549
14041       b_mtem(6,ja,je) = 37.6104
14042
14043 ! in nahso4
14044       je = jnahso4
14045       b_mtem(1,ja,je) = -1.95805
14046       b_mtem(2,ja,je) = 6.62417
14047       b_mtem(3,ja,je) = -31.8072
14048       b_mtem(4,ja,je) = 77.8603
14049       b_mtem(5,ja,je) = -84.6458
14050       b_mtem(6,ja,je) = 33.4963
14051
14052 ! in na3h(so4)2
14053       je = jna3hso4
14054       b_mtem(1,ja,je) = -0.36045
14055       b_mtem(2,ja,je) = 3.55223
14056       b_mtem(3,ja,je) = -24.0327
14057       b_mtem(4,ja,je) = 54.4879
14058       b_mtem(5,ja,je) = -56.6531
14059       b_mtem(6,ja,je) = 22.4956
14060
14061
14062 !----------
14063 ! nano3 in e
14064       ja = jnano3
14065
14066 ! in (nh4)2so4
14067       je = jnh4so4
14068       b_mtem(1,ja,je) = -2.5888
14069       b_mtem(2,ja,je) = 17.6192
14070       b_mtem(3,ja,je) = -63.2183
14071       b_mtem(4,ja,je) = 115.3520
14072       b_mtem(5,ja,je) = -104.0860
14073       b_mtem(6,ja,je) = 36.7390
14074
14075 ! in nh4no3
14076       je = jnh4no3
14077       b_mtem(1,ja,je) = -2.0669
14078       b_mtem(2,ja,je) = 1.4792
14079       b_mtem(3,ja,je) = 10.5261
14080       b_mtem(4,ja,je) = -27.0987
14081       b_mtem(5,ja,je) = 23.0591
14082       b_mtem(6,ja,je) = -6.0938
14083
14084 ! in nh4cl (revised on 11/15/2003)
14085       je = jnh4cl
14086       b_mtem(1,ja,je) = -0.8325
14087       b_mtem(2,ja,je) = 3.9933
14088       b_mtem(3,ja,je) = -15.3789
14089       b_mtem(4,ja,je) = 30.4050
14090       b_mtem(5,ja,je) = -29.4204
14091       b_mtem(6,ja,je) = 11.0597
14092
14093 ! in na2so4
14094       je = jna2so4
14095       b_mtem(1,ja,je) = -1.1233
14096       b_mtem(2,ja,je) = 8.3998
14097       b_mtem(3,ja,je) = -31.9002
14098       b_mtem(4,ja,je) = 60.1450
14099       b_mtem(5,ja,je) = -55.5503
14100       b_mtem(6,ja,je) = 19.7757
14101
14102 ! in nano3
14103       je = jnano3
14104       b_mtem(1,ja,je) = -2.5386
14105       b_mtem(2,ja,je) = 13.9039
14106       b_mtem(3,ja,je) = -42.8467
14107       b_mtem(4,ja,je) = 69.7442
14108       b_mtem(5,ja,je) = -57.8988
14109       b_mtem(6,ja,je) = 19.4635
14110
14111 ! in nacl
14112       je = jnacl
14113       b_mtem(1,ja,je) = -0.4351
14114       b_mtem(2,ja,je) = 2.8311
14115       b_mtem(3,ja,je) = -11.4485
14116       b_mtem(4,ja,je) = 22.7201
14117       b_mtem(5,ja,je) = -22.4228
14118       b_mtem(6,ja,je) = 8.5792
14119
14120 ! in ca(no3)2
14121       je = jcano3
14122       b_mtem(1,ja,je) = -0.72060
14123       b_mtem(2,ja,je) = 5.64915
14124       b_mtem(3,ja,je) = -23.5020
14125       b_mtem(4,ja,je) = 46.0078
14126       b_mtem(5,ja,je) = -43.8075
14127       b_mtem(6,ja,je) = 16.1652
14128
14129 ! in cacl2
14130       je = jcacl2
14131       b_mtem(1,ja,je) = 0.003928
14132       b_mtem(2,ja,je) = 3.54724
14133       b_mtem(3,ja,je) = -18.6057
14134       b_mtem(4,ja,je) = 38.1445
14135       b_mtem(5,ja,je) = -36.7745
14136       b_mtem(6,ja,je) = 13.4529
14137
14138 ! in hno3
14139       je = jhno3
14140       b_mtem(1,ja,je) = -1.1712
14141       b_mtem(2,ja,je) = 7.20907
14142       b_mtem(3,ja,je) = -22.9215
14143       b_mtem(4,ja,je) = 38.1257
14144       b_mtem(5,ja,je) = -32.0759
14145       b_mtem(6,ja,je) = 10.6443
14146
14147 ! in hcl
14148       je = jhcl
14149       b_mtem(1,ja,je) = 0.738022
14150       b_mtem(2,ja,je) = -1.14313
14151       b_mtem(3,ja,je) = 0.32251
14152       b_mtem(4,ja,je) = 0.838679
14153       b_mtem(5,ja,je) = -1.81747
14154       b_mtem(6,ja,je) = 0.873986
14155
14156
14157 !----------
14158 ! nacl in e
14159       ja = jnacl
14160
14161 ! in (nh4)2so4
14162       je = jnh4so4
14163       b_mtem(1,ja,je) = -1.9525
14164       b_mtem(2,ja,je) = 16.6433
14165       b_mtem(3,ja,je) = -61.7090
14166       b_mtem(4,ja,je) = 112.9910
14167       b_mtem(5,ja,je) = -101.9370
14168       b_mtem(6,ja,je) = 35.7760
14169
14170 ! in nh4no3
14171       je = jnh4no3
14172       b_mtem(1,ja,je) = -1.7525
14173       b_mtem(2,ja,je) = 3.0713
14174       b_mtem(3,ja,je) = 4.8063
14175       b_mtem(4,ja,je) = -17.5334
14176       b_mtem(5,ja,je) = 14.2872
14177       b_mtem(6,ja,je) = -3.0690
14178
14179 ! in nh4cl (revised on 11/15/2003)
14180       je = jnh4cl
14181       b_mtem(1,ja,je) = -0.4021
14182       b_mtem(2,ja,je) = 5.2399
14183       b_mtem(3,ja,je) = -19.4278
14184       b_mtem(4,ja,je) = 33.0027
14185       b_mtem(5,ja,je) = -28.1020
14186       b_mtem(6,ja,je) = 9.5159
14187
14188 ! in na2so4
14189       je = jna2so4
14190       b_mtem(1,ja,je) = 0.6692
14191       b_mtem(2,ja,je) = 4.1207
14192       b_mtem(3,ja,je) = -27.3314
14193       b_mtem(4,ja,je) = 59.3112
14194       b_mtem(5,ja,je) = -58.7998
14195       b_mtem(6,ja,je) = 21.7674
14196
14197 ! in nano3
14198       je = jnano3
14199       b_mtem(1,ja,je) = -1.17444
14200       b_mtem(2,ja,je) = 10.9927
14201       b_mtem(3,ja,je) = -38.9013
14202       b_mtem(4,ja,je) = 66.8521
14203       b_mtem(5,ja,je) = -57.6564
14204       b_mtem(6,ja,je) = 19.7296
14205
14206 ! in nacl
14207       je = jnacl
14208       b_mtem(1,ja,je) = 1.17679
14209       b_mtem(2,ja,je) = -2.5061
14210       b_mtem(3,ja,je) = 0.8508
14211       b_mtem(4,ja,je) = 4.4802
14212       b_mtem(5,ja,je) = -8.4945
14213       b_mtem(6,ja,je) = 4.3182
14214
14215 ! in ca(no3)2
14216       je = jcano3
14217       b_mtem(1,ja,je) = 1.01450
14218       b_mtem(2,ja,je) = 2.10260
14219       b_mtem(3,ja,je) = -20.9036
14220       b_mtem(4,ja,je) = 49.1481
14221       b_mtem(5,ja,je) = -51.4867
14222       b_mtem(6,ja,je) = 19.9301
14223
14224 ! in cacl2 (psc92: revised on 11/27/2003)
14225       je = jcacl2
14226       b_mtem(1,ja,je) = 1.55463
14227       b_mtem(2,ja,je) = -3.20122
14228       b_mtem(3,ja,je) = -0.957075
14229       b_mtem(4,ja,je) = 12.103
14230       b_mtem(5,ja,je) = -17.221
14231       b_mtem(6,ja,je) = 7.50264
14232
14233 ! in hno3
14234       je = jhno3
14235       b_mtem(1,ja,je) = 2.46187
14236       b_mtem(2,ja,je) = -12.6845
14237       b_mtem(3,ja,je) = 34.2383
14238       b_mtem(4,ja,je) = -51.9992
14239       b_mtem(5,ja,je) = 39.4934
14240       b_mtem(6,ja,je) = -11.7247
14241
14242 ! in hcl
14243       je = jhcl
14244       b_mtem(1,ja,je) = 1.74915
14245       b_mtem(2,ja,je) = -4.65768
14246       b_mtem(3,ja,je) = 8.80287
14247       b_mtem(4,ja,je) = -12.2503
14248       b_mtem(5,ja,je) = 8.668751
14249       b_mtem(6,ja,je) = -2.50158
14250
14251
14252 !----------
14253 ! ca(no3)2 in e
14254       ja = jcano3
14255
14256 ! in nh4no3
14257       je = jnh4no3
14258       b_mtem(1,ja,je) = -1.86260
14259       b_mtem(2,ja,je) = 11.6178
14260       b_mtem(3,ja,je) = -30.9069
14261       b_mtem(4,ja,je) = 41.7578
14262       b_mtem(5,ja,je) = -33.7338
14263       b_mtem(6,ja,je) = 12.7541
14264
14265 ! in nh4cl (revised on 11/15/2003)
14266       je = jnh4cl
14267       b_mtem(1,ja,je) = -1.1798
14268       b_mtem(2,ja,je) = 25.9608
14269       b_mtem(3,ja,je) = -98.9373
14270       b_mtem(4,ja,je) = 160.2300
14271       b_mtem(5,ja,je) = -125.9540
14272       b_mtem(6,ja,je) = 39.5130
14273
14274 ! in nano3
14275       je = jnano3
14276       b_mtem(1,ja,je) = -1.44384
14277       b_mtem(2,ja,je) = 13.6044
14278       b_mtem(3,ja,je) = -54.4300
14279       b_mtem(4,ja,je) = 100.582
14280       b_mtem(5,ja,je) = -91.2364
14281       b_mtem(6,ja,je) = 32.5970
14282
14283 ! in nacl
14284       je = jnacl
14285       b_mtem(1,ja,je) = -0.099114
14286       b_mtem(2,ja,je) = 2.84091
14287       b_mtem(3,ja,je) = -16.9229
14288       b_mtem(4,ja,je) = 37.4839
14289       b_mtem(5,ja,je) = -39.5132
14290       b_mtem(6,ja,je) = 15.8564
14291
14292 ! in ca(no3)2
14293       je = jcano3
14294       b_mtem(1,ja,je) = 0.055116
14295       b_mtem(2,ja,je) = 4.58610
14296       b_mtem(3,ja,je) = -27.6629
14297       b_mtem(4,ja,je) = 60.8288
14298       b_mtem(5,ja,je) = -61.4988
14299       b_mtem(6,ja,je) = 23.3136
14300
14301 ! in cacl2 (psc92: revised on 11/27/2003)
14302       je = jcacl2
14303       b_mtem(1,ja,je) = 1.57155
14304       b_mtem(2,ja,je) = -3.18486
14305       b_mtem(3,ja,je) = -3.35758
14306       b_mtem(4,ja,je) = 18.7501
14307       b_mtem(5,ja,je) = -24.5604
14308       b_mtem(6,ja,je) = 10.3798
14309
14310 ! in hno3
14311       je = jhno3
14312       b_mtem(1,ja,je) = 1.04446
14313       b_mtem(2,ja,je) = -3.19066
14314       b_mtem(3,ja,je) = 2.44714
14315       b_mtem(4,ja,je) = 2.07218
14316       b_mtem(5,ja,je) = -6.43949
14317       b_mtem(6,ja,je) = 3.66471
14318
14319 ! in hcl
14320       je = jhcl
14321       b_mtem(1,ja,je) = 1.05723
14322       b_mtem(2,ja,je) = -1.46826
14323       b_mtem(3,ja,je) = -1.0713
14324       b_mtem(4,ja,je) = 4.64439
14325       b_mtem(5,ja,je) = -6.32402
14326       b_mtem(6,ja,je) = 2.78202
14327
14328
14329 !----------
14330 ! cacl2 in e
14331       ja = jcacl2
14332
14333 ! in nh4no3 (psc92: revised on 12/22/2003)
14334       je = jnh4no3
14335       b_mtem(1,ja,je) = -1.43626
14336       b_mtem(2,ja,je) = 13.6598
14337       b_mtem(3,ja,je) = -38.2068
14338       b_mtem(4,ja,je) = 53.9057
14339       b_mtem(5,ja,je) = -44.9018
14340       b_mtem(6,ja,je) = 16.6120
14341
14342 ! in nh4cl (psc92: revised on 11/27/2003)
14343       je = jnh4cl
14344       b_mtem(1,ja,je) = -0.603965
14345       b_mtem(2,ja,je) = 27.6027
14346       b_mtem(3,ja,je) = -104.258
14347       b_mtem(4,ja,je) = 163.553
14348       b_mtem(5,ja,je) = -124.076
14349       b_mtem(6,ja,je) = 37.4153
14350
14351 ! in nano3 (psc92: revised on 12/22/2003)
14352       je = jnano3
14353       b_mtem(1,ja,je) = 0.44648
14354       b_mtem(2,ja,je) = 8.8850
14355       b_mtem(3,ja,je) = -45.5232
14356       b_mtem(4,ja,je) = 89.3263
14357       b_mtem(5,ja,je) = -83.8604
14358       b_mtem(6,ja,je) = 30.4069
14359
14360 ! in nacl (psc92: revised on 11/27/2003)
14361       je = jnacl
14362       b_mtem(1,ja,je) = 1.61927
14363       b_mtem(2,ja,je) = 0.247547
14364       b_mtem(3,ja,je) = -18.1252
14365       b_mtem(4,ja,je) = 45.2479
14366       b_mtem(5,ja,je) = -48.6072
14367       b_mtem(6,ja,je) = 19.2784
14368
14369 ! in ca(no3)2 (psc92: revised on 11/27/2003)
14370       je = jcano3
14371       b_mtem(1,ja,je) = 2.36667
14372       b_mtem(2,ja,je) = -0.123309
14373       b_mtem(3,ja,je) = -24.2723
14374       b_mtem(4,ja,je) = 65.1486
14375       b_mtem(5,ja,je) = -71.8504
14376       b_mtem(6,ja,je) = 28.3696
14377
14378 ! in cacl2 (psc92: revised on 11/27/2003)
14379       je = jcacl2
14380       b_mtem(1,ja,je) = 3.64023
14381       b_mtem(2,ja,je) = -12.1926
14382       b_mtem(3,ja,je) = 20.2028
14383       b_mtem(4,ja,je) = -16.0056
14384       b_mtem(5,ja,je) = 1.52355
14385       b_mtem(6,ja,je) = 2.44709
14386
14387 ! in hno3
14388       je = jhno3
14389       b_mtem(1,ja,je) = 5.88794
14390       b_mtem(2,ja,je) = -29.7083
14391       b_mtem(3,ja,je) = 78.6309
14392       b_mtem(4,ja,je) = -118.037
14393       b_mtem(5,ja,je) = 88.932
14394       b_mtem(6,ja,je) = -26.1407
14395
14396 ! in hcl
14397       je = jhcl
14398       b_mtem(1,ja,je) = 2.40628
14399       b_mtem(2,ja,je) = -6.16566
14400       b_mtem(3,ja,je) = 10.2851
14401       b_mtem(4,ja,je) = -12.9035
14402       b_mtem(5,ja,je) = 7.7441
14403       b_mtem(6,ja,je) = -1.74821
14404
14405
14406 !----------
14407 ! hno3 in e
14408       ja = jhno3
14409
14410 ! in (nh4)2so4
14411       je = jnh4so4
14412       b_mtem(1,ja,je) = -3.57598
14413       b_mtem(2,ja,je) = 21.5469
14414       b_mtem(3,ja,je) = -77.4111
14415       b_mtem(4,ja,je) = 144.136
14416       b_mtem(5,ja,je) = -132.849
14417       b_mtem(6,ja,je) = 47.9412
14418
14419 ! in nh4no3
14420       je = jnh4no3
14421       b_mtem(1,ja,je) = -2.00209
14422       b_mtem(2,ja,je) = -3.48399
14423       b_mtem(3,ja,je) = 34.9906
14424       b_mtem(4,ja,je) = -68.6653
14425       b_mtem(5,ja,je) = 54.0992
14426       b_mtem(6,ja,je) = -15.1343
14427
14428 ! in nh4cl revised on 12/22/2003
14429       je = jnh4cl
14430       b_mtem(1,ja,je) = -0.63790
14431       b_mtem(2,ja,je) = -1.67730
14432       b_mtem(3,ja,je) = 10.1727
14433       b_mtem(4,ja,je) = -14.9097
14434       b_mtem(5,ja,je) = 7.67410
14435       b_mtem(6,ja,je) = -0.79586
14436
14437 ! in nacl
14438       je = jnacl
14439       b_mtem(1,ja,je) = 1.3446
14440       b_mtem(2,ja,je) = -2.5578
14441       b_mtem(3,ja,je) = 1.3464
14442       b_mtem(4,ja,je) = 2.90537
14443       b_mtem(5,ja,je) = -6.53014
14444       b_mtem(6,ja,je) = 3.31339
14445
14446 ! in nano3
14447       je = jnano3
14448       b_mtem(1,ja,je) = -0.546636
14449       b_mtem(2,ja,je) = 10.3127
14450       b_mtem(3,ja,je) = -39.9603
14451       b_mtem(4,ja,je) = 71.4609
14452       b_mtem(5,ja,je) = -63.4958
14453       b_mtem(6,ja,je) = 22.0679
14454
14455 ! in na2so4
14456       je = jna2so4
14457       b_mtem(1,ja,je) = 1.35059
14458       b_mtem(2,ja,je) = 4.34557
14459       b_mtem(3,ja,je) = -35.8425
14460       b_mtem(4,ja,je) = 80.9868
14461       b_mtem(5,ja,je) = -81.6544
14462       b_mtem(6,ja,je) = 30.4841
14463
14464 ! in ca(no3)2
14465       je = jcano3
14466       b_mtem(1,ja,je) = 0.869414
14467       b_mtem(2,ja,je) = 2.98486
14468       b_mtem(3,ja,je) = -22.255
14469       b_mtem(4,ja,je) = 50.1863
14470       b_mtem(5,ja,je) = -51.214
14471       b_mtem(6,ja,je) = 19.2235
14472
14473 ! in cacl2 (km) revised on 12/22/2003
14474       je = jcacl2
14475       b_mtem(1,ja,je) = 1.42800
14476       b_mtem(2,ja,je) = -1.78959
14477       b_mtem(3,ja,je) = -2.49075
14478       b_mtem(4,ja,je) = 10.1877
14479       b_mtem(5,ja,je) = -12.1948
14480       b_mtem(6,ja,je) = 4.64475
14481
14482 ! in hno3 (added on 12/06/2004)
14483       je = jhno3
14484       b_mtem(1,ja,je) = 0.22035
14485       b_mtem(2,ja,je) = 2.94973
14486       b_mtem(3,ja,je) = -12.1469
14487       b_mtem(4,ja,je) = 20.4905
14488       b_mtem(5,ja,je) = -17.3966
14489       b_mtem(6,ja,je) = 5.70779
14490
14491 ! in hcl (added on 12/06/2004)
14492       je = jhcl
14493       b_mtem(1,ja,je) = 1.55503
14494       b_mtem(2,ja,je) = -3.61226
14495       b_mtem(3,ja,je) = 6.28265
14496       b_mtem(4,ja,je) = -8.69575
14497       b_mtem(5,ja,je) = 6.09372
14498       b_mtem(6,ja,je) = -1.80898
14499
14500 ! in h2so4
14501       je = jh2so4
14502       b_mtem(1,ja,je) = 1.10783
14503       b_mtem(2,ja,je) = -1.3363
14504       b_mtem(3,ja,je) = -1.83525
14505       b_mtem(4,ja,je) = 7.47373
14506       b_mtem(5,ja,je) = -9.72954
14507       b_mtem(6,ja,je) = 4.12248
14508
14509 ! in nh4hso4
14510       je = jnh4hso4
14511       b_mtem(1,ja,je) = -0.851026
14512       b_mtem(2,ja,je) = 12.2515
14513       b_mtem(3,ja,je) = -49.788
14514       b_mtem(4,ja,je) = 91.6215
14515       b_mtem(5,ja,je) = -81.4877
14516       b_mtem(6,ja,je) = 28.0002
14517
14518 ! in (nh4)3h(so4)2
14519       je = jlvcite
14520       b_mtem(1,ja,je) = -3.09464
14521       b_mtem(2,ja,je) = 14.9303
14522       b_mtem(3,ja,je) = -43.0454
14523       b_mtem(4,ja,je) = 72.6695
14524       b_mtem(5,ja,je) = -65.2140
14525       b_mtem(6,ja,je) = 23.4814
14526
14527 ! in nahso4
14528       je = jnahso4
14529       b_mtem(1,ja,je) = 1.22973
14530       b_mtem(2,ja,je) = 2.82702
14531       b_mtem(3,ja,je) = -17.5869
14532       b_mtem(4,ja,je) = 28.9564
14533       b_mtem(5,ja,je) = -23.5814
14534       b_mtem(6,ja,je) = 7.91153
14535
14536 ! in na3h(so4)2
14537       je = jna3hso4
14538       b_mtem(1,ja,je) = 1.64773
14539       b_mtem(2,ja,je) = 0.94188
14540       b_mtem(3,ja,je) = -19.1242
14541       b_mtem(4,ja,je) = 46.9887
14542       b_mtem(5,ja,je) = -50.9494
14543       b_mtem(6,ja,je) = 20.2169
14544
14545
14546 !----------
14547 ! hcl in e
14548       ja = jhcl
14549
14550 ! in (nh4)2so4
14551       je = jnh4so4
14552       b_mtem(1,ja,je) = -2.93783
14553       b_mtem(2,ja,je) = 20.5546
14554       b_mtem(3,ja,je) = -75.8548
14555       b_mtem(4,ja,je) = 141.729
14556       b_mtem(5,ja,je) = -130.697
14557       b_mtem(6,ja,je) = 46.9905
14558
14559 ! in nh4no3
14560       je = jnh4no3
14561       b_mtem(1,ja,je) = -1.69063
14562       b_mtem(2,ja,je) = -1.85303
14563       b_mtem(3,ja,je) = 29.0927
14564       b_mtem(4,ja,je) = -58.7401
14565       b_mtem(5,ja,je) = 44.999
14566       b_mtem(6,ja,je) = -11.9988
14567
14568 ! in nh4cl (revised on 11/15/2003)
14569       je = jnh4cl
14570       b_mtem(1,ja,je) = -0.2073
14571       b_mtem(2,ja,je) = -0.4322
14572       b_mtem(3,ja,je) = 6.1271
14573       b_mtem(4,ja,je) = -12.3146
14574       b_mtem(5,ja,je) = 8.9919
14575       b_mtem(6,ja,je) = -2.3388
14576
14577 ! in nacl
14578       je = jnacl
14579       b_mtem(1,ja,je) = 2.95913
14580       b_mtem(2,ja,je) = -7.92254
14581       b_mtem(3,ja,je) = 13.736
14582       b_mtem(4,ja,je) = -15.433
14583       b_mtem(5,ja,je) = 7.40386
14584       b_mtem(6,ja,je) = -0.918641
14585
14586 ! in nano3
14587       je = jnano3
14588       b_mtem(1,ja,je) = 0.893272
14589       b_mtem(2,ja,je) = 6.53768
14590       b_mtem(3,ja,je) = -32.3458
14591       b_mtem(4,ja,je) = 61.2834
14592       b_mtem(5,ja,je) = -56.4446
14593       b_mtem(6,ja,je) = 19.9202
14594
14595 ! in na2so4
14596       je = jna2so4
14597       b_mtem(1,ja,je) = 3.14484
14598       b_mtem(2,ja,je) = 0.077019
14599       b_mtem(3,ja,je) = -31.4199
14600       b_mtem(4,ja,je) = 80.5865
14601       b_mtem(5,ja,je) = -85.392
14602       b_mtem(6,ja,je) = 32.6644
14603
14604 ! in ca(no3)2
14605       je = jcano3
14606       b_mtem(1,ja,je) = 2.60432
14607       b_mtem(2,ja,je) = -0.55909
14608       b_mtem(3,ja,je) = -19.6671
14609       b_mtem(4,ja,je) = 53.3446
14610       b_mtem(5,ja,je) = -58.9076
14611       b_mtem(6,ja,je) = 22.9927
14612
14613 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
14614       je = jcacl2
14615       b_mtem(1,ja,je) = 2.98036
14616       b_mtem(2,ja,je) = -8.55365
14617       b_mtem(3,ja,je) = 15.2108
14618       b_mtem(4,ja,je) = -15.9359
14619       b_mtem(5,ja,je) = 7.41772
14620       b_mtem(6,ja,je) = -1.32143
14621
14622 ! in hno3 (added on 12/06/2004)
14623       je = jhno3
14624       b_mtem(1,ja,je) = 3.8533
14625       b_mtem(2,ja,je) = -16.9427
14626       b_mtem(3,ja,je) = 45.0056
14627       b_mtem(4,ja,je) = -69.6145
14628       b_mtem(5,ja,je) = 54.1491
14629       b_mtem(6,ja,je) = -16.6513
14630
14631 ! in hcl (added on 12/06/2004)
14632       je = jhcl
14633       b_mtem(1,ja,je) = 2.56665
14634       b_mtem(2,ja,je) = -7.13585
14635       b_mtem(3,ja,je) = 14.8103
14636       b_mtem(4,ja,je) = -21.8881
14637       b_mtem(5,ja,je) = 16.6808
14638       b_mtem(6,ja,je) = -5.22091
14639
14640 ! in h2so4
14641       je = jh2so4
14642       b_mtem(1,ja,je) = 2.50179
14643       b_mtem(2,ja,je) = -6.69364
14644       b_mtem(3,ja,je) = 11.6551
14645       b_mtem(4,ja,je) = -13.6897
14646       b_mtem(5,ja,je) = 7.36796
14647       b_mtem(6,ja,je) = -1.33245
14648
14649 ! in nh4hso4
14650       je = jnh4hso4
14651       b_mtem(1,ja,je) = 0.149955
14652       b_mtem(2,ja,je) = 11.8213
14653       b_mtem(3,ja,je) = -53.9164
14654       b_mtem(4,ja,je) = 101.574
14655       b_mtem(5,ja,je) = -91.4123
14656       b_mtem(6,ja,je) = 31.5487
14657
14658 ! in (nh4)3h(so4)2
14659       je = jlvcite
14660       b_mtem(1,ja,je) = -2.36927
14661       b_mtem(2,ja,je) = 14.8359
14662       b_mtem(3,ja,je) = -44.3443
14663       b_mtem(4,ja,je) = 73.6229
14664       b_mtem(5,ja,je) = -65.3366
14665       b_mtem(6,ja,je) = 23.3250
14666
14667 ! in nahso4
14668       je = jnahso4
14669       b_mtem(1,ja,je) = 2.72993
14670       b_mtem(2,ja,je) = -0.23406
14671       b_mtem(3,ja,je) = -10.4103
14672       b_mtem(4,ja,je) = 13.1586
14673       b_mtem(5,ja,je) = -7.79925
14674       b_mtem(6,ja,je) = 2.30843
14675
14676 ! in na3h(so4)2
14677       je = jna3hso4
14678       b_mtem(1,ja,je) = 3.51258
14679       b_mtem(2,ja,je) = -3.95107
14680       b_mtem(3,ja,je) = -11.0175
14681       b_mtem(4,ja,je) = 38.8617
14682       b_mtem(5,ja,je) = -48.1575
14683       b_mtem(6,ja,je) = 20.4717
14684
14685
14686 !----------
14687 ! 2h.so4 in e
14688       ja = jh2so4
14689
14690 ! in h2so4
14691       je = jh2so4
14692       b_mtem(1,ja,je) = 0.76734
14693       b_mtem(2,ja,je) = -1.12263
14694       b_mtem(3,ja,je) = -9.08728
14695       b_mtem(4,ja,je) = 30.3836
14696       b_mtem(5,ja,je) = -38.4133
14697       b_mtem(6,ja,je) = 17.0106
14698
14699 ! in nh4hso4
14700       je = jnh4hso4
14701       b_mtem(1,ja,je) = -2.03879
14702       b_mtem(2,ja,je) = 15.7033
14703       b_mtem(3,ja,je) = -58.7363
14704       b_mtem(4,ja,je) = 109.242
14705       b_mtem(5,ja,je) = -102.237
14706       b_mtem(6,ja,je) = 37.5350
14707
14708 ! in (nh4)3h(so4)2
14709       je = jlvcite
14710       b_mtem(1,ja,je) = -3.10228
14711       b_mtem(2,ja,je) = 16.6920
14712       b_mtem(3,ja,je) = -59.1522
14713       b_mtem(4,ja,je) = 113.487
14714       b_mtem(5,ja,je) = -110.890
14715       b_mtem(6,ja,je) = 42.4578
14716
14717 ! in (nh4)2so4
14718       je = jnh4so4
14719       b_mtem(1,ja,je) = -3.43885
14720       b_mtem(2,ja,je) = 21.0372
14721       b_mtem(3,ja,je) = -84.7026
14722       b_mtem(4,ja,je) = 165.324
14723       b_mtem(5,ja,je) = -156.101
14724       b_mtem(6,ja,je) = 57.3101
14725
14726 ! in nahso4
14727       je = jnahso4
14728       b_mtem(1,ja,je) = 0.33164
14729       b_mtem(2,ja,je) = 6.55864
14730       b_mtem(3,ja,je) = -33.5876
14731       b_mtem(4,ja,je) = 65.1798
14732       b_mtem(5,ja,je) = -63.2046
14733       b_mtem(6,ja,je) = 24.1783
14734
14735 ! in na3h(so4)2
14736       je = jna3hso4
14737       b_mtem(1,ja,je) = 3.06830
14738       b_mtem(2,ja,je) = -3.18408
14739       b_mtem(3,ja,je) = -19.6332
14740       b_mtem(4,ja,je) = 61.3657
14741       b_mtem(5,ja,je) = -73.4438
14742       b_mtem(6,ja,je) = 31.2334
14743
14744 ! in na2so4
14745       je = jna2so4
14746       b_mtem(1,ja,je) = 2.58649
14747       b_mtem(2,ja,je) = 0.87921
14748       b_mtem(3,ja,je) = -39.3023
14749       b_mtem(4,ja,je) = 101.603
14750       b_mtem(5,ja,je) = -109.469
14751       b_mtem(6,ja,je) = 43.0188
14752
14753 ! in hno3
14754       je = jhno3
14755       b_mtem(1,ja,je) = 1.54587
14756       b_mtem(2,ja,je) = -7.50976
14757       b_mtem(3,ja,je) = 12.8237
14758       b_mtem(4,ja,je) = -10.1452
14759       b_mtem(5,ja,je) = -0.541956
14760       b_mtem(6,ja,je) = 3.34536
14761
14762 ! in hcl
14763       je = jhcl
14764       b_mtem(1,ja,je) = 0.829757
14765       b_mtem(2,ja,je) = -4.11316
14766       b_mtem(3,ja,je) = 3.67111
14767       b_mtem(4,ja,je) = 3.6833
14768       b_mtem(5,ja,je) = -11.2711
14769       b_mtem(6,ja,je) = 6.71421
14770
14771
14772 !----------
14773 ! h.hso4 in e
14774       ja = jhhso4
14775
14776 ! in h2so4
14777       je = jh2so4
14778       b_mtem(1,ja,je) = 2.63953
14779       b_mtem(2,ja,je) = -6.01532
14780       b_mtem(3,ja,je) = 10.0204
14781       b_mtem(4,ja,je) = -12.4840
14782       b_mtem(5,ja,je) = 7.78853
14783       b_mtem(6,ja,je) = -2.12638
14784
14785 ! in nh4hso4
14786       je = jnh4hso4
14787       b_mtem(1,ja,je) = -0.77412
14788       b_mtem(2,ja,je) = 14.1656
14789       b_mtem(3,ja,je) = -53.4087
14790       b_mtem(4,ja,je) = 93.2013
14791       b_mtem(5,ja,je) = -80.5723
14792       b_mtem(6,ja,je) = 27.1577
14793
14794 ! in (nh4)3h(so4)2
14795       je = jlvcite
14796       b_mtem(1,ja,je) = -2.98882
14797       b_mtem(2,ja,je) = 14.4436
14798       b_mtem(3,ja,je) = -40.1774
14799       b_mtem(4,ja,je) = 67.5937
14800       b_mtem(5,ja,je) = -61.5040
14801       b_mtem(6,ja,je) = 22.3695
14802
14803 ! in (nh4)2so4
14804       je = jnh4so4
14805       b_mtem(1,ja,je) = -1.15502
14806       b_mtem(2,ja,je) = 8.12309
14807       b_mtem(3,ja,je) = -38.4726
14808       b_mtem(4,ja,je) = 80.8861
14809       b_mtem(5,ja,je) = -80.1644
14810       b_mtem(6,ja,je) = 30.4717
14811
14812 ! in nahso4
14813       je = jnahso4
14814       b_mtem(1,ja,je) = 1.99641
14815       b_mtem(2,ja,je) = -2.96061
14816       b_mtem(3,ja,je) = 5.54778
14817       b_mtem(4,ja,je) = -14.5488
14818       b_mtem(5,ja,je) = 14.8492
14819       b_mtem(6,ja,je) = -5.1389
14820
14821 ! in na3h(so4)2
14822       je = jna3hso4
14823       b_mtem(1,ja,je) = 2.23816
14824       b_mtem(2,ja,je) = -3.20847
14825       b_mtem(3,ja,je) = -4.82853
14826       b_mtem(4,ja,je) = 20.9192
14827       b_mtem(5,ja,je) = -27.2819
14828       b_mtem(6,ja,je) = 11.8655
14829
14830 ! in na2so4
14831       je = jna2so4
14832       b_mtem(1,ja,je) = 2.56907
14833       b_mtem(2,ja,je) = 1.13444
14834       b_mtem(3,ja,je) = -34.6853
14835       b_mtem(4,ja,je) = 87.9775
14836       b_mtem(5,ja,je) = -93.2330
14837       b_mtem(6,ja,je) = 35.9260
14838
14839 ! in hno3
14840       je = jhno3
14841       b_mtem(1,ja,je) = 2.00024
14842       b_mtem(2,ja,je) = -4.80868
14843       b_mtem(3,ja,je) = 8.29222
14844       b_mtem(4,ja,je) = -11.0849
14845       b_mtem(5,ja,je) = 7.51262
14846       b_mtem(6,ja,je) = -2.07654
14847
14848 ! in hcl
14849       je = jhcl
14850       b_mtem(1,ja,je) = 2.8009
14851       b_mtem(2,ja,je) = -6.98416
14852       b_mtem(3,ja,je) = 14.3146
14853       b_mtem(4,ja,je) = -22.0068
14854       b_mtem(5,ja,je) = 17.5557
14855       b_mtem(6,ja,je) = -5.84917
14856
14857
14858 !----------
14859 ! nh4hso4 in e
14860       ja = jnh4hso4
14861
14862 ! in h2so4
14863       je = jh2so4
14864       b_mtem(1,ja,je) = 0.169160
14865       b_mtem(2,ja,je) = 2.15094
14866       b_mtem(3,ja,je) = -9.62904
14867       b_mtem(4,ja,je) = 18.2631
14868       b_mtem(5,ja,je) = -17.3333
14869       b_mtem(6,ja,je) = 6.19835
14870
14871 ! in nh4hso4
14872       je = jnh4hso4
14873       b_mtem(1,ja,je) = -2.34457
14874       b_mtem(2,ja,je) = 12.8035
14875       b_mtem(3,ja,je) = -35.2513
14876       b_mtem(4,ja,je) = 53.6153
14877       b_mtem(5,ja,je) = -42.7655
14878       b_mtem(6,ja,je) = 13.7129
14879
14880 ! in (nh4)3h(so4)2
14881       je = jlvcite
14882       b_mtem(1,ja,je) = -2.56109
14883       b_mtem(2,ja,je) = 11.1414
14884       b_mtem(3,ja,je) = -30.2361
14885       b_mtem(4,ja,je) = 50.0320
14886       b_mtem(5,ja,je) = -44.1586
14887       b_mtem(6,ja,je) = 15.5393
14888
14889 ! in (nh4)2so4
14890       je = jnh4so4
14891       b_mtem(1,ja,je) = -0.97315
14892       b_mtem(2,ja,je) = 7.06295
14893       b_mtem(3,ja,je) = -29.3032
14894       b_mtem(4,ja,je) = 57.6101
14895       b_mtem(5,ja,je) = -54.9020
14896       b_mtem(6,ja,je) = 20.2222
14897
14898 ! in nahso4
14899       je = jnahso4
14900       b_mtem(1,ja,je) = -0.44450
14901       b_mtem(2,ja,je) = 3.33451
14902       b_mtem(3,ja,je) = -15.2791
14903       b_mtem(4,ja,je) = 30.1413
14904       b_mtem(5,ja,je) = -26.7710
14905       b_mtem(6,ja,je) = 8.78462
14906
14907 ! in na3h(so4)2
14908       je = jna3hso4
14909       b_mtem(1,ja,je) = -0.99780
14910       b_mtem(2,ja,je) = 4.69200
14911       b_mtem(3,ja,je) = -16.1219
14912       b_mtem(4,ja,je) = 29.3100
14913       b_mtem(5,ja,je) = -26.3383
14914       b_mtem(6,ja,je) = 9.20695
14915
14916 ! in na2so4
14917       je = jna2so4
14918       b_mtem(1,ja,je) = -0.52694
14919       b_mtem(2,ja,je) = 7.02684
14920       b_mtem(3,ja,je) = -33.7508
14921       b_mtem(4,ja,je) = 70.0565
14922       b_mtem(5,ja,je) = -68.3226
14923       b_mtem(6,ja,je) = 25.2692
14924
14925 ! in hno3
14926       je = jhno3
14927       b_mtem(1,ja,je) = 0.572926
14928       b_mtem(2,ja,je) = -2.04791
14929       b_mtem(3,ja,je) = 2.1134
14930       b_mtem(4,ja,je) = 0.246654
14931       b_mtem(5,ja,je) = -3.06019
14932       b_mtem(6,ja,je) = 1.98126
14933
14934 ! in hcl
14935       je = jhcl
14936       b_mtem(1,ja,je) = 0.56514
14937       b_mtem(2,ja,je) = 0.22287
14938       b_mtem(3,ja,je) = -2.76973
14939       b_mtem(4,ja,je) = 4.54444
14940       b_mtem(5,ja,je) = -3.86549
14941       b_mtem(6,ja,je) = 1.13441
14942
14943
14944 !----------
14945 ! (nh4)3h(so4)2 in e
14946       ja = jlvcite
14947
14948 ! in h2so4
14949       je = jh2so4
14950       b_mtem(1,ja,je) = -1.44811
14951       b_mtem(2,ja,je) = 6.71815
14952       b_mtem(3,ja,je) = -25.0141
14953       b_mtem(4,ja,je) = 50.1109
14954       b_mtem(5,ja,je) = -50.0561
14955       b_mtem(6,ja,je) = 19.3370
14956
14957 ! in nh4hso4
14958       je = jnh4hso4
14959       b_mtem(1,ja,je) = -3.41707
14960       b_mtem(2,ja,je) = 13.4496
14961       b_mtem(3,ja,je) = -34.8018
14962       b_mtem(4,ja,je) = 55.2987
14963       b_mtem(5,ja,je) = -48.1839
14964       b_mtem(6,ja,je) = 17.2444
14965
14966 ! in (nh4)3h(so4)2
14967       je = jlvcite
14968       b_mtem(1,ja,je) = -2.54479
14969       b_mtem(2,ja,je) = 11.8501
14970       b_mtem(3,ja,je) = -39.7286
14971       b_mtem(4,ja,je) = 74.2479
14972       b_mtem(5,ja,je) = -70.4934
14973       b_mtem(6,ja,je) = 26.2836
14974
14975 ! in (nh4)2so4
14976       je = jnh4so4
14977       b_mtem(1,ja,je) = -2.30561
14978       b_mtem(2,ja,je) = 14.5806
14979       b_mtem(3,ja,je) = -55.1238
14980       b_mtem(4,ja,je) = 103.451
14981       b_mtem(5,ja,je) = -95.2571
14982       b_mtem(6,ja,je) = 34.2218
14983
14984 ! in nahso4
14985       je = jnahso4
14986       b_mtem(1,ja,je) = -2.20809
14987       b_mtem(2,ja,je) = 13.6391
14988       b_mtem(3,ja,je) = -57.8246
14989       b_mtem(4,ja,je) = 117.907
14990       b_mtem(5,ja,je) = -112.154
14991       b_mtem(6,ja,je) = 40.3058
14992
14993 ! in na3h(so4)2
14994       je = jna3hso4
14995       b_mtem(1,ja,je) = -1.15099
14996       b_mtem(2,ja,je) = 6.32269
14997       b_mtem(3,ja,je) = -27.3860
14998       b_mtem(4,ja,je) = 55.4592
14999       b_mtem(5,ja,je) = -54.0100
15000       b_mtem(6,ja,je) = 20.3469
15001
15002 ! in na2so4
15003       je = jna2so4
15004       b_mtem(1,ja,je) = -1.15678
15005       b_mtem(2,ja,je) = 8.28718
15006       b_mtem(3,ja,je) = -37.3231
15007       b_mtem(4,ja,je) = 76.6124
15008       b_mtem(5,ja,je) = -74.9307
15009       b_mtem(6,ja,je) = 28.0559
15010
15011 ! in hno3
15012       je = jhno3
15013       b_mtem(1,ja,je) = 0.01502
15014       b_mtem(2,ja,je) = -3.1197
15015       b_mtem(3,ja,je) = 3.61104
15016       b_mtem(4,ja,je) = 3.05196
15017       b_mtem(5,ja,je) = -9.98957
15018       b_mtem(6,ja,je) = 6.04155
15019
15020 ! in hcl
15021       je = jhcl
15022       b_mtem(1,ja,je) = -1.06477
15023       b_mtem(2,ja,je) = 3.38801
15024       b_mtem(3,ja,je) = -12.5784
15025       b_mtem(4,ja,je) = 25.2823
15026       b_mtem(5,ja,je) = -25.4611
15027       b_mtem(6,ja,je) = 10.0754
15028
15029
15030 !----------
15031 ! nahso4 in e
15032       ja = jnahso4
15033
15034 ! in h2so4
15035       je = jh2so4
15036       b_mtem(1,ja,je) = 0.68259
15037       b_mtem(2,ja,je) = 0.71468
15038       b_mtem(3,ja,je) = -5.59003
15039       b_mtem(4,ja,je) = 11.0089
15040       b_mtem(5,ja,je) = -10.7983
15041       b_mtem(6,ja,je) = 3.82335
15042
15043 ! in nh4hso4
15044       je = jnh4hso4
15045       b_mtem(1,ja,je) = -0.03956
15046       b_mtem(2,ja,je) = 4.52828
15047       b_mtem(3,ja,je) = -25.2557
15048       b_mtem(4,ja,je) = 54.4225
15049       b_mtem(5,ja,je) = -52.5105
15050       b_mtem(6,ja,je) = 18.6562
15051
15052 ! in (nh4)3h(so4)2
15053       je = jlvcite
15054       b_mtem(1,ja,je) = -1.53503
15055       b_mtem(2,ja,je) = 8.27608
15056       b_mtem(3,ja,je) = -28.9539
15057       b_mtem(4,ja,je) = 55.2876
15058       b_mtem(5,ja,je) = -51.9563
15059       b_mtem(6,ja,je) = 18.6576
15060
15061 ! in (nh4)2so4
15062       je = jnh4so4
15063       b_mtem(1,ja,je) = -0.38793
15064       b_mtem(2,ja,je) = 7.14680
15065       b_mtem(3,ja,je) = -38.7201
15066       b_mtem(4,ja,je) = 84.3965
15067       b_mtem(5,ja,je) = -84.7453
15068       b_mtem(6,ja,je) = 32.1283
15069
15070 ! in nahso4
15071       je = jnahso4
15072       b_mtem(1,ja,je) = -0.41982
15073       b_mtem(2,ja,je) = 4.26491
15074       b_mtem(3,ja,je) = -20.2351
15075       b_mtem(4,ja,je) = 42.6764
15076       b_mtem(5,ja,je) = -40.7503
15077       b_mtem(6,ja,je) = 14.2868
15078
15079 ! in na3h(so4)2
15080       je = jna3hso4
15081       b_mtem(1,ja,je) = -0.32912
15082       b_mtem(2,ja,je) = 1.80808
15083       b_mtem(3,ja,je) = -8.01286
15084       b_mtem(4,ja,je) = 15.5791
15085       b_mtem(5,ja,je) = -14.5494
15086       b_mtem(6,ja,je) = 5.27052
15087
15088 ! in na2so4
15089       je = jna2so4
15090       b_mtem(1,ja,je) = 0.10271
15091       b_mtem(2,ja,je) = 5.09559
15092       b_mtem(3,ja,je) = -30.3295
15093       b_mtem(4,ja,je) = 66.2975
15094       b_mtem(5,ja,je) = -66.3458
15095       b_mtem(6,ja,je) = 24.9443
15096
15097 ! in hno3
15098       je = jhno3
15099       b_mtem(1,ja,je) = 0.608309
15100       b_mtem(2,ja,je) = -0.541905
15101       b_mtem(3,ja,je) = -2.52084
15102       b_mtem(4,ja,je) = 6.63297
15103       b_mtem(5,ja,je) = -7.24599
15104       b_mtem(6,ja,je) = 2.88811
15105
15106 ! in hcl
15107       je = jhcl
15108       b_mtem(1,ja,je) = 1.98399
15109       b_mtem(2,ja,je) = -4.51562
15110       b_mtem(3,ja,je) = 8.36059
15111       b_mtem(4,ja,je) = -12.4948
15112       b_mtem(5,ja,je) = 9.67514
15113       b_mtem(6,ja,je) = -3.18004
15114
15115
15116 !----------
15117 ! na3h(so4)2 in e
15118       ja = jna3hso4
15119
15120 ! in h2so4
15121       je = jh2so4
15122       b_mtem(1,ja,je) = -0.83214
15123       b_mtem(2,ja,je) = 4.99572
15124       b_mtem(3,ja,je) = -20.1697
15125       b_mtem(4,ja,je) = 41.4066
15126       b_mtem(5,ja,je) = -42.2119
15127       b_mtem(6,ja,je) = 16.4855
15128
15129 ! in nh4hso4
15130       je = jnh4hso4
15131       b_mtem(1,ja,je) = -0.65139
15132       b_mtem(2,ja,je) = 3.52300
15133       b_mtem(3,ja,je) = -22.8220
15134       b_mtem(4,ja,je) = 56.2956
15135       b_mtem(5,ja,je) = -59.9028
15136       b_mtem(6,ja,je) = 23.1844
15137
15138 ! in (nh4)3h(so4)2
15139       je = jlvcite
15140       b_mtem(1,ja,je) = -1.31331
15141       b_mtem(2,ja,je) = 8.40835
15142       b_mtem(3,ja,je) = -38.1757
15143       b_mtem(4,ja,je) = 80.5312
15144       b_mtem(5,ja,je) = -79.8346
15145       b_mtem(6,ja,je) = 30.0219
15146
15147 ! in (nh4)2so4
15148       je = jnh4so4
15149       b_mtem(1,ja,je) = -1.03054
15150       b_mtem(2,ja,je) = 8.08155
15151       b_mtem(3,ja,je) = -38.1046
15152       b_mtem(4,ja,je) = 78.7168
15153       b_mtem(5,ja,je) = -77.2263
15154       b_mtem(6,ja,je) = 29.1521
15155
15156 ! in nahso4
15157       je = jnahso4
15158       b_mtem(1,ja,je) = -1.90695
15159       b_mtem(2,ja,je) = 11.6241
15160       b_mtem(3,ja,je) = -50.3175
15161       b_mtem(4,ja,je) = 105.884
15162       b_mtem(5,ja,je) = -103.258
15163       b_mtem(6,ja,je) = 37.6588
15164
15165 ! in na3h(so4)2
15166       je = jna3hso4
15167       b_mtem(1,ja,je) = -0.34780
15168       b_mtem(2,ja,je) = 2.85363
15169       b_mtem(3,ja,je) = -17.6224
15170       b_mtem(4,ja,je) = 38.9220
15171       b_mtem(5,ja,je) = -39.8106
15172       b_mtem(6,ja,je) = 15.6055
15173
15174 ! in na2so4
15175       je = jna2so4
15176       b_mtem(1,ja,je) = -0.75230
15177       b_mtem(2,ja,je) = 10.0140
15178       b_mtem(3,ja,je) = -50.5677
15179       b_mtem(4,ja,je) = 106.941
15180       b_mtem(5,ja,je) = -105.534
15181       b_mtem(6,ja,je) = 39.5196
15182
15183 ! in hno3
15184       je = jhno3
15185       b_mtem(1,ja,je) = 0.057456
15186       b_mtem(2,ja,je) = -1.31264
15187       b_mtem(3,ja,je) = -1.94662
15188       b_mtem(4,ja,je) = 10.7024
15189       b_mtem(5,ja,je) = -14.9946
15190       b_mtem(6,ja,je) = 7.12161
15191
15192 ! in hcl
15193       je = jhcl
15194       b_mtem(1,ja,je) = 0.637894
15195       b_mtem(2,ja,je) = -2.29719
15196       b_mtem(3,ja,je) = 0.765361
15197       b_mtem(4,ja,je) = 4.8748
15198       b_mtem(5,ja,je) = -9.25978
15199       b_mtem(6,ja,je) = 4.91773
15200 !
15201 !
15202 !
15203 !----------------------------------------------------------
15204 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3    (t in kelvin)
15205 ! valid temperature range: 240 - 320 k
15206 !----------------------------------------------------------
15207 !
15208 ! sulfate-poor systems
15209 ! ac
15210       j_index = 1
15211       d_mdrh(j_index,1) = -58.00268351
15212       d_mdrh(j_index,2) = 2.031077573
15213       d_mdrh(j_index,3) = -0.008281218
15214       d_mdrh(j_index,4) = 1.00447e-05
15215
15216 ! an
15217       j_index = 2
15218       d_mdrh(j_index,1) = 1039.137773
15219       d_mdrh(j_index,2) = -11.47847095
15220       d_mdrh(j_index,3) = 0.047702786
15221       d_mdrh(j_index,4) = -6.77675e-05
15222
15223 ! as
15224       j_index = 3
15225       d_mdrh(j_index,1) = 115.8366357
15226       d_mdrh(j_index,2) = 0.491881663
15227       d_mdrh(j_index,3) = -0.00422807
15228       d_mdrh(j_index,4) = 7.29274e-06
15229
15230 ! sc
15231       j_index = 4
15232       d_mdrh(j_index,1) = 253.2424151
15233       d_mdrh(j_index,2) = -1.429957864
15234       d_mdrh(j_index,3) = 0.003727554
15235       d_mdrh(j_index,4) = -3.13037e-06
15236
15237 ! sn
15238       j_index = 5
15239       d_mdrh(j_index,1) = -372.4306506
15240       d_mdrh(j_index,2) = 5.3955633
15241       d_mdrh(j_index,3) = -0.019804438
15242       d_mdrh(j_index,4) = 2.25662e-05
15243
15244 ! ss
15245       j_index = 6
15246       d_mdrh(j_index,1) = 286.1271416
15247       d_mdrh(j_index,2) = -1.670787758
15248       d_mdrh(j_index,3) = 0.004431373
15249       d_mdrh(j_index,4) = -3.57757e-06
15250
15251 ! cc
15252       j_index = 7
15253       d_mdrh(j_index,1) = -1124.07059
15254       d_mdrh(j_index,2) = 14.26364209
15255       d_mdrh(j_index,3) = -0.054816822
15256       d_mdrh(j_index,4) = 6.70107e-05
15257
15258 ! cn
15259       j_index = 8
15260       d_mdrh(j_index,1) = 1855.413934
15261       d_mdrh(j_index,2) = -20.29219473
15262       d_mdrh(j_index,3) = 0.07807482
15263       d_mdrh(j_index,4) = -1.017887858e-4
15264
15265 ! an + ac
15266       j_index = 9
15267       d_mdrh(j_index,1) = 1761.176886
15268       d_mdrh(j_index,2) = -19.29811062
15269       d_mdrh(j_index,3) = 0.075676987
15270       d_mdrh(j_index,4) = -1.0116959e-4
15271
15272 ! as + ac
15273       j_index = 10
15274       d_mdrh(j_index,1) = 122.1074303
15275       d_mdrh(j_index,2) = 0.429692122
15276       d_mdrh(j_index,3) = -0.003928277
15277       d_mdrh(j_index,4) = 6.43275e-06
15278
15279 ! as + an
15280       j_index = 11
15281       d_mdrh(j_index,1) = 2424.634678
15282       d_mdrh(j_index,2) = -26.54031307
15283       d_mdrh(j_index,3) = 0.101625387
15284       d_mdrh(j_index,4) = -1.31544547798e-4
15285
15286 ! as + an + ac
15287       j_index = 12
15288       d_mdrh(j_index,1) = 2912.082599
15289       d_mdrh(j_index,2) = -31.8894185
15290       d_mdrh(j_index,3) = 0.121185849
15291       d_mdrh(j_index,4) = -1.556534623e-4
15292
15293 ! sc + ac
15294       j_index = 13
15295       d_mdrh(j_index,1) = 172.2596493
15296       d_mdrh(j_index,2) = -0.511006195
15297       d_mdrh(j_index,3) = 4.27244597e-4
15298       d_mdrh(j_index,4) = 4.12797e-07
15299
15300 ! sn + ac
15301       j_index = 14
15302       d_mdrh(j_index,1) = 1596.184935
15303       d_mdrh(j_index,2) = -16.37945565
15304       d_mdrh(j_index,3) = 0.060281218
15305       d_mdrh(j_index,4) = -7.6161e-05
15306
15307 ! sn + an
15308       j_index = 15
15309       d_mdrh(j_index,1) = 1916.072988
15310       d_mdrh(j_index,2) = -20.85594868
15311       d_mdrh(j_index,3) = 0.081140141
15312       d_mdrh(j_index,4) = -1.07954274796e-4
15313
15314 ! sn + an + ac
15315       j_index = 16
15316       d_mdrh(j_index,1) = 1467.165935
15317       d_mdrh(j_index,2) = -16.01166196
15318       d_mdrh(j_index,3) = 0.063505582
15319       d_mdrh(j_index,4) = -8.66722e-05
15320
15321 ! sn + sc
15322       j_index = 17
15323       d_mdrh(j_index,1) = 158.447059
15324       d_mdrh(j_index,2) = -0.628167358
15325       d_mdrh(j_index,3) = 0.002014448
15326       d_mdrh(j_index,4) = -3.13037e-06
15327
15328 ! sn + sc + ac
15329       j_index = 18
15330       d_mdrh(j_index,1) = 1115.892468
15331       d_mdrh(j_index,2) = -11.76936534
15332       d_mdrh(j_index,3) = 0.045577399
15333       d_mdrh(j_index,4) = -6.05779e-05
15334
15335 ! ss + ac
15336       j_index = 19
15337       d_mdrh(j_index,1) = 269.5432407
15338       d_mdrh(j_index,2) = -1.319963885
15339       d_mdrh(j_index,3) = 0.002592363
15340       d_mdrh(j_index,4) = -1.44479e-06
15341
15342 ! ss + an
15343       j_index = 20
15344       d_mdrh(j_index,1) = 2841.334784
15345       d_mdrh(j_index,2) = -31.1889487
15346       d_mdrh(j_index,3) = 0.118809274
15347       d_mdrh(j_index,4) = -1.53007e-4
15348
15349 ! ss + an + ac
15350       j_index = 21
15351       d_mdrh(j_index,1) = 2199.36914
15352       d_mdrh(j_index,2) = -24.11926569
15353       d_mdrh(j_index,3) = 0.092932361
15354       d_mdrh(j_index,4) = -1.21774e-4
15355
15356 ! ss + as
15357       j_index = 22
15358       d_mdrh(j_index,1) = 395.0051604
15359       d_mdrh(j_index,2) = -2.521101657
15360       d_mdrh(j_index,3) = 0.006139319
15361       d_mdrh(j_index,4) = -4.43756e-06
15362
15363 ! ss + as + ac
15364       j_index = 23
15365       d_mdrh(j_index,1) = 386.5150675
15366       d_mdrh(j_index,2) = -2.4632138
15367       d_mdrh(j_index,3) = 0.006139319
15368       d_mdrh(j_index,4) = -4.98796e-06
15369
15370 ! ss + as + an
15371       j_index = 24
15372       d_mdrh(j_index,1) = 3101.538491
15373       d_mdrh(j_index,2) = -34.19978105
15374       d_mdrh(j_index,3) = 0.130118605
15375       d_mdrh(j_index,4) = -1.66873e-4
15376
15377 ! ss + as + an + ac
15378       j_index = 25
15379       d_mdrh(j_index,1) = 2307.579403
15380       d_mdrh(j_index,2) = -25.43136774
15381       d_mdrh(j_index,3) = 0.098064728
15382       d_mdrh(j_index,4) = -1.28301e-4
15383
15384 ! ss + sc
15385       j_index = 26
15386       d_mdrh(j_index,1) = 291.8309602
15387       d_mdrh(j_index,2) = -1.828912974
15388       d_mdrh(j_index,3) = 0.005053148
15389       d_mdrh(j_index,4) = -4.57516e-06
15390
15391 ! ss + sc + ac
15392       j_index = 27
15393       d_mdrh(j_index,1) = 188.3914345
15394       d_mdrh(j_index,2) = -0.631345031
15395       d_mdrh(j_index,3) = 0.000622807
15396       d_mdrh(j_index,4) = 4.47196e-07
15397
15398 ! ss + sn
15399       j_index = 28
15400       d_mdrh(j_index,1) = -167.1252839
15401       d_mdrh(j_index,2) = 2.969828002
15402       d_mdrh(j_index,3) = -0.010637255
15403       d_mdrh(j_index,4) = 1.13175e-05
15404
15405 ! ss + sn + ac
15406       j_index = 29
15407       d_mdrh(j_index,1) = 1516.782768
15408       d_mdrh(j_index,2) = -15.7922661
15409       d_mdrh(j_index,3) = 0.058942209
15410       d_mdrh(j_index,4) = -7.5301e-05
15411
15412 ! ss + sn + an
15413       j_index = 30
15414       d_mdrh(j_index,1) = 1739.963163
15415       d_mdrh(j_index,2) = -19.06576022
15416       d_mdrh(j_index,3) = 0.07454963
15417       d_mdrh(j_index,4) = -9.94302e-05
15418
15419 ! ss + sn + an + ac
15420       j_index = 31
15421       d_mdrh(j_index,1) = 2152.104877
15422       d_mdrh(j_index,2) = -23.74998008
15423       d_mdrh(j_index,3) = 0.092256654
15424       d_mdrh(j_index,4) = -1.21953e-4
15425
15426 ! ss + sn + sc
15427       j_index = 32
15428       d_mdrh(j_index,1) = 221.9976265
15429       d_mdrh(j_index,2) = -1.311331272
15430       d_mdrh(j_index,3) = 0.004406089
15431       d_mdrh(j_index,4) = -5.88235e-06
15432
15433 ! ss + sn + sc + ac
15434       j_index = 33
15435       d_mdrh(j_index,1) = 1205.645615
15436       d_mdrh(j_index,2) = -12.71353459
15437       d_mdrh(j_index,3) = 0.048803922
15438       d_mdrh(j_index,4) = -6.41899e-05
15439
15440 ! cc + ac
15441       j_index = 34
15442       d_mdrh(j_index,1) = 506.6737879
15443       d_mdrh(j_index,2) = -3.723520818
15444       d_mdrh(j_index,3) = 0.010814242
15445       d_mdrh(j_index,4) = -1.21087e-05
15446
15447 ! cc + sc
15448       j_index = 35
15449       d_mdrh(j_index,1) = -1123.523841
15450       d_mdrh(j_index,2) = 14.08345977
15451       d_mdrh(j_index,3) = -0.053687823
15452       d_mdrh(j_index,4) = 6.52219e-05
15453
15454 ! cc + sc + ac
15455       j_index = 36
15456       d_mdrh(j_index,1) = -1159.98607
15457       d_mdrh(j_index,2) = 14.44309169
15458       d_mdrh(j_index,3) = -0.054841073
15459       d_mdrh(j_index,4) = 6.64259e-05
15460
15461 ! cn + ac
15462       j_index = 37
15463       d_mdrh(j_index,1) = 756.0747916
15464       d_mdrh(j_index,2) = -8.546826257
15465       d_mdrh(j_index,3) = 0.035798677
15466       d_mdrh(j_index,4) = -5.06629e-05
15467
15468 ! cn + an
15469       j_index = 38
15470       d_mdrh(j_index,1) = 338.668191
15471       d_mdrh(j_index,2) = -2.971223403
15472       d_mdrh(j_index,3) = 0.012294866
15473       d_mdrh(j_index,4) = -1.87558e-05
15474
15475 ! cn + an + ac
15476       j_index = 39
15477       d_mdrh(j_index,1) = -53.18033508
15478       d_mdrh(j_index,2) = 0.663911748
15479       d_mdrh(j_index,3) = 9.16326e-4
15480       d_mdrh(j_index,4) = -6.70354e-06
15481
15482 ! cn + sc
15483       j_index = 40
15484       d_mdrh(j_index,1) = 3623.831129
15485       d_mdrh(j_index,2) = -39.27226457
15486       d_mdrh(j_index,3) = 0.144559515
15487       d_mdrh(j_index,4) = -1.78159e-4
15488
15489 ! cn + sc + ac
15490       j_index = 41
15491       d_mdrh(j_index,1) = 3436.656743
15492       d_mdrh(j_index,2) = -37.16192684
15493       d_mdrh(j_index,3) = 0.136641377
15494       d_mdrh(j_index,4) = -1.68262e-4
15495
15496 ! cn + sn
15497       j_index = 42
15498       d_mdrh(j_index,1) = 768.608476
15499       d_mdrh(j_index,2) = -8.051517149
15500       d_mdrh(j_index,3) = 0.032342332
15501       d_mdrh(j_index,4) = -4.52224e-05
15502
15503 ! cn + sn + ac
15504       j_index = 43
15505       d_mdrh(j_index,1) = 33.58027951
15506       d_mdrh(j_index,2) = -0.308772182
15507       d_mdrh(j_index,3) = 0.004713639
15508       d_mdrh(j_index,4) = -1.19658e-05
15509
15510 ! cn + sn + an
15511       j_index = 44
15512       d_mdrh(j_index,1) = 57.80183041
15513       d_mdrh(j_index,2) = 0.215264604
15514       d_mdrh(j_index,3) = 4.11406e-4
15515       d_mdrh(j_index,4) = -4.30702e-06
15516
15517 ! cn + sn + an + ac
15518       j_index = 45
15519       d_mdrh(j_index,1) = -234.368984
15520       d_mdrh(j_index,2) = 2.721045204
15521       d_mdrh(j_index,3) = -0.006688341
15522       d_mdrh(j_index,4) = 2.31729e-06
15523
15524 ! cn + sn + sc
15525       j_index = 46
15526       d_mdrh(j_index,1) = 3879.080557
15527       d_mdrh(j_index,2) = -42.13562874
15528       d_mdrh(j_index,3) = 0.155235005
15529       d_mdrh(j_index,4) = -1.91387e-4
15530
15531 ! cn + sn + sc + ac
15532       j_index = 47
15533       d_mdrh(j_index,1) = 3600.576985
15534       d_mdrh(j_index,2) = -39.0283489
15535       d_mdrh(j_index,3) = 0.143710316
15536       d_mdrh(j_index,4) = -1.77167e-4
15537
15538 ! cn + cc
15539       j_index = 48
15540       d_mdrh(j_index,1) = -1009.729826
15541       d_mdrh(j_index,2) = 12.9145339
15542       d_mdrh(j_index,3) = -0.049811146
15543       d_mdrh(j_index,4) = 6.09563e-05
15544
15545 ! cn + cc + ac
15546       j_index = 49
15547       d_mdrh(j_index,1) = -577.0919514
15548       d_mdrh(j_index,2) = 8.020324227
15549       d_mdrh(j_index,3) = -0.031469556
15550       d_mdrh(j_index,4) = 3.82181e-05
15551
15552 ! cn + cc + sc
15553       j_index = 50
15554       d_mdrh(j_index,1) = -728.9983499
15555       d_mdrh(j_index,2) = 9.849458215
15556       d_mdrh(j_index,3) = -0.03879257
15557       d_mdrh(j_index,4) = 4.78844e-05
15558
15559 ! cn + cc + sc + ac
15560       j_index = 51
15561       d_mdrh(j_index,1) = -803.7026845
15562       d_mdrh(j_index,2) = 10.61881494
15563       d_mdrh(j_index,3) = -0.041402993
15564       d_mdrh(j_index,4) = 5.08084e-05
15565
15566 !
15567 ! sulfate-rich systems
15568 ! ab
15569       j_index = 52
15570       d_mdrh(j_index,1) = -493.6190458
15571       d_mdrh(j_index,2) = 6.747053851
15572       d_mdrh(j_index,3) = -0.026955267
15573       d_mdrh(j_index,4) = 3.45118e-05
15574
15575 ! lv
15576       j_index = 53
15577       d_mdrh(j_index,1) = 53.37874093
15578       d_mdrh(j_index,2) = 1.01368249
15579       d_mdrh(j_index,3) = -0.005887513
15580       d_mdrh(j_index,4) = 8.94393e-06
15581
15582 ! sb
15583       j_index = 54
15584       d_mdrh(j_index,1) = 206.619047
15585       d_mdrh(j_index,2) = -1.342735684
15586       d_mdrh(j_index,3) = 0.003197691
15587       d_mdrh(j_index,4) = -1.93603e-06
15588
15589 ! ab + lv
15590       j_index = 55
15591       d_mdrh(j_index,1) = -493.6190458
15592       d_mdrh(j_index,2) = 6.747053851
15593       d_mdrh(j_index,3) = -0.026955267
15594       d_mdrh(j_index,4) = 3.45118e-05
15595
15596 ! as + lv
15597       j_index = 56
15598       d_mdrh(j_index,1) = 53.37874093
15599       d_mdrh(j_index,2) = 1.01368249
15600       d_mdrh(j_index,3) = -0.005887513
15601       d_mdrh(j_index,4) = 8.94393e-06
15602
15603 ! ss + sb
15604       j_index = 57
15605       d_mdrh(j_index,1) = 206.619047
15606       d_mdrh(j_index,2) = -1.342735684
15607       d_mdrh(j_index,3) = 0.003197691
15608       d_mdrh(j_index,4) = -1.93603e-06
15609
15610 ! ss + lv
15611       j_index = 58
15612       d_mdrh(j_index,1) = 41.7619047
15613       d_mdrh(j_index,2) = 1.303872053
15614       d_mdrh(j_index,3) = -0.007647908
15615       d_mdrh(j_index,4) = 1.17845e-05
15616
15617 ! ss + as + lv
15618       j_index = 59
15619       d_mdrh(j_index,1) = 41.7619047
15620       d_mdrh(j_index,2) = 1.303872053
15621       d_mdrh(j_index,3) = -0.007647908
15622       d_mdrh(j_index,4) = 1.17845e-05
15623
15624 ! ss + ab
15625       j_index = 60
15626       d_mdrh(j_index,1) = -369.7142842
15627       d_mdrh(j_index,2) = 5.512878771
15628       d_mdrh(j_index,3) = -0.02301948
15629       d_mdrh(j_index,4) = 3.0303e-05
15630
15631 ! ss + lv + ab
15632       j_index = 61
15633       d_mdrh(j_index,1) = -369.7142842
15634       d_mdrh(j_index,2) = 5.512878771
15635       d_mdrh(j_index,3) = -0.02301948
15636       d_mdrh(j_index,4) = 3.0303e-05
15637
15638 ! sb + ab
15639       j_index = 62
15640       d_mdrh(j_index,1) = -162.8095232
15641       d_mdrh(j_index,2) = 2.399326592
15642       d_mdrh(j_index,3) = -0.009336219
15643       d_mdrh(j_index,4) = 1.17845e-05
15644
15645 ! ss + sb + ab
15646       j_index = 63
15647       d_mdrh(j_index,1) = -735.4285689
15648       d_mdrh(j_index,2) = 8.885521857
15649       d_mdrh(j_index,3) = -0.033488456
15650       d_mdrh(j_index,4) = 4.12458e-05
15651
15652       call load_kappa_nonelectro
15653
15654       endif ! first
15655
15656       return
15657       end subroutine load_mosaic_parameters
15658
15659
15660
15661
15662       subroutine load_kappa_nonelectro
15663
15664       use module_data_mosaic_asect, only: &
15665          hygro_oin_aer, hygro_oc_aer, hygro_bc_aer,  &
15666          hygro_pcg1_b_c_aer,  hygro_pcg2_b_c_aer,  hygro_pcg3_b_c_aer,  &
15667          hygro_pcg4_b_c_aer,  hygro_pcg5_b_c_aer,  hygro_pcg6_b_c_aer,  &
15668          hygro_pcg7_b_c_aer,  hygro_pcg8_b_c_aer,  hygro_pcg9_b_c_aer,  &
15669          hygro_pcg1_b_o_aer,  hygro_pcg2_b_o_aer,  hygro_pcg3_b_o_aer,  &
15670          hygro_pcg4_b_o_aer,  hygro_pcg5_b_o_aer,  hygro_pcg6_b_o_aer,  &
15671          hygro_pcg7_b_o_aer,  hygro_pcg8_b_o_aer,  hygro_pcg9_b_o_aer,  &
15672          hygro_opcg1_b_c_aer, hygro_opcg2_b_c_aer, hygro_opcg3_b_c_aer,  &
15673          hygro_opcg4_b_c_aer, hygro_opcg5_b_c_aer, hygro_opcg6_b_c_aer,  &
15674          hygro_opcg7_b_c_aer, hygro_opcg8_b_c_aer,  &
15675          hygro_opcg1_b_o_aer, hygro_opcg2_b_o_aer, hygro_opcg3_b_o_aer,  &
15676          hygro_opcg4_b_o_aer, hygro_opcg5_b_o_aer, hygro_opcg6_b_o_aer,  &
15677          hygro_opcg7_b_o_aer, hygro_opcg8_b_o_aer,  &
15678          hygro_pcg1_f_c_aer,  hygro_pcg2_f_c_aer,  hygro_pcg3_f_c_aer,  &
15679          hygro_pcg4_f_c_aer,  hygro_pcg5_f_c_aer,  hygro_pcg6_f_c_aer,  &
15680          hygro_pcg7_f_c_aer,  hygro_pcg8_f_c_aer,  hygro_pcg9_f_c_aer,  &
15681          hygro_pcg1_f_o_aer,  hygro_pcg2_f_o_aer,  hygro_pcg3_f_o_aer,  &
15682          hygro_pcg4_f_o_aer,  hygro_pcg5_f_o_aer,  hygro_pcg6_f_o_aer,  &
15683          hygro_pcg7_f_o_aer,  hygro_pcg8_f_o_aer,  hygro_pcg9_f_o_aer,  &
15684          hygro_opcg1_f_c_aer, hygro_opcg2_f_c_aer, hygro_opcg3_f_c_aer,  &
15685          hygro_opcg4_f_c_aer, hygro_opcg5_f_c_aer, hygro_opcg6_f_c_aer,  &
15686          hygro_opcg7_f_c_aer, hygro_opcg8_f_c_aer,  &
15687          hygro_opcg1_f_o_aer, hygro_opcg2_f_o_aer, hygro_opcg3_f_o_aer,  &
15688          hygro_opcg4_f_o_aer, hygro_opcg5_f_o_aer, hygro_opcg6_f_o_aer,  &
15689          hygro_opcg7_f_o_aer, hygro_opcg8_f_o_aer,  &
15690          hygro_ant1_c_aer,  hygro_ant2_c_aer,  hygro_ant3_c_aer,  hygro_ant4_c_aer,  &
15691          hygro_ant1_o_aer,  hygro_ant2_o_aer,  hygro_ant3_o_aer,  hygro_ant4_o_aer,  &
15692          hygro_biog1_c_aer, hygro_biog2_c_aer, hygro_biog3_c_aer, hygro_biog4_c_aer,  &
15693          hygro_biog1_o_aer, hygro_biog2_o_aer, hygro_biog3_o_aer, hygro_biog4_o_aer,  &
15694          hygro_smpa_aer, hygro_smpbb_aer,  &
15695          hygro_glysoa_r1_aer,  hygro_glysoa_r2_aer,  hygro_glysoa_oh_aer,  &
15696          hygro_glysoa_nh4_aer, hygro_glysoa_sfc_aer,  &
15697          hygro_asoaX_aer, hygro_asoa1_aer, hygro_asoa2_aer,  &
15698          hygro_asoa3_aer, hygro_asoa4_aer,  &
15699          hygro_bsoaX_aer, hygro_bsoa1_aer, hygro_bsoa2_aer,  &
15700          hygro_bsoa3_aer, hygro_bsoa4_aer
15701
15702       if (ioin_a        > 0) kappa_nonelectro(ioin_a       ) = hygro_oin_aer
15703       if (ioc_a         > 0) kappa_nonelectro(ioc_a        ) = hygro_oc_aer
15704       if (ibc_a         > 0) kappa_nonelectro(ibc_a        ) = hygro_bc_aer
15705
15706       if (ipcg1_b_c_a   > 0) kappa_nonelectro(ipcg1_b_c_a  ) = hygro_pcg1_b_c_aer
15707       if (ipcg2_b_c_a   > 0) kappa_nonelectro(ipcg2_b_c_a  ) = hygro_pcg2_b_c_aer
15708       if (ipcg3_b_c_a   > 0) kappa_nonelectro(ipcg3_b_c_a  ) = hygro_pcg3_b_c_aer
15709       if (ipcg4_b_c_a   > 0) kappa_nonelectro(ipcg4_b_c_a  ) = hygro_pcg4_b_c_aer
15710       if (ipcg5_b_c_a   > 0) kappa_nonelectro(ipcg5_b_c_a  ) = hygro_pcg5_b_c_aer
15711       if (ipcg6_b_c_a   > 0) kappa_nonelectro(ipcg6_b_c_a  ) = hygro_pcg6_b_c_aer
15712       if (ipcg7_b_c_a   > 0) kappa_nonelectro(ipcg7_b_c_a  ) = hygro_pcg7_b_c_aer
15713       if (ipcg8_b_c_a   > 0) kappa_nonelectro(ipcg8_b_c_a  ) = hygro_pcg8_b_c_aer
15714       if (ipcg9_b_c_a   > 0) kappa_nonelectro(ipcg9_b_c_a  ) = hygro_pcg9_b_c_aer
15715       if (ipcg1_b_o_a   > 0) kappa_nonelectro(ipcg1_b_o_a  ) = hygro_pcg1_b_o_aer
15716       if (ipcg2_b_o_a   > 0) kappa_nonelectro(ipcg2_b_o_a  ) = hygro_pcg2_b_o_aer
15717       if (ipcg3_b_o_a   > 0) kappa_nonelectro(ipcg3_b_o_a  ) = hygro_pcg3_b_o_aer
15718       if (ipcg4_b_o_a   > 0) kappa_nonelectro(ipcg4_b_o_a  ) = hygro_pcg4_b_o_aer
15719       if (ipcg5_b_o_a   > 0) kappa_nonelectro(ipcg5_b_o_a  ) = hygro_pcg5_b_o_aer
15720       if (ipcg6_b_o_a   > 0) kappa_nonelectro(ipcg6_b_o_a  ) = hygro_pcg6_b_o_aer
15721       if (ipcg7_b_o_a   > 0) kappa_nonelectro(ipcg7_b_o_a  ) = hygro_pcg7_b_o_aer
15722       if (ipcg8_b_o_a   > 0) kappa_nonelectro(ipcg8_b_o_a  ) = hygro_pcg8_b_o_aer
15723       if (ipcg9_b_o_a   > 0) kappa_nonelectro(ipcg9_b_o_a  ) = hygro_pcg9_b_o_aer
15724       if (iopcg1_b_c_a  > 0) kappa_nonelectro(iopcg1_b_c_a ) = hygro_opcg1_b_c_aer
15725       if (iopcg2_b_c_a  > 0) kappa_nonelectro(iopcg2_b_c_a ) = hygro_opcg2_b_c_aer
15726       if (iopcg3_b_c_a  > 0) kappa_nonelectro(iopcg3_b_c_a ) = hygro_opcg3_b_c_aer
15727       if (iopcg4_b_c_a  > 0) kappa_nonelectro(iopcg4_b_c_a ) = hygro_opcg4_b_c_aer
15728       if (iopcg5_b_c_a  > 0) kappa_nonelectro(iopcg5_b_c_a ) = hygro_opcg5_b_c_aer
15729       if (iopcg6_b_c_a  > 0) kappa_nonelectro(iopcg6_b_c_a ) = hygro_opcg6_b_c_aer
15730       if (iopcg7_b_c_a  > 0) kappa_nonelectro(iopcg7_b_c_a ) = hygro_opcg7_b_c_aer
15731       if (iopcg8_b_c_a  > 0) kappa_nonelectro(iopcg8_b_c_a ) = hygro_opcg8_b_c_aer
15732       if (iopcg1_b_o_a  > 0) kappa_nonelectro(iopcg1_b_o_a ) = hygro_opcg1_b_o_aer
15733       if (iopcg2_b_o_a  > 0) kappa_nonelectro(iopcg2_b_o_a ) = hygro_opcg2_b_o_aer
15734       if (iopcg3_b_o_a  > 0) kappa_nonelectro(iopcg3_b_o_a ) = hygro_opcg3_b_o_aer
15735       if (iopcg4_b_o_a  > 0) kappa_nonelectro(iopcg4_b_o_a ) = hygro_opcg4_b_o_aer
15736       if (iopcg5_b_o_a  > 0) kappa_nonelectro(iopcg5_b_o_a ) = hygro_opcg5_b_o_aer
15737       if (iopcg6_b_o_a  > 0) kappa_nonelectro(iopcg6_b_o_a ) = hygro_opcg6_b_o_aer
15738       if (iopcg7_b_o_a  > 0) kappa_nonelectro(iopcg7_b_o_a ) = hygro_opcg7_b_o_aer
15739       if (iopcg8_b_o_a  > 0) kappa_nonelectro(iopcg8_b_o_a ) = hygro_opcg8_b_o_aer
15740       if (ipcg1_f_c_a   > 0) kappa_nonelectro(ipcg1_f_c_a  ) = hygro_pcg1_f_c_aer
15741       if (ipcg2_f_c_a   > 0) kappa_nonelectro(ipcg2_f_c_a  ) = hygro_pcg2_f_c_aer
15742       if (ipcg3_f_c_a   > 0) kappa_nonelectro(ipcg3_f_c_a  ) = hygro_pcg3_f_c_aer
15743       if (ipcg4_f_c_a   > 0) kappa_nonelectro(ipcg4_f_c_a  ) = hygro_pcg4_f_c_aer
15744       if (ipcg5_f_c_a   > 0) kappa_nonelectro(ipcg5_f_c_a  ) = hygro_pcg5_f_c_aer
15745       if (ipcg6_f_c_a   > 0) kappa_nonelectro(ipcg6_f_c_a  ) = hygro_pcg6_f_c_aer
15746       if (ipcg7_f_c_a   > 0) kappa_nonelectro(ipcg7_f_c_a  ) = hygro_pcg7_f_c_aer
15747       if (ipcg8_f_c_a   > 0) kappa_nonelectro(ipcg8_f_c_a  ) = hygro_pcg8_f_c_aer
15748       if (ipcg9_f_c_a   > 0) kappa_nonelectro(ipcg9_f_c_a  ) = hygro_pcg9_f_c_aer
15749       if (ipcg1_f_o_a   > 0) kappa_nonelectro(ipcg1_f_o_a  ) = hygro_pcg1_f_o_aer
15750       if (ipcg2_f_o_a   > 0) kappa_nonelectro(ipcg2_f_o_a  ) = hygro_pcg2_f_o_aer
15751       if (ipcg3_f_o_a   > 0) kappa_nonelectro(ipcg3_f_o_a  ) = hygro_pcg3_f_o_aer
15752       if (ipcg4_f_o_a   > 0) kappa_nonelectro(ipcg4_f_o_a  ) = hygro_pcg4_f_o_aer
15753       if (ipcg5_f_o_a   > 0) kappa_nonelectro(ipcg5_f_o_a  ) = hygro_pcg5_f_o_aer
15754       if (ipcg6_f_o_a   > 0) kappa_nonelectro(ipcg6_f_o_a  ) = hygro_pcg6_f_o_aer
15755       if (ipcg7_f_o_a   > 0) kappa_nonelectro(ipcg7_f_o_a  ) = hygro_pcg7_f_o_aer
15756       if (ipcg8_f_o_a   > 0) kappa_nonelectro(ipcg8_f_o_a  ) = hygro_pcg8_f_o_aer
15757       if (ipcg9_f_o_a   > 0) kappa_nonelectro(ipcg9_f_o_a  ) = hygro_pcg9_f_o_aer
15758       if (iopcg1_f_c_a  > 0) kappa_nonelectro(iopcg1_f_c_a ) = hygro_opcg1_f_c_aer
15759       if (iopcg2_f_c_a  > 0) kappa_nonelectro(iopcg2_f_c_a ) = hygro_opcg2_f_c_aer
15760       if (iopcg3_f_c_a  > 0) kappa_nonelectro(iopcg3_f_c_a ) = hygro_opcg3_f_c_aer
15761       if (iopcg4_f_c_a  > 0) kappa_nonelectro(iopcg4_f_c_a ) = hygro_opcg4_f_c_aer
15762       if (iopcg5_f_c_a  > 0) kappa_nonelectro(iopcg5_f_c_a ) = hygro_opcg5_f_c_aer
15763       if (iopcg6_f_c_a  > 0) kappa_nonelectro(iopcg6_f_c_a ) = hygro_opcg6_f_c_aer
15764       if (iopcg7_f_c_a  > 0) kappa_nonelectro(iopcg7_f_c_a ) = hygro_opcg7_f_c_aer
15765       if (iopcg8_f_c_a  > 0) kappa_nonelectro(iopcg8_f_c_a ) = hygro_opcg8_f_c_aer
15766       if (iopcg1_f_o_a  > 0) kappa_nonelectro(iopcg1_f_o_a ) = hygro_opcg1_f_o_aer
15767       if (iopcg2_f_o_a  > 0) kappa_nonelectro(iopcg2_f_o_a ) = hygro_opcg2_f_o_aer
15768       if (iopcg3_f_o_a  > 0) kappa_nonelectro(iopcg3_f_o_a ) = hygro_opcg3_f_o_aer
15769       if (iopcg4_f_o_a  > 0) kappa_nonelectro(iopcg4_f_o_a ) = hygro_opcg4_f_o_aer
15770       if (iopcg5_f_o_a  > 0) kappa_nonelectro(iopcg5_f_o_a ) = hygro_opcg5_f_o_aer
15771       if (iopcg6_f_o_a  > 0) kappa_nonelectro(iopcg6_f_o_a ) = hygro_opcg6_f_o_aer
15772       if (iopcg7_f_o_a  > 0) kappa_nonelectro(iopcg7_f_o_a ) = hygro_opcg7_f_o_aer
15773       if (iopcg8_f_o_a  > 0) kappa_nonelectro(iopcg8_f_o_a ) = hygro_opcg8_f_o_aer
15774
15775       if (iant1_c_a     > 0) kappa_nonelectro(iant1_c_a    ) = hygro_ant1_c_aer
15776       if (iant2_c_a     > 0) kappa_nonelectro(iant2_c_a    ) = hygro_ant2_c_aer
15777       if (iant3_c_a     > 0) kappa_nonelectro(iant3_c_a    ) = hygro_ant3_c_aer
15778       if (iant4_c_a     > 0) kappa_nonelectro(iant4_c_a    ) = hygro_ant4_c_aer
15779       if (iant1_o_a     > 0) kappa_nonelectro(iant1_o_a    ) = hygro_ant1_o_aer
15780       if (iant2_o_a     > 0) kappa_nonelectro(iant2_o_a    ) = hygro_ant2_o_aer
15781       if (iant3_o_a     > 0) kappa_nonelectro(iant3_o_a    ) = hygro_ant3_o_aer
15782       if (iant4_o_a     > 0) kappa_nonelectro(iant4_o_a    ) = hygro_ant4_o_aer
15783       if (ibiog1_c_a    > 0) kappa_nonelectro(ibiog1_c_a   ) = hygro_biog1_c_aer
15784       if (ibiog2_c_a    > 0) kappa_nonelectro(ibiog2_c_a   ) = hygro_biog2_c_aer
15785       if (ibiog3_c_a    > 0) kappa_nonelectro(ibiog3_c_a   ) = hygro_biog3_c_aer
15786       if (ibiog4_c_a    > 0) kappa_nonelectro(ibiog4_c_a   ) = hygro_biog4_c_aer
15787       if (ibiog1_o_a    > 0) kappa_nonelectro(ibiog1_o_a   ) = hygro_biog1_o_aer
15788       if (ibiog2_o_a    > 0) kappa_nonelectro(ibiog2_o_a   ) = hygro_biog2_o_aer
15789       if (ibiog3_o_a    > 0) kappa_nonelectro(ibiog3_o_a   ) = hygro_biog3_o_aer
15790       if (ibiog4_o_a    > 0) kappa_nonelectro(ibiog4_o_a   ) = hygro_biog4_o_aer
15791
15792       if (ismpa_a       > 0) kappa_nonelectro(ismpa_a      ) = hygro_smpa_aer
15793       if (ismpbb_a      > 0) kappa_nonelectro(ismpbb_a     ) = hygro_smpbb_aer
15794       if (iglysoa_r1_a  > 0) kappa_nonelectro(iglysoa_r1_a ) = hygro_glysoa_r1_aer
15795       if (iglysoa_r2_a  > 0) kappa_nonelectro(iglysoa_r2_a ) = hygro_glysoa_r2_aer
15796       if (iglysoa_oh_a  > 0) kappa_nonelectro(iglysoa_oh_a ) = hygro_glysoa_oh_aer
15797       if (iglysoa_nh4_a > 0) kappa_nonelectro(iglysoa_nh4_a) = hygro_glysoa_nh4_aer
15798       if (iglysoa_sfc_a > 0) kappa_nonelectro(iglysoa_sfc_a) = hygro_glysoa_sfc_aer
15799       if (iasoaX_a      > 0) kappa_nonelectro(iasoaX_a     ) = hygro_asoaX_aer
15800       if (iasoa1_a      > 0) kappa_nonelectro(iasoa1_a     ) = hygro_asoa1_aer
15801       if (iasoa2_a      > 0) kappa_nonelectro(iasoa2_a     ) = hygro_asoa2_aer
15802       if (iasoa3_a      > 0) kappa_nonelectro(iasoa3_a     ) = hygro_asoa3_aer
15803       if (iasoa4_a      > 0) kappa_nonelectro(iasoa4_a     ) = hygro_asoa4_aer
15804       if (ibsoaX_a      > 0) kappa_nonelectro(ibsoaX_a     ) = hygro_bsoaX_aer
15805       if (ibsoa1_a      > 0) kappa_nonelectro(ibsoa1_a     ) = hygro_bsoa1_aer
15806       if (ibsoa2_a      > 0) kappa_nonelectro(ibsoa2_a     ) = hygro_bsoa2_aer
15807       if (ibsoa3_a      > 0) kappa_nonelectro(ibsoa3_a     ) = hygro_bsoa3_aer
15808       if (ibsoa4_a      > 0) kappa_nonelectro(ibsoa4_a     ) = hygro_bsoa4_aer
15809
15810       return
15811       end subroutine load_kappa_nonelectro
15812
15813
15814
15815
15816 !***********************************************************************
15817 ! updates all temperature dependent thermodynamic parameters
15818 !
15819 ! author: rahul a. zaveri
15820 ! update: jan 2005
15821 !-----------------------------------------------------------------------
15822       subroutine update_thermodynamic_constants(vbs_nbin)
15823 !     implicit none
15824 !     include 'mosaic.h'
15825 ! local variables
15826       integer iv, j_index, ibin, je,vbs_nbin(1)
15827       integer start_ind
15828       real(kind=8) :: tr, rt, term
15829       real(kind=8) :: gam_nh4no3_0, gam_nh4cl_0, m_nh4no3_0, m_nh4cl_0  ! raz update 6/25/2008
15830 ! function
15831 !     real(kind=8) :: fn_keq, fn_po, drh_mutual, bin_molality, molality_0
15832
15833
15834       tr = 298.15                       ! reference temperature
15835       rt = 82.056*t_k/(1.e9*1.e6)       ! [m^3 atm/nmol]
15836
15837 ! gas-liquid
15838       keq_gl(1)= 1.0                                     ! kelvin effect (default)
15839       keq_gl(2)= fn_keq(57.64d0 , 13.79d0, -5.39d0,t_k)*rt     ! nh3(g)  <=> nh3(l)
15840       keq_gl(3)= fn_keq(2.63d6, 29.17d0, 16.83d0,t_k)*rt     ! hno3(g) <=> no3- + h+
15841       keq_gl(4)= fn_keq(2.00d6, 30.20d0, 19.91d0,t_k)*rt     ! hcl(g)  <=> cl- + h+
15842
15843 ! liquid-liquid
15844       keq_ll(1)= fn_keq(1.0502d-2, 8.85d0, 25.14d0,t_k)      ! hso4- <=> so4= + h+
15845       keq_ll(2)= fn_keq(1.805d-5, -1.50d0, 26.92d0,t_k)      ! nh3(l) + h2o = nh4+ + oh-
15846       keq_ll(3)= fn_keq(1.01d-14,-22.52d0, 26.92d0,t_k)      ! h2o(l) <=> h+ + oh-
15847
15848
15849       kp_nh3   = keq_ll(3)/(keq_ll(2)*keq_gl(2))
15850       kp_nh4no3= kp_nh3/keq_gl(3)
15851       kp_nh4cl = kp_nh3/keq_gl(4)
15852
15853
15854 ! solid-gas
15855       keq_sg(1)= fn_keq(4.72d-17,-74.38d0,6.12d0,t_k)/rt**2  ! nh4no3<=>nh3(g)+hno3(g)
15856       keq_sg(2)= fn_keq(8.43d-17,-71.00d0,2.40d0,t_k)/rt**2  ! nh4cl <=>nh3(g)+hcl(g)
15857
15858
15859 ! solid-liquid
15860       keq_sl(jnh4so4) = fn_keq(1.040d0,-2.65d0, 38.57d0, t_k)  ! amso4(s) = 2nh4+ + so4=
15861       keq_sl(jlvcite) = fn_keq(11.8d0, -5.19d0, 54.40d0, t_k)  ! lvcite(s)= 3nh4+ + hso4- + so4=
15862       keq_sl(jnh4hso4)= fn_keq(117.0d0,-2.87d0, 15.83d0, t_k)  ! amhso4(s)= nh4+ + hso4-
15863       keq_sl(jnh4msa) = 1.e15                            ! NH4MSA(s)= NH4+ + MSA-
15864       keq_sl(jnh4no3) = fn_keq(12.21d0,-10.4d0, 17.56d0, t_k)  ! nh4no3(s)= nh4+ + no3-
15865       keq_sl(jnh4cl)  = fn_keq(17.37d0,-6.03d0, 16.92d0, t_k)  ! nh4cl(s) = nh4+ + cl-
15866       keq_sl(jna2so4) = fn_keq(0.491d0, 0.98d0, 39.75d0, t_k)  ! na2so4(s)= 2na+ + so4=
15867       keq_sl(jnahso4) = fn_keq(313.0d0, 0.8d0,  14.79d0, t_k)  ! nahso4(s)= na+ + hso4-
15868       keq_sl(jna3hso4)= 1.e15                            ! na3h(so4)2(s) = 2na+ + hso4- + so4=
15869       keq_sl(jnamsa)  = 1.e15                            ! NaMSA(s) = Na+ + MSA-
15870       keq_sl(jnano3)  = fn_keq(11.95d0,-8.22d0, 16.01d0, t_k)  ! nano3(s) = na+ + no3-
15871       keq_sl(jnacl)   = fn_keq(38.28d0,-1.52d0, 16.89d0, t_k)  ! nacl(s)  = na+ + cl-
15872       keq_sl(jcacl2)  = fn_keq(8.0d11,32.84d0,44.79d0, t_k)*1.e5  ! cacl2(s) = ca++ + 2cl-
15873       keq_sl(jcano3)  = fn_keq(4.31d5, 7.83d0,42.01d0, t_k)*1.e5  ! ca(no3)2(s) = ca++ + 2no3-
15874       keq_sl(jcamsa2) = 1.e15                            ! CaMSA2(s)= Ca+ + 2MSA-
15875
15876       start_ind = 1
15877       if (vbs_nbin(1).eq.0) then
15878         start_ind = ismpa_g
15879       else if (vbs_nbin(1) .eq. 4) then
15880         start_ind = iasoaX_g
15881       else
15882         start_ind = ipcg1_b_c_g
15883       endif
15884
15885       do iv = start_ind, ngas_ioa + ngas_soa
15886         sat_soa(iv) = 0.0       ! [nmol/m^3(air)]
15887       enddo
15888
15889        if (vbs_nbin(1).eq.9) then
15890 ! vapor pressures of soa species
15891       po_soa(ipcg1_b_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15892       po_soa(ipcg2_b_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15893       po_soa(ipcg3_b_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15894       po_soa(ipcg4_b_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15895       po_soa(ipcg5_b_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15896       po_soa(ipcg6_b_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15897       po_soa(ipcg7_b_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15898       po_soa(ipcg8_b_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15899       po_soa(ipcg9_b_c_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15900       po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15901       po_soa(iopcg2_b_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15902       po_soa(iopcg3_b_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15903       po_soa(iopcg4_b_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15904       po_soa(iopcg5_b_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15905       po_soa(iopcg6_b_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15906       po_soa(iopcg7_b_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15907       po_soa(iopcg8_b_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15908       po_soa(ipcg1_b_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15909       po_soa(ipcg2_b_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15910       po_soa(ipcg3_b_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15911       po_soa(ipcg4_b_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15912       po_soa(ipcg5_b_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15913       po_soa(ipcg6_b_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15914       po_soa(ipcg7_b_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15915       po_soa(ipcg8_b_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15916       po_soa(ipcg9_b_o_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15917       po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15918       po_soa(iopcg2_b_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15919       po_soa(iopcg3_b_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15920       po_soa(iopcg4_b_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15921       po_soa(iopcg5_b_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15922       po_soa(iopcg6_b_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15923       po_soa(iopcg7_b_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15924       po_soa(iopcg8_b_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15925       po_soa(ipcg1_f_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15926       po_soa(ipcg2_f_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15927       po_soa(ipcg3_f_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15928       po_soa(ipcg4_f_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15929       po_soa(ipcg5_f_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15930       po_soa(ipcg6_f_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15931       po_soa(ipcg7_f_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15932       po_soa(ipcg8_f_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15933       po_soa(ipcg9_f_c_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15934       po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15935       po_soa(iopcg2_f_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15936       po_soa(iopcg3_f_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15937       po_soa(iopcg4_f_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15938       po_soa(iopcg5_f_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15939       po_soa(iopcg6_f_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15940       po_soa(iopcg7_f_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15941       po_soa(iopcg8_f_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15942       po_soa(ipcg1_f_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15943       po_soa(ipcg2_f_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15944       po_soa(ipcg3_f_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15945       po_soa(ipcg4_f_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15946       po_soa(ipcg5_f_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15947       po_soa(ipcg6_f_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15948       po_soa(ipcg7_f_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15949       po_soa(ipcg8_f_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15950       po_soa(ipcg9_f_o_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15951       po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15952       po_soa(iopcg2_f_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15953       po_soa(iopcg3_f_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15954       po_soa(iopcg4_f_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15955       po_soa(iopcg5_f_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15956       po_soa(iopcg6_f_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15957       po_soa(iopcg7_f_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15958       po_soa(iopcg8_f_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15959
15960       po_soa(iant1_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15961       po_soa(iant2_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15962       po_soa(iant3_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15963       po_soa(iant4_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15964       po_soa(iant1_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15965       po_soa(iant2_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15966       po_soa(iant3_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15967       po_soa(iant4_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15968       po_soa(ibiog1_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15969       po_soa(ibiog2_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15970       po_soa(ibiog3_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15971       po_soa(ibiog4_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15972       po_soa(ibiog1_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15973       po_soa(ibiog2_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15974       po_soa(ibiog3_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15975       po_soa(ibiog4_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15976       endif
15977
15978       if (vbs_nbin(1).eq.4) then
15979         po_soa(iasoaX_g) = fn_po(9.91d-10, 40.0d0, T_K) ! [Pascal]
15980         po_soa(iasoa1_g) = fn_po(9.91d-6, dhr_approx(0.0d0), T_K) ! [Pascal]
15981         po_soa(iasoa2_g) = fn_po(9.91d-5, dhr_approx(1.0d0), T_K) ! [Pascal]
15982         po_soa(iasoa3_g) = fn_po(9.91d-4, dhr_approx(2.0d0), T_K) ! [Pascal]
15983         po_soa(iasoa4_g) = fn_po(9.91d-3, dhr_approx(3.0d0), T_K) ! [Pascal]
15984         po_soa(ibsoaX_g) = fn_po(9.91d-10, 40.0d0, T_K) ! [Pascal]
15985         po_soa(ibsoa1_g) = fn_po(9.91d-6, dhr_approx(0.0d0), T_K) ! [Pascal]
15986         po_soa(ibsoa2_g) = fn_po(9.91d-5, dhr_approx(1.0d0), T_K) ! [Pascal]
15987         po_soa(ibsoa3_g) = fn_po(9.91d-4, dhr_approx(2.0d0), T_K) ! [Pascal]
15988         po_soa(ibsoa4_g) = fn_po(9.91d-3, dhr_approx(3.0d0), T_K) ! [Pascal]
15989       endif
15990
15991       if (vbs_nbin(1).eq.3) then
15992 ! these values for pcg and opcg gases are the same as vbs_nbin(1)==2
15993 ! below
15994         po_soa(ipcg1_b_c_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
15995         po_soa(ipcg2_b_c_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
15996         po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
15997         po_soa(ipcg1_b_o_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
15998         po_soa(ipcg2_b_o_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
15999         po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16000         po_soa(ipcg1_f_c_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16001         po_soa(ipcg2_f_c_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16002         po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16003         po_soa(ipcg1_f_o_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16004         po_soa(ipcg2_f_o_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16005         po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16006 ! these values for ant and bio gases are from manish wrfchem 3.5
16007         po_soa(iant1_c_g)    = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16008         po_soa(iant2_c_g)    = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16009         po_soa(iant3_c_g)    = fn_po(9.91d-5,  94.0d0, T_K) ! [Pascal]
16010         po_soa(iant4_c_g)    = fn_po(9.91d-4,  88.0d0, T_K) ! [Pascal]
16011         po_soa(ibiog1_c_g)   = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16012         po_soa(ibiog2_c_g)   = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16013         po_soa(ibiog3_c_g)   = fn_po(9.91d-5,  94.0d0, T_K) ! [Pascal]
16014         po_soa(ibiog1_o_g)   = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16015         po_soa(ibiog2_o_g)   = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16016       endif
16017
16018       if (vbs_nbin(1).eq.2) then
16019       po_soa(ipcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16020       po_soa(ipcg2_b_c_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16021       po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16022       po_soa(ipcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16023       po_soa(ipcg2_b_o_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16024       po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16025       po_soa(ipcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16026       po_soa(ipcg2_f_c_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16027       po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16028       po_soa(ipcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16029       po_soa(ipcg2_f_o_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16030       po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16031       po_soa(iant1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16032       po_soa(iant1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16033       po_soa(ibiog1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16034       po_soa(ibiog1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16035       endif
16036       if (vbs_nbin(1).eq.0) then
16037         po_soa(ismpa_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16038         po_soa(ismpbb_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16039         po_soa(ibiog1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16040         po_soa(ibiog1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16041       endif
16042
16043       start_ind = 1
16044       if (vbs_nbin(1).eq.0) then
16045         start_ind = ismpa_g
16046       else if (vbs_nbin(1).eq.4) then
16047         start_ind = iasoaX_g
16048       else
16049         start_ind = ipcg1_b_c_g
16050       end if
16051
16052       do iv = start_ind, ngas_ioa + ngas_soa
16053         sat_soa(iv) = 1.e9*po_soa(iv)/(8.314*t_k)       ! [nmol/m^3(air)]
16054       enddo
16055
16056 ! water surface tension
16057       term = (647.15 - t_k)/647.15
16058       sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
16059
16060 ! mdrh(t)
16061       do j_index = 1, 63
16062         mdrh_t(j_index) = drh_mutual(j_index)
16063       enddo
16064
16065
16066
16067 ! rh dependent parameters
16068       do ibin = 1, nbin_a
16069         ah2o_a(ibin) = ah2o                     ! initialize
16070       enddo
16071
16072       call mtem_compute_log_gamz                ! function of ah2o and t
16073
16074 ! raz update 6/25/2008 - start
16075       gam_nh4no3_0 = 10.**log_gamZ(jnh4no3,jnh4no3)
16076       gam_nh4cl_0  = 10.**log_gamZ(jnh4cl,jnh4cl)
16077
16078       m_nh4no3_0   = molality_0(jnh4no3)
16079       m_nh4cl_0    = molality_0(jnh4cl)
16080
16081       Kp_nh4no3_0  = Kp_nh4no3*(m_nh4no3_0*gam_nh4no3_0)**2
16082       Kp_nh4cl_0   = Kp_nh4cl *(m_nh4cl_0 *gam_nh4cl_0 )**2
16083 ! raz update 6/25/2008 - end
16084
16085
16086
16087       return
16088       end subroutine update_thermodynamic_constants
16089
16090       ! Function to approximate enthalpy of vaporization for
16091       ! semi-volatile organic aerosols as a function of volatility
16092       ! from Epstein et al., ES&T, 2010
16093       ! http://pubs.acs.org/doi/abs/10.1021/es902497z
16094       real(kind=8) function dhr_approx(log10_Csat_298)
16095
16096         real(kind=8), intent(in) :: log10_Csat_298
16097
16098         dhr_approx = -11.0 * log10_Csat_298 + 131.0 ! kJ/mol
16099
16100       end function dhr_approx
16101
16102
16103
16104 !***********************************************************************
16105 ! functions used in mosaic
16106 !
16107 ! author: rahul a. zaveri
16108 ! update: jan 2005
16109 !-----------------------------------------------------------------------
16110
16111
16112
16113 !----------------------------------------------------------
16114       real(kind=8) function fn_keq(keq_298, a, b, t)
16115 !     implicit none
16116 ! subr. arguments
16117       real(kind=8) keq_298, a, b, t
16118 ! local variables
16119       real(kind=8) tt
16120
16121
16122         tt = 298.15/t
16123         fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+log(tt)-tt))
16124
16125       return
16126       end function fn_keq
16127 !----------------------------------------------------------
16128
16129
16130
16131
16132
16133 !----------------------------------------------------------
16134       real(kind=8) function fn_po(po_298, dh, t)        ! touch
16135 !     implicit none
16136 ! subr. arguments
16137       real(kind=8) po_298, dh, t
16138 ! local variables
16139
16140         fn_po = po_298*exp(-(dh/8.314e-3)*(1./t - 3.354016435e-3))
16141
16142       return
16143       end function fn_po
16144 !----------------------------------------------------------
16145
16146
16147
16148
16149
16150 !----------------------------------------------------------
16151       real(kind=8) function drh_mutual(j_index)
16152 !     implicit none
16153 !     include 'mosaic.h'
16154 ! subr. arguments
16155       integer j_index
16156 ! local variables
16157       integer j
16158
16159
16160       j = j_index
16161
16162       if(j_index .eq. 7 .or. j_index .eq. 8 .or.   &
16163         (j_index.ge. 34 .and. j_index .le. 51))then
16164
16165         drh_mutual = 10.0  ! cano3 or cacl2 containing mixtures
16166
16167       else
16168
16169         drh_mutual =  d_mdrh(j,1) + t_k*   &
16170                      (d_mdrh(j,2) + t_k*   &
16171                      (d_mdrh(j,3) + t_k*   &
16172                       d_mdrh(j,4) )) + 1.0
16173
16174       endif
16175
16176
16177       return
16178       end function drh_mutual
16179 !----------------------------------------------------------
16180
16181
16182
16183
16184
16185
16186 !----------------------------------------------------------
16187 ! zsr method at 60% rh
16188 !
16189       real(kind=8) function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
16190 !     implicit none
16191 !     include 'mosaic.h'
16192 ! subr. arguments
16193       integer ibin
16194 ! local variables
16195       integer jp, je
16196       real(kind=8) dum
16197 ! function
16198 !     real(kind=8) bin_molality_60
16199
16200
16201       jp = jtotal
16202       dum = 0.0
16203
16204       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
16205         dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
16206       enddo
16207
16208       aerosol_water_up = dum
16209
16210       return
16211       end function aerosol_water_up
16212 !----------------------------------------------------------
16213
16214
16215
16216
16217
16218
16219 !----------------------------------------------------------
16220 ! zsr method
16221 !
16222 ! RAZ 5/21/2014: Included organics, oin, and bc in water absorption (but does not include organic-inorganic interactions)
16223 !
16224       real(kind=8) function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
16225 !     implicit none
16226 !     include 'mosaic.h'
16227 ! subr. arguments
16228       integer jp, ibin
16229 ! local variables
16230       integer ja, je
16231       real(kind=8) dum, tmpa
16232 ! function
16233 !     real(kind=8) bin_molality
16234
16235
16236       dum = 0.0
16237       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
16238         dum = dum + electrolyte(je,jp,ibin)/bin_molality(je,ibin)
16239       enddo
16240
16241       if (mwater_kappa_nonelectro > 0) then
16242          tmpa = 0.0
16243          do ja = 1, naer
16244             if (kappa_nonelectro(ja) > 0.0) then
16245                tmpa = tmpa + (aer(ja,jtotal,ibin)*mw_aer_mac(ja)/dens_aer_mac(ja))*kappa_nonelectro(ja)
16246             end if
16247          end do
16248          dum = dum + 1.0e-3*tmpa*aH2O_a(ibin)/(1.0-aH2O_a(ibin))
16249       end if
16250
16251       aerosol_water = dum*1.e-9  ! kg(water)/m^3(air)
16252
16253       if(aerosol_water .le. 0.0)then
16254         if (iprint_mosaic_diag1 .gt. 0) then
16255           write(6,*)'mosaic aerosol_water - water .le. 0'
16256           write(6,*)'iclm  jclm  ibin  jp = ',   &
16257                      iclm_aer, jclm_aer, ibin, jp
16258           write(6,*)'ah2o, water = ', ah2o, aerosol_water
16259           write(6,*)'dry mass = ', mass_dry_a(ibin)
16260           write(6,*)'soluble mass = ', mass_soluble_a(ibin)
16261           write(6,*)'number = ', num_a(ibin)
16262           do je = 1, nsoluble
16263             write(6,44)ename(je), electrolyte(je,jp,ibin)
16264           enddo
16265           write(6,*)'error in water calculation'
16266           write(6,*)'ibin = ', ibin
16267           write(6,*)'water content cannot be negative or zero'
16268           write(6,*)'setting jaerosolstate to all_solid'
16269         endif
16270
16271         call print_input
16272
16273         jaerosolstate(ibin) = all_solid
16274         jphase(ibin)    = jsolid
16275         jhyst_leg(ibin) = jhyst_lo
16276
16277 !c        write(6,*)'stopping execution in function aerosol_water'
16278 !c        stop
16279       endif
16280
16281 44    format(a7, 2x, e11.3)
16282
16283
16284       return
16285       end function aerosol_water
16286 !----------------------------------------------------------
16287
16288
16289
16290
16291
16292 !----------------------------------------------------------
16293       real(kind=8) function bin_molality(je,ibin)
16294 !     implicit none
16295 !     include 'mosaic.h'
16296 ! subr. arguments
16297       integer je, ibin
16298 ! local variables
16299       real(kind=8) aw, xm
16300
16301
16302       aw = max(ah2o_a(ibin), aw_min(je))
16303       aw = min(aw, 0.999999D0)
16304
16305
16306       if(aw .lt. 0.97)then
16307
16308         xm =     a_zsr(1,je) +   &
16309              aw*(a_zsr(2,je) +   &
16310              aw*(a_zsr(3,je) +   &
16311              aw*(a_zsr(4,je) +   &
16312              aw*(a_zsr(5,je) +   &
16313              aw* a_zsr(6,je) ))))
16314
16315         bin_molality = 55.509*xm/(1. - xm)
16316
16317       else
16318
16319         bin_molality = -b_zsr(je)*log(aw)
16320
16321       endif
16322
16323
16324       return
16325       end function bin_molality
16326 !----------------------------------------------------------
16327
16328
16329
16330
16331
16332 !----------------------------------------------------------
16333       real(kind=8) function bin_molality_60(je)
16334 !     implicit none
16335 !     include 'mosaic.h'
16336 ! subr. arguments
16337       integer je
16338 ! local variables
16339       real(kind=8) aw, xm
16340
16341
16342       aw = 0.6
16343
16344         xm =  a_zsr(1,je) + aw*   &
16345              (a_zsr(2,je) + aw*   &
16346              (a_zsr(3,je) + aw*   &
16347              (a_zsr(4,je) + aw*   &
16348              (a_zsr(5,je) + aw*   &
16349               a_zsr(6,je) ))))
16350
16351       bin_molality_60 = 55.509*xm/(1. - xm)
16352
16353       return
16354       end function bin_molality_60
16355 !----------------------------------------------------------
16356
16357
16358 !----------------------------------------------------------
16359 ! raz update 6/25/2008 - start
16360       real(kind=8) function molality_0(je)
16361 !      implicit none
16362 ! subr. arguments
16363       integer je
16364 ! local variables
16365       real(kind=8) :: aw, xm
16366
16367
16368       aw = max(ah2o, aw_min(je))
16369       aw = min(aw, 0.999999d0)
16370
16371
16372       if(aw .lt. 0.97)then
16373
16374         xm =     a_zsr(1,je) +   &
16375              aw*(a_zsr(2,je) +   &
16376              aw*(a_zsr(3,je) +   &
16377              aw*(a_zsr(4,je) +   &
16378              aw*(a_zsr(5,je) +   &
16379              aw* a_zsr(6,je) ))))
16380
16381         molality_0 = 55.509*xm/(1. - xm)
16382
16383       else
16384
16385         molality_0 = -b_zsr(je)*log(aw)
16386
16387       endif
16388
16389
16390       return
16391       end function molality_0
16392 ! raz update 6/25/2008 - end
16393 !----------------------------------------------------------
16394
16395
16396 !----------------------------------------------------------
16397       real(kind=8) function fnlog_gamz(ja,je)   ! ja in je
16398 !     implicit none
16399 !     include 'mosaic.h'
16400 ! subr. arguments
16401       integer ja, je
16402 ! local variables
16403       real(kind=8) aw
16404
16405
16406       aw = max(ah2o, aw_min(je))
16407
16408       fnlog_gamz = b_mtem(1,ja,je) + aw*   &
16409                   (b_mtem(2,ja,je) + aw*   &
16410                   (b_mtem(3,ja,je) + aw*   &
16411                   (b_mtem(4,ja,je) + aw*   &
16412                   (b_mtem(5,ja,je) + aw*   &
16413                    b_mtem(6,ja,je) ))))
16414
16415       return
16416       end function fnlog_gamz
16417 !----------------------------------------------------------
16418
16419
16420
16421
16422 !----------------------------------------------------------
16423       real(kind=8) function mean_molecular_speed(t, mw) ! in cm/s
16424 !     implicit none
16425 ! subr. arguments
16426       real(kind=8) t, mw        ! t(k)
16427
16428         mean_molecular_speed = 1.455e4 * sqrt(t/mw)
16429
16430       return
16431       end function mean_molecular_speed
16432 !----------------------------------------------------------
16433
16434
16435
16436
16437 !----------------------------------------------------------
16438       real(kind=8) function gas_diffusivity(t, p, mw, vm)       ! in cm^2/s
16439 !     implicit none
16440 ! subr. arguments
16441       real(kind=8) mw, vm, t, p ! t(k), p(atm)
16442
16443
16444       gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/   &
16445                              (p * (vm**0.333333 + 2.7189)**2)
16446
16447
16448       return
16449       end function gas_diffusivity
16450 !----------------------------------------------------------
16451
16452
16453
16454
16455 !----------------------------------------------------------
16456       real(kind=8) function fuchs_sutugin(rkn,a)
16457 !     implicit none
16458 ! subr. arguments
16459       real(kind=8) rkn, a
16460 ! local variables
16461       real(kind=8) rnum, denom
16462
16463
16464       rnum  = 0.75*a*(1. + rkn)
16465       denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
16466       fuchs_sutugin = rnum/denom
16467
16468       return
16469       end function fuchs_sutugin
16470 !----------------------------------------------------------
16471
16472
16473
16474 !----------------------------------------------------------
16475     real(kind=8) function acc_n2o5_bert_thorn(mass_h2o,mol_no3,mol_cl,vol)
16476         ! Composition dependent mass accommodation coefficient.
16477         ! After Bertram and Thornton, ACP, 2009
16478         !
16479         ! acc_N2O5 = A*(b-b*exp(-d*[H2O(l)]))
16480         !                       * (1-1/(1+(k3'*[H2O(l)]/[NO3-])+(k4'*[Cl-]/[NO3-])))
16481         ! where:
16482         ! acc_N2O5 = accommodation coefficient of N2O5 on the aerosol
16483         ! A = factor for experimental conditions = 3.2e-8 s
16484         ! b = 1.15e6 s^-1
16485         ! d = 1.3e-1 M^-1
16486         ! [H2O(l)] = H2O Molarity
16487         ! k3' (=k3/k2b) = 6.0e-2
16488         ! k4' (=k4/k2b) = 29e0
16489         ! [Cl-] = Cl- Molarity
16490         ! [NO3-] = NO3- Molarity
16491
16492         ! define set factors for scheme
16493         real(kind=8), parameter :: A_bt  = 3.2e-8
16494         real(kind=8), parameter :: b_bt  = 1.15e6
16495         real(kind=8), parameter :: d_bt  = 1.3e-1
16496         real(kind=8), parameter :: k3_bt = 6.0e-2
16497         real(kind=8), parameter :: k4_bt = 29e0
16498
16499         ! internal conversion factors
16500         real(kind=8), parameter :: nmol_mol = 1e-9      ! convert nmol->mol
16501         real(kind=8), parameter :: m3_litre = 1e3       ! convert m3->litre
16502         real(kind=8), parameter :: mm_h2o   = 18e-3     ! molar mass (kg/mol)
16503
16504         ! input variables
16505         real(kind=8) :: mass_h2o        ! kg(water)/m^3(air)
16506         real(kind=8) :: mol_no3         ! nmol/m^3(air?)
16507         real(kind=8) :: mol_cl          ! nmol/m^3(air?)
16508         real(kind=8) :: vol                     ! cc/cc(air) - wet volume
16509
16510         ! internal variables
16511         real(kind=8) :: part_step
16512         real(kind=8) :: aer_h2o, aer_no3, aer_cl        ! molarity - mol/litre(solution)
16513
16514
16515         ! extract and convert aerosol data from inputs to Moles/litre(solution)
16516         aer_h2o = mass_h2o / (mm_h2o*vol*m3_litre)
16517         aer_no3 = mol_no3*nmol_mol / (vol*m3_litre)
16518         aer_cl  = mol_cl*nmol_mol / (vol*m3_litre)
16519
16520         if(n2o5_flag.eq.1)then ! switch off Cl pathway
16521                 aer_cl = 0.0
16522         end if
16523
16524         if(aer_h2o .ne. 0.0)then
16525                 part_step =  b_bt - b_bt * exp(-d_bt*aer_h2o)
16526                 if(aer_no3 .ne. 0.0)then
16527                         acc_n2o5_bert_thorn = A_bt * part_step *  &
16528                                         (1.0 - 1.0 / (                    &
16529                                                 1.0 +                         &
16530                                                 (k3_bt*aer_h2o/aer_no3) +     &
16531                                                 (k4_bt*aer_cl/aer_no3)        &
16532                                         ))
16533                 else
16534                         acc_n2o5_bert_thorn = A_bt * part_step
16535                 endif
16536         else ! if no aerosol water then don't take up N2O5
16537                 acc_n2o5_bert_thorn = 0.0
16538         endif
16539
16540         return
16541         end function acc_n2o5_bert_thorn
16542 !-------------------------------------------------------------
16543
16544
16545 !-------------------------------------------------------------
16546         real(kind=8) function split_n2o5_bert_thorn(mass_h2o,mol_cl,vol)
16547         ! Hetereogeneous reaction of N2O5 with H2O(l) and Cl-(aq)
16548         ! after Bertram and Thornton, ACP, 2009
16549         ! Subroutine for splitting reaction pathways
16550         !
16551         ! R3f = 1 / (1+(k4'[Cl-])/(k3'[H2O(l)])) (H2O pathway)
16552         ! R4f = 1 / (1+(k3'[H2O(l)])/(k4'[Cl-])) (Cl- pathway)
16553         ! where:
16554         ! R3f = fraction of N2O5 that reacts with H2O
16555         ! R4f = fraction of N2O5 that reacts with Cl-
16556         ! [H2O(l)] = H2O Molarity
16557         ! [Cl-] = Cl- Molarity
16558         ! k3' (=k3/k2b) = 6.0e-2
16559         ! k4' (=k4/k2b) = 29e0
16560         !
16561         ! This function outputs the fraction of N2O5 which reacts
16562         ! with H2O
16563
16564         ! define parameters for the scheme
16565         real(kind=8), parameter :: k3_bt = 6.0e-2
16566         real(kind=8), parameter :: k4_bt = 29e0
16567
16568         ! internal conversion factors
16569         real(kind=8), parameter :: nmol_mol = 1e-9      ! convert nmol->mol
16570         real(kind=8), parameter :: m3_litre = 1e3       ! convert m3->litre
16571         real(kind=8), parameter :: mm_h2o   = 18e-3     ! molar mass (kg/mol)
16572
16573         ! input variables
16574         real(kind=8) :: mass_h2o        ! kg(water)/m^3(air)
16575         real(kind=8) :: mol_cl          ! nmol/m^3(air?)
16576         real(kind=8) :: vol                     ! cc/cc(air) - wet volume
16577
16578         ! internal variables
16579         real(kind=8) :: part_step
16580         real(kind=8) :: aer_h2o, aer_cl ! molarity - mol/litre(solution)
16581
16582
16583         ! extract and convert aerosol data from inputs to Moles/litre(solution)
16584         aer_h2o = mass_h2o / (mm_h2o*vol*m3_litre)
16585         aer_cl  = mol_cl*nmol_mol / (vol*m3_litre)
16586
16587         if(n2o5_flag.eq.1)then ! switch off Cl pathway
16588                 aer_cl = 0.0
16589         end if
16590
16591         if(aer_h2o .ne. 0.0)then
16592                 split_n2o5_bert_thorn = 1e0 / &
16593                                         ( 1e0 + (k4_bt*aer_cl)/(k3_bt*aer_h2o) )
16594         else
16595                 split_n2o5_bert_thorn = 0.0
16596         endif
16597
16598
16599
16600         return
16601         end function split_n2o5_bert_thorn
16602 !-------------------------------------------------------------
16603
16604
16605
16606
16607
16608
16609 !----------------------------------------------------------
16610 ! solution to x^3 + px^2 + qx + r = 0
16611 !
16612       real(kind=8) function cubic( p, q, r )
16613 !     implicit none
16614 ! subr arguments
16615       real(kind=8), intent(in) :: p, q, r
16616 ! local variables
16617       real(kind=8) a, b, d, m, n, third, y
16618       real(kind=8) k, phi, thesign, x(3), duma
16619       integer icase, kk
16620
16621       third = 1.d0/3.d0
16622
16623       a = (1.d0/3.d0)*((3.d0*q) - (p*p))
16624       b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
16625
16626       d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
16627
16628       if(d .gt. 0.)then !       => 1 real and 2 complex roots
16629         icase = 1
16630       elseif(d .eq. 0.)then !   => 3 real roots, atleast 2 identical
16631         icase = 2
16632       else      ! d < 0         => 3 distinct real roots
16633         icase = 3
16634       endif
16635
16636
16637       goto (1,2,3), icase
16638
16639 ! case 1: d > 0
16640 1     thesign = 1.
16641       if(b .gt. 0.)then
16642         b = -b
16643         thesign = -1.
16644       endif
16645
16646       m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
16647       n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
16648
16649       cubic = real( (m) + (n) - (p/3.d0) )
16650       return
16651
16652 ! case 2: d = 0
16653 2     thesign = 1.
16654       if(b .gt. 0.)then
16655         b = -b
16656         thesign = -1.
16657       endif
16658
16659       m = thesign*(-b/2.d0)**third
16660       n = m
16661
16662       x(1) = real( (m) + (n) - (p/3.d0) )
16663       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
16664       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
16665
16666       cubic = 0.
16667       do kk = 1, 3
16668         if(x(kk).gt.cubic) cubic = x(kk)
16669       enddo
16670       return
16671
16672 ! case 3: d < 0
16673 3     if(b.gt.0.)then
16674         thesign = -1.
16675       elseif(b.lt.0.)then
16676         thesign = 1.
16677       endif
16678
16679 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
16680 !     phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) ))     ! radians
16681       duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
16682       duma = min( duma, +1.0D0 )
16683       duma = max( duma, -1.0D0 )
16684       phi  = acos( duma )       ! radians
16685
16686
16687       cubic = 0.
16688       do kk = 1, 3
16689         k = kk-1
16690         y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
16691         x(kk) = real((y) - (p/3.d0))
16692         if(x(kk).gt.cubic) cubic = x(kk)
16693       enddo
16694       return
16695
16696       end function cubic
16697 !----------------------------------------------------------
16698
16699
16700
16701
16702 !----------------------------------------------------------
16703       real(kind=8) function quadratic(a,b,c)
16704 !     implicit none
16705 ! subr. arguments
16706       real(kind=8) a, b, c
16707 ! local variables
16708       real(kind=8) x, dum, quad1, quad2
16709
16710
16711         if(b .ne. 0.0)then
16712         x = 4.*(a/b)*(c/b)
16713         else
16714         x = 1.e+6
16715         endif
16716
16717         if(abs(x) .lt. 1.e-6)then
16718           dum = (0.5*x) +   &
16719                 (0.125*x**2) +   &
16720                 (0.0625*x**3)
16721
16722           quadratic = (-0.5*b/a)*dum
16723
16724           if(quadratic .lt. 0.)then
16725             quadratic = -b/a - quadratic
16726           endif
16727
16728         else
16729           quad1 = (-b+sqrt(b*b-4.*a*c))/(2.*a)
16730           quad2 = (-b-sqrt(b*b-4.*a*c))/(2.*a)
16731
16732           quadratic = max(quad1, quad2)
16733         endif
16734
16735       return
16736       end function quadratic
16737 !----------------------------------------------------------
16738
16739
16740
16741 !----------------------------------------------------------
16742 ! currently not used
16743
16744 ! two roots of a quadratic equation
16745
16746       subroutine quadratix(a,b,c, qx1,qx2)
16747 !      implicit none
16748 ! subr. arguments
16749       real(kind=8) a, b, c, qx1, qx2
16750 ! local variables
16751       real(kind=8) x, dum
16752
16753
16754       if(b .ne. 0.0)then
16755         x = 4.*(a/b)*(c/b)
16756         else
16757         x = 1.e+6
16758       endif
16759
16760       if(abs(x) .lt. 1.e-6)then
16761         dum = (0.5*x) +   &
16762               (0.125*x**2) +   &
16763               (0.0625*x**3)
16764
16765         qx1 = (-0.5*b/a)*dum
16766         qx2 = -b/a - qx1
16767
16768       else
16769
16770         qx1 = (-b+sqrt(b*b - 4.*a*c))/(2.*a)
16771         qx2 = (-b-sqrt(b*b - 4.*a*c))/(2.*a)
16772
16773       endif
16774
16775       return
16776       end subroutine quadratix
16777
16778
16779 !=====================================================================
16780
16781
16782
16783
16784
16785
16786
16787
16788
16789
16790
16791
16792
16793
16794
16795
16796
16797 !***********************************************************************
16798 !  save aerosol drymass and drydens before aerosol mass transfer is
16799 !  calculated this subr is called from within subr mosaic_dynamic_solver,
16800 !  after the initial calls to check_aerosol_mass, conform_electrolytes,
16801 !  conform_aerosol_number, and aerosol_phase_state, but before the mass
16802 !  transfer is calculated
16803 !
16804 ! author: richard c. easter
16805 !-----------------------------------------------------------------------
16806       subroutine save_pregrow_props
16807
16808       use module_data_mosaic_asect
16809       use module_data_mosaic_other
16810
16811 !     implicit none
16812 !     include 'v33com'
16813 !     include 'v33com9a'
16814 !     include 'v33com9b'
16815 !     include 'mosaic.h'
16816
16817 !   subr arguments (none)
16818
16819 !   local variables
16820       integer ibin, isize, itype
16821
16822
16823 ! air conc in mol/cm^3
16824       cair_mol_cc = cairclm(kclm_aer)
16825
16826 ! compute then save drymass and drydens for each bin
16827       do ibin = 1, nbin_a
16828
16829       call calc_dry_n_wet_aerosol_props( ibin )
16830
16831       call isize_itype_from_ibin( ibin, isize, itype )
16832       drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc       ! g/mol(air)
16833       if(jaerosolstate(ibin) .eq. no_aerosol) then
16834           drydens_pregrow(isize,itype) = -1.
16835       else
16836           drydens_pregrow(isize,itype) = dens_dry_a(ibin)               ! g/cc
16837       end if
16838
16839       end do
16840
16841       return
16842       end subroutine save_pregrow_props
16843
16844
16845
16846
16847
16848
16849
16850 !***********************************************************************
16851 ! special output
16852 !
16853 ! author: richard c. easter
16854 !-----------------------------------------------------------------------
16855         subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
16856
16857 !       implicit none
16858
16859         integer iclm, jclm, kclm, msub
16860         character*(*) fromwhere
16861
16862         return
16863         end subroutine specialoutaa
16864
16865
16866
16867
16868 !***********************************************************************
16869 ! box model test output
16870 !
16871 ! author: richard c. easter
16872 !-----------------------------------------------------------------------
16873         subroutine aerchem_boxtest_output(   &
16874                 iflag, iclm, jclm, kclm, msub, dtchem )
16875
16876         use module_data_mosaic_asect
16877         use module_data_mosaic_other
16878 !       implicit none
16879
16880 !       include 'v33com'
16881 !       include 'v33com2'
16882 !       include 'v33com9a'
16883
16884         integer iflag, iclm, jclm, kclm, msub
16885         real(kind=8) dtchem
16886
16887 !   local variables
16888         integer lun
16889         parameter (lun=83)
16890         integer, save :: ientryno = -13579
16891         integer icomp, iphase, isize, itype, k, l, m, n
16892
16893         real(kind=8) dtchem_sv1
16894         save dtchem_sv1
16895         real(kind=8) rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
16896
16897
16898 !   bypass unless maerchem_boxtest_output > 0
16899         if (maerchem_boxtest_output .le. 0) return
16900
16901
16902
16903 !
16904 ! *** currently this only works for ntype_aer = 1
16905 !
16906         itype = 1
16907         iphase = ai_phase
16908
16909 !   do initial output
16910         if (ientryno .ne. -13579) goto 1000
16911
16912         ientryno = +1
16913         call peg_message( lunerr, '***' )
16914         call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
16915         call peg_message( lunerr, '***' )
16916
16917         write(lun) ltot, ltot2, itot, jtot, ktot
16918         write(lun) (name(l), l=1,ltot2)
16919
16920         write(lun) maerocoag, maerchem, maeroptical
16921         write(lun) msectional, maerosolincw
16922
16923         write(lun) nsize_aer(itype), ntot_mastercomp_aer
16924
16925         do icomp = 1, ntot_mastercomp_aer
16926             write(lun)   &
16927                 name_mastercomp_aer(icomp)
16928             write(lun)   &
16929                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
16930         end do
16931
16932         do isize = 1, nsize_aer(itype)
16933             write(lun)   &
16934                 ncomp_plustracer_aer(itype),   &
16935                 ncomp_aer(itype),   &
16936                 waterptr_aer(isize,itype),   &
16937                 numptr_aer(isize,itype,iphase),   &
16938                 mprognum_aer(isize,itype,iphase)
16939             write(lun)   &
16940               ( mastercompptr_aer(l,itype),   &
16941                 massptr_aer(l,isize,itype,iphase),   &
16942                 l=1,ncomp_plustracer_aer(itype) )
16943             write(lun)   &
16944                 volumcen_sect(isize,itype),   &
16945                 volumlo_sect(isize,itype),   &
16946                 volumhi_sect(isize,itype),   &
16947                 dcen_sect(isize,itype),   &
16948                 dlo_sect(isize,itype),   &
16949                 dhi_sect(isize,itype)
16950             write(lun)   &
16951                 lptr_so4_aer(isize,itype,iphase),   &
16952                 lptr_msa_aer(isize,itype,iphase),   &
16953                 lptr_no3_aer(isize,itype,iphase),   &
16954                 lptr_cl_aer(isize,itype,iphase),   &
16955                 lptr_co3_aer(isize,itype,iphase),   &
16956                 lptr_nh4_aer(isize,itype,iphase),   &
16957                 lptr_na_aer(isize,itype,iphase),   &
16958                 lptr_ca_aer(isize,itype,iphase),   &
16959                 lptr_oin_aer(isize,itype,iphase),   &
16960                 lptr_oc_aer(isize,itype,iphase),   &
16961                 lptr_bc_aer(isize,itype,iphase),   &
16962                 hyswptr_aer(isize,itype)
16963         end do
16964
16965 !
16966 !   test iflag
16967 !
16968 1000    continue
16969         if (iflag .eq. 1) goto 1010
16970         if (iflag .eq. 2) goto 2000
16971         if (iflag .eq. 3) goto 3000
16972         return
16973
16974 !
16975 !   iflag=1 -- save initial values
16976 !
16977 1010    continue
16978         dtchem_sv1 = dtchem
16979         do m = 1, nsubareas
16980         do k = 1, ktot
16981         do l = 1, ltot2
16982             rsub_sv1(l,k,m) = rsub(l,k,m)
16983         end do
16984         end do
16985         end do
16986
16987         return
16988
16989 !
16990 !   iflag=2 -- save intermediate values before doing move_sections
16991 !   (this is deactivated for now)
16992 !
16993 2000    continue
16994         return
16995
16996
16997 !
16998 !   iflag=3 -- do output
16999 !
17000 3000    continue
17001         do m = 1, nsubareas
17002         do k = 1, ktot
17003
17004         write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
17005         write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
17006                 ptotclm(k), afracsubarea(k,m)
17007
17008         write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
17009
17010         end do
17011         end do
17012
17013
17014         return
17015         end subroutine aerchem_boxtest_output
17016
17017
17018
17019 !***********************************************************************
17020 ! 'debugging' output when mosaic encounters 'fatal error' situation
17021 !
17022 ! author: richard c. easter
17023 !-----------------------------------------------------------------------
17024         subroutine mosaic_aerchem_error_dump( istop, ibin, luna, msga )
17025 !
17026 !   dumps current column information when a fatal computational error occurs
17027 !   when istop>0, the simulation is halted
17028 !
17029         use module_data_mosaic_asect
17030         use module_data_mosaic_other
17031 !       implicit none
17032
17033 !   arguments
17034         integer istop, ibin, luna
17035         character*(*) msga
17036
17037 !   local variables
17038         integer icomp, iphase, isize, itype, k, l, lunb, m, n
17039         real(kind=8) dtchem_sv1
17040
17041
17042 !
17043 ! *** currently this only works for ntype_aer = 1
17044 !
17045         itype = 1
17046
17047
17048         lunb = luna
17049         if (lunb .le. 0) lunb = 6
17050
17051 9000    format( a )
17052 9010    format( 7i10 )
17053 9020    format( 3(1pe19.11) )
17054
17055         write(lunb,9000)
17056         write(lunb,9000) 'begin mosaic_aerchem_error_dump - msga ='
17057         write(lunb,9000) msga
17058         write(lunb,9000) 'i, j, k, msub,ibin ='
17059         write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
17060
17061         write(lunb,9010) ltot, ltot2, itot, jtot, ktot
17062         write(lunb,9000) (name(l), l=1,ltot2)
17063
17064         write(lunb,9010) maerocoag, maerchem, maeroptical
17065         write(lunb,9010) msectional, maerosolincw
17066
17067         write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
17068
17069         do icomp = 1, ntot_mastercomp_aer
17070             write(lunb,9000)   &
17071                 name_mastercomp_aer(icomp)
17072             write(lunb,9020)   &
17073                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
17074         end do
17075
17076         do isize = 1, nsize_aer(itype)
17077             write(lunb,9010)   &
17078                 ncomp_plustracer_aer(itype),   &
17079                 ncomp_aer(itype),   &
17080                 waterptr_aer(isize,itype),   &
17081                 numptr_aer(isize,itype,iphase),   &
17082                 mprognum_aer(isize,itype,iphase)
17083             write(lunb,9010)   &
17084               ( mastercompptr_aer(l,itype),   &
17085                 massptr_aer(l,isize,itype,iphase),   &
17086                 l=1,ncomp_plustracer_aer(itype) )
17087             write(lunb,9020)   &
17088                 volumcen_sect(isize,itype),   &
17089                 volumlo_sect(isize,itype),   &
17090                 volumhi_sect(isize,itype),   &
17091                 dcen_sect(isize,itype),   &
17092                 dlo_sect(isize,itype),   &
17093                 dhi_sect(isize,itype)
17094             write(lunb,9010)   &
17095                 lptr_so4_aer(isize,itype,iphase),   &
17096                 lptr_msa_aer(isize,itype,iphase),   &
17097                 lptr_no3_aer(isize,itype,iphase),   &
17098                 lptr_cl_aer(isize,itype,iphase),   &
17099                 lptr_co3_aer(isize,itype,iphase),   &
17100                 lptr_nh4_aer(isize,itype,iphase),   &
17101                 lptr_na_aer(isize,itype,iphase),   &
17102                 lptr_ca_aer(isize,itype,iphase),   &
17103                 lptr_oin_aer(isize,itype,iphase),   &
17104                 lptr_oc_aer(isize,itype,iphase),   &
17105                 lptr_bc_aer(isize,itype,iphase),   &
17106                 hyswptr_aer(isize,itype)
17107         end do
17108
17109
17110         dtchem_sv1 = -1.0
17111         do m = 1, nsubareas
17112         do k = 1, ktot
17113
17114         write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
17115         write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
17116                 ptotclm(k), afracsubarea(k,m)
17117
17118         write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
17119
17120         end do
17121         end do
17122
17123         write(lunb,9000) 'end mosaic_aerchem_error_dump'
17124
17125
17126         if (istop .gt. 0) call peg_error_fatal( luna, msga )
17127
17128         return
17129         end subroutine mosaic_aerchem_error_dump
17130 !-----------------------------------------------------------------------
17131
17132       end module module_mosaic_therm
17133