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,do_ph )
  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       integer, intent(in) :: do_ph
 111       real, optional, intent(out), dimension(kms:kme) ::                       &
 112             ph_aer1, ph_aer2, ph_aer3, ph_aer4       ! pH of the aerosols
 113 !   local variables
 114       real(kind=8) :: dtchem
 115       integer k, m
 116
 117
 118
 119       dtchem = dtchem_sngl
 120
 121       lunerr_aer = lunerr
 122       ncorecnt_aer = ncorecnt
 123
 124 !   special output for solver testing
 125       call aerchem_boxtest_output( 1, iclm, jclm, 0, 0, dtchem )
 126
 127       iclm_aer = iclm
 128       jclm_aer = jclm
 129       kclm_aer_calcbgn = kclm_calcbgn
 130       kclm_aer_calcend = kclm_calcend
 131
 132
 133       do 200 m = 1, nsubareas
 134         mclm_aer = m
 135
 136         do 100 k = kclm_aer_calcbgn, kclm_aer_calcend
 137           kclm_aer = k
 138           if (afracsubarea(k,m) .lt. 1.e-4) goto 100
 139
 140           istat_mosaic_fe1 = 1
 141
 142           call mosaic( k, m, dtchem,vbs_nbin)
 143
 144           if (istat_mosaic_fe1 .lt. 0) then
 145              nfe1_mosaic_cur = nfe1_mosaic_cur + 1
 146              nfe1_mosaic_tot = nfe1_mosaic_tot + 1
 147              if (iprint_mosaic_fe1 .gt. 0) then
 148                 write(6,*) 'mosaic aerchemistry fatal error - i/j/k/m =',   &
 149                    iclm_aer, jclm_aer, kclm_aer, mclm_aer
 150                 call print_input
 151                 if (iprint_mosaic_fe1 .ge. 10)   &
 152                    call mosaic_aerchem_error_dump( 0, 0, lunerr_aer,   &
 153                       'aerchemistry fatal error' )
 154              end if
 155              goto 100
 156           end if
 157
 158           call specialoutaa( iclm, jclm, k, m, 'befor_movesect' )
 159           call move_sections( 1, iclm, jclm, k, m)
 160           call specialoutaa( iclm, jclm, k, m, 'after_movesect' )
 161           if ( do_ph .eq. 1 ) then
 162           ph_aer1(k) = mc(1,1)
 163           ph_aer2(k) = mc(1,2)
 164           ph_aer3(k) = mc(1,3)
 165           ph_aer4(k) = mc(1,4)
 166           end if
 167
 168 100     continue        ! k levels
 169
 170 200   continue          ! subareas
 171
 172
 173 !   special output for solver testing
 174       call aerchem_boxtest_output( 3, iclm, jclm, 0, 0, dtchem )
 175
 176       return
 177       end subroutine aerchemistry
 178
 179
 180
 181
 182
 183
 184
 185
 186
 187
 188 !***********************************************************************
 189 ! mosaic (model for simulating aerosol interactions and chemistry)
 190 !
 191 ! author: rahul a. zaveri
 192 ! update: dec 2004
 193 !-----------------------------------------------------------------------
 194       subroutine mosaic(k, m, dtchem,vbs_nbin)
 195
 196       use module_data_mosaic_asect
 197       use module_data_mosaic_other
 198
 199 !     implicit none
 200 !     include 'v33com'
 201 !     include 'v33com3'
 202 !     include 'mosaic.h'
 203 !   subr arguments
 204       integer k, m,vbs_nbin(1)
 205       real(kind=8) dtchem
 206 !   local variables
 207       real(kind=8) yh2o, dumdum
 208       integer iclm_debug, jclm_debug, kclm_debug, ncnt_debug
 209 !     data iclm_debug /28/
 210 !     data jclm_debug /1/
 211 !     data kclm_debug /9/
 212 !     data ncnt_debug /6/
 213       iclm_debug=-28; jclm_debug=1; kclm_debug=9; ncnt_debug=6
 214
 215
 216
 217       if(iclm_aer .eq. iclm_debug .and.   &
 218          jclm_aer .eq. jclm_debug .and.   &
 219          kclm_aer .eq. kclm_debug  .and.   &
 220          ncorecnt_aer .eq. ncnt_debug)then
 221         dumdum = 0.0
 222       endif
 223
 224
 225 ! overwrite inputs
 226          if(1.eq.0)then
 227            call hijack_input(k,m)
 228          endif
 229
 230
 231           t_k = rsub(ktemp,k,m)                 ! update temperature  = k
 232           p_atm = ptotclm(k) /1.032d6           ! update pressure = atm
 233           yh2o = rsub(kh2o,k,m)                 ! mol(h2o)/mol(air)
 234           rh_pc = 100.*relhumclm(k)             ! rh (%)
 235           ah2o = relhumclm(k)                   ! fractional rh
 236
 237
 238           call load_mosaic_parameters           ! sets up indices and other stuff once per simulation
 239
 240           call initialize_mosaic_variables
 241
 242           call update_thermodynamic_constants(vbs_nbin) ! update t and rh dependent constants
 243
 244           call map_mosaic_species(k, m, 0)
 245
 246
 247           call overall_massbal_in ! save input mass over all bins
 248           iprint_input = myes     ! reset to default
 249
 250
 251           call mosaic_dynamic_solver( dtchem,vbs_nbin )
 252           if (istat_mosaic_fe1 .lt. 0) return
 253
 254
 255           call overall_massbal_out(0) ! check mass balance after integration
 256
 257           call map_mosaic_species(k, m, 1)
 258
 259 !      write(6,*)' done ijk', iclm_aer, jclm_aer, kclm_aer
 260
 261       return
 262       end subroutine mosaic
 263
 264
 265
 266
 267
 268
 269
 270
 271
 272
 273
 274
 275 !***********************************************************************
 276 ! interface to asceem and asteem dynamic gas-particle exchange solvers
 277 !
 278 ! author: rahul a. zaveri
 279 ! update: jan 2005
 280 !-----------------------------------------------------------------------
 281       subroutine mosaic_dynamic_solver( dtchem,vbs_nbin )
 282 !     implicit none
 283 !     include 'v33com'
 284 !     include 'mosaic.h'
 285 ! subr arguments
 286       real(kind=8) dtchem
 287 ! local variables
 288       integer ibin, iv, k, m,vbs_nbin(1)
 289       real(kind=8) xt, dumdum
 290 !     real(kind=8) aerosol_water_up                             ! mosaic func
 291
 292
 293 !      if(iclm_aer .eq. 21 .and.   &
 294 !         jclm_aer .eq. 17 .and.   &
 295 !         kclm_aer .eq. 3  .and.   &
 296 !         ncorecnt_aer .eq. 4)then
 297 !        dumdum = 0.0
 298 !      endif
 299
 300
 301       do 500 ibin = 1, nbin_a
 302
 303         call check_aerosol_mass(ibin)
 304         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500
 305
 306         call conform_electrolytes(jtotal,ibin,xt)       ! conforms aer(jtotal) to a valid aerosol
 307
 308         call check_aerosol_mass(ibin)                   ! check mass again after conform_electrolytes
 309         if(jaerosolstate(ibin) .eq. no_aerosol)goto 500 ! ignore this bin
 310
 311         call conform_aerosol_number(ibin)               ! adjusts number conc so that it conforms with bin mass and diameter
 312
 313 500   continue
 314
 315
 316
 317 ! box
 318 !        call initial_aer_print_box     ! box
 319
 320       call save_pregrow_props
 321
 322       call specialoutaa( iclm_aer, jclm_aer, kclm_aer, 77,   &
 323                 'after_conform' )
 324 !
 325 !-------------------------------------
 326 ! do dynamic gas-aerosol mass transfer
 327
 328       if(mgas_aer_xfer .eq. mon)then
 329
 330         call astem(dtchem,vbs_nbin)
 331
 332       endif
 333
 334 !-------------------------------------
 335 ! box
 336 ! grows or shrinks size depending on mass increase or decrease
 337 !
 338 !      do ibin = 1, nbin_a
 339 !        if(jaerosolstate(ibin) .ne. no_aerosol)then
 340 !          call conform_particle_size(ibin)     ! box
 341 !        endif
 342 !      enddo
 343
 344
 345
 346       do 600 ibin = 1, nbin_a
 347         if(jaerosolstate(ibin).eq.no_aerosol) goto 600
 348
 349         if(jhyst_leg(ibin) .eq. jhyst_lo)then
 350           water_a_hyst(ibin) = 0.0
 351         elseif(jhyst_leg(ibin) .eq. jhyst_up)then
 352           water_a_up(ibin)   = aerosol_water_up(ibin)   ! at 60% rh
 353           water_a_hyst(ibin) = water_a_up(ibin)
 354         endif
 355
 356         call calc_dry_n_wet_aerosol_props(ibin)         ! compute final mass and density
 357 600   continue
 358
 359       return
 360       end subroutine mosaic_dynamic_solver
 361
 362
 363
 364
 365
 366
 367
 368
 369
 370
 371
 372
 373
 374
 375       subroutine hijack_input(k, m)
 376
 377       use module_data_mosaic_asect
 378       use module_data_mosaic_other
 379
 380 !     implicit none
 381 !     include 'v33com'
 382 !     include 'v33com3'
 383 !     include 'v33com9a'
 384 !     include 'v33com9b'
 385 !     include 'mosaic.h'
 386 ! subr arguments
 387       integer k, m
 388 ! local variables
 389       integer ibin, igas, iphase, isize, itype
 390       real(kind=8) t_kdum, p_atmdum, rhdum, cairclmdum
 391       real(kind=8) gasdum(4), aerdum(14,8)
 392
 393
 394
 395
 396 ! read inputs----------------
 397       open(92, file = 'box.txt')
 398
 399       read(92,*)t_kdum, p_atmdum, rhdum, cairclmdum
 400 !      do igas = 1, 4
 401         read(92,*)gasdum(1),gasdum(2),gasdum(3),gasdum(4)
 402 !      enddo
 403
 404       do ibin = 1, nbin_a
 405         read(92,*)aerdum(1,ibin),aerdum(2,ibin),aerdum(3,ibin),   &
 406                   aerdum(4,ibin),aerdum(5,ibin),aerdum(6,ibin),   &
 407                   aerdum(7,ibin),aerdum(8,ibin),aerdum(9,ibin),   &
 408                   aerdum(10,ibin),aerdum(11,ibin),aerdum(12,ibin),   &
 409                   aerdum(13,ibin),aerdum(14,ibin)
 410       enddo
 411
 412       close(92)
 413 !----------------------------
 414
 415
 416
 417       rsub(ktemp,k,m) = t_kdum                  ! update temperature  = k
 418       ptotclm(k)      = p_atmdum*1.032d6! update pressure = atm
 419       relhumclm(k)    = rhdum/100.0             ! fractional rh
 420       cairclm(k)      = cairclmdum              ! mol/cc
 421
 422
 423 ! 3-d
 424 ! calculate air conc in mol/m^3
 425       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 426       cair_mol_cc = cairclm(k)
 427
 428 ! 3-d
 429 ! define conversion factors
 430       conv1a = cair_mol_m3*1.e9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 431       conv1b = 1./conv1a                ! converts nq/m^3 to q/mol(air)
 432       conv2a = cair_mol_m3*18.*1.e-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 433       conv2b = 1./conv2a                ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 434
 435
 436 ! read rsub (mol/mol(air))
 437 ! gas
 438         rsub(kh2so4,k,m) = gasdum(1)
 439         rsub(khno3,k,m)  = gasdum(2)
 440         rsub(khcl,k,m)   = gasdum(3)
 441         rsub(knh3,k,m)   = gasdum(4)
 442
 443
 444 ! aerosol: rsub [mol/mol (air) or g/mol(air)]
 445         iphase = ai_phase
 446         ibin = 0
 447         do 10 itype = 1, ntype_aer
 448         do 10 isize = 1, nsize_aer(itype)
 449         ibin = ibin + 1
 450
 451         rsub(lptr_so4_aer(isize,itype,iphase),k,m) = aerdum(1,ibin)
 452         rsub(lptr_no3_aer(isize,itype,iphase),k,m) = aerdum(2,ibin)
 453         rsub(lptr_cl_aer(isize,itype,iphase),k,m)  = aerdum(3,ibin)
 454         rsub(lptr_nh4_aer(isize,itype,iphase),k,m) = aerdum(4,ibin)
 455         rsub(lptr_oc_aer(isize,itype,iphase),k,m)  = aerdum(5,ibin)
 456         rsub(lptr_co3_aer(isize,itype,iphase),k,m) = aerdum(6,ibin)
 457         rsub(lptr_msa_aer(isize,itype,iphase),k,m) = aerdum(7,ibin)
 458         rsub(lptr_bc_aer(isize,itype,iphase),k,m)  = aerdum(8,ibin)
 459         rsub(lptr_na_aer(isize,itype,iphase),k,m)  = aerdum(9,ibin)
 460         rsub(lptr_ca_aer(isize,itype,iphase),k,m)  = aerdum(10,ibin)
 461         rsub(lptr_oin_aer(isize,itype,iphase),k,m) = aerdum(11,ibin)
 462
 463         rsub(hyswptr_aer(isize,itype),k,m) = aerdum(12,ibin) ! kg/m^3(air)
 464         rsub(waterptr_aer(isize,itype),k,m)       = aerdum(13,ibin)     ! kg/m^3(air)
 465         rsub(numptr_aer(isize,itype,iphase),k,m)          = aerdum(14,ibin)     ! num_a is in #/cc
 466 10    continue
 467
 468       return
 469       end subroutine hijack_input
 470
 471
 472
 473
 474
 475 !***********************************************************************
 476 ! intializes all the mosaic variables to zero or their default values.
 477 !
 478 ! author: rahul a. zaveri
 479 ! update: jun 2003
 480 !-----------------------------------------------------------------------
 481       subroutine initialize_mosaic_variables
 482 !     implicit none
 483 !     include 'mosaic.h'
 484 ! local variables
 485       integer iaer, ibin, iv, ja, jc, je
 486
 487
 488
 489       do iv = 1, ngas_ioa
 490           gas(iv)           = 0.0
 491       enddo
 492
 493 ! initialize to zero
 494       do ibin = 1, nbin_a
 495
 496         num_a(ibin)          = 0.0
 497         mass_dry_a(ibin)     = 0.0
 498         mass_soluble_a(ibin) = 0.0
 499
 500         do iaer = 1, naer
 501           aer(iaer,jtotal,ibin)  = 0.0
 502           aer(iaer,jsolid,ibin)  = 0.0
 503           aer(iaer,jliquid,ibin) = 0.0
 504         enddo
 505
 506         do je = 1, nelectrolyte
 507           electrolyte(je,jtotal,ibin)  = 0.0
 508           electrolyte(je,jsolid,ibin)  = 0.0
 509           electrolyte(je,jliquid,ibin) = 0.0
 510           epercent(je,jtotal,ibin)     = 0.0    ! raz update 11/13/2008
 511           epercent(je,jsolid,ibin)     = 0.0    ! raz update 11/13/2008
 512           epercent(je,jliquid,ibin)    = 0.0    ! raz update 11/13/2008
 513           activity(je,ibin)            = 0.0
 514           gam(je,ibin)                 = 0.0
 515         enddo
 516
 517           gam_ratio(ibin)   = 0.0
 518
 519         do iv = 1, ngas_ioa
 520           flux_s(iv,ibin)   = 0.0
 521           flux_l(iv,ibin)   = 0.0
 522           kg(iv,ibin)       = 0.0
 523 !          fraceq(iv,ibin)   =0.0
 524           phi_volatile_s(iv,ibin) = 0.0
 525           phi_volatile_l(iv,ibin) = 0.0
 526           df_gas_s(iv,ibin)   = 0.0
 527           df_gas_l(iv,ibin)   = 0.0
 528           volatile_s(iv,ibin) = 0.0
 529         enddo
 530
 531
 532         jaerosolstate(ibin) = -1        ! initialize to default value
 533         jphase(ibin) = 0
 534
 535         do jc = 1, ncation
 536           mc(jc,ibin) = 0.0
 537         enddo
 538
 539         do ja = 1, nanion
 540           ma(ja,ibin) = 0.0
 541         enddo
 542
 543       enddo     ! ibin
 544
 545
 546       return
 547       end subroutine initialize_mosaic_variables
 548
 549
 550
 551
 552
 553
 554 !***********************************************************************
 555 ! maps rsub(k,l,m) to and from mosaic arrays: gas and aer
 556 !
 557 ! author: rahul a. zaveri
 558 ! update: nov 2001
 559 !-------------------------------------------------------------------------
 560       subroutine map_mosaic_species(k, m, imap)
 561
 562       use module_data_mosaic_asect
 563       use module_data_mosaic_other
 564       use module_state_description, only:  param_first_scalar
 565
 566 !     implicit none
 567
 568 !     include 'v33com'
 569 !     include 'v33com3'
 570 !     include 'v33com9a'
 571 !     include 'v33com9b'
 572
 573 ! subr arguments
 574       integer k, m, imap
 575 ! local variables
 576       integer ibin, iphase, isize, itsi, itype, l, p1st
 577
 578
 579 ! if a species index is less than this value, then the species is not defined
 580       p1st = param_first_scalar
 581
 582 ! 3-d
 583 ! calculate air conc in mol/m^3
 584       cair_mol_m3 = cairclm(k)*1.e6     ! cairclm(k) is in mol/cc
 585       cair_mol_cc = cairclm(k)
 586
 587 ! 3-d
 588 ! define conversion factors
 589       conv1a = cair_mol_m3*1.d9         ! converts q/mol(air) to nq/m^3 (q = mol or g)
 590       conv1b = 1.d0/conv1a              ! converts nq/m^3 to q/mol(air)
 591       conv2a = cair_mol_m3*18.*1.d-3    ! converts mol(h2o)/mol(air) to kg(h2o)/m^3(air)
 592       conv2b = 1.d0/conv2a              ! converts kg(h2o)/m^3(air) to mol(h2o)/mol(air)
 593
 594
 595 ! box
 596 !      conv1 = 1.d15/avogad     ! converts (molec/cc) to (nmol/m^3)
 597 !      conv2 = 1.d0/conv1         ! converts (nmol/m^3) to (molec/cc)
 598 !      kaerstart = ngas_max
 599
 600
 601       if(imap.eq.0)then    ! map rsub (mol/mol(air)) into aer (nmol/m^3)
 602 ! gas
 603         if (kh2so4 .ge. p1st) then
 604             gas(ih2so4_g) = rsub(kh2so4,k,m)*conv1a     ! nmol/m^3
 605         else
 606             gas(ih2so4_g) = 0.0
 607         end if
 608         if (khno3 .ge. p1st) then
 609             gas(ihno3_g)  = rsub(khno3,k,m)*conv1a
 610         else
 611             gas(ihno3_g) = 0.0
 612         end if
 613         if (khcl .ge. p1st) then
 614             gas(ihcl_g)   = rsub(khcl,k,m)*conv1a
 615         else
 616             gas(ihcl_g) = 0.0
 617         end if
 618         if (knh3 .ge. p1st) then
 619             gas(inh3_g)   = rsub(knh3,k,m)*conv1a
 620         else
 621             gas(inh3_g) = 0.0
 622         end if
 623         if (kn2o5 .ge. p1st) then
 624             gas(in2o5_g)   = rsub(kn2o5,k,m)*conv1a
 625         else
 626             gas(in2o5_g) = 0.0
 627         end if
 628         if (kclno2 .ge. p1st) then
 629             gas(iclno2_g)   = rsub(kclno2,k,m)*conv1a
 630         else
 631             gas(iclno2_g) = 0.0
 632         end if
 633
 634 ! soa gas-phase species -- currently deactivated
 635         if (kpcg1_b_c .ge. p1st) then
 636             gas(ipcg1_b_c_g)   = rsub(kpcg1_b_c,k,m)*conv1a
 637         else
 638         gas(ipcg1_b_c_g) = 0.0
 639         end if
 640         if (kpcg2_b_c .ge. p1st) then
 641             gas(ipcg2_b_c_g)   = rsub(kpcg2_b_c,k,m)*conv1a
 642         else
 643         gas(ipcg2_b_c_g) = 0.0
 644         end if
 645         if (kpcg3_b_c .ge. p1st) then
 646             gas(ipcg3_b_c_g)   = rsub(kpcg3_b_c,k,m)*conv1a
 647         else
 648         gas(ipcg3_b_c_g) = 0.0
 649         end if
 650         if (kpcg4_b_c .ge. p1st) then
 651             gas(ipcg4_b_c_g)   = rsub(kpcg4_b_c,k,m)*conv1a
 652         else
 653         gas(ipcg4_b_c_g) = 0.0
 654         end if
 655         if (kpcg5_b_c .ge. p1st) then
 656             gas(ipcg5_b_c_g)   = rsub(kpcg5_b_c,k,m)*conv1a
 657         else
 658         gas(ipcg5_b_c_g) = 0.0
 659         end if
 660         if (kpcg6_b_c .ge. p1st) then
 661             gas(ipcg6_b_c_g)   = rsub(kpcg6_b_c,k,m)*conv1a
 662         else
 663         gas(ipcg6_b_c_g) = 0.0
 664         end if
 665         if (kpcg7_b_c .ge. p1st) then
 666             gas(ipcg7_b_c_g)   = rsub(kpcg7_b_c,k,m)*conv1a
 667         else
 668         gas(ipcg7_b_c_g) = 0.0
 669         end if
 670         if (kpcg8_b_c .ge. p1st) then
 671             gas(ipcg8_b_c_g)   = rsub(kpcg8_b_c,k,m)*conv1a
 672         else
 673         gas(ipcg8_b_c_g) = 0.0
 674         end if
 675         if (kpcg9_b_c .ge. p1st) then
 676             gas(ipcg9_b_c_g)   = rsub(kpcg9_b_c,k,m)*conv1a
 677         else
 678         gas(ipcg9_b_c_g) = 0.0
 679         end if
 680         if (kpcg1_b_o .ge. p1st) then
 681             gas(ipcg1_b_o_g)   = rsub(kpcg1_b_o,k,m)*conv1a
 682         else
 683         gas(ipcg1_b_o_g) = 0.0
 684         end if
 685         if (kpcg2_b_o .ge. p1st) then
 686             gas(ipcg2_b_o_g)   = rsub(kpcg2_b_o,k,m)*conv1a
 687         else
 688         gas(ipcg2_b_o_g) = 0.0
 689         end if
 690         if (kpcg3_b_o .ge. p1st) then
 691             gas(ipcg3_b_o_g)   = rsub(kpcg3_b_o,k,m)*conv1a
 692         else
 693         gas(ipcg3_b_o_g) = 0.0
 694         end if
 695         if (kpcg4_b_o .ge. p1st) then
 696             gas(ipcg4_b_o_g)   = rsub(kpcg4_b_o,k,m)*conv1a
 697         else
 698         gas(ipcg4_b_o_g) = 0.0
 699         end if
 700         if (kpcg5_b_o .ge. p1st) then
 701             gas(ipcg5_b_o_g)   = rsub(kpcg5_b_o,k,m)*conv1a
 702         else
 703         gas(ipcg5_b_o_g) = 0.0
 704         end if
 705         if (kpcg6_b_o .ge. p1st) then
 706             gas(ipcg6_b_o_g)   = rsub(kpcg6_b_o,k,m)*conv1a
 707         else
 708         gas(ipcg6_b_o_g) = 0.0
 709         end if
 710         if (kpcg7_b_o .ge. p1st) then
 711             gas(ipcg7_b_o_g)   = rsub(kpcg7_b_o,k,m)*conv1a
 712         else
 713         gas(ipcg7_b_o_g) = 0.0
 714         end if
 715         if (kpcg8_b_o .ge. p1st) then
 716             gas(ipcg8_b_o_g)   = rsub(kpcg8_b_o,k,m)*conv1a
 717         else
 718         gas(ipcg8_b_o_g) = 0.0
 719         end if
 720         if (kpcg9_b_o .ge. p1st) then
 721             gas(ipcg9_b_o_g)   = rsub(kpcg9_b_o,k,m)*conv1a
 722         else
 723         gas(ipcg9_b_o_g) = 0.0
 724         end if
 725         if (kopcg1_b_c .ge. p1st) then
 726             gas(iopcg1_b_c_g)   = rsub(kopcg1_b_c,k,m)*conv1a
 727         else
 728         gas(iopcg1_b_c_g) = 0.0
 729         end if
 730         if (kopcg2_b_c .ge. p1st) then
 731             gas(iopcg2_b_c_g)   = rsub(kopcg2_b_c,k,m)*conv1a
 732         else
 733         gas(iopcg2_b_c_g) = 0.0
 734         end if
 735         if (kopcg3_b_c .ge. p1st) then
 736             gas(iopcg3_b_c_g)   = rsub(kopcg3_b_c,k,m)*conv1a
 737         else
 738         gas(iopcg3_b_c_g) = 0.0
 739         end if
 740         if (kopcg4_b_c .ge. p1st) then
 741             gas(iopcg4_b_c_g)   = rsub(kopcg4_b_c,k,m)*conv1a
 742         else
 743         gas(iopcg4_b_c_g) = 0.0
 744         end if
 745         if (kopcg5_b_c .ge. p1st) then
 746             gas(iopcg5_b_c_g)   = rsub(kopcg5_b_c,k,m)*conv1a
 747         else
 748         gas(iopcg5_b_c_g) = 0.0
 749         end if
 750         if (kopcg6_b_c .ge. p1st) then
 751             gas(iopcg6_b_c_g)   = rsub(kopcg6_b_c,k,m)*conv1a
 752         else
 753         gas(iopcg6_b_c_g) = 0.0
 754         end if
 755         if (kopcg7_b_c .ge. p1st) then
 756             gas(iopcg7_b_c_g)   = rsub(kopcg7_b_c,k,m)*conv1a
 757         else
 758         gas(iopcg7_b_c_g) = 0.0
 759         end if
 760         if (kopcg8_b_c .ge. p1st) then
 761             gas(iopcg8_b_c_g)   = rsub(kopcg8_b_c,k,m)*conv1a
 762         else
 763         gas(iopcg8_b_c_g) = 0.0
 764         end if
 765         if (kopcg1_b_o .ge. p1st) then
 766             gas(iopcg1_b_o_g)   = rsub(kopcg1_b_o,k,m)*conv1a
 767         else
 768         gas(iopcg1_b_o_g) = 0.0
 769         end if
 770         if (kopcg2_b_o .ge. p1st) then
 771             gas(iopcg2_b_o_g)   = rsub(kopcg2_b_o,k,m)*conv1a
 772         else
 773         gas(iopcg2_b_o_g) = 0.0
 774         end if
 775         if (kopcg3_b_o .ge. p1st) then
 776             gas(iopcg3_b_o_g)   = rsub(kopcg3_b_o,k,m)*conv1a
 777         else
 778         gas(iopcg3_b_o_g) = 0.0
 779         end if
 780         if (kopcg4_b_o .ge. p1st) then
 781             gas(iopcg4_b_o_g)   = rsub(kopcg4_b_o,k,m)*conv1a
 782         else
 783         gas(iopcg4_b_o_g) = 0.0
 784         end if
 785         if (kopcg5_b_o .ge. p1st) then
 786             gas(iopcg5_b_o_g)   = rsub(kopcg5_b_o,k,m)*conv1a
 787         else
 788         gas(iopcg5_b_o_g) = 0.0
 789         end if
 790         if (kopcg6_b_o .ge. p1st) then
 791             gas(iopcg6_b_o_g)   = rsub(kopcg6_b_o,k,m)*conv1a
 792         else
 793         gas(iopcg6_b_o_g) = 0.0
 794         end if
 795         if (kopcg7_b_o .ge. p1st) then
 796             gas(iopcg7_b_o_g)   = rsub(kopcg7_b_o,k,m)*conv1a
 797         else
 798         gas(iopcg7_b_o_g) = 0.0
 799         end if
 800         if (kopcg8_b_o .ge. p1st) then
 801             gas(iopcg8_b_o_g)   = rsub(kopcg8_b_o,k,m)*conv1a
 802         else
 803         gas(iopcg8_b_o_g) = 0.0
 804         end if
 805         if (kpcg1_f_c .ge. p1st) then
 806             gas(ipcg1_f_c_g)   = rsub(kpcg1_f_c,k,m)*conv1a
 807         else
 808         gas(ipcg1_f_c_g) = 0.0
 809         end if
 810         if (kpcg2_f_c .ge. p1st) then
 811             gas(ipcg2_f_c_g)   = rsub(kpcg2_f_c,k,m)*conv1a
 812         else
 813         gas(ipcg2_f_c_g) = 0.0
 814         end if
 815         if (kpcg3_f_c .ge. p1st) then
 816             gas(ipcg3_f_c_g)   = rsub(kpcg3_f_c,k,m)*conv1a
 817         else
 818         gas(ipcg3_f_c_g) = 0.0
 819         end if
 820         if (kpcg4_f_c .ge. p1st) then
 821             gas(ipcg4_f_c_g)   = rsub(kpcg4_f_c,k,m)*conv1a
 822         else
 823         gas(ipcg4_f_c_g) = 0.0
 824         end if
 825         if (kpcg5_f_c .ge. p1st) then
 826             gas(ipcg5_f_c_g)   = rsub(kpcg5_f_c,k,m)*conv1a
 827         else
 828         gas(ipcg5_f_c_g) = 0.0
 829         end if
 830         if (kpcg6_f_c .ge. p1st) then
 831             gas(ipcg6_f_c_g)   = rsub(kpcg6_f_c,k,m)*conv1a
 832         else
 833         gas(ipcg6_f_c_g) = 0.0
 834         end if
 835         if (kpcg7_f_c .ge. p1st) then
 836             gas(ipcg7_f_c_g)   = rsub(kpcg7_f_c,k,m)*conv1a
 837         else
 838         gas(ipcg7_f_c_g) = 0.0
 839         end if
 840         if (kpcg8_f_c .ge. p1st) then
 841             gas(ipcg8_f_c_g)   = rsub(kpcg8_f_c,k,m)*conv1a
 842         else
 843         gas(ipcg8_f_c_g) = 0.0
 844         end if
 845         if (kpcg9_f_c .ge. p1st) then
 846             gas(ipcg9_f_c_g)   = rsub(kpcg9_f_c,k,m)*conv1a
 847         else
 848         gas(ipcg9_f_c_g) = 0.0
 849         end if
 850         if (kpcg1_f_o .ge. p1st) then
 851             gas(ipcg1_f_o_g)   = rsub(kpcg1_f_o,k,m)*conv1a
 852         else
 853         gas(ipcg1_f_o_g) = 0.0
 854         end if
 855         if (kpcg2_f_o .ge. p1st) then
 856             gas(ipcg2_f_o_g)   = rsub(kpcg2_f_o,k,m)*conv1a
 857         else
 858         gas(ipcg2_f_o_g) = 0.0
 859         end if
 860         if (kpcg3_f_o .ge. p1st) then
 861             gas(ipcg3_f_o_g)   = rsub(kpcg3_f_o,k,m)*conv1a
 862         else
 863         gas(ipcg3_f_o_g) = 0.0
 864         end if
 865         if (kpcg4_f_o .ge. p1st) then
 866             gas(ipcg4_f_o_g)   = rsub(kpcg4_f_o,k,m)*conv1a
 867         else
 868         gas(ipcg4_f_o_g) = 0.0
 869         end if
 870         if (kpcg5_f_o .ge. p1st) then
 871             gas(ipcg5_f_o_g)   = rsub(kpcg5_f_o,k,m)*conv1a
 872         else
 873         gas(ipcg5_f_o_g) = 0.0
 874         end if
 875         if (kpcg6_f_o .ge. p1st) then
 876             gas(ipcg6_f_o_g)   = rsub(kpcg6_f_o,k,m)*conv1a
 877         else
 878         gas(ipcg6_f_o_g) = 0.0
 879         end if
 880         if (kpcg7_f_o .ge. p1st) then
 881             gas(ipcg7_f_o_g)   = rsub(kpcg7_f_o,k,m)*conv1a
 882         else
 883         gas(ipcg7_f_o_g) = 0.0
 884         end if
 885         if (kpcg8_f_o .ge. p1st) then
 886             gas(ipcg8_f_o_g)   = rsub(kpcg8_f_o,k,m)*conv1a
 887         else
 888         gas(ipcg8_f_o_g) = 0.0
 889         end if
 890         if (kpcg9_f_o .ge. p1st) then
 891             gas(ipcg9_f_o_g)   = rsub(kpcg9_f_o,k,m)*conv1a
 892         else
 893         gas(ipcg9_f_o_g) = 0.0
 894         end if
 895         if (kopcg1_f_c .ge. p1st) then
 896             gas(iopcg1_f_c_g)   = rsub(kopcg1_f_c,k,m)*conv1a
 897         else
 898         gas(iopcg1_f_c_g) = 0.0
 899         end if
 900         if (kopcg2_f_c .ge. p1st) then
 901             gas(iopcg2_f_c_g)   = rsub(kopcg2_f_c,k,m)*conv1a
 902         else
 903         gas(iopcg2_f_c_g) = 0.0
 904         end if
 905         if (kopcg3_f_c .ge. p1st) then
 906             gas(iopcg3_f_c_g)   = rsub(kopcg3_f_c,k,m)*conv1a
 907         else
 908         gas(iopcg3_f_c_g) = 0.0
 909         end if
 910         if (kopcg4_f_c .ge. p1st) then
 911             gas(iopcg4_f_c_g)   = rsub(kopcg4_f_c,k,m)*conv1a
 912         else
 913         gas(iopcg4_f_c_g) = 0.0
 914         end if
 915         if (kopcg5_f_c .ge. p1st) then
 916             gas(iopcg5_f_c_g)   = rsub(kopcg5_f_c,k,m)*conv1a
 917         else
 918         gas(iopcg5_f_c_g) = 0.0
 919         end if
 920         if (kopcg6_f_c .ge. p1st) then
 921             gas(iopcg6_f_c_g)   = rsub(kopcg6_f_c,k,m)*conv1a
 922         else
 923         gas(iopcg6_f_c_g) = 0.0
 924         end if
 925         if (kopcg7_f_c .ge. p1st) then
 926             gas(iopcg7_f_c_g)   = rsub(kopcg7_f_c,k,m)*conv1a
 927         else
 928         gas(iopcg7_f_c_g) = 0.0
 929         end if
 930         if (kopcg8_f_c .ge. p1st) then
 931             gas(iopcg8_f_c_g)   = rsub(kopcg8_f_c,k,m)*conv1a
 932         else
 933         gas(iopcg8_f_c_g) = 0.0
 934         end if
 935         if (kopcg1_f_o .ge. p1st) then
 936             gas(iopcg1_f_o_g)   = rsub(kopcg1_f_o,k,m)*conv1a
 937         else
 938         gas(iopcg1_f_o_g) = 0.0
 939         end if
 940         if (kopcg2_f_o .ge. p1st) then
 941             gas(iopcg2_f_o_g)   = rsub(kopcg2_f_o,k,m)*conv1a
 942         else
 943         gas(iopcg2_f_o_g) = 0.0
 944         end if
 945         if (kopcg3_f_o .ge. p1st) then
 946             gas(iopcg3_f_o_g)   = rsub(kopcg3_f_o,k,m)*conv1a
 947         else
 948         gas(iopcg3_f_o_g) = 0.0
 949         end if
 950         if (kopcg4_f_o .ge. p1st) then
 951             gas(iopcg4_f_o_g)   = rsub(kopcg4_f_o,k,m)*conv1a
 952         else
 953         gas(iopcg4_f_o_g) = 0.0
 954         end if
 955         if (kopcg5_f_o .ge. p1st) then
 956             gas(iopcg5_f_o_g)   = rsub(kopcg5_f_o,k,m)*conv1a
 957         else
 958         gas(iopcg5_f_o_g) = 0.0
 959         end if
 960         if (kopcg6_f_o .ge. p1st) then
 961             gas(iopcg6_f_o_g)   = rsub(kopcg6_f_o,k,m)*conv1a
 962         else
 963         gas(iopcg6_f_o_g) = 0.0
 964         end if
 965         if (kopcg7_f_o .ge. p1st) then
 966             gas(iopcg7_f_o_g)   = rsub(kopcg7_f_o,k,m)*conv1a
 967         else
 968         gas(iopcg7_f_o_g) = 0.0
 969         end if
 970         if (kopcg8_f_o .ge. p1st) then
 971             gas(iopcg8_f_o_g)   = rsub(kopcg8_f_o,k,m)*conv1a
 972         else
 973         gas(iopcg8_f_o_g) = 0.0
 974         end if
 975
 976        if (ksmpa .ge. p1st) then
 977             gas(ismpa_g)   = rsub(ksmpa,k,m)*conv1a
 978         else
 979         gas(ismpa_g) = 0.0
 980         end if
 981         if (ksmpbb .ge. p1st) then
 982             gas(ismpbb_g)   = rsub(ksmpbb,k,m)*conv1a
 983         else
 984         gas(ismpbb_g) = 0.0
 985         end if
 986        if (kgly .ge. p1st) then
 987             gas(igly)   = rsub(kgly,k,m)*conv1a
 988         else
 989         gas(igly) = 0.0
 990         end if
 991         if (koh .ge. p1st) then
 992             gas(iho)   = rsub(koh,k,m)*conv1a
 993         else
 994         gas(koh) = 0.0
 995         end if
 996
 997
 998         if (kant1_c .ge. p1st) then
 999             gas(iant1_c_g)   = rsub(kant1_c,k,m)*conv1a
1000         else
1001         gas(iant1_c_g) = 0.0
1002         end if
1003         if (kant2_c .ge. p1st) then
1004             gas(iant2_c_g)   = rsub(kant2_c,k,m)*conv1a
1005         else
1006         gas(iant2_c_g) = 0.0
1007         end if
1008         if (kant3_c .ge. p1st) then
1009             gas(iant3_c_g)   = rsub(kant3_c,k,m)*conv1a
1010         else
1011         gas(iant3_c_g) = 0.0
1012         end if
1013         if (kant4_c .ge. p1st) then
1014             gas(iant4_c_g)   = rsub(kant4_c,k,m)*conv1a
1015         else
1016         gas(iant4_c_g) = 0.0
1017         end if
1018
1019         if (kant1_o .ge. p1st) then
1020             gas(iant1_o_g)   = rsub(kant1_o,k,m)*conv1a
1021         else
1022         gas(iant1_o_g) = 0.0
1023         end if
1024         if (kant2_o .ge. p1st) then
1025             gas(iant2_o_g)   = rsub(kant2_o,k,m)*conv1a
1026         else
1027         gas(iant2_o_g) = 0.0
1028         end if
1029         if (kant3_o .ge. p1st) then
1030             gas(iant3_o_g)   = rsub(kant3_o,k,m)*conv1a
1031         else
1032         gas(iant3_o_g) = 0.0
1033         end if
1034         if (kant4_o .ge. p1st) then
1035             gas(iant4_o_g)   = rsub(kant4_o,k,m)*conv1a
1036         else
1037         gas(iant4_o_g) = 0.0
1038         end if
1039
1040         if (kbiog1_c .ge. p1st) then
1041             gas(ibiog1_c_g)   = rsub(kbiog1_c,k,m)*conv1a
1042         else
1043         gas(ibiog1_c_g) = 0.0
1044         end if
1045         if (kbiog2_c .ge. p1st) then
1046             gas(ibiog2_c_g)   = rsub(kbiog2_c,k,m)*conv1a
1047         else
1048         gas(ibiog2_c_g) = 0.0
1049         end if
1050         if (kbiog3_c .ge. p1st) then
1051             gas(ibiog3_c_g)   = rsub(kbiog3_c,k,m)*conv1a
1052         else
1053         gas(ibiog3_c_g) = 0.0
1054         end if
1055         if (kbiog4_c .ge. p1st) then
1056             gas(ibiog4_c_g)   = rsub(kbiog4_c,k,m)*conv1a
1057         else
1058         gas(ibiog4_c_g) = 0.0
1059         end if
1060
1061         if (kbiog1_o .ge. p1st) then
1062             gas(ibiog1_o_g)   = rsub(kbiog1_o,k,m)*conv1a
1063         else
1064         gas(ibiog1_o_g) = 0.0
1065         end if
1066         if (kbiog2_o .ge. p1st) then
1067             gas(ibiog2_o_g)   = rsub(kbiog2_o,k,m)*conv1a
1068         else
1069         gas(ibiog2_o_g) = 0.0
1070         end if
1071         if (kbiog3_o .ge. p1st) then
1072             gas(ibiog3_o_g)   = rsub(kbiog3_o,k,m)*conv1a
1073         else
1074         gas(ibiog3_o_g) = 0.0
1075         end if
1076         if (kbiog4_o .ge. p1st) then
1077             gas(ibiog4_o_g)   = rsub(kbiog4_o,k,m)*conv1a
1078         else
1079         gas(ibiog4_o_g) = 0.0
1080         end if
1081
1082         if (kasoaX .ge. p1st) then
1083             gas(iasoaX_g)   = rsub(kasoaX,k,m)*conv1a
1084         else
1085         gas(iasoaX_g) = 0.0
1086         end if
1087
1088         if (kasoa1 .ge. p1st) then
1089             gas(iasoa1_g)   = rsub(kasoa1,k,m)*conv1a
1090         else
1091         gas(iasoa1_g) = 0.0
1092         end if
1093
1094         if (kasoa2 .ge. p1st) then
1095             gas(iasoa2_g)   = rsub(kasoa2,k,m)*conv1a
1096         else
1097         gas(iasoa2_g) = 0.0
1098         end if
1099
1100         if (kasoa3 .ge. p1st) then
1101             gas(iasoa3_g)   = rsub(kasoa3,k,m)*conv1a
1102         else
1103         gas(iasoa3_g) = 0.0
1104         end if
1105
1106         if (kasoa4 .ge. p1st) then
1107             gas(iasoa4_g)   = rsub(kasoa4,k,m)*conv1a
1108         else
1109         gas(iasoa4_g) = 0.0
1110         end if
1111
1112         if (kbsoaX .ge. p1st) then
1113             gas(ibsoaX_g)   = rsub(kbsoaX,k,m)*conv1a
1114         else
1115         gas(ibsoaX_g) = 0.0
1116         end if
1117
1118         if (kbsoa1 .ge. p1st) then
1119             gas(ibsoa1_g)   = rsub(kbsoa1,k,m)*conv1a
1120         else
1121         gas(ibsoa1_g) = 0.0
1122         end if
1123
1124         if (kbsoa2 .ge. p1st) then
1125             gas(ibsoa2_g)   = rsub(kbsoa2,k,m)*conv1a
1126         else
1127         gas(ibsoa2_g) = 0.0
1128         end if
1129
1130         if (kbsoa3 .ge. p1st) then
1131             gas(ibsoa3_g)   = rsub(kbsoa3,k,m)*conv1a
1132         else
1133         gas(ibsoa3_g) = 0.0
1134         end if
1135
1136         if (kbsoa4 .ge. p1st) then
1137             gas(ibsoa4_g)   = rsub(kbsoa4,k,m)*conv1a
1138         else
1139         gas(ibsoa4_g) = 0.0
1140         end if
1141
1142
1143
1144
1145
1146 ! aerosol
1147         iphase = ai_phase
1148         ibin = 0
1149         do 10 itype = 1, ntype_aer
1150         do 10 isize = 1, nsize_aer(itype)
1151         ibin = ibin + 1
1152
1153 ! aer array units are nmol/(m^3 air)
1154
1155 ! rce 18-nov-2004 - always map so4 and number,
1156 ! but only map other species when (lptr_xxx .ge. p1st)
1157 ! rce 11-may-2006 - so4 mapping now optional
1158         l = lptr_so4_aer(isize,itype,iphase)
1159         if (l .ge. p1st) then
1160             aer(iso4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1161         else
1162             aer(iso4_a,jtotal,ibin)=0.0
1163         end if
1164
1165         l = lptr_no3_aer(isize,itype,iphase)
1166         if (l .ge. p1st) then
1167             aer(ino3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1168         else
1169             aer(ino3_a,jtotal,ibin)=0.0
1170         end if
1171
1172         l = lptr_cl_aer(isize,itype,iphase)
1173         if (l .ge. p1st) then
1174             aer(icl_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1175         else
1176             aer(icl_a,jtotal,ibin)=0.0
1177         end if
1178
1179         l = lptr_nh4_aer(isize,itype,iphase)
1180         if (l .ge. p1st) then
1181             aer(inh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1182         else
1183             aer(inh4_a,jtotal,ibin)=0.0
1184         end if
1185
1186         l = lptr_oc_aer(isize,itype,iphase)
1187         if (l .ge. p1st) then
1188             aer(ioc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1189         else
1190             aer(ioc_a,jtotal,ibin)=0.0
1191         end if
1192
1193         l = lptr_bc_aer(isize,itype,iphase)
1194         if (l .ge. p1st) then
1195             aer(ibc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1196         else
1197             aer(ibc_a,jtotal,ibin)=0.0
1198         end if
1199
1200         l = lptr_na_aer(isize,itype,iphase)
1201         if (l .ge. p1st) then
1202             aer(ina_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1203         else
1204             aer(ina_a,jtotal,ibin)=0.0
1205         end if
1206
1207         l = lptr_oin_aer(isize,itype,iphase)
1208         if (l .ge. p1st) then
1209             aer(ioin_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1210         else
1211             aer(ioin_a,jtotal,ibin)=0.0
1212         end if
1213
1214         l = lptr_msa_aer(isize,itype,iphase)
1215         if (l .ge. p1st) then
1216             aer(imsa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1217         else
1218             aer(imsa_a,jtotal,ibin)=0.0
1219         end if
1220
1221         l = lptr_co3_aer(isize,itype,iphase)
1222         if (l .ge. p1st) then
1223             aer(ico3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1224         else
1225             aer(ico3_a,jtotal,ibin)=0.0
1226         end if
1227
1228         l = lptr_ca_aer(isize,itype,iphase)
1229         if (l .ge. p1st) then
1230             aer(ica_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1231         else
1232             aer(ica_a,jtotal,ibin)=0.0
1233         end if
1234
1235 ! soa aerosol-phase species -- currently deactivated
1236
1237        l = lptr_pcg1_b_c_aer(isize,itype,iphase)
1238        if (l .ge. p1st) then
1239            aer(ipcg1_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1240        else
1241             aer(ipcg1_b_c_a,jtotal,ibin)=0.0
1242        end if
1243        l = lptr_pcg2_b_c_aer(isize,itype,iphase)
1244        if (l .ge. p1st) then
1245            aer(ipcg2_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1246        else
1247             aer(ipcg2_b_c_a,jtotal,ibin)=0.0
1248        end if
1249        l = lptr_pcg3_b_c_aer(isize,itype,iphase)
1250        if (l .ge. p1st) then
1251            aer(ipcg3_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1252        else
1253             aer(ipcg3_b_c_a,jtotal,ibin)=0.0
1254        end if
1255        l = lptr_pcg4_b_c_aer(isize,itype,iphase)
1256        if (l .ge. p1st) then
1257            aer(ipcg4_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1258        else
1259             aer(ipcg4_b_c_a,jtotal,ibin)=0.0
1260        end if
1261        l = lptr_pcg5_b_c_aer(isize,itype,iphase)
1262        if (l .ge. p1st) then
1263            aer(ipcg5_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1264        else
1265             aer(ipcg5_b_c_a,jtotal,ibin)=0.0
1266        end if
1267        l = lptr_pcg6_b_c_aer(isize,itype,iphase)
1268        if (l .ge. p1st) then
1269            aer(ipcg6_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1270        else
1271             aer(ipcg6_b_c_a,jtotal,ibin)=0.0
1272        end if
1273        l = lptr_pcg7_b_c_aer(isize,itype,iphase)
1274        if (l .ge. p1st) then
1275            aer(ipcg7_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1276        else
1277             aer(ipcg7_b_c_a,jtotal,ibin)=0.0
1278        end if
1279        l = lptr_pcg8_b_c_aer(isize,itype,iphase)
1280        if (l .ge. p1st) then
1281            aer(ipcg8_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1282        else
1283             aer(ipcg8_b_c_a,jtotal,ibin)=0.0
1284        end if
1285        l = lptr_pcg9_b_c_aer(isize,itype,iphase)
1286        if (l .ge. p1st) then
1287            aer(ipcg9_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1288        else
1289             aer(ipcg9_b_c_a,jtotal,ibin)=0.0
1290        end if
1291        l = lptr_pcg1_b_o_aer(isize,itype,iphase)
1292        if (l .ge. p1st) then
1293            aer(ipcg1_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1294        else
1295             aer(ipcg1_b_o_a,jtotal,ibin)=0.0
1296        end if
1297        l = lptr_pcg2_b_o_aer(isize,itype,iphase)
1298        if (l .ge. p1st) then
1299            aer(ipcg2_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1300        else
1301             aer(ipcg2_b_o_a,jtotal,ibin)=0.0
1302        end if
1303        l = lptr_pcg3_b_o_aer(isize,itype,iphase)
1304        if (l .ge. p1st) then
1305            aer(ipcg3_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1306        else
1307             aer(ipcg3_b_o_a,jtotal,ibin)=0.0
1308        end if
1309        l = lptr_pcg4_b_o_aer(isize,itype,iphase)
1310        if (l .ge. p1st) then
1311            aer(ipcg4_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1312        else
1313             aer(ipcg4_b_o_a,jtotal,ibin)=0.0
1314        end if
1315        l = lptr_pcg5_b_o_aer(isize,itype,iphase)
1316        if (l .ge. p1st) then
1317            aer(ipcg5_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1318        else
1319             aer(ipcg5_b_o_a,jtotal,ibin)=0.0
1320        end if
1321        l = lptr_pcg6_b_o_aer(isize,itype,iphase)
1322        if (l .ge. p1st) then
1323            aer(ipcg6_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1324        else
1325             aer(ipcg6_b_o_a,jtotal,ibin)=0.0
1326        end if
1327        l = lptr_pcg7_b_o_aer(isize,itype,iphase)
1328        if (l .ge. p1st) then
1329            aer(ipcg7_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1330        else
1331             aer(ipcg7_b_o_a,jtotal,ibin)=0.0
1332        end if
1333        l = lptr_pcg8_b_o_aer(isize,itype,iphase)
1334        if (l .ge. p1st) then
1335            aer(ipcg8_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1336        else
1337             aer(ipcg8_b_o_a,jtotal,ibin)=0.0
1338        end if
1339        l = lptr_pcg9_b_o_aer(isize,itype,iphase)
1340        if (l .ge. p1st) then
1341            aer(ipcg9_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1342        else
1343             aer(ipcg9_b_o_a,jtotal,ibin)=0.0
1344        end if
1345        l = lptr_opcg1_b_c_aer(isize,itype,iphase)
1346        if (l .ge. p1st) then
1347            aer(iopcg1_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1348        else
1349             aer(iopcg1_b_c_a,jtotal,ibin)=0.0
1350        end if
1351        l = lptr_opcg2_b_c_aer(isize,itype,iphase)
1352        if (l .ge. p1st) then
1353            aer(iopcg2_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1354        else
1355             aer(iopcg2_b_c_a,jtotal,ibin)=0.0
1356        end if
1357        l = lptr_opcg3_b_c_aer(isize,itype,iphase)
1358        if (l .ge. p1st) then
1359            aer(iopcg3_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1360        else
1361             aer(iopcg3_b_c_a,jtotal,ibin)=0.0
1362        end if
1363        l = lptr_opcg4_b_c_aer(isize,itype,iphase)
1364        if (l .ge. p1st) then
1365            aer(iopcg4_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1366        else
1367             aer(iopcg4_b_c_a,jtotal,ibin)=0.0
1368        end if
1369        l = lptr_opcg5_b_c_aer(isize,itype,iphase)
1370        if (l .ge. p1st) then
1371            aer(iopcg5_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1372        else
1373             aer(iopcg5_b_c_a,jtotal,ibin)=0.0
1374        end if
1375        l = lptr_opcg6_b_c_aer(isize,itype,iphase)
1376        if (l .ge. p1st) then
1377            aer(iopcg6_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1378        else
1379             aer(iopcg6_b_c_a,jtotal,ibin)=0.0
1380        end if
1381        l = lptr_opcg7_b_c_aer(isize,itype,iphase)
1382        if (l .ge. p1st) then
1383            aer(iopcg7_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1384        else
1385             aer(iopcg7_b_c_a,jtotal,ibin)=0.0
1386        end if
1387        l = lptr_opcg8_b_c_aer(isize,itype,iphase)
1388        if (l .ge. p1st) then
1389            aer(iopcg8_b_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1390        else
1391             aer(iopcg8_b_c_a,jtotal,ibin)=0.0
1392        end if
1393        l = lptr_opcg1_b_o_aer(isize,itype,iphase)
1394        if (l .ge. p1st) then
1395            aer(iopcg1_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1396        else
1397             aer(iopcg1_b_o_a,jtotal,ibin)=0.0
1398        end if
1399        l = lptr_opcg2_b_o_aer(isize,itype,iphase)
1400        if (l .ge. p1st) then
1401            aer(iopcg2_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1402        else
1403             aer(iopcg2_b_o_a,jtotal,ibin)=0.0
1404        end if
1405        l = lptr_opcg3_b_o_aer(isize,itype,iphase)
1406        if (l .ge. p1st) then
1407            aer(iopcg3_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1408        else
1409             aer(iopcg3_b_o_a,jtotal,ibin)=0.0
1410        end if
1411        l = lptr_opcg4_b_o_aer(isize,itype,iphase)
1412        if (l .ge. p1st) then
1413            aer(iopcg4_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1414        else
1415             aer(iopcg4_b_o_a,jtotal,ibin)=0.0
1416        end if
1417        l = lptr_opcg5_b_o_aer(isize,itype,iphase)
1418        if (l .ge. p1st) then
1419            aer(iopcg5_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1420        else
1421             aer(iopcg5_b_o_a,jtotal,ibin)=0.0
1422        end if
1423        l = lptr_opcg6_b_o_aer(isize,itype,iphase)
1424        if (l .ge. p1st) then
1425            aer(iopcg6_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1426        else
1427             aer(iopcg6_b_o_a,jtotal,ibin)=0.0
1428        end if
1429        l = lptr_opcg7_b_o_aer(isize,itype,iphase)
1430        if (l .ge. p1st) then
1431            aer(iopcg7_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1432        else
1433             aer(iopcg7_b_o_a,jtotal,ibin)=0.0
1434        end if
1435        l = lptr_opcg8_b_o_aer(isize,itype,iphase)
1436        if (l .ge. p1st) then
1437            aer(iopcg8_b_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1438        else
1439             aer(iopcg8_b_o_a,jtotal,ibin)=0.0
1440        end if
1441        l = lptr_pcg1_f_c_aer(isize,itype,iphase)
1442        if (l .ge. p1st) then
1443            aer(ipcg1_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1444        else
1445             aer(ipcg1_f_c_a,jtotal,ibin)=0.0
1446        end if
1447        l = lptr_pcg2_f_c_aer(isize,itype,iphase)
1448        if (l .ge. p1st) then
1449            aer(ipcg2_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1450        else
1451             aer(ipcg2_f_c_a,jtotal,ibin)=0.0
1452        end if
1453        l = lptr_pcg3_f_c_aer(isize,itype,iphase)
1454        if (l .ge. p1st) then
1455            aer(ipcg3_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1456        else
1457             aer(ipcg3_f_c_a,jtotal,ibin)=0.0
1458        end if
1459        l = lptr_pcg4_f_c_aer(isize,itype,iphase)
1460        if (l .ge. p1st) then
1461            aer(ipcg4_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1462        else
1463             aer(ipcg4_f_c_a,jtotal,ibin)=0.0
1464        end if
1465        l = lptr_pcg5_f_c_aer(isize,itype,iphase)
1466        if (l .ge. p1st) then
1467            aer(ipcg5_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1468        else
1469             aer(ipcg5_f_c_a,jtotal,ibin)=0.0
1470        end if
1471        l = lptr_pcg6_f_c_aer(isize,itype,iphase)
1472        if (l .ge. p1st) then
1473            aer(ipcg6_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1474        else
1475             aer(ipcg6_f_c_a,jtotal,ibin)=0.0
1476        end if
1477        l = lptr_pcg7_f_c_aer(isize,itype,iphase)
1478        if (l .ge. p1st) then
1479            aer(ipcg7_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1480        else
1481             aer(ipcg7_f_c_a,jtotal,ibin)=0.0
1482        end if
1483        l = lptr_pcg8_f_c_aer(isize,itype,iphase)
1484        if (l .ge. p1st) then
1485            aer(ipcg8_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1486        else
1487             aer(ipcg8_f_c_a,jtotal,ibin)=0.0
1488        end if
1489        l = lptr_pcg9_f_c_aer(isize,itype,iphase)
1490        if (l .ge. p1st) then
1491            aer(ipcg9_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1492        else
1493             aer(ipcg9_f_c_a,jtotal,ibin)=0.0
1494        end if
1495        l = lptr_pcg1_f_o_aer(isize,itype,iphase)
1496        if (l .ge. p1st) then
1497            aer(ipcg1_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1498        else
1499             aer(ipcg1_f_o_a,jtotal,ibin)=0.0
1500        end if
1501        l = lptr_pcg2_f_o_aer(isize,itype,iphase)
1502        if (l .ge. p1st) then
1503            aer(ipcg2_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1504        else
1505             aer(ipcg2_f_o_a,jtotal,ibin)=0.0
1506        end if
1507        l = lptr_pcg3_f_o_aer(isize,itype,iphase)
1508        if (l .ge. p1st) then
1509            aer(ipcg3_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1510        else
1511             aer(ipcg3_f_o_a,jtotal,ibin)=0.0
1512        end if
1513        l = lptr_pcg4_f_o_aer(isize,itype,iphase)
1514        if (l .ge. p1st) then
1515            aer(ipcg4_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1516        else
1517             aer(ipcg4_f_o_a,jtotal,ibin)=0.0
1518        end if
1519        l = lptr_pcg5_f_o_aer(isize,itype,iphase)
1520        if (l .ge. p1st) then
1521            aer(ipcg5_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1522        else
1523             aer(ipcg5_f_o_a,jtotal,ibin)=0.0
1524        end if
1525        l = lptr_pcg6_f_o_aer(isize,itype,iphase)
1526        if (l .ge. p1st) then
1527            aer(ipcg6_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1528        else
1529             aer(ipcg6_f_o_a,jtotal,ibin)=0.0
1530        end if
1531        l = lptr_pcg7_f_o_aer(isize,itype,iphase)
1532        if (l .ge. p1st) then
1533            aer(ipcg7_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1534        else
1535             aer(ipcg7_f_o_a,jtotal,ibin)=0.0
1536        end if
1537        l = lptr_pcg8_f_o_aer(isize,itype,iphase)
1538        if (l .ge. p1st) then
1539            aer(ipcg8_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1540        else
1541             aer(ipcg8_f_o_a,jtotal,ibin)=0.0
1542        end if
1543        l = lptr_pcg9_f_o_aer(isize,itype,iphase)
1544        if (l .ge. p1st) then
1545            aer(ipcg9_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1546        else
1547             aer(ipcg9_f_o_a,jtotal,ibin)=0.0
1548        end if
1549        l = lptr_opcg1_f_c_aer(isize,itype,iphase)
1550        if (l .ge. p1st) then
1551            aer(iopcg1_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1552        else
1553             aer(iopcg1_f_c_a,jtotal,ibin)=0.0
1554        end if
1555        l = lptr_opcg2_f_c_aer(isize,itype,iphase)
1556        if (l .ge. p1st) then
1557            aer(iopcg2_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1558        else
1559             aer(iopcg2_f_c_a,jtotal,ibin)=0.0
1560        end if
1561        l = lptr_opcg3_f_c_aer(isize,itype,iphase)
1562        if (l .ge. p1st) then
1563            aer(iopcg3_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1564        else
1565             aer(iopcg3_f_c_a,jtotal,ibin)=0.0
1566        end if
1567        l = lptr_opcg4_f_c_aer(isize,itype,iphase)
1568        if (l .ge. p1st) then
1569            aer(iopcg4_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1570        else
1571             aer(iopcg4_f_c_a,jtotal,ibin)=0.0
1572        end if
1573        l = lptr_opcg5_f_c_aer(isize,itype,iphase)
1574        if (l .ge. p1st) then
1575            aer(iopcg5_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1576        else
1577             aer(iopcg5_f_c_a,jtotal,ibin)=0.0
1578        end if
1579        l = lptr_opcg6_f_c_aer(isize,itype,iphase)
1580        if (l .ge. p1st) then
1581            aer(iopcg6_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1582        else
1583             aer(iopcg6_f_c_a,jtotal,ibin)=0.0
1584        end if
1585        l = lptr_opcg7_f_c_aer(isize,itype,iphase)
1586        if (l .ge. p1st) then
1587            aer(iopcg7_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1588        else
1589             aer(iopcg7_f_c_a,jtotal,ibin)=0.0
1590        end if
1591        l = lptr_opcg8_f_c_aer(isize,itype,iphase)
1592        if (l .ge. p1st) then
1593            aer(iopcg8_f_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1594        else
1595             aer(iopcg8_f_c_a,jtotal,ibin)=0.0
1596        end if
1597        l = lptr_opcg1_f_o_aer(isize,itype,iphase)
1598        if (l .ge. p1st) then
1599            aer(iopcg1_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1600        else
1601             aer(iopcg1_f_o_a,jtotal,ibin)=0.0
1602        end if
1603        l = lptr_opcg2_f_o_aer(isize,itype,iphase)
1604        if (l .ge. p1st) then
1605            aer(iopcg2_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1606        else
1607             aer(iopcg2_f_o_a,jtotal,ibin)=0.0
1608        end if
1609        l = lptr_opcg3_f_o_aer(isize,itype,iphase)
1610        if (l .ge. p1st) then
1611            aer(iopcg3_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1612        else
1613             aer(iopcg3_f_o_a,jtotal,ibin)=0.0
1614        end if
1615        l = lptr_opcg4_f_o_aer(isize,itype,iphase)
1616        if (l .ge. p1st) then
1617            aer(iopcg4_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1618        else
1619             aer(iopcg4_f_o_a,jtotal,ibin)=0.0
1620        end if
1621        l = lptr_opcg5_f_o_aer(isize,itype,iphase)
1622        if (l .ge. p1st) then
1623            aer(iopcg5_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1624        else
1625             aer(iopcg5_f_o_a,jtotal,ibin)=0.0
1626        end if
1627        l = lptr_opcg6_f_o_aer(isize,itype,iphase)
1628        if (l .ge. p1st) then
1629            aer(iopcg6_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1630        else
1631             aer(iopcg6_f_o_a,jtotal,ibin)=0.0
1632        end if
1633        l = lptr_opcg7_f_o_aer(isize,itype,iphase)
1634        if (l .ge. p1st) then
1635            aer(iopcg7_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1636        else
1637             aer(iopcg7_f_o_a,jtotal,ibin)=0.0
1638        end if
1639        l = lptr_opcg8_f_o_aer(isize,itype,iphase)
1640        if (l .ge. p1st) then
1641            aer(iopcg8_f_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1642        else
1643             aer(iopcg8_f_o_a,jtotal,ibin)=0.0
1644        end if
1645
1646        l = lptr_smpa_aer(isize,itype,iphase)
1647        if (l .ge. p1st) then
1648            aer(ismpa_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1649        else
1650             aer(ismpa_a,jtotal,ibin)=0.0
1651        end if
1652        l = lptr_smpbb_aer(isize,itype,iphase)
1653        if (l .ge. p1st) then
1654            aer(ismpbb_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1655        else
1656             aer(ismpbb_a,jtotal,ibin)=0.0
1657        end if
1658
1659        l = lptr_glysoa_r1_aer(isize,itype,iphase)
1660        if (l .ge. p1st) then
1661            aer(iglysoa_r1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1662        else
1663             aer(iglysoa_r1_a,jtotal,ibin)=0.0
1664        end if
1665
1666        l = lptr_glysoa_r2_aer(isize,itype,iphase)
1667        if (l .ge. p1st) then
1668            aer(iglysoa_r2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1669        else
1670             aer(iglysoa_r2_a,jtotal,ibin)=0.0
1671        end if
1672
1673        l = lptr_glysoa_sfc_aer(isize,itype,iphase)
1674        if (l .ge. p1st) then
1675            aer(iglysoa_sfc_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1676        else
1677             aer(iglysoa_sfc_a,jtotal,ibin)=0.0
1678        end if
1679
1680        l = lptr_glysoa_nh4_aer(isize,itype,iphase)
1681        if (l .ge. p1st) then
1682            aer(iglysoa_nh4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1683        else
1684             aer(iglysoa_nh4_a,jtotal,ibin)=0.0
1685        end if
1686
1687        l = lptr_glysoa_oh_aer(isize,itype,iphase)
1688        if (l .ge. p1st) then
1689            aer(iglysoa_oh_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1690        else
1691             aer(iglysoa_oh_a,jtotal,ibin)=0.0
1692        end if
1693
1694        l = lptr_ant1_c_aer(isize,itype,iphase)
1695        if (l .ge. p1st) then
1696            aer(iant1_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1697        else
1698             aer(iant1_c_a,jtotal,ibin)=0.0
1699        end if
1700
1701        l = lptr_ant2_c_aer(isize,itype,iphase)
1702        if (l .ge. p1st) then
1703            aer(iant2_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1704        else
1705             aer(iant2_c_a,jtotal,ibin)=0.0
1706        end if
1707
1708        l = lptr_ant3_c_aer(isize,itype,iphase)
1709        if (l .ge. p1st) then
1710            aer(iant3_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1711        else
1712             aer(iant3_c_a,jtotal,ibin)=0.0
1713        end if
1714
1715        l = lptr_ant4_c_aer(isize,itype,iphase)
1716        if (l .ge. p1st) then
1717            aer(iant4_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1718        else
1719             aer(iant4_c_a,jtotal,ibin)=0.0
1720        end if
1721
1722        l = lptr_ant1_o_aer(isize,itype,iphase)
1723        if (l .ge. p1st) then
1724            aer(iant1_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1725        else
1726             aer(iant1_o_a,jtotal,ibin)=0.0
1727        end if
1728
1729        l = lptr_ant2_o_aer(isize,itype,iphase)
1730        if (l .ge. p1st) then
1731            aer(iant2_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1732        else
1733             aer(iant2_o_a,jtotal,ibin)=0.0
1734        end if
1735
1736        l = lptr_ant3_o_aer(isize,itype,iphase)
1737        if (l .ge. p1st) then
1738            aer(iant3_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1739        else
1740             aer(iant3_o_a,jtotal,ibin)=0.0
1741        end if
1742
1743        l = lptr_ant4_o_aer(isize,itype,iphase)
1744        if (l .ge. p1st) then
1745            aer(iant4_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1746        else
1747             aer(iant4_o_a,jtotal,ibin)=0.0
1748        end if
1749
1750        l = lptr_biog1_c_aer(isize,itype,iphase)
1751        if (l .ge. p1st) then
1752            aer(ibiog1_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1753        else
1754             aer(ibiog1_c_a,jtotal,ibin)=0.0
1755        end if
1756
1757        l = lptr_biog2_c_aer(isize,itype,iphase)
1758        if (l .ge. p1st) then
1759            aer(ibiog2_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1760        else
1761             aer(ibiog2_c_a,jtotal,ibin)=0.0
1762        end if
1763
1764        l = lptr_biog3_c_aer(isize,itype,iphase)
1765        if (l .ge. p1st) then
1766            aer(ibiog3_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1767        else
1768             aer(ibiog3_c_a,jtotal,ibin)=0.0
1769        end if
1770
1771        l = lptr_biog4_c_aer(isize,itype,iphase)
1772        if (l .ge. p1st) then
1773            aer(ibiog4_c_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1774        else
1775             aer(ibiog4_c_a,jtotal,ibin)=0.0
1776        end if
1777
1778        l = lptr_biog1_o_aer(isize,itype,iphase)
1779        if (l .ge. p1st) then
1780            aer(ibiog1_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1781        else
1782             aer(ibiog1_o_a,jtotal,ibin)=0.0
1783        end if
1784
1785        l = lptr_biog2_o_aer(isize,itype,iphase)
1786        if (l .ge. p1st) then
1787            aer(ibiog2_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1788        else
1789             aer(ibiog2_o_a,jtotal,ibin)=0.0
1790        end if
1791
1792        l = lptr_biog3_o_aer(isize,itype,iphase)
1793        if (l .ge. p1st) then
1794            aer(ibiog3_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1795        else
1796             aer(ibiog3_o_a,jtotal,ibin)=0.0
1797        end if
1798
1799        l = lptr_biog4_o_aer(isize,itype,iphase)
1800        if (l .ge. p1st) then
1801            aer(ibiog4_o_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1802        else
1803             aer(ibiog4_o_a,jtotal,ibin)=0.0
1804        end if
1805
1806        l = lptr_asoaX_aer(isize,itype,iphase)
1807        if (l .ge. p1st) then
1808            aer(iasoaX_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1809        else
1810             aer(iasoaX_a,jtotal,ibin)=0.0
1811        end if
1812
1813        l = lptr_asoa1_aer(isize,itype,iphase)
1814        if (l .ge. p1st) then
1815            aer(iasoa1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1816        else
1817             aer(iasoa1_a,jtotal,ibin)=0.0
1818        end if
1819
1820        l = lptr_asoa2_aer(isize,itype,iphase)
1821        if (l .ge. p1st) then
1822            aer(iasoa2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1823        else
1824             aer(iasoa2_a,jtotal,ibin)=0.0
1825        end if
1826
1827        l = lptr_asoa3_aer(isize,itype,iphase)
1828        if (l .ge. p1st) then
1829            aer(iasoa3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1830        else
1831             aer(iasoa3_a,jtotal,ibin)=0.0
1832        end if
1833
1834        l = lptr_asoa4_aer(isize,itype,iphase)
1835        if (l .ge. p1st) then
1836            aer(iasoa4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1837        else
1838             aer(iasoa4_a,jtotal,ibin)=0.0
1839        end if
1840
1841        l = lptr_bsoaX_aer(isize,itype,iphase)
1842        if (l .ge. p1st) then
1843            aer(ibsoaX_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1844        else
1845             aer(ibsoaX_a,jtotal,ibin)=0.0
1846        end if
1847
1848        l = lptr_bsoa1_aer(isize,itype,iphase)
1849        if (l .ge. p1st) then
1850            aer(ibsoa1_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1851        else
1852             aer(ibsoa1_a,jtotal,ibin)=0.0
1853        end if
1854
1855        l = lptr_bsoa2_aer(isize,itype,iphase)
1856        if (l .ge. p1st) then
1857            aer(ibsoa2_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1858        else
1859             aer(ibsoa2_a,jtotal,ibin)=0.0
1860        end if
1861
1862        l = lptr_bsoa3_aer(isize,itype,iphase)
1863        if (l .ge. p1st) then
1864            aer(ibsoa3_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1865        else
1866             aer(ibsoa3_a,jtotal,ibin)=0.0
1867        end if
1868
1869        l = lptr_bsoa4_aer(isize,itype,iphase)
1870        if (l .ge. p1st) then
1871            aer(ibsoa4_a,jtotal,ibin)=rsub(l,k,m)*conv1a
1872        else
1873             aer(ibsoa4_a,jtotal,ibin)=0.0
1874        end if
1875
1876 ! water_a and water_a_hyst units are kg/(m^3 air)
1877         l = hyswptr_aer(isize,itype)
1878         if (l .ge. p1st) then
1879             water_a_hyst(ibin)=rsub(l,k,m)*conv2a
1880         else
1881             water_a_hyst(ibin)=0.0
1882         end if
1883
1884 ! water_a units are kg/(m^3 air)
1885         l = waterptr_aer(isize,itype)
1886         if (l .ge. p1st) then
1887             water_a(ibin)=rsub(l,k,m)*conv2a
1888         else
1889             water_a(ibin)=0.0
1890         end if
1891
1892 ! num_a units are #/(cm^3 air)
1893         l = numptr_aer(isize,itype,iphase)
1894         num_a(ibin) = rsub(l,k,m)*cair_mol_cc
1895
1896 ! other bin parameters (fixed for now)
1897         sigmag_a(ibin)  = 1.02
1898
1899 10      continue
1900
1901
1902
1903
1904 !---------------------------------------------------------------------
1905
1906
1907       else                 ! map aer & gas (nmol/m^3) back into rsub (mol/mol(air))
1908
1909
1910
1911 ! gas
1912         if (kh2so4 .ge. p1st)   &
1913             rsub(kh2so4,k,m) = gas(ih2so4_g)*conv1b
1914         if (khno3 .ge. p1st)   &
1915             rsub(khno3,k,m)  = gas(ihno3_g)*conv1b
1916         if (khcl .ge. p1st)   &
1917             rsub(khcl,k,m)   = gas(ihcl_g)*conv1b
1918         if (knh3 .ge. p1st)   &
1919             rsub(knh3,k,m)   = gas(inh3_g)*conv1b
1920         if (kn2o5 .ge. p1st)   &
1921             rsub(kn2o5,k,m)   = gas(in2o5_g)*conv1b
1922         if (kclno2 .ge. p1st)   &
1923             rsub(kclno2,k,m)   = gas(iclno2_g)*conv1b
1924
1925 ! soa gas-phase species -- currently deactivated
1926         if (kpcg1_b_c .ge. p1st)   &
1927             rsub(kpcg1_b_c,k,m)   = gas(ipcg1_b_c_g)*conv1b
1928         if (kpcg2_b_c .ge. p1st)   &
1929             rsub(kpcg2_b_c,k,m)   = gas(ipcg2_b_c_g)*conv1b
1930         if (kpcg3_b_c .ge. p1st)   &
1931             rsub(kpcg3_b_c,k,m)   = gas(ipcg3_b_c_g)*conv1b
1932         if (kpcg4_b_c .ge. p1st)   &
1933             rsub(kpcg4_b_c,k,m)   = gas(ipcg4_b_c_g)*conv1b
1934         if (kpcg5_b_c .ge. p1st)   &
1935             rsub(kpcg5_b_c,k,m)   = gas(ipcg5_b_c_g)*conv1b
1936         if (kpcg6_b_c .ge. p1st)   &
1937             rsub(kpcg6_b_c,k,m)   = gas(ipcg6_b_c_g)*conv1b
1938         if (kpcg7_b_c .ge. p1st)   &
1939             rsub(kpcg7_b_c,k,m)   = gas(ipcg7_b_c_g)*conv1b
1940         if (kpcg8_b_c .ge. p1st)   &
1941             rsub(kpcg8_b_c,k,m)   = gas(ipcg8_b_c_g)*conv1b
1942         if (kpcg9_b_c .ge. p1st)   &
1943             rsub(kpcg9_b_c,k,m)   = gas(ipcg9_b_c_g)*conv1b
1944         if (kpcg1_b_o .ge. p1st)   &
1945             rsub(kpcg1_b_o,k,m)   = gas(ipcg1_b_o_g)*conv1b
1946         if (kpcg2_b_o .ge. p1st)   &
1947             rsub(kpcg2_b_o,k,m)   = gas(ipcg2_b_o_g)*conv1b
1948         if (kpcg3_b_o .ge. p1st)   &
1949             rsub(kpcg3_b_o,k,m)   = gas(ipcg3_b_o_g)*conv1b
1950         if (kpcg4_b_o .ge. p1st)   &
1951             rsub(kpcg4_b_o,k,m)   = gas(ipcg4_b_o_g)*conv1b
1952         if (kpcg5_b_o .ge. p1st)   &
1953             rsub(kpcg5_b_o,k,m)   = gas(ipcg5_b_o_g)*conv1b
1954         if (kpcg6_b_o .ge. p1st)   &
1955             rsub(kpcg6_b_o,k,m)   = gas(ipcg6_b_o_g)*conv1b
1956         if (kpcg7_b_o .ge. p1st)   &
1957             rsub(kpcg7_b_o,k,m)   = gas(ipcg7_b_o_g)*conv1b
1958         if (kpcg8_b_o .ge. p1st)   &
1959             rsub(kpcg8_b_o,k,m)   = gas(ipcg8_b_o_g)*conv1b
1960         if (kpcg9_b_o .ge. p1st)   &
1961             rsub(kpcg9_b_o,k,m)   = gas(ipcg9_b_o_g)*conv1b
1962         if (kopcg1_b_c .ge. p1st)   &
1963             rsub(kopcg1_b_c,k,m)   = gas(iopcg1_b_c_g)*conv1b
1964         if (kopcg2_b_c .ge. p1st)   &
1965             rsub(kopcg2_b_c,k,m)   = gas(iopcg2_b_c_g)*conv1b
1966         if (kopcg3_b_c .ge. p1st)   &
1967             rsub(kopcg3_b_c,k,m)   = gas(iopcg3_b_c_g)*conv1b
1968         if (kopcg4_b_c .ge. p1st)   &
1969             rsub(kopcg4_b_c,k,m)   = gas(iopcg4_b_c_g)*conv1b
1970         if (kopcg5_b_c .ge. p1st)   &
1971             rsub(kopcg5_b_c,k,m)   = gas(iopcg5_b_c_g)*conv1b
1972         if (kopcg6_b_c .ge. p1st)   &
1973             rsub(kopcg6_b_c,k,m)   = gas(iopcg6_b_c_g)*conv1b
1974         if (kopcg7_b_c .ge. p1st)   &
1975             rsub(kopcg7_b_c,k,m)   = gas(iopcg7_b_c_g)*conv1b
1976         if (kopcg8_b_c .ge. p1st)   &
1977             rsub(kopcg8_b_c,k,m)   = gas(iopcg8_b_c_g)*conv1b
1978         if (kopcg1_b_o .ge. p1st)   &
1979             rsub(kopcg1_b_o,k,m)   = gas(iopcg1_b_o_g)*conv1b
1980         if (kopcg2_b_o .ge. p1st)   &
1981             rsub(kopcg2_b_o,k,m)   = gas(iopcg2_b_o_g)*conv1b
1982         if (kopcg3_b_o .ge. p1st)   &
1983             rsub(kopcg3_b_o,k,m)   = gas(iopcg3_b_o_g)*conv1b
1984         if (kopcg4_b_o .ge. p1st)   &
1985             rsub(kopcg4_b_o,k,m)   = gas(iopcg4_b_o_g)*conv1b
1986         if (kopcg5_b_o .ge. p1st)   &
1987             rsub(kopcg5_b_o,k,m)   = gas(iopcg5_b_o_g)*conv1b
1988         if (kopcg6_b_o .ge. p1st)   &
1989             rsub(kopcg6_b_o,k,m)   = gas(iopcg6_b_o_g)*conv1b
1990         if (kopcg7_b_o .ge. p1st)   &
1991             rsub(kopcg7_b_o,k,m)   = gas(iopcg7_b_o_g)*conv1b
1992         if (kopcg8_b_o .ge. p1st)   &
1993             rsub(kopcg8_b_o,k,m)   = gas(iopcg8_b_o_g)*conv1b
1994         if (kpcg1_f_c .ge. p1st)   &
1995             rsub(kpcg1_f_c,k,m)   = gas(ipcg1_f_c_g)*conv1b
1996         if (kpcg2_f_c .ge. p1st)   &
1997             rsub(kpcg2_f_c,k,m)   = gas(ipcg2_f_c_g)*conv1b
1998         if (kpcg3_f_c .ge. p1st)   &
1999             rsub(kpcg3_f_c,k,m)   = gas(ipcg3_f_c_g)*conv1b
2000         if (kpcg4_f_c .ge. p1st)   &
2001             rsub(kpcg4_f_c,k,m)   = gas(ipcg4_f_c_g)*conv1b
2002         if (kpcg5_f_c .ge. p1st)   &
2003             rsub(kpcg5_f_c,k,m)   = gas(ipcg5_f_c_g)*conv1b
2004         if (kpcg6_f_c .ge. p1st)   &
2005             rsub(kpcg6_f_c,k,m)   = gas(ipcg6_f_c_g)*conv1b
2006         if (kpcg7_f_c .ge. p1st)   &
2007             rsub(kpcg7_f_c,k,m)   = gas(ipcg7_f_c_g)*conv1b
2008         if (kpcg8_f_c .ge. p1st)   &
2009             rsub(kpcg8_f_c,k,m)   = gas(ipcg8_f_c_g)*conv1b
2010         if (kpcg9_f_c .ge. p1st)   &
2011             rsub(kpcg9_f_c,k,m)   = gas(ipcg9_f_c_g)*conv1b
2012         if (kpcg1_f_o .ge. p1st)   &
2013             rsub(kpcg1_f_o,k,m)   = gas(ipcg1_f_o_g)*conv1b
2014         if (kpcg2_f_o .ge. p1st)   &
2015             rsub(kpcg2_f_o,k,m)   = gas(ipcg2_f_o_g)*conv1b
2016         if (kpcg3_f_o .ge. p1st)   &
2017             rsub(kpcg3_f_o,k,m)   = gas(ipcg3_f_o_g)*conv1b
2018         if (kpcg4_f_o .ge. p1st)   &
2019             rsub(kpcg4_f_o,k,m)   = gas(ipcg4_f_o_g)*conv1b
2020         if (kpcg5_f_o .ge. p1st)   &
2021             rsub(kpcg5_f_o,k,m)   = gas(ipcg5_f_o_g)*conv1b
2022         if (kpcg6_f_o .ge. p1st)   &
2023             rsub(kpcg6_f_o,k,m)   = gas(ipcg6_f_o_g)*conv1b
2024         if (kpcg7_f_o .ge. p1st)   &
2025             rsub(kpcg7_f_o,k,m)   = gas(ipcg7_f_o_g)*conv1b
2026         if (kpcg8_f_o .ge. p1st)   &
2027             rsub(kpcg8_f_o,k,m)   = gas(ipcg8_f_o_g)*conv1b
2028         if (kpcg9_f_o .ge. p1st)   &
2029             rsub(kpcg9_f_o,k,m)   = gas(ipcg9_f_o_g)*conv1b
2030         if (kopcg1_f_c .ge. p1st)   &
2031             rsub(kopcg1_f_c,k,m)   = gas(iopcg1_f_c_g)*conv1b
2032         if (kopcg2_f_c .ge. p1st)   &
2033             rsub(kopcg2_f_c,k,m)   = gas(iopcg2_f_c_g)*conv1b
2034         if (kopcg3_f_c .ge. p1st)   &
2035             rsub(kopcg3_f_c,k,m)   = gas(iopcg3_f_c_g)*conv1b
2036         if (kopcg4_f_c .ge. p1st)   &
2037             rsub(kopcg4_f_c,k,m)   = gas(iopcg4_f_c_g)*conv1b
2038         if (kopcg5_f_c .ge. p1st)   &
2039             rsub(kopcg5_f_c,k,m)   = gas(iopcg5_f_c_g)*conv1b
2040         if (kopcg6_f_c .ge. p1st)   &
2041             rsub(kopcg6_f_c,k,m)   = gas(iopcg6_f_c_g)*conv1b
2042         if (kopcg7_f_c .ge. p1st)   &
2043             rsub(kopcg7_f_c,k,m)   = gas(iopcg7_f_c_g)*conv1b
2044         if (kopcg8_f_c .ge. p1st)   &
2045             rsub(kopcg8_f_c,k,m)   = gas(iopcg8_f_c_g)*conv1b
2046         if (kopcg1_f_o .ge. p1st)   &
2047             rsub(kopcg1_f_o,k,m)   = gas(iopcg1_f_o_g)*conv1b
2048         if (kopcg2_f_o .ge. p1st)   &
2049             rsub(kopcg2_f_o,k,m)   = gas(iopcg2_f_o_g)*conv1b
2050         if (kopcg3_f_o .ge. p1st)   &
2051             rsub(kopcg3_f_o,k,m)   = gas(iopcg3_f_o_g)*conv1b
2052         if (kopcg4_f_o .ge. p1st)   &
2053             rsub(kopcg4_f_o,k,m)   = gas(iopcg4_f_o_g)*conv1b
2054         if (kopcg5_f_o .ge. p1st)   &
2055             rsub(kopcg5_f_o,k,m)   = gas(iopcg5_f_o_g)*conv1b
2056         if (kopcg6_f_o .ge. p1st)   &
2057             rsub(kopcg6_f_o,k,m)   = gas(iopcg6_f_o_g)*conv1b
2058         if (kopcg7_f_o .ge. p1st)   &
2059             rsub(kopcg7_f_o,k,m)   = gas(iopcg7_f_o_g)*conv1b
2060         if (kopcg8_f_o .ge. p1st)   &
2061             rsub(kopcg8_f_o,k,m)   = gas(iopcg8_f_o_g)*conv1b
2062         if (ksmpa .ge. p1st)   &
2063             rsub(ksmpa,k,m)   = gas(ismpa_g)*conv1b
2064         if (kgly .ge. p1st)   &
2065             rsub(kgly,k,m)   = gas(igly)*conv1b
2066         ! CK 20120913 OH is only used as scaling quantity, not returned to gas array
2067 !!        if (koh .ge. p1st)   &
2068 !!            rsub(koh,k,m)   = gas(iho)*conv1b
2069         if (ksmpbb .ge. p1st)   &
2070             rsub(ksmpbb,k,m)   = gas(ismpbb_g)*conv1b
2071         if (kant1_c .ge. p1st)   &
2072             rsub(kant1_c,k,m)   = gas(iant1_c_g)*conv1b
2073         if (kant2_c .ge. p1st)   &
2074             rsub(kant2_c,k,m)   = gas(iant2_c_g)*conv1b
2075         if (kant3_c .ge. p1st)   &
2076             rsub(kant3_c,k,m)   = gas(iant3_c_g)*conv1b
2077         if (kant4_c .ge. p1st)   &
2078             rsub(kant4_c,k,m)   = gas(iant4_c_g)*conv1b
2079         if (kant1_o .ge. p1st)   &
2080             rsub(kant1_o,k,m)   = gas(iant1_o_g)*conv1b
2081         if (kant2_o .ge. p1st)   &
2082             rsub(kant2_o,k,m)   = gas(iant2_o_g)*conv1b
2083         if (kant3_o .ge. p1st)   &
2084             rsub(kant3_o,k,m)   = gas(iant3_o_g)*conv1b
2085         if (kant4_o .ge. p1st)   &
2086             rsub(kant4_o,k,m)   = gas(iant4_o_g)*conv1b
2087         if (kbiog1_c .ge. p1st)   &
2088             rsub(kbiog1_c,k,m)   = gas(ibiog1_c_g)*conv1b
2089         if (kbiog2_c .ge. p1st)   &
2090             rsub(kbiog2_c,k,m)   = gas(ibiog2_c_g)*conv1b
2091         if (kbiog3_c .ge. p1st)   &
2092             rsub(kbiog3_c,k,m)   = gas(ibiog3_c_g)*conv1b
2093         if (kbiog4_c .ge. p1st)   &
2094             rsub(kbiog4_c,k,m)   = gas(ibiog4_c_g)*conv1b
2095         if (kbiog1_o .ge. p1st)   &
2096             rsub(kbiog1_o,k,m)   = gas(ibiog1_o_g)*conv1b
2097         if (kbiog2_o .ge. p1st)   &
2098             rsub(kbiog2_o,k,m)   = gas(ibiog2_o_g)*conv1b
2099         if (kbiog3_o .ge. p1st)   &
2100             rsub(kbiog3_o,k,m)   = gas(ibiog3_o_g)*conv1b
2101         if (kbiog4_o .ge. p1st)   &
2102             rsub(kbiog4_o,k,m)   = gas(ibiog4_o_g)*conv1b
2103         if (kasoaX .ge. p1st)   &
2104             rsub(kasoaX,k,m)   = gas(iasoaX_g)*conv1b
2105         if (kasoa1 .ge. p1st)   &
2106             rsub(kasoa1,k,m)   = gas(iasoa1_g)*conv1b
2107         if (kasoa2 .ge. p1st)   &
2108             rsub(kasoa2,k,m)   = gas(iasoa2_g)*conv1b
2109         if (kasoa3 .ge. p1st)   &
2110             rsub(kasoa3,k,m)   = gas(iasoa3_g)*conv1b
2111         if (kasoa4 .ge. p1st)   &
2112             rsub(kasoa4,k,m)   = gas(iasoa4_g)*conv1b
2113         if (kbsoaX .ge. p1st)   &
2114             rsub(kbsoaX,k,m)   = gas(ibsoaX_g)*conv1b
2115         if (kbsoa1 .ge. p1st)   &
2116             rsub(kbsoa1,k,m)   = gas(ibsoa1_g)*conv1b
2117         if (kbsoa2 .ge. p1st)   &
2118             rsub(kbsoa2,k,m)   = gas(ibsoa2_g)*conv1b
2119         if (kbsoa3 .ge. p1st)   &
2120             rsub(kbsoa3,k,m)   = gas(ibsoa3_g)*conv1b
2121         if (kbsoa4 .ge. p1st)   &
2122             rsub(kbsoa4,k,m)   = gas(ibsoa4_g)*conv1b
2123
2124 ! aerosol
2125         iphase = ai_phase
2126         ibin = 0
2127         do 20 itype = 1, ntype_aer
2128         do 20 isize = 1, nsize_aer(itype)
2129         ibin = ibin + 1
2130
2131
2132 ! rce 18-nov-2004 - always map so4 and number,
2133 ! but only map other species when (lptr_xxx .ge. p1st)
2134         l = lptr_so4_aer(isize,itype,iphase)
2135         rsub(l,k,m) = aer(iso4_a,jtotal,ibin)*conv1b
2136
2137         l = lptr_no3_aer(isize,itype,iphase)
2138         if (l .ge. p1st) rsub(l,k,m) = aer(ino3_a,jtotal,ibin)*conv1b
2139
2140         l = lptr_cl_aer(isize,itype,iphase)
2141         if (l .ge. p1st) rsub(l,k,m) = aer(icl_a,jtotal,ibin)*conv1b
2142
2143         l = lptr_nh4_aer(isize,itype,iphase)
2144         if (l .ge. p1st) rsub(l,k,m) = aer(inh4_a,jtotal,ibin)*conv1b
2145
2146         l = lptr_oc_aer(isize,itype,iphase)
2147         if (l .ge. p1st) rsub(l,k,m) = aer(ioc_a,jtotal,ibin)*conv1b
2148
2149         l = lptr_bc_aer(isize,itype,iphase)
2150         if (l .ge. p1st) rsub(l,k,m) = aer(ibc_a,jtotal,ibin)*conv1b
2151
2152         l = lptr_na_aer(isize,itype,iphase)
2153         if (l .ge. p1st) rsub(l,k,m) = aer(ina_a,jtotal,ibin)*conv1b
2154
2155         l = lptr_oin_aer(isize,itype,iphase)
2156         if (l .ge. p1st) rsub(l,k,m) = aer(ioin_a,jtotal,ibin)*conv1b
2157
2158         l = lptr_msa_aer(isize,itype,iphase)
2159         if (l .ge. p1st) rsub(l,k,m) = aer(imsa_a,jtotal,ibin)*conv1b
2160
2161         l = lptr_co3_aer(isize,itype,iphase)
2162         if (l .ge. p1st) rsub(l,k,m) = aer(ico3_a,jtotal,ibin)*conv1b
2163
2164         l = lptr_ca_aer(isize,itype,iphase)
2165         if (l .ge. p1st) rsub(l,k,m) = aer(ica_a,jtotal,ibin)*conv1b
2166
2167 ! soa aerosol-phase species -- currently deactivated
2168
2169        l = lptr_pcg1_b_c_aer(isize,itype,iphase)
2170        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_b_c_a,jtotal,ibin)*conv1b
2171        l = lptr_pcg2_b_c_aer(isize,itype,iphase)
2172        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_b_c_a,jtotal,ibin)*conv1b
2173        l = lptr_pcg3_b_c_aer(isize,itype,iphase)
2174        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_b_c_a,jtotal,ibin)*conv1b
2175        l = lptr_pcg4_b_c_aer(isize,itype,iphase)
2176        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_b_c_a,jtotal,ibin)*conv1b
2177        l = lptr_pcg5_b_c_aer(isize,itype,iphase)
2178        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_b_c_a,jtotal,ibin)*conv1b
2179        l = lptr_pcg6_b_c_aer(isize,itype,iphase)
2180        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_b_c_a,jtotal,ibin)*conv1b
2181        l = lptr_pcg7_b_c_aer(isize,itype,iphase)
2182        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_b_c_a,jtotal,ibin)*conv1b
2183        l = lptr_pcg8_b_c_aer(isize,itype,iphase)
2184        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_b_c_a,jtotal,ibin)*conv1b
2185        l = lptr_pcg9_b_c_aer(isize,itype,iphase)
2186        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_b_c_a,jtotal,ibin)*conv1b
2187        l = lptr_pcg1_b_o_aer(isize,itype,iphase)
2188        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_b_o_a,jtotal,ibin)*conv1b
2189        l = lptr_pcg2_b_o_aer(isize,itype,iphase)
2190        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_b_o_a,jtotal,ibin)*conv1b
2191        l = lptr_pcg3_b_o_aer(isize,itype,iphase)
2192        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_b_o_a,jtotal,ibin)*conv1b
2193        l = lptr_pcg4_b_o_aer(isize,itype,iphase)
2194        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_b_o_a,jtotal,ibin)*conv1b
2195        l = lptr_pcg5_b_o_aer(isize,itype,iphase)
2196        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_b_o_a,jtotal,ibin)*conv1b
2197        l = lptr_pcg6_b_o_aer(isize,itype,iphase)
2198        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_b_o_a,jtotal,ibin)*conv1b
2199        l = lptr_pcg7_b_o_aer(isize,itype,iphase)
2200        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_b_o_a,jtotal,ibin)*conv1b
2201        l = lptr_pcg8_b_o_aer(isize,itype,iphase)
2202        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_b_o_a,jtotal,ibin)*conv1b
2203        l = lptr_pcg9_b_o_aer(isize,itype,iphase)
2204        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_b_o_a,jtotal,ibin)*conv1b
2205        l = lptr_opcg1_b_c_aer(isize,itype,iphase)
2206        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_b_c_a,jtotal,ibin)*conv1b
2207        l = lptr_opcg2_b_c_aer(isize,itype,iphase)
2208        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_b_c_a,jtotal,ibin)*conv1b
2209        l = lptr_opcg3_b_c_aer(isize,itype,iphase)
2210        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_b_c_a,jtotal,ibin)*conv1b
2211        l = lptr_opcg4_b_c_aer(isize,itype,iphase)
2212        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_b_c_a,jtotal,ibin)*conv1b
2213        l = lptr_opcg5_b_c_aer(isize,itype,iphase)
2214        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_b_c_a,jtotal,ibin)*conv1b
2215        l = lptr_opcg6_b_c_aer(isize,itype,iphase)
2216        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_b_c_a,jtotal,ibin)*conv1b
2217        l = lptr_opcg7_b_c_aer(isize,itype,iphase)
2218        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_b_c_a,jtotal,ibin)*conv1b
2219        l = lptr_opcg8_b_c_aer(isize,itype,iphase)
2220        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_b_c_a,jtotal,ibin)*conv1b
2221        l = lptr_opcg1_b_o_aer(isize,itype,iphase)
2222        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_b_o_a,jtotal,ibin)*conv1b
2223        l = lptr_opcg2_b_o_aer(isize,itype,iphase)
2224        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_b_o_a,jtotal,ibin)*conv1b
2225        l = lptr_opcg3_b_o_aer(isize,itype,iphase)
2226        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_b_o_a,jtotal,ibin)*conv1b
2227        l = lptr_opcg4_b_o_aer(isize,itype,iphase)
2228        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_b_o_a,jtotal,ibin)*conv1b
2229        l = lptr_opcg5_b_o_aer(isize,itype,iphase)
2230        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_b_o_a,jtotal,ibin)*conv1b
2231        l = lptr_opcg6_b_o_aer(isize,itype,iphase)
2232        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_b_o_a,jtotal,ibin)*conv1b
2233        l = lptr_opcg7_b_o_aer(isize,itype,iphase)
2234        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_b_o_a,jtotal,ibin)*conv1b
2235        l = lptr_opcg8_b_o_aer(isize,itype,iphase)
2236        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_b_o_a,jtotal,ibin)*conv1b
2237        l = lptr_pcg1_f_c_aer(isize,itype,iphase)
2238        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_f_c_a,jtotal,ibin)*conv1b
2239        l = lptr_pcg2_f_c_aer(isize,itype,iphase)
2240        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_f_c_a,jtotal,ibin)*conv1b
2241        l = lptr_pcg3_f_c_aer(isize,itype,iphase)
2242        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_f_c_a,jtotal,ibin)*conv1b
2243        l = lptr_pcg4_f_c_aer(isize,itype,iphase)
2244        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_f_c_a,jtotal,ibin)*conv1b
2245        l = lptr_pcg5_f_c_aer(isize,itype,iphase)
2246        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_f_c_a,jtotal,ibin)*conv1b
2247        l = lptr_pcg6_f_c_aer(isize,itype,iphase)
2248        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_f_c_a,jtotal,ibin)*conv1b
2249        l = lptr_pcg7_f_c_aer(isize,itype,iphase)
2250        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_f_c_a,jtotal,ibin)*conv1b
2251        l = lptr_pcg8_f_c_aer(isize,itype,iphase)
2252        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_f_c_a,jtotal,ibin)*conv1b
2253        l = lptr_pcg9_f_c_aer(isize,itype,iphase)
2254        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_f_c_a,jtotal,ibin)*conv1b
2255        l = lptr_pcg1_f_o_aer(isize,itype,iphase)
2256        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg1_f_o_a,jtotal,ibin)*conv1b
2257        l = lptr_pcg2_f_o_aer(isize,itype,iphase)
2258        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg2_f_o_a,jtotal,ibin)*conv1b
2259        l = lptr_pcg3_f_o_aer(isize,itype,iphase)
2260        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg3_f_o_a,jtotal,ibin)*conv1b
2261        l = lptr_pcg4_f_o_aer(isize,itype,iphase)
2262        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg4_f_o_a,jtotal,ibin)*conv1b
2263        l = lptr_pcg5_f_o_aer(isize,itype,iphase)
2264        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg5_f_o_a,jtotal,ibin)*conv1b
2265        l = lptr_pcg6_f_o_aer(isize,itype,iphase)
2266        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg6_f_o_a,jtotal,ibin)*conv1b
2267        l = lptr_pcg7_f_o_aer(isize,itype,iphase)
2268        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg7_f_o_a,jtotal,ibin)*conv1b
2269        l = lptr_pcg8_f_o_aer(isize,itype,iphase)
2270        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg8_f_o_a,jtotal,ibin)*conv1b
2271        l = lptr_pcg9_f_o_aer(isize,itype,iphase)
2272        if (l .ge. p1st) rsub(l,k,m) = aer(ipcg9_f_o_a,jtotal,ibin)*conv1b
2273        l = lptr_opcg1_f_c_aer(isize,itype,iphase)
2274        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_f_c_a,jtotal,ibin)*conv1b
2275        l = lptr_opcg2_f_c_aer(isize,itype,iphase)
2276        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_f_c_a,jtotal,ibin)*conv1b
2277        l = lptr_opcg3_f_c_aer(isize,itype,iphase)
2278        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_f_c_a,jtotal,ibin)*conv1b
2279        l = lptr_opcg4_f_c_aer(isize,itype,iphase)
2280        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_f_c_a,jtotal,ibin)*conv1b
2281        l = lptr_opcg5_f_c_aer(isize,itype,iphase)
2282        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_f_c_a,jtotal,ibin)*conv1b
2283        l = lptr_opcg6_f_c_aer(isize,itype,iphase)
2284        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_f_c_a,jtotal,ibin)*conv1b
2285        l = lptr_opcg7_f_c_aer(isize,itype,iphase)
2286        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_f_c_a,jtotal,ibin)*conv1b
2287        l = lptr_opcg8_f_c_aer(isize,itype,iphase)
2288        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_f_c_a,jtotal,ibin)*conv1b
2289        l = lptr_opcg1_f_o_aer(isize,itype,iphase)
2290        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg1_f_o_a,jtotal,ibin)*conv1b
2291        l = lptr_opcg2_f_o_aer(isize,itype,iphase)
2292        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg2_f_o_a,jtotal,ibin)*conv1b
2293        l = lptr_opcg3_f_o_aer(isize,itype,iphase)
2294        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg3_f_o_a,jtotal,ibin)*conv1b
2295        l = lptr_opcg4_f_o_aer(isize,itype,iphase)
2296        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg4_f_o_a,jtotal,ibin)*conv1b
2297        l = lptr_opcg5_f_o_aer(isize,itype,iphase)
2298        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg5_f_o_a,jtotal,ibin)*conv1b
2299        l = lptr_opcg6_f_o_aer(isize,itype,iphase)
2300        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg6_f_o_a,jtotal,ibin)*conv1b
2301        l = lptr_opcg7_f_o_aer(isize,itype,iphase)
2302        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg7_f_o_a,jtotal,ibin)*conv1b
2303        l = lptr_opcg8_f_o_aer(isize,itype,iphase)
2304        if (l .ge. p1st) rsub(l,k,m) = aer(iopcg8_f_o_a,jtotal,ibin)*conv1b
2305
2306        l = lptr_smpa_aer(isize,itype,iphase)
2307        if (l .ge. p1st) rsub(l,k,m) = aer(ismpa_a,jtotal,ibin)*conv1b
2308        l = lptr_smpbb_aer(isize,itype,iphase)
2309        if (l .ge. p1st) rsub(l,k,m) = aer(ismpbb_a,jtotal,ibin)*conv1b
2310        l = lptr_glysoa_r1_aer(isize,itype,iphase)
2311        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_r1_a,jtotal,ibin)*conv1b
2312        l = lptr_glysoa_r2_aer(isize,itype,iphase)
2313        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_r2_a,jtotal,ibin)*conv1b
2314        l = lptr_glysoa_sfc_aer(isize,itype,iphase)
2315        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_sfc_a,jtotal,ibin)*conv1b
2316        l = lptr_glysoa_nh4_aer(isize,itype,iphase)
2317        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_nh4_a,jtotal,ibin)*conv1b
2318        l = lptr_glysoa_oh_aer(isize,itype,iphase)
2319        if (l .ge. p1st) rsub(l,k,m) = aer(iglysoa_oh_a,jtotal,ibin)*conv1b
2320
2321        l = lptr_ant1_c_aer(isize,itype,iphase)
2322        if (l .ge. p1st) rsub(l,k,m) = aer(iant1_c_a,jtotal,ibin)*conv1b
2323        l = lptr_ant2_c_aer(isize,itype,iphase)
2324        if (l .ge. p1st) rsub(l,k,m) = aer(iant2_c_a,jtotal,ibin)*conv1b
2325        l = lptr_ant3_c_aer(isize,itype,iphase)
2326        if (l .ge. p1st) rsub(l,k,m) = aer(iant3_c_a,jtotal,ibin)*conv1b
2327        l = lptr_ant4_c_aer(isize,itype,iphase)
2328        if (l .ge. p1st) rsub(l,k,m) = aer(iant4_c_a,jtotal,ibin)*conv1b
2329        l = lptr_ant1_o_aer(isize,itype,iphase)
2330        if (l .ge. p1st) rsub(l,k,m) = aer(iant1_o_a,jtotal,ibin)*conv1b
2331        l = lptr_ant2_o_aer(isize,itype,iphase)
2332        if (l .ge. p1st) rsub(l,k,m) = aer(iant2_o_a,jtotal,ibin)*conv1b
2333        l = lptr_ant3_o_aer(isize,itype,iphase)
2334        if (l .ge. p1st) rsub(l,k,m) = aer(iant3_o_a,jtotal,ibin)*conv1b
2335        l = lptr_ant4_o_aer(isize,itype,iphase)
2336        if (l .ge. p1st) rsub(l,k,m) = aer(iant4_o_a,jtotal,ibin)*conv1b
2337        l = lptr_biog1_c_aer(isize,itype,iphase)
2338        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog1_c_a,jtotal,ibin)*conv1b
2339        l = lptr_biog2_c_aer(isize,itype,iphase)
2340        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog2_c_a,jtotal,ibin)*conv1b
2341        l = lptr_biog3_c_aer(isize,itype,iphase)
2342        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog3_c_a,jtotal,ibin)*conv1b
2343        l = lptr_biog4_c_aer(isize,itype,iphase)
2344        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog4_c_a,jtotal,ibin)*conv1b
2345        l = lptr_biog1_o_aer(isize,itype,iphase)
2346        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog1_o_a,jtotal,ibin)*conv1b
2347        l = lptr_biog2_o_aer(isize,itype,iphase)
2348        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog2_o_a,jtotal,ibin)*conv1b
2349        l = lptr_biog3_o_aer(isize,itype,iphase)
2350        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog3_o_a,jtotal,ibin)*conv1b
2351        l = lptr_biog4_o_aer(isize,itype,iphase)
2352        if (l .ge. p1st) rsub(l,k,m) = aer(ibiog4_o_a,jtotal,ibin)*conv1b
2353
2354        l = lptr_asoaX_aer(isize,itype,iphase)
2355        if (l .ge. p1st) rsub(l,k,m) = aer(iasoaX_a,jtotal,ibin)*conv1b
2356        l = lptr_asoa1_aer(isize,itype,iphase)
2357        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa1_a,jtotal,ibin)*conv1b
2358        l = lptr_asoa2_aer(isize,itype,iphase)
2359        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa2_a,jtotal,ibin)*conv1b
2360        l = lptr_asoa3_aer(isize,itype,iphase)
2361        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa3_a,jtotal,ibin)*conv1b
2362        l = lptr_asoa4_aer(isize,itype,iphase)
2363        if (l .ge. p1st) rsub(l,k,m) = aer(iasoa4_a,jtotal,ibin)*conv1b
2364        l = lptr_bsoaX_aer(isize,itype,iphase)
2365        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoaX_a,jtotal,ibin)*conv1b
2366        l = lptr_bsoa1_aer(isize,itype,iphase)
2367        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa1_a,jtotal,ibin)*conv1b
2368        l = lptr_bsoa2_aer(isize,itype,iphase)
2369        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa2_a,jtotal,ibin)*conv1b
2370        l = lptr_bsoa3_aer(isize,itype,iphase)
2371        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa3_a,jtotal,ibin)*conv1b
2372        l = lptr_bsoa4_aer(isize,itype,iphase)
2373        if (l .ge. p1st) rsub(l,k,m) = aer(ibsoa4_a,jtotal,ibin)*conv1b
2374
2375
2376
2377
2378         l = hyswptr_aer(isize,itype)
2379         if (l .ge. p1st) rsub(l,k,m) = water_a_hyst(ibin)*conv2b
2380
2381         l = waterptr_aer(isize,itype)
2382         if (l .ge. p1st) rsub(l,k,m) = water_a(ibin)*conv2b
2383
2384         l = numptr_aer(isize,itype,iphase)
2385         if (l .ge. p1st) rsub(l,k,m) =  num_a(ibin)/cair_mol_cc
2386
2387
2388         drymass_aftgrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc ! g/mol-air
2389         if(jaerosolstate(ibin) .eq. no_aerosol) then
2390             drydens_aftgrow(isize,itype) = -1.
2391         else
2392             drydens_aftgrow(isize,itype) = dens_dry_a(ibin)         ! g/cc
2393         end if
2394
2395 20      continue
2396
2397       endif
2398
2399       return
2400       end subroutine map_mosaic_species
2401
2402
2403
2404
2405
2406       subroutine isize_itype_from_ibin( ibin, isize, itype )
2407 !
2408 ! inside of mosaic, the '2d' (isize,itype) indexing is replaced
2409 !     by '1d' (ibin) indexing
2410 ! this routine gives (isize,itype) corresponding to (ibin)
2411 !
2412       use module_data_mosaic_asect
2413       use module_data_mosaic_other, only:  lunerr
2414 !     implicit none
2415
2416 ! subr arguments
2417       integer ibin, isize, itype
2418 ! local variables
2419       integer jdum_bin, jdum_size, jdum_type
2420       character*80 msg
2421
2422       isize = -999888777
2423       itype = -999888777
2424
2425       jdum_bin = 0
2426       do jdum_type = 1, ntype_aer
2427       do jdum_size = 1, nsize_aer(jdum_type)
2428           jdum_bin = jdum_bin + 1
2429           if (ibin .eq. jdum_bin) then
2430               isize = jdum_size
2431               itype = jdum_type
2432           end if
2433       end do
2434       end do
2435
2436       if (isize .le. 0) then
2437           write(msg,'(a,1x,i5)')   &
2438               '*** subr isize_itype_from_ibin - bad ibin =', ibin
2439           call peg_error_fatal( lunerr, msg )
2440       end if
2441
2442       return
2443       end subroutine isize_itype_from_ibin
2444
2445
2446
2447
2448       subroutine overall_massbal_in
2449
2450       use module_data_mosaic_asect
2451       use module_data_mosaic_other
2452
2453 !     implicit none
2454 !     include 'mosaic.h'
2455       integer ibin
2456
2457       tot_so4_in = gas(ih2so4_g)
2458       tot_no3_in = gas(ihno3_g)
2459       tot_cl_in  = gas(ihcl_g)
2460       tot_nh4_in = gas(inh3_g)
2461       tot_na_in  = 0.0
2462       tot_ca_in  = 0.0
2463
2464
2465       do ibin = 1, nbin_a
2466         tot_so4_in = tot_so4_in + aer(iso4_a,jtotal,ibin)
2467         tot_no3_in = tot_no3_in + aer(ino3_a,jtotal,ibin)
2468         tot_cl_in  = tot_cl_in  + aer(icl_a, jtotal,ibin)
2469         tot_nh4_in = tot_nh4_in + aer(inh4_a,jtotal,ibin)
2470         tot_na_in  = tot_na_in  + aer(ina_a,jtotal,ibin)
2471         tot_ca_in  = tot_ca_in  + aer(ica_a,jtotal,ibin)
2472       enddo
2473
2474
2475         total_species(inh3_g) = tot_nh4_in
2476         total_species(ihno3_g)= tot_no3_in
2477         total_species(ihcl_g) = tot_cl_in
2478
2479
2480       return
2481       end subroutine overall_massbal_in
2482
2483
2484
2485       subroutine overall_massbal_out(mbin)
2486 !     implicit none
2487 !      include 'v33com'
2488 !      include 'v33com3'
2489 !      include 'v33com9a'
2490 !      include 'v33com9b'
2491 !     include 'mosaic.h'
2492
2493 ! subr. agrument
2494       integer mbin
2495 ! local variables
2496       integer ibin
2497
2498
2499
2500         tot_so4_out = gas(ih2so4_g)
2501         tot_no3_out = gas(ihno3_g)
2502         tot_cl_out  = gas(ihcl_g)
2503         tot_nh4_out = gas(inh3_g)
2504         tot_na_out  = 0.0
2505         tot_ca_out  = 0.0
2506
2507         do ibin = 1, nbin_a
2508           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
2509           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
2510           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
2511           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
2512           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
2513           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
2514         enddo
2515
2516         diff_so4 = tot_so4_out - tot_so4_in
2517         diff_no3 = tot_no3_out - tot_no3_in
2518         diff_cl  = tot_cl_out  - tot_cl_in
2519         diff_nh4 = tot_nh4_out - tot_nh4_in
2520         diff_na  = tot_na_out  - tot_na_in
2521         diff_ca  = tot_ca_out  - tot_ca_in
2522
2523
2524         reldiff_so4 = 0.0
2525         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
2526           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
2527         endif
2528
2529         reldiff_no3 = 0.0
2530         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
2531           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
2532         endif
2533
2534         reldiff_cl = 0.0
2535         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
2536           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
2537         endif
2538
2539         reldiff_nh4 = 0.0
2540         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
2541           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
2542         endif
2543
2544         reldiff_na = 0.0
2545         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
2546           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
2547         endif
2548
2549         reldiff_ca = 0.0
2550         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
2551           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
2552         endif
2553
2554
2555
2556       if(  abs(reldiff_so4) .gt. 1.e-4 .or.   &
2557            abs(reldiff_no3) .gt. 1.e-4 .or.   &
2558            abs(reldiff_cl)  .gt. 1.e-4 .or.   &
2559            abs(reldiff_nh4) .gt. 1.e-4 .or.   &
2560            abs(reldiff_na)  .gt. 1.e-4 .or.   &
2561            abs(reldiff_ca)  .gt. 1.e-4)then
2562
2563
2564         if (iprint_mosaic_diag1 .gt. 0) then
2565           if (iprint_input .eq. myes) then
2566             write(6,*)'*** mbin = ', mbin, '  isteps = ', isteps_ASTEM
2567             write(6,*)'reldiff_so4 = ', reldiff_so4
2568             write(6,*)'reldiff_no3 = ', reldiff_no3
2569             write(6,*)'reldiff_cl  = ', reldiff_cl
2570             write(6,*)'reldiff_nh4 = ', reldiff_nh4
2571             write(6,*)'reldiff_na  = ', reldiff_na
2572             write(6,*)'reldiff_ca  = ', reldiff_ca
2573             call print_input
2574             iprint_input = mno
2575           endif
2576         endif
2577
2578       endif
2579
2580
2581       return
2582       end subroutine overall_massbal_out
2583
2584
2585
2586
2587
2588
2589
2590       subroutine print_input
2591
2592       use module_data_mosaic_asect
2593       use module_data_mosaic_other
2594
2595 !     implicit none
2596 !     include 'v33com'
2597 !     include 'v33com3'
2598 !     include 'v33com9a'
2599 !     include 'v33com9b'
2600 !     include 'mosaic.h'
2601 ! subr arguments
2602       integer k, m
2603 ! local variables
2604       integer ibin, iphase, isize, itype
2605       integer ipasstmp, luntmp
2606
2607
2608 ! check for print_input allowed and not already done
2609         if (iprint_mosaic_input_ok .le. 0) return
2610         if (iprint_input .ne. myes) return
2611         iprint_input = mno
2612
2613         k = kclm_aer
2614         m = mclm_aer
2615
2616
2617         tot_so4_out = gas(ih2so4_g)
2618         tot_no3_out = gas(ihno3_g)
2619         tot_cl_out  = gas(ihcl_g)
2620         tot_nh4_out = gas(inh3_g)
2621         tot_na_out  = 0.0
2622         tot_ca_out  = 0.0
2623
2624         do ibin = 1, nbin_a
2625           tot_so4_out = tot_so4_out + aer(iso4_a,jtotal,ibin)
2626           tot_no3_out = tot_no3_out + aer(ino3_a,jtotal,ibin)
2627           tot_cl_out  = tot_cl_out  + aer(icl_a,jtotal,ibin)
2628           tot_nh4_out = tot_nh4_out + aer(inh4_a,jtotal,ibin)
2629           tot_na_out  = tot_na_out  + aer(ina_a,jtotal,ibin)
2630           tot_ca_out  = tot_ca_out  + aer(ica_a,jtotal,ibin)
2631         enddo
2632
2633         diff_so4 = tot_so4_out - tot_so4_in
2634         diff_no3 = tot_no3_out - tot_no3_in
2635         diff_cl  = tot_cl_out  - tot_cl_in
2636         diff_nh4 = tot_nh4_out - tot_nh4_in
2637         diff_na  = tot_na_out  - tot_na_in
2638         diff_ca  = tot_ca_out  - tot_ca_in
2639
2640
2641         reldiff_so4 = 0.0
2642         if(tot_so4_in .gt. 1.e-25 .or. tot_so4_out .gt. 1.e-25)then
2643           reldiff_so4 = diff_so4/max(tot_so4_in, tot_so4_out)
2644         endif
2645
2646         reldiff_no3 = 0.0
2647         if(tot_no3_in .gt. 1.e-25 .or. tot_no3_out .gt. 1.e-25)then
2648           reldiff_no3 = diff_no3/max(tot_no3_in, tot_no3_out)
2649         endif
2650
2651         reldiff_cl = 0.0
2652         if(tot_cl_in .gt. 1.e-25 .or. tot_cl_out .gt. 1.e-25)then
2653           reldiff_cl = diff_cl/max(tot_cl_in, tot_cl_out)
2654         endif
2655
2656         reldiff_nh4 = 0.0
2657         if(tot_nh4_in .gt. 1.e-25 .or. tot_nh4_out .gt. 1.e-25)then
2658           reldiff_nh4 = diff_nh4/max(tot_nh4_in, tot_nh4_out)
2659         endif
2660
2661         reldiff_na = 0.0
2662         if(tot_na_in .gt. 1.e-25 .or. tot_na_out .gt. 1.e-25)then
2663           reldiff_na = diff_na/max(tot_na_in, tot_na_out)
2664         endif
2665
2666         reldiff_ca = 0.0
2667         if(tot_ca_in .gt. 1.e-25 .or. tot_ca_out .gt. 1.e-25)then
2668           reldiff_ca = diff_ca/max(tot_ca_in, tot_ca_out)
2669         endif
2670
2671
2672         do 2900 ipasstmp = 1, 2
2673
2674         if (ipasstmp .eq. 1) then
2675            luntmp = 6     ! write to standard output
2676         else
2677            luntmp = 67    ! write to fort.67
2678 !           goto 2900      ! skip this
2679         endif
2680
2681 ! write to monitor screen
2682           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
2683           write(luntmp,*)'i j k n = ', iclm_aer, jclm_aer, kclm_aer,   &
2684                                   ncorecnt_aer
2685           write(luntmp,*)'relative so4 mass bal = ', reldiff_so4
2686           write(luntmp,*)'relative no3 mass bal = ', reldiff_no3
2687           write(luntmp,*)'relative cl  mass bal = ', reldiff_cl
2688           write(luntmp,*)'relative nh4 mass bal = ', reldiff_nh4
2689           write(luntmp,*)'relative na  mass bal = ', reldiff_na
2690           write(luntmp,*)'relative ca  mass bal = ', reldiff_ca
2691           write(luntmp,*)'inputs:'
2692           write(luntmp,*)'t (k), p (atm), rh (%), cair (mol/cc) = '
2693           write(luntmp,44) t_k, p_atm, rh_pc, cairclm(k)
2694           write(luntmp,*)'gas h2so4, hno3, hcl, nh3 (mol/mol)'
2695           write(luntmp,44)rsub(kh2so4,k,m), rsub(khno3,k,m),   &
2696                           rsub(khcl,k,m), rsub(knh3,k,m)
2697
2698
2699           iphase = ai_phase
2700           ibin = 0
2701           do itype = 1, ntype_aer
2702           do isize = 1, nsize_aer(itype)
2703           ibin = ibin + 1
2704
2705           write(luntmp,44) rsub(lptr_so4_aer(ibin,itype,iphase),k,m),   &
2706                       rsub(lptr_no3_aer(ibin,itype,iphase),k,m),   &
2707                       rsub(lptr_cl_aer(ibin,itype,iphase),k,m),   &
2708                       rsub(lptr_nh4_aer(ibin,itype,iphase),k,m),   &
2709                       rsub(lptr_oc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
2710                       rsub(lptr_co3_aer(ibin,itype,iphase),k,m),   &
2711                       rsub(lptr_msa_aer(ibin,itype,iphase),k,m),   &
2712                       rsub(lptr_bc_aer(ibin,itype,iphase),k,m),    &  ! ng/m^3(air)
2713                       rsub(lptr_na_aer(ibin,itype,iphase),k,m),   &
2714                       rsub(lptr_ca_aer(ibin,itype,iphase),k,m),   &
2715                       rsub(lptr_oin_aer(ibin,itype,iphase),k,m),           &
2716                       rsub(hyswptr_aer(ibin,itype),k,m),   &
2717                       rsub(waterptr_aer(ibin,itype),k,m),   &
2718                       rsub(numptr_aer(ibin,itype,iphase),k,m)
2719           enddo
2720           enddo
2721
2722           write(luntmp,*)'+++++++++++++++++++++++++++++++++++++++++'
2723
2724 2900    continue
2725
2726
2727 44      format(14e20.10)
2728
2729 !c      stop
2730
2731       return
2732       end subroutine print_input
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751 !***********************************************************************
2752 ! checks if aerosol mass is too low to be of any significance
2753 ! and determine jaerosolstate
2754 !
2755 ! author: rahul a. zaveri
2756 ! update: jan 2005
2757 !-----------------------------------------------------------------------
2758       subroutine check_aerosol_mass(ibin)
2759 !     implicit none
2760 !     include 'mosaic.h'
2761 ! subr arguments
2762       integer ibin
2763 ! local variables
2764       integer iaer
2765       real(kind=8) drymass, aer_H
2766
2767       mass_dry_a(ibin) = 0.0
2768
2769       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2770                   aer(ino3_a,jtotal,ibin) +  &
2771                   aer(icl_a,jtotal,ibin)  +  &
2772                   aer(imsa_a,jtotal,ibin) +  &
2773                2.*aer(ico3_a,jtotal,ibin))-  &
2774               (2.*aer(ica_a,jtotal,ibin)  +  &
2775                   aer(ina_a,jtotal,ibin)  +  &
2776                   aer(inh4_a,jtotal,ibin))
2777
2778
2779       do iaer = 1, naer
2780         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
2781                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
2782       enddo
2783       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
2784
2785       drymass = mass_dry_a(ibin)                        ! ng/m^3(air)
2786       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15        ! g/cc(air)
2787
2788       if(drymass .lt. mass_cutoff)then                  ! bin mass is too small
2789         jaerosolstate(ibin) = no_aerosol
2790         jphase(ibin) = 0
2791         if(drymass .eq. 0.)num_a(ibin) = 0.0
2792       endif
2793
2794       return
2795       end subroutine check_aerosol_mass
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807 !***********************************************************************
2808 ! checks and conforms number according to the mass and bin size range
2809 !
2810 ! author: rahul a. zaveri
2811 ! update: jan 2005
2812 !-----------------------------------------------------------------------
2813       subroutine conform_aerosol_number(ibin)
2814
2815       use module_data_mosaic_asect
2816
2817 !     implicit none
2818 !     include 'v33com'
2819 !     include 'v33com3'
2820 !     include 'v33com9a'
2821 !     include 'mosaic.h'
2822 ! subr arguments
2823       integer ibin
2824 ! local variables
2825       integer je, l, iaer, isize, itype
2826       real(kind=8) num_at_dlo, num_at_dhi, numold
2827       real(kind=8) aer_H
2828
2829       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
2830
2831       if(jaerosolstate(ibin) .eq. no_aerosol) return
2832
2833       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2834                   aer(ino3_a,jtotal,ibin) +  &
2835                   aer(icl_a,jtotal,ibin)  +  &
2836                   aer(imsa_a,jtotal,ibin) +  &
2837                2.*aer(ico3_a,jtotal,ibin))-  &
2838               (2.*aer(ica_a,jtotal,ibin)  +  &
2839                   aer(ina_a,jtotal,ibin)  +  &
2840                   aer(inh4_a,jtotal,ibin))
2841
2842       do iaer = 1, naer
2843         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
2844         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)  ! ng/m^3(air)
2845       enddo
2846       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
2847
2848       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15  ! cc(aer)/cc(air)
2849
2850 ! conform number
2851       call isize_itype_from_ibin( ibin, isize, itype )
2852       num_at_dlo = vol_dry_a(ibin)/volumlo_sect(isize,itype)
2853       num_at_dhi = vol_dry_a(ibin)/volumhi_sect(isize,itype)
2854
2855       numold = num_a(ibin)
2856       num_a(ibin) = min(num_a(ibin), num_at_dlo) ! #/cc(air)
2857       num_a(ibin) = max(num_a(ibin), num_at_dhi) ! #/cc(air)
2858
2859 !     if (numold .ne. num_a(ibin)) then
2860 !       write(*,*) 'conform number - i, vol, mass, numold/new', ibin,
2861 !     &       vol_dry_a(ibin), mass_dry_temp, numold, num_a(ibin)
2862 !       write(*,*) 'conform i,j,k', iclm_aer, jclm_aer, kclm_aer
2863 !       if (nsubareas .gt. 0) then
2864 !       write(*,'(a,1pe14.4)') (name(l), rsub(l,kclm_aer,1), l=1,ltot2)
2865 !       else
2866 !       write(*,'(a,1pe14.4)') (name(l), rclm(kclm_aer,l), l=1,ltot2)
2867 !       end if
2868 !      stop
2869 !      end if
2870
2871       return
2872       end subroutine conform_aerosol_number
2873
2874
2875
2876
2877
2878 !***********************************************************************
2879 ! determines phase state of an aerosol bin. includes kelvin effect.
2880 !
2881 ! author: rahul a. zaveri
2882 ! update: jan 2005
2883 !-----------------------------------------------------------------------
2884       subroutine aerosol_phase_state(ibin)
2885 !     implicit none
2886 !     include 'mosaic.h'
2887 ! subr arguments
2888       integer ibin
2889 ! local variables
2890       integer js, je, iaer, iv, iter_kelvin
2891       real(kind=8) ah2o_a_new, rel_err
2892 !     real(kind=8) aerosol_water_up, bin_molality               ! mosaic func
2893       real(kind=8) kelvin_toler, term
2894       real(kind=8) aer_H
2895
2896
2897       ah2o = rh_pc*0.01
2898       ah2o_a(ibin) = ah2o
2899       kelvin(ibin) = 1.0
2900       do iv = 1, ngas_volatile+ngas_het
2901         kel(iv,ibin) = 1.0
2902       enddo
2903
2904       if(rh_pc .le. 99)then
2905         kelvin_toler = 1.e-2
2906       else
2907         kelvin_toler = 1.e-6
2908       endif
2909
2910 ! calculate dry mass and dry volume of a bin
2911       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
2912       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
2913
2914       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
2915                   aer(ino3_a,jtotal,ibin) +  &
2916                   aer(icl_a,jtotal,ibin)  +  &
2917                   aer(imsa_a,jtotal,ibin) +  &
2918                2.*aer(ico3_a,jtotal,ibin))-  &
2919               (2.*aer(ica_a,jtotal,ibin)  +  &
2920                   aer(ina_a,jtotal,ibin)  +  &
2921                   aer(inh4_a,jtotal,ibin))
2922
2923       do iaer = 1, naer
2924         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
2925                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
2926         vol_dry_a(ibin)  = vol_dry_a(ibin) +   &
2927         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
2928       enddo
2929       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
2930       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
2931
2932       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
2933       vol_dry_a(ibin)  = vol_dry_a(ibin)*1.e-15                         ! cc(aer)/cc(air) or m^3/m^3(air)
2934
2935 ! wet mass and wet volume
2936       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
2937       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
2938
2939
2940       water_a_up(ibin) = aerosol_water_up(ibin) ! for hysteresis curve determination
2941
2942       iter_kelvin = 0
2943
2944 10    iter_kelvin = iter_kelvin + 1
2945       do je = 1, nelectrolyte
2946         molality0(je) = bin_molality(je,ibin)   ! compute ah2o dependent binary molalities
2947       enddo
2948
2949       call mesa(ibin)
2950       if(jaerosolstate(ibin) .eq. all_solid)then
2951         return
2952       endif
2953       if (istat_mosaic_fe1 .lt. 0) return
2954
2955 ! new wet mass and wet volume
2956       mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3         ! g/cc(air)
2957       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
2958
2959       call calculate_kelvin(ibin)
2960
2961       ah2o_a_new = rh_pc*0.01/kelvin(ibin)
2962
2963       rel_err = abs( (ah2o_a_new - ah2o_a(ibin))/ah2o_a(ibin))
2964
2965       if(rel_err .gt. kelvin_toler .and. iter_kelvin.le.10)then
2966         ah2o_a(ibin) = ah2o_a_new
2967         goto 10
2968       endif
2969
2970       if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
2971
2972 ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
2973       do iv = 1,  ngas_volatile+ngas_het
2974         term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/  &
2975                        (8.3144e7*T_K*DpmV(ibin))
2976         kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
2977       enddo
2978
2979
2980       return
2981       end subroutine aerosol_phase_state
2982
2983
2984
2985
2986
2987
2988 !***********************************************************************
2989 ! computes kelvin effect term (kelvin => 1.0)
2990 !
2991 ! author: rahul a. zaveri
2992 ! update: jan 2005
2993 !-----------------------------------------------------------------------
2994       subroutine calculate_kelvin(ibin)
2995 !     implicit none
2996 !     include 'mosaic.h'
2997 ! subr arguments
2998       integer ibin
2999 ! local variables
3000       real(kind=8) term
3001
3002
3003
3004       volume_a(ibin) = vol_wet_a(ibin)                                  ! [cc/cc(air)]
3005       dpmv(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*3.1415926))**(1./3.)   ! [cm]
3006       sigma_soln(ibin) = sigma_water + 49.0*(1. - ah2o_a(ibin))         ! [dyn/cm]
3007       term = 72.*sigma_soln(ibin)/(8.3144e7*t_k*dpmv(ibin))             ! [-]
3008 !      kelvin(ibin) = exp(term)
3009       kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
3010
3011
3012       return
3013       end subroutine calculate_kelvin
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029 !***********************************************************************
3030 ! mesa: multicomponent equilibrium solver for aerosols.
3031 ! computes equilibrum solid and liquid phases by integrating
3032 ! pseudo-transient dissolution and precipitation reactions
3033 !
3034 ! author: rahul a. zaveri
3035 ! update: jan 2005
3036 ! update: 21 may 2014 - revised code to force metastable or stable state (upper curve) for RH > 35%
3037 !
3038 !-----------------------------------------------------------------------
3039       subroutine mesa(ibin)     ! touch
3040 !     implicit none
3041 !     include 'mosaic.h'
3042 ! subr arguments
3043       integer ibin
3044
3045 ! local variables
3046       integer idissolved, j_index, jdum, js, je         ! raz update 11/13/2008
3047       real(kind=8) crh, solids, sum_soluble, sum_insoluble, xt
3048 !     real(kind=8) aerosol_water                                ! mosaic func
3049 !     real(kind=8) drh_mutual                                   ! mosaic func
3050       real(kind=8) h_ion, sum_dum                               ! raz update 11/13/2008
3051
3052
3053 ! calculate percent composition ! raz update 11/13/2008
3054       sum_dum = 0.0
3055       do je = 1, nelectrolyte
3056         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
3057       enddo
3058
3059       if(sum_dum .eq. 0.)sum_dum = 1.0
3060
3061       do je = 1, nelectrolyte
3062         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
3063       enddo
3064
3065
3066       call calculate_xt(ibin,jtotal,xt)
3067
3068       crh = 0.35  ! raz-30apr07
3069
3070 ! step 1: check if ah2o is below crh (crystallization or efflorescence point)
3071       if( (ah2o_a(ibin) .lt. crh)   .and. &
3072           (xt.gt.1.0 .or. xt.lt.0.) .and. &
3073           (epercent(jcano3,jtotal,ibin) .le. ptol_mol_astem) .and. &
3074           (epercent(jcacl2,jtotal,ibin) .le. ptol_mol_astem) )then     ! raz-30apr07
3075         jaerosolstate(ibin) = all_solid
3076         jphase(ibin)    = jsolid
3077         jhyst_leg(ibin) = jhyst_lo
3078         call adjust_solid_aerosol(ibin)
3079         return
3080       endif
3081
3082
3083 ! step 2: check for supersaturation/metastable state
3084 !     jdum = 1 ! 1 = forced metastable. 0 = maybe stable               ! RAZ 5/21/2014
3085 !     if(water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin) .or. jdum .eq. 1)then
3086
3087 ! 2017.12.03 water hysteresis changes
3088       if (mhyst_method .eq. mhyst_uporlo_waterhyst) then
3089          jdum = 0
3090          if (water_a_hyst(ibin) .gt. 0.5*water_a_up(ibin)) jdum = 1
3091       else if (mhyst_method .eq. mhyst_force_up) then
3092          jdum = 1
3093       else ! if (mhyst_method .eq. mhyst_force_lo) then
3094          jdum = 0
3095       end if
3096
3097       if (jdum .eq. 1) then
3098
3099         call do_full_deliquescence(ibin)
3100
3101 !       sum_soluble = 0.0
3102 !       do js = 1, nsoluble
3103 !         sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
3104 !       enddo
3105
3106 !       solids = electrolyte(jcaso4,jtotal,ibin) +   &
3107 !                electrolyte(jcaco3,jtotal,ibin) +   &
3108 !                aer(ioin_a ,jtotal,ibin)
3109 !
3110 !
3111 !       if(sum_soluble .lt. 1.e-15 .and. solids .gt. 0.0)then
3112 !
3113 !         jaerosolstate(ibin) = all_solid ! no soluble material present
3114 !         jphase(ibin) = jsolid
3115 !         call adjust_solid_aerosol(ibin)
3116 !
3117 ! new wet mass and wet volume
3118 !         mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
3119 !         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
3120 !         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
3121 !
3122 !         return
3123 !
3124 !       elseif(sum_soluble .gt. 0.0 .and. solids .eq. 0.0)then
3125
3126           jaerosolstate(ibin) = all_liquid
3127           jhyst_leg(ibin) = jhyst_up
3128           jphase(ibin) = jliquid
3129           water_a(ibin) = aerosol_water(jtotal,ibin)
3130
3131           if(water_a(ibin) .lt. 0.0)then    ! one last attempt to catch bad input
3132             jaerosolstate(ibin) = all_solid ! no soluble material present
3133             jphase(ibin)    = jsolid
3134             jhyst_leg(ibin) = jhyst_lo
3135             call adjust_solid_aerosol(ibin)
3136           else
3137             call adjust_liquid_aerosol(ibin)
3138             call compute_activities(ibin)
3139           endif
3140
3141 ! new wet mass and wet volume
3142           mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3     ! g/cc(air)
3143           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3      ! cc(aer)/cc(air) or m^3/m^3(air)
3144           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)       ! mass growth factor
3145
3146           return
3147
3148 !       endif
3149
3150       endif
3151
3152
3153
3154
3155 ! step 3: diagnose mdrh
3156       if(xt .lt. 1. .and. xt .gt. 0. )goto 10   ! excess sulfate domain - no mdrh exists
3157
3158       jdum = 0
3159       do js = 1, nsalt
3160         jsalt_present(js) = 0                   ! default value - salt absent
3161
3162         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
3163           jsalt_present(js) = 1                 ! salt present
3164           jdum = jdum + jsalt_index(js)
3165         endif
3166       enddo
3167
3168       if(jdum .eq. 0)then
3169         jaerosolstate(ibin) = all_solid ! no significant soluble material present
3170         jphase(ibin) = jsolid
3171         call adjust_solid_aerosol(ibin)
3172         return
3173       endif
3174
3175       if(xt .ge. 2.0 .or. xt .lt. 0.0)then
3176         j_index = jsulf_poor(jdum)
3177       else
3178         j_index = jsulf_rich(jdum)
3179       endif
3180
3181       mdrh(ibin) = mdrh_t(j_index)
3182
3183       if(ah2o_a(ibin)*100. .lt. mdrh(ibin)) then
3184         jaerosolstate(ibin) = all_solid
3185         jphase(ibin) = jsolid
3186         jhyst_leg(ibin) = jhyst_lo
3187         call adjust_solid_aerosol(ibin)
3188         return
3189       endif
3190
3191
3192 ! step 4: none of the above means it must be sub-saturated or mixed-phase
3193 10    call do_full_deliquescence(ibin)
3194       call mesa_ptc(ibin)       ! determines jaerosolstate(ibin)
3195       if (istat_mosaic_fe1 .lt. 0) return
3196
3197
3198
3199       return
3200       end subroutine mesa
3201
3202
3203
3204
3205
3206
3207
3208
3209 !***********************************************************************
3210 ! this subroutine completely deliquesces an aerosol and partitions
3211 ! all the soluble electrolytes into the liquid phase and insoluble
3212 ! ones into the solid phase. it also calculates the corresponding
3213 ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
3214 ! concentrations
3215 !
3216 ! author: rahul a. zaveri
3217 ! update: jan 2005
3218 !-----------------------------------------------------------------------
3219       subroutine do_full_deliquescence(ibin)    ! touch
3220 !     implicit none
3221 !     include 'mosaic.h'
3222 ! subr arguments
3223       integer ibin
3224 ! local variables
3225       integer js
3226
3227
3228
3229
3230 ! partition all electrolytes into liquid phase
3231       do js = 1, nelectrolyte
3232        electrolyte(js,jsolid,ibin)  = 0.0
3233        electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
3234       enddo
3235 !
3236 ! except these electrolytes, which always remain in the solid phase
3237       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
3238       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
3239       electrolyte(jcaco3,jliquid,ibin)= 0.0
3240       electrolyte(jcaso4,jliquid,ibin)= 0.0
3241
3242
3243 ! partition all the generic aer species into solid and liquid phases
3244 ! solid phase
3245       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
3246       aer(ino3_a,jsolid,ibin) = 0.0
3247       aer(icl_a, jsolid,ibin) = 0.0
3248       aer(inh4_a,jsolid,ibin) = 0.0
3249       aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
3250       aer(imsa_a,jsolid,ibin) = 0.0
3251       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
3252       aer(ina_a, jsolid,ibin) = 0.0
3253       aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) +   &
3254                                 electrolyte(jcaso4,jsolid,ibin)
3255       aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
3256       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
3257       aer(ipcg1_b_c_a,jsolid,ibin)= aer(ipcg1_b_c_a,jtotal,ibin)
3258       aer(ipcg2_b_c_a,jsolid,ibin)= aer(ipcg2_b_c_a,jtotal,ibin)
3259       aer(ipcg3_b_c_a,jsolid,ibin)= aer(ipcg3_b_c_a,jtotal,ibin)
3260       aer(ipcg4_b_c_a,jsolid,ibin)= aer(ipcg4_b_c_a,jtotal,ibin)
3261       aer(ipcg5_b_c_a,jsolid,ibin)= aer(ipcg5_b_c_a,jtotal,ibin)
3262       aer(ipcg6_b_c_a,jsolid,ibin)= aer(ipcg6_b_c_a,jtotal,ibin)
3263       aer(ipcg7_b_c_a,jsolid,ibin)= aer(ipcg7_b_c_a,jtotal,ibin)
3264       aer(ipcg8_b_c_a,jsolid,ibin)= aer(ipcg8_b_c_a,jtotal,ibin)
3265       aer(ipcg9_b_c_a,jsolid,ibin)= aer(ipcg9_b_c_a,jtotal,ibin)
3266       aer(ipcg1_b_o_a,jsolid,ibin)= aer(ipcg1_b_o_a,jtotal,ibin)
3267       aer(ipcg2_b_o_a,jsolid,ibin)= aer(ipcg2_b_o_a,jtotal,ibin)
3268       aer(ipcg3_b_o_a,jsolid,ibin)= aer(ipcg3_b_o_a,jtotal,ibin)
3269       aer(ipcg4_b_o_a,jsolid,ibin)= aer(ipcg4_b_o_a,jtotal,ibin)
3270       aer(ipcg5_b_o_a,jsolid,ibin)= aer(ipcg5_b_o_a,jtotal,ibin)
3271       aer(ipcg6_b_o_a,jsolid,ibin)= aer(ipcg6_b_o_a,jtotal,ibin)
3272       aer(ipcg7_b_o_a,jsolid,ibin)= aer(ipcg7_b_o_a,jtotal,ibin)
3273       aer(ipcg8_b_o_a,jsolid,ibin)= aer(ipcg8_b_o_a,jtotal,ibin)
3274       aer(ipcg9_b_o_a,jsolid,ibin)= aer(ipcg9_b_o_a,jtotal,ibin)
3275       aer(iopcg1_b_c_a,jsolid,ibin)= aer(iopcg1_b_c_a,jtotal,ibin)
3276       aer(iopcg2_b_c_a,jsolid,ibin)= aer(iopcg2_b_c_a,jtotal,ibin)
3277       aer(iopcg3_b_c_a,jsolid,ibin)= aer(iopcg3_b_c_a,jtotal,ibin)
3278       aer(iopcg4_b_c_a,jsolid,ibin)= aer(iopcg4_b_c_a,jtotal,ibin)
3279       aer(iopcg5_b_c_a,jsolid,ibin)= aer(iopcg5_b_c_a,jtotal,ibin)
3280       aer(iopcg6_b_c_a,jsolid,ibin)= aer(iopcg6_b_c_a,jtotal,ibin)
3281       aer(iopcg7_b_c_a,jsolid,ibin)= aer(iopcg7_b_c_a,jtotal,ibin)
3282       aer(iopcg8_b_c_a,jsolid,ibin)= aer(iopcg8_b_c_a,jtotal,ibin)
3283       aer(iopcg1_b_o_a,jsolid,ibin)= aer(iopcg1_b_o_a,jtotal,ibin)
3284       aer(iopcg2_b_o_a,jsolid,ibin)= aer(iopcg2_b_o_a,jtotal,ibin)
3285       aer(iopcg3_b_o_a,jsolid,ibin)= aer(iopcg3_b_o_a,jtotal,ibin)
3286       aer(iopcg4_b_o_a,jsolid,ibin)= aer(iopcg4_b_o_a,jtotal,ibin)
3287       aer(iopcg5_b_o_a,jsolid,ibin)= aer(iopcg5_b_o_a,jtotal,ibin)
3288       aer(iopcg6_b_o_a,jsolid,ibin)= aer(iopcg6_b_o_a,jtotal,ibin)
3289       aer(iopcg7_b_o_a,jsolid,ibin)= aer(iopcg7_b_o_a,jtotal,ibin)
3290       aer(iopcg8_b_o_a,jsolid,ibin)= aer(iopcg8_b_o_a,jtotal,ibin)
3291       aer(ipcg1_f_c_a,jsolid,ibin)= aer(ipcg1_f_c_a,jtotal,ibin)
3292       aer(ipcg2_f_c_a,jsolid,ibin)= aer(ipcg2_f_c_a,jtotal,ibin)
3293       aer(ipcg3_f_c_a,jsolid,ibin)= aer(ipcg3_f_c_a,jtotal,ibin)
3294       aer(ipcg4_f_c_a,jsolid,ibin)= aer(ipcg4_f_c_a,jtotal,ibin)
3295       aer(ipcg5_f_c_a,jsolid,ibin)= aer(ipcg5_f_c_a,jtotal,ibin)
3296       aer(ipcg6_f_c_a,jsolid,ibin)= aer(ipcg6_f_c_a,jtotal,ibin)
3297       aer(ipcg7_f_c_a,jsolid,ibin)= aer(ipcg7_f_c_a,jtotal,ibin)
3298       aer(ipcg8_f_c_a,jsolid,ibin)= aer(ipcg8_f_c_a,jtotal,ibin)
3299       aer(ipcg9_f_c_a,jsolid,ibin)= aer(ipcg9_f_c_a,jtotal,ibin)
3300       aer(ipcg1_f_o_a,jsolid,ibin)= aer(ipcg1_f_o_a,jtotal,ibin)
3301       aer(ipcg2_f_o_a,jsolid,ibin)= aer(ipcg2_f_o_a,jtotal,ibin)
3302       aer(ipcg3_f_o_a,jsolid,ibin)= aer(ipcg3_f_o_a,jtotal,ibin)
3303       aer(ipcg4_f_o_a,jsolid,ibin)= aer(ipcg4_f_o_a,jtotal,ibin)
3304       aer(ipcg5_f_o_a,jsolid,ibin)= aer(ipcg5_f_o_a,jtotal,ibin)
3305       aer(ipcg6_f_o_a,jsolid,ibin)= aer(ipcg6_f_o_a,jtotal,ibin)
3306       aer(ipcg7_f_o_a,jsolid,ibin)= aer(ipcg7_f_o_a,jtotal,ibin)
3307       aer(ipcg8_f_o_a,jsolid,ibin)= aer(ipcg8_f_o_a,jtotal,ibin)
3308       aer(ipcg9_f_o_a,jsolid,ibin)= aer(ipcg9_f_o_a,jtotal,ibin)
3309       aer(iopcg1_f_c_a,jsolid,ibin)= aer(iopcg1_f_c_a,jtotal,ibin)
3310       aer(iopcg2_f_c_a,jsolid,ibin)= aer(iopcg2_f_c_a,jtotal,ibin)
3311       aer(iopcg3_f_c_a,jsolid,ibin)= aer(iopcg3_f_c_a,jtotal,ibin)
3312       aer(iopcg4_f_c_a,jsolid,ibin)= aer(iopcg4_f_c_a,jtotal,ibin)
3313       aer(iopcg5_f_c_a,jsolid,ibin)= aer(iopcg5_f_c_a,jtotal,ibin)
3314       aer(iopcg6_f_c_a,jsolid,ibin)= aer(iopcg6_f_c_a,jtotal,ibin)
3315       aer(iopcg7_f_c_a,jsolid,ibin)= aer(iopcg7_f_c_a,jtotal,ibin)
3316       aer(iopcg8_f_c_a,jsolid,ibin)= aer(iopcg8_f_c_a,jtotal,ibin)
3317       aer(iopcg1_f_o_a,jsolid,ibin)= aer(iopcg1_f_o_a,jtotal,ibin)
3318       aer(iopcg2_f_o_a,jsolid,ibin)= aer(iopcg2_f_o_a,jtotal,ibin)
3319       aer(iopcg3_f_o_a,jsolid,ibin)= aer(iopcg3_f_o_a,jtotal,ibin)
3320       aer(iopcg4_f_o_a,jsolid,ibin)= aer(iopcg4_f_o_a,jtotal,ibin)
3321       aer(iopcg5_f_o_a,jsolid,ibin)= aer(iopcg5_f_o_a,jtotal,ibin)
3322       aer(iopcg6_f_o_a,jsolid,ibin)= aer(iopcg6_f_o_a,jtotal,ibin)
3323       aer(iopcg7_f_o_a,jsolid,ibin)= aer(iopcg7_f_o_a,jtotal,ibin)
3324       aer(iopcg8_f_o_a,jsolid,ibin)= aer(iopcg8_f_o_a,jtotal,ibin)
3325       aer(ismpa_a,jsolid,ibin)= aer(ismpa_a,jtotal,ibin)
3326       aer(ismpbb_a,jsolid,ibin)= aer(ismpbb_a,jtotal,ibin)
3327       aer(iglysoa_r1_a,jsolid,ibin)= aer(iglysoa_r1_a,jtotal,ibin)
3328       aer(iglysoa_r2_a,jsolid,ibin)= aer(iglysoa_r2_a,jtotal,ibin)
3329       aer(iglysoa_sfc_a,jsolid,ibin)= aer(iglysoa_sfc_a,jtotal,ibin)
3330       aer(iglysoa_nh4_a,jsolid,ibin)= aer(iglysoa_nh4_a,jtotal,ibin)
3331       aer(iglysoa_oh_a,jsolid,ibin)= aer(iglysoa_oh_a,jtotal,ibin)
3332       aer(iant1_c_a,jsolid,ibin)= aer(iant1_c_a,jtotal,ibin)
3333       aer(iant2_c_a,jsolid,ibin)= aer(iant2_c_a,jtotal,ibin)
3334       aer(iant3_c_a,jsolid,ibin)= aer(iant3_c_a,jtotal,ibin)
3335       aer(iant4_c_a,jsolid,ibin)= aer(iant4_c_a,jtotal,ibin)
3336       aer(iant1_o_a,jsolid,ibin)= aer(iant1_o_a,jtotal,ibin)
3337       aer(iant2_o_a,jsolid,ibin)= aer(iant2_o_a,jtotal,ibin)
3338       aer(iant3_o_a,jsolid,ibin)= aer(iant3_o_a,jtotal,ibin)
3339       aer(iant4_o_a,jsolid,ibin)= aer(iant4_o_a,jtotal,ibin)
3340       aer(ibiog1_c_a,jsolid,ibin)= aer(ibiog1_c_a,jtotal,ibin)
3341       aer(ibiog2_c_a,jsolid,ibin)= aer(ibiog2_c_a,jtotal,ibin)
3342       aer(ibiog3_c_a,jsolid,ibin)= aer(ibiog3_c_a,jtotal,ibin)
3343       aer(ibiog4_c_a,jsolid,ibin)= aer(ibiog4_c_a,jtotal,ibin)
3344       aer(ibiog1_o_a,jsolid,ibin)= aer(ibiog1_o_a,jtotal,ibin)
3345       aer(ibiog2_o_a,jsolid,ibin)= aer(ibiog2_o_a,jtotal,ibin)
3346       aer(ibiog3_o_a,jsolid,ibin)= aer(ibiog3_o_a,jtotal,ibin)
3347       aer(ibiog4_o_a,jsolid,ibin)= aer(ibiog4_o_a,jtotal,ibin)
3348       aer(iasoaX_a,jsolid,ibin)= aer(iasoaX_a,jtotal,ibin)
3349       aer(iasoa1_a,jsolid,ibin)= aer(iasoa1_a,jtotal,ibin)
3350       aer(iasoa2_a,jsolid,ibin)= aer(iasoa2_a,jtotal,ibin)
3351       aer(iasoa3_a,jsolid,ibin)= aer(iasoa3_a,jtotal,ibin)
3352       aer(iasoa4_a,jsolid,ibin)= aer(iasoa4_a,jtotal,ibin)
3353       aer(ibsoaX_a,jsolid,ibin)= aer(ibsoaX_a,jtotal,ibin)
3354       aer(ibsoa1_a,jsolid,ibin)= aer(ibsoa1_a,jtotal,ibin)
3355       aer(ibsoa2_a,jsolid,ibin)= aer(ibsoa2_a,jtotal,ibin)
3356       aer(ibsoa3_a,jsolid,ibin)= aer(ibsoa3_a,jtotal,ibin)
3357       aer(ibsoa4_a,jsolid,ibin)= aer(ibsoa4_a,jtotal,ibin)
3358
3359 ! liquid-phase
3360       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) -   &
3361                                  electrolyte(jcaso4,jsolid,ibin)
3362       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
3363       aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
3364       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
3365       aer(ioc_a, jliquid,ibin) = 0.0
3366       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
3367       aer(ico3_a,jliquid,ibin) = 0.0
3368       aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
3369       aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) +   &
3370                                  electrolyte(jcacl2,jtotal,ibin)
3371       aer(ibc_a, jliquid,ibin) = 0.0
3372       aer(ioin_a,jliquid,ibin) = 0.0
3373       aer(ipcg1_b_c_a,jliquid,ibin)= 0.0
3374       aer(ipcg2_b_c_a,jliquid,ibin)= 0.0
3375       aer(ipcg3_b_c_a,jliquid,ibin)= 0.0
3376       aer(ipcg4_b_c_a,jliquid,ibin)= 0.0
3377       aer(ipcg5_b_c_a,jliquid,ibin)= 0.0
3378       aer(ipcg6_b_c_a,jliquid,ibin)= 0.0
3379       aer(ipcg7_b_c_a,jliquid,ibin)= 0.0
3380       aer(ipcg8_b_c_a,jliquid,ibin)= 0.0
3381       aer(ipcg9_b_c_a,jliquid,ibin)= 0.0
3382       aer(ipcg1_b_o_a,jliquid,ibin)= 0.0
3383       aer(ipcg2_b_o_a,jliquid,ibin)= 0.0
3384       aer(ipcg3_b_o_a,jliquid,ibin)= 0.0
3385       aer(ipcg4_b_o_a,jliquid,ibin)= 0.0
3386       aer(ipcg5_b_o_a,jliquid,ibin)= 0.0
3387       aer(ipcg6_b_o_a,jliquid,ibin)= 0.0
3388       aer(ipcg7_b_o_a,jliquid,ibin)= 0.0
3389       aer(ipcg8_b_o_a,jliquid,ibin)= 0.0
3390       aer(ipcg9_b_o_a,jliquid,ibin)= 0.0
3391       aer(iopcg1_b_c_a,jliquid,ibin)= 0.0
3392       aer(iopcg2_b_c_a,jliquid,ibin)= 0.0
3393       aer(iopcg3_b_c_a,jliquid,ibin)= 0.0
3394       aer(iopcg4_b_c_a,jliquid,ibin)= 0.0
3395       aer(iopcg5_b_c_a,jliquid,ibin)= 0.0
3396       aer(iopcg6_b_c_a,jliquid,ibin)= 0.0
3397       aer(iopcg7_b_c_a,jliquid,ibin)= 0.0
3398       aer(iopcg8_b_c_a,jliquid,ibin)= 0.0
3399       aer(iopcg1_b_o_a,jliquid,ibin)= 0.0
3400       aer(iopcg2_b_o_a,jliquid,ibin)= 0.0
3401       aer(iopcg3_b_o_a,jliquid,ibin)= 0.0
3402       aer(iopcg4_b_o_a,jliquid,ibin)= 0.0
3403       aer(iopcg5_b_o_a,jliquid,ibin)= 0.0
3404       aer(iopcg6_b_o_a,jliquid,ibin)= 0.0
3405       aer(iopcg7_b_o_a,jliquid,ibin)= 0.0
3406       aer(iopcg8_b_o_a,jliquid,ibin)= 0.0
3407       aer(ipcg1_f_c_a,jliquid,ibin)= 0.0
3408       aer(ipcg2_f_c_a,jliquid,ibin)= 0.0
3409       aer(ipcg3_f_c_a,jliquid,ibin)= 0.0
3410       aer(ipcg4_f_c_a,jliquid,ibin)= 0.0
3411       aer(ipcg5_f_c_a,jliquid,ibin)= 0.0
3412       aer(ipcg6_f_c_a,jliquid,ibin)= 0.0
3413       aer(ipcg7_f_c_a,jliquid,ibin)= 0.0
3414       aer(ipcg8_f_c_a,jliquid,ibin)= 0.0
3415       aer(ipcg9_f_c_a,jliquid,ibin)= 0.0
3416       aer(ipcg1_f_o_a,jliquid,ibin)= 0.0
3417       aer(ipcg2_f_o_a,jliquid,ibin)= 0.0
3418       aer(ipcg3_f_o_a,jliquid,ibin)= 0.0
3419       aer(ipcg4_f_o_a,jliquid,ibin)= 0.0
3420       aer(ipcg5_f_o_a,jliquid,ibin)= 0.0
3421       aer(ipcg6_f_o_a,jliquid,ibin)= 0.0
3422       aer(ipcg7_f_o_a,jliquid,ibin)= 0.0
3423       aer(ipcg8_f_o_a,jliquid,ibin)= 0.0
3424       aer(ipcg9_f_o_a,jliquid,ibin)= 0.0
3425       aer(iopcg1_f_c_a,jliquid,ibin)= 0.0
3426       aer(iopcg2_f_c_a,jliquid,ibin)= 0.0
3427       aer(iopcg3_f_c_a,jliquid,ibin)= 0.0
3428       aer(iopcg4_f_c_a,jliquid,ibin)= 0.0
3429       aer(iopcg5_f_c_a,jliquid,ibin)= 0.0
3430       aer(iopcg6_f_c_a,jliquid,ibin)= 0.0
3431       aer(iopcg7_f_c_a,jliquid,ibin)= 0.0
3432       aer(iopcg8_f_c_a,jliquid,ibin)= 0.0
3433       aer(iopcg1_f_o_a,jliquid,ibin)= 0.0
3434       aer(iopcg2_f_o_a,jliquid,ibin)= 0.0
3435       aer(iopcg3_f_o_a,jliquid,ibin)= 0.0
3436       aer(iopcg4_f_o_a,jliquid,ibin)= 0.0
3437       aer(iopcg5_f_o_a,jliquid,ibin)= 0.0
3438       aer(iopcg6_f_o_a,jliquid,ibin)= 0.0
3439       aer(iopcg7_f_o_a,jliquid,ibin)= 0.0
3440       aer(iopcg8_f_o_a,jliquid,ibin)= 0.0
3441       aer(ismpa_a,jliquid,ibin)= 0.0
3442       aer(ismpbb_a,jliquid,ibin)= 0.0
3443       aer(iglysoa_r1_a,jliquid,ibin)= 0.0
3444       aer(iglysoa_r2_a,jliquid,ibin)= 0.0
3445       aer(iglysoa_sfc_a,jliquid,ibin)= 0.0
3446       aer(iglysoa_nh4_a,jliquid,ibin)= 0.0
3447       aer(iglysoa_oh_a,jliquid,ibin)= 0.0
3448       aer(iant1_c_a,jliquid,ibin)= 0.0
3449       aer(iant2_c_a,jliquid,ibin)= 0.0
3450       aer(iant3_c_a,jliquid,ibin)= 0.0
3451       aer(iant4_c_a,jliquid,ibin)= 0.0
3452       aer(iant1_o_a,jliquid,ibin)= 0.0
3453       aer(iant2_o_a,jliquid,ibin)= 0.0
3454       aer(iant3_o_a,jliquid,ibin)= 0.0
3455       aer(iant4_o_a,jliquid,ibin)= 0.0
3456       aer(ibiog1_c_a,jliquid,ibin)= 0.0
3457       aer(ibiog2_c_a,jliquid,ibin)= 0.0
3458       aer(ibiog3_c_a,jliquid,ibin)= 0.0
3459       aer(ibiog4_c_a,jliquid,ibin)= 0.0
3460       aer(ibiog1_o_a,jliquid,ibin)= 0.0
3461       aer(ibiog2_o_a,jliquid,ibin)= 0.0
3462       aer(ibiog3_o_a,jliquid,ibin)= 0.0
3463       aer(ibiog4_o_a,jliquid,ibin)= 0.0
3464       aer(iasoaX_a,jliquid,ibin)= 0.0
3465       aer(iasoa1_a,jliquid,ibin)= 0.0
3466       aer(iasoa2_a,jliquid,ibin)= 0.0
3467       aer(iasoa3_a,jliquid,ibin)= 0.0
3468       aer(iasoa4_a,jliquid,ibin)= 0.0
3469       aer(ibsoaX_a,jliquid,ibin)= 0.0
3470       aer(ibsoa1_a,jliquid,ibin)= 0.0
3471       aer(ibsoa2_a,jliquid,ibin)= 0.0
3472       aer(ibsoa3_a,jliquid,ibin)= 0.0
3473       aer(ibsoa4_a,jliquid,ibin)= 0.0
3474
3475
3476
3477
3478
3479       return
3480       end subroutine do_full_deliquescence
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503 !***********************************************************************
3504 ! mesa: multicomponent equilibrium solver for aerosol-phase
3505 ! computes equilibrum solid and liquid phases by integrating
3506 ! pseudo-transient dissolution and precipitation reactions
3507 !
3508 ! author: rahul a. zaveri
3509 ! update: jan 2005
3510 ! reference: zaveri r.a., r.c. easter, and l.k. peters, jgr, 2005b
3511 !-----------------------------------------------------------------------
3512       subroutine mesa_ptc(ibin)         ! touch
3513 !     implicit none
3514 !     include 'mosaic.h'
3515 ! subr arguments
3516       integer ibin
3517 ! local variables
3518       integer iaer, iconverge, iconverge_flux, iconverge_mass,   &
3519            idissolved, itdum, js, je, jp                        ! raz update 11/13/2008
3520       real(kind=8) tau_p(nsalt), tau_d(nsalt)
3521       real(kind=8) hsalt_min
3522       real(kind=8) phi_prod, alpha_fac, sum_dum         ! raz update 11/13/2008
3523       real(kind=8) aer_H
3524 ! function
3525 !     real(kind=8) aerosol_water
3526
3527
3528
3529 ! initialize
3530       itdum = 0         ! initialize time
3531       hsalt_max = 1.e25
3532
3533
3534
3535       do js = 1, nsalt
3536         hsalt(js)     = 0.0
3537         sat_ratio(js) = 0.0
3538         phi_salt(js)  = 0.0
3539         flux_sl(js)   = 0.0
3540       enddo
3541
3542
3543 ! calculate percent composition ! raz update 11/13/2008
3544       sum_dum = 0.0
3545       do je = 1, nelectrolyte
3546         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
3547       enddo
3548
3549       if(sum_dum .eq. 0.)sum_dum = 1.0
3550
3551       do je = 1, nelectrolyte
3552         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
3553       enddo
3554
3555
3556
3557       do js = 1, nsalt
3558         jsalt_present(js) = 0                   ! default value - salt absent
3559         if(epercent(js,jtotal,ibin) .gt. 1.0)then
3560           jsalt_present(js) = 1                 ! salt present
3561         endif
3562       enddo
3563
3564
3565       mass_dry_a(ibin) = 0.0
3566
3567       aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
3568                   aer(ino3_a,jtotal,ibin) +  &
3569                   aer(icl_a,jtotal,ibin)  +  &
3570                   aer(imsa_a,jtotal,ibin) +  &
3571                2.*aer(ico3_a,jtotal,ibin))-  &
3572               (2.*aer(ica_a,jtotal,ibin)  +  &
3573                   aer(ina_a,jtotal,ibin)  +  &
3574                   aer(inh4_a,jtotal,ibin))
3575       aer_H = max(aer_H, 0.0d0)         ! raz update 11/13/2008
3576
3577       do iaer = 1, naer
3578        mass_dry_a(ibin) = mass_dry_a(ibin) +  &
3579           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)        ! [ng/m^3(air)]
3580         vol_dry_a(ibin)  = vol_dry_a(ibin) +  &
3581           aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)     ! ncc/m^3(air)
3582       enddo
3583       mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
3584       vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
3585
3586       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! [g/cc(air)]
3587       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! [cc(aer)/cc(air)]
3588
3589       mass_dry_salt(ibin) = 0.0         ! soluble salts only
3590       do je = 1, nsalt
3591         mass_dry_salt(ibin) = mass_dry_salt(ibin) +  &
3592               electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15     ! g/cc(air)
3593       enddo
3594
3595       nmesa_call = nmesa_call + 1
3596
3597 !----begin pseudo time continuation loop-------------------------------
3598
3599       do 500 itdum = 1, nmax_mesa
3600
3601
3602 ! compute new salt fluxes
3603       call mesa_flux_salt(ibin)
3604       if (istat_mosaic_fe1 .lt. 0) return
3605
3606
3607 ! check convergence
3608       call mesa_convergence_criterion(ibin,      &
3609                                       iconverge_mass,   &
3610                                       iconverge_flux,   &
3611                                       idissolved)
3612
3613       if(iconverge_mass .eq. myes)then
3614         iter_mesa(ibin) = iter_mesa(ibin) + itdum
3615         niter_mesa = niter_mesa + itdum
3616         niter_mesa_max = max(niter_mesa_max, itdum)
3617         jaerosolstate(ibin) = all_solid
3618         call adjust_solid_aerosol(ibin)
3619         jhyst_leg(ibin) = jhyst_lo
3620         growth_factor(ibin) = 1.0
3621         return
3622       elseif(iconverge_flux .eq. myes)then
3623         iter_mesa(ibin) = iter_mesa(ibin)+ itdum
3624         niter_mesa = niter_mesa + itdum
3625         niter_mesa_max = max(niter_mesa_max, itdum)
3626         mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
3627         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3                ! cc(aer)/cc(air) or m^3/m^3(air)
3628         growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)         ! mass growth factor
3629
3630         if(idissolved .eq. myes)then
3631           jaerosolstate(ibin) = all_liquid
3632 !          jhyst_leg(ibin) = jhyst_up  ! do this later (to avoid tripping kelvin iterations)
3633         else
3634           jaerosolstate(ibin) = mixed
3635           jhyst_leg(ibin) = jhyst_lo
3636         endif
3637
3638 ! calculate epercent(jsolid) composition in mixed-phase aerosol
3639         sum_dum = 0.0
3640         jp = jsolid
3641         do je = 1, nelectrolyte
3642           electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
3643           sum_dum = sum_dum + electrolyte(je,jp,ibin)
3644         enddo
3645         electrolyte_sum(jp,ibin) = sum_dum
3646         if(sum_dum .eq. 0.)sum_dum = 1.0
3647         do je = 1, nelectrolyte
3648           epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
3649         enddo
3650
3651         return
3652       endif
3653
3654
3655 ! calculate hsalt(js)   ! time step
3656       hsalt_min = 1.e25
3657       do js = 1, nsalt
3658
3659         phi_prod = phi_salt(js) * phi_salt_old(js)
3660
3661         if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
3662           phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/   &
3663                                     alpha_salt(js)
3664         else
3665           phi_bar(js) = 0.0                     ! oscillating, or phi_salt and/or phi_salt_old may be zero
3666         endif
3667
3668         if(phi_bar(js) .lt. 0.0)then            ! good. phi getting lower. maybe able to take bigger alphas
3669           phi_bar(js) = max(phi_bar(js), -10.0D0)
3670           alpha_fac = 3.0*exp(phi_bar(js))
3671           alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9D0)
3672         elseif(phi_bar(js) .gt. 0.0)then        ! bad - phi is getting bigger. so be conservative with alpha
3673            alpha_salt(js) = min(abs(phi_salt(js)), 0.5D0)
3674         else                                    ! very bad - phi is oscillating. be very conservative
3675            alpha_salt(js) = min(abs(phi_salt(js))/3.0, 0.5D0)
3676         endif
3677
3678 !        alpha_salt(js) = max(alpha_salt(js), 0.01D0)
3679
3680         phi_salt_old(js) = phi_salt(js)         ! update old array
3681
3682
3683         if(flux_sl(js) .gt. 0.)then
3684
3685           tau_p(js) = eleliquid(js)/flux_sl(js) ! precipitation time scale
3686           if(tau_p(js) .eq. 0.0)then
3687             hsalt(js) = 1.e25
3688             flux_sl(js) = 0.0
3689             phi_salt(js)= 0.0
3690           else
3691             hsalt(js) = alpha_salt(js)*tau_p(js)
3692           endif
3693
3694         elseif(flux_sl(js) .lt. 0.)then
3695
3696           tau_p(js) = -eleliquid(js)/flux_sl(js)        ! precipitation time scale
3697           tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
3698           if(tau_p(js) .eq. 0.0)then
3699             hsalt(js) = alpha_salt(js)*tau_d(js)
3700           else
3701             hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
3702           endif
3703
3704         else
3705
3706           hsalt(js) = 1.e25
3707
3708         endif
3709
3710           hsalt_min = min(hsalt(js), hsalt_min)
3711
3712       enddo
3713
3714 !---------------------------------
3715
3716 ! integrate electrolyte(solid)
3717       do js = 1, nsalt
3718         electrolyte(js,jsolid,ibin) =    &
3719                          electrolyte(js,jsolid,ibin)  +   &
3720                          hsalt(js) * flux_sl(js)
3721       enddo
3722
3723
3724 ! compute aer(solid) from electrolyte(solid)
3725       call electrolytes_to_ions(jsolid,ibin)
3726
3727
3728 ! compute new electrolyte(liquid) from mass balance
3729       do iaer = 1, naer
3730         aer(iaer,jliquid,ibin) = aer(iaer,jtotal,ibin) -   &
3731                                        aer(iaer,jsolid,ibin)
3732       enddo
3733
3734 !---------------------------------
3735
3736
3737
3738 500   continue  ! end time continuation loop
3739 !--------------------------------------------------------------------
3740       nmesa_fail = nmesa_fail + 1
3741       iter_mesa(ibin) = iter_mesa(ibin) + itdum
3742       niter_mesa = niter_mesa + itdum
3743       jaerosolstate(ibin) = mixed
3744       jhyst_leg(ibin) = jhyst_lo
3745       mass_wet_a(ibin)    = mass_dry_a(ibin) + water_a(ibin)*1.e-3      ! g/cc(air)
3746       vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
3747       growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)           ! mass growth factor
3748
3749       return
3750       end subroutine mesa_ptc
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761 !***********************************************************************
3762 ! part of mesa: calculates solid-liquid fluxes of soluble salts
3763 !
3764 ! author: rahul a. zaveri
3765 ! update: jan 2005
3766 !-----------------------------------------------------------------------
3767       subroutine mesa_flux_salt(ibin)   ! touch
3768 !     implicit none
3769 !     include 'mosaic.h'
3770 ! subr arguments
3771       integer ibin
3772 ! local variables
3773       integer js, je                                            ! raz update 11/13/2008
3774       real(kind=8) xt, calcium, sum_salt, sum_dum       ! raz update 11/13/2008
3775
3776
3777 ! compute activities and water content
3778       call ions_to_electrolytes(jliquid,ibin,xt)
3779       if (istat_mosaic_fe1 .lt. 0) return
3780       call compute_activities(ibin)
3781       activity(jna3hso4,ibin)   = 0.0
3782
3783       if(water_a(ibin) .le. 0.0)then
3784         do js = 1, nsalt
3785          flux_sl(js) = 0.0
3786         enddo
3787         return
3788       endif
3789
3790
3791       call mesa_estimate_eleliquid(ibin,xt)
3792
3793       calcium = aer(ica_a,jliquid,ibin)
3794
3795
3796
3797 ! calculate percent composition ! raz update 11/13/2008
3798       sum_dum = 0.0
3799       do je = 1, nelectrolyte
3800         sum_dum = sum_dum + electrolyte(je,jliquid,ibin)
3801       enddo
3802
3803       if(sum_dum .eq. 0.)sum_dum = 1.0
3804
3805       do je = 1, nelectrolyte
3806         epercent(je,jliquid,ibin) = 100.*electrolyte(je,jliquid,ibin)/sum_dum
3807       enddo
3808
3809
3810
3811 ! calculate % electrolyte composition in the solid and liquid phases
3812       sum_salt = 0.0
3813       do js = 1, nsalt
3814         sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
3815       enddo
3816       electrolyte_sum(jsolid,ibin) = sum_salt
3817       if(sum_salt .eq. 0.0)sum_salt = 1.0
3818       do js = 1, nsalt
3819         frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
3820         frac_salt_liq(js)   = epercent(js,jliquid,ibin)/100.
3821       enddo
3822
3823
3824
3825 ! compute salt fluxes
3826       do js = 1, nsalt          ! soluble solid salts
3827
3828 ! compute new saturation ratio
3829         sat_ratio(js) = activity(js,ibin)/keq_sl(js)
3830 ! compute relative driving force
3831         phi_salt(js)  = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0D0)
3832
3833 ! check if too little solid-phase salt is trying to dissolve
3834         if(sat_ratio(js)       .lt. 1.00 .and.   &
3835            frac_salt_solid(js) .lt. 0.01 .and.   &
3836            frac_salt_solid(js) .gt. 0.0)then
3837           call mesa_dissolve_small_salt(ibin,js)
3838           call mesa_estimate_eleliquid(ibin,xt)
3839           sat_ratio(js) = activity(js,ibin)/keq_sl(js)
3840         endif
3841
3842 ! compute flux
3843         flux_sl(js) = sat_ratio(js) - 1.0
3844
3845 ! apply heaviside function
3846         if( (sat_ratio(js)               .lt. 1.0 .and.   &
3847              electrolyte(js,jsolid,ibin) .eq. 0.0) .or.   &
3848             (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or.   &
3849             (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
3850           flux_sl(js) = 0.0
3851           phi_salt(js)= 0.0
3852         endif
3853
3854       enddo
3855
3856
3857 ! force cacl2 and cano3 fluxes to zero
3858       sat_ratio(jcano3) = 1.0
3859       phi_salt(jcano3)  = 0.0
3860       flux_sl(jcano3)   = 0.0
3861
3862       sat_ratio(jcacl2) = 1.0
3863       phi_salt(jcacl2)  = 0.0
3864       flux_sl(jcacl2)   = 0.0
3865
3866
3867       return
3868       end subroutine mesa_flux_salt
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881 !***********************************************************************
3882 ! part of mesa: calculates liquid electrolytes from ions
3883 !
3884 ! notes:
3885 !  - this subroutine is to be used for liquid-phase or total-phase only
3886 !  - this sub transfers caso4 and caco3 from liquid to solid phase
3887 !
3888 ! author: rahul a. zaveri
3889 ! update: jan 2005
3890 !-----------------------------------------------------------------------
3891       subroutine mesa_estimate_eleliquid(ibin,xt)       ! touch
3892 !     implicit none
3893 !     include 'mosaic.h'
3894 ! subr arguments
3895       integer ibin, jp
3896       real(kind=8) xt
3897 ! local variables
3898       integer iaer, je, jc, ja, icase
3899       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
3900            f_nh4, f_na, xh, xb, xl, xs, xt_d, xna_d, xnh4_d,   &
3901            xdum, dum, cat_net
3902       real(kind=8) nc(ncation), na(nanion)
3903       real(kind=8) dum_ca, dum_no3, dum_cl, cano3, cacl2
3904
3905
3906
3907 ! remove negative concentrations, if any
3908       do iaer =  1, naer
3909       aer(iaer,jliquid,ibin) = max(0.0D0, aer(iaer,jliquid,ibin))
3910       enddo
3911
3912
3913 ! calculate sulfate ratio
3914       call calculate_xt(ibin,jliquid,xt)
3915
3916       if(xt .ge. 2.0 .or. xt.lt.0.)then
3917        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
3918       else
3919        icase = 2        ! acidic (acidity is caused by excess so4)
3920       endif
3921
3922
3923 ! initialize to zero
3924       do je = 1, nelectrolyte
3925         eleliquid(je) = 0.0
3926       enddo
3927 !
3928 !---------------------------------------------------------
3929 ! initialize moles of ions depending on the sulfate domain
3930
3931       jp = jliquid
3932
3933       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
3934
3935         dum_ca  = aer(ica_a,jp,ibin)
3936         dum_no3 = aer(ino3_a,jp,ibin)
3937         dum_cl  = aer(icl_a,jp,ibin)
3938
3939         cano3   = min(dum_ca, 0.5*dum_no3)
3940         dum_ca  = max(0.D0, dum_ca - cano3)
3941         dum_no3 = max(0.D0, dum_no3 - 2.*cano3)
3942
3943         cacl2   = min(dum_ca, 0.5*dum_cl)
3944         dum_ca  = max(0.D0, dum_ca - cacl2)
3945         dum_cl  = max(0.D0, dum_cl - 2.*cacl2)
3946
3947         na(ja_hso4)= 0.0
3948         na(ja_so4) = aer(iso4_a,jp,ibin)
3949         na(ja_no3) = aer(ino3_a,jp,ibin)
3950         na(ja_cl)  = aer(icl_a, jp,ibin)
3951         na(ja_msa) = aer(imsa_a,jp,ibin)
3952
3953         nc(jc_ca)  = aer(ica_a, jp,ibin)
3954         nc(jc_na)  = aer(ina_a, jp,ibin)
3955         nc(jc_nh4) = aer(inh4_a,jp,ibin)
3956
3957         cat_net =     &
3958             ( 2.d0*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) ) -  &
3959             ( nc(jc_h)+2.d0*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
3960
3961         if(cat_net .lt. 0.0)then
3962
3963           nc(jc_h) = 0.0
3964
3965         else  ! cat_net must be 0.0 or positive
3966
3967           nc(jc_h) = cat_net
3968
3969         endif
3970
3971
3972 ! now compute equivalent fractions
3973       sum_naza = 0.0
3974       do ja = 1, nanion
3975         sum_naza = sum_naza + na(ja)*za(ja)
3976       enddo
3977
3978       sum_nczc = 0.0
3979       do jc = 1, ncation
3980         sum_nczc = sum_nczc + nc(jc)*zc(jc)
3981       enddo
3982
3983       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
3984         if (iprint_mosaic_diag1 .gt. 0) then
3985           write(6,*)'subroutine mesa_estimate_eleliquid'
3986           write(6,*)'ionic concentrations are zero'
3987           write(6,*)'sum_naza = ', sum_naza
3988           write(6,*)'sum_nczc = ', sum_nczc
3989         endif
3990         return
3991       endif
3992
3993       do ja = 1, nanion
3994         xeq_a(ja) = na(ja)*za(ja)/sum_naza
3995       enddo
3996
3997       do jc = 1, ncation
3998         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
3999       enddo
4000
4001       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
4002       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
4003       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
4004       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
4005       na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
4006
4007       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
4008       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
4009       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
4010       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
4011
4012
4013 ! now compute electrolyte moles
4014       eleliquid(jna2so4) = (xeq_c(jc_na) *na_ma(ja_so4) +  &
4015                             xeq_a(ja_so4)*nc_mc(jc_na))/   &
4016                              mw_electrolyte(jna2so4)
4017
4018       eleliquid(jnahso4) = (xeq_c(jc_na) *na_ma(ja_hso4) +  &
4019                             xeq_a(ja_hso4)*nc_mc(jc_na))/   &
4020                              mw_electrolyte(jnahso4)
4021
4022       eleliquid(jnamsa)  = (xeq_c(jc_na) *na_ma(ja_msa) + &
4023                             xeq_a(ja_msa)*nc_mc(jc_na))/  &
4024                              mw_electrolyte(jnamsa)
4025
4026       eleliquid(jnano3)  = (xeq_c(jc_na) *na_ma(ja_no3) +  &
4027                             xeq_a(ja_no3)*nc_mc(jc_na))/   &
4028                              mw_electrolyte(jnano3)
4029
4030       eleliquid(jnacl)   = (xeq_c(jc_na) *na_ma(ja_cl) +   &
4031                             xeq_a(ja_cl) *nc_mc(jc_na))/   &
4032                              mw_electrolyte(jnacl)
4033
4034       eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_ma(ja_so4) +   &
4035                             xeq_a(ja_so4)*nc_mc(jc_nh4))/   &
4036                              mw_electrolyte(jnh4so4)
4037
4038       eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_ma(ja_hso4) +   &
4039                             xeq_a(ja_hso4)*nc_mc(jc_nh4))/   &
4040                              mw_electrolyte(jnh4hso4)
4041
4042       eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_ma(ja_msa) +  &
4043                             xeq_a(ja_msa)*nc_mc(jc_nh4))/   &
4044                              mw_electrolyte(jnh4msa)
4045
4046       eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_ma(ja_no3) +   &
4047                             xeq_a(ja_no3)*nc_mc(jc_nh4))/   &
4048                              mw_electrolyte(jnh4no3)
4049
4050       eleliquid(jnh4cl)  = (xeq_c(jc_nh4)*na_ma(ja_cl) +   &
4051                             xeq_a(ja_cl) *nc_mc(jc_nh4))/  &
4052                              mw_electrolyte(jnh4cl)
4053
4054       eleliquid(jcano3)  = (xeq_c(jc_ca) *na_ma(ja_no3) +  &
4055                             xeq_a(ja_no3)*nc_mc(jc_ca))/   &
4056                              mw_electrolyte(jcano3)
4057
4058       eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_ma(ja_msa) +  &
4059                             xeq_a(ja_msa)*nc_mc(jc_ca))/   &
4060                              mw_electrolyte(jcamsa2)
4061
4062       eleliquid(jcacl2)  = (xeq_c(jc_ca) *na_ma(ja_cl) +   &
4063                             xeq_a(ja_cl) *nc_mc(jc_ca))/   &
4064                              mw_electrolyte(jcacl2)
4065
4066       eleliquid(jh2so4)  = (xeq_c(jc_h)  *na_ma(ja_hso4) + &
4067                             xeq_a(ja_hso4)*nc_mc(jc_h))/   &
4068                              mw_electrolyte(jh2so4)
4069
4070       eleliquid(jhno3)   = (xeq_c(jc_h)  *na_ma(ja_no3) +  &
4071                             xeq_a(ja_no3)*nc_mc(jc_h))/    &
4072                              mw_electrolyte(jhno3)
4073
4074       eleliquid(jhcl)    = (xeq_c(jc_h) *na_ma(ja_cl) +   &
4075                             xeq_a(ja_cl)*nc_mc(jc_h))/    &
4076                              mw_electrolyte(jhcl)
4077
4078       eleliquid(jmsa)    = (xeq_c(jc_h)  *na_ma(ja_msa) + &
4079                             xeq_a(ja_msa)*nc_mc(jc_h))/   &
4080                              mw_electrolyte(jmsa)
4081
4082 !--------------------------------------------------------------------
4083
4084       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
4085
4086         jp = jliquid
4087
4088         store(iso4_a) = aer(iso4_a,jp,ibin)
4089         store(imsa_a) = aer(imsa_a,jp,ibin)
4090         store(inh4_a) = aer(inh4_a,jp,ibin)
4091         store(ina_a)  = aer(ina_a, jp,ibin)
4092         store(ica_a)  = aer(ica_a, jp,ibin)
4093
4094         call form_camsa2(store,jp,ibin)
4095
4096         sum_na_nh4 = store(ina_a) + store(inh4_a)
4097         if(sum_na_nh4 .gt. 0.0)then
4098           f_nh4 = store(inh4_a)/sum_na_nh4
4099           f_na  = store(ina_a)/sum_na_nh4
4100         else
4101           f_nh4 = 0.0
4102           f_na  = 0.0
4103         endif
4104
4105 ! first form msa electrolytes
4106         if(sum_na_nh4 .gt. store(imsa_a))then
4107           eleliquid(jnh4msa) = f_nh4*store(imsa_a)
4108           eleliquid(jnamsa)  = f_na *store(imsa_a)
4109           store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
4110           store(ina_a) = store(ina_a) -eleliquid(jnamsa)  ! remaining na
4111         else
4112           eleliquid(jnh4msa) = store(inh4_a)
4113           eleliquid(jnamsa)  = store(ina_a)
4114           eleliquid(jmsa)    = store(imsa_a) - sum_na_nh4
4115           store(inh4_a)= 0.0  ! remaining nh4
4116           store(ina_a) = 0.0  ! remaining na
4117         endif
4118
4119         if(store(iso4_a).eq.0.0)goto 10
4120
4121         xt_d  = xt
4122         xna_d = 1. + 0.5*aer(ina_a,jp,ibin)/aer(iso4_a,jp,ibin)
4123         xdum = aer(iso4_a,jp,ibin) - aer(inh4_a,jp,ibin)
4124
4125         dum = 2.d0*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin)
4126         if(aer(inh4_a,jp,ibin) .gt. 0.0 .and. dum .gt. 0.0)then
4127           xnh4_d = 2.*aer(inh4_a,jp,ibin)/   &
4128                   (2.*aer(iso4_a,jp,ibin) - aer(ina_a,jp,ibin))
4129         else
4130           xnh4_d = 0.0
4131         endif
4132
4133
4134         if(aer(inh4_a,jp,ibin) .gt. 0.0)then
4135
4136
4137         if(xt_d .ge. xna_d)then
4138           eleliquid(jna2so4) = 0.5*aer(ina_a,jp,ibin)
4139
4140           if(xnh4_d .ge. 5./3.)then
4141             eleliquid(jnh4so4) = 1.5*aer(ina_a,jp,ibin)   &
4142                                - 3.*xdum - aer(inh4_a,jp,ibin)
4143             eleliquid(jlvcite) = 2.*xdum + aer(inh4_a,jp,ibin)   &
4144                                - aer(ina_a,jp,ibin)
4145           elseif(xnh4_d .ge. 1.5)then
4146             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/5.
4147             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/5.
4148           elseif(xnh4_d .ge. 1.0)then
4149             eleliquid(jnh4so4) = aer(inh4_a,jp,ibin)/6.
4150             eleliquid(jlvcite) = aer(inh4_a,jp,ibin)/6.
4151             eleliquid(jnh4hso4)= aer(inh4_a,jp,ibin)/6.
4152           endif
4153
4154         elseif(xt_d .gt. 1.0)then
4155           eleliquid(jnh4so4)  = aer(inh4_a,jp,ibin)/6.
4156           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
4157           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/6.
4158           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/3.
4159           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/3.
4160         elseif(xt_d .le. 1.0)then
4161           eleliquid(jna2so4)  = aer(ina_a,jp,ibin)/4.
4162           eleliquid(jnahso4)  = aer(ina_a,jp,ibin)/2.
4163           eleliquid(jlvcite)  = aer(inh4_a,jp,ibin)/6.
4164           eleliquid(jnh4hso4) = aer(inh4_a,jp,ibin)/2.
4165         endif
4166
4167         else
4168
4169         if(xt_d .gt. 1.0)then
4170           eleliquid(jna2so4) = aer(ina_a,jp,ibin) - aer(iso4_a,jp,ibin)
4171           eleliquid(jnahso4) = 2.*aer(iso4_a,jp,ibin) -   &
4172                                   aer(ina_a,jp,ibin)
4173         else
4174           eleliquid(jna2so4) = aer(ina_a,jp,ibin)/4.
4175           eleliquid(jnahso4) = aer(ina_a,jp,ibin)/2.
4176         endif
4177
4178
4179         endif
4180
4181
4182
4183       endif
4184 !---------------------------------------------------------
4185
4186 10    return
4187       end subroutine mesa_estimate_eleliquid
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198 !***********************************************************************
4199 ! part of mesa: completely dissolves small amounts of soluble salts
4200 !
4201 ! author: rahul a. zaveri
4202 ! update: jan 2005
4203 !-----------------------------------------------------------------------
4204       subroutine mesa_dissolve_small_salt(ibin,js)
4205 !     implicit none
4206 !     include 'mosaic.h'
4207 ! subr arguments
4208       integer ibin, js, jp
4209
4210       jp = jsolid
4211
4212
4213       if(js .eq. jnh4so4)then
4214         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4215                            2.*electrolyte(js,jsolid,ibin)
4216         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4217                               electrolyte(js,jsolid,ibin)
4218
4219         electrolyte(js,jsolid,ibin) = 0.0
4220
4221         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4222                             electrolyte(jnh4cl,jp,ibin)  +   &
4223                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4224                          3.*electrolyte(jlvcite,jp,ibin) +   &
4225                             electrolyte(jnh4hso4,jp,ibin)+   &
4226                             electrolyte(jnh4msa,jp,ibin)
4227
4228         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4229                             electrolyte(jna2so4,jp,ibin) +   &
4230                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4231                             electrolyte(jnahso4,jp,ibin) +   &
4232                             electrolyte(jnh4so4,jp,ibin) +   &
4233                          2.*electrolyte(jlvcite,jp,ibin) +   &
4234                             electrolyte(jnh4hso4,jp,ibin)+   &
4235                             electrolyte(jh2so4,jp,ibin)
4236         return
4237       endif
4238
4239
4240       if(js .eq. jlvcite)then
4241         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4242                            3.*electrolyte(js,jsolid,ibin)
4243         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4244                            2.*electrolyte(js,jsolid,ibin)
4245
4246         electrolyte(js,jsolid,ibin) = 0.0
4247
4248         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4249                             electrolyte(jnh4cl,jp,ibin)  +   &
4250                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4251                          3.*electrolyte(jlvcite,jp,ibin) +   &
4252                             electrolyte(jnh4hso4,jp,ibin)+   &
4253                             electrolyte(jnh4msa,jp,ibin)
4254
4255         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4256                             electrolyte(jna2so4,jp,ibin) +   &
4257                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4258                             electrolyte(jnahso4,jp,ibin) +   &
4259                             electrolyte(jnh4so4,jp,ibin) +   &
4260                          2.*electrolyte(jlvcite,jp,ibin) +   &
4261                             electrolyte(jnh4hso4,jp,ibin)+   &
4262                             electrolyte(jh2so4,jp,ibin)
4263         return
4264       endif
4265
4266
4267       if(js .eq. jnh4hso4)then
4268         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4269                               electrolyte(js,jsolid,ibin)
4270         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4271                              electrolyte(js,jsolid,ibin)
4272
4273         electrolyte(js,jsolid,ibin) = 0.0
4274
4275         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4276                             electrolyte(jnh4cl,jp,ibin)  +   &
4277                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4278                          3.*electrolyte(jlvcite,jp,ibin) +   &
4279                             electrolyte(jnh4hso4,jp,ibin)+   &
4280                             electrolyte(jnh4msa,jp,ibin)
4281
4282         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4283                             electrolyte(jna2so4,jp,ibin) +   &
4284                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4285                             electrolyte(jnahso4,jp,ibin) +   &
4286                             electrolyte(jnh4so4,jp,ibin) +   &
4287                          2.*electrolyte(jlvcite,jp,ibin) +   &
4288                             electrolyte(jnh4hso4,jp,ibin)+   &
4289                             electrolyte(jh2so4,jp,ibin)
4290         return
4291       endif
4292
4293
4294       if(js .eq. jna2so4)then
4295         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4296                            2.*electrolyte(js,jsolid,ibin)
4297         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4298                               electrolyte(js,jsolid,ibin)
4299
4300         electrolyte(js,jsolid,ibin) = 0.0
4301
4302         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4303                             electrolyte(jnacl,jp,ibin)   +   &
4304                          2.*electrolyte(jna2so4,jp,ibin) +   &
4305                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4306                             electrolyte(jnahso4,jp,ibin) +   &
4307                             electrolyte(jnamsa,jp,ibin)
4308
4309         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4310                             electrolyte(jna2so4,jp,ibin) +   &
4311                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4312                             electrolyte(jnahso4,jp,ibin) +   &
4313                             electrolyte(jnh4so4,jp,ibin) +   &
4314                          2.*electrolyte(jlvcite,jp,ibin) +   &
4315                             electrolyte(jnh4hso4,jp,ibin)+   &
4316                             electrolyte(jh2so4,jp,ibin)
4317         return
4318       endif
4319
4320
4321       if(js .eq. jna3hso4)then
4322         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4323                            3.*electrolyte(js,jsolid,ibin)
4324         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4325                            2.*electrolyte(js,jsolid,ibin)
4326
4327         electrolyte(js,jsolid,ibin) = 0.0
4328
4329         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4330                             electrolyte(jnacl,jp,ibin)   +   &
4331                          2.*electrolyte(jna2so4,jp,ibin) +   &
4332                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4333                             electrolyte(jnahso4,jp,ibin) +   &
4334                             electrolyte(jnamsa,jp,ibin)
4335
4336         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4337                             electrolyte(jna2so4,jp,ibin) +   &
4338                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4339                             electrolyte(jnahso4,jp,ibin) +   &
4340                             electrolyte(jnh4so4,jp,ibin) +   &
4341                          2.*electrolyte(jlvcite,jp,ibin) +   &
4342                             electrolyte(jnh4hso4,jp,ibin)+   &
4343                             electrolyte(jh2so4,jp,ibin)
4344         return
4345       endif
4346
4347
4348       if(js .eq. jnahso4)then
4349         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4350                               electrolyte(js,jsolid,ibin)
4351         aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
4352                               electrolyte(js,jsolid,ibin)
4353
4354         electrolyte(js,jsolid,ibin) = 0.0
4355
4356         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4357                             electrolyte(jnacl,jp,ibin)   +   &
4358                          2.*electrolyte(jna2so4,jp,ibin) +   &
4359                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4360                             electrolyte(jnahso4,jp,ibin) +   &
4361                             electrolyte(jnamsa,jp,ibin)
4362
4363         aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
4364                             electrolyte(jna2so4,jp,ibin) +   &
4365                          2.*electrolyte(jna3hso4,jp,ibin)+   &
4366                             electrolyte(jnahso4,jp,ibin) +   &
4367                             electrolyte(jnh4so4,jp,ibin) +   &
4368                          2.*electrolyte(jlvcite,jp,ibin) +   &
4369                             electrolyte(jnh4hso4,jp,ibin)+   &
4370                             electrolyte(jh2so4,jp,ibin)
4371         return
4372       endif
4373
4374
4375       if(js .eq. jnh4no3)then
4376         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4377                               electrolyte(js,jsolid,ibin)
4378         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4379                               electrolyte(js,jsolid,ibin)
4380
4381         electrolyte(js,jsolid,ibin) = 0.0
4382
4383         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4384                             electrolyte(jnh4cl,jp,ibin)  +   &
4385                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4386                          3.*electrolyte(jlvcite,jp,ibin) +   &
4387                             electrolyte(jnh4hso4,jp,ibin)+   &
4388                             electrolyte(jnh4msa,jp,ibin)
4389
4390         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4391                          2.*electrolyte(jcano3,jp,ibin)  +   &
4392                             electrolyte(jnh4no3,jp,ibin) +   &
4393                             electrolyte(jhno3,jp,ibin)
4394         return
4395       endif
4396
4397
4398       if(js .eq. jnh4cl)then
4399         aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
4400                               electrolyte(js,jsolid,ibin)
4401         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
4402                               electrolyte(js,jsolid,ibin)
4403
4404         electrolyte(js,jsolid,ibin) = 0.0
4405
4406         aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
4407                             electrolyte(jnh4cl,jp,ibin)  +   &
4408                          2.*electrolyte(jnh4so4,jp,ibin) +   &
4409                          3.*electrolyte(jlvcite,jp,ibin) +   &
4410                             electrolyte(jnh4hso4,jp,ibin)+   &
4411                             electrolyte(jnh4msa,jp,ibin)
4412
4413         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4414                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4415                             electrolyte(jnh4cl,jp,ibin)  +   &
4416                             electrolyte(jhcl,jp,ibin)
4417         return
4418       endif
4419
4420
4421       if(js .eq. jnano3)then
4422         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4423                               electrolyte(js,jsolid,ibin)
4424         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4425                               electrolyte(js,jsolid,ibin)
4426
4427         electrolyte(js,jsolid,ibin) = 0.0
4428
4429         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4430                             electrolyte(jnacl,jp,ibin)   +   &
4431                          2.*electrolyte(jna2so4,jp,ibin) +   &
4432                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4433                             electrolyte(jnahso4,jp,ibin) +   &
4434                             electrolyte(jnamsa,jp,ibin)
4435
4436         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4437                          2.*electrolyte(jcano3,jp,ibin)  +   &
4438                             electrolyte(jnh4no3,jp,ibin) +   &
4439                             electrolyte(jhno3,jp,ibin)
4440         return
4441       endif
4442
4443
4444       if(js .eq. jnacl)then
4445         aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
4446                               electrolyte(js,jsolid,ibin)
4447         aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
4448                               electrolyte(js,jsolid,ibin)
4449
4450         electrolyte(js,jsolid,ibin) = 0.0
4451
4452         aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
4453                             electrolyte(jnacl,jp,ibin)   +   &
4454                          2.*electrolyte(jna2so4,jp,ibin) +   &
4455                          3.*electrolyte(jna3hso4,jp,ibin)+   &
4456                             electrolyte(jnahso4,jp,ibin) +   &
4457                             electrolyte(jnamsa,jp,ibin)
4458
4459         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4460                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4461                             electrolyte(jnh4cl,jp,ibin)  +   &
4462                             electrolyte(jhcl,jp,ibin)
4463         return
4464       endif
4465
4466
4467       if(js .eq. jcano3)then
4468         aer(ica_a,jliquid,ibin)  = aer(ica_a,jliquid,ibin) +   &
4469                               electrolyte(js,jsolid,ibin)
4470         aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
4471                             2.*electrolyte(js,jsolid,ibin)
4472
4473         electrolyte(js,jsolid,ibin) = 0.0
4474
4475         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
4476                             electrolyte(jcano3,jp,ibin)  +   &
4477                             electrolyte(jcacl2,jp,ibin)  +   &
4478                             electrolyte(jcaco3,jp,ibin)  +   &
4479                             electrolyte(jcamsa2,jp,ibin)
4480
4481         aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
4482                          2.*electrolyte(jcano3,jp,ibin)  +   &
4483                             electrolyte(jnh4no3,jp,ibin) +   &
4484                             electrolyte(jhno3,jp,ibin)
4485         return
4486       endif
4487
4488
4489       if(js .eq. jcacl2)then
4490         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) +   &
4491                               electrolyte(js,jsolid,ibin)
4492         aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) +   &
4493                             2.*electrolyte(js,jsolid,ibin)
4494
4495         electrolyte(js,jsolid,ibin) = 0.0
4496
4497         aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
4498                             electrolyte(jcano3,jp,ibin)  +   &
4499                             electrolyte(jcacl2,jp,ibin)  +   &
4500                             electrolyte(jcaco3,jp,ibin)  +   &
4501                             electrolyte(jcamsa2,jp,ibin)
4502
4503         aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
4504                          2.*electrolyte(jcacl2,jp,ibin)  +   &
4505                             electrolyte(jnh4cl,jp,ibin)  +   &
4506                             electrolyte(jhcl,jp,ibin)
4507         return
4508       endif
4509
4510
4511
4512       return
4513       end subroutine mesa_dissolve_small_salt
4514
4515
4516
4517
4518
4519
4520 !***********************************************************************
4521 ! part of mesa: checks mesa convergence
4522 !
4523 ! author: rahul a. zaveri
4524 ! update: jan 2005
4525 !         Oct 2009: William.Gustafson@pnl.gov - zero salt bug fixed
4526 !-----------------------------------------------------------------------
4527       subroutine mesa_convergence_criterion(ibin,  &  ! touch
4528                                        iconverge_mass,    &
4529                                        iconverge_flux,    &
4530                                        idissolved)
4531 !     implicit none
4532 !     include 'mosaic.h'
4533 ! subr arguments
4534       integer ibin, iconverge_mass, iconverge_flux, idissolved
4535 ! local variables
4536       integer je, js, iaer
4537       real(kind=8) mass_solid, mass_solid_salt, frac_solid, xt, h_ion, &
4538            crustal_solids, sumflux
4539
4540
4541       idissolved = mno          ! default = not completely dissolved
4542
4543 ! check mass convergence
4544       iconverge_mass = mno      ! default value = no convergence
4545
4546 !      call electrolytes_to_ions(jsolid,ibin)
4547 !      mass_solid = 0.0
4548 !      do iaer = 1, naer
4549 !        mass_solid = mass_solid +   &
4550 !                     aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15     ! g/cc(air)
4551 !      enddo
4552
4553       mass_solid_salt = 0.0
4554       do je = 1, nsalt
4555         mass_solid_salt = mass_solid_salt + &
4556              electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15      ! g/cc(air)
4557       enddo
4558
4559
4560
4561 !      frac_solid = mass_solid/mass_dry_a(ibin)
4562
4563 !!$      frac_solid = mass_solid_salt/mass_dry_salt(ibin)
4564 !!$
4565 !!$      if(frac_solid .ge. 0.98)then
4566 !!$        iconverge_mass = myes
4567 !!$        return
4568 !!$      endif
4569 !beg: Modified above logic to handle zero salts, wig 28-Oct-2009
4570 ! If mass of salts is zero, then this will force jaerosolstate to solid
4571 ! in mesa_ptc.
4572       if( mass_dry_salt(ibin) < 1e-30 ) then
4573          iconverge_mass = myes
4574          return
4575       else
4576          frac_solid = mass_solid_salt/mass_dry_salt(ibin)
4577          if(frac_solid .ge. 0.98)then
4578             iconverge_mass = myes
4579             return
4580          endif
4581       end if
4582 !end wig
4583
4584 ! check relative driving force convergence
4585       iconverge_flux = myes
4586       do js = 1, nsalt
4587         if(abs(phi_salt(js)).gt. rtol_mesa)then
4588           iconverge_flux = mno
4589           return
4590         endif
4591       enddo
4592
4593
4594
4595 ! check if all the fluxes are zero
4596
4597       sumflux = 0.0
4598       do js = 1, nsalt
4599         sumflux = sumflux + abs(flux_sl(js))
4600       enddo
4601
4602 ! 2017.12.03 implement xhyst_up_crustal_thresh
4603 !     crustal_solids = electrolyte(jcaco3,jsolid,ibin) +  &
4604 !                      electrolyte(jcaso4,jsolid,ibin) +  &
4605 !                      aer(ioin_a,jsolid,ibin)
4606       crustal_solids = electrolyte(jcaco3,jsolid,ibin)*mw_electrolyte(jcaco3) +  &
4607                        electrolyte(jcaso4,jsolid,ibin)*mw_electrolyte(jcaso4) +  &
4608                        aer(ioin_a,jsolid,ibin)*mw_aer_mac(ioin_a)
4609
4610 !     if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
4611       if ( sumflux .eq. 0.0 .and. &
4612            crustal_solids .le. xhyst_up_crustal_thresh*(mass_dry_a(ibin)*1.0e15) ) then
4613          ! crustal_solids is ng/m^3, mass_dry_a is g/cm^3
4614         idissolved = myes
4615       endif
4616
4617
4618
4619       return
4620       end subroutine mesa_convergence_criterion
4621
4622
4623
4624
4625
4626
4627
4628
4629 !***********************************************************************
4630 ! called when aerosol bin is completely solid.
4631 !
4632 ! author: rahul a. zaveri
4633 ! update: jan 2005
4634 !-----------------------------------------------------------------------
4635       subroutine adjust_solid_aerosol(ibin)
4636 !     implicit none
4637 !     include 'mosaic.h'
4638 ! subr arguments
4639       integer ibin
4640 ! local variables
4641       integer iaer, je
4642
4643
4644       jphase(ibin)    = jsolid
4645       jhyst_leg(ibin) = jhyst_lo        ! lower curve
4646       water_a(ibin)   = 0.0
4647
4648 ! transfer aer(jtotal) to aer(jsolid)
4649       do iaer = 1, naer
4650         aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
4651         aer(iaer, jliquid,ibin) = 0.0
4652       enddo
4653
4654 ! transfer electrolyte(jtotal) to electrolyte(jsolid)
4655       do je = 1, nelectrolyte
4656         electrolyte(je,jliquid,ibin) = 0.0
4657         epercent(je,jliquid,ibin)    = 0.0
4658         electrolyte(je,jsolid,ibin)  = electrolyte(je,jtotal,ibin)
4659         epercent(je,jsolid,ibin)     = epercent(je,jtotal,ibin)
4660       enddo
4661
4662 ! update aer(jtotal) that may have been affected above
4663       aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
4664       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
4665       aer(icl_a,jtotal,ibin)  = aer(icl_a,jsolid,ibin)
4666
4667 ! update electrolyte(jtotal)
4668       do je = 1, nelectrolyte
4669         electrolyte(je,jtotal,ibin) = electrolyte(je,jsolid,ibin)
4670         epercent(je,jtotal,ibin)    = epercent(je,jsolid,ibin)
4671       enddo
4672
4673       return
4674       end subroutine adjust_solid_aerosol
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684 !***********************************************************************
4685 ! called when aerosol bin is completely liquid.
4686 !
4687 ! author: rahul a. zaveri
4688 ! update: jan 2005
4689 !-----------------------------------------------------------------------
4690       subroutine adjust_liquid_aerosol(ibin)
4691 !     implicit none
4692 !     include 'mosaic.h'
4693 ! subr arguments
4694       integer ibin
4695 ! local variables
4696       integer je
4697
4698
4699
4700
4701       jphase(ibin)    = jliquid
4702       jhyst_leg(ibin) = jhyst_up        ! upper curve
4703
4704 ! partition all electrolytes into liquid phase
4705       do je = 1, nelectrolyte
4706         electrolyte(je,jsolid,ibin)  = 0.0
4707         epercent(je,jsolid,ibin)     = 0.0
4708         electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
4709         epercent(je,jliquid,ibin)    = epercent(je,jtotal,ibin)
4710       enddo
4711 ! except these electrolytes, which always remain in the solid phase
4712       electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
4713       electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
4714       epercent(jcaco3,jsolid,ibin)    = epercent(jcaco3,jtotal,ibin)
4715       epercent(jcaso4,jsolid,ibin)    = epercent(jcaso4,jtotal,ibin)
4716       electrolyte(jcaco3,jliquid,ibin)= 0.0
4717       electrolyte(jcaso4,jliquid,ibin)= 0.0
4718       epercent(jcaco3,jliquid,ibin)   = 0.0
4719       epercent(jcaso4,jliquid,ibin)   = 0.0
4720
4721
4722 ! partition all the aer species into
4723 ! solid phase
4724       aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
4725       aer(ino3_a,jsolid,ibin) = 0.0
4726       aer(icl_a,jsolid,ibin)  = 0.0
4727       aer(inh4_a,jsolid,ibin) = 0.0
4728       aer(ioc_a,jsolid,ibin)  = aer(ioc_a,jtotal,ibin)
4729       aer(imsa_a,jsolid,ibin) = 0.0
4730       aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
4731       aer(ina_a,jsolid,ibin)  = 0.0
4732       aer(ica_a,jsolid,ibin)  = electrolyte(jcaco3,jsolid,ibin) + &
4733                                 electrolyte(jcaso4,jsolid,ibin)
4734       aer(ibc_a,jsolid,ibin)  = aer(ibc_a,jtotal,ibin)
4735       aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
4736       aer(ipcg1_b_c_a,jsolid,ibin)= aer(ipcg1_b_c_a,jtotal,ibin)
4737       aer(ipcg2_b_c_a,jsolid,ibin)= aer(ipcg2_b_c_a,jtotal,ibin)
4738       aer(ipcg3_b_c_a,jsolid,ibin)= aer(ipcg3_b_c_a,jtotal,ibin)
4739       aer(ipcg4_b_c_a,jsolid,ibin)= aer(ipcg4_b_c_a,jtotal,ibin)
4740       aer(ipcg5_b_c_a,jsolid,ibin)= aer(ipcg5_b_c_a,jtotal,ibin)
4741       aer(ipcg6_b_c_a,jsolid,ibin)= aer(ipcg6_b_c_a,jtotal,ibin)
4742       aer(ipcg7_b_c_a,jsolid,ibin)= aer(ipcg7_b_c_a,jtotal,ibin)
4743       aer(ipcg8_b_c_a,jsolid,ibin)= aer(ipcg8_b_c_a,jtotal,ibin)
4744       aer(ipcg9_b_c_a,jsolid,ibin)= aer(ipcg9_b_c_a,jtotal,ibin)
4745       aer(ipcg1_b_o_a,jsolid,ibin)= aer(ipcg1_b_o_a,jtotal,ibin)
4746       aer(ipcg2_b_o_a,jsolid,ibin)= aer(ipcg2_b_o_a,jtotal,ibin)
4747       aer(ipcg3_b_o_a,jsolid,ibin)= aer(ipcg3_b_o_a,jtotal,ibin)
4748       aer(ipcg4_b_o_a,jsolid,ibin)= aer(ipcg4_b_o_a,jtotal,ibin)
4749       aer(ipcg5_b_o_a,jsolid,ibin)= aer(ipcg5_b_o_a,jtotal,ibin)
4750       aer(ipcg6_b_o_a,jsolid,ibin)= aer(ipcg6_b_o_a,jtotal,ibin)
4751       aer(ipcg7_b_o_a,jsolid,ibin)= aer(ipcg7_b_o_a,jtotal,ibin)
4752       aer(ipcg8_b_o_a,jsolid,ibin)= aer(ipcg8_b_o_a,jtotal,ibin)
4753       aer(ipcg9_b_o_a,jsolid,ibin)= aer(ipcg9_b_o_a,jtotal,ibin)
4754       aer(iopcg1_b_c_a,jsolid,ibin)= aer(iopcg1_b_c_a,jtotal,ibin)
4755       aer(iopcg2_b_c_a,jsolid,ibin)= aer(iopcg2_b_c_a,jtotal,ibin)
4756       aer(iopcg3_b_c_a,jsolid,ibin)= aer(iopcg3_b_c_a,jtotal,ibin)
4757       aer(iopcg4_b_c_a,jsolid,ibin)= aer(iopcg4_b_c_a,jtotal,ibin)
4758       aer(iopcg5_b_c_a,jsolid,ibin)= aer(iopcg5_b_c_a,jtotal,ibin)
4759       aer(iopcg6_b_c_a,jsolid,ibin)= aer(iopcg6_b_c_a,jtotal,ibin)
4760       aer(iopcg7_b_c_a,jsolid,ibin)= aer(iopcg7_b_c_a,jtotal,ibin)
4761       aer(iopcg8_b_c_a,jsolid,ibin)= aer(iopcg8_b_c_a,jtotal,ibin)
4762       aer(iopcg1_b_o_a,jsolid,ibin)= aer(iopcg1_b_o_a,jtotal,ibin)
4763       aer(iopcg2_b_o_a,jsolid,ibin)= aer(iopcg2_b_o_a,jtotal,ibin)
4764       aer(iopcg3_b_o_a,jsolid,ibin)= aer(iopcg3_b_o_a,jtotal,ibin)
4765       aer(iopcg4_b_o_a,jsolid,ibin)= aer(iopcg4_b_o_a,jtotal,ibin)
4766       aer(iopcg5_b_o_a,jsolid,ibin)= aer(iopcg5_b_o_a,jtotal,ibin)
4767       aer(iopcg6_b_o_a,jsolid,ibin)= aer(iopcg6_b_o_a,jtotal,ibin)
4768       aer(iopcg7_b_o_a,jsolid,ibin)= aer(iopcg7_b_o_a,jtotal,ibin)
4769       aer(iopcg8_b_o_a,jsolid,ibin)= aer(iopcg8_b_o_a,jtotal,ibin)
4770       aer(ipcg1_f_c_a,jsolid,ibin)= aer(ipcg1_f_c_a,jtotal,ibin)
4771       aer(ipcg2_f_c_a,jsolid,ibin)= aer(ipcg2_f_c_a,jtotal,ibin)
4772       aer(ipcg3_f_c_a,jsolid,ibin)= aer(ipcg3_f_c_a,jtotal,ibin)
4773       aer(ipcg4_f_c_a,jsolid,ibin)= aer(ipcg4_f_c_a,jtotal,ibin)
4774       aer(ipcg5_f_c_a,jsolid,ibin)= aer(ipcg5_f_c_a,jtotal,ibin)
4775       aer(ipcg6_f_c_a,jsolid,ibin)= aer(ipcg6_f_c_a,jtotal,ibin)
4776       aer(ipcg7_f_c_a,jsolid,ibin)= aer(ipcg7_f_c_a,jtotal,ibin)
4777       aer(ipcg8_f_c_a,jsolid,ibin)= aer(ipcg8_f_c_a,jtotal,ibin)
4778       aer(ipcg9_f_c_a,jsolid,ibin)= aer(ipcg9_f_c_a,jtotal,ibin)
4779       aer(ipcg1_f_o_a,jsolid,ibin)= aer(ipcg1_f_o_a,jtotal,ibin)
4780       aer(ipcg2_f_o_a,jsolid,ibin)= aer(ipcg2_f_o_a,jtotal,ibin)
4781       aer(ipcg3_f_o_a,jsolid,ibin)= aer(ipcg3_f_o_a,jtotal,ibin)
4782       aer(ipcg4_f_o_a,jsolid,ibin)= aer(ipcg4_f_o_a,jtotal,ibin)
4783       aer(ipcg5_f_o_a,jsolid,ibin)= aer(ipcg5_f_o_a,jtotal,ibin)
4784       aer(ipcg6_f_o_a,jsolid,ibin)= aer(ipcg6_f_o_a,jtotal,ibin)
4785       aer(ipcg7_f_o_a,jsolid,ibin)= aer(ipcg7_f_o_a,jtotal,ibin)
4786       aer(ipcg8_f_o_a,jsolid,ibin)= aer(ipcg8_f_o_a,jtotal,ibin)
4787       aer(ipcg9_f_o_a,jsolid,ibin)= aer(ipcg9_f_o_a,jtotal,ibin)
4788       aer(iopcg1_f_c_a,jsolid,ibin)= aer(iopcg1_f_c_a,jtotal,ibin)
4789       aer(iopcg2_f_c_a,jsolid,ibin)= aer(iopcg2_f_c_a,jtotal,ibin)
4790       aer(iopcg3_f_c_a,jsolid,ibin)= aer(iopcg3_f_c_a,jtotal,ibin)
4791       aer(iopcg4_f_c_a,jsolid,ibin)= aer(iopcg4_f_c_a,jtotal,ibin)
4792       aer(iopcg5_f_c_a,jsolid,ibin)= aer(iopcg5_f_c_a,jtotal,ibin)
4793       aer(iopcg6_f_c_a,jsolid,ibin)= aer(iopcg6_f_c_a,jtotal,ibin)
4794       aer(iopcg7_f_c_a,jsolid,ibin)= aer(iopcg7_f_c_a,jtotal,ibin)
4795       aer(iopcg8_f_c_a,jsolid,ibin)= aer(iopcg8_f_c_a,jtotal,ibin)
4796       aer(iopcg1_f_o_a,jsolid,ibin)= aer(iopcg1_f_o_a,jtotal,ibin)
4797       aer(iopcg2_f_o_a,jsolid,ibin)= aer(iopcg2_f_o_a,jtotal,ibin)
4798       aer(iopcg3_f_o_a,jsolid,ibin)= aer(iopcg3_f_o_a,jtotal,ibin)
4799       aer(iopcg4_f_o_a,jsolid,ibin)= aer(iopcg4_f_o_a,jtotal,ibin)
4800       aer(iopcg5_f_o_a,jsolid,ibin)= aer(iopcg5_f_o_a,jtotal,ibin)
4801       aer(iopcg6_f_o_a,jsolid,ibin)= aer(iopcg6_f_o_a,jtotal,ibin)
4802       aer(iopcg7_f_o_a,jsolid,ibin)= aer(iopcg7_f_o_a,jtotal,ibin)
4803       aer(iopcg8_f_o_a,jsolid,ibin)= aer(iopcg8_f_o_a,jtotal,ibin)
4804       aer(ismpa_a,jsolid,ibin)= aer(ismpa_a,jtotal,ibin)
4805       aer(ismpbb_a,jsolid,ibin)= aer(ismpbb_a,jtotal,ibin)
4806       aer(iglysoa_r1_a,jsolid,ibin)= aer(iglysoa_r1_a,jtotal,ibin)
4807       aer(iglysoa_r2_a,jsolid,ibin)= aer(iglysoa_r2_a,jtotal,ibin)
4808       aer(iglysoa_sfc_a,jsolid,ibin)= aer(iglysoa_sfc_a,jtotal,ibin)
4809       aer(iglysoa_nh4_a,jsolid,ibin)= aer(iglysoa_nh4_a,jtotal,ibin)
4810       aer(iglysoa_oh_a,jsolid,ibin)= aer(iglysoa_oh_a,jtotal,ibin)
4811       aer(iant1_c_a,jsolid,ibin)= aer(iant1_c_a,jtotal,ibin)
4812       aer(iant2_c_a,jsolid,ibin)= aer(iant2_c_a,jtotal,ibin)
4813       aer(iant3_c_a,jsolid,ibin)= aer(iant3_c_a,jtotal,ibin)
4814       aer(iant4_c_a,jsolid,ibin)= aer(iant4_c_a,jtotal,ibin)
4815       aer(iant1_o_a,jsolid,ibin)= aer(iant1_o_a,jtotal,ibin)
4816       aer(iant2_o_a,jsolid,ibin)= aer(iant2_o_a,jtotal,ibin)
4817       aer(iant3_o_a,jsolid,ibin)= aer(iant3_o_a,jtotal,ibin)
4818       aer(iant4_o_a,jsolid,ibin)= aer(iant4_o_a,jtotal,ibin)
4819       aer(ibiog1_c_a,jsolid,ibin)= aer(ibiog1_c_a,jtotal,ibin)
4820       aer(ibiog2_c_a,jsolid,ibin)= aer(ibiog2_c_a,jtotal,ibin)
4821       aer(ibiog3_c_a,jsolid,ibin)= aer(ibiog3_c_a,jtotal,ibin)
4822       aer(ibiog4_c_a,jsolid,ibin)= aer(ibiog4_c_a,jtotal,ibin)
4823       aer(ibiog1_o_a,jsolid,ibin)= aer(ibiog1_o_a,jtotal,ibin)
4824       aer(ibiog2_o_a,jsolid,ibin)= aer(ibiog2_o_a,jtotal,ibin)
4825       aer(ibiog3_o_a,jsolid,ibin)= aer(ibiog3_o_a,jtotal,ibin)
4826       aer(ibiog4_o_a,jsolid,ibin)= aer(ibiog4_o_a,jtotal,ibin)
4827       aer(iasoaX_a,jsolid,ibin)= aer(iasoaX_a,jtotal,ibin)
4828       aer(iasoa1_a,jsolid,ibin)= aer(iasoa1_a,jtotal,ibin)
4829       aer(iasoa2_a,jsolid,ibin)= aer(iasoa2_a,jtotal,ibin)
4830       aer(iasoa3_a,jsolid,ibin)= aer(iasoa3_a,jtotal,ibin)
4831       aer(iasoa4_a,jsolid,ibin)= aer(iasoa4_a,jtotal,ibin)
4832       aer(ibsoaX_a,jsolid,ibin)= aer(ibsoaX_a,jtotal,ibin)
4833       aer(ibsoa1_a,jsolid,ibin)= aer(ibsoa1_a,jtotal,ibin)
4834       aer(ibsoa2_a,jsolid,ibin)= aer(ibsoa2_a,jtotal,ibin)
4835       aer(ibsoa3_a,jsolid,ibin)= aer(ibsoa3_a,jtotal,ibin)
4836       aer(ibsoa4_a,jsolid,ibin)= aer(ibsoa4_a,jtotal,ibin)
4837
4838
4839
4840
4841 ! liquid-phase
4842       aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) - &
4843                                  aer(iso4_a,jsolid,ibin)
4844       aer(iso4_a,jliquid,ibin) = max(0.D0, aer(iso4_a,jliquid,ibin))
4845       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
4846       aer(icl_a,jliquid,ibin)  = aer(icl_a,jtotal,ibin)
4847       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
4848       aer(ioc_a,jliquid,ibin)  = 0.0
4849       aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
4850       aer(ico3_a,jliquid,ibin) = 0.0
4851       aer(ina_a,jliquid,ibin)  = aer(ina_a,jtotal,ibin)
4852       aer(ica_a,jliquid,ibin)  = aer(ica_a,jtotal,ibin) - &
4853                                  aer(ica_a,jsolid,ibin)
4854       aer(ica_a,jliquid,ibin)  = max(0.D0, aer(ica_a,jliquid,ibin))
4855       aer(ibc_a,jliquid,ibin)  = 0.0
4856       aer(ioin_a,jliquid,ibin) = 0.0
4857       aer(ipcg1_b_c_a,jliquid,ibin)= 0.0
4858       aer(ipcg2_b_c_a,jliquid,ibin)= 0.0
4859       aer(ipcg3_b_c_a,jliquid,ibin)= 0.0
4860       aer(ipcg4_b_c_a,jliquid,ibin)= 0.0
4861       aer(ipcg5_b_c_a,jliquid,ibin)= 0.0
4862       aer(ipcg6_b_c_a,jliquid,ibin)= 0.0
4863       aer(ipcg7_b_c_a,jliquid,ibin)= 0.0
4864       aer(ipcg8_b_c_a,jliquid,ibin)= 0.0
4865       aer(ipcg9_b_c_a,jliquid,ibin)= 0.0
4866       aer(ipcg1_b_o_a,jliquid,ibin)= 0.0
4867       aer(ipcg2_b_o_a,jliquid,ibin)= 0.0
4868       aer(ipcg3_b_o_a,jliquid,ibin)= 0.0
4869       aer(ipcg4_b_o_a,jliquid,ibin)= 0.0
4870       aer(ipcg5_b_o_a,jliquid,ibin)= 0.0
4871       aer(ipcg6_b_o_a,jliquid,ibin)= 0.0
4872       aer(ipcg7_b_o_a,jliquid,ibin)= 0.0
4873       aer(ipcg8_b_o_a,jliquid,ibin)= 0.0
4874       aer(ipcg9_b_o_a,jliquid,ibin)= 0.0
4875       aer(iopcg1_b_c_a,jliquid,ibin)= 0.0
4876       aer(iopcg2_b_c_a,jliquid,ibin)= 0.0
4877       aer(iopcg3_b_c_a,jliquid,ibin)= 0.0
4878       aer(iopcg4_b_c_a,jliquid,ibin)= 0.0
4879       aer(iopcg5_b_c_a,jliquid,ibin)= 0.0
4880       aer(iopcg6_b_c_a,jliquid,ibin)= 0.0
4881       aer(iopcg7_b_c_a,jliquid,ibin)= 0.0
4882       aer(iopcg8_b_c_a,jliquid,ibin)= 0.0
4883       aer(iopcg1_b_o_a,jliquid,ibin)= 0.0
4884       aer(iopcg2_b_o_a,jliquid,ibin)= 0.0
4885       aer(iopcg3_b_o_a,jliquid,ibin)= 0.0
4886       aer(iopcg4_b_o_a,jliquid,ibin)= 0.0
4887       aer(iopcg5_b_o_a,jliquid,ibin)= 0.0
4888       aer(iopcg6_b_o_a,jliquid,ibin)= 0.0
4889       aer(iopcg7_b_o_a,jliquid,ibin)= 0.0
4890       aer(iopcg8_b_o_a,jliquid,ibin)= 0.0
4891       aer(ipcg1_f_c_a,jliquid,ibin)= 0.0
4892       aer(ipcg2_f_c_a,jliquid,ibin)= 0.0
4893       aer(ipcg3_f_c_a,jliquid,ibin)= 0.0
4894       aer(ipcg4_f_c_a,jliquid,ibin)= 0.0
4895       aer(ipcg5_f_c_a,jliquid,ibin)= 0.0
4896       aer(ipcg6_f_c_a,jliquid,ibin)= 0.0
4897       aer(ipcg7_f_c_a,jliquid,ibin)= 0.0
4898       aer(ipcg8_f_c_a,jliquid,ibin)= 0.0
4899       aer(ipcg9_f_c_a,jliquid,ibin)= 0.0
4900       aer(ipcg1_f_o_a,jliquid,ibin)= 0.0
4901       aer(ipcg2_f_o_a,jliquid,ibin)= 0.0
4902       aer(ipcg3_f_o_a,jliquid,ibin)= 0.0
4903       aer(ipcg4_f_o_a,jliquid,ibin)= 0.0
4904       aer(ipcg5_f_o_a,jliquid,ibin)= 0.0
4905       aer(ipcg6_f_o_a,jliquid,ibin)= 0.0
4906       aer(ipcg7_f_o_a,jliquid,ibin)= 0.0
4907       aer(ipcg8_f_o_a,jliquid,ibin)= 0.0
4908       aer(ipcg9_f_o_a,jliquid,ibin)= 0.0
4909       aer(iopcg1_f_c_a,jliquid,ibin)= 0.0
4910       aer(iopcg2_f_c_a,jliquid,ibin)= 0.0
4911       aer(iopcg3_f_c_a,jliquid,ibin)= 0.0
4912       aer(iopcg4_f_c_a,jliquid,ibin)= 0.0
4913       aer(iopcg5_f_c_a,jliquid,ibin)= 0.0
4914       aer(iopcg6_f_c_a,jliquid,ibin)= 0.0
4915       aer(iopcg7_f_c_a,jliquid,ibin)= 0.0
4916       aer(iopcg8_f_c_a,jliquid,ibin)= 0.0
4917       aer(iopcg1_f_o_a,jliquid,ibin)= 0.0
4918       aer(iopcg2_f_o_a,jliquid,ibin)= 0.0
4919       aer(iopcg3_f_o_a,jliquid,ibin)= 0.0
4920       aer(iopcg4_f_o_a,jliquid,ibin)= 0.0
4921       aer(iopcg5_f_o_a,jliquid,ibin)= 0.0
4922       aer(iopcg6_f_o_a,jliquid,ibin)= 0.0
4923       aer(iopcg7_f_o_a,jliquid,ibin)= 0.0
4924       aer(iopcg8_f_o_a,jliquid,ibin)= 0.0
4925       aer(ismpa_a,jliquid,ibin)= 0.0
4926       aer(ismpbb_a,jliquid,ibin)= 0.0
4927       aer(iglysoa_r1_a,jliquid,ibin)= 0.0
4928       aer(iglysoa_r2_a,jliquid,ibin)= 0.0
4929       aer(iglysoa_sfc_a,jliquid,ibin)= 0.0
4930       aer(iglysoa_nh4_a,jliquid,ibin)= 0.0
4931       aer(iglysoa_oh_a,jliquid,ibin)= 0.0
4932       aer(iant1_c_a,jliquid,ibin)= 0.0
4933       aer(iant2_c_a,jliquid,ibin)= 0.0
4934       aer(iant3_c_a,jliquid,ibin)= 0.0
4935       aer(iant4_c_a,jliquid,ibin)= 0.0
4936       aer(iant1_o_a,jliquid,ibin)= 0.0
4937       aer(iant2_o_a,jliquid,ibin)= 0.0
4938       aer(iant3_o_a,jliquid,ibin)= 0.0
4939       aer(iant4_o_a,jliquid,ibin)= 0.0
4940       aer(ibiog1_c_a,jliquid,ibin)= 0.0
4941       aer(ibiog2_c_a,jliquid,ibin)= 0.0
4942       aer(ibiog3_c_a,jliquid,ibin)= 0.0
4943       aer(ibiog4_c_a,jliquid,ibin)= 0.0
4944       aer(ibiog1_o_a,jliquid,ibin)= 0.0
4945       aer(ibiog2_o_a,jliquid,ibin)= 0.0
4946       aer(ibiog3_o_a,jliquid,ibin)= 0.0
4947       aer(ibiog4_o_a,jliquid,ibin)= 0.0
4948       aer(iasoaX_a,jliquid,ibin)= 0.0
4949       aer(iasoa1_a,jliquid,ibin)= 0.0
4950       aer(iasoa2_a,jliquid,ibin)= 0.0
4951       aer(iasoa3_a,jliquid,ibin)= 0.0
4952       aer(iasoa4_a,jliquid,ibin)= 0.0
4953       aer(ibsoaX_a,jliquid,ibin)= 0.0
4954       aer(ibsoa1_a,jliquid,ibin)= 0.0
4955       aer(ibsoa2_a,jliquid,ibin)= 0.0
4956       aer(ibsoa3_a,jliquid,ibin)= 0.0
4957       aer(ibsoa4_a,jliquid,ibin)= 0.0
4958
4959
4960
4961
4962
4963       return
4964       end subroutine adjust_liquid_aerosol
4965
4966
4967
4968
4969
4970
4971
4972 ! end of mesa package
4973 !=======================================================================
4974
4975
4976
4977
4978
4979
4980
4981
4982 !***********************************************************************
4983 ! ASTEM: Adaptive Step Time-Split Euler Method
4984 !
4985 ! author: Rahul A. Zaveri
4986 ! update: jan 2007
4987 !-----------------------------------------------------------------------
4988       subroutine ASTEM(dtchem,vbs_nbin)
4989
4990       USE module_mosaic_gly, only : glysoa_complex, glysoa_simple
4991
4992 !      implicit none
4993 !      include 'chemistry.com'
4994 !      include 'mosaic.h'
4995 ! subr arguments
4996       real(kind=8) dtchem
4997 ! local variables
4998       integer ibin
4999       real(kind=8) dumdum
5000       integer vbs_nbin(1)
5001       integer start_svoc, Nsoa
5002 !      logical first
5003 !      save first
5004 !      data first/.true./
5005
5006       integer, save :: iclm_debug, jclm_debug, kclm_debug, ncnt_debug
5007       data iclm_debug /25/
5008       data jclm_debug /1/
5009       data kclm_debug /9/
5010       data ncnt_debug /2/
5011
5012
5013
5014       if(iclm_aer .eq. iclm_debug .and.   &
5015          jclm_aer .eq. jclm_debug .and.   &
5016          kclm_aer .eq. kclm_debug  .and.   &
5017          ncorecnt_aer .eq. ncnt_debug)then
5018         dumdum = 0.0
5019       endif
5020
5021
5022
5023 ! update ASTEM call counter
5024       nASTEM_call  = nASTEM_call + 1
5025
5026 ! reset input print flag
5027       iprint_input = mYES
5028
5029
5030
5031
5032 ! compute aerosol phase state before starting integration
5033       do ibin = 1, nbin_a
5034         if(jaerosolstate(ibin) .ne. no_aerosol)then
5035           call aerosol_phase_state(ibin)
5036           if (istat_mosaic_fe1 .lt. 0) return
5037           call calc_dry_n_wet_aerosol_props(ibin)
5038         endif
5039 !      endif ! added by Manish Shrivastav 12/7/09
5040       enddo
5041
5042
5043 !      if(first)then
5044 !        first=.false.
5045 !        call print_aer(0)              ! BOX
5046 !      endif
5047
5048
5049 ! compute new gas-aerosol mass transfer coefficients
5050       call aerosolmtc(vbs_nbin)
5051       if (istat_mosaic_fe1 .lt. 0) return
5052
5053 ! condense h2so4, msa, and nh3 only
5054       call ASTEM_non_volatiles(dtchem)  ! analytical solution
5055       if (istat_mosaic_fe1 .lt. 0) return
5056
5057 ! DL - 20/11/2012 - recalculate the mass balance to take account of
5058 !                   NO3- and Cl- changes from N2O5 het reactions
5059           call overall_massbal_in ! save input mass over all bins
5060
5061
5062 ! condense inorganic semi-volatile gases hno3, hcl, nh3, and co2
5063       call ASTEM_semi_volatiles(dtchem) ! semi-implicit + explicit euler
5064       if (istat_mosaic_fe1 .lt. 0) return
5065
5066       if (glysoa_param == glysoa_param_simple)  call glysoa_simple(dtchem)
5067       if (glysoa_param == glysoa_param_complex) call glysoa_complex(dtchem)
5068
5069 ! condense secondary organic gases (8 sorgam species)
5070       if (istat_mosaic_fe1 .lt. 0) return
5071
5072       start_svoc = 1
5073       Nsoa       = 0
5074       ! simple version, Hodzic and Jimenez, GMD, 2011
5075       if (vbs_nbin(1).eq.0) then
5076         start_svoc = ismpa_g
5077       ! 4-bin version, Knote et al., ACPD, 2014
5078       else if (vbs_nbin(1).eq.4) then
5079         start_svoc = iasoaX_g
5080       ! 9-bin version
5081       else
5082         start_svoc = ipcg1_b_c_g
5083 !        Nsoa = ngas_volatile-start_svoc
5084       end if
5085       Nsoa       = ngas_ioa + ngas_soa - start_svoc + 1
5086
5087       call equilibrium(start_svoc,Nsoa)
5088
5089 !!BSINGH (PNNL)- Following 3 lines are commented due to array out of bound error in equilibrium_smp
5090 !      !if (vbs_nbin.eq.0) then
5091 !      !call equilibrium_smp
5092 !      !else
5093 !      call equilibrium
5094 !      !Bend if
5095 !
5096
5097 ! template for error status checking
5098 !        if (iprint_mosaic_fe1 .gt. 0) then
5099 !          write(6,*)'error in computing dtmax for soa'
5100 !          write(6,*)'mosaic fatal error in astem_soa_dtmax'
5101 !       stop
5102 !       endif
5103 !        istat_mosaic_fe1 = -1800
5104 !        return
5105 !      endif
5106
5107       return
5108       end subroutine astem
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118       subroutine print_mosaic_stats( iflag1 )
5119 !     implicit none
5120 !     include 'mosaic.h'
5121 ! subr arguments
5122       integer iflag1
5123 ! local variables
5124       integer ibin
5125       real(kind=8) p_mesa_fails, p_astem_fails, dumcnt
5126
5127
5128       if (iflag1 .le. 0) goto 2000
5129
5130 ! print mesa and astem statistics
5131
5132       dumcnt = float(max(nmesa_call,1))
5133       p_mesa_fails  = 100.*float(nmesa_fail)/dumcnt
5134       niter_mesa_avg = float(niter_mesa)/dumcnt
5135
5136       dumcnt = float(max(nastem_call,1))
5137       p_astem_fails = 100.*float(nastem_fail)/dumcnt
5138       nsteps_astem_avg = float(nsteps_astem)/dumcnt
5139
5140
5141       if (iprint_mosaic_perform_stats .gt. 0) then
5142         write(6,*)'------------------------------------------------'
5143         write(6,*)'     astem performance statistics'
5144         write(6,*)'number of astem calls=', nastem_call
5145         write(6,*)'percent astem fails  =', nastem_fail
5146         write(6,*)'avg steps per dtchem =', nsteps_astem_avg
5147         write(6,*)'max steps per dtchem =', nsteps_astem_max
5148         write(6,*)'  '
5149         write(6,*)'     mesa performance statistics'
5150         write(6,*)'number of mesa calls =', nmesa_call
5151         write(6,*)'total mesa fails     =', nmesa_fail
5152         write(6,*)'percent mesa fails   =', p_mesa_fails
5153         write(6,*)'avg iterations/call  =', niter_mesa_avg
5154         write(6,*)'max iterations/call  =', niter_mesa_max
5155         write(6,*)'  '
5156       endif
5157
5158       if (iprint_mosaic_fe1 .gt. 0) then
5159          if ((nfe1_mosaic_cur .gt. 0) .or.   &
5160              (iprint_mosaic_fe1 .ge. 100)) then
5161             write(6,*)'-----------------------------------------'
5162             write(6,*)'mosaic failure count (current step) =',   &
5163                nfe1_mosaic_cur
5164             write(6,*)'mosaic failure count (all step tot) =',   &
5165                nfe1_mosaic_tot
5166             write(6,*)'  '
5167          endif
5168       endif
5169
5170       if (nfe1_mosaic_tot .gt. 9999) then
5171          write(6,'(a)') "MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!"
5172          call peg_error_fatal( lunerr_aer, &
5173               "---> MOSAIC FAILURE COUNT > 9999 -- SOMETHING IS SERIOUSLY WRONG !!!" )
5174       endif
5175
5176 2000  continue
5177
5178 ! reset counters
5179       nfe1_mosaic_cur = 0
5180
5181       nmesa_call   = 0
5182       nmesa_fail   = 0
5183       niter_mesa   = 0.0
5184       niter_mesa_max = 0
5185
5186       nastem_call = 0
5187       nastem_fail = 0
5188
5189       nsteps_astem = 0.0
5190       nsteps_astem_max = 0.0
5191
5192
5193       return
5194       end subroutine print_mosaic_stats
5195
5196
5197
5198
5199
5200 ! Calculates the equilibrium gas-particle partitioning for SOA species
5201         subroutine  equilibrium(start_ind,N)
5202 !        subroutine  equilibrium
5203 ! This routine was implemented by Manish Shrivastava on 12/24/2009 to do gas-particle partitioning of SOA assuming thermodynamic equilibrium.
5204 ! 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)
5205 ! This would give MOSAIC cpabilities of running both dynamic and equilibrium gas-particle partitioning
5206 ! Calls the subroutine soap. Subroutine soap calls subroutine spfcn
5207 !        use module_data_mosaic_main
5208 !        use module_data_mosaic_aero
5209
5210         implicit none
5211         real(kind=8), parameter :: tinys=1.0d-15
5212         integer, intent(in) :: start_ind, N
5213 !        integer, parameter :: N=ngas_soa !Total number of soa species
5214         integer, parameter :: itermax=2000
5215         integer idxfresh(N),idxaged(N)   !counter for fresh and aged soa species
5216         real(kind=8) :: dq,frqfresh(nbin_a),frqaged(nbin_a)
5217         real(kind=8) :: frqtotfresh,frqtotaged,frt
5218         real(kind=8) :: xsumfresh(nbin_a),xsumaged(nbin_a)
5219         real(kind=8) :: mnkfresh,mxkfresh,mnkaged,mxkaged
5220         real betak
5221 !        integer :: flagsoap(N) ! flagsoap determines if the species 'i' is fresh (flagsoap(i)=2) or aged(flagsoap(i)=1
5222         real(kind=8) ::  Csatfresh(N), Ctotfresh(N)
5223         real(kind=8) ::  Cgasfresh(N),Caerfresh(N) ! Csat: Saturation conc., Ctot: Total organic mass
5224 !       in gas+aerosol phase, Cgas:gas phase, Caer: Particle
5225         real(kind=8) ::    Csataged(N), Ctotaged(N)
5226         real(kind=8) ::  Cgasaged(N),Caeraged(N)
5227         integer nsolfresh,nsolaged,ntrack,icontfresh,icontaged ! counters corresponding to fresh and aged species for mapping
5228         real(kind=8) :: cpxfresh,cpxaged !Moles of pre-existing fresh and aged particle phase organic mass
5229         integer ibin,iter ! Bin nos.
5230 ! local variables
5231         integer iv, jp
5232          real(kind=8) :: dum, sum_dum, sum_soa, small_oc
5233
5234 !        real, parameter :: tolmin = 1.E-12^M
5235 !        real, parameter :: conmin = 1.E-20^M
5236 !        real totOA,minitw !total OA in particle phase^M
5237         real(kind=8) :: cpx !pre-existing OA umol/m3^M
5238         real(kind=8) :: Ctot(N),Caer(N),Cgas(N),Csat(N)
5239         real(kind=8) :: Paer(ngas_volatile)
5240         integer :: i
5241 !       LOGICAL check
5242         jp=jtotal
5243         iter=0
5244          cpxaged=0.0
5245         cpxfresh=0.0 ! Assume no pres-existing OA forms a solution
5246         nsolfresh=0
5247          nsolaged=0
5248          icontfresh=0
5249          icontaged=0
5250          dq=0.0
5251 ! Paer holds the organic aerosol values in each volatility bin (sum of all size bins)
5252           do iv=1,ngas_volatile
5253            Paer(iv)=0.0
5254           enddo
5255 ! Initialize flagsoap
5256           do i=1,N
5257              flagsoap(i)=1
5258              Ctot(i) = 0.0
5259              Ctotaged(i) = 0.0
5260              Ctotfresh(i) = 0.0
5261              Caer(i) = 0.0
5262              Caeraged(i) = 0.0
5263              Caerfresh(i) = 0.0
5264              Cgas(i) = 0.0
5265              Cgasaged(i) = 0.0
5266              Cgasfresh(i) = 0.0
5267              Csat(i) = 0.0
5268              Csataged(i) = 0.0
5269              Csatfresh(i) = 0.0
5270           enddo
5271 ! Calculate Ctot and Paer
5272 !              do iv = ipcg1_b_c_g, ngas_volatile
5273 !              do iv = start_ind, ngas_ioa + ngas_soa
5274               do iv = start_ind, (start_ind + N - 1)
5275         total_species(iv) = gas(iv)
5276         do ibin = 1, nbin_a
5277           total_species(iv) = total_species(iv) + aer(iv,jtotal,ibin)
5278            Paer(iv)=Paer(iv)+aer(iv,jtotal,ibin)
5279         enddo
5280       enddo
5281 ! Calculate pre-existing moles of OA (cpx) as sum of all size bins
5282         do ibin=1,nbin_a
5283         cpxaged= cpxaged+aer(ioc_a,jp,ibin)
5284          enddo
5285
5286 !  Maps arrays starting from start_ind or ipcg1_b_c_g on to corresponding arrays starting from 1 for just soa species
5287         do i=1,N
5288            Ctot(i)=total_species(start_ind+i-1)
5289            Caer(i)=Paer(start_ind+i-1)
5290            Csat(i)=sat_soa(start_ind+i-1)
5291            Cgas(i)=gas(start_ind+i-1)
5292          enddo
5293
5294 ! Initialize mapping array indices
5295           do i=1,N
5296             idxfresh(i)=0
5297             idxaged(i)=0
5298           enddo
5299 !     Seperate the fresh and aged species and treat them as 2 different solutions. Note this approach differes from PMCAMx
5300 !     In PMCAMx if flagsoap(i) was set to zero those species were not considered solution forming.
5301
5302          do i=1,N
5303             flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5304          enddo
5305
5306
5307 !         do i=1,9
5308 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5309 !          enddo
5310 !         do i=10,18
5311 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5312 !          enddo
5313 !        do i=19,26
5314 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5315 !          enddo
5316 !        do i=27,34
5317 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5318 !          enddo
5319 !        do i=35,43
5320 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5321 !          enddo
5322 !         do i=44,52
5323 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5324 !          enddo
5325 !        do i=53,60
5326 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5327 !          enddo
5328 !      do i=61,68
5329 !            flagsoap(i)=1 ! Biomass burning(carbon and oxygen species) +traditional soa species
5330 !          enddo
5331 !        do i=69,84
5332 !            flagsoap(i)=1 !Oxidized fossil oxygen
5333 !        enddo
5334
5335       do i=1,N
5336          if (flagsoap(i).eq.2) then ! fresh primary species forming 1 solution
5337            icontfresh=icontfresh+1  ! count the number of fresh species
5338             idxfresh(icontfresh) = i  !Map the species
5339             Csatfresh(icontfresh)=Csat(i)
5340             Ctotfresh(icontfresh)=Ctot(i)
5341             Caerfresh(icontfresh)=Caer(i)
5342             Cgasfresh(icontfresh)=Cgas(i)
5343             nsolfresh=nsolfresh+1
5344          elseif (flagsoap(i).eq.1) then                       ! Aged SOA species forming another solution
5345             icontaged=icontaged+1
5346             idxaged(icontaged) = i
5347             Csataged(icontaged)=Csat(i)
5348             Ctotaged(icontaged)=Ctot(i)
5349             Caeraged(icontaged)=Caer(i)
5350             Cgasaged(icontaged)=Cgas(i)
5351             nsolaged=nsolaged+1
5352          endif
5353       enddo
5354
5355 !      Caluclate the initial equilibrium partitioning by the bisection method (CMU PMCAMx approach)
5356 !       If all fresh abd aged species form a solution
5357 !         call soap(ngas_soa,Ctot,Csat,Caer,Cgas,cpx)
5358
5359 !       if fresh and aged species form seperate solutions
5360       if (nsolfresh.gt.0)  call soap(nsolfresh,Ctotfresh, &
5361                     Csatfresh,Caerfresh,Cgasfresh,cpxfresh)
5362       if (nsolaged.gt.0)  call soap(nsolaged,Ctotaged, &
5363                   Csataged,Caeraged,Cgasaged,cpxaged)
5364
5365 !     Map the fresh and aged species back into original arrays
5366 !     Now assign the equilibrium gas-particle partitioning arrays
5367         ntrack=0
5368        do i=1,N ! Map the fresh and aged species back into array from 1 to N after calculating equilibrium
5369          if (idxfresh(i).gt.0) then
5370          Caer(idxfresh(i))= Caerfresh(i)
5371          Cgas(idxfresh(i))= Cgasfresh(i)
5372          Ctot(idxfresh(i))= Ctotfresh(i)
5373          ntrack=ntrack+1
5374          endif
5375          if (idxaged(i).gt.0) then
5376          Caer(idxaged(i))= Caeraged(i)
5377          Cgas(idxaged(i))= Cgasaged(i)
5378          Ctot(idxaged(i))= Ctotaged(i)
5379          ntrack=ntrack+1
5380          endif
5381        enddo
5382 !       Check for total number of species
5383         if (ntrack.ne.N) then
5384         call wrf_error_fatal('Error in mapping fresh and primary species arrays')
5385         endif
5386 ! From here on distribute the organic aerosol in size bins following Koo et al. 2003 " Integrated approaches to modeling
5387 ! the organic and inorganic atmospheric aerosol components"
5388 ! The original code from PMCAMx was modified to include 2 solutions for fresh and primary species
5389 ! by Manish Shrivastava on 01/11/2010
5390 ! Calculate total organic aerosol OA(in nmoles/m3) in each bin for either of fresh and aged aerosols
5391
5392          do ibin=1,nbin_a
5393            xsumfresh(ibin)=0.0
5394            xsumaged(ibin)=0.0
5395               xsumaged(ibin)= xsumaged(ibin)+aer(ioc_a,jp,ibin)!Caluclate pre-existing primary in each bin for aged aerosol
5396 !         do iv = start_ind, ngas_ioa + ngas_soa
5397          do iv = start_ind, (start_ind + N - 1)
5398            if (flagsoap(iv-start_ind+1).eq.2) then
5399                xsumfresh(ibin)= xsumfresh(ibin)+aer(iv,jtotal,ibin)
5400            elseif (flagsoap(iv-start_ind+1).eq.1) then
5401               xsumaged(ibin)= xsumaged(ibin)+aer(iv,jtotal,ibin)
5402                 elseif (flagsoap(iv-start_ind+1).eq.0) then
5403                  print *, 'Error in mapping flagsoap to start_ind'
5404            endif
5405          enddo
5406 !         do iv = ipcg1_b_c_g, ngas_volatile
5407 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5408 !               xsumfresh(ibin)= xsumfresh(ibin)+aer(iv,jtotal,ibin)
5409 !           elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5410 !              xsumaged(ibin)= xsumaged(ibin)+aer(iv,jtotal,ibin)
5411 !                elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.0) then
5412 !                 print *, 'Error in mapping flagsoap to ipcg1_b_c_g'
5413 !           endif
5414 !         enddo
5415
5416 ! Give a small non-zero value to xsum if it is zero in the section
5417           if (xsumfresh(ibin).eq.0.0) xsumfresh(ibin)=tinys
5418           if (xsumaged(ibin).eq.0.0) xsumaged(ibin)=tinys
5419         enddo
5420
5421
5422 ! Calculate dq as (gas concentration) G(t)-G(t+h):
5423 ! Caluclate driving force at previous time step (Cgas,i-XiCsati) for both fresh and aged solutions
5424 !          do iv = start_ind, ngas_ioa + ngas_soa
5425           do iv = start_ind, (start_ind + N - 1)
5426            if (Ctot(iv-start_ind+1).lt.1d-10) goto 120 ! If a given species concentration is too low skip
5427             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
5428 !          do iv = ipcg1_b_c_g, ngas_volatile
5429 !           if (Ctot(iv-ipcg1_b_c_g+1).lt.1d-10) goto 120 ! If a given species concentration is too low skip
5430 !            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
5431            frqtotfresh=0.0d0
5432            frqtotaged=0.0d0
5433            mnkfresh=0.0d0
5434            mnkaged=0.0d0
5435            mxkfresh=0.0d0
5436            mxkaged=0.0d0
5437              do ibin=1,nbin_a
5438 ! fraceq(iv,ibin) is calculated as the rate of mass transfer
5439 ! The weighting fractions frqfresh(ibin) amd frqaged(ibin) are caluclated assuming mole fractions from previous time step
5440 ! This assumtion could be relaxed by iterativetely solving this equation
5441            if (flagsoap(iv-start_ind+1).eq.2) then
5442               frqfresh(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5443               -(aer(iv,jtotal,ibin))/xsumfresh(ibin) &
5444               *Csat(iv-start_ind+1))
5445           endif
5446
5447            if (flagsoap(iv-start_ind+1).eq.1) then
5448               frqaged(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5449              -(aer(iv,jtotal,ibin))/xsumaged(ibin) &
5450               *Csat(iv-start_ind+1))
5451           endif
5452
5453 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5454 !              frqfresh(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5455 !              -(aer(iv,jtotal,ibin))/xsumfresh(ibin) &
5456 !              *Csat(iv-ipcg1_b_c_g+1))
5457 !          endif
5458 !
5459 !           if (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5460 !              frqaged(ibin)= kg(iv,ibin)*(gas(iv) & ! replaced fraceq(iv,ibin) by kg(iv,ibin) on 01/19/10
5461 !             -(aer(iv,jtotal,ibin))/xsumaged(ibin) &
5462 !              *Csat(iv-ipcg1_b_c_g+1))
5463 !          endif
5464             mnkfresh=min(mnkfresh,frqfresh(ibin))
5465             mnkaged=min(mnkaged,frqaged(ibin))
5466
5467             mxkfresh=max(mxkfresh,frqfresh(ibin))
5468             mxkaged=max(mxkaged,frqaged(ibin))
5469           enddo ! for ibin
5470 !          Repeat code from this point on for aged aerosol species
5471             if (flagsoap(iv-start_ind+1).eq.2) then
5472 !            if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5473 ! Condensation is favored in the next time step in this bin
5474           if(dq.gt.0.and.mnkfresh.lt.0.and.mxkfresh.gt.0) then
5475              do ibin=1,nbin_a
5476                frqfresh(ibin)=max(frqfresh(ibin)-mnkfresh,0.0d0)
5477               enddo
5478 ! evaporation is favored in the next time step in this bin
5479           elseif(dq.lt.0.and.mxkfresh.gt.0.and.mnkfresh.lt.0) then
5480               do ibin=1,nbin_a
5481               frqfresh(ibin)=min(frqfresh(ibin)-mxkfresh,0.0d0)
5482               enddo
5483            endif
5484            do ibin=1,nbin_a
5485             frqtotfresh=frqtotfresh+frqfresh(ibin)
5486            enddo
5487 ! Re-normalize frqfresh(ibin)
5488 ! Additional code to check for frqtotfresh and frqtotaged
5489 ! Added by Manish Shrivastava on 02/19/2010
5490
5491           do ibin=1,nbin_a
5492            frqfresh(ibin)=frqfresh(ibin)/frqtotfresh
5493            enddo
5494
5495             elseif(flagsoap(iv-start_ind+1).eq.1) then
5496 !            elseif(flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5497           if(dq.gt.0.and.mnkaged.lt.0.and.mxkaged.gt.0) then
5498              do ibin=1,nbin_a
5499                frqaged(ibin)=max(frqaged(ibin)-mnkaged,0.0d0)
5500               enddo
5501           elseif(dq.lt.0.and.mxkaged.gt.0.and.mnkaged.lt.0) then
5502               do ibin=1,nbin_a
5503               frqaged(ibin)=min(frqaged(ibin)-mxkaged,0.0d0)
5504               enddo
5505            endif
5506
5507            do ibin=1,nbin_a
5508             frqtotaged=frqtotaged+frqaged(ibin)
5509            enddo
5510
5511            do ibin=1,nbin_a
5512            frqaged(ibin)=frqaged(ibin)/frqtotaged
5513            enddo
5514
5515            endif ! for flagsoap
5516 !     Condense all condensing species
5517            if(dq.gt.0.0d0) then
5518
5519             !  Map the species back into the original MOSAIC arrays
5520              do ibin=1,nbin_a
5521                  if (flagsoap(iv-start_ind+1).eq.2) then
5522                  aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqfresh(ibin)
5523                  endif
5524                 if (flagsoap(iv-start_ind+1).eq.1) then
5525                 aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqaged(ibin)
5526                 endif
5527              enddo
5528 ! Set the gas phase species to equilibrium value
5529                 gas(iv)=Cgas(iv-start_ind+1)
5530
5531 !             do ibin=1,nbin_a
5532 !                 if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5533 !                 aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqfresh(ibin)
5534 !                 endif
5535 !                if (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5536 !                aer(iv,jtotal,ibin)= aer(iv,jtotal,ibin)+dq*frqaged(ibin)
5537 !                endif
5538 !             enddo
5539 !! Set the gas phase species to equilibrium value
5540 !                gas(iv)=Cgas(iv-ipcg1_b_c_g+1)
5541
5542 !     Evaporate all evaporating species
5543          elseif(dq.lt.0.0d0) then
5544             iter=0
5545 100         frt=1.0d0
5546                do ibin=1,nbin_a
5547                    if (flagsoap(iv-start_ind+1).eq.2) then
5548 !                   if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5549 ! Cannot evaporate more than whats in the bin ie ratio (aer(iv,jtotal,ibin)/dq*frqfresh(ibin)) should be less than equal to 1
5550                  if(frqfresh(ibin).gt.0.0d0) &
5551          frt=MAX(MIN(aer(iv,jtotal,ibin)/abs(-dq*frqfresh(ibin)),frt),0.0d0)
5552 !                  elseif(flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5553                   elseif(flagsoap(iv-start_ind+1).eq.1) then
5554                if(frqaged(ibin).gt.0.0d0) &
5555          frt=MAX(MIN(aer(iv,jtotal,ibin)/abs(-dq*frqaged(ibin)),frt),0.0d0)
5556                   endif ! for flagsoap
5557                enddo ! for ibin
5558
5559
5560
5561          frqtotfresh=0.0d0
5562          frqtotaged=0.0d0
5563
5564              do ibin=1,nbin_a
5565         if (flagsoap(iv-start_ind+1).eq.2) then
5566 !        if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5567                aer(iv,jtotal,ibin)= &
5568 ! Since dq is negative this is evaporating aerosols
5569                MAX(aer(iv,jtotal,ibin)+frt*dq*frqfresh(ibin),0.0d0)
5570          if(aer(iv,jtotal,ibin).lt.tinys) frqfresh(ibin)=0.0d0
5571               frqtotfresh=frqtotfresh+frqfresh(ibin)
5572 !        elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5573         elseif (flagsoap(iv-start_ind+1).eq.1) then
5574                aer(iv,jtotal,ibin)= &
5575                MAX(aer(iv,jtotal,ibin)+frt*dq*frqaged(ibin),0.0d0)
5576          if(aer(iv,jtotal,ibin).lt.tinys) frqaged(ibin)=0.0d0
5577               frqtotaged=frqtotaged+frqaged(ibin)
5578          endif ! for flagsoap
5579              enddo ! for ibin
5580
5581 ! Check if we should evaporate more
5582           dq=(1.0d0-frt)*dq
5583 !         if (flagsoap(iv-ipcg1_b_c_g+1).eq.2) then
5584          if (flagsoap(iv-start_ind+1).eq.2) then
5585            if(dq.lt.-1.d-8) then ! check if d-8 is better
5586              if(frqtotfresh.gt.tinys) then ! we have sections which are not empty
5587               if(iter.le.itermax) then ! check infinite loop
5588                 iter = iter + 1
5589                 do ibin = 1,nbin_a
5590                   frqfresh(ibin) = frqfresh(ibin) / frqtotfresh
5591                 enddo ! for ibin
5592              goto 100
5593             endif ! for iter
5594           endif ! frqtotfresh.gt.tinys
5595            endif ! dq.lt.-1.d-7
5596 !          elseif (flagsoap(iv-ipcg1_b_c_g+1).eq.1) then
5597           elseif (flagsoap(iv-start_ind+1).eq.1) then
5598            if(dq.lt.-1.d-8) then
5599              if(frqtotaged.gt.tinys) then ! we have sections which are not empty
5600               if(iter.le.itermax) then ! check infinite loop
5601                 iter = iter + 1
5602                 do ibin = 1,nbin_a
5603                   frqaged(ibin) = frqaged(ibin) / frqtotaged
5604                 enddo
5605                goto 100
5606           endif
5607             endif
5608             endif
5609
5610             ! we need to evaporate more to achieve equilibrium
5611             ! but we completely evaporated the species in all sections
5612             ! or exceeded itermax
5613            endif ! for flagsoap
5614
5615 ! now set the gas species concentration conservatively
5616 !           gas(iv)=Ctot(iv-ipcg1_b_c_g+1)
5617            gas(iv)=Ctot(iv-start_ind+1)
5618              do ibin=1,nbin_a
5619                gas(iv)=gas(iv)-aer(iv,jtotal,ibin)
5620              enddo
5621         endif ! if dq.gt.0
5622
5623 120       continue
5624            enddo ! for iv=start_ind
5625
5626        end subroutine equilibrium
5627
5628
5629 !---------------------------------
5630 ! Calculates the equilibrium gas-particle partitioning for SOA species when MOZART_MOSAIC_4BIN_KPP is used
5631 ! This routine was modified by Alma Hodzic based on the initial code implemented by Manish Shrivastava and originated from CAMx
5632
5633 !++ alma - removed the subroutine  equilibrium_smp
5634 !        subroutine  equilibrium_smp
5635 !..
5636 !       end subroutine equilibrium_smp
5637 !--
5638
5639 !    This subroutine spfcn calculates the objective function fval to solve gas-particle partitioning of SOA
5640 !    Subroutine spfcn is called from within the subroutine soap
5641         subroutine spfcn(N,Ctot,Csat,Ca,cpx,tom,fval)
5642 !        use module_data_mosaic_main
5643 !        use module_data_mosaic_aero
5644       implicit none
5645        real(kind=8):: Ctot(N),Csat(N),Ca(N),tom,fval,cpx
5646
5647          integer i,N
5648         fval=0.0
5649          do i=1, N
5650          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
5651         fval=fval+Ca(i)/1 ! The divisor is set to 1 as the species are in nmol/m3
5652         enddo
5653           fval=fval+cpx-tom
5654         return
5655
5656        end subroutine spfcn
5657
5658
5659         subroutine soap(N,Ctot,Csat,Ca,Cgas,cpx)
5660 ! SOAP calculates the gas-partitioning of SOA. Adapted from PMCAMx and uses the bisection approach.
5661 ! SOAP calls subroutine spfcn which calculates the objective function for solving gas-particle partitioning
5662 !        use module_data_mosaic_main
5663 !        use module_data_mosaic_aero
5664
5665         real(kind=8),  parameter :: xtol = 5.0e-5
5666           real(kind=8):: Ctot(N),Csat(N),cpx,Ca(N),Cgas(N)
5667           real(kind=8):: xend,dx,xmid,fend,fmid,sun
5668          integer i,N,znum
5669
5670          sun=0.0
5671           do i=1,N
5672             if (Csat(i).gt.0) then
5673             sun=sun+Ctot(i)/Csat(i) !If a species does not exist its Csat is zero
5674            else
5675            endif
5676           enddo
5677          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
5678            do i=1,N
5679              Cgas(i)=Ctot(i)
5680              Ca(i)=0.0
5681            enddo
5682          goto 900
5683         endif
5684
5685        xend=0.0
5686        do i=1, N
5687          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
5688          enddo
5689         xend=xend+cpx ! total number of moles
5690        if (xend.gt.1e-10) then
5691            call spfcn(N,Ctot,Csat,Ca,cpx,xend,fend) ! Calculates the objective function
5692         else
5693 !          write (2,*) "Total no of moles less than 1e-10 bypassing soap"
5694               goto 100
5695       endif
5696           if(abs(fend).le.xtol*xend) goto 99 ! Check for tolerance
5697           if (fend.gt.0.0) then ! The objective function is supposed to be less than equal to zero
5698          write (2,*) "Error in SOAP"
5699          goto 50
5700         endif
5701            dx=xend-cpx
5702         do znum=1,200
5703         dx=0.5*dx
5704          xmid=xend-dx ! Find the midpoint following the bisection approach
5705            call spfcn (N,Ctot,Csat,Ca,cpx,xmid,fmid) ! Re-calculate the objective function
5706           if(abs(fmid).le.xtol*xmid.or.dx.le.xtol*xmid) goto 100 ! converged
5707            if (fmid.lt.0.0) xend=xmid
5708          enddo
5709 50       call wrf_message("Error in SOAP")
5710          call wrf_error_fatal("Error: max number of iterations reached")
5711
5712
5713 99     xmid=xend
5714 100    continue
5715         do i=1, N
5716         Ca(i)=min(Ctot(i), Ca(i))
5717         Cgas(i)=Ctot(i)-Ca(i)
5718        enddo
5719 900   continue
5720
5721
5722 !     write(2,*) xmid
5723      return
5724
5725        end subroutine soap
5726
5727
5728
5729 !***********************************************************************
5730 ! part of ASTEM: integrates semi-volatile inorganic gases
5731 !
5732 ! author: Rahul A. Zaveri
5733 ! update: jan 2007
5734 !-----------------------------------------------------------------------
5735       subroutine ASTEM_semi_volatiles(dtchem)
5736 !      implicit none
5737 !      include 'chemistry.com'
5738 !      include 'mosaic.h'
5739 ! subr arguments
5740       real(kind=8) dtchem
5741 ! local variables
5742       integer ibin, iv, jp
5743       real(kind=8) dtmax, t_new, t_old, t_out, xt
5744       real(kind=8) sum1, sum2, sum3, sum4, sum4a, sum4b, h_flux_s
5745
5746
5747 ! initialize time
5748       t_old = 0.0
5749       t_out = dtchem
5750
5751 ! reset ASTEM time steps and MESA iterations counters to zero
5752       isteps_ASTEM = 0
5753       do ibin = 1, nbin_a
5754         iter_MESA(ibin) = 0
5755       enddo
5756
5757 !--------------------------------
5758 ! overall integration loop begins over dtchem seconds
5759
5760 10    isteps_ASTEM = isteps_ASTEM + 1
5761
5762 ! compute new fluxes
5763       phi_nh4no3_s = 0.0
5764       phi_nh4cl_s  = 0.0
5765       ieqblm_ASTEM = mYES                       ! reset to default
5766
5767       do 501 ibin = 1, nbin_a
5768
5769         idry_case3a(ibin) = mNO                 ! reset to default
5770 ! default fluxes and other stuff
5771         do iv = 1, ngas_ioa
5772           sfc_a(iv)                  = gas(iv)
5773           df_gas_s(iv,ibin)          = 0.0
5774           df_gas_l(iv,ibin)          = 0.0
5775           flux_s(iv,ibin)            = 0.0
5776           flux_l(iv,ibin)            = 0.0
5777           Heff(iv,ibin)              = 0.0
5778           volatile_s(iv,ibin)        = 0.0
5779           phi_volatile_s(iv,ibin)    = 0.0
5780           phi_volatile_l(iv,ibin)    = 0.0
5781           integrate(iv,jsolid,ibin)  = mNO      ! reset to default
5782           integrate(iv,jliquid,ibin) = mNO      ! reset to default
5783         enddo
5784
5785
5786         if(jaerosolstate(ibin) .eq. all_solid)then
5787           jphase(ibin) = jsolid
5788           call ASTEM_flux_dry(ibin)
5789         elseif(jaerosolstate(ibin) .eq. all_liquid)then
5790           jphase(ibin) = jliquid
5791           call ASTEM_flux_wet(ibin)
5792         elseif(jaerosolstate(ibin) .eq. mixed)then
5793
5794           if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
5795               electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
5796             call ASTEM_flux_mix(ibin)   ! jphase(ibin) will be determined in this subr.
5797           else
5798             jphase(ibin) = jliquid
5799             call ASTEM_flux_wet(ibin)
5800           endif
5801
5802         endif
5803
5804 501   continue
5805
5806       if(ieqblm_ASTEM .eq. mYES)goto 30 ! all bins have reached eqblm, so quit.
5807
5808 !-------------------------
5809
5810
5811 ! calculate maximum possible internal time-step
5812 11    call ASTEM_calculate_dtmax(dtchem, dtmax)
5813       t_new = t_old + dtmax     ! update time
5814       if(t_new .gt. t_out)then  ! check if the new time step is too large
5815         dtmax = t_out - t_old
5816         t_new = t_out*1.01
5817       endif
5818
5819
5820 !------------------------------------------
5821 ! do internal time-step (dtmax) integration
5822
5823       do 20 iv = 2, 4
5824
5825         sum1 = 0.0
5826         sum2 = 0.0
5827         sum3 = 0.0
5828         sum4 = 0.0
5829         sum4a= 0.0
5830         sum4b= 0.0
5831
5832         do 21 ibin = 1, nbin_a
5833           if(jaerosolstate(ibin) .eq. no_aerosol)goto 21
5834
5835           jp = jliquid
5836           sum1 = sum1 + aer(iv,jp,ibin)/ &
5837           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
5838
5839           sum2 = sum2 + kg(iv,ibin)*integrate(iv,jp,ibin)/ &
5840           (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin)*integrate(iv,jp,ibin))
5841
5842           jp = jsolid
5843           sum3 = sum3 + aer(iv,jp,ibin)
5844
5845           if(flux_s(iv,ibin) .gt. 0.)then
5846             h_flux_s = dtmax*flux_s(iv,ibin)
5847             sum4a = sum4a + h_flux_s
5848             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
5849           elseif(flux_s(iv,ibin) .lt. 0.)then
5850             h_flux_s = min(h_s_i_m(iv,ibin),dtmax)*flux_s(iv,ibin)
5851             sum4b = sum4b + h_flux_s
5852             aer(iv,jp,ibin) = aer(iv,jp,ibin) + h_flux_s
5853             aer(iv,jp,ibin) = max(aer(iv,jp,ibin), 0.0D0)
5854           endif
5855
5856 21      continue
5857
5858         sum4 = sum4a + sum4b
5859
5860
5861 ! first update gas concentration
5862         gas(iv) = (total_species(iv) - (sum1 + sum3 + sum4) )/ &
5863                               (1. + dtmax*sum2)
5864         gas(iv) = max(gas(iv), 0.0D0)
5865
5866 !        if(gas(iv) .lt. 0.)write(6,*) gas(iv)
5867
5868 ! now update aer concentration in the liquid phase
5869         do 22 ibin = 1, nbin_a
5870
5871           if(integrate(iv,jliquid,ibin) .eq. mYES)then
5872             aer(iv,jliquid,ibin) =  &
5873              (aer(iv,jliquid,ibin) + dtmax*kg(iv,ibin)*gas(iv))/ &
5874                   (1. + dtmax*kg(iv,ibin)*Heff(iv,ibin))
5875
5876           endif
5877
5878 22      continue
5879
5880
5881 20    continue
5882 !------------------------------------------
5883 ! sub-step integration done
5884
5885
5886 !------------------------------------------
5887 ! now update aer(jtotal) and update internal phase equilibrium
5888 ! also do integration of species by mass balance if necessary
5889
5890       do 40 ibin = 1, nbin_a
5891         if(jaerosolstate(ibin) .eq. no_aerosol)goto 40
5892
5893         if(jphase(ibin) .eq. jsolid)then
5894           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
5895         elseif(jphase(ibin) .eq. jliquid)then
5896           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
5897         elseif(jphase(ibin) .eq. jtotal)then
5898           call form_electrolytes(jsolid,ibin,XT)  ! degas excess nh3 (if present)
5899           call form_electrolytes(jliquid,ibin,XT) ! degas excess nh3 (if present)
5900         endif
5901
5902 !========================
5903 ! now update jtotal
5904         do iv = 2, ngas_ioa
5905           aer(iv,jtotal,ibin)=aer(iv,jsolid,ibin)+aer(iv,jliquid,ibin)
5906         enddo
5907 !========================
5908
5909
5910         call form_electrolytes(jtotal,ibin,XT)  ! for MDRH diagnosis
5911
5912
5913
5914 ! update internal phase equilibrium
5915         if(jhyst_leg(ibin) .eq. jhyst_lo)then
5916           call ASTEM_update_phase_eqblm(ibin)
5917         else
5918           call do_full_deliquescence(ibin)              ! simply do liquid <-- total
5919         endif
5920
5921
5922 40    continue
5923 !------------------------------------------
5924
5925 ! update time
5926       t_old = t_new
5927
5928
5929       if(isteps_astem .ge. nmax_astem)then
5930         nastem_fail = nastem_fail + 1
5931         write(6,*)'ASTEM internal steps exceeded', nmax_astem
5932         if(iprint_input .eq. mYES)then
5933           write(67,*)'ASTEM internal steps exceeded', nmax_astem
5934           call print_input
5935           iprint_input = mNO
5936         endif
5937         goto 30
5938       elseif(t_new .lt. t_out)then
5939         goto 10
5940       endif
5941
5942
5943 ! check if end of dtchem reached
5944       if(t_new .lt. 0.9999*t_out) goto 10
5945
5946 30    nsteps_astem = nsteps_astem + isteps_astem                ! cumulative steps
5947       nsteps_astem_max = max(nsteps_astem_max, isteps_astem)    ! max steps in a dtchem time-step
5948
5949 !================================================
5950 ! end of overall integration loop over dtchem seconds
5951
5952
5953
5954 ! call subs to calculate fluxes over mixed-phase particles to update H+ ions,
5955 ! which were wiped off during update_phase_eqblm
5956 !      do ibin = 1, nbin_a
5957 !
5958 !        if(jaerosolstate(ibin) .eq. mixed)then
5959 !          if( electrolyte(jnh4no3,jsolid,ibin).gt. 0.0 .or. &
5960 !              electrolyte(jnh4cl, jsolid,ibin).gt. 0.0 )then
5961 !            call ASTEM_flux_mix(ibin)          ! jphase(ibin) will be determined in this subr.
5962 !          else
5963 !            jphase(ibin) = jliquid
5964 !            call ASTEM_flux_wet(ibin)
5965 !          endif
5966 !        endif
5967 !
5968 !      enddo
5969
5970
5971
5972       return
5973       end subroutine ASTEM_semi_volatiles
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986 !***********************************************************************
5987 ! part of ASTEM: computes max time step for gas-aerosol integration
5988 !
5989 ! author: Rahul A. Zaveri
5990 ! update: jan 2005
5991 !-----------------------------------------------------------------------
5992       subroutine ASTEM_calculate_dtmax(dtchem, dtmax)
5993        use module_data_mosaic_other, only:  lunerr
5994 !      implicit none
5995 !      include 'mosaic.h'
5996 ! subr arguments
5997       real(kind=8) dtchem, dtmax
5998 ! local variables
5999       integer ibin, iv
6000       real(kind=8) alpha, h_gas, h_sub_max,  &
6001            h_gas_i(ngas_ioa), h_gas_l, h_gas_s,  &
6002            sum_kg_phi, sumflux_s
6003
6004
6005       h_sub_max = 100.0 ! sec  raz update 4/30/2007
6006
6007
6008 ! gas-side
6009
6010 ! solid-phase
6011 ! calculate h_gas_i and h_gas_l
6012
6013       h_gas_s = 2.e16
6014
6015       do 5 iv = 2, ngas_ioa
6016         h_gas_i(iv) = 1.e16
6017         sumflux_s = 0.0
6018         do ibin = 1, nbin_a
6019           if(flux_s(iv,ibin) .gt. 0.0)then
6020             sumflux_s = sumflux_s + flux_s(iv,ibin)
6021           endif
6022         enddo
6023
6024         if(sumflux_s .gt. 0.0)then
6025           h_gas_i(iv) = 0.1*gas(iv)/sumflux_s     ! raz-30apr07
6026           h_gas_s     = min(h_gas_s, h_gas_i(iv))
6027         endif
6028
6029 5     continue
6030
6031
6032 ! liquid-phase
6033 ! calculate h_gas_s and h_gas_l
6034
6035       h_gas_l = 2.e16
6036
6037       do 6 iv = 2, ngas_ioa
6038         h_gas_i(iv) = 1.e16
6039         sum_kg_phi = 0.0
6040         do ibin = 1, nbin_a
6041           if(integrate(iv,jliquid,ibin) .eq. mYES)then
6042           sum_kg_phi = sum_kg_phi +  &
6043                        abs(phi_volatile_l(iv,ibin))*kg(iv,ibin)
6044           endif
6045         enddo
6046
6047         if(sum_kg_phi .gt. 0.0)then
6048           h_gas_i(iv) = alpha_astem/sum_kg_phi
6049           h_gas_l     = min(h_gas_l, h_gas_i(iv))
6050         endif
6051
6052 6     continue
6053
6054       h_gas = min(h_gas_s, h_gas_l)
6055       h_gas = min(h_gas, h_sub_max)
6056
6057
6058
6059
6060 ! aerosol-side: solid-phase
6061
6062 ! first load volatile_solid array
6063       do ibin = 1, nbin_a
6064
6065         volatile_s(ino3_a,ibin) = electrolyte(jnh4no3,jsolid,ibin)
6066         volatile_s(inh4_a,ibin) = electrolyte(jnh4cl,jsolid,ibin) +  &
6067                                   electrolyte(jnh4no3,jsolid,ibin)
6068
6069         if(idry_case3a(ibin) .eq. mYES)then
6070           volatile_s(icl_a,ibin)  = aer(icl_a,jsolid,ibin)
6071         else
6072           volatile_s(icl_a,ibin)  = electrolyte(jnh4cl,jsolid,ibin)
6073         endif
6074
6075       enddo
6076
6077
6078 ! next calculate weighted avg_df_gas_s
6079       do iv = 2, ngas_ioa
6080
6081         sum_bin_s(iv) = 0.0
6082         sum_vdf_s(iv) = 0.0
6083         sum_vol_s(iv) = 0.0
6084
6085         do ibin = 1, nbin_a
6086           if(flux_s(iv,ibin) .lt. 0.)then       ! aer -> gas
6087             sum_bin_s(iv) = sum_bin_s(iv) + 1.0
6088             sum_vdf_s(iv) = sum_vdf_s(iv) +  &
6089                             volatile_s(iv,ibin)*df_gas_s(iv,ibin)
6090             sum_vol_s(iv) = sum_vol_s(iv) + volatile_s(iv,ibin)
6091           endif
6092         enddo
6093
6094         if(sum_vol_s(iv) .gt. 0.0)then
6095           avg_df_gas_s(iv) = sum_vdf_s(iv)/sum_vol_s(iv)
6096         else
6097           avg_df_gas_s(iv) = 1.0 ! never used, but set to 1.0 just to be safe
6098         endif
6099
6100       enddo
6101
6102
6103 ! calculate h_s_i_m
6104
6105
6106       do 20 ibin = 1, nbin_a
6107
6108         if(jaerosolstate(ibin) .eq. no_aerosol) goto 20
6109
6110         do 10 iv = 2, ngas_ioa
6111
6112           if(flux_s(iv,ibin) .lt. 0.)then                               ! aer -> gas
6113
6114             alpha = abs(avg_df_gas_s(iv))/  &
6115                    (volatile_s(iv,ibin)*sum_bin_s(iv))
6116             alpha = min(alpha, 1.0D0)
6117
6118             if(idry_case3a(ibin) .eq. mYES)alpha = 1.0D0
6119
6120             h_s_i_m(iv,ibin) =  &
6121                  -alpha*volatile_s(iv,ibin)/flux_s(iv,ibin)
6122
6123           endif
6124
6125 10      continue
6126
6127
6128 20    continue
6129
6130
6131       dtmax = min(dtchem, h_gas)
6132
6133
6134       if(dtmax .eq. 0.0)then
6135         write(6,*)' dtmax = ', dtmax
6136         write(67,*)' dtmax = ', dtmax
6137         call print_input
6138         iprint_input = mNO
6139         call peg_error_fatal( lunerr, " " )
6140       endif
6141
6142       return
6143       end subroutine astem_calculate_dtmax
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159 !***********************************************************************
6160 ! part of ASTEM: updates solid-liquid partitioning after each gas-aerosol
6161 ! mass transfer step
6162 !
6163 ! author: Rahul A. Zaveri
6164 ! update: jan 2005
6165 !-----------------------------------------------------------------------
6166       subroutine ASTEM_update_phase_eqblm(ibin) ! TOUCH
6167 !      implicit none
6168 !      include 'mosaic.h'
6169 ! subr arguments
6170       integer ibin
6171 ! local variables
6172       integer jdum, js, j_index, je     ! raz update 11/13/2008
6173       real(kind=8) XT, sum_dum  ! raz update 11/13/2008
6174
6175
6176
6177 ! calculate percent composition ! raz update 11/13/2008
6178       sum_dum = 0.0
6179       do je = 1, nelectrolyte
6180         sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
6181       enddo
6182
6183       if(sum_dum .eq. 0.)sum_dum = 1.0
6184
6185       do je = 1, nelectrolyte
6186         epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
6187       enddo
6188
6189
6190 ! calculate overall sulfate ratio
6191       call calculate_XT(ibin,jtotal,XT)         ! calc updated XT
6192
6193 ! now diagnose MDRH
6194       if(XT .lt. 1. .and. XT .gt. 0. )goto 10   ! excess sulfate domain - no MDRH exists
6195
6196       jdum = 0
6197       do js = 1, nsalt
6198         jsalt_present(js) = 0                   ! default value - salt absent
6199
6200         if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
6201           jsalt_present(js) = 1                 ! salt present
6202           jdum = jdum + jsalt_index(js)
6203         endif
6204       enddo
6205
6206       if(jdum .eq. 0)then
6207         jaerosolstate(ibin) = all_solid ! no significant soluble material present
6208         jphase(ibin) = jsolid
6209         call adjust_solid_aerosol(ibin)
6210         return
6211       endif
6212
6213       if(XT .ge. 2.0 .or. XT .lt. 0.0)then
6214         j_index = jsulf_poor(jdum)
6215       else
6216         j_index = jsulf_rich(jdum)
6217       endif
6218
6219       MDRH(ibin) = MDRH_T(j_index)
6220
6221       if(aH2O*100. .lt. MDRH(ibin)) then
6222         jaerosolstate(ibin) = all_solid
6223         jphase(ibin) = jsolid
6224         call adjust_solid_aerosol(ibin)
6225         return
6226       endif
6227
6228
6229 ! none of the above means it must be sub-saturated or mixed-phase
6230 10    if(jphase(ibin) .eq. jsolid)then
6231         call do_full_deliquescence(ibin)
6232         call MESA_PTC(ibin)
6233       else
6234         call MESA_PTC(ibin)
6235       endif
6236
6237
6238
6239       return
6240       end subroutine ASTEM_update_phase_eqblm
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253 !==================================================================
6254 !
6255 ! LIQUID PARTICLES
6256 !
6257 !***********************************************************************
6258 ! part of ASTEM: computes fluxes over wet aerosols
6259 !
6260 ! author: Rahul A. Zaveri
6261 ! update: Jan 2007
6262 !-----------------------------------------------------------------------
6263       subroutine ASTEM_flux_wet(ibin)
6264       use module_data_mosaic_other, only:  lunerr
6265 !      implicit none
6266 !      include 'mosaic.h'
6267 ! subr arguments
6268       integer ibin
6269 ! local variables
6270       integer iv, iadjust, iadjust_intermed
6271       real(kind=8) xt, g_nh3_hno3, g_nh3_hcl, a_nh4_no3, a_nh4_cl
6272
6273
6274
6275       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
6276       call compute_activities(ibin)
6277
6278       if(water_a(ibin) .eq. 0.0)then
6279         write(6,*)'Water is zero in liquid phase'
6280         call peg_error_fatal( lunerr, "Stopping in ASTEM_flux_wet" )
6281       endif
6282
6283 !-------------------------------------------------------------------
6284 ! CASE 1: caco3 > 0 absorb acids (and indirectly degas co2)
6285
6286       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
6287         call ASTEM_flux_wet_case1(ibin)
6288         return
6289       endif
6290
6291 !-------------------------------------------------------------------
6292 ! CASE 2: Sulfate-Rich Domain
6293
6294       if(XT.lt.1.9999 .and. XT.ge.0.)then
6295         call ASTEM_flux_wet_case2(ibin)
6296         return
6297       endif
6298
6299 !-------------------------------------------------------------------
6300
6301       if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10  ! no ammonia in the system
6302
6303 !-------------------------------------------------------------------
6304 ! CASE 3: nh4no3 and/or nh4cl maybe active
6305 ! do some small adjustments (if needed) before deciding case 3
6306
6307       iadjust = mNO             ! default
6308       iadjust_intermed = mNO    ! default
6309
6310 ! nh4no3
6311       g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
6312       a_nh4_no3  = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
6313
6314       if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
6315         call absorb_tiny_nh4no3(ibin)
6316         iadjust = mYES
6317         iadjust_intermed = mYES
6318       endif
6319
6320       if(iadjust_intermed .eq. mYES)then
6321         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6322         iadjust_intermed = mNO  ! reset
6323       endif
6324
6325 ! nh4cl
6326       g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
6327       a_nh4_cl  = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
6328
6329       if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
6330         call absorb_tiny_nh4cl(ibin)
6331         iadjust = mYES
6332         iadjust_intermed = mYES
6333       endif
6334
6335       if(iadjust_intermed .eq. mYES)then
6336         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6337       endif
6338
6339       if(iadjust .eq. mYES)then
6340         call compute_activities(ibin)                   ! update after adjustments
6341       endif
6342
6343
6344 ! all adjustments done...
6345
6346 !--------
6347       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
6348       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
6349
6350       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
6351       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
6352
6353       call ASTEM_flux_wet_case3(ibin)
6354
6355       return
6356
6357
6358 !-------------------------------------------------------------------
6359 ! CASE 4: ammonia = 0. hno3 and hcl exchange may happen here
6360 ! do small adjustments (if needed) before deciding case 4
6361
6362 10    iadjust = mNO             ! default
6363       iadjust_intermed = mNO    ! default
6364
6365 ! hno3
6366       if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and. &
6367          aer(icl_a,jliquid,ibin) .gt. 0.0)then
6368         call absorb_tiny_hno3(ibin)     ! and degas tiny hcl
6369         iadjust = mYES
6370         iadjust_intermed = mYES
6371       endif
6372
6373       if(iadjust_intermed .eq. mYES)then
6374         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6375         iadjust_intermed = mNO  ! reset
6376       endif
6377
6378 ! hcl
6379       if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin).eq.0. .and. &
6380          aer(ino3_a,jliquid,ibin) .gt. 0.0)then
6381         call absorb_tiny_hcl(ibin)      ! and degas tiny hno3
6382         iadjust = mYES
6383         iadjust_intermed = mYES
6384       endif
6385
6386       if(iadjust_intermed .eq. mYES)then
6387         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
6388       endif
6389
6390       if(iadjust .eq. mYES)then
6391         call compute_activities(ibin)                   ! update after adjustments
6392       endif
6393
6394 ! all adjustments done...
6395
6396       call ASTEM_flux_wet_case4(ibin)
6397
6398
6399       return
6400       end subroutine ASTEM_flux_wet
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413 !***********************************************************************
6414 ! part of ASTEM: subroutines for flux_wet cases
6415 !
6416 ! author: Rahul A. Zaveri
6417 ! update: Jan 2007
6418 !-----------------------------------------------------------------------
6419
6420 ! CASE 1: CaCO3 > 0 absorb all acids (and indirectly degas co2)
6421
6422       subroutine ASTEM_flux_wet_case1(ibin)
6423 !      implicit none
6424 !      include 'mosaic.h'
6425 ! subr arguments
6426       integer ibin
6427 ! local variables
6428       integer iv
6429
6430       mc(jc_h,ibin) = sqrt(Keq_ll(3))
6431
6432 ! same as dry case1
6433       if(gas(ihno3_g) .gt. 1.e-5)then
6434         sfc_a(ihno3_g) = 0.0
6435         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
6436         phi_volatile_s(ihno3_g,ibin) = 1.0
6437         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
6438         integrate(ihno3_g,jsolid,ibin) = mYES
6439         jphase(ibin) = jsolid
6440         ieqblm_ASTEM = mNO
6441       endif
6442
6443       if(gas(ihcl_g) .gt. 1.e-5)then
6444         sfc_a(ihcl_g)  = 0.0
6445         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
6446         phi_volatile_s(ihcl_g,ibin) = 1.0
6447         flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
6448         integrate(ihcl_g,jsolid,ibin)  = mYES
6449         jphase(ibin) = jsolid
6450         ieqblm_ASTEM = mNO
6451       endif
6452
6453       return
6454       end subroutine ASTEM_flux_wet_case1
6455
6456
6457
6458 !--------------------------------------------------------------------
6459 ! CASE 2: Sulfate-Rich Domain
6460
6461       subroutine ASTEM_flux_wet_case2(ibin)
6462 !      implicit none
6463 !      include 'mosaic.h'
6464 ! subr arguments
6465       integer ibin
6466 ! local variables
6467       real(kind=8) dum_hno3, dum_hcl, dum_nh3
6468
6469
6470       sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
6471                        gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
6472                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6473
6474       sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
6475                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
6476                    Keq_gl(3)
6477
6478       sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
6479                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
6480                    Keq_gl(4)
6481
6482       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6483       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6484       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6485
6486
6487 ! compute relative driving forces
6488       if(dum_hno3 .gt. 0.0)then
6489         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6490         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6491       else
6492         phi_volatile_l(ihno3_g,ibin)= 0.0
6493       endif
6494
6495       if(dum_hcl .gt. 0.0)then
6496         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6497         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6498       else
6499         phi_volatile_l(ihcl_g,ibin) = 0.0
6500       endif
6501
6502       if(dum_nh3 .gt. 0.0)then
6503         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6504         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6505       else
6506         phi_volatile_l(inh3_g,ibin) = 0.0
6507       endif
6508
6509
6510       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6511          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6512          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6513
6514         return
6515
6516       endif
6517
6518
6519 ! compute Heff
6520       if(dum_hno3 .gt. 0.0)then
6521         Heff(ihno3_g,ibin)=  &
6522           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6523                        (water_a(ibin)*Keq_gl(3))
6524         integrate(ihno3_g,jliquid,ibin)= mYES
6525         ieqblm_ASTEM = mNO
6526       endif
6527
6528       if(dum_hcl .gt. 0.0)then
6529         Heff(ihcl_g,ibin)=  &
6530           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6531                        (water_a(ibin)*Keq_gl(4))
6532         integrate(ihcl_g,jliquid,ibin) = mYES
6533         ieqblm_ASTEM = mNO
6534       endif
6535
6536       if(dum_nh3 .gt. 0.0)then
6537         Heff(inh3_g,ibin) =  &
6538              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6539              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6540         integrate(inh3_g,jliquid,ibin) = mYES
6541         ieqblm_ASTEM = mNO
6542       endif
6543
6544
6545       return
6546       end subroutine ASTEM_flux_wet_case2
6547
6548
6549
6550
6551
6552
6553
6554
6555 !---------------------------------------------------------------------
6556 ! CASE 3: nh4no3 and/or nh4cl may be active
6557
6558       subroutine ASTEM_flux_wet_case3(ibin)
6559 !      implicit none
6560 !      include 'mosaic.h'
6561 ! subr arguments
6562       integer ibin
6563 ! local variables
6564       real(kind=8) a, b, c, dum_hno3, dum_hcl, dum_nh3
6565 ! function
6566 !      real(kind=8) quadratic
6567
6568       a =   kg(inh3_g,ibin)
6569       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
6570           + kg(ihno3_g,ibin)*gas(ihno3_g)  &
6571           + kg(ihcl_g,ibin)*gas(ihcl_g)
6572       c = -(kg(ihno3_g,ibin)*Keq_nh4no3 + kg(ihcl_g,ibin)*Keq_nh4cl)
6573
6574       sfc_a(inh3_g)  = quadratic(a,b,c)
6575       sfc_a(ihno3_g) = Keq_nh4no3/max(sfc_a(inh3_g),1.D-20)
6576       sfc_a(ihcl_g)  = Keq_nh4cl/max(sfc_a(inh3_g),1.D-20)
6577
6578
6579 ! diagnose mH+
6580       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6581         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6582         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6583       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6584         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6585         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6586       else
6587         call equilibrate_acids(ibin)    ! hno3 and/or hcl may be > 0 in the gas phase
6588         mc(jc_h,ibin)  = max(mc(jc_h,ibin), sqrt(Keq_ll(3)))
6589
6590         sfc_a(inh3_g)  = kel(inh3_g,ibin)* &
6591                          gam_ratio(ibin)*mc(jc_nh4,ibin)*Keq_ll(3)/ &
6592                         (mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6593
6594         sfc_a(ihno3_g) = kel(ihno3_g,ibin)* &
6595                    mc(jc_h,ibin)*ma(ja_no3,ibin)*gam(jhno3,ibin)**2/ &
6596                    Keq_gl(3)
6597         sfc_a(ihcl_g)  = kel(ihcl_g,ibin)* &
6598                    mc(jc_h,ibin)*ma(ja_cl,ibin)*gam(jhcl,ibin)**2/ &
6599                    Keq_gl(4)
6600       endif
6601
6602
6603
6604       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6605       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6606       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6607
6608 ! compute relative driving forces
6609       if(dum_hno3 .gt. 0.0)then
6610         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6611         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6612       else
6613         phi_volatile_l(ihno3_g,ibin)= 0.0
6614       endif
6615
6616       if(dum_hcl .gt. 0.0)then
6617         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6618         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6619       else
6620         phi_volatile_l(ihcl_g,ibin) = 0.0
6621       endif
6622
6623       if(dum_nh3 .gt. 0.0)then
6624         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6625         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6626       else
6627         phi_volatile_l(inh3_g,ibin) = 0.0
6628       endif
6629
6630
6631
6632       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6633          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6634          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6635
6636         return
6637
6638       endif
6639
6640
6641 ! compute Heff
6642       if(dum_hno3 .gt. 0.0)then
6643         Heff(ihno3_g,ibin)=  &
6644           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6645                        (water_a(ibin)*Keq_gl(3))
6646         integrate(ihno3_g,jliquid,ibin)= mYES
6647         ieqblm_ASTEM = mNO
6648       endif
6649
6650       if(dum_hcl .gt. 0.0)then
6651         Heff(ihcl_g,ibin)=  &
6652           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6653                        (water_a(ibin)*Keq_gl(4))
6654         integrate(ihcl_g,jliquid,ibin) = mYES
6655         ieqblm_ASTEM = mNO
6656       endif
6657
6658       if(dum_nh3 .gt. 0.0)then
6659         Heff(inh3_g,ibin) =  &
6660              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6661              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6662         integrate(inh3_g,jliquid,ibin) = mYES
6663         ieqblm_ASTEM = mNO
6664       endif
6665
6666
6667
6668       return
6669       end subroutine ASTEM_flux_wet_case3
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679 !--------------------------------------------------------------------
6680 ! CASE 3a: only NH4NO3 (aq) active
6681
6682       subroutine ASTEM_flux_wet_case3a(ibin)    ! NH4NO3 (aq)
6683 !      implicit none
6684 !      include 'mosaic.h'
6685 ! subr arguments
6686       integer ibin
6687 ! local variables
6688       real(kind=8) a, b, c, dum_hno3, dum_nh3
6689 ! function
6690 !      real(kind=8) quadratic
6691
6692
6693       a =   kg(inh3_g,ibin)
6694       b = - kg(inh3_g,ibin)*gas(inh3_g) &
6695           + kg(ihno3_g,ibin)*gas(ihno3_g)
6696       c = -(kg(ihno3_g,ibin)*Keq_nh4no3)
6697
6698       sfc_a(inh3_g)  = quadratic(a,b,c)
6699       sfc_a(ihno3_g) = Keq_nh4no3/sfc_a(inh3_g)
6700
6701
6702 ! diagnose mH+
6703       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6704         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6705           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6706       else
6707         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6708       endif
6709
6710
6711 ! compute Heff
6712       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g))
6713       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6714
6715 ! compute relative driving forces
6716       if(dum_hno3 .gt. 0.0)then
6717         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6718         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6719       else
6720         phi_volatile_l(ihno3_g,ibin)= 0.0
6721       endif
6722
6723       if(dum_nh3 .gt. 0.0)then
6724         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6725         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6726       else
6727         phi_volatile_l(inh3_g,ibin) = 0.0
6728       endif
6729
6730
6731       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6732          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6733
6734         return
6735
6736       endif
6737
6738
6739 ! compute Heff
6740       Heff(ihno3_g,ibin)=  &
6741         kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6742                      (water_a(ibin)*Keq_gl(3))
6743       integrate(ihno3_g,jliquid,ibin)= mYES
6744
6745
6746       Heff(inh3_g,ibin) =  &
6747            kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6748            (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6749       integrate(inh3_g,jliquid,ibin) = mYES
6750
6751
6752       ieqblm_ASTEM = mNO
6753
6754
6755       return
6756       end subroutine ASTEM_flux_wet_case3a
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766 !--------------------------------------------------------------------
6767 ! CASE 3b: only NH4Cl (aq) active
6768
6769       subroutine ASTEM_flux_wet_case3b(ibin)    ! NH4Cl (aq)
6770 !      implicit none
6771 !      include 'mosaic.h'
6772 ! subr arguments
6773       integer ibin
6774 ! local variables
6775       real(kind=8) a, b, c, dum_hcl, dum_nh3
6776 ! function
6777 !      real(kind=8) quadratic
6778
6779
6780       a =   kg(inh3_g,ibin)
6781       b = - kg(inh3_g,ibin)*gas(inh3_g) &
6782           + kg(ihcl_g,ibin)*gas(ihcl_g)
6783       c = -(kg(ihcl_g,ibin)*Keq_nh4cl)
6784
6785       sfc_a(inh3_g)  = quadratic(a,b,c)
6786       sfc_a(ihcl_g)  = Keq_nh4cl /sfc_a(inh3_g)
6787
6788
6789 ! diagnose mH+
6790       if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6791         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6792           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6793       else
6794         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6795       endif
6796
6797
6798 ! compute Heff
6799       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))
6800       dum_nh3  = max(sfc_a(inh3_g), gas(inh3_g))
6801
6802
6803 ! compute relative driving forces
6804       if(dum_hcl .gt. 0.0)then
6805         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6806         phi_volatile_l(ihcl_g,ibin) = df_gas_l(ihcl_g,ibin)/dum_hcl
6807       else
6808         phi_volatile_l(ihcl_g,ibin) = 0.0
6809       endif
6810
6811       if(dum_nh3 .gt. 0.0)then
6812         df_gas_l(inh3_g,ibin)  = gas(inh3_g)  - sfc_a(inh3_g)
6813         phi_volatile_l(inh3_g,ibin) = df_gas_l(inh3_g,ibin)/dum_nh3
6814       else
6815         phi_volatile_l(inh3_g,ibin) = 0.0
6816       endif
6817
6818
6819
6820       if(phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem .and. &
6821          phi_volatile_l(inh3_g,ibin)  .le. rtol_eqb_astem)then
6822
6823         return
6824
6825       endif
6826
6827
6828
6829 ! compute Heff
6830       Heff(ihcl_g,ibin)=  &
6831           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6832                        (water_a(ibin)*Keq_gl(4))
6833       integrate(ihcl_g,jliquid,ibin) = mYES
6834
6835
6836       Heff(inh3_g,ibin) =  &
6837              kel(inh3_g,ibin)*gam_ratio(ibin)*1.e-9*Keq_ll(3)/ &
6838              (water_a(ibin)*mc(jc_h,ibin)*Keq_ll(2)*Keq_gl(2))
6839       integrate(inh3_g,jliquid,ibin) = mYES
6840
6841
6842       ieqblm_ASTEM = mNO
6843
6844
6845
6846       return
6847       end subroutine ASTEM_flux_wet_case3b
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857 !-----------------------------------------------------------------------
6858 ! CASE 4: NH3 = 0 (in gas and aerosol). hno3 and hcl exchange may happen here
6859
6860       subroutine ASTEM_flux_wet_case4(ibin)
6861 !      implicit none
6862 !      include 'mosaic.h'
6863 ! subr arguments
6864       integer ibin
6865 ! local variables
6866       real(kind=8) dum_numer, dum_denom, gas_eqb_ratio, dum_hno3, dum_hcl
6867
6868
6869       dum_numer = kel(ihno3_g,ibin)*Keq_gl(4)*ma(ja_no3,ibin)* &
6870                   gam(jhno3,ibin)**2
6871       dum_denom = kel(ihcl_g,ibin)*Keq_gl(3)*ma(ja_cl ,ibin)* &
6872                   gam(jhcl,ibin)**2
6873
6874
6875       if(dum_denom .eq. 0.0 .or. dum_numer .eq. 0.0)then
6876         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6877         return
6878       endif
6879
6880       gas_eqb_ratio = dum_numer/dum_denom       ! Ce,hno3/Ce,hcl
6881
6882
6883 ! compute equilibrium surface concentrations
6884       sfc_a(ihcl_g) =  &
6885        ( kg(ihno3_g,ibin)*gas(ihno3_g)+kg(ihcl_g,ibin)*gas(ihcl_g) )/ &
6886            ( kg(ihcl_g,ibin) + gas_eqb_ratio*kg(ihno3_g,ibin) )
6887       sfc_a(ihno3_g)= gas_eqb_ratio*sfc_a(ihcl_g)
6888
6889
6890 ! diagnose mH+
6891       if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
6892         mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
6893         (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
6894       elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
6895         mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
6896         (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
6897       else
6898         mc(jc_h,ibin) = sqrt(Keq_ll(3))
6899       endif
6900
6901
6902 ! compute Heff
6903       dum_hno3 = max(sfc_a(ihno3_g), gas(ihno3_g)) ! raz-30apr07
6904       dum_hcl  = max(sfc_a(ihcl_g), gas(ihcl_g))   ! raz-30apr07
6905
6906 ! compute relative driving forces
6907       if(dum_hno3 .gt. 0.0)then
6908         df_gas_l(ihno3_g,ibin) = gas(ihno3_g) - sfc_a(ihno3_g)
6909         phi_volatile_l(ihno3_g,ibin)= df_gas_l(ihno3_g,ibin)/dum_hno3
6910       else
6911         phi_volatile_l(ihno3_g,ibin)= 0.0
6912       endif
6913
6914       if(dum_hcl .gt. 0.0)then
6915         df_gas_l(ihcl_g,ibin)  = gas(ihcl_g)  - sfc_a(ihcl_g)
6916         phi_volatile_l(ihcl_g,ibin)= df_gas_l(ihcl_g,ibin)/dum_hcl
6917       else
6918         phi_volatile_l(ihcl_g,ibin)= 0.0
6919       endif
6920
6921
6922       if(phi_volatile_l(ihno3_g,ibin) .le. rtol_eqb_astem .and. &
6923          phi_volatile_l(ihcl_g,ibin)  .le. rtol_eqb_astem)then
6924
6925         return
6926
6927       endif
6928
6929
6930
6931 ! compute Heff
6932       Heff(ihno3_g,ibin)=  &
6933           kel(ihno3_g,ibin)*gam(jhno3,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6934                        (water_a(ibin)*Keq_gl(3))
6935       integrate(ihno3_g,jliquid,ibin)= mYES
6936
6937
6938       Heff(ihcl_g,ibin)=  &
6939           kel(ihcl_g,ibin)*gam(jhcl,ibin)**2*mc(jc_h,ibin)*1.e-9/ &
6940                        (water_a(ibin)*Keq_gl(4))
6941       integrate(ihcl_g,jliquid,ibin) = mYES
6942
6943
6944       ieqblm_ASTEM = mNO
6945
6946
6947
6948       return
6949       end subroutine ASTEM_flux_wet_case4
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964 !===========================================================
6965 !
6966 ! DRY PARTICLES
6967 !
6968 !===========================================================
6969 !***********************************************************************
6970 ! part of ASTEM: computes gas-aerosol fluxes over dry aerosols
6971 !
6972 ! author: Rahul A. Zaveri
6973 ! update: dec 2006
6974 !-----------------------------------------------------------------------
6975       subroutine ASTEM_flux_dry(ibin)
6976 !      implicit none
6977 !      include 'mosaic.h'
6978 ! subr arguments
6979       integer ibin
6980 ! local variables
6981       integer iv
6982       real(kind=8) XT, prod_nh4no3, prod_nh4cl, volatile_cl
6983
6984
6985
6986
6987       call calculate_XT(ibin,jsolid,XT)
6988
6989 !-----------------------------------------------------------------
6990 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
6991
6992       if(electrolyte(jcaco3,jsolid,ibin) .gt. 0.0)then
6993
6994         call ASTEM_flux_dry_case1(ibin)
6995
6996         return
6997       endif
6998
6999 !-----------------------------------------------------------------
7000 ! CASE 2: Sulfate-Rich Domain
7001
7002       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
7003
7004         call ASTEM_flux_dry_case2(ibin)
7005
7006         return
7007       endif
7008
7009 !-------------------------------------------------------------------
7010 ! CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
7011
7012       volatile_cl  = electrolyte(jnacl,jsolid,ibin) + &
7013                      electrolyte(jcacl2,jsolid,ibin)
7014
7015
7016       if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
7017
7018         call ASTEM_flux_dry_case3a(ibin)
7019
7020         Keq_nh4cl_0  = min(Kp_nh4cl_0,  Keq_sg(2))      ! raz update 6/25/2008
7021
7022         prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_nh4cl_0), 0.0d0) +   &
7023                      electrolyte(jnh4cl, jsolid,ibin)   ! raz update 6/25/2008
7024
7025         if(prod_nh4cl .gt. 0.0)then
7026           call ASTEM_flux_dry_case3b(ibin)
7027         endif
7028
7029         return
7030       endif
7031
7032 !-----------------------------------------------------------------
7033 ! CASE 4: nh4no3 or nh4cl or both may be active
7034
7035       Keq_nh4no3_0 = min(Kp_nh4no3_0, Keq_sg(1))        ! raz update 6/25/2008
7036       Keq_nh4cl_0  = min(Kp_nh4cl_0,  Keq_sg(2))        ! raz update 6/25/2008
7037
7038       prod_nh4no3 = max( (gas(inh3_g)*gas(ihno3_g)-Keq_nh4no3_0), 0.0d0) +   &
7039                     electrolyte(jnh4no3,jsolid,ibin)    ! raz update 6/25/2008
7040       prod_nh4cl  = max( (gas(inh3_g)*gas(ihcl_g) -Keq_nh4cl_0), 0.0d0) +   &
7041                     electrolyte(jnh4cl, jsolid,ibin)    ! raz update 6/25/2008
7042
7043       if(prod_nh4no3 .gt. 0.0 .or. prod_nh4cl .gt. 0.0)then
7044         call ASTEM_flux_dry_case4(ibin)
7045         return
7046       endif
7047
7048 !-----------------------------------------------------------------
7049
7050       return
7051       end subroutine ASTEM_flux_dry
7052
7053 !----------------------------------------------------------------------
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067 !***********************************************************************
7068 ! part of ASTEM: subroutines for flux_dry cases
7069 !
7070 ! author: Rahul A. Zaveri
7071 ! update: dec 2006
7072 !-----------------------------------------------------------------------
7073
7074 ! CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
7075
7076       subroutine ASTEM_flux_dry_case1(ibin)
7077 !      implicit none
7078 !      include 'mosaic.h'
7079 ! subr arguments
7080       integer ibin
7081
7082
7083       if(gas(ihno3_g) .gt. 1.e-5)then
7084         sfc_a(ihno3_g) = 0.0
7085         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
7086         phi_volatile_s(ihno3_g,ibin) = 1.0
7087         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
7088         integrate(ihno3_g,jsolid,ibin) = mYES
7089         ieqblm_ASTEM = mNO
7090       endif
7091
7092       if(gas(ihcl_g) .gt. 1.e-5)then
7093         sfc_a(ihcl_g)  = 0.0
7094         df_gas_s(ihcl_g,ibin) = gas(ihcl_g)
7095         phi_volatile_s(ihcl_g,ibin) = 1.0
7096         flux_s(ihcl_g,ibin)  = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
7097         integrate(ihcl_g,jsolid,ibin)  = mYES
7098         ieqblm_ASTEM = mNO
7099       endif
7100
7101
7102       return
7103       end subroutine ASTEM_flux_dry_case1
7104
7105
7106
7107 !---------------------------------------------------------------------
7108 ! CASE 2: Sulfate-Rich Domain
7109
7110       subroutine ASTEM_flux_dry_case2(ibin) ! TOUCH
7111 !      implicit none
7112 !      include 'mosaic.h'
7113 ! subr arguments
7114       integer ibin
7115
7116
7117       if(gas(inh3_g).gt.1.e-5)then
7118         sfc_a(inh3_g) = 0.0
7119         df_gas_s(inh3_g,ibin) = gas(inh3_g)
7120         phi_volatile_s(inh3_g,ibin)  = 1.0
7121         flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*gas(inh3_g)
7122         integrate(inh3_g,jsolid,ibin) = mYES
7123         ieqblm_ASTEM = mNO
7124       endif
7125
7126
7127       return
7128       end subroutine ASTEM_flux_dry_case2
7129
7130
7131
7132
7133 !---------------------------------------------------------------------
7134 ! CASE 3a: degas hcl from nacl or cacl2 by flux_s balance with hno3
7135
7136       subroutine ASTEM_flux_dry_case3a(ibin)
7137 !      implicit none
7138 !      include 'mosaic.h'
7139 ! subr arguments
7140       integer ibin
7141
7142
7143       if(gas(ihno3_g) .gt. 1.e-5)then
7144         sfc_a(ihno3_g) = 0.0
7145         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
7146
7147         df_gas_s(ihno3_g,ibin) = gas(ihno3_g)
7148         df_gas_s(ihcl_g,ibin)  = -aer(icl_a,jsolid,ibin)
7149
7150         flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*gas(ihno3_g)
7151         flux_s(ihcl_g,ibin)  = -flux_s(ihno3_g,ibin)
7152
7153         phi_volatile_s(ihno3_g,ibin) = 1.0
7154         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)
7155
7156         integrate(ihno3_g,jsolid,ibin) = mYES
7157         integrate(ihcl_g,jsolid,ibin)  = mYES
7158
7159         idry_case3a(ibin) = mYES
7160         ieqblm_ASTEM = mNO
7161       endif
7162
7163       return
7164       end subroutine ASTEM_flux_dry_case3a
7165
7166
7167
7168
7169 !---------------------------------------------------------------------
7170 ! CASE 3b: nh4cl may form/evaporate here
7171
7172       subroutine ASTEM_flux_dry_case3b(ibin)    ! TOUCH
7173 !      implicit none
7174 !      include 'mosaic.h'
7175 ! subr arguments
7176       integer ibin
7177 ! local variables
7178       integer iactive_nh4cl, js ! raz update 11/13/2008
7179       real(kind=8) a, b, c, sum_dum     ! raz update 11/13/2008
7180 ! function
7181 !      real(kind=8) quadratic
7182
7183
7184 ! calculate percent composition ! raz update 11/13/2008
7185       sum_dum = 0.0
7186       do js = 1, nsalt
7187         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7188       enddo
7189
7190       if(sum_dum .eq. 0.)sum_dum = 1.0
7191
7192       epercent(jnh4cl,jsolid,ibin) = 100.*electrolyte(jnh4cl,jsolid,ibin)/sum_dum
7193
7194
7195
7196
7197 !-------------------
7198 ! set default values for flags
7199       iactive_nh4cl  = 1
7200
7201
7202 ! compute relative driving force
7203       phi_nh4cl_s = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7204                     max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7205
7206
7207 !-------------------
7208 ! now determine if nh4cl is active or significant
7209 ! nh4cl
7210       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
7211         iactive_nh4cl = 0
7212       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7213              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
7214         iactive_nh4cl = 0
7215         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
7216           call degas_solid_nh4cl(ibin)
7217         endif
7218       endif
7219
7220
7221 ! check the outcome
7222       if(iactive_nh4cl .eq. 0)return
7223
7224
7225 !-----------------
7226 ! nh4cl is active
7227
7228
7229       a =   kg(inh3_g,ibin)
7230       b = - kg(inh3_g,ibin)*gas(inh3_g) &
7231           + kg(ihcl_g,ibin)*gas(ihcl_g)
7232       c = -(kg(ihcl_g,ibin)*Keq_sg(2))
7233
7234       sfc_a(inh3_g) = quadratic(a,b,c)
7235       sfc_a(ihcl_g) = Keq_sg(2)/sfc_a(inh3_g)
7236
7237       df_gas_s(ihcl_g,ibin) = gas(ihcl_g) - sfc_a(ihcl_g)
7238       df_gas_s(inh3_g,ibin) = gas(inh3_g) - sfc_a(inh3_g)
7239
7240       flux_s(inh3_g,ibin) = kg(inh3_g,ibin)*df_gas_s(inh3_g,ibin)
7241       flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) + flux_s(inh3_g,ibin)
7242
7243       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
7244
7245       if(flux_s(ihcl_g,ibin) .gt. 0.0)then
7246         df_gas_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)     ! recompute df_gas
7247         phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
7248       else
7249         sfc_a(ihcl_g)  = gas(ihcl_g) + aer(icl_a,jsolid,ibin)
7250         df_gas_s(ihcl_g,ibin) = -aer(icl_a,jsolid,ibin)
7251         phi_volatile_s(ihcl_g,ibin)=df_gas_s(ihcl_g,ibin)/sfc_a(ihcl_g)  ! not to be used
7252       endif
7253
7254       integrate(inh3_g,jsolid,ibin) = mYES
7255       integrate(ihcl_g,jsolid,ibin) = mYES      ! integrate HCl with explicit euler
7256
7257       ieqblm_ASTEM = mNO
7258
7259       return
7260       end subroutine ASTEM_flux_dry_case3b
7261
7262
7263
7264
7265 !---------------------------------------------------------------------
7266 ! Case 4: NH4NO3 and/or NH4Cl may be active
7267
7268       subroutine ASTEM_flux_dry_case4(ibin)     ! TOUCH
7269 !      implicit none
7270 !      include 'mosaic.h'
7271 ! subr arguments
7272       integer ibin
7273 ! local variables
7274       integer iactive_nh4no3, iactive_nh4cl, iactive, js        ! raz update 11/13/2008
7275       real(kind=8) a, b, c, sum_dum                                     ! raz update 11/13/2008
7276 ! function
7277 !      real(kind=8) quadratic
7278
7279
7280
7281 ! calculate percent composition ! raz update 11/13/2008
7282       sum_dum = 0.0
7283       do js = 1, nsalt
7284         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7285       enddo
7286
7287       if(sum_dum .eq. 0.)sum_dum = 1.0
7288
7289       epercent(jnh4no3,jsolid,ibin) = 100.*electrolyte(jnh4no3,jsolid,ibin)/sum_dum
7290       epercent(jnh4cl, jsolid,ibin) = 100.*electrolyte(jnh4cl, jsolid,ibin)/sum_dum
7291
7292
7293
7294 !-------------------
7295 ! set default values for flags
7296       iactive_nh4no3 = 1
7297       iactive_nh4cl  = 2
7298
7299
7300 ! compute diagnostic products and ratios
7301       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
7302                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
7303       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7304                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7305
7306
7307 !-------------------
7308 ! now determine if nh4no3 and/or nh4cl are active or significant
7309
7310 ! nh4no3
7311       if( abs(phi_nh4no3_s) .lt. rtol_eqb_ASTEM )then
7312         iactive_nh4no3 = 0
7313       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
7314              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
7315         iactive_nh4no3 = 0
7316         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
7317           call degas_solid_nh4no3(ibin)
7318         endif
7319       endif
7320
7321 ! nh4cl
7322       if( abs(phi_nh4cl_s) .lt. rtol_eqb_ASTEM )then
7323         iactive_nh4cl = 0
7324       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7325              epercent(jnh4cl, jsolid,ibin) .le. ptol_mol_ASTEM)then
7326         iactive_nh4cl = 0
7327         if(epercent(jnh4cl, jsolid,ibin) .gt. 0.0)then
7328           call degas_solid_nh4cl(ibin)
7329         endif
7330       endif
7331
7332
7333       iactive = iactive_nh4no3 + iactive_nh4cl
7334
7335 ! check the outcome
7336       if(iactive .eq. 0)return
7337
7338
7339       goto (1,2,3),iactive
7340
7341 !---------------------------------
7342 ! only nh4no3 solid is active
7343 1     call ASTEM_flux_dry_case4a(ibin)
7344
7345       return
7346
7347
7348 !-----------------
7349 ! only nh4cl solid is active
7350 2     call ASTEM_flux_dry_case4b(ibin)
7351
7352       return
7353
7354
7355 !-----------------
7356 ! both nh4no3 and nh4cl are active
7357 3     call ASTEM_flux_dry_case4ab(ibin)
7358
7359
7360
7361
7362       return
7363       end subroutine ASTEM_flux_dry_case4
7364
7365
7366
7367
7368
7369
7370
7371 !---------------------------------------------------------------------
7372 ! Case 4a
7373
7374       subroutine ASTEM_flux_dry_case4a(ibin) ! NH4NO3 solid
7375 !      implicit none
7376 !      include 'mosaic.h'
7377 ! subr arguments
7378       integer ibin
7379 ! local variables
7380       real(kind=8) a, b, c
7381 ! function
7382 !      real(kind=8) quadratic
7383
7384
7385
7386       a =   kg(inh3_g,ibin)
7387       b = - kg(inh3_g,ibin)*gas(inh3_g)  &
7388           + kg(ihno3_g,ibin)*gas(ihno3_g)
7389       c = -(kg(ihno3_g,ibin)*Keq_nh4no3_0)      ! raz update 6/25/2008
7390
7391       sfc_a(inh3_g)  = quadratic(a,b,c)
7392       sfc_a(ihno3_g) = Keq_nh4no3_0/sfc_a(inh3_g) ! raz update 6/25/2008
7393
7394       integrate(ihno3_g,jsolid,ibin) = mYES
7395       integrate(inh3_g,jsolid,ibin)  = mYES
7396
7397       df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
7398       df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
7399
7400       phi_volatile_s(ihno3_g,ibin)= phi_nh4no3_s
7401       phi_volatile_s(inh3_g,ibin) = phi_nh4no3_s
7402
7403       flux_s(ihno3_g,ibin) = kg(ihno3_g,ibin)*df_gas_s(ihno3_g,ibin)
7404       flux_s(inh3_g,ibin)  = flux_s(ihno3_g,ibin)
7405
7406       ieqblm_ASTEM = mNO
7407
7408       return
7409       end subroutine ASTEM_flux_dry_case4a
7410
7411
7412
7413
7414 !---------------------------------------------------------
7415 ! Case 4b
7416
7417       subroutine ASTEM_flux_dry_case4b(ibin) ! NH4Cl solid
7418 !      implicit none
7419 !      include 'mosaic.h'
7420 ! subr arguments
7421       integer ibin
7422 ! local variables
7423       real(kind=8) a, b, c
7424 ! function
7425 !      real(kind=8) quadratic
7426
7427
7428       a =   kg(inh3_g,ibin)
7429       b = - kg(inh3_g,ibin)*gas(inh3_g) &
7430           + kg(ihcl_g,ibin)*gas(ihcl_g)
7431       c = -(kg(ihcl_g,ibin)*Keq_nh4cl_0)        ! raz update 6/25/2008
7432
7433       sfc_a(inh3_g) = quadratic(a,b,c)
7434       sfc_a(ihcl_g) = Keq_nh4cl_0 /sfc_a(inh3_g)        ! raz update 6/25/2008
7435
7436       integrate(ihcl_g,jsolid,ibin) = mYES
7437       integrate(inh3_g,jsolid,ibin) = mYES
7438
7439       df_gas_s(ihcl_g,ibin) = gas(ihcl_g)-sfc_a(ihcl_g)
7440       df_gas_s(inh3_g,ibin) = gas(inh3_g)-sfc_a(inh3_g)
7441
7442       phi_volatile_s(ihcl_g,ibin) = phi_nh4cl_s
7443       phi_volatile_s(inh3_g,ibin) = phi_nh4cl_s
7444
7445       flux_s(ihcl_g,ibin) = kg(ihcl_g,ibin)*df_gas_s(ihcl_g,ibin)
7446       flux_s(inh3_g,ibin) = flux_s(ihcl_g,ibin)
7447
7448       ieqblm_ASTEM = mNO
7449
7450       return
7451       end subroutine ASTEM_flux_dry_case4b
7452
7453
7454
7455
7456 !-------------------------------------------------------------------
7457 ! Case 4ab
7458
7459       subroutine ASTEM_flux_dry_case4ab(ibin)   ! NH4NO3 + NH4Cl (solid)
7460 !      implicit none
7461 !      include 'mosaic.h'
7462 ! subr arguments
7463       integer ibin
7464 ! local variables
7465       real(kind=8) a, b, c, &
7466            flux_nh3_est, flux_nh3_max, ratio_flux
7467 ! function
7468 !      real(kind=8) quadratic
7469
7470       call ASTEM_flux_dry_case4a(ibin)
7471       call ASTEM_flux_dry_case4b(ibin)
7472
7473
7474 ! estimate nh3 flux and adjust hno3 and/or hcl if necessary
7475
7476       flux_nh3_est = flux_s(ihno3_g,ibin)+flux_s(ihcl_g,ibin)
7477       flux_nh3_max = kg(inh3_g,ibin)*gas(inh3_g)
7478
7479
7480       if(flux_nh3_est .le. flux_nh3_max)then
7481
7482         flux_s(inh3_g,ibin) = flux_nh3_est                      ! all ok - no adjustments needed
7483         sfc_a(inh3_g)       = gas(inh3_g) -  &                  ! recompute sfc_a(ihno3_g)
7484                               flux_s(inh3_g,ibin)/kg(inh3_g,ibin)
7485         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
7486                                           abs(phi_nh4cl_s))
7487
7488       else                      ! reduce hno3 and hcl flux_ses as necessary so that nh3 flux_s = flux_s_nh3_max
7489
7490         ratio_flux          = flux_nh3_max/flux_nh3_est
7491         flux_s(inh3_g,ibin) = flux_nh3_max
7492         flux_s(ihno3_g,ibin)= flux_s(ihno3_g,ibin)*ratio_flux
7493         flux_s(ihcl_g,ibin) = flux_s(ihcl_g,ibin) *ratio_flux
7494
7495         sfc_a(inh3_g) = 0.0
7496         sfc_a(ihno3_g)= gas(ihno3_g) -  &       ! recompute sfc_a(ihno3_g)
7497                         flux_s(ihno3_g,ibin)/kg(ihno3_g,ibin)
7498         sfc_a(ihcl_g) = gas(ihcl_g) -   &       ! recompute sfc_a(ihcl_g)
7499                         flux_s(ihcl_g,ibin)/kg(ihcl_g,ibin)
7500
7501         df_gas_s(inh3_g,ibin) =gas(inh3_g) -sfc_a(inh3_g)
7502         df_gas_s(ihno3_g,ibin)=gas(ihno3_g)-sfc_a(ihno3_g)
7503         df_gas_s(ihcl_g,ibin) =gas(ihcl_g) -sfc_a(ihcl_g)
7504
7505         phi_volatile_s(inh3_g,ibin) = max(abs(phi_nh4no3_s), &
7506                                           abs(phi_nh4cl_s))
7507
7508       endif
7509
7510       ieqblm_ASTEM = mNO
7511
7512       return
7513       end subroutine ASTEM_flux_dry_case4ab
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525 !=======================================================================
7526 !
7527 ! MIXED-PHASE PARTICLES
7528 !
7529 !***********************************************************************
7530 ! part of ASTEM: computes gas-aerosol fluxes over mixed-phase aerosols
7531 !
7532 ! author: Rahul A. Zaveri
7533 ! update: apr 2006
7534 !-----------------------------------------------------------------------
7535
7536       subroutine ASTEM_flux_mix(ibin)
7537       use module_data_mosaic_other, only:  lunerr
7538 !      implicit none
7539 !      include 'mosaic.h'
7540 ! subr arguments
7541       integer ibin
7542 ! local variables
7543       integer iv, iadjust, iadjust_intermed, js         ! raz update 11/13/2008
7544       real(kind=8) XT, g_nh3_hno3, g_nh3_hcl, &
7545            a_nh4_no3, a_nh4_cl, a_no3, a_cl, &
7546            prod_nh4no3, prod_nh4cl
7547       real(kind=8) volatile_cl, sum_dum                 ! raz update 11/13/2008
7548
7549
7550       call ions_to_electrolytes(jliquid,ibin,XT)        ! for water content calculation
7551       call compute_activities(ibin)
7552
7553       if(water_a(ibin) .eq. 0.0)then
7554         write(6,*)'Water is zero in liquid phase'
7555         call peg_error_fatal( lunerr, "Stopping in ASTEM_flux_wet" )
7556       endif
7557
7558
7559
7560 ! calculate percent composition ! raz update 11/13/2008
7561       sum_dum = 0.0
7562       do js = 1, nsalt
7563         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7564       enddo
7565
7566       if(sum_dum .eq. 0.)sum_dum = 1.0
7567
7568       epercent(jcaco3,jsolid,ibin) = 100.*electrolyte(jcaco3,jsolid,ibin)/sum_dum
7569
7570
7571 ! reset
7572         Keq_nh4no3_0 = Keq_sg(1)        ! raz update 6/25/2008
7573         Keq_nh4cl_0  = Keq_sg(2)        ! raz update 6/25/2008
7574
7575 !-----------------------------------------------------------------
7576 ! MIXED CASE 1:  caco3 > 0 absorb all acids (and indirectly degas co2)
7577
7578       if(epercent(jcaco3,jsolid,ibin) .gt. 0.0)then
7579         jphase(ibin) = jliquid
7580         call ASTEM_flux_wet_case1(ibin)
7581         return
7582       endif
7583
7584 !-----------------------------------------------------------------
7585 ! MIXED CASE 2: Sulfate-Rich Domain
7586
7587       if(XT.lt.1.9999 .and. XT.ge.0.)then       ! excess sulfate (acidic)
7588         jphase(ibin) = jliquid
7589         call ASTEM_flux_wet_case2(ibin)
7590         return
7591       endif
7592
7593 !-------------------------------------------------------------------
7594 ! MIXED CASE 3: hno3 and hcl exchange may happen here and nh4cl may form/evaporate
7595
7596       volatile_cl  = electrolyte(jnacl,jsolid,ibin) +   &
7597                      electrolyte(jcacl2,jsolid,ibin)
7598
7599
7600       if(volatile_cl .gt. 0.0 .and. gas(ihno3_g).gt. 0.0 )then
7601
7602         call ASTEM_flux_dry_case3a(ibin)
7603
7604         prod_nh4cl = max( (gas(inh3_g)*gas(ihcl_g)-Keq_sg(2)), 0.0d0) +   &
7605                      electrolyte(jnh4cl, jsolid,ibin)
7606
7607         if(prod_nh4cl .gt. 0.0)then
7608           call ASTEM_flux_dry_case3b(ibin)
7609         endif
7610
7611         jphase(ibin) = jsolid
7612
7613         return
7614       endif
7615
7616 !-------------------------------------------------------------------
7617 ! MIXED CASE 4: nh4no3 or nh4cl or both may be active
7618
7619       if( electrolyte(jnh4no3,jsolid,ibin).gt.0. .and. &
7620           electrolyte(jnh4cl,jsolid,ibin) .gt.0. )then
7621         jphase(ibin) = jsolid
7622         call ASTEM_flux_dry_case4(ibin)
7623
7624         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7625           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7626           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7627         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7628           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7629           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7630         else
7631           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7632         endif
7633
7634         return
7635
7636       elseif( electrolyte(jnh4no3,jsolid,ibin).gt.0. )then
7637 ! do small adjustments for nh4cl aq
7638         g_nh3_hcl= gas(inh3_g)*gas(ihcl_g)
7639         a_nh4_cl = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
7640
7641         iadjust = mNO           ! initialize
7642         if(g_nh3_hcl .gt. 0.0 .and. a_nh4_cl .eq. 0.0)then
7643           call absorb_tiny_nh4cl(ibin)
7644           iadjust = mYES
7645         elseif(g_nh3_hcl .eq. 0.0 .and. a_nh4_cl .gt. 0.0)then
7646           call degas_tiny_nh4cl(ibin)
7647           iadjust = mYES
7648         endif
7649
7650         if(iadjust .eq. mYES)then
7651           call ions_to_electrolytes(jliquid,ibin,XT)  ! update after adjustments
7652           call compute_activities(ibin)                 ! update after adjustments
7653         endif
7654
7655         call ASTEM_flux_mix_case4a(ibin)        ! nh4no3 solid + nh4cl aq
7656         jphase(ibin) = jtotal
7657         return
7658
7659       elseif( electrolyte(jnh4cl,jsolid,ibin).gt.0.)then
7660 ! do small adjustments for nh4no3 aq
7661         g_nh3_hno3= gas(inh3_g)*gas(ihno3_g)
7662         a_nh4_no3 = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
7663
7664         iadjust = mNO           ! initialize
7665         if(g_nh3_hno3 .gt. 0.0 .and. a_nh4_no3 .eq. 0.0)then
7666           call absorb_tiny_nh4no3(ibin)
7667           iadjust = mYES
7668         elseif(g_nh3_hno3 .eq. 0.0 .and. a_nh4_no3 .gt. 0.0)then
7669           call degas_tiny_nh4no3(ibin)
7670           iadjust = mYES
7671         endif
7672
7673         if(iadjust .eq. mYES)then
7674           call ions_to_electrolytes(jliquid,ibin,XT)    ! update after adjustments
7675           call compute_activities(ibin)                 ! update after adjustments
7676         endif
7677
7678         kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7679         Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3     ! = [NH3]s * [HNO3]s
7680
7681         call ASTEM_flux_mix_case4b(ibin)        ! nh4cl solid + nh4no3 aq
7682         jphase(ibin) = jtotal
7683         return
7684       endif
7685
7686
7687 !-------------------------------------------------------------------
7688
7689       if( (gas(inh3_g)+aer(inh4_a,jliquid,ibin)) .lt. 1.e-25)goto 10  ! no ammonia in the system
7690
7691 !-------------------------------------------------------------------
7692 ! MIXED CASE 5: liquid nh4no3 and/or nh4cl maybe active
7693 ! do some small adjustments (if needed) before deciding case 3
7694
7695       iadjust = mNO             ! default
7696       iadjust_intermed = mNO    ! default
7697
7698 ! nh4no3
7699       g_nh3_hno3 = gas(inh3_g)*gas(ihno3_g)
7700       a_nh4_no3  = aer(inh4_a,jliquid,ibin)*aer(ino3_a,jliquid,ibin)
7701
7702       if(g_nh3_hno3 .gt. 0. .and. a_nh4_no3 .eq. 0.)then
7703         call absorb_tiny_nh4no3(ibin)
7704         iadjust = mYES
7705         iadjust_intermed = mYES
7706       endif
7707
7708       if(iadjust_intermed .eq. mYES)then
7709         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7710         iadjust_intermed = mNO  ! reset
7711       endif
7712
7713 ! nh4cl
7714       g_nh3_hcl = gas(inh3_g)*gas(ihcl_g)
7715       a_nh4_cl  = aer(inh4_a,jliquid,ibin)*aer(icl_a,jliquid,ibin)
7716
7717       if(g_nh3_hcl .gt. 0. .and. a_nh4_cl .eq. 0.)then
7718         call absorb_tiny_nh4cl(ibin)
7719         iadjust = mYES
7720         iadjust_intermed = mYES
7721       endif
7722
7723       if(iadjust_intermed .eq. mYES)then
7724         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7725       endif
7726
7727       if(iadjust .eq. mYES)then
7728         call compute_activities(ibin)                   ! update after adjustments
7729       endif
7730
7731
7732 ! all adjustments done...
7733
7734 !--------
7735       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7736       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
7737
7738       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
7739       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
7740
7741       call ASTEM_flux_wet_case3(ibin)
7742       jphase(ibin) = jliquid
7743
7744       return
7745
7746
7747 !-------------------------------------------------------------------
7748 ! MIXED CASE 6: ammonia = 0. liquid hno3 and hcl exchange may happen here
7749 ! do small adjustments (if needed) before deciding case 4
7750
7751 10    iadjust = mNO             ! default
7752       iadjust_intermed = mNO    ! default
7753
7754 ! hno3
7755       if(gas(ihno3_g).gt.0. .and. aer(ino3_a,jliquid,ibin).eq.0. .and.   &
7756          aer(icl_a,jliquid,ibin) .gt. 0.0)then
7757         call absorb_tiny_hno3(ibin)     ! and degas tiny hcl
7758         iadjust = mYES
7759         iadjust_intermed = mYES
7760       endif
7761
7762       if(iadjust_intermed .eq. mYES)then
7763         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7764         iadjust_intermed = mNO  ! reset
7765       endif
7766
7767 ! hcl
7768       if(gas(ihcl_g).gt.0. .and. aer(icl_a,jliquid,ibin) .eq. 0. .and.   &
7769          aer(ino3_a,jliquid,ibin) .gt. 0.0)then
7770         call absorb_tiny_hcl(ibin)                      ! and degas tiny hno3
7771         iadjust = mYES
7772         iadjust_intermed = mYES
7773       endif
7774
7775       if(iadjust_intermed .eq. mYES)then
7776         call ions_to_electrolytes(jliquid,ibin,XT)      ! update after adjustments
7777       endif
7778
7779       if(iadjust .eq. mYES)then
7780         call compute_activities(ibin)                   ! update after adjustments
7781       endif
7782
7783 ! all adjustments done...
7784
7785       call ASTEM_flux_wet_case4(ibin)
7786       jphase(ibin) = jliquid
7787
7788
7789
7790       return
7791       end subroutine ASTEM_flux_mix
7792
7793 !----------------------------------------------------------------------
7794
7795
7796
7797
7798
7799
7800
7801
7802 !------------------------------------------------------------------
7803 ! Mix Case 4a: NH4NO3 solid maybe active. NH4Cl aq maybe active
7804
7805       subroutine ASTEM_flux_mix_case4a(ibin)    ! TOUCH
7806 !      implicit none
7807 !      include 'mosaic.h'
7808 ! subr arguments
7809       integer ibin
7810 ! local variables
7811       integer iactive_nh4no3, iactive_nh4cl, js ! raz update 11/13/2008
7812       real(kind=8) sum_dum                              ! raz update 11/13/2008
7813
7814
7815 ! set default values for flags
7816       iactive_nh4no3 = mYES
7817       iactive_nh4cl  = mYES
7818
7819
7820 ! calculate percent composition ! raz update 11/13/2008
7821       sum_dum = 0.0
7822       do js = 1, nsalt
7823         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7824       enddo
7825
7826       if(sum_dum .eq. 0.)sum_dum = 1.0
7827
7828       epercent(jnh4no3,jsolid,ibin) = 100.*electrolyte(jnh4no3,jsolid,ibin)/sum_dum
7829
7830
7831
7832 ! nh4no3 (solid)
7833       phi_nh4no3_s = (gas(inh3_g)*gas(ihno3_g) - Keq_sg(1))/ &
7834                      max(gas(inh3_g)*gas(ihno3_g),Keq_sg(1))
7835
7836 ! nh4cl (liquid)
7837       kelvin_nh4cl = kel(inh3_g,ibin)*kel(ihcl_g,ibin)
7838       Keq_nh4cl = kelvin_nh4cl*activity(jnh4cl,ibin)*Kp_nh4cl   ! = [NH3]s * [HCl]s
7839
7840
7841 !-------------------
7842 ! now determine if nh4no3 and/or nh4cl are active or significant
7843 ! nh4no3 solid
7844       if( abs(phi_nh4no3_s) .le. rtol_eqb_ASTEM )then
7845         iactive_nh4no3 = mNO
7846       elseif(gas(inh3_g)*gas(ihno3_g) .lt. Keq_sg(1) .and. &
7847              epercent(jnh4no3,jsolid,ibin) .le. ptol_mol_ASTEM)then
7848         iactive_nh4no3 = mNO
7849         if(epercent(jnh4no3,jsolid,ibin) .gt. 0.0)then
7850           call degas_solid_nh4no3(ibin)
7851         endif
7852       endif
7853
7854 ! nh4cl aq
7855       if( gas(inh3_g)*gas(ihcl_g).eq.0. .or. Keq_nh4cl.eq.0. )then
7856         iactive_nh4cl = mNO
7857       endif
7858
7859
7860 !---------------------------------
7861       if(iactive_nh4no3 .eq. mYES)then
7862
7863         jphase(ibin) = jsolid
7864         call ASTEM_flux_dry_case4a(ibin)        ! NH4NO3 (solid)
7865
7866         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7867           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7868           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7869         elseif(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7870           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7871           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7872         else
7873           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7874         endif
7875
7876       endif
7877
7878
7879       if(iactive_nh4cl .eq. mYES)then
7880
7881         jphase(ibin) = jliquid
7882         call ASTEM_flux_wet_case3b(ibin)        ! NH4Cl (liquid)
7883
7884         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7885           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7886           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7887         else
7888           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7889         endif
7890
7891       endif
7892
7893
7894       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
7895         jphase(ibin) = jtotal
7896       endif
7897
7898
7899
7900       return
7901       end subroutine ASTEM_flux_mix_case4a
7902
7903
7904
7905
7906
7907
7908
7909
7910 !------------------------------------------------------------------
7911 ! Mix Case 4b: NH4Cl solid maybe active. NH4NO3 aq may or maybe active
7912
7913       subroutine ASTEM_flux_mix_case4b(ibin)    ! TOUCH
7914 !      implicit none
7915 !      include 'mosaic.h'
7916 ! subr arguments
7917       integer ibin
7918 ! local variables
7919       integer iactive_nh4no3, iactive_nh4cl, js ! raz update 11/13/2008
7920         real(kind=8) sum_dum                            ! raz update 11/13/2008
7921
7922
7923 ! set default values for flags
7924       iactive_nh4cl  = mYES
7925       iactive_nh4no3 = mYES
7926
7927
7928 ! calculate percent composition ! raz update 11/13/2008
7929       sum_dum = 0.0
7930       do js = 1, nsalt
7931         sum_dum = sum_dum + electrolyte(js,jsolid,ibin)
7932       enddo
7933
7934       if(sum_dum .eq. 0.)sum_dum = 1.0
7935
7936       epercent(jnh4cl,jsolid,ibin) = 100.*electrolyte(jnh4cl,jsolid,ibin)/sum_dum
7937
7938
7939
7940 ! nh4cl (solid)
7941       phi_nh4cl_s  = (gas(inh3_g)*gas(ihcl_g) - Keq_sg(2))/ &
7942                      max(gas(inh3_g)*gas(ihcl_g),Keq_sg(2))
7943
7944 ! nh4no3 (liquid)
7945       kelvin_nh4no3 = kel(inh3_g,ibin)*kel(ihno3_g,ibin)
7946       Keq_nh4no3 = kelvin_nh4no3*activity(jnh4no3,ibin)*Kp_nh4no3       ! = [NH3]s * [HNO3]s
7947
7948
7949 !-------------------
7950 ! now determine if nh4no3 and/or nh4cl are active or significant
7951 ! nh4cl (solid)
7952       if( abs(phi_nh4cl_s) .le. rtol_eqb_ASTEM )then
7953         iactive_nh4cl = mNO
7954       elseif(gas(inh3_g)*gas(ihcl_g) .lt. Keq_sg(2) .and. &
7955              epercent(jnh4cl,jsolid,ibin) .le. ptol_mol_ASTEM)then
7956         iactive_nh4cl = mNO
7957         if(epercent(jnh4cl,jsolid,ibin) .gt. 0.0)then
7958           call degas_solid_nh4cl(ibin)
7959         endif
7960       endif
7961
7962 ! nh4no3 (liquid)
7963       if( gas(inh3_g)*gas(ihno3_g).eq.0. .or. Keq_nh4no3.eq.0. )then
7964         iactive_nh4no3 = mNO
7965       endif
7966
7967
7968 !---------------------------------
7969       if(iactive_nh4cl .eq. mYES)then
7970
7971         jphase(ibin) = jsolid
7972         call ASTEM_flux_dry_case4b(ibin)        ! NH4Cl (solid)
7973
7974         if(sfc_a(ihcl_g).gt.0.0 .and. ma(ja_cl,ibin).gt.0.0)then
7975           mc(jc_h,ibin) = Keq_gl(4)*sfc_a(ihcl_g)/ &
7976           (kel(ihcl_g,ibin)*gam(jhcl,ibin)**2 * ma(ja_cl,ibin))
7977         elseif(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7978           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7979           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7980         else
7981           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7982         endif
7983
7984       endif
7985
7986
7987       if(iactive_nh4no3 .eq. mYES)then
7988
7989         jphase(ibin) = jliquid
7990         call ASTEM_flux_wet_case3a(ibin)        ! NH4NO3 (liquid)
7991
7992         if(sfc_a(ihno3_g).gt.0.0 .and. ma(ja_no3,ibin).gt.0.0)then
7993           mc(jc_h,ibin) = Keq_gl(3)*sfc_a(ihno3_g)/ &
7994           (kel(ihno3_g,ibin)*gam(jhno3,ibin)**2 * ma(ja_no3,ibin))
7995         else
7996           mc(jc_h,ibin) = sqrt(Keq_ll(3))
7997         endif
7998
7999       endif
8000
8001
8002       if(iactive_nh4cl .eq. mYES .and. iactive_nh4no3 .eq. mYES)then
8003         jphase(ibin) = jtotal
8004       endif
8005
8006
8007
8008       return
8009       end subroutine ASTEM_flux_mix_case4b
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021 !***********************************************************************
8022 ! part of ASTEM: condenses h2so4, msa, and nh3 analytically over dtchem [s]
8023 !
8024 ! author: Rahul A. Zaveri
8025 ! update: jan 2007
8026 !-----------------------------------------------------------------------
8027
8028       subroutine ASTEM_non_volatiles(dtchem) ! TOUCH
8029 !      implicit none
8030 !      include 'mosaic.h'
8031 ! subr arguments
8032       real(kind=8) dtchem
8033 ! local variables
8034       integer ibin, iupdate_phase_state
8035       real(kind=8) decay_h2so4, decay_msa,   &
8036            delta_h2so4, delta_tmsa, delta_nh3, delta_hno3, delta_hcl, &
8037            delta_so4(nbin_a), delta_msa(nbin_a), &
8038            delta_nh4(nbin_a)
8039                 ! DL (10/7/2012) - move N2O5 het uptake into non-volatile subroutine, so that
8040                 !                       NH3 uptake to balance acid uptake takes place too
8041       real(kind=8) :: decay_n2o5,   &
8042            delta_n2o5, delta_clno2, &
8043            delta_no3_rct1(nbin_a), delta_no3_rct2(nbin_a)
8044       real(kind=8) XT
8045
8046
8047
8048
8049       sumkg_h2so4 = 0.0
8050       sumkg_msa   = 0.0
8051       sumkg_nh3   = 0.0
8052       sumkg_hno3  = 0.0
8053       sumkg_hcl   = 0.0
8054       do ibin = 1, nbin_a
8055         sumkg_h2so4 = sumkg_h2so4 + kg(ih2so4_g,ibin)
8056         sumkg_msa   = sumkg_msa   + kg(imsa_g,ibin)
8057         sumkg_nh3   = sumkg_nh3   + kg(inh3_g,ibin)
8058         sumkg_hno3  = sumkg_hno3  + kg(ihno3_g,ibin)
8059         sumkg_hcl   = sumkg_hcl   + kg(ihcl_g,ibin)
8060       enddo
8061                 ! DL (10/7/2012)
8062       sumkg_n2o5  = 0.0
8063       do ibin = 1, nbin_a
8064         sumkg_n2o5 = sumkg_n2o5 + kg(in2o5_g,ibin)
8065       enddo
8066
8067
8068
8069 !--------------------------------------
8070 ! H2SO4
8071       if(gas(ih2so4_g) .gt. 1.e-14)then
8072
8073 ! integrate h2so4 condensation analytically
8074         decay_h2so4   = exp(-sumkg_h2so4*dtchem)
8075         delta_h2so4   = gas(ih2so4_g)*(1.0 - decay_h2so4)
8076         gas(ih2so4_g) = gas(ih2so4_g)*decay_h2so4
8077
8078
8079 ! now distribute delta_h2so4 to each bin and conform the particle (may degas by massbal)
8080         do ibin = 1, nbin_a
8081           if(jaerosolstate(ibin) .ne. no_aerosol)then
8082             delta_so4(ibin) = delta_h2so4*kg(ih2so4_g,ibin)/sumkg_h2so4
8083             aer(iso4_a,jtotal,ibin) = aer(iso4_a,jtotal,ibin) + &
8084                                       delta_so4(ibin)
8085           endif
8086         enddo
8087
8088       else
8089
8090         delta_h2so4 = 0.0
8091         do ibin = 1, nbin_a
8092             delta_so4(ibin) = 0.0
8093         enddo
8094
8095       endif
8096 ! h2so4 condensation is now complete
8097 !--------------------------------------
8098
8099
8100
8101 ! MSA
8102       if(gas(imsa_g) .gt. 1.e-14)then
8103
8104 ! integrate msa condensation analytically
8105         decay_msa   = exp(-sumkg_msa*dtchem)
8106         delta_tmsa  = gas(imsa_g)*(1.0 - decay_msa)
8107         gas(imsa_g) = gas(imsa_g)*decay_msa
8108
8109 ! now distribute delta_msa to each bin and conform the particle (may degas by massbal)
8110         do ibin = 1, nbin_a
8111           if(jaerosolstate(ibin) .ne. no_aerosol)then
8112             delta_msa(ibin) = delta_tmsa*kg(imsa_g,ibin)/sumkg_msa
8113             aer(imsa_a,jtotal,ibin) = aer(imsa_a,jtotal,ibin) + &
8114                                       delta_msa(ibin)
8115           endif
8116         enddo
8117
8118       else
8119
8120         delta_tmsa = 0.0
8121         do ibin = 1, nbin_a
8122             delta_msa(ibin) = 0.0
8123         enddo
8124
8125       endif
8126 ! msa condensation is now complete
8127 !-------------------------------------
8128
8129
8130
8131         if(n2o5_flag .gt. 0) then
8132                 ! DL (10/7/2012) moved from separate subroutine into involatile subroutine
8133                 !--------------------------------------
8134                 ! N2O5 uptake, if there is enough gas, and uptake is non-zero
8135                 !  (currently we only calculate uptake for aqueous particles,
8136                 !    so in some circumstances we could have aerosol but no reaction)
8137                 if(gas(in2o5_g) .gt. 1.e-14 .and. sumkg_n2o5 .gt. 0.0)then
8138
8139                         ! integrate n2o5 condensation analytically
8140                         decay_n2o5   = exp(-sumkg_n2o5*dtchem)
8141                         delta_n2o5   = gas(in2o5_g)*(1.0 - decay_n2o5)
8142                         gas(in2o5_g) = gas(in2o5_g)*decay_n2o5
8143
8144
8145                         ! now distribute delta_n2o5 to each bin and conform the particle (may degas by massbal)
8146                         do ibin = 1, nbin_a
8147                                 if(jaerosolstate(ibin) .ne. no_aerosol)then
8148                                         delta_no3_rct1(ibin) = delta_n2o5*frac_n2o5_h2o(ibin)*kg(in2o5_g,ibin)/sumkg_n2o5
8149                                         delta_no3_rct2(ibin) = delta_n2o5*(1.0-frac_n2o5_h2o(ibin))*kg(in2o5_g,ibin)/sumkg_n2o5
8150
8151                                         aer(ino3_a,jtotal,ibin) = aer(ino3_a,jtotal,ibin) + &
8152                                                                                   (2.0*delta_no3_rct1(ibin)+delta_no3_rct2(ibin))
8153                                         ! check to ensure we don't get negative Cl- concentrations
8154                                         ! - if this will occur then branch the remaining N2O5 to reaction 1
8155                                         if(aer(icl_a,jtotal,ibin).ge.delta_no3_rct2(ibin))then
8156                                                 aer(icl_a,jtotal,ibin)  = aer(icl_a,jtotal,ibin) - &
8157                                                                                                   delta_no3_rct2(ibin)
8158                                                 gas(iclno2_g)           = gas(iclno2_g) + &
8159                                                                                                   delta_no3_rct2(ibin)
8160                                         else
8161                                                 aer(ino3_a,jtotal,ibin) = aer(ino3_a,jtotal,ibin) + &
8162                                                                                                   (delta_no3_rct2(ibin)-aer(icl_a,jtotal,ibin))
8163                                                 gas(iclno2_g)           = gas(iclno2_g) + &
8164                                                                                                   aer(icl_a,jtotal,ibin)
8165
8166                                                 ! record the amount of remaining N2O5 which branches to reaction 1 (this is
8167                                                 ! for the purposes of determining NH3 uptake later)
8168                                                 delta_no3_rct1(ibin) = delta_no3_rct1(ibin) + (delta_no3_rct2(ibin)-aer(icl_a,jtotal,ibin))
8169                                                 delta_no3_rct2(ibin) = aer(icl_a,jtotal,ibin)
8170
8171                                                 aer(icl_a,jtotal,ibin)  = 0.0
8172                                         endif
8173                                 endif
8174                         enddo
8175
8176                 else
8177
8178                         delta_n2o5 = 0.0
8179                         do ibin = 1, nbin_a
8180                                 delta_no3_rct1(ibin) = 0.0
8181                                 delta_no3_rct2(ibin) = 0.0
8182                         enddo
8183
8184                 endif
8185         else
8186                 delta_n2o5 = 0.0        ! if we're not using the N2O5 het scheme then set these to zero for ion balance calculations below
8187                 do ibin = 1, nbin_a
8188                         delta_no3_rct1(ibin) = 0.0
8189                         delta_no3_rct2(ibin) = 0.0
8190                 enddo
8191         endif
8192
8193
8194
8195
8196 ! compute max allowable nh3, hno3, and hcl condensation
8197       delta_nh3 = gas(inh3_g) *(1.0 - exp(-sumkg_nh3*dtchem))
8198       delta_hno3= gas(ihno3_g)*(1.0 - exp(-sumkg_hno3*dtchem))
8199       delta_hcl = gas(ihcl_g) *(1.0 - exp(-sumkg_hcl*dtchem))
8200
8201 ! compute max possible nh4 condensation for each bin
8202       do ibin = 1, nbin_a
8203         if(jaerosolstate(ibin) .ne. no_aerosol)then
8204           delta_nh3_max(ibin) = delta_nh3*kg(inh3_g,ibin)/sumkg_nh3
8205           delta_hno3_max(ibin)= delta_hno3*kg(ihno3_g,ibin)/sumkg_hno3
8206           delta_hcl_max(ibin) = delta_hcl*kg(ihcl_g,ibin)/sumkg_hcl
8207         endif
8208       enddo
8209
8210
8211       if(delta_h2so4 .eq. 0.0 .and. delta_tmsa .eq. 0.0 .and. delta_n2o5 .eq. 0.0)then
8212         iupdate_phase_state = mNO
8213         goto 100
8214       endif
8215
8216
8217 ! now condense appropriate amounts of nh3 to each bin
8218       do ibin = 1, nbin_a
8219
8220         if(epercent(jnacl,jtotal,ibin)  .eq. 0.0 .and. &
8221            epercent(jcacl2,jtotal,ibin) .eq. 0.0 .and. &
8222            epercent(jnano3,jtotal,ibin) .eq. 0.0 .and. &
8223            epercent(jcano3,jtotal,ibin) .eq. 0.0 .and. &
8224            epercent(jcaco3,jtotal,ibin) .eq. 0.0 .and. &
8225            jaerosolstate(ibin) .ne. no_aerosol)then
8226
8227           delta_nh4(ibin)=min( (2.*delta_so4(ibin)+delta_msa(ibin)+2.*delta_no3_rct1(ibin)+delta_no3_rct2(ibin)), &
8228                                 delta_nh3_max(ibin) )
8229
8230           aer(inh4_a,jtotal,ibin) = aer(inh4_a,jtotal,ibin) +        &  ! update aer-phase
8231                                     delta_nh4(ibin)
8232
8233           gas(inh3_g) = gas(inh3_g) - delta_nh4(ibin)           ! update gas-phase
8234
8235         else
8236
8237           delta_nh4(ibin) = 0.0
8238
8239         endif
8240
8241       enddo
8242
8243       iupdate_phase_state = mYES
8244
8245
8246 ! recompute phase equilibrium
8247 100   if(iupdate_phase_state .eq. mYES)then
8248         do ibin = 1, nbin_a
8249           if(jaerosolstate(ibin) .ne. no_aerosol)then
8250             call conform_electrolytes(jtotal,ibin,XT)
8251             call aerosol_phase_state(ibin)
8252           endif
8253         enddo
8254       endif
8255
8256       return
8257       end subroutine ASTEM_non_volatiles
8258
8259
8260
8261
8262
8263
8264
8265 !***********************************************************************
8266 ! computes mass transfer coefficients for each condensing species for
8267 ! all the aerosol bins
8268 !
8269 ! author: rahul a. zaveri
8270 ! update: jan 2005
8271 !-----------------------------------------------------------------------
8272       subroutine aerosolmtc(vbs_nbin)
8273
8274       use module_data_mosaic_asect
8275
8276 !     implicit none
8277 !     include 'v33com9a'
8278 !     include 'mosaic.h'
8279 ! local variables
8280       integer nghq,vbs_nbin(1)
8281       integer start_ind
8282       parameter (nghq = 2)              ! gauss-hermite quadrature order
8283       integer ibin, iq, iv
8284       real(kind=8) tworootpi, root2, beta
8285       parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
8286       real(kind=8) cdum, dp, dp_avg, fkn, kn, lnsg, lndpgn, lndp, speed,   &
8287            sumghq
8288       real(kind=8) xghq(nghq), wghq(nghq)                       ! quadrature abscissae and weights
8289       real(kind=8) mw_vol(ngas_volatile+ngas_het), v_molar(ngas_volatile+ngas_het),                  &  ! mw and molar vols of volatile species
8290            freepath(ngas_volatile+ngas_het), accom(ngas_volatile+ngas_het),   &
8291            dg(ngas_volatile+ngas_het)                           ! keep local
8292 !     real(kind=8) fuchs_sutugin                                ! mosaic func
8293 !     real(kind=8) gas_diffusivity                              ! mosaic func
8294 !     real(kind=8) mean_molecular_speed                         ! mosaic func
8295
8296
8297
8298
8299
8300 ! molecular weights
8301       mw_vol(ih2so4_g) = 98.0
8302       mw_vol(ihno3_g)  = 63.0
8303       mw_vol(ihcl_g)   = 36.5
8304       mw_vol(inh3_g)   = 17.0
8305       mw_vol(in2o5_g)  = 108.0
8306       mw_vol(iclno2_g) = 81.5
8307       mw_vol(imsa_g)   = 96.0
8308       mw_vol(ipcg1_b_c_g) =250.0
8309       mw_vol(ipcg2_b_c_g) =250.0
8310       mw_vol(ipcg3_b_c_g)=250.0
8311       mw_vol(ipcg4_b_c_g)=250.0
8312       mw_vol(ipcg5_b_c_g)=250.0
8313       mw_vol(ipcg6_b_c_g)=250.0
8314       mw_vol(ipcg7_b_c_g)=250.0
8315       mw_vol(ipcg8_b_c_g)=250.0
8316       mw_vol(ipcg9_b_c_g)=250.0
8317       mw_vol(iopcg1_b_c_g)=250.0
8318       mw_vol(iopcg2_b_c_g)=250.0
8319       mw_vol(iopcg3_b_c_g)=250.0
8320       mw_vol(iopcg4_b_c_g)=250.0
8321       mw_vol(iopcg5_b_c_g)=250.0
8322       mw_vol(iopcg6_b_c_g)=250.0
8323       mw_vol(iopcg7_b_c_g)=250.0
8324       mw_vol(iopcg8_b_c_g)=250.0
8325       mw_vol(ipcg1_b_o_g)=250.0
8326       mw_vol(ipcg2_b_o_g)=250.0
8327       mw_vol(ipcg3_b_o_g)=250.0
8328       mw_vol(ipcg4_b_o_g)=250.0
8329       mw_vol(ipcg5_b_o_g)=250.0
8330       mw_vol(ipcg6_b_o_g)=250.0
8331       mw_vol(ipcg7_b_o_g)=250.0
8332       mw_vol(ipcg8_b_o_g)=250.0
8333       mw_vol(ipcg9_b_o_g)=250.0
8334       mw_vol(iopcg1_b_o_g)=250.0
8335       mw_vol(iopcg2_b_o_g)=250.0
8336       mw_vol(iopcg3_b_o_g)=250.0
8337       mw_vol(iopcg4_b_o_g)=250.0
8338       mw_vol(iopcg5_b_o_g)=250.0
8339       mw_vol(iopcg6_b_o_g)=250.0
8340       mw_vol(iopcg7_b_o_g)=250.0
8341       mw_vol(iopcg8_b_o_g)=250.0
8342       mw_vol(ipcg1_f_c_g) =250.0
8343       mw_vol(ipcg2_f_c_g) =250.0
8344       mw_vol(ipcg3_f_c_g)=250.0
8345       mw_vol(ipcg4_f_c_g)=250.0
8346       mw_vol(ipcg5_f_c_g)=250.0
8347       mw_vol(ipcg6_f_c_g)=250.0
8348       mw_vol(ipcg7_f_c_g)=250.0
8349       mw_vol(ipcg8_f_c_g)=250.0
8350       mw_vol(ipcg9_f_c_g)=250.0
8351       mw_vol(iopcg1_f_c_g)=250.0
8352       mw_vol(iopcg2_f_c_g)=250.0
8353       mw_vol(iopcg3_f_c_g)=250.0
8354       mw_vol(iopcg4_f_c_g)=250.0
8355       mw_vol(iopcg5_f_c_g)=250.0
8356       mw_vol(iopcg6_f_c_g)=250.0
8357       mw_vol(iopcg7_f_c_g)=250.0
8358       mw_vol(iopcg8_f_c_g)=250.0
8359       mw_vol(ipcg1_f_o_g)=250.0
8360       mw_vol(ipcg2_f_o_g)=250.0
8361       mw_vol(ipcg3_f_o_g)=250.0
8362       mw_vol(ipcg4_f_o_g)=250.0
8363       mw_vol(ipcg5_f_o_g)=250.0
8364       mw_vol(ipcg6_f_o_g)=250.0
8365       mw_vol(ipcg7_f_o_g)=250.0
8366       mw_vol(ipcg8_f_o_g)=250.0
8367       mw_vol(ipcg9_f_o_g)=250.0
8368       mw_vol(iopcg1_f_o_g)=250.0
8369       mw_vol(iopcg2_f_o_g)=250.0
8370       mw_vol(iopcg3_f_o_g)=250.0
8371       mw_vol(iopcg4_f_o_g)=250.0
8372       mw_vol(iopcg5_f_o_g)=250.0
8373       mw_vol(iopcg6_f_o_g)=250.0
8374       mw_vol(iopcg7_f_o_g)=250.0
8375       mw_vol(iopcg8_f_o_g)=250.0
8376       mw_vol(ismpa_g)=250.0
8377       mw_vol(ismpbb_g)=250.0
8378       mw_vol(igly)=58.0
8379       mw_vol(iho)=17.0
8380       mw_vol(iant1_c_g)=250.0
8381       mw_vol(iant2_c_g)=250.0
8382       mw_vol(iant3_c_g)=250.0
8383       mw_vol(iant4_c_g)=250.0
8384       mw_vol(iant1_o_g)=250.0
8385       mw_vol(iant2_o_g)=250.0
8386       mw_vol(iant3_o_g)=250.0
8387       mw_vol(iant4_o_g)=250.0
8388       mw_vol(ibiog1_c_g)=250.0
8389       mw_vol(ibiog2_c_g)=250.0
8390       mw_vol(ibiog3_c_g)=250.0
8391       mw_vol(ibiog4_c_g)=250.0
8392       mw_vol(ibiog1_o_g)=250.0
8393       mw_vol(ibiog2_o_g)=250.0
8394       mw_vol(ibiog3_o_g)=250.0
8395       mw_vol(ibiog4_o_g)=250.0
8396       mw_vol(iasoaX_g)=250.0
8397       mw_vol(iasoa1_g)=250.0
8398       mw_vol(iasoa2_g)=250.0
8399       mw_vol(iasoa3_g)=250.0
8400       mw_vol(iasoa4_g)=250.0
8401       mw_vol(ibsoaX_g)=250.0
8402       mw_vol(ibsoa1_g)=250.0
8403       mw_vol(ibsoa2_g)=250.0
8404       mw_vol(ibsoa3_g)=250.0
8405       mw_vol(ibsoa4_g)=250.0
8406
8407
8408
8409
8410
8411       v_molar(ih2so4_g)= 42.88
8412       v_molar(ihno3_g) = 24.11
8413       v_molar(ihcl_g)  = 21.48
8414       v_molar(inh3_g)  = 14.90
8415       v_molar(imsa_g)  = 58.00
8416       v_molar(in2o5_g) = 60.40
8417       v_molar(iclno2_g)= 52.70
8418
8419 ! mass accommodation coefficients
8420       accom(ih2so4_g)  = 0.1
8421       accom(ihno3_g)   = 0.1
8422       accom(ihcl_g)    = 0.1
8423       accom(inh3_g)    = 0.1
8424       accom(in2o5_g)   = 0.1  ! dummy variable - will recalc later..
8425       accom(iclno2_g)  = 0.1  ! dummy - for convenience of calcs
8426       accom(imsa_g)    = 0.1
8427       accom(ipcg1_b_c_g) =0.1
8428       accom(ipcg2_b_c_g) =0.1
8429       accom(ipcg3_b_c_g)=0.1
8430       accom(ipcg4_b_c_g)=0.1
8431       accom(ipcg5_b_c_g)=0.1
8432       accom(ipcg6_b_c_g)=0.1
8433       accom(ipcg7_b_c_g)=0.1
8434       accom(ipcg8_b_c_g)=0.1
8435       accom(ipcg9_b_c_g)=0.1
8436       accom(iopcg1_b_c_g)=0.1
8437       accom(iopcg2_b_c_g)=0.1
8438       accom(iopcg3_b_c_g)=0.1
8439       accom(iopcg4_b_c_g)=0.1
8440       accom(iopcg5_b_c_g)=0.1
8441       accom(iopcg6_b_c_g)=0.1
8442       accom(iopcg7_b_c_g)=0.1
8443       accom(iopcg8_b_c_g)=0.1
8444       accom(ipcg1_b_o_g)=0.1
8445       accom(ipcg2_b_o_g)=0.1
8446       accom(ipcg3_b_o_g)=0.1
8447       accom(ipcg4_b_o_g)=0.1
8448       accom(ipcg5_b_o_g)=0.1
8449       accom(ipcg6_b_o_g)=0.1
8450       accom(ipcg7_b_o_g)=0.1
8451       accom(ipcg8_b_o_g)=0.1
8452       accom(ipcg9_b_o_g)=0.1
8453       accom(iopcg1_b_o_g)=0.1
8454       accom(iopcg2_b_o_g)=0.1
8455       accom(iopcg3_b_o_g)=0.1
8456       accom(iopcg4_b_o_g)=0.1
8457       accom(iopcg5_b_o_g)=0.1
8458       accom(iopcg6_b_o_g)=0.1
8459       accom(iopcg7_b_o_g)=0.1
8460       accom(iopcg8_b_o_g)=0.1
8461       accom(ipcg1_f_c_g) =0.1
8462       accom(ipcg2_f_c_g) =0.1
8463       accom(ipcg3_f_c_g)=0.1
8464       accom(ipcg4_f_c_g)=0.1
8465       accom(ipcg5_f_c_g)=0.1
8466       accom(ipcg6_f_c_g)=0.1
8467       accom(ipcg7_f_c_g)=0.1
8468       accom(ipcg8_f_c_g)=0.1
8469       accom(ipcg9_f_c_g)=0.1
8470       accom(iopcg1_f_c_g)=0.1
8471       accom(iopcg2_f_c_g)=0.1
8472       accom(iopcg3_f_c_g)=0.1
8473       accom(iopcg4_f_c_g)=0.1
8474       accom(iopcg5_f_c_g)=0.1
8475       accom(iopcg6_f_c_g)=0.1
8476       accom(iopcg7_f_c_g)=0.1
8477       accom(iopcg8_f_c_g)=0.1
8478       accom(ipcg1_f_o_g)=0.1
8479       accom(ipcg2_f_o_g)=0.1
8480       accom(ipcg3_f_o_g)=0.1
8481       accom(ipcg4_f_o_g)=0.1
8482       accom(ipcg5_f_o_g)=0.1
8483       accom(ipcg6_f_o_g)=0.1
8484       accom(ipcg7_f_o_g)=0.1
8485       accom(ipcg8_f_o_g)=0.1
8486       accom(ipcg9_f_o_g)=0.1
8487       accom(iopcg1_f_o_g)=0.1
8488       accom(iopcg2_f_o_g)=0.1
8489       accom(iopcg3_f_o_g)=0.1
8490       accom(iopcg4_f_o_g)=0.1
8491       accom(iopcg5_f_o_g)=0.1
8492       accom(iopcg6_f_o_g)=0.1
8493       accom(iopcg7_f_o_g)=0.1
8494       accom(iopcg8_f_o_g)=0.1
8495       accom(ismpa_g)=0.1
8496       accom(ismpbb_g)=0.1
8497       ! added glyoxal, but only for completeness - is hopefully never used
8498       accom(igly)=0.1
8499       accom(iho)=0.1
8500       accom(iant1_c_g)=0.1
8501       accom(iant2_c_g)=0.1
8502       accom(iant3_c_g)=0.1
8503       accom(iant4_c_g)=0.1
8504       accom(iant1_o_g)=0.1
8505       accom(iant2_o_g)=0.1
8506       accom(iant3_o_g)=0.1
8507       accom(iant4_o_g)=0.1
8508       accom(ibiog1_c_g)=0.1
8509       accom(ibiog2_c_g)=0.1
8510       accom(ibiog3_c_g)=0.1
8511       accom(ibiog4_c_g)=0.1
8512       accom(ibiog1_o_g)=0.1
8513       accom(ibiog2_o_g)=0.1
8514       accom(ibiog3_o_g)=0.1
8515       accom(ibiog4_o_g)=0.1
8516       accom(iasoaX_g)=0.1
8517       accom(iasoa1_g)=0.1
8518       accom(iasoa2_g)=0.1
8519       accom(iasoa3_g)=0.1
8520       accom(iasoa4_g)=0.1
8521       accom(ibsoaX_g)=0.1
8522       accom(ibsoa1_g)=0.1
8523       accom(ibsoa2_g)=0.1
8524       accom(ibsoa3_g)=0.1
8525       accom(ibsoa4_g)=0.1
8526
8527
8528
8529
8530 ! quadrature weights
8531       xghq(1) =  0.70710678
8532       xghq(2) = -0.70710678
8533       wghq(1) =  0.88622693
8534       wghq(2) =  0.88622693
8535
8536
8537
8538 ! calculate gas diffusivity and mean free path for condensing gases
8539 ! ioa
8540       do iv = 1, ngas_ioa
8541         speed  = mean_molecular_speed(t_k,mw_vol(iv))   ! cm/s
8542         dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
8543         freepath(iv) = 3.*dg(iv)/speed                  ! cm
8544       enddo
8545
8546 ! soa
8547       start_ind = 1
8548       if(vbs_nbin(1) .eq. 0) then
8549         start_ind = ismpa_g
8550       else if (vbs_nbin(1) .eq. 4) then
8551         start_ind = iasoaX_g
8552       else
8553         start_ind = ipcg1_b_c_g
8554       end if
8555       !BSINGH(03/10/2015): Added 2 in the following do-loop to accomodate oh and gly species.
8556       ! *IMPORTANT*:This is a TEMPORARY fix, we need a better fix for this problem.
8557       do iv = start_ind, ngas_ioa + ngas_soa+2
8558         speed = mean_molecular_speed(t_k,mw_vol(iv))    ! cm/s
8559         dg(iv) = 0.1                                    ! cm^2/s (increased from 0.2 to 0.035 by Manish Shrivastava)
8560         freepath(iv) = 3.*dg(iv)/speed
8561       enddo
8562
8563 ! het-rct gases   ! DL 9/9/2011
8564       do iv = (ngas_volatile+1), (ngas_volatile+ngas_het)
8565         speed = mean_molecular_speed(t_k,mw_vol(iv))    ! cm/s
8566                 dg(iv) = gas_diffusivity(t_k,p_atm,mw_vol(iv),v_molar(iv)) ! cm^2/s
8567                 freepath(iv) = 3.*dg(iv)/speed                  ! cm
8568       enddo
8569
8570
8571 ! calc mass transfer coefficients for gases over various aerosol bins
8572
8573       if (msize_framework .eq. mmodal) then
8574
8575 ! for modal approach
8576       do 10 ibin = 1, nbin_a
8577
8578         if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
8579         call calc_dry_n_wet_aerosol_props(ibin)
8580
8581         dpgn_a(ibin) = dp_wet_a(ibin)   ! cm
8582
8583         lnsg   = log(sigmag_a(ibin))
8584         lndpgn = log(dpgn_a(ibin))
8585         cdum   = tworootpi*num_a(ibin)*   &
8586                  exp(beta*lndpgn + 0.5*(beta*lnsg)**2)
8587
8588         do 20 iv = 1, ngas_volatile + ngas_het
8589
8590                   if(iv.eq.in2o5_g)then ! recalculate accom coeff for N2O5
8591                                                                 ! for each different aerosol composition
8592                                                                 ! (use total aerosol composition for now)
8593                         if(n2o5_flag.gt.0)then
8594                                 accom(iv) = acc_n2o5_bert_thorn(water_a(ibin),&
8595                                                                         aer(ino3_a,jtotal,ibin),&
8596                                                                         aer(icl_a,jtotal,ibin),&
8597                                                                         vol_wet_a(ibin))
8598                         else
8599                                 accom(iv) = 0.0
8600                         endif
8601                   end if
8602
8603           sumghq = 0.0
8604           do 30 iq = 1, nghq    ! sum over gauss-hermite quadrature points
8605             lndp = lndpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
8606             dp = exp(lndp)
8607             kn = 2.*freepath(iv)/dp
8608             fkn = fuchs_sutugin(kn,accom(iv))
8609             sumghq = sumghq + wghq(iq)*dp*fkn/(dp**beta)
8610 30        continue
8611
8612         kg(iv,ibin) = cdum*dg(iv)*sumghq                ! 1/s
8613 20      continue
8614
8615                 if(n2o5_flag.gt.0)then
8616                         ! calculate the reaction path splitting for
8617                         ! heterogeneous N2O5 reactions
8618                         frac_n2o5_h2o(ibin) = split_n2o5_bert_thorn(water_a(ibin),&
8619                                                                         aer(icl_a,jtotal,ibin),&
8620                                                                         vol_wet_a(ibin))
8621                 else
8622                         frac_n2o5_h2o(ibin) = 0.0
8623                 endif
8624
8625 10    continue
8626
8627       elseif(msize_framework .eq. msection)then
8628
8629 ! for sectional approach
8630       do 11 ibin = 1, nbin_a
8631
8632         if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
8633
8634         call calc_dry_n_wet_aerosol_props(ibin)
8635
8636         dp_avg = dp_wet_a(ibin)
8637         cdum  = 6.283185*dp_avg*num_a(ibin)
8638
8639         do 21 iv = 1, ngas_volatile+ngas_het
8640                   if(iv.eq.in2o5_g)then ! recalculate accom coeff for N2O5
8641                                                                 ! for each different aerosol composition
8642                                                                 ! (use total aerosol composition for now)
8643                         if(n2o5_flag.gt.0)then
8644                                 accom(iv) = acc_n2o5_bert_thorn(water_a(ibin),&
8645                                                                         aer(ino3_a,jtotal,ibin),&
8646                                                                         aer(icl_a,jtotal,ibin),&
8647                                                                         vol_wet_a(ibin))
8648                         else
8649                                 accom(iv) = 0.0
8650                         end if
8651                   end if
8652           kn = 2.*freepath(iv)/dp_avg
8653           fkn = fuchs_sutugin(kn,accom(iv))
8654           kg(iv,ibin) = cdum*dg(iv)*fkn         ! 1/s!Increased by a factor of 10000 by Manish Shrivastava to force to equilibrium
8655 !           fraceq(iv,ibin)=num_a(ibin)*dp_wet_a(ibin)/(kn/accom(iv)+1)
8656 21      continue
8657                 if(n2o5_flag.gt.0)then
8658                         ! calculate the reaction path splitting for
8659                         ! heterogeneous N2O5 reactions
8660                         frac_n2o5_h2o(ibin) = split_n2o5_bert_thorn(water_a(ibin),&
8661                                                                         aer(icl_a,jtotal,ibin),&
8662                                                                         vol_wet_a(ibin))
8663                 else
8664                         frac_n2o5_h2o(ibin) = 0.0
8665                 end if
8666
8667 11    continue
8668
8669       else
8670
8671         if (iprint_mosaic_fe1 .gt. 0) then
8672           write(6,*)'error in the choice of msize_framework'
8673           write(6,*)'mosaic fatal error in subr. aerosolmtc'
8674         endif
8675 !       stop
8676         istat_mosaic_fe1 = -1900
8677         return
8678
8679       endif
8680
8681
8682       return
8683       end subroutine aerosolmtc
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696 !***********************************************************************
8697 ! calculates dry and wet aerosol properties: density, refractive indices
8698 !
8699 ! author: rahul a. zaveri
8700 ! update: jan 2005
8701 !-----------------------------------------------------------------------
8702       subroutine calc_dry_n_wet_aerosol_props(ibin)
8703
8704       use module_data_mosaic_asect
8705
8706 !     implicit none
8707 !     include 'v33com9a'
8708 !     include 'mosaic.h'
8709 ! subr arguments
8710       integer ibin
8711 ! local variables
8712       integer jc, je, iaer, isize, itype
8713       real(kind=8) aer_H
8714       complex(kind=8) ri_dum
8715
8716
8717 ! calculate dry mass and dry volume of a bin
8718       mass_dry_a(ibin) = 0.0            ! initialize to 0.0
8719       vol_dry_a(ibin)  = 0.0            ! initialize to 0.0
8720       area_dry_a(ibin) = 0.0            ! initialize to 0.0
8721
8722       if(jaerosolstate(ibin) .ne. no_aerosol)then
8723
8724         aer_H = (2.*aer(iso4_a,jtotal,ibin) +  &
8725                     aer(ino3_a,jtotal,ibin) +  &
8726                     aer(icl_a,jtotal,ibin)  +  &
8727                     aer(imsa_a,jtotal,ibin) +  &
8728                  2.*aer(ico3_a,jtotal,ibin))-  &
8729                 (2.*aer(ica_a,jtotal,ibin)  +  &
8730                     aer(ina_a,jtotal,ibin)  +  &
8731                     aer(inh4_a,jtotal,ibin))
8732
8733       do iaer = 1, naer
8734         mass_dry_a(ibin) = mass_dry_a(ibin) +   &
8735                            aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)       ! ng/m^3(air)
8736         vol_dry_a(ibin) = vol_dry_a(ibin) +   &
8737         aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
8738       enddo
8739         mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
8740         vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
8741
8742       mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                        ! g/cc(air)
8743       vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                          ! cc(aer)/cc(air)
8744
8745 ! wet mass and wet volume
8746         mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3       ! g/cc(air)
8747         vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3        ! cc(aer)/cc(air)
8748
8749 ! calculate mean dry and wet particle densities
8750         dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin) ! g/cc(aerosol)
8751         dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin) ! g/cc(aerosol)
8752
8753 ! calculate mean dry and wet particle diameters
8754         dp_dry_a(ibin)=(1.90985*vol_dry_a(ibin)/num_a(ibin))**0.3333333 ! cm
8755         dp_wet_a(ibin)=(1.90985*vol_wet_a(ibin)/num_a(ibin))**0.3333333 ! cm
8756
8757 ! calculate mean dry and wet particle surface areas
8758         area_dry_a(ibin)= 3.14159*num_a(ibin)*dp_dry_a(ibin)**2 ! cm^2/cc(air)
8759         area_wet_a(ibin)= 3.14159*num_a(ibin)*dp_wet_a(ibin)**2 ! cm^2/cc(air)
8760
8761 ! calculate volume average refractive index
8762 !   load comp_a array
8763         do je = 1, nelectrolyte
8764           comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15   ! g/cc(air)
8765         enddo
8766         comp_a(joc)  = aer(ioc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
8767         comp_a(jbc)  = aer(ibc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15      ! g/cc(air)
8768         comp_a(join) = aer(ioin_a,jtotal,ibin)*mw_comp_a(je)*1.e-15     ! g/cc(air)
8769          comp_a(jpcg1_b_c)= aer(ipcg1_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8770          comp_a(jpcg2_b_c)= aer(ipcg2_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8771          comp_a(jpcg3_b_c)= aer(ipcg3_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8772          comp_a(jpcg4_b_c)= aer(ipcg4_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8773          comp_a(jpcg5_b_c)= aer(ipcg5_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8774          comp_a(jpcg6_b_c)= aer(ipcg6_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8775          comp_a(jpcg7_b_c)= aer(ipcg7_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8776          comp_a(jpcg8_b_c)= aer(ipcg8_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8777          comp_a(jpcg9_b_c)= aer(ipcg9_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8778          comp_a(jopcg1_b_c)= aer(iopcg1_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8779          comp_a(jopcg2_b_c)= aer(iopcg2_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8780          comp_a(jopcg3_b_c)= aer(iopcg3_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8781          comp_a(jopcg4_b_c)= aer(iopcg4_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8782          comp_a(jopcg5_b_c)= aer(iopcg5_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8783          comp_a(jopcg6_b_c)= aer(iopcg6_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8784          comp_a(jopcg7_b_c)= aer(iopcg7_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8785          comp_a(jopcg8_b_c)= aer(iopcg8_b_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8786          comp_a(jpcg1_b_o)= aer(ipcg1_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8787          comp_a(jpcg2_b_o)= aer(ipcg2_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8788          comp_a(jpcg3_b_o)= aer(ipcg3_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8789          comp_a(jpcg4_b_o)= aer(ipcg4_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8790          comp_a(jpcg5_b_o)= aer(ipcg5_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8791          comp_a(jpcg6_b_o)= aer(ipcg6_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8792          comp_a(jpcg7_b_o)= aer(ipcg7_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8793          comp_a(jpcg8_b_o)= aer(ipcg8_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8794          comp_a(jpcg9_b_o)= aer(ipcg9_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8795          comp_a(jopcg1_b_o)= aer(iopcg1_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8796          comp_a(jopcg2_b_o)= aer(iopcg2_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8797          comp_a(jopcg3_b_o)= aer(iopcg3_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8798          comp_a(jopcg4_b_o)= aer(iopcg4_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8799          comp_a(jopcg5_b_o)= aer(iopcg5_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8800          comp_a(jopcg6_b_o)= aer(iopcg6_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8801          comp_a(jopcg7_b_o)= aer(iopcg7_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8802          comp_a(jopcg8_b_o)= aer(iopcg8_b_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8803          comp_a(jpcg1_f_c)= aer(ipcg1_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8804          comp_a(jpcg2_f_c)= aer(ipcg2_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8805          comp_a(jpcg3_f_c)= aer(ipcg3_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8806          comp_a(jpcg4_f_c)= aer(ipcg4_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8807          comp_a(jpcg5_f_c)= aer(ipcg5_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8808          comp_a(jpcg6_f_c)= aer(ipcg6_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8809          comp_a(jpcg7_f_c)= aer(ipcg7_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8810          comp_a(jpcg8_f_c)= aer(ipcg8_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8811          comp_a(jpcg9_f_c)= aer(ipcg9_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8812          comp_a(jopcg1_f_c)= aer(iopcg1_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8813          comp_a(jopcg2_f_c)= aer(iopcg2_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8814          comp_a(jopcg3_f_c)= aer(iopcg3_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8815          comp_a(jopcg4_f_c)= aer(iopcg4_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8816          comp_a(jopcg5_f_c)= aer(iopcg5_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8817          comp_a(jopcg6_f_c)= aer(iopcg6_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8818          comp_a(jopcg7_f_c)= aer(iopcg7_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8819          comp_a(jopcg8_f_c)= aer(iopcg8_f_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8820          comp_a(jpcg1_f_o)= aer(ipcg1_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8821          comp_a(jpcg2_f_o)= aer(ipcg2_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8822          comp_a(jpcg3_f_o)= aer(ipcg3_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8823          comp_a(jpcg4_f_o)= aer(ipcg4_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8824          comp_a(jpcg5_f_o)= aer(ipcg5_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8825          comp_a(jpcg6_f_o)= aer(ipcg6_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8826          comp_a(jpcg7_f_o)= aer(ipcg7_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8827          comp_a(jpcg8_f_o)= aer(ipcg8_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8828          comp_a(jpcg9_f_o)= aer(ipcg9_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8829          comp_a(jopcg1_f_o)= aer(iopcg1_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8830          comp_a(jopcg2_f_o)= aer(iopcg2_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8831          comp_a(jopcg3_f_o)= aer(iopcg3_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8832          comp_a(jopcg4_f_o)= aer(iopcg4_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8833          comp_a(jopcg5_f_o)= aer(iopcg5_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8834          comp_a(jopcg6_f_o)= aer(iopcg6_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8835          comp_a(jopcg7_f_o)= aer(iopcg7_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8836          comp_a(jopcg8_f_o)= aer(iopcg8_f_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8837          comp_a(jsmpa)= aer(ismpa_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8838          comp_a(jsmpbb)= aer(ismpbb_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8839          comp_a(jglysoa_r1)= aer(iglysoa_r1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8840          comp_a(jglysoa_r2)= aer(iglysoa_r2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8841          comp_a(jglysoa_sfc)= aer(iglysoa_sfc_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8842          comp_a(jglysoa_nh4)= aer(iglysoa_nh4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8843          comp_a(jglysoa_oh)= aer(iglysoa_oh_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8844          comp_a(jant1_c)= aer(iant1_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8845          comp_a(jant2_c)= aer(iant2_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8846          comp_a(jant3_c)= aer(iant3_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8847          comp_a(jant4_c)= aer(iant4_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8848          comp_a(jant1_o)= aer(iant1_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8849          comp_a(jant2_o)= aer(iant2_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8850          comp_a(jant3_o)= aer(iant3_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8851          comp_a(jant4_o)= aer(iant4_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8852          comp_a(jbiog1_c)= aer(ibiog1_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8853          comp_a(jbiog2_c)= aer(ibiog2_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8854          comp_a(jbiog3_c)= aer(ibiog3_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8855          comp_a(jbiog4_c)= aer(ibiog4_c_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8856          comp_a(jbiog1_o)= aer(ibiog1_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8857          comp_a(jbiog2_o)= aer(ibiog2_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8858          comp_a(jbiog3_o)= aer(ibiog3_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8859          comp_a(jbiog4_o)= aer(ibiog4_o_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8860          comp_a(jasoaX)= aer(iasoaX_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8861          comp_a(jasoa1)= aer(iasoa1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8862          comp_a(jasoa2)= aer(iasoa2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8863          comp_a(jasoa3)= aer(iasoa3_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8864          comp_a(jasoa4)= aer(iasoa4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8865          comp_a(jbsoaX)= aer(ibsoaX_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8866          comp_a(jbsoa1)= aer(ibsoa1_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8867          comp_a(jbsoa2)= aer(ibsoa2_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8868          comp_a(jbsoa3)= aer(ibsoa3_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8869          comp_a(jbsoa4)= aer(ibsoa4_a,jtotal,ibin)*mw_comp_a(je)*1.e-15 ! g/cc(air)
8870
8871
8872
8873         comp_a(jh2o) = water_a(ibin)*1.e-3                              ! g/cc(air)
8874
8875         ri_dum = (0.0,0.0)
8876         do jc = 1, naercomp
8877           if (dens_comp_a(jc).gt.0) then
8878           ri_dum = ri_dum + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
8879           endif
8880         enddo
8881
8882         ri_avg_a(ibin) = ri_dum/vol_wet_a(ibin)
8883
8884       else      ! use defaults
8885
8886         dens_dry_a(ibin) = 1.0   ! g/cc(aerosol)
8887         dens_wet_a(ibin) = 1.0   ! g/cc(aerosol)
8888
8889         call isize_itype_from_ibin( ibin, isize, itype )
8890         dp_dry_a(ibin) = dcen_sect(isize,itype) ! cm
8891         dp_wet_a(ibin) = dcen_sect(isize,itype) ! cm
8892
8893         ri_avg_a(ibin) = (1.5,0.0)
8894       endif
8895
8896
8897       return
8898       end subroutine calc_dry_n_wet_aerosol_props
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919 !***********************************************************************
8920 ! computes activities
8921 !
8922 ! author: rahul a. zaveri
8923 ! update: jan 2005
8924 !-----------------------------------------------------------------------
8925       subroutine compute_activities(ibin)
8926 !     implicit none
8927 !     include 'mosaic.h'
8928 ! subr arguments
8929       integer ibin
8930 ! local variables
8931       integer jp, ja
8932       real(kind=8) xt, xmol(nelectrolyte), sum_elec, dumK, c_bal, a_c
8933       real(kind=8) quad, aq, bq, cq, xq, dum
8934 ! function
8935 !     real(kind=8) aerosol_water
8936
8937
8938       water_a(ibin) = aerosol_water(jliquid,ibin)       ! kg/m^3(air)
8939       if(water_a(ibin) .eq. 0.0)return
8940
8941
8942       call calculate_xt(ibin,jliquid,xt)
8943
8944       if(xt.gt.2.0 .or. xt.lt.0.)then
8945 ! sulfate poor: fully dissociated electrolytes
8946
8947
8948 ! anion molalities (mol/kg water)
8949       ma(ja_so4,ibin)  = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
8950       ma(ja_hso4,ibin) = 0.0
8951       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
8952       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
8953       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
8954
8955 ! cation molalities (mol/kg water)
8956       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
8957       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
8958       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
8959       a_c              = ( 2.d0*ma(ja_so4,ibin)+  &
8960                                 ma(ja_no3,ibin)+  &
8961                                 ma(ja_cl,ibin) +  &
8962                                 ma(ja_msa,ibin) ) - &
8963                          ( 2.d0*mc(jc_ca,ibin) +  &
8964                                 mc(jc_nh4,ibin)+  &
8965                                 mc(jc_na,ibin) )
8966       mc(jc_h,ibin) = 0.5*a_c + sqrt(a_c**2 + 4.*Keq_ll(3))
8967
8968       if(mc(jc_h,ibin) .eq. 0.0)then
8969         mc(jc_h,ibin) = sqrt(Keq_ll(3))
8970       endif
8971
8972
8973       jp = jliquid
8974
8975
8976       sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) +  &
8977                  2.*electrolyte(jnh4cl,jp,ibin)  +  &
8978                  3.*electrolyte(jnh4so4,jp,ibin) +  &
8979                  3.*electrolyte(jna2so4,jp,ibin) +  &
8980                  2.*electrolyte(jnano3,jp,ibin)  +  &
8981                  2.*electrolyte(jnacl,jp,ibin)   +  &
8982                  3.*electrolyte(jcano3,jp,ibin)  +  &
8983                  3.*electrolyte(jcacl2,jp,ibin)  +  &
8984                  2.*electrolyte(jhno3,jp,ibin)   +  &
8985                  2.*electrolyte(jhcl,jp,ibin)
8986
8987       if(sum_elec .eq. 0.0)then
8988         do ja = 1, nelectrolyte
8989           gam(ja,ibin) = 1.0
8990         enddo
8991         goto 10
8992       endif
8993
8994
8995 ! ionic mole fractions
8996       xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
8997       xmol(jnh4cl)  = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
8998       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
8999       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
9000       xmol(jnano3)  = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
9001       xmol(jnacl)   = 2.*electrolyte(jnacl,jp,ibin)  /sum_elec
9002       xmol(jcano3)  = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
9003       xmol(jcacl2)  = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
9004       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)  /sum_elec
9005       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)   /sum_elec
9006
9007
9008       ja = jnh4so4
9009       if(xmol(ja).gt.0.0)then
9010       log_gam(ja) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9011                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9012                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9013                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9014                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9015                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9016                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9017                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9018                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9019                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9020       gam(jA,ibin) = 10.**log_gam(jA)
9021       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
9022                                gam(jnh4so4,ibin)**3
9023       endif
9024
9025
9026
9027       jA = jnh4no3
9028       if(xmol(jA).gt.0.0)then
9029       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9030                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9031                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9032                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9033                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9034                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9035                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9036                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9037                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9038                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9039       gam(jA,ibin) = 10.**log_gam(jA)
9040       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)* &
9041                                gam(jnh4no3,ibin)**2
9042       endif
9043
9044
9045       jA = jnh4cl
9046       if(xmol(jA).gt.0.0)then
9047       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9048                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9049                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9050                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9051                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9052                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9053                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9054                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9055                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9056                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9057       gam(jA,ibin) = 10.**log_gam(jA)
9058       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin)* &
9059                                gam(jnh4cl,ibin)**2
9060       endif
9061
9062
9063       jA = jna2so4
9064       if(xmol(jA).gt.0.0)then
9065       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9066                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9067                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9068                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9069                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9070                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9071                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9072                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9073                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9074                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9075       gam(jA,ibin) = 10.**log_gam(jA)
9076       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
9077                                gam(jna2so4,ibin)**3
9078       endif
9079
9080
9081       jA = jnano3
9082       if(xmol(jA).gt.0.0)then
9083       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9084                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9085                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9086                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9087                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9088                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9089                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9090                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9091                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9092                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9093       gam(jA,ibin) = 10.**log_gam(jA)
9094       activity(jnano3,ibin)  = mc(jc_na,ibin)*ma(ja_no3,ibin)* &
9095                                gam(jnano3,ibin)**2
9096       endif
9097
9098
9099
9100       jA = jnacl
9101       if(xmol(jA).gt.0.0)then
9102       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9103                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9104                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9105                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9106                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9107                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9108                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9109                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9110                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9111                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9112       gam(jA,ibin) = 10.**log_gam(jA)
9113       activity(jnacl,ibin)   = mc(jc_na,ibin)*ma(ja_cl,ibin)* &
9114                                gam(jnacl,ibin)**2
9115       endif
9116
9117
9118
9119 !      jA = jcano3
9120 !      if(xmol(jA).gt.0.0)then
9121 !      gam(jA,ibin) = 1.0
9122 !      activity(jcano3,ibin)  = 1.0
9123 !      endif
9124
9125
9126
9127 !      jA = jcacl2
9128 !      if(xmol(jA).gt.0.0)then
9129 !      gam(jA,ibin) = 1.0
9130 !      activity(jcacl2,ibin)  = 1.0
9131 !      endif
9132
9133       jA = jcano3
9134       if(xmol(jA).gt.0.0)then
9135       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9136                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9137                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9138                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9139                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9140                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9141                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9142                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9143                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9144                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9145       gam(jA,ibin) = 10.**log_gam(jA)
9146       activity(jcano3,ibin)  = mc(jc_ca,ibin)*ma(ja_no3,ibin)**2* &
9147                                gam(jcano3,ibin)**3
9148       endif
9149
9150
9151
9152       jA = jcacl2
9153       if(xmol(jA).gt.0.0)then
9154       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9155                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9156                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9157                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9158                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9159                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9160                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9161                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9162                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9163                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9164       gam(jA,ibin) = 10.**log_gam(jA)
9165       activity(jcacl2,ibin)  = mc(jc_ca,ibin)*ma(ja_cl,ibin)**2* &
9166                                gam(jcacl2,ibin)**3
9167       endif
9168
9169
9170       jA = jhno3
9171       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9172                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9173                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9174                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9175                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9176                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9177                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9178                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9179                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9180                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9181       gam(jA,ibin) = 10.**log_gam(jA)
9182       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
9183                                gam(jhno3,ibin)**2
9184
9185
9186       jA = jhcl
9187       log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +  &
9188                     xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +  &
9189                     xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +  &
9190                     xmol(jna2so4)*log_gamZ(jA,jna2so4) +  &
9191                     xmol(jnano3) *log_gamZ(jA,jnano3)  +  &
9192                     xmol(jnacl)  *log_gamZ(jA,jnacl)   +  &
9193                     xmol(jcano3) *log_gamZ(jA,jcano3)  +  &
9194                     xmol(jcacl2) *log_gamZ(jA,jcacl2)  +  &
9195                     xmol(jhno3)  *log_gamZ(jA,jhno3)   +  &
9196                     xmol(jhcl)   *log_gamZ(jA,jhcl)
9197       gam(jA,ibin) = 10.**log_gam(jA)
9198       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
9199                                gam(jhcl,ibin)**2
9200
9201 !----
9202 10    gam(jlvcite,ibin) = 1.0
9203
9204       gam(jnh4hso4,ibin)= 1.0
9205
9206       gam(jnh4msa,ibin) = 1.0
9207
9208       gam(jna3hso4,ibin) = 1.0
9209
9210       gam(jnahso4,ibin) = 1.0
9211
9212       gam(jnamsa,ibin)  = 1.0
9213
9214       gam(jcamsa2,ibin) = 1.0  ! raz-30apr07
9215
9216       activity(jlvcite,ibin) = 0.0
9217
9218       activity(jnh4hso4,ibin)= 0.0
9219
9220       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
9221                                gam(jnh4msa,ibin)**2
9222
9223       activity(jna3hso4,ibin)= 0.0
9224
9225       activity(jnahso4,ibin) = 0.0
9226
9227       activity(jnamsa,ibin) = mc(jc_na,ibin)*ma(ja_msa,ibin)* &  ! raz-30apr07
9228                                gam(jnamsa,ibin)**2
9229
9230       activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * &  ! raz-30apr07
9231                                gam(jcamsa2,ibin)**3
9232
9233       gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
9234
9235
9236       else
9237 !  SULFATE-RICH: solve for SO4= and HSO4- ions
9238
9239       jp = jliquid
9240
9241       sum_elec = 3.*electrolyte(jh2so4,jp,ibin)    +  &
9242                  2.*electrolyte(jnh4hso4,jp,ibin)  +  &
9243                  5.*electrolyte(jlvcite,jp,ibin)   +  &
9244                  3.*electrolyte(jnh4so4,jp,ibin)   +  &
9245                  2.*electrolyte(jnahso4,jp,ibin)   +  &
9246                  5.*electrolyte(jna3hso4,jp,ibin)  +  &
9247                  3.*electrolyte(jna2so4,jp,ibin)   +  &
9248                  2.*electrolyte(jhno3,jp,ibin)     +  &
9249                  2.*electrolyte(jhcl,jp,ibin)
9250
9251
9252       if(sum_elec .eq. 0.0)then
9253         do jA = 1, nelectrolyte
9254           gam(jA,ibin) = 1.0
9255         enddo
9256         goto 20
9257       endif
9258
9259
9260       xmol(jh2so4)  = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
9261       xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
9262       xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
9263       xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
9264       xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
9265       xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
9266       xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
9267       xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
9268       xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
9269
9270
9271 ! 2H.SO4
9272       jA = jh2so4
9273       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9274                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9275                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9276                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9277                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9278                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9279                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9280                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9281                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9282       gam(jA,ibin) = 10.**log_gam(jA)
9283
9284
9285 ! H.HSO4
9286       jA = jhhso4
9287       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9288                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9289                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9290                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9291                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9292                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9293                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9294                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9295                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9296       gam(jA,ibin) = 10.**log_gam(jA)
9297
9298
9299 ! NH4HSO4
9300       jA = jnh4hso4
9301       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9302                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9303                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9304                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9305                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9306                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9307                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9308                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9309                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9310       gam(jA,ibin) = 10.**log_gam(jA)
9311
9312
9313 ! LETOVICITE
9314       jA = jlvcite
9315       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9316                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9317                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9318                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9319                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9320                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9321                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9322                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9323                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9324       gam(jA,ibin) = 10.**log_gam(jA)
9325
9326
9327 ! (NH4)2SO4
9328       jA = jnh4so4
9329       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9330                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9331                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9332                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9333                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9334                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9335                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9336                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9337                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9338       gam(jA,ibin) = 10.**log_gam(jA)
9339
9340
9341 ! NaHSO4
9342       jA = jnahso4
9343       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9344                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9345                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9346                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9347                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9348                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9349                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9350                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9351                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9352       gam(jA,ibin) = 10.**log_gam(jA)
9353
9354
9355 ! Na3H(SO4)2
9356       jA = jna3hso4
9357 !      log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9358 !                    xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9359 !                    xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9360 !                    xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9361 !                    xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9362 !                    xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9363 !                    xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9364 !                    xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9365 !                    xmol(jhcl)    *log_gamZ(jA,jhcl)
9366 !      gam(jA,ibin) = 10.**log_gam(jA)
9367       gam(jA,ibin) = 1.0
9368
9369
9370 ! Na2SO4
9371       jA = jna2so4
9372       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9373                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9374                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9375                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9376                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9377                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9378                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9379                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9380                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9381       gam(jA,ibin) = 10.**log_gam(jA)
9382
9383
9384 ! HNO3
9385       jA = jhno3
9386       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9387                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9388                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9389                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9390                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9391                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9392                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9393                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9394                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9395       gam(jA,ibin) = 10.**log_gam(jA)
9396
9397
9398 ! HCl
9399       jA = jhcl
9400       log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +  &
9401                     xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+  &
9402                     xmol(jlvcite) *log_gamZ(jA,jlvcite) +  &
9403                     xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +  &
9404                     xmol(jnahso4) *log_gamZ(jA,jnahso4) +  &
9405                     xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+  &
9406                     xmol(jna2so4) *log_gamZ(jA,jna2so4) +  &
9407                     xmol(jhno3)   *log_gamZ(jA,jhno3)   +  &
9408                     xmol(jhcl)    *log_gamZ(jA,jhcl)
9409       gam(jA,ibin) = 10.**log_gam(jA)
9410
9411
9412 20    gam(jnh4no3,ibin) = 1.0
9413       gam(jnh4cl,ibin)  = 1.0
9414       gam(jnano3,ibin)  = 1.0
9415       gam(jnacl,ibin)   = 1.0
9416       gam(jcano3,ibin)  = 1.0
9417       gam(jcacl2,ibin)  = 1.0
9418
9419       gam(jnh4msa,ibin) = 1.0
9420       gam(jnamsa,ibin)  = 1.0
9421       gam(jcamsa2,ibin) = 1.0  ! raz-30apr07
9422
9423
9424 ! compute equilibrium pH
9425 ! cation molalities (mol/kg water)
9426       mc(jc_ca,ibin)   = 0.0    ! aqueous ca never exists in sulfate rich cases
9427       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
9428       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
9429
9430 ! anion molalities (mol/kg water)
9431       mSULF            = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
9432       ma(ja_hso4,ibin) = 0.0
9433       ma(ja_so4,ibin)  = 0.0
9434       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
9435       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
9436       ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
9437
9438       gam_ratio(ibin)  = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
9439       dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
9440
9441       c_bal =  mc(jc_nh4,ibin) + mc(jc_na,ibin) + 2.*mc(jc_ca,ibin) & ! raz-30apr07
9442          - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
9443
9444       aq = 1.0
9445       bq = dumK + c_bal
9446       cq = dumK*(c_bal - mSULF)
9447
9448
9449 !--quadratic solution
9450         if(bq .ne. 0.0)then
9451         xq = 4.*(1./bq)*(cq/bq)
9452         else
9453         xq = 1.e+6
9454         endif
9455
9456         if(abs(xq) .lt. 1.e-6)then
9457           dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
9458           quad = (-0.5*bq/aq)*dum
9459           if(quad .lt. 0.)then
9460             quad = -bq/aq - quad
9461           endif
9462         else
9463           quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
9464         endif
9465 !--end of quadratic solution
9466
9467       mc(jc_h,ibin) = max(quad, 1.D-7)
9468       ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
9469       ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
9470
9471
9472       activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 * & ! raz-30apr07
9473                                gam(jcamsa2,ibin)**3
9474
9475       activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2*ma(ja_so4,ibin)* &
9476                                gam(jnh4so4,ibin)**3
9477
9478       activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3*ma(ja_hso4,ibin)* &
9479                                ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
9480
9481       activity(jnh4hso4,ibin)= mc(jc_nh4,ibin)*ma(ja_hso4,ibin)* &
9482                                gam(jnh4hso4,ibin)**2
9483
9484       activity(jnh4msa,ibin) = mc(jc_nh4,ibin)*ma(ja_msa,ibin)* &
9485                                gam(jnh4msa,ibin)**2
9486
9487       activity(jna2so4,ibin) = mc(jc_na,ibin)**2*ma(ja_so4,ibin)* &
9488                                gam(jna2so4,ibin)**3
9489
9490       activity(jnahso4,ibin) = mc(jc_na,ibin)*ma(ja_hso4,ibin)* &
9491                                gam(jnahso4,ibin)**2
9492
9493       activity(jnamsa,ibin)  = mc(jc_na,ibin)*ma(ja_msa,ibin)* &
9494                                gam(jnamsa,ibin)**2
9495
9496 !      activity(jna3hso4,ibin)= mc(jc_na,ibin)**3*ma(ja_hso4,ibin)* &
9497 !                               ma(ja_so4,ibin)*gam(jna3hso4,ibin)**5
9498
9499       activity(jna3hso4,ibin)= 0.0
9500
9501       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)* &
9502                                gam(jhno3,ibin)**2
9503
9504       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)* &
9505                                gam(jhcl,ibin)**2
9506
9507       activity(jmsa,ibin)    = mc(jc_h,ibin)*ma(ja_msa,ibin)* &
9508                                gam(jmsa,ibin)**2
9509
9510
9511 ! sulfate-poor species
9512       activity(jnh4no3,ibin) = 0.0
9513
9514       activity(jnh4cl,ibin)  = 0.0
9515
9516       activity(jnano3,ibin)  = 0.0
9517
9518       activity(jnacl,ibin)   = 0.0
9519
9520       activity(jcano3,ibin)  = 0.0
9521
9522       activity(jcacl2,ibin)  = 0.0
9523
9524
9525       endif
9526
9527
9528
9529
9530       return
9531       end subroutine compute_activities
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542
9543
9544 !***********************************************************************
9545 ! computes mtem ternary parameters only once per transport time-step
9546 ! for a given ah2o (= rh)
9547 !
9548 ! author: rahul a. zaveri
9549 ! update: jan 2005
9550 ! reference: zaveri, r.a., r.c. easter, and a.s. wexler,
9551 ! a new method for multicomponent activity coefficients of electrolytes
9552 ! in aqueous atmospheric aerosols, j. geophys. res., 2005.
9553 !-----------------------------------------------------------------------
9554       subroutine mtem_compute_log_gamz
9555 !     implicit none
9556 !     include 'mosaic.h'
9557 ! local variables
9558       integer ja
9559 ! functions
9560 !     real(kind=8) fnlog_gamz, bin_molality
9561
9562
9563 ! sulfate-poor species
9564       ja = jhno3
9565       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9566       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9567       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9568       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9569       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9570       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9571       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9572       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9573       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9574       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9575       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9576       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9577       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9578       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9579       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9580
9581
9582       ja = jhcl
9583       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9584       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9585       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9586       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9587       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9588       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9589       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9590       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9591       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9592       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9593       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9594       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9595       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9596       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9597       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9598
9599
9600       ja = jnh4so4
9601       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9602       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9603       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9604       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9605       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9606       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9607       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9608       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9609       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9610       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9611       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9612       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9613       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9614       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9615       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9616
9617
9618       ja = jnh4no3
9619       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9620       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9621       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9622       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9623       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9624       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9625       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9626       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9627       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9628       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9629
9630
9631       ja = jnh4cl
9632       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9633       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9634       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9635       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9636       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9637       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9638       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9639       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9640       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9641       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9642
9643
9644       ja = jna2so4
9645       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9646       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9647       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9648       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9649       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9650       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9651       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9652       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9653       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9654       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9655       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9656       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9657       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9658       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9659       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9660
9661
9662       ja = jnano3
9663       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9664       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9665       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9666       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9667       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9668       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9669       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9670       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9671       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9672       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9673
9674
9675       ja = jnacl
9676       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9677       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9678       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9679       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9680       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9681       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9682       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9683       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9684       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9685       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9686
9687
9688       ja = jcano3
9689       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9690       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9691       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9692       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9693       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9694       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9695       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9696       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9697       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9698       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9699
9700
9701       ja = jcacl2
9702       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9703       log_gamz(ja,jnh4no3) = fnlog_gamz(ja,jnh4no3)
9704       log_gamz(ja,jnh4cl)  = fnlog_gamz(ja,jnh4cl)
9705       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9706       log_gamz(ja,jnano3)  = fnlog_gamz(ja,jnano3)
9707       log_gamz(ja,jnacl)   = fnlog_gamz(ja,jnacl)
9708       log_gamz(ja,jcano3)  = fnlog_gamz(ja,jcano3)
9709       log_gamz(ja,jcacl2)  = fnlog_gamz(ja,jcacl2)
9710       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9711       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9712
9713
9714 ! sulfate-rich species
9715       ja = jh2so4
9716       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9717       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9718       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9719       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9720       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9721       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9722       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9723       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9724       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9725
9726
9727       ja = jhhso4
9728       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9729       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9730       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9731       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9732       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9733       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9734       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9735       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9736       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9737
9738
9739       ja = jnh4hso4
9740       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9741       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9742       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9743       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9744       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9745       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9746       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9747       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9748       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9749
9750
9751       ja = jlvcite
9752       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9753       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9754       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9755       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9756       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9757       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9758       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9759       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9760       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9761
9762
9763       ja = jnahso4
9764       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9765       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9766       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9767       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9768       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9769       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9770       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9771       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9772       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9773
9774
9775       ja = jna3hso4
9776       log_gamz(ja,jh2so4)  = fnlog_gamz(ja,jh2so4)
9777       log_gamz(ja,jnh4hso4)= fnlog_gamz(ja,jnh4hso4)
9778       log_gamz(ja,jlvcite) = fnlog_gamz(ja,jlvcite)
9779       log_gamz(ja,jnh4so4) = fnlog_gamz(ja,jnh4so4)
9780       log_gamz(ja,jnahso4) = fnlog_gamz(ja,jnahso4)
9781       log_gamz(ja,jna3hso4)= fnlog_gamz(ja,jna3hso4)
9782       log_gamz(ja,jna2so4) = fnlog_gamz(ja,jna2so4)
9783       log_gamz(ja,jhno3)   = fnlog_gamz(ja,jhno3)
9784       log_gamz(ja,jhcl)    = fnlog_gamz(ja,jhcl)
9785
9786       return
9787       end subroutine mtem_compute_log_gamz
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
9816 !***********************************************************************
9817 ! computes sulfate ratio
9818 !
9819 ! author: rahul a. zaveri
9820 ! update: dec 1999
9821 !-----------------------------------------------------------------------
9822       subroutine calculate_xt(ibin,jp,xt)
9823 !     implicit none
9824 !     include 'mosaic.h'
9825 ! subr arguments
9826       integer ibin, jp
9827       real(kind=8) xt
9828
9829
9830       if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
9831         xt   = ( aer(inh4_a,jp,ibin) +   &
9832      &           aer(ina_a,jp,ibin)  +   &
9833      &        2.*aer(ica_a,jp,ibin) )/   &
9834      &         (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
9835       else
9836         xt   = -1.0
9837       endif
9838
9839
9840       return
9841       end subroutine calculate_xt
9842
9843
9844
9845
9846
9847 !***********************************************************************
9848 ! computes ions from electrolytes
9849 !
9850 ! author: rahul a. zaveri
9851 ! update: jan 2005
9852 !-----------------------------------------------------------------------
9853       subroutine electrolytes_to_ions(jp,ibin)
9854 !     implicit none
9855 !     include 'mosaic.h'
9856 ! subr arguments
9857       integer jp, ibin
9858
9859
9860       aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
9861                             electrolyte(jna2so4,jp,ibin) +   &
9862                          2.*electrolyte(jna3hso4,jp,ibin)+   &
9863                             electrolyte(jnahso4,jp,ibin) +   &
9864                             electrolyte(jnh4so4,jp,ibin) +   &
9865                          2.*electrolyte(jlvcite,jp,ibin) +   &
9866                             electrolyte(jnh4hso4,jp,ibin)+   &
9867                             electrolyte(jh2so4,jp,ibin)
9868
9869       aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
9870                          2.*electrolyte(jcano3,jp,ibin)  +   &
9871                             electrolyte(jnh4no3,jp,ibin) +   &
9872                             electrolyte(jhno3,jp,ibin)
9873
9874       aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
9875                          2.*electrolyte(jcacl2,jp,ibin)  +   &
9876                             electrolyte(jnh4cl,jp,ibin)  +   &
9877                             electrolyte(jhcl,jp,ibin)
9878
9879       aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) +   &
9880                             electrolyte(jnamsa,jp,ibin)  +   &
9881                          2.*electrolyte(jcamsa2,jp,ibin) +   &
9882                             electrolyte(jmsa,jp,ibin)
9883
9884       aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
9885
9886       aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
9887                             electrolyte(jcano3,jp,ibin)  +   &
9888                             electrolyte(jcacl2,jp,ibin)  +   &
9889                             electrolyte(jcaco3,jp,ibin)  +   &
9890                             electrolyte(jcamsa2,jp,ibin)
9891
9892       aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
9893                             electrolyte(jnacl,jp,ibin)   +   &
9894                          2.*electrolyte(jna2so4,jp,ibin) +   &
9895                          3.*electrolyte(jna3hso4,jp,ibin)+   &
9896                             electrolyte(jnahso4,jp,ibin) +   &
9897                             electrolyte(jnamsa,jp,ibin)
9898
9899       aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
9900                             electrolyte(jnh4cl,jp,ibin)  +   &
9901                          2.*electrolyte(jnh4so4,jp,ibin) +   &
9902                          3.*electrolyte(jlvcite,jp,ibin) +   &
9903                             electrolyte(jnh4hso4,jp,ibin)+   &
9904                             electrolyte(jnh4msa,jp,ibin)
9905
9906
9907       return
9908       end subroutine electrolytes_to_ions
9909
9910
9911
9912
9913
9914
9915
9916
9917
9918
9919 !***********************************************************************
9920 ! combinatorial method for computing electrolytes from ions
9921 !
9922 ! notes:
9923 !  - to be used for liquid-phase or total-phase only
9924 !  - transfers caso4 and caco3 from liquid to solid phase
9925 !
9926 ! author: rahul a. zaveri (based on code provided by a.s. wexler
9927 ! update: apr 2005
9928 !-----------------------------------------------------------------------
9929       subroutine ions_to_electrolytes(jp,ibin,xt)
9930 !     implicit none
9931 !     include 'mosaic.h'
9932 ! subr arguments
9933       integer ibin, jp
9934       real(kind=8) xt
9935 ! local variables
9936       integer iaer, je, jc, ja, icase
9937       real(kind=8) store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
9938            f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
9939       real(kind=8) nc(ncation), na(nanion)
9940
9941
9942
9943
9944       if(jp .ne. jliquid)then
9945         if (iprint_mosaic_fe1 .gt. 0) then
9946           write(6,*)' jp must be jliquid'
9947           write(6,*)' in ions_to_electrolytes sub'
9948           write(6,*)' wrong jp = ', jp
9949           write(6,*)' mosaic fatal error in ions_to_electrolytes'
9950         endif
9951 !       stop
9952         istat_mosaic_fe1 = -2000
9953         return
9954       endif
9955
9956 ! remove negative concentrations, if any
9957       do iaer = 1, naer
9958       aer(iaer,jp,ibin) = max(0.0D0, aer(iaer,jp,ibin))
9959       enddo
9960
9961
9962 ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
9963       store(ica_a)  = aer(ica_a, jp,ibin)
9964       store(iso4_a) = aer(iso4_a,jp,ibin)
9965
9966       call form_caso4(store,jp,ibin)
9967
9968       if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
9969         aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) -   &
9970                                   electrolyte(jcaso4,jliquid,ibin)
9971
9972         aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)-   &
9973                                   electrolyte(jcaso4,jliquid,ibin)
9974
9975         aer(ica_a,jsolid,ibin)  = aer(ica_a,jsolid,ibin) +   &
9976                                   electrolyte(jcaso4,jliquid,ibin)
9977
9978         aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) +   &
9979                                   electrolyte(jcaso4,jliquid,ibin)
9980
9981         electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin) &
9982                                        +electrolyte(jcaso4,jliquid,ibin)
9983         electrolyte(jcaso4,jliquid,ibin)= 0.0
9984       endif
9985
9986
9987 ! calculate sulfate ratio
9988       call calculate_xt(ibin,jp,xt)
9989
9990       if(xt .ge. 1.9999 .or. xt.lt.0.)then
9991        icase = 1        ! near neutral (acidity is caused by hcl and/or hno3)
9992       else
9993        icase = 2        ! acidic (acidity is caused by excess so4)
9994       endif
9995
9996
9997 ! initialize to zero
9998       do je = 1, nelectrolyte
9999         electrolyte(je,jp,ibin) = 0.0
10000       enddo
10001 !
10002 !---------------------------------------------------------
10003 ! initialize moles of ions depending on the sulfate domain
10004
10005       if(icase.eq.1)then ! xt >= 2 : sulfate poor domain
10006
10007         na(ja_hso4)= 0.0
10008         na(ja_so4) = aer(iso4_a,jp,ibin)
10009         na(ja_no3) = aer(ino3_a,jp,ibin)
10010         na(ja_cl)  = aer(icl_a, jp,ibin)
10011         na(ja_msa) = aer(imsa_a,jp,ibin)
10012
10013         nc(jc_ca)  = aer(ica_a, jp,ibin)
10014         nc(jc_na)  = aer(ina_a, jp,ibin)
10015         nc(jc_nh4) = aer(inh4_a,jp,ibin)
10016
10017         cat_net =&
10018                  ( 2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa) )- &
10019                  ( 2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na) )
10020
10021         if(cat_net .lt. 0.0)then
10022
10023           nc(jc_h) = 0.0
10024
10025         else  ! cat_net must be 0.0 or positive
10026
10027           nc(jc_h) = cat_net
10028
10029         endif
10030
10031
10032 ! now compute equivalent fractions
10033       sum_naza = 0.0
10034       do ja = 1, nanion
10035         sum_naza = sum_naza + na(ja)*za(ja)
10036       enddo
10037
10038       sum_nczc = 0.0
10039       do jc = 1, ncation
10040         sum_nczc = sum_nczc + nc(jc)*zc(jc)
10041       enddo
10042
10043       if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
10044         if (iprint_mosaic_diag1 .gt. 0) then
10045           write(6,*)'mosaic ions_to_electrolytes'
10046           write(6,*)'ionic concentrations are zero'
10047           write(6,*)'sum_naza = ', sum_naza
10048           write(6,*)'sum_nczc = ', sum_nczc
10049         endif
10050         return
10051       endif
10052
10053       do ja = 1, nanion
10054         xeq_a(ja) = na(ja)*za(ja)/sum_naza
10055       enddo
10056
10057       do jc = 1, ncation
10058         xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
10059       enddo
10060
10061       na_ma(ja_so4) = na(ja_so4) *mw_a(ja_so4)
10062       na_ma(ja_no3) = na(ja_no3) *mw_a(ja_no3)
10063       na_ma(ja_cl)  = na(ja_cl)  *mw_a(ja_cl)
10064       na_ma(ja_msa) = na(ja_msa) *mw_a(ja_msa)
10065       na_ma(ja_hso4)= na(ja_hso4)*mw_a(ja_hso4)
10066
10067       nc_mc(jc_ca)  = nc(jc_ca) *mw_c(jc_ca)
10068       nc_mc(jc_na)  = nc(jc_na) *mw_c(jc_na)
10069       nc_mc(jc_nh4) = nc(jc_nh4)*mw_c(jc_nh4)
10070       nc_mc(jc_h)   = nc(jc_h)  *mw_c(jc_h)
10071
10072
10073 ! now compute electrolyte moles
10074       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
10075         electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_ma(ja_so4) + &
10076                                         xeq_a(ja_so4)*nc_mc(jc_na))/  &
10077                                          mw_electrolyte(jna2so4)
10078       endif
10079
10080       electrolyte(jnahso4,jp,ibin) = 0.0
10081
10082       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10083         electrolyte(jnamsa,jp,ibin)  = (xeq_c(jc_na) *na_Ma(ja_msa) + &
10084                                         xeq_a(ja_msa)*nc_Mc(jc_na))/  &
10085                                          mw_electrolyte(jnamsa)
10086       endif
10087
10088       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10089         electrolyte(jnano3, jp,ibin) = (xeq_c(jc_na) *na_ma(ja_no3) + &
10090                                         xeq_a(ja_no3)*nc_mc(jc_na))/  &
10091                                          mw_electrolyte(jnano3)
10092       endif
10093
10094       if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10095         electrolyte(jnacl,  jp,ibin) = (xeq_c(jc_na) *na_ma(ja_cl) +  &
10096                                         xeq_a(ja_cl) *nc_mc(jc_na))/  &
10097                                          mw_electrolyte(jnacl)
10098       endif
10099
10100       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
10101         electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_so4) + &
10102                                         xeq_a(ja_so4)*nc_mc(jc_nh4))/ &
10103                                          mw_electrolyte(jnh4so4)
10104       endif
10105
10106       electrolyte(jnh4hso4,jp,ibin)= 0.0
10107
10108       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10109         electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) + &
10110                                         xeq_a(ja_msa)*nc_Mc(jc_nh4))/ &
10111                                          mw_electrolyte(jnh4msa)
10112       endif
10113
10114       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10115         electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_no3) + &
10116                                         xeq_a(ja_no3)*nc_mc(jc_nh4))/ &
10117                                          mw_electrolyte(jnh4no3)
10118       endif
10119
10120       if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10121         electrolyte(jnh4cl, jp,ibin) = (xeq_c(jc_nh4)*na_ma(ja_cl) +  &
10122                                         xeq_a(ja_cl) *nc_mc(jc_nh4))/ &
10123                                          mw_electrolyte(jnh4cl)
10124       endif
10125
10126       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
10127         electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_no3) + &
10128                                         xeq_a(ja_no3)*nc_mc(jc_ca))/  &
10129                                          mw_electrolyte(jcano3)
10130       endif
10131
10132       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10133         electrolyte(jcacl2, jp,ibin) = (xeq_c(jc_ca) *na_ma(ja_cl) +  &
10134                                         xeq_a(ja_cl) *nc_mc(jc_ca))/  &
10135                                          mw_electrolyte(jcacl2)
10136       endif
10137
10138       if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10139         electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) + &
10140                                         xeq_a(ja_msa) *nc_Mc(jc_ca))/ &
10141                                          mw_electrolyte(jcamsa2)
10142       endif
10143
10144       electrolyte(jh2so4, jp,ibin) = 0.0
10145
10146       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
10147       electrolyte(jhno3,  jp,ibin) = (xeq_c(jc_h)  *na_ma(ja_no3) +   &
10148                                       xeq_a(ja_no3)*nc_mc(jc_h))/     &
10149                                        mw_electrolyte(jhno3)
10150       endif
10151
10152       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
10153         electrolyte(jhcl,   jp,ibin) = (xeq_c(jc_h) *na_ma(ja_cl) +   &
10154                                         xeq_a(ja_cl)*nc_mc(jc_h))/    &
10155                                          mw_electrolyte(jhcl)
10156       endif
10157
10158       if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
10159         electrolyte(jmsa,jp,ibin)    = (xeq_c(jc_h) *na_ma(ja_msa) +  &
10160                                         xeq_a(ja_msa)*nc_mc(jc_h))/   &
10161                                          mw_electrolyte(jmsa)
10162       endif
10163
10164 !--------------------------------------------------------------------
10165
10166       elseif(icase.eq.2)then ! xt < 2 : sulfate rich domain
10167
10168         store(imsa_a) = aer(imsa_a,jp,ibin)
10169         store(ica_a)  = aer(ica_a, jp,ibin)
10170
10171         call form_camsa2(store,jp,ibin)
10172
10173         sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
10174
10175         if(sum_na_nh4 .gt. 0.0)then
10176           f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
10177           f_na  = aer(ina_a,jp,ibin)/sum_na_nh4
10178         else
10179           f_nh4 = 0.0
10180           f_na  = 0.0
10181         endif
10182
10183 ! first form msa electrolytes
10184         if(sum_na_nh4 .gt. store(imsa_a))then
10185           electrolyte(jnamsa,jp,ibin)  = f_na *store(imsa_a)
10186           electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
10187           rem_na = aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin)  ! remaining na
10188           rem_nh4= aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin) ! remaining nh4
10189         else
10190           electrolyte(jnamsa,jp,ibin)  = aer(ina_a,jp,ibin)
10191           electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
10192           electrolyte(jmsa,jp,ibin)    = store(imsa_a) - sum_na_nh4
10193           rem_nh4 = 0.0  ! remaining nh4
10194           rem_na  = 0.0  ! remaining na
10195         endif
10196
10197
10198 ! recompute xt
10199         if(aer(iso4_a,jp,ibin).gt.0.0)then
10200           xt = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
10201         else
10202           goto 10
10203         endif
10204
10205         if(xt .le. 1.0)then     ! h2so4 + bisulfate
10206           xh = (1.0 - xt)
10207           xb = xt
10208           electrolyte(jh2so4,jp,ibin)   = xh*aer(iso4_a,jp,ibin)
10209           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10210           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
10211         elseif(xt .le. 1.5)then ! bisulfate + letovicite
10212           xb = 3.0 - 2.0*xt
10213           xl = xt - 1.0
10214           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
10215           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
10216           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
10217           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10218         else                    ! letovicite + sulfate
10219           xl = 2.0 - xt
10220           xs = 2.0*xt - 3.0
10221           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
10222           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
10223           electrolyte(jnh4so4,jp,ibin)  = xs*f_nh4*aer(iso4_a,jp,ibin)
10224           electrolyte(jna2so4,jp,ibin)  = xs*f_na *aer(iso4_a,jp,ibin)
10225         endif
10226
10227         electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
10228         electrolyte(jhcl,jp,ibin)  = aer(icl_a,jp,ibin)
10229
10230       endif
10231 !---------------------------------------------------------
10232 !
10233 ! calculate % composition
10234 !! 10    sum_dum = 0.0
10235 !!      do je = 1, nelectrolyte
10236 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10237 !!      enddo
10238 !!
10239 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10240 !!      electrolyte_sum(jp,ibin) = sum_dum
10241 !!
10242 !!      do je = 1, nelectrolyte
10243 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10244 !!      enddo
10245
10246 10    return
10247       end subroutine ions_to_electrolytes
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
10275 !***********************************************************************
10276 ! conforms aerosol generic species to a valid electrolyte composition
10277 !
10278 ! author: rahul a. zaveri
10279 ! update: june 2000
10280 !-----------------------------------------------------------------------
10281       subroutine conform_electrolytes(jp,ibin,xt)
10282 !     implicit none
10283 !     include 'mosaic.h'
10284 ! subr arguments
10285       integer ibin, jp
10286       real(kind=8) xt
10287 ! local variables
10288       integer i, ixt_case, je
10289       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
10290       real(kind=8) store(naer)
10291
10292 ! remove negative concentrations, if any
10293       do i=1,naer
10294       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
10295       enddo
10296
10297
10298       call calculate_xt(ibin,jp,xt)
10299
10300       if(xt .ge. 1.9999 .or. xt.lt.0.)then
10301        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
10302       else
10303        ixt_case = 2     ! acidic (acidity is caused by excess so4)
10304       endif
10305
10306 ! initialize
10307 !
10308 ! put total aer(*) into store(*)
10309       store(iso4_a) = aer(iso4_a,jp,ibin)
10310       store(ino3_a) = aer(ino3_a,jp,ibin)
10311       store(icl_a)  = aer(icl_a, jp,ibin)
10312       store(imsa_a) = aer(imsa_a,jp,ibin)
10313       store(ico3_a) = aer(ico3_a,jp,ibin)
10314       store(inh4_a) = aer(inh4_a,jp,ibin)
10315       store(ina_a)  = aer(ina_a, jp,ibin)
10316       store(ica_a)  = aer(ica_a, jp,ibin)
10317
10318       do je=1,nelectrolyte
10319       electrolyte(je,jp,ibin) = 0.0
10320       enddo
10321 !
10322 !---------------------------------------------------------
10323 !
10324       if(ixt_case.eq.1)then
10325
10326 ! xt >= 2   : sulfate deficient
10327
10328         call form_caso4(store,jp,ibin)
10329         call form_camsa2(store,jp,ibin)
10330         call form_na2so4(store,jp,ibin)
10331         call form_namsa(store,jp,ibin)
10332         call form_cano3(store,jp,ibin)
10333         call form_nano3(store,jp,ibin)
10334         call form_nacl(store,jp,ibin)
10335         call form_cacl2(store,jp,ibin)
10336         call form_caco3(store,jp,ibin)
10337         call form_nh4so4(store,jp,ibin)
10338         call form_nh4msa(store,jp,ibin)
10339         call form_nh4no3(store,jp,ibin)
10340         call form_nh4cl(store,jp,ibin)
10341         call form_msa(store,jp,ibin)
10342         call degas_hno3(store,jp,ibin)
10343         call degas_hcl(store,jp,ibin)
10344         call degas_nh3(store,jp,ibin)
10345
10346       elseif(ixt_case.eq.2)then
10347
10348 ! xt < 2   : sulfate enough or sulfate excess
10349
10350         call form_caso4(store,jp,ibin)
10351         call form_camsa2(store,jp,ibin)
10352         call form_namsa(store,jp,ibin)
10353         call form_nh4msa(store,jp,ibin)
10354         call form_msa(store,jp,ibin)
10355
10356         if(store(iso4_a).eq.0.0)goto 10
10357
10358
10359         xt_prime =(store(ina_a)+store(inh4_a))/   &
10360                         store(iso4_a)
10361         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10362
10363         if(xt_prime.ge.xna_prime)then
10364           call form_na2so4(store,jp,ibin)
10365           xnh4_prime = 0.0
10366           if(store(iso4_a).gt.1.e-15)then
10367             xnh4_prime = store(inh4_a)/store(iso4_a)
10368           endif
10369
10370           if(xnh4_prime .ge. 1.5)then
10371             call form_nh4so4_lvcite(store,jp,ibin)
10372           else
10373             call form_lvcite_nh4hso4(store,jp,ibin)
10374           endif
10375
10376         elseif(xt_prime.ge.1.)then
10377           call form_nh4hso4(store,jp,ibin)
10378           call form_na2so4_nahso4(store,jp,ibin)
10379         elseif(xt_prime.lt.1.)then
10380           call form_nahso4(store,jp,ibin)
10381           call form_nh4hso4(store,jp,ibin)
10382           call form_h2so4(store,jp,ibin)
10383         endif
10384
10385 10    call degas_hno3(store,jp,ibin)
10386       call degas_hcl(store,jp,ibin)
10387       call degas_nh3(store,jp,ibin)
10388
10389       endif ! case 1, 2
10390
10391
10392 ! re-calculate ions to eliminate round-off errors
10393       call electrolytes_to_ions(jp, ibin)
10394 !---------------------------------------------------------
10395 !
10396 ! calculate % composition
10397 !!      sum_dum = 0.0
10398 !!      do je = 1, nelectrolyte
10399 !!        electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
10400 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10401 !!      enddo
10402
10403 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10404 !!      electrolyte_sum(jp,ibin) = sum_dum
10405
10406 !!      do je = 1, nelectrolyte
10407 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10408 !!      enddo
10409
10410       return
10411       end subroutine conform_electrolytes
10412
10413
10414
10415
10416
10417
10418
10419
10420
10421
10422
10423 !***********************************************************************
10424 ! forms electrolytes from ions
10425 !
10426 ! author: rahul a. zaveri
10427 ! update: june 2000
10428 !-----------------------------------------------------------------------
10429       subroutine form_electrolytes(jp,ibin,xt)
10430 !     implicit none
10431 !     include 'mosaic.h'
10432 ! subr arguments
10433       integer ibin, jp
10434       real(kind=8) xt
10435 ! local variables
10436       integer i, ixt_case, j, je
10437       real(kind=8) sum_dum, xna_prime, xnh4_prime, xt_prime
10438       real(kind=8) store(naer)
10439
10440 ! remove negative concentrations, if any
10441       do i=1,naer
10442       aer(i,jp,ibin) = max(0.0D0, aer(i,jp,ibin))
10443       enddo
10444
10445
10446       call calculate_xt(ibin,jp,xt)
10447
10448       if(xt .ge. 1.9999 .or. xt.lt.0.)then
10449        ixt_case = 1     ! near neutral (acidity is caused by hcl and/or hno3)
10450       else
10451        ixt_case = 2     ! acidic (acidity is caused by excess so4)
10452       endif
10453
10454 ! initialize
10455 !
10456 ! put total aer(*) into store(*)
10457       store(iso4_a) = aer(iso4_a,jp,ibin)
10458       store(ino3_a) = aer(ino3_a,jp,ibin)
10459       store(icl_a)  = aer(icl_a, jp,ibin)
10460       store(imsa_a) = aer(imsa_a,jp,ibin)
10461       store(ico3_a) = aer(ico3_a,jp,ibin)
10462       store(inh4_a) = aer(inh4_a,jp,ibin)
10463       store(ina_a)  = aer(ina_a, jp,ibin)
10464       store(ica_a)  = aer(ica_a, jp,ibin)
10465 !
10466       do j=1,nelectrolyte
10467       electrolyte(j,jp,ibin) = 0.0
10468       enddo
10469 !
10470 !---------------------------------------------------------
10471 !
10472       if(ixt_case.eq.1)then
10473
10474 ! xt >= 2   : sulfate deficient
10475         call form_caso4(store,jp,ibin)
10476         call form_camsa2(store,jp,ibin)
10477         call form_na2so4(store,jp,ibin)
10478         call form_namsa(store,jp,ibin)
10479         call form_cano3(store,jp,ibin)
10480         call form_nano3(store,jp,ibin)
10481         call form_nacl(store,jp,ibin)
10482         call form_cacl2(store,jp,ibin)
10483         call form_caco3(store,jp,ibin)
10484         call form_nh4so4(store,jp,ibin)
10485         call form_nh4msa(store,jp,ibin)
10486         call form_nh4no3(store,jp,ibin)
10487         call form_nh4cl(store,jp,ibin)
10488         call form_msa(store,jp,ibin)
10489
10490         if(jp .eq. jsolid)then
10491           call degas_hno3(store,jp,ibin)
10492           call degas_hcl(store,jp,ibin)
10493           call degas_nh3(store,jp,ibin)
10494         else
10495           call form_hno3(store,jp,ibin)
10496           call form_hcl(store,jp,ibin)
10497           call degas_nh3(store,jp,ibin)
10498         endif
10499
10500
10501
10502       elseif(ixt_case.eq.2)then
10503
10504 ! xt < 2   : sulfate enough or sulfate excess
10505
10506         call form_caso4(store,jp,ibin)
10507         call form_camsa2(store,jp,ibin)
10508         call form_namsa(store,jp,ibin)
10509         call form_nh4msa(store,jp,ibin)
10510         call form_msa(store,jp,ibin)
10511
10512         if(store(iso4_a).eq.0.0)goto 10
10513
10514
10515         xt_prime =(store(ina_a)+store(inh4_a))/   &
10516                         store(iso4_a)
10517         xna_prime=0.5*store(ina_a)/store(iso4_a) + 1.
10518
10519         if(xt_prime.ge.xna_prime)then
10520           call form_na2so4(store,jp,ibin)
10521           xnh4_prime = 0.0
10522           if(store(iso4_a).gt.1.e-15)then
10523             xnh4_prime = store(inh4_a)/store(iso4_a)
10524           endif
10525
10526           if(xnh4_prime .ge. 1.5)then
10527             call form_nh4so4_lvcite(store,jp,ibin)
10528           else
10529             call form_lvcite_nh4hso4(store,jp,ibin)
10530           endif
10531
10532         elseif(xt_prime.ge.1.)then
10533           call form_nh4hso4(store,jp,ibin)
10534           call form_na2so4_nahso4(store,jp,ibin)
10535         elseif(xt_prime.lt.1.)then
10536           call form_nahso4(store,jp,ibin)
10537           call form_nh4hso4(store,jp,ibin)
10538           call form_h2so4(store,jp,ibin)
10539         endif
10540
10541 10      if(jp .eq. jsolid)then
10542           call degas_hno3(store,jp,ibin)
10543           call degas_hcl(store,jp,ibin)
10544           call degas_nh3(store,jp,ibin)
10545         else
10546           call form_hno3(store,jp,ibin)
10547           call form_hcl(store,jp,ibin)
10548           call degas_nh3(store,jp,ibin)
10549         endif
10550
10551       endif ! case 1, 2
10552
10553
10554 ! re-calculate ions to eliminate round-off errors
10555       call electrolytes_to_ions(jp, ibin)
10556 !---------------------------------------------------------
10557 !
10558 ! calculate % composition
10559 !!      sum_dum = 0.0
10560 !!      do je = 1, nelectrolyte
10561 !!        electrolyte(je,jp,ibin) = max(0.D0,electrolyte(je,jp,ibin)) ! remove -ve
10562 !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
10563 !!      enddo
10564 !!
10565 !!      if(sum_dum .eq. 0.)sum_dum = 1.0
10566 !!      electrolyte_sum(jp,ibin) = sum_dum
10567 !!
10568 !!      do je = 1, nelectrolyte
10569 !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
10570 !!      enddo
10571
10572       return
10573       end subroutine form_electrolytes
10574
10575
10576
10577
10578
10579
10580
10581
10582
10583
10584
10585
10586
10587
10588 !***********************************************************************
10589 ! electrolyte formation subroutines
10590 !
10591 ! author: rahul a. zaveri
10592 ! update: june 2000
10593 !-----------------------------------------------------------------------
10594       subroutine form_caso4(store,jp,ibin)
10595 !     implicit none
10596 !     include 'mosaic.h'
10597 ! subr arguments
10598       integer jp, ibin
10599       real(kind=8) store(naer)
10600
10601       electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
10602       store(ica_a)  = store(ica_a) - electrolyte(jcaso4,jp,ibin)
10603       store(iso4_a) = store(iso4_a) - electrolyte(jcaso4,jp,ibin)
10604       store(ica_a)  = max(0.D0, store(ica_a))
10605       store(iso4_a) = max(0.D0, store(iso4_a))
10606
10607       return
10608       end subroutine form_caso4
10609
10610
10611
10612       subroutine form_camsa2(store,jp,ibin)
10613 !      implicit none
10614 !      include 'mosaic.h'
10615 ! subr arguments
10616       integer jp, ibin
10617       real(kind=8) store(naer)
10618
10619       electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
10620       store(ica_a)  = store(ica_a) - electrolyte(jcamsa2,jp,ibin)
10621       store(imsa_a) = store(imsa_a) - 2.d0*electrolyte(jcamsa2,jp,ibin)
10622       store(ica_a)  = max(0.D0, store(ica_a))
10623       store(imsa_a) = max(0.D0, store(imsa_a))
10624
10625       return
10626       end subroutine form_camsa2
10627
10628
10629
10630       subroutine form_cano3(store,jp,ibin)      ! ca(no3)2
10631 !     implicit none
10632 !     include 'mosaic.h'
10633 ! subr arguments
10634       integer jp, ibin
10635       real(kind=8) store(naer)
10636
10637       electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
10638
10639       store(ica_a)  = store(ica_a) - electrolyte(jcano3,jp,ibin)
10640       store(ino3_a) = store(ino3_a) - 2.*electrolyte(jcano3,jp,ibin)
10641       store(ica_a)  = max(0.D0, store(ica_a))
10642       store(ino3_a) = max(0.D0, store(ino3_a))
10643
10644       return
10645       end subroutine form_cano3
10646
10647
10648       subroutine form_cacl2(store,jp,ibin)
10649 !     implicit none
10650 !     include 'mosaic.h'
10651 ! subr arguments
10652       integer jp, ibin
10653       real(kind=8) store(naer)
10654
10655       electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
10656
10657       store(ica_a)  = store(ica_a) - electrolyte(jcacl2,jp,ibin)
10658       store(icl_a)  = store(icl_a) - 2.*electrolyte(jcacl2,jp,ibin)
10659       store(ica_a)  = max(0.D0, store(ica_a))
10660       store(icl_a)  = max(0.D0, store(icl_a))
10661
10662       return
10663       end subroutine form_cacl2
10664
10665
10666       subroutine form_caco3(store,jp,ibin)
10667 !     implicit none
10668 !     include 'mosaic.h'
10669 ! subr arguments
10670       integer jp, ibin
10671       real(kind=8) store(naer)
10672
10673       if(jp.eq.jtotal .or. jp.eq.jsolid)then
10674       electrolyte(jcaco3,jp,ibin) = store(ica_a)
10675
10676       aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin)  ! force co3 = caco3
10677
10678       store(ica_a) = 0.0
10679       store(ico3_a)= 0.0
10680       endif
10681
10682       return
10683       end subroutine form_caco3
10684
10685
10686       subroutine form_na2so4(store,jp,ibin)
10687 !     implicit none
10688 !     include 'mosaic.h'
10689 ! subr arguments
10690       integer jp, ibin
10691       real(kind=8) store(naer)
10692
10693       electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a),   &
10694                                             store(iso4_a))
10695       store(ina_a) = store(ina_a) - 2.*electrolyte(jna2so4,jp,ibin)
10696       store(iso4_a)= store(iso4_a) - electrolyte(jna2so4,jp,ibin)
10697       store(ina_a) = max(0.D0, store(ina_a))
10698       store(iso4_a)= max(0.D0, store(iso4_a))
10699
10700       return
10701       end subroutine form_na2so4
10702
10703
10704
10705       subroutine form_nahso4(store,jp,ibin)
10706 !     implicit none
10707 !     include 'mosaic.h'
10708 ! subr arguments
10709       integer jp, ibin
10710       real(kind=8) store(naer)
10711
10712       electrolyte(jnahso4,jp,ibin) = min(store(ina_a),   &
10713                                          store(iso4_a))
10714       store(ina_a)  = store(ina_a) - electrolyte(jnahso4,jp,ibin)
10715       store(iso4_a) = store(iso4_a) - electrolyte(jnahso4,jp,ibin)
10716       store(ina_a)  = max(0.D0, store(ina_a))
10717       store(iso4_a) = max(0.D0, store(iso4_a))
10718
10719       return
10720       end subroutine form_nahso4
10721
10722
10723
10724       subroutine form_namsa(store,jp,ibin)
10725 !      implicit none
10726 !      include 'mosaic.h'
10727 ! subr arguments
10728       integer jp, ibin
10729       real(kind=8) store(naer)
10730
10731       electrolyte(jnamsa,jp,ibin) = min(store(ina_a), &
10732                                         store(imsa_a))
10733       store(ina_a)  = store(ina_a) - electrolyte(jnamsa,jp,ibin)
10734       store(imsa_a) = store(imsa_a) - electrolyte(jnamsa,jp,ibin)
10735       store(ina_a)  = max(0.D0, store(ina_a))
10736       store(imsa_a) = max(0.D0, store(imsa_a))
10737
10738       return
10739       end subroutine form_namsa
10740
10741
10742
10743       subroutine form_nano3(store,jp,ibin)
10744 !     implicit none
10745 !     include 'mosaic.h'
10746 ! subr arguments
10747       integer jp, ibin
10748       real(kind=8) store(naer)
10749
10750       electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
10751       store(ina_a)  = store(ina_a) - electrolyte(jnano3,jp,ibin)
10752       store(ino3_a) = store(ino3_a) - electrolyte(jnano3,jp,ibin)
10753       store(ina_a)  = max(0.D0, store(ina_a))
10754       store(ino3_a) = max(0.D0, store(ino3_a))
10755
10756       return
10757       end subroutine form_nano3
10758
10759
10760
10761       subroutine form_nacl(store,jp,ibin)
10762 !     implicit none
10763 !     include 'mosaic.h'
10764 ! subr arguments
10765       integer jp, ibin
10766       real(kind=8) store(naer)
10767
10768       electrolyte(jnacl,jp,ibin) = store(ina_a)
10769
10770       store(ina_a) = 0.0
10771       store(icl_a) = store(icl_a) - electrolyte(jnacl,jp,ibin)
10772
10773       if(store(icl_a) .lt. 0.)then                              ! cl deficit in aerosol. take some from gas
10774         aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a)    ! update aer(icl_a)
10775
10776         if(jp .ne. jtotal)then
10777           aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ &            ! update for jtotal
10778                                   aer(icl_a,jsolid,ibin)
10779         endif
10780
10781         gas(ihcl_g) = gas(ihcl_g) + store(icl_a)                        ! update gas(ihcl_g)
10782
10783         if(gas(ihcl_g) .lt. 0.0)then
10784           total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g)   ! update total_species
10785           tot_cl_in = tot_cl_in - gas(ihcl_g)                           ! update tot_cl_in
10786         endif
10787
10788         gas(ihcl_g) = max(0.D0, gas(ihcl_g))                            ! restrict gas(ihcl_g) to >= 0.
10789         store(icl_a) = 0.                                       ! force store(icl_a) to 0.
10790
10791       endif
10792
10793       store(icl_a) = max(0.D0, store(icl_a))
10794
10795       return
10796       end subroutine form_nacl
10797
10798
10799
10800       subroutine form_nh4so4(store,jp,ibin)     ! (nh4)2so4
10801 !     implicit none
10802 !     include 'mosaic.h'
10803 ! subr arguments
10804       integer jp, ibin
10805       real(kind=8) store(naer)
10806
10807       electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a),   &
10808                                            store(iso4_a))
10809       store(inh4_a)= store(inh4_a) - 2.*electrolyte(jnh4so4,jp,ibin)
10810       store(iso4_a)= store(iso4_a) - electrolyte(jnh4so4,jp,ibin)
10811       store(inh4_a) = max(0.D0, store(inh4_a))
10812       store(iso4_a) = max(0.D0, store(iso4_a))
10813
10814       return
10815       end subroutine form_nh4so4
10816
10817
10818
10819       subroutine form_nh4hso4(store,jp,ibin)    ! nh4hso4
10820 !     implicit none
10821 !     include 'mosaic.h'
10822 ! subr arguments
10823       integer jp, ibin
10824       real(kind=8) store(naer)
10825
10826       electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a),   &
10827                                           store(iso4_a))
10828       store(inh4_a)= store(inh4_a) - electrolyte(jnh4hso4,jp,ibin)
10829       store(iso4_a)= store(iso4_a) - electrolyte(jnh4hso4,jp,ibin)
10830       store(inh4_a) = max(0.D0, store(inh4_a))
10831       store(iso4_a) = max(0.D0, store(iso4_a))
10832
10833       return
10834       end subroutine form_nh4hso4
10835
10836
10837
10838       subroutine form_nh4msa(store,jp,ibin)
10839 !      implicit none
10840 !      include 'mosaic.h'
10841 ! subr arguments
10842       integer jp, ibin
10843       real(kind=8) store(naer)
10844
10845       electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a), &
10846                                          store(imsa_a))
10847       store(inh4_a) = store(inh4_a) - electrolyte(jnh4msa,jp,ibin)
10848       store(imsa_a) = store(imsa_a) - electrolyte(jnh4msa,jp,ibin)
10849       store(inh4_a) = max(0.D0, store(inh4_a))
10850       store(imsa_a) = max(0.D0, store(imsa_a))
10851
10852       return
10853       end subroutine form_nh4msa
10854
10855
10856
10857       subroutine form_nh4cl(store,jp,ibin)
10858 !     implicit none
10859 !     include 'mosaic.h'
10860 ! subr arguments
10861       integer jp, ibin
10862       real(kind=8) store(naer)
10863
10864       electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a),   &
10865                                         store(icl_a))
10866       store(inh4_a) = store(inh4_a) - electrolyte(jnh4cl,jp,ibin)
10867       store(icl_a)  = store(icl_a) - electrolyte(jnh4cl,jp,ibin)
10868       store(inh4_a) = max(0.D0, store(inh4_a))
10869       store(icl_a)  = max(0.D0, store(icl_a))
10870
10871       return
10872       end subroutine form_nh4cl
10873
10874
10875
10876       subroutine form_nh4no3(store,jp,ibin)
10877 !     implicit none
10878 !     include 'mosaic.h'
10879 ! subr arguments
10880       integer jp, ibin
10881       real(kind=8) store(naer)
10882
10883       electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a),   &
10884                                          store(ino3_a))
10885       store(inh4_a) = store(inh4_a) - electrolyte(jnh4no3,jp,ibin)
10886       store(ino3_a) = store(ino3_a) - electrolyte(jnh4no3,jp,ibin)
10887       store(inh4_a) = max(0.D0, store(inh4_a))
10888       store(ino3_a) = max(0.D0, store(ino3_a))
10889
10890       return
10891       end subroutine form_nh4no3
10892
10893
10894
10895       subroutine form_nh4so4_lvcite(store,jp,ibin) ! (nh4)2so4 + (nh4)3h(so4)2
10896 !     implicit none
10897 !     include 'mosaic.h'
10898 ! subr arguments
10899       integer jp, ibin
10900       real(kind=8) store(naer)
10901
10902       electrolyte(jnh4so4,jp,ibin)= 2.*store(inh4_a) - 3.*store(iso4_a)
10903       electrolyte(jlvcite,jp,ibin)= 2.*store(iso4_a) - store(inh4_a)
10904       electrolyte(jnh4so4,jp,ibin)= max(0.D0,   &
10905                                     electrolyte(jnh4so4,jp,ibin))
10906       electrolyte(jlvcite,jp,ibin)= max(0.D0,   &
10907                                     electrolyte(jlvcite,jp,ibin))
10908       store(inh4_a) = 0.
10909       store(iso4_a) = 0.
10910
10911       return
10912       end subroutine form_nh4so4_lvcite
10913
10914
10915
10916       subroutine form_lvcite_nh4hso4(store,jp,ibin) ! (nh4)3h(so4)2 + nh4hso4
10917 !     implicit none
10918 !     include 'mosaic.h'
10919 ! subr arguments
10920       integer jp, ibin
10921       real(kind=8) store(naer)
10922
10923       electrolyte(jlvcite,jp,ibin) = store(inh4_a) - store(iso4_a)
10924       electrolyte(jnh4hso4,jp,ibin)= 3.*store(iso4_a) - 2.*store(inh4_a)
10925       electrolyte(jlvcite,jp,ibin) = max(0.D0,   &
10926                                       electrolyte(jlvcite,jp,ibin))
10927       electrolyte(jnh4hso4,jp,ibin)= max(0.D0,   &
10928                                       electrolyte(jnh4hso4,jp,ibin))
10929       store(inh4_a) = 0.
10930       store(iso4_a) = 0.
10931
10932       return
10933       end subroutine form_lvcite_nh4hso4
10934
10935
10936
10937       subroutine form_na2so4_nahso4(store,jp,ibin) ! na2so4 + nahso4
10938 !     implicit none
10939 !     include 'mosaic.h'
10940 ! subr arguments
10941       integer jp, ibin
10942       real(kind=8) store(naer)
10943
10944       electrolyte(jna2so4,jp,ibin)= store(ina_a) - store(iso4_a)
10945       electrolyte(jnahso4,jp,ibin)= 2.*store(iso4_a) - store(ina_a)
10946       electrolyte(jna2so4,jp,ibin)= max(0.D0,   &
10947                                     electrolyte(jna2so4,jp,ibin))
10948       electrolyte(jnahso4,jp,ibin)= max(0.D0,   &
10949                                     electrolyte(jnahso4,jp,ibin))
10950       store(ina_a)  = 0.
10951       store(iso4_a) = 0.
10952
10953 !       write(6,*)'na2so4 + nahso4'
10954
10955       return
10956       end subroutine form_na2so4_nahso4
10957
10958
10959
10960
10961       subroutine form_h2so4(store,jp,ibin)
10962 !     implicit none
10963 !     include 'mosaic.h'
10964 ! subr arguments
10965       integer jp, ibin
10966       real(kind=8) store(naer)
10967
10968       electrolyte(jh2so4,jp,ibin) = max(0.0D0, store(iso4_a))
10969       store(iso4_a) = 0.0
10970
10971       return
10972       end subroutine form_h2so4
10973
10974
10975
10976
10977       subroutine form_msa(store,jp,ibin)
10978 !      implicit none
10979 !      include 'mosaic.h'
10980 ! subr arguments
10981       integer jp, ibin
10982       real(kind=8) store(naer)
10983
10984       electrolyte(jmsa,jp,ibin) = max(0.0D0, store(imsa_a))
10985       store(imsa_a) = 0.0
10986
10987       return
10988       end subroutine form_msa
10989
10990
10991
10992       subroutine form_hno3(store,jp,ibin)
10993 !     implicit none
10994 !     include 'mosaic.h'
10995 ! subr arguments
10996       integer jp, ibin
10997       real(kind=8) store(naer)
10998
10999       electrolyte(jhno3,jp,ibin) = max(0.0D0, store(ino3_a))
11000       store(ino3_a) = 0.0
11001
11002       return
11003       end subroutine form_hno3
11004
11005
11006
11007
11008       subroutine form_hcl(store,jp,ibin)
11009 !     implicit none
11010 !     include 'mosaic.h'
11011 ! subr arguments
11012       integer jp, ibin
11013       real(kind=8) store(naer)
11014
11015       electrolyte(jhcl,jp,ibin) = max(0.0D0, store(icl_a))
11016       store(icl_a) = 0.0
11017
11018       return
11019       end subroutine form_hcl
11020
11021
11022
11023
11024       subroutine degas_hno3(store,jp,ibin)
11025 !     implicit none
11026 !     include 'mosaic.h'
11027 ! subr arguments
11028       integer jp, ibin
11029       real(kind=8) store(naer)
11030
11031       store(ino3_a) = max(0.0D0, store(ino3_a))
11032       gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
11033       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - store(ino3_a)
11034       aer(ino3_a,jp,ibin) = max(0.0D0,aer(ino3_a,jp,ibin))
11035
11036 ! also do it for jtotal
11037       if(jp .ne. jtotal)then
11038         aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) +   &
11039                                   aer(ino3_a,jliquid,ibin)
11040       endif
11041
11042       electrolyte(jhno3,jp,ibin) = 0.0
11043       store(ino3_a) = 0.0
11044
11045       return
11046       end subroutine degas_hno3
11047
11048
11049
11050       subroutine degas_hcl(store,jp,ibin)
11051 !     implicit none
11052 !     include 'mosaic.h'
11053 ! subr arguments
11054       integer jp, ibin
11055       real(kind=8) store(naer)
11056
11057       store(icl_a) = max(0.0D0, store(icl_a))
11058       gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
11059       aer(icl_a,jp,ibin) = aer(icl_a,jp,ibin) - store(icl_a)
11060       aer(icl_a,jp,ibin) = max(0.0D0,aer(icl_a,jp,ibin))
11061
11062 ! also do it for jtotal
11063       if(jp .ne. jtotal)then
11064         aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) +   &
11065                                  aer(icl_a,jliquid,ibin)
11066       endif
11067
11068       electrolyte(jhcl,jp,ibin) = 0.0
11069       store(icl_a) = 0.0
11070
11071       return
11072       end subroutine degas_hcl
11073
11074
11075
11076       subroutine degas_nh3(store,jp,ibin)
11077 !     implicit none
11078 !     include 'mosaic.h'
11079 ! subr arguments
11080       integer jp, ibin
11081       real(kind=8) store(naer)
11082
11083       store(inh4_a) = max(0.0D0, store(inh4_a))
11084       gas(inh3_g) = gas(inh3_g) + store(inh4_a)
11085       aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - store(inh4_a)
11086       aer(inh4_a,jp,ibin) = max(0.0D0,aer(inh4_a,jp,ibin))
11087
11088 ! also do it for jtotal
11089       if(jp .ne. jtotal)then
11090         aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) +   &
11091                                  aer(inh4_a,jliquid,ibin)
11092       endif
11093
11094       store(inh4_a) = 0.0
11095
11096       return
11097       end subroutine degas_nh3
11098
11099
11100
11101
11102
11103
11104
11105
11106
11107       subroutine degas_acids(jp,ibin,xt)
11108 !     implicit none
11109 !     include 'mosaic.h'
11110 ! subr arguments
11111       integer jp, ibin
11112       real(kind=8) xt
11113 ! local variables
11114       real(kind=8) ehno3, ehcl
11115
11116
11117
11118       if(jp .ne. jliquid)then
11119         if (iprint_mosaic_diag1 .gt. 0) then
11120           write(6,*)'mosaic - error in degas_acids'
11121           write(6,*)'wrong jp'
11122         endif
11123       endif
11124
11125       ehno3 = electrolyte(jhno3,jp,ibin)
11126       ehcl  = electrolyte(jhcl,jp,ibin)
11127
11128 ! add to gas
11129       gas(ihno3_g) = gas(ihno3_g) + ehno3
11130       gas(ihcl_g)  = gas(ihcl_g)  + ehcl
11131
11132 ! remove from aer
11133       aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - ehno3
11134       aer(icl_a, jp,ibin) = aer(icl_a, jp,ibin) - ehcl
11135
11136 ! update jtotal
11137       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11138                                 aer(ino3_a,jsolid, ibin)
11139
11140       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
11141                                 aer(icl_a,jsolid, ibin)
11142
11143       electrolyte(jhno3,jp,ibin) = 0.0
11144       electrolyte(jhcl,jp,ibin)  = 0.0
11145
11146       return
11147       end subroutine degas_acids
11148
11149
11150
11151
11152
11153
11154
11155
11156
11157
11158
11159
11160
11161
11162 !***********************************************************************
11163 ! subroutines to evaporate solid volatile species
11164 !
11165 ! author: rahul a. zaveri
11166 ! update: sep 2004
11167 !-----------------------------------------------------------------------
11168 !
11169 ! nh4no3 (solid)
11170       subroutine degas_solid_nh4no3(ibin)
11171 !     implicit none
11172 !     include 'mosaic.h'
11173 ! subr arguments
11174       integer ibin
11175 ! local variables
11176       integer jp
11177       real(kind=8) a, b, c, xgas, xt
11178 !     real(kind=8) quadratic                                    ! mosaic func
11179
11180
11181       jp = jsolid
11182
11183       a = 1.0
11184       b = gas(inh3_g) + gas(ihno3_g)
11185       c = gas(inh3_g)*gas(ihno3_g) - keq_sg(1)
11186       xgas = quadratic(a,b,c)
11187
11188       if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
11189
11190           gas(inh3_g) = gas(inh3_g)  + electrolyte(jnh4no3,jp,ibin)
11191           gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
11192           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
11193                                 electrolyte(jnh4no3,jp,ibin)
11194           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) -   &
11195                                 electrolyte(jnh4no3,jp,ibin)
11196
11197       else      ! degas only xgas amount of nh4no3
11198
11199           gas(inh3_g) = gas(inh3_g)  + xgas
11200           gas(ihno3_g)= gas(ihno3_g) + xgas
11201           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
11202           aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
11203       endif
11204
11205
11206 ! update jtotal
11207       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11208                                  aer(inh4_a,jliquid,ibin)
11209       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11210                                  aer(ino3_a,jliquid,ibin)
11211
11212       return
11213       end subroutine degas_solid_nh4no3
11214
11215
11216
11217
11218
11219
11220
11221
11222
11223 ! nh4cl (solid)
11224       subroutine degas_solid_nh4cl(ibin)
11225 !     implicit none
11226 !     include 'mosaic.h'
11227 ! subr arguments
11228       integer ibin
11229 ! local variables
11230       integer jp
11231       real(kind=8) a, b, c, xgas, xt
11232 !     real(kind=8) quadratic                                    ! mosaic func
11233
11234
11235       jp = jsolid
11236
11237       a = 1.0
11238       b = gas(inh3_g) + gas(ihcl_g)
11239       c = gas(inh3_g)*gas(ihcl_g) - keq_sg(2)
11240       xgas = quadratic(a,b,c)
11241
11242       if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
11243
11244           gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
11245           gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
11246           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
11247                                 electrolyte(jnh4cl,jp,ibin)
11248           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin) -   &
11249                                 electrolyte(jnh4cl,jp,ibin)
11250
11251       else      ! degas only xgas amount of nh4cl
11252
11253           gas(inh3_g) = gas(inh3_g) + xgas
11254           gas(ihcl_g) = gas(ihcl_g) + xgas
11255           aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
11256           aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin)  - xgas
11257
11258       endif
11259
11260
11261 ! update jtotal
11262       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11263                                  aer(inh4_a,jliquid,ibin)
11264       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11265                                  aer(icl_a,jliquid,ibin)
11266
11267       return
11268       end subroutine degas_solid_nh4cl
11269
11270
11271
11272
11273
11274
11275
11276
11277
11278
11279
11280 !***********************************************************************
11281 ! subroutines to absorb and degas small amounts of volatile species
11282 !
11283 ! author: rahul a. zaveri
11284 ! update: jun 2002
11285 !-----------------------------------------------------------------------
11286 !
11287 ! nh4no3 (liquid)
11288       subroutine absorb_tiny_nh4no3(ibin)
11289 !     implicit none
11290 !     include 'mosaic.h'
11291 ! subr arguments
11292       integer ibin
11293 ! local variables
11294       real(kind=8) small_aer, small_gas, small_amt
11295       integer je                                        ! raz update 11/13/2008
11296
11297
11298
11299       electrolyte_sum(jtotal,ibin) = 0.0        ! raz update 11/13/2008
11300       do je = 1, nelectrolyte
11301         electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
11302                                        electrolyte(je,jtotal,ibin)
11303       enddo
11304
11305
11306       small_gas = 0.01 * min(gas(inh3_g), gas(ihno3_g))
11307       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
11308       if(small_aer .eq. 0.0)small_aer = small_gas
11309
11310       small_amt = min(small_gas, small_aer)
11311
11312       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
11313       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
11314
11315 ! update jtotal
11316       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11317                                  aer(inh4_a,jliquid,ibin)
11318       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11319                                  aer(ino3_a,jliquid,ibin)
11320
11321 ! update gas
11322       gas(inh3_g)    = gas(inh3_g) - small_amt
11323       gas(ihno3_g)   = gas(ihno3_g) - small_amt
11324
11325       return
11326       end subroutine absorb_tiny_nh4no3
11327
11328
11329
11330
11331
11332
11333 !--------------------------------------------------------------------
11334 ! nh4cl (liquid)
11335       subroutine absorb_tiny_nh4cl(ibin)
11336 !     implicit none
11337 !     include 'mosaic.h'
11338 ! subr arguments
11339       integer ibin
11340 ! local variables
11341       real(kind=8) small_aer, small_gas, small_amt
11342         integer je                                      ! raz update 11/13/2008
11343
11344
11345
11346       electrolyte_sum(jtotal,ibin) = 0.0        ! raz update 11/13/2008
11347       do je = 1, nelectrolyte
11348         electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
11349                                        electrolyte(je,jtotal,ibin)
11350       enddo
11351
11352
11353       small_gas = 0.01 * min(gas(inh3_g), gas(ihcl_g))
11354       small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
11355       if(small_aer .eq. 0.0)small_aer = small_gas
11356
11357       small_amt = min(small_gas, small_aer)
11358
11359       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
11360       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin)  + small_amt
11361
11362 ! update jtotal
11363       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11364                                  aer(inh4_a,jliquid,ibin)
11365       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11366                                  aer(icl_a,jliquid,ibin)
11367
11368 ! update gas
11369       gas(inh3_g)   = gas(inh3_g) - small_amt
11370       gas(ihcl_g)   = gas(ihcl_g) - small_amt
11371
11372       return
11373       end subroutine absorb_tiny_nh4cl
11374
11375
11376
11377
11378
11379
11380
11381
11382
11383
11384
11385
11386
11387 !--------------------------------------------------------------
11388 ! nh4no3 (liquid)
11389       subroutine degas_tiny_nh4no3(ibin)
11390 !     implicit none
11391 !     include 'mosaic.h'
11392 ! subr arguments
11393       integer ibin
11394 ! local variables
11395       real(kind=8) small_amt
11396
11397       small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
11398
11399       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
11400       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
11401
11402 ! update jtotal
11403       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11404                                  aer(inh4_a,jliquid,ibin)
11405       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11406                                  aer(ino3_a,jliquid,ibin)
11407
11408 ! update gas
11409       gas(inh3_g)  = gas(inh3_g)  + small_amt
11410       gas(ihno3_g) = gas(ihno3_g) + small_amt
11411
11412       return
11413       end subroutine degas_tiny_nh4no3
11414
11415
11416
11417
11418 !--------------------------------------------------------------------
11419 ! liquid nh4cl (liquid)
11420       subroutine degas_tiny_nh4cl(ibin)
11421 !     implicit none
11422 !     include 'mosaic.h'
11423 ! subr arguments
11424       integer ibin
11425 ! local variables
11426       real(kind=8) small_amt
11427
11428
11429       small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
11430
11431       aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) - small_amt
11432       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
11433
11434 ! update jtotal
11435       aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
11436                                  aer(inh4_a,jliquid,ibin)
11437       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
11438                                  aer(icl_a,jliquid,ibin)
11439
11440 ! update gas
11441       gas(inh3_g) = gas(inh3_g) + small_amt
11442       gas(ihcl_g) = gas(ihcl_g) + small_amt
11443
11444       return
11445       end subroutine degas_tiny_nh4cl
11446
11447
11448
11449
11450
11451
11452
11453 !--------------------------------------------------------------------
11454 ! hcl (liquid)
11455       subroutine absorb_tiny_hcl(ibin)  ! and degas tiny hno3
11456 !     implicit none
11457 !     include 'mosaic.h'
11458 ! subr arguments
11459       integer ibin
11460 ! local variables
11461       real(kind=8) small_aer, small_amt, small_gas
11462
11463       small_gas = 0.01 * gas(ihcl_g)
11464       small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
11465
11466       small_amt = min(small_gas, small_aer)
11467
11468 ! absorb tiny hcl
11469       aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
11470       aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) +   &
11471                                aer(icl_a,jliquid,ibin)
11472       gas(ihcl_g) = gas(ihcl_g) - small_amt
11473
11474 ! degas tiny hno3
11475       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) - small_amt
11476       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11477                                  aer(ino3_a,jliquid,ibin)
11478
11479 ! update gas
11480       gas(ihno3_g) = gas(ihno3_g) + small_amt
11481
11482       return
11483       end subroutine absorb_tiny_hcl
11484
11485
11486
11487 !--------------------------------------------------------------------
11488 ! hno3 (liquid)
11489       subroutine absorb_tiny_hno3(ibin) ! and degas tiny hcl
11490 !     implicit none
11491 !     include 'mosaic.h'
11492 ! subr arguments
11493       integer ibin
11494 ! local variables
11495       real(kind=8) small_aer, small_amt, small_gas
11496
11497       small_gas = 0.01 * gas(ihno3_g)
11498       small_aer = 0.01 * aer(icl_a,jliquid,ibin)
11499
11500       small_amt = min(small_gas, small_aer)
11501
11502 ! absorb tiny hno3
11503       aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
11504       aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
11505                                  aer(ino3_a,jliquid,ibin)
11506       gas(ihno3_g) = gas(ihno3_g) - small_amt
11507
11508 ! degas tiny hcl
11509       aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) - small_amt
11510       aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin) +   &
11511                                  aer(icl_a,jliquid,ibin)
11512
11513 ! update gas
11514       gas(ihcl_g) = gas(ihcl_g) + small_amt
11515
11516       return
11517       end subroutine absorb_tiny_hno3
11518
11519
11520
11521
11522
11523
11524
11525
11526
11527 !***********************************************************************
11528 ! subroutines to equilibrate volatile acids
11529 !
11530 ! author: rahul a. zaveri
11531 ! update: may 2002
11532 !-----------------------------------------------------------------------
11533       subroutine equilibrate_acids(ibin)
11534 !     implicit none
11535 !     include 'mosaic.h'
11536 ! subr arguments
11537       integer ibin
11538
11539
11540
11541       if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
11542         call equilibrate_hcl_and_hno3(ibin)
11543       elseif(gas(ihcl_g) .gt. 0.)then
11544         call equilibrate_hcl(ibin)
11545       elseif(gas(ihno3_g) .gt. 0.)then
11546         call equilibrate_hno3(ibin)
11547       endif
11548
11549
11550       return
11551       end subroutine equilibrate_acids
11552
11553
11554
11555
11556
11557
11558
11559
11560 ! only hcl
11561       subroutine equilibrate_hcl(ibin)
11562 !     implicit none
11563 !     include 'mosaic.h'
11564 ! subr arguments
11565       integer ibin
11566 ! local variables
11567       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hcl, mh, tcl,   &
11568         w, xt, z
11569 !     real(kind=8) quadratic                                    ! mosaic func
11570
11571       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11572       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11573
11574       tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g)               ! nmol/m^3(air)
11575       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
11576       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11577               aer(inh4_a,jliquid,ibin) +   &
11578            2.*aer(ica_a, jliquid,ibin) ) -   &
11579           (2.*aerso4  +   &
11580               aerhso4 +   &
11581               aer(ino3_a,jliquid,ibin) )
11582
11583
11584       w     = water_a(ibin)                             ! kg/m^3(air)
11585
11586       kdash_hcl = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2    ! (nmol^2/kg^2)/(nmol/m^3(air))
11587       a = 1.0
11588       b = (kdash_hcl*w + z/w)*1.e-9
11589       c = kdash_hcl*(z - tcl)*1.e-18
11590
11591
11592       dum = b*b - 4.*a*c
11593       if (dum .lt. 0.) return           ! no real root
11594
11595
11596       if(c .lt. 0.)then
11597         mh = quadratic(a,b,c)   ! mol/kg(water)
11598         aerh = mh*w*1.e+9
11599         aer(icl_a,jliquid,ibin) = aerh + z
11600       else
11601         mh = sqrt(keq_ll(3))
11602       endif
11603
11604       call form_electrolytes(jliquid,ibin,xt)
11605
11606 ! update gas phase concentration
11607       gas(ihcl_g) = tcl - aer(icl_a,jliquid,ibin)
11608
11609
11610 ! update the following molalities
11611       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11612       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11613       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11614       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11615
11616       mc(jc_h,ibin)    = mh
11617       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11618       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11619       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11620
11621
11622 ! update the following activities
11623       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
11624                                gam(jhcl,ibin)**2
11625
11626       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
11627                                gam(jhno3,ibin)**2
11628
11629       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
11630                                gam(jnh4cl,ibin)**2
11631
11632
11633 ! also update xyz(jtotal)
11634       aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) +   &
11635                                aer(icl_a,jsolid,ibin)
11636
11637       electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
11638
11639       return
11640       end subroutine equilibrate_hcl
11641
11642
11643
11644
11645 ! only hno3
11646       subroutine equilibrate_hno3(ibin)
11647 !     implicit none
11648 !     include 'mosaic.h'
11649 ! subr arguments
11650       integer ibin
11651 ! local variables
11652       real(kind=8) a, aerh, aerhso4, aerso4, b, c, dum, kdash_hno3, mh,   &
11653         tno3, w, xt, z
11654 !     real(kind=8) quadratic                                    ! mosaic func
11655
11656       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11657       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11658
11659       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
11660       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11661       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11662               aer(inh4_a,jliquid,ibin) +   &
11663            2.*aer(ica_a, jliquid,ibin) ) -   &
11664           (2.*aerso4  +   &
11665               aerhso4 +   &
11666               aer(icl_a,jliquid,ibin) )
11667
11668
11669       w     = water_a(ibin)                             ! kg/m^3(air)
11670
11671       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11672       a = 1.0
11673       b = (kdash_hno3*w + z/w)*1.e-9
11674       c = kdash_hno3*(z - tno3)*1.e-18
11675
11676       dum = b*b - 4.*a*c
11677       if (dum .lt. 0.) return           ! no real root
11678
11679
11680
11681       if(c .lt. 0.)then
11682         mh = quadratic(a,b,c)   ! mol/kg(water)
11683         aerh = mh*w*1.e+9
11684         aer(ino3_a,jliquid,ibin) = aerh + z
11685       else
11686         mh = sqrt(keq_ll(3))
11687       endif
11688
11689       call form_electrolytes(jliquid,ibin,xt)
11690
11691 ! update gas phase concentration
11692       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
11693
11694
11695 ! update the following molalities
11696       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11697       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11698       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11699       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11700
11701       mc(jc_h,ibin)    = mh
11702       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11703       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11704       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11705
11706
11707 ! update the following activities
11708       activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
11709                                gam(jhcl,ibin)**2
11710
11711       activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
11712                                gam(jhno3,ibin)**2
11713
11714       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) *   &
11715                                gam(jnh4no3,ibin)**2
11716
11717
11718 ! also update xyz(jtotal)
11719       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11720                                 aer(ino3_a,jsolid,ibin)
11721
11722       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
11723
11724       return
11725       end subroutine equilibrate_hno3
11726
11727
11728
11729
11730
11731
11732
11733
11734
11735
11736 ! both hcl and hno3
11737       subroutine equilibrate_hcl_and_hno3(ibin)
11738 !     implicit none
11739 !     include 'mosaic.h'
11740 ! subr arguments
11741       integer ibin
11742 ! local variables
11743       real(kind=8) aerh, aerhso4, aerso4, kdash_hcl, kdash_hno3,   &
11744         mh, p, q, r, tcl, tno3, w, xt, z
11745 !     real(kind=8) cubic                                        ! mosaic func
11746
11747
11748       aerso4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
11749       aerhso4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
11750
11751       tcl  = aer(icl_a,jliquid,ibin)  + gas(ihcl_g)     ! nmol/m^3(air)
11752       tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)    ! nmol/m^3(air)
11753
11754       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
11755       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11756
11757       z = (   aer(ina_a, jliquid,ibin) +                   &  ! nmol/m^3(air)
11758               aer(inh4_a,jliquid,ibin) +   &
11759            2.*aer(ica_a, jliquid,ibin) ) -   &
11760           (2.*aerso4 + aerhso4 )
11761
11762
11763       w = water_a(ibin)
11764
11765       kdash_hcl  = keq_gl(4)*1.e+18/gam(jhcl,ibin)**2   ! (nmol^2/kg^2)/(nmol/m^3(air))
11766       kdash_hno3 = keq_gl(3)*1.e+18/gam(jhno3,ibin)**2  ! (nmol^2/kg^2)/(nmol/m^3(air))
11767
11768       p = (z/w + w*(kdash_hcl + kdash_hno3))*1.e-9
11769
11770       q = 1.e-18*kdash_hcl*kdash_hno3*w**2  +   &
11771           1.e-18*z*(kdash_hcl + kdash_hno3) -   &
11772           1.e-18*kdash_hcl*tcl -   &
11773           1.e-18*kdash_hno3*tno3
11774
11775       r = 1.e-18*kdash_hcl*kdash_hno3*w*(z - tcl - tno3)*1.e-9
11776
11777       mh = cubic(p,q,r)
11778
11779       if(mh .gt. 0.0)then
11780         aerh = mh*w*1.e+9
11781         aer(ino3_a,jliquid,ibin) = kdash_hno3*w*w*tno3/   &
11782                                   (aerh + kdash_hno3*w*w)
11783         aer(icl_a, jliquid,ibin) = kdash_hcl*w*w*tcl/   &
11784                                   (aerh + kdash_hcl*w*w)
11785       else
11786         mh = sqrt(keq_ll(3))
11787       endif
11788
11789       call form_electrolytes(jliquid,ibin,xt)
11790
11791 ! update gas phase concentration
11792       gas(ihno3_g)= tno3 - aer(ino3_a,jliquid,ibin)
11793       gas(ihcl_g) = tcl  - aer(icl_a,jliquid,ibin)
11794
11795
11796 ! update the following molalities
11797       ma(ja_so4,ibin)  = 1.e-9*aerso4/water_a(ibin)
11798       ma(ja_hso4,ibin) = 1.e-9*aerhso4/water_a(ibin)
11799       ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
11800       ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
11801
11802       mc(jc_h,ibin)    = mh
11803       mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
11804       mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
11805       mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
11806
11807
11808 ! update the following activities
11809       activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)   *   &
11810                                gam(jhcl,ibin)**2
11811
11812       activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)  *   &
11813                                gam(jhno3,ibin)**2
11814
11815       activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)*   &
11816                                gam(jnh4no3,ibin)**2
11817
11818       activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
11819                                gam(jnh4cl,ibin)**2
11820
11821
11822 ! also update xyz(jtotal)
11823       aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
11824                                 aer(icl_a,jsolid,ibin)
11825
11826       aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
11827                                 aer(ino3_a,jsolid,ibin)
11828
11829       electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
11830       electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
11831
11832       return
11833       end subroutine equilibrate_hcl_and_hno3
11834
11835
11836
11837
11838
11839
11840
11841
11842
11843
11844
11845
11846
11847 !***********************************************************************
11848 ! called only once per entire simulation to load gas and aerosol
11849 ! indices, parameters, physico-chemical constants, polynomial coeffs, etc.
11850 !
11851 ! author: rahul a. zaveri
11852 ! update: jan 2005
11853 !-----------------------------------------------------------------------
11854       subroutine load_mosaic_parameters
11855 !     implicit none
11856 !     include 'v33com2'
11857 !     include 'mosaic.h'
11858 ! local variables
11859       integer iaer, je, ja, j_index, ibin
11860 !     logical first
11861 !     save first
11862 !     data first/.true./
11863       logical, save :: first = .true.
11864
11865
11866
11867       if(first)then
11868         first=.false.
11869
11870 !----------------------------------------------------------------
11871 ! control settings
11872       msize_framework = msection        ! mmodal or msection
11873       mgas_aer_xfer   = myes            ! myes, mno
11874
11875 ! astem parameters
11876       nmax_astem      = 200             ! max number of time steps in astem
11877       alpha_astem     = 0.05            ! choose a value between 0.01 and 1.0
11878 ! Changed alpha_astem from 0.5 to 0.05 by Manish Shrivastava on 01/08/2010
11879       rtol_eqb_astem  = 0.01            ! equilibrium tolerance in astem
11880       ptol_mol_astem  = 0.01            ! mol percent tolerance in astem
11881
11882 ! mesa parameters
11883       nmax_mesa       = 80              ! max number of iterations in mesa_ptc
11884       rtol_mesa       = 0.01            ! mesa equilibrium tolerance
11885 !----------------------------------------------------------------
11886 !
11887 ! set gas and aerosol indices
11888 !
11889 ! gas (local)
11890
11891
11892       ih2so4_g  = 1     ! ioa (inorganic aerosol)
11893       ihno3_g   = 2     ! ioa
11894       ihcl_g    = 3     ! ioa
11895       inh3_g    = 4     ! ioa
11896       imsa_g    = 5     ! ioa
11897       ipcg1_b_c_g =6
11898       ipcg2_b_c_g =7
11899       ipcg3_b_c_g =8
11900       ipcg4_b_c_g =9
11901       ipcg5_b_c_g =10
11902       ipcg6_b_c_g =11
11903       ipcg7_b_c_g =12
11904       ipcg8_b_c_g =13
11905       ipcg9_b_c_g =14
11906       ipcg1_b_o_g =15
11907       ipcg2_b_o_g =16
11908       ipcg3_b_o_g =17
11909       ipcg4_b_o_g =18
11910       ipcg5_b_o_g =19
11911       ipcg6_b_o_g =20
11912       ipcg7_b_o_g =21
11913       ipcg8_b_o_g =22
11914       ipcg9_b_o_g =23
11915       iopcg1_b_c_g =24
11916       iopcg2_b_c_g = 25
11917       iopcg3_b_c_g =26
11918       iopcg4_b_c_g =27
11919       iopcg5_b_c_g =28
11920       iopcg6_b_c_g =29
11921       iopcg7_b_c_g =30
11922       iopcg8_b_c_g =31
11923       iopcg1_b_o_g =32
11924       iopcg2_b_o_g =33
11925       iopcg3_b_o_g =34
11926       iopcg4_b_o_g =35
11927       iopcg5_b_o_g =36
11928       iopcg6_b_o_g =37
11929       iopcg7_b_o_g =38
11930       iopcg8_b_o_g =39
11931       ipcg1_f_c_g =40
11932       ipcg2_f_c_g =41
11933       ipcg3_f_c_g =42
11934       ipcg4_f_c_g =43
11935       ipcg5_f_c_g =44
11936       ipcg6_f_c_g =45
11937       ipcg7_f_c_g =46
11938       ipcg8_f_c_g =47
11939       ipcg9_f_c_g =48
11940       ipcg1_f_o_g =49
11941       ipcg2_f_o_g =50
11942       ipcg3_f_o_g =51
11943       ipcg4_f_o_g =52
11944       ipcg5_f_o_g =53
11945       ipcg6_f_o_g =54
11946       ipcg7_f_o_g =55
11947       ipcg8_f_o_g =56
11948       ipcg9_f_o_g =57
11949       iopcg1_f_c_g =58
11950       iopcg2_f_c_g =59
11951       iopcg3_f_c_g =60
11952       iopcg4_f_c_g =61
11953       iopcg5_f_c_g =62
11954       iopcg6_f_c_g =63
11955       iopcg7_f_c_g =64
11956       iopcg8_f_c_g =65
11957       iopcg1_f_o_g =66
11958       iopcg2_f_o_g =67
11959       iopcg3_f_o_g =68
11960       iopcg4_f_o_g =69
11961       iopcg5_f_o_g =70
11962       iopcg6_f_o_g =71
11963       iopcg7_f_o_g =72
11964       iopcg8_f_o_g =73
11965       ismpa_g =74
11966       ismpbb_g =75
11967       iant1_c_g =76
11968       iant2_c_g =77
11969       iant3_c_g =78
11970       iant4_c_g =79
11971       iant1_o_g =80
11972       iant2_o_g =81
11973       iant3_o_g =82
11974       iant4_o_g =83
11975       ibiog1_c_g =84
11976       ibiog2_c_g =85
11977       ibiog3_c_g =86
11978       ibiog4_c_g =87
11979       ibiog1_o_g =88
11980       ibiog2_o_g =89
11981       ibiog3_o_g =90
11982       ibiog4_o_g =91
11983 !      in2o5_g    =92  ! ioa --> NO3-
11984 !      iclno2_g   =93  ! ioa N2O5+Cl- -->
11985 !     the order of species is ngas_ioa, then ngas_soa, then the rest...
11986 !     for the "equilibrium" routine i*_a and i*_g species
11987 !     have to have the same index.
11988       iasoaX_g=92
11989       iasoa1_g=93
11990       iasoa2_g=94
11991       iasoa3_g=95
11992       iasoa4_g=96
11993       ibsoaX_g=97
11994       ibsoa1_g=98
11995       ibsoa2_g=99
11996       ibsoa3_g=100
11997       ibsoa4_g=101
11998       in2o5_g    =102  ! ioa --> NO3-
11999       iclno2_g   =103  ! ioa N2O5+Cl- -->
12000
12001       igly       =104
12002       iho        =105
12003
12004
12005 !      ico2_g   = 14    ! currently not used
12006 !
12007 ! aerosol (local): used for total species
12008       iso4_a    =  1    ! <-> ih2so4_g
12009       ino3_a    =  2    ! <-> ihno3_g
12010       icl_a     =  3    ! <-> ihcl_g
12011       inh4_a    =  4    ! <-> inh3_g
12012       imsa_a    =  5    ! <-> imsa_g
12013       ipcg1_b_c_a =6
12014       ipcg2_b_c_a =7
12015       ipcg3_b_c_a =8
12016       ipcg4_b_c_a =9
12017       ipcg5_b_c_a =10
12018       ipcg6_b_c_a =11
12019       ipcg7_b_c_a =12
12020       ipcg8_b_c_a =13
12021       ipcg9_b_c_a =14
12022       ipcg1_b_o_a =15
12023       ipcg2_b_o_a =16
12024       ipcg3_b_o_a =17
12025       ipcg4_b_o_a =18
12026       ipcg5_b_o_a =19
12027       ipcg6_b_o_a =20
12028       ipcg7_b_o_a =21
12029       ipcg8_b_o_a =22
12030       ipcg9_b_o_a =23
12031       iopcg1_b_c_a =24
12032       iopcg2_b_c_a = 25
12033       iopcg3_b_c_a =26
12034       iopcg4_b_c_a =27
12035       iopcg5_b_c_a =28
12036       iopcg6_b_c_a =29
12037       iopcg7_b_c_a =30
12038       iopcg8_b_c_a =31
12039       iopcg1_b_o_a =32
12040       iopcg2_b_o_a = 33
12041       iopcg3_b_o_a =34
12042       iopcg4_b_o_a =35
12043       iopcg5_b_o_a =36
12044       iopcg6_b_o_a =37
12045       iopcg7_b_o_a =38
12046       iopcg8_b_o_a =39
12047       ipcg1_f_c_a =40
12048       ipcg2_f_c_a =41
12049       ipcg3_f_c_a =42
12050       ipcg4_f_c_a =43
12051       ipcg5_f_c_a =44
12052       ipcg6_f_c_a =45
12053       ipcg7_f_c_a =46
12054       ipcg8_f_c_a =47
12055       ipcg9_f_c_a =48
12056       ipcg1_f_o_a =49
12057       ipcg2_f_o_a =50
12058       ipcg3_f_o_a =51
12059       ipcg4_f_o_a =52
12060       ipcg5_f_o_a =53
12061       ipcg6_f_o_a =54
12062       ipcg7_f_o_a =55
12063       ipcg8_f_o_a =56
12064       ipcg9_f_o_a =57
12065       iopcg1_f_c_a =58
12066       iopcg2_f_c_a =59
12067       iopcg3_f_c_a =60
12068       iopcg4_f_c_a =61
12069       iopcg5_f_c_a =62
12070       iopcg6_f_c_a =63
12071       iopcg7_f_c_a =64
12072       iopcg8_f_c_a =65
12073       iopcg1_f_o_a =66
12074       iopcg2_f_o_a =67
12075       iopcg3_f_o_a =68
12076       iopcg4_f_o_a =69
12077       iopcg5_f_o_a =70
12078       iopcg6_f_o_a =71
12079       iopcg7_f_o_a =72
12080       iopcg8_f_o_a =73
12081       ismpa_a =74
12082       ismpbb_a =75
12083       iant1_c_a =76
12084       iant2_c_a =77
12085       iant3_c_a =78
12086       iant4_c_a =79
12087       iant1_o_a =80
12088       iant2_o_a =81
12089       iant3_o_a =82
12090       iant4_o_a =83
12091       ibiog1_c_a =84
12092       ibiog2_c_a =85
12093       ibiog3_c_a =86
12094       ibiog4_c_a =87
12095       ibiog1_o_a =88
12096       ibiog2_o_a =89
12097       ibiog3_o_a =90
12098       ibiog4_o_a =91
12099 ! for the "equilibrium" routine,
12100 ! i*_g and i*_a species have to have the same index...
12101 !      ico3_a    = 92    ! <-> ico2_g ! ico3_a was 14 earlier, changed to 82 by Manish Shrivastava
12102 !      ina_a     = 93
12103 !      ica_a     = 94
12104 !      ioin_a    = 95
12105 !      ioc_a     = 96
12106 !      ibc_a     = 97
12107       iasoaX_a=92
12108       iasoa1_a=93
12109       iasoa2_a=94
12110       iasoa3_a=95
12111       iasoa4_a=96
12112       ibsoaX_a=97
12113       ibsoa1_a=98
12114       ibsoa2_a=99
12115       ibsoa3_a=100
12116       ibsoa4_a=101
12117       iglysoa_r1_a = 102
12118       iglysoa_r2_a = 103
12119       iglysoa_sfc_a = 104
12120       iglysoa_nh4_a = 105
12121       iglysoa_oh_a = 106
12122
12123       ico3_a    = 107    ! <-> ico2_g ! ico3_a was 14 earlier, changed to 82 by Manish Shrivastava
12124       ina_a     = 108
12125       ica_a     = 109
12126       ioin_a    = 110
12127       ioc_a     = 111
12128       ibc_a     = 112
12129
12130 ! electrolyte indices (used for water content calculations)
12131 ! these indices are order sensitive
12132
12133       jnh4so4   =  1    ! soluble
12134       jlvcite   =  2    ! soluble
12135       jnh4hso4  =  3    ! soluble
12136       jnh4msa   =  4    ! soluble new
12137       jnh4no3   =  5    ! soluble
12138       jnh4cl    =  6    ! soluble
12139       jna2so4   =  7    ! soluble
12140       jna3hso4  =  8    ! soluble
12141       jnahso4   =  9    ! soluble
12142       jnamsa    = 10    ! soluble new
12143       jnano3    = 11    ! soluble
12144       jnacl     = 12    ! soluble
12145       jcano3    = 13    ! soluble
12146       jcacl2    = 14    ! soluble
12147       jcamsa2   = 15    ! soluble new     nsalt
12148       jh2so4    = 16    ! soluble
12149       jmsa      = 17    ! soluble new
12150       jhno3     = 18    ! soluble
12151       jhcl      = 19    ! soluble
12152       jhhso4    = 20    ! soluble
12153       jcaso4    = 21    ! insoluble
12154       jcaco3    = 22    ! insoluble
12155       joc       = 23    ! insoluble - part of naercomp
12156       jbc       = 24    ! insoluble - part of naercomp
12157       join      = 25    ! insoluble - part of naercomp
12158       jpcg1_b_c =26
12159       jpcg2_b_c =27
12160       jpcg3_b_c =28
12161       jpcg4_b_c =29
12162       jpcg5_b_c =30
12163       jpcg6_b_c =31
12164       jpcg7_b_c =32
12165       jpcg8_b_c =33
12166       jpcg9_b_c =34
12167       jpcg1_b_o =35
12168       jpcg2_b_o =36
12169       jpcg3_b_o =37
12170       jpcg4_b_o =38
12171       jpcg5_b_o =39
12172       jpcg6_b_o =40
12173       jpcg7_b_o =41
12174       jpcg8_b_o =42
12175       jpcg9_b_o =43
12176       jopcg1_b_c =44
12177       jopcg2_b_c =45
12178       jopcg3_b_c =46
12179       jopcg4_b_c =47
12180       jopcg5_b_c =48
12181       jopcg6_b_c =49
12182       jopcg7_b_c =50
12183       jopcg8_b_c =51
12184       jopcg1_b_o =52
12185       jopcg2_b_o =53
12186       jopcg3_b_o =54
12187       jopcg4_b_o =55
12188       jopcg5_b_o =56
12189       jopcg6_b_o =57
12190       jopcg7_b_o =58
12191       jopcg8_b_o =59
12192       jpcg1_f_c =60
12193       jpcg2_f_c =61
12194       jpcg3_f_c =62
12195       jpcg4_f_c =63
12196       jpcg5_f_c =64
12197       jpcg6_f_c =65
12198       jpcg7_f_c =66
12199       jpcg8_f_c =67
12200       jpcg9_f_c =68
12201       jpcg1_f_o =69
12202       jpcg2_f_o =70
12203       jpcg3_f_o =71
12204       jpcg4_f_o =72
12205       jpcg5_f_o =73
12206       jpcg6_f_o =74
12207       jpcg7_f_o =75
12208       jpcg8_f_o =76
12209       jpcg9_f_o =77
12210       jopcg1_f_c =78
12211       jopcg2_f_c =79
12212       jopcg3_f_c =80
12213       jopcg4_f_c =81
12214       jopcg5_f_c =82
12215       jopcg6_f_c =83
12216       jopcg7_f_c =84
12217       jopcg8_f_c =85
12218       jopcg1_f_o =86
12219       jopcg2_f_o =87
12220       jopcg3_f_o =88
12221       jopcg4_f_o =89
12222       jopcg5_f_o =90
12223       jopcg6_f_o =91
12224       jopcg7_f_o =92
12225       jopcg8_f_o =93
12226       jsmpa =94
12227       jsmpbb =95
12228       jant1_c =96
12229       jant2_c =97
12230       jant3_c =98
12231       jant4_c =99
12232       jant1_o =100
12233       jant2_o =101
12234       jant3_o =102
12235       jant4_o =103
12236       jbiog1_c =104
12237       jbiog2_c =105
12238       jbiog3_c =106
12239       jbiog4_c =107
12240       jbiog1_o =108
12241       jbiog2_o =109
12242       jbiog3_o =110
12243       jbiog4_o =111
12244 !      jh2o     = 112   ! water - part of naercomp
12245       jasoaX=112
12246       jasoa1=113
12247       jasoa2=114
12248       jasoa3=115
12249       jasoa4=116
12250       jbsoaX=117
12251       jbsoa1=118
12252       jbsoa2=119
12253       jbsoa3=120
12254       jbsoa4=121
12255       jglysoa_r1  = 122
12256       jglysoa_r2  = 123
12257       jglysoa_sfc = 124
12258       jglysoa_nh4 = 125
12259       jglysoa_oh  = 126
12260       jh2o  = 127 ! water - part of naercomp
12261
12262 ! local aerosol ions
12263 ! cations
12264       jc_h      =  1
12265       jc_nh4    =  2
12266       jc_na     =  3
12267       jc_ca     =  4
12268 !
12269 ! anions
12270       ja_hso4   =  1
12271       ja_so4    =  2
12272       ja_no3    =  3
12273       ja_cl     =  4
12274       ja_msa    =  5
12275 !     ja_co3    =  6
12276
12277 !--------------------------------------------------------------------
12278 ! phase state names
12279 !      phasestate(no_aerosol) = "NOAERO"
12280 !      phasestate(all_solid)  = "SOLID "
12281 !      phasestate(all_liquid) = "LIQUID"
12282 !      phasestate(mixed)      = "MIXED "
12283
12284 ! names of aer species
12285       aer_name(iso4_a) = 'so4'
12286       aer_name(ino3_a) = 'no3'
12287       aer_name(icl_a)  = 'cl '
12288       aer_name(inh4_a) = 'nh4'
12289       aer_name(ioc_a)  = 'oc '
12290       aer_name(imsa_a) = 'msa'
12291       aer_name(ico3_a) = 'co3'
12292       aer_name(ina_a)  = 'na '
12293       aer_name(ica_a)  = 'ca '
12294       aer_name(ibc_a)  = 'bc '
12295       aer_name(ioin_a) = 'oin'
12296       aer_name(ipcg1_b_c_a)="pcg1_b_c"
12297       aer_name(ipcg2_b_c_a)="pcg2_b_c"
12298       aer_name(ipcg3_b_c_a)="pcg3_b_c"
12299       aer_name(ipcg4_b_c_a)="pcg4_b_c"
12300       aer_name(ipcg5_b_c_a)="pcg5_b_c"
12301       aer_name(ipcg6_b_c_a)="pcg6_b_c"
12302       aer_name(ipcg7_b_c_a)="pcg7_b_c"
12303       aer_name(ipcg8_b_c_a)="pcg8_b_c"
12304       aer_name(ipcg9_b_c_a)="pcg9_b_c"
12305       aer_name(iopcg1_b_c_a)="opcg1_b_c"
12306       aer_name(iopcg2_b_c_a)="opcg2_b_c"
12307       aer_name(iopcg3_b_c_a)="opcg3_b_c"
12308       aer_name(iopcg4_b_c_a)="opcg4_b_c"
12309       aer_name(iopcg5_b_c_a)="opcg5_b_c"
12310       aer_name(iopcg6_b_c_a)="opcg6_b_c"
12311       aer_name(iopcg7_b_c_a)="opcg7_b_c"
12312       aer_name(iopcg8_b_c_a)="opcg8_b_c"
12313       aer_name(ipcg1_b_o_a)="pcg1_b_o"
12314       aer_name(ipcg2_b_o_a)="pcg2_b_o"
12315       aer_name(ipcg3_b_o_a)="pcg3_b_o"
12316       aer_name(ipcg4_b_o_a)="pcg4_b_o"
12317       aer_name(ipcg5_b_o_a)="pcg5_b_o"
12318       aer_name(ipcg6_b_o_a)="pcg6_b_o"
12319       aer_name(ipcg7_b_o_a)="pcg7_b_o"
12320       aer_name(ipcg8_b_o_a)="pcg8_b_o"
12321       aer_name(ipcg9_b_o_a)="pcg9_b_o"
12322       aer_name(iopcg1_b_o_a)="opcg1_b_o"
12323       aer_name(iopcg2_b_o_a)="opcg2_b_o"
12324       aer_name(iopcg3_b_o_a)="opcg3_b_o"
12325       aer_name(iopcg4_b_o_a)="opcg4_b_o"
12326       aer_name(iopcg5_b_o_a)="opcg5_b_o"
12327       aer_name(iopcg6_b_o_a)="opcg6_b_o"
12328       aer_name(iopcg7_b_o_a)="opcg7_b_o"
12329       aer_name(iopcg8_b_o_a)="opcg8_b_o"
12330       aer_name(ipcg1_f_c_a)="pcg1_f_c"
12331       aer_name(ipcg2_f_c_a)="pcg2_f_c"
12332       aer_name(ipcg3_f_c_a)="pcg3_f_c"
12333       aer_name(ipcg4_f_c_a)="pcg4_f_c"
12334       aer_name(ipcg5_f_c_a)="pcg5_f_c"
12335       aer_name(ipcg6_f_c_a)="pcg6_f_c"
12336       aer_name(ipcg7_f_c_a)="pcg7_f_c"
12337       aer_name(ipcg8_f_c_a)="pcg8_f_c"
12338       aer_name(ipcg9_f_c_a)="pcg9_f_c"
12339       aer_name(iopcg1_f_c_a)="opcg1_f_c"
12340       aer_name(iopcg2_f_c_a)="opcg2_f_c"
12341       aer_name(iopcg3_f_c_a)="opcg3_f_c"
12342       aer_name(iopcg4_f_c_a)="opcg4_f_c"
12343       aer_name(iopcg5_f_c_a)="opcg5_f_c"
12344       aer_name(iopcg6_f_c_a)="opcg6_f_c"
12345       aer_name(iopcg7_f_c_a)="opcg7_f_c"
12346       aer_name(iopcg8_f_c_a)="opcg8_f_c"
12347       aer_name(ipcg1_f_o_a)="pcg1_f_o"
12348       aer_name(ipcg2_f_o_a)="pcg2_f_o"
12349       aer_name(ipcg3_f_o_a)="pcg3_f_o"
12350       aer_name(ipcg4_f_o_a)="pcg4_f_o"
12351       aer_name(ipcg5_f_o_a)="pcg5_f_o"
12352       aer_name(ipcg6_f_o_a)="pcg6_f_o"
12353       aer_name(ipcg7_f_o_a)="pcg7_f_o"
12354       aer_name(ipcg8_f_o_a)="pcg8_f_o"
12355       aer_name(ipcg9_f_o_a)="pcg9_f_o"
12356       aer_name(iopcg1_f_o_a)="opcg1_f_o"
12357       aer_name(iopcg2_f_o_a)="opcg2_f_o"
12358       aer_name(iopcg3_f_o_a)="opcg3_f_o"
12359       aer_name(iopcg4_f_o_a)="opcg4_f_o"
12360       aer_name(iopcg5_f_o_a)="opcg5_f_o"
12361       aer_name(iopcg6_f_o_a)="opcg6_f_o"
12362       aer_name(iopcg7_f_o_a)="opcg7_f_o"
12363       aer_name(iopcg8_f_o_a)="opcg8_f_o"
12364       aer_name(ismpa_a)="smpa"
12365       aer_name(ismpbb_a)="smpbb"
12366       aer_name(iglysoa_r1_a)="glysoa_r1"
12367       aer_name(iglysoa_r2_a)="glysoa_r2"
12368       aer_name(iglysoa_sfc_a)="glysoa_sfc"
12369       aer_name(iglysoa_nh4_a)="glysoa_nh4"
12370       aer_name(iglysoa_oh_a)="glysoa_oh"
12371       aer_name(iant1_c_a)="ant1_c"
12372       aer_name(iant2_c_a)="ant2_c"
12373       aer_name(iant3_c_a)="ant3_c"
12374       aer_name(iant4_c_a)="ant4_c"
12375       aer_name(iant1_o_a)="ant1_o"
12376       aer_name(iant2_o_a)="ant2_o"
12377       aer_name(iant3_o_a)="ant3_o"
12378       aer_name(iant4_o_a)="ant4_o"
12379       aer_name(ibiog1_c_a)="biog1_c"
12380       aer_name(ibiog2_c_a)="biog2_c"
12381       aer_name(ibiog3_c_a)="biog3_c"
12382       aer_name(ibiog4_c_a)="biog4_c"
12383       aer_name(ibiog1_o_a)="biog1_o"
12384       aer_name(ibiog2_o_a)="biog2_o"
12385       aer_name(ibiog3_o_a)="biog3_o"
12386       aer_name(ibiog4_o_a)="biog4_o"
12387       aer_name(iasoaX_a)="asoaX"
12388       aer_name(iasoa1_a)="asoa1"
12389       aer_name(iasoa2_a)="asoa2"
12390       aer_name(iasoa3_a)="asoa3"
12391       aer_name(iasoa4_a)="asoa4"
12392       aer_name(ibsoaX_a)="bsoaX"
12393       aer_name(ibsoa1_a)="bsoa1"
12394       aer_name(ibsoa2_a)="bsoa2"
12395       aer_name(ibsoa3_a)="bsoa3"
12396       aer_name(ibsoa4_a)="bsoa4"
12397
12398 ! names of gas species
12399       gas_name(ih2so4_g) = 'h2so4'
12400       gas_name(ihno3_g)  = 'hno3 '
12401       gas_name(ihcl_g)   = 'hcl  '
12402       gas_name(inh3_g)   = 'nh3  '
12403       gas_name(imsa_g)   = "msa  "
12404       gas_name(ipcg1_b_c_g)="pcg1_b_c"
12405       gas_name(ipcg2_b_c_g)="pcg2_b_c"
12406       gas_name(ipcg3_b_c_g)="pcg3_b_c"
12407       gas_name(ipcg4_b_c_g)="pcg4_b_c"
12408       gas_name(ipcg5_b_c_g)="pcg5_b_c"
12409       gas_name(ipcg6_b_c_g)="pcg6_b_c"
12410       gas_name(ipcg7_b_c_g)="pcg7_b_c"
12411       gas_name(ipcg8_b_c_g)="pcg8_b_c"
12412       gas_name(ipcg9_b_c_g)="pcg9_b_c"
12413       gas_name(iopcg1_b_c_g)="opcg1_b_c"
12414       gas_name(iopcg2_b_c_g)="opcg2_b_c"
12415       gas_name(iopcg3_b_c_g)="opcg3_b_c"
12416       gas_name(iopcg4_b_c_g)="opcg4_b_c"
12417       gas_name(iopcg5_b_c_g)="opcg5_b_c"
12418       gas_name(iopcg6_b_c_g)="opcg6_b_c"
12419       gas_name(iopcg7_b_c_g)="opcg7_b_c"
12420       gas_name(iopcg8_b_c_g)="opcg8_b_c"
12421       gas_name(ipcg1_b_o_g)="pcg1_b_o"
12422       gas_name(ipcg2_b_o_g)="pcg2_b_o"
12423       gas_name(ipcg3_b_o_g)="pcg3_b_o"
12424       gas_name(ipcg4_b_o_g)="pcg4_b_o"
12425       gas_name(ipcg5_b_o_g)="pcg5_b_o"
12426       gas_name(ipcg6_b_o_g)="pcg6_b_o"
12427       gas_name(ipcg7_b_o_g)="pcg7_b_o"
12428       gas_name(ipcg8_b_o_g)="pcg8_b_o"
12429       gas_name(ipcg9_b_o_g)="pcg9_b_o"
12430       gas_name(iopcg1_b_o_g)="opcg1_b_o"
12431       gas_name(iopcg2_b_o_g)="opcg2_b_o"
12432       gas_name(iopcg3_b_o_g)="opcg3_b_o"
12433       gas_name(iopcg4_b_o_g)="opcg4_b_o"
12434       gas_name(iopcg5_b_o_g)="opcg5_b_o"
12435       gas_name(iopcg6_b_o_g)="opcg6_b_o"
12436       gas_name(iopcg7_b_o_g)="opcg7_b_o"
12437       gas_name(iopcg8_b_o_g)="opcg8_b_o"
12438       gas_name(ipcg1_f_c_g)="pcg1_f_c"
12439       gas_name(ipcg2_f_c_g)="pcg2_f_c"
12440       gas_name(ipcg3_f_c_g)="pcg3_f_c"
12441       gas_name(ipcg4_f_c_g)="pcg4_f_c"
12442       gas_name(ipcg5_f_c_g)="pcg5_f_c"
12443       gas_name(ipcg6_f_c_g)="pcg6_f_c"
12444       gas_name(ipcg7_f_c_g)="pcg7_f_c"
12445       gas_name(ipcg8_f_c_g)="pcg8_f_c"
12446       gas_name(ipcg9_f_c_g)="pcg9_f_c"
12447       gas_name(iopcg1_f_c_g)="opcg1_f_c"
12448       gas_name(iopcg2_f_c_g)="opcg2_f_c"
12449       gas_name(iopcg3_f_c_g)="opcg3_f_c"
12450       gas_name(iopcg4_f_c_g)="opcg4_f_c"
12451       gas_name(iopcg5_f_c_g)="opcg5_f_c"
12452       gas_name(iopcg6_f_c_g)="opcg6_f_c"
12453       gas_name(iopcg7_f_c_g)="opcg7_f_c"
12454       gas_name(iopcg8_f_c_g)="opcg8_f_c"
12455       gas_name(ipcg1_f_o_g)="pcg1_f_o"
12456       gas_name(ipcg2_f_o_g)="pcg2_f_o"
12457       gas_name(ipcg3_f_o_g)="pcg3_f_o"
12458       gas_name(ipcg4_f_o_g)="pcg4_f_o"
12459       gas_name(ipcg5_f_o_g)="pcg5_f_o"
12460       gas_name(ipcg6_f_o_g)="pcg6_f_o"
12461       gas_name(ipcg7_f_o_g)="pcg7_f_o"
12462       gas_name(ipcg8_f_o_g)="pcg8_f_o"
12463       gas_name(ipcg9_f_o_g)="pcg9_f_o"
12464       gas_name(iopcg1_f_o_g)="opcg1_f_o"
12465       gas_name(iopcg2_f_o_g)="opcg2_f_o"
12466       gas_name(iopcg3_f_o_g)="opcg3_f_o"
12467       gas_name(iopcg4_f_o_g)="opcg4_f_o"
12468       gas_name(iopcg5_f_o_g)="opcg5_f_o"
12469       gas_name(iopcg6_f_o_g)="opcg6_f_o"
12470       gas_name(iopcg7_f_o_g)="opcg7_f_o"
12471       gas_name(iopcg8_f_o_g)="opcg8_f_o"
12472       gas_name(ismpa_g)="smpa"
12473       gas_name(ismpbb_g)="smpbb"
12474       gas_name(iant1_c_g)="ant1_c"
12475       gas_name(iant2_c_g)="ant2_c"
12476       gas_name(iant3_c_g)="ant3_c"
12477       gas_name(iant4_c_g)="ant4_c"
12478       gas_name(iant1_o_g)="ant1_o"
12479       gas_name(iant2_o_g)="ant2_o"
12480       gas_name(iant3_o_g)="ant3_o"
12481       gas_name(iant4_o_g)="ant4_o"
12482       gas_name(ibiog1_c_g)="biog1_c"
12483       gas_name(ibiog2_c_g)="biog2_c"
12484       gas_name(ibiog3_c_g)="biog3_c"
12485       gas_name(ibiog4_c_g)="biog4_c"
12486       gas_name(ibiog1_o_g)="biog1_o"
12487       gas_name(ibiog2_o_g)="biog2_o"
12488       gas_name(ibiog3_o_g)="biog3_o"
12489       gas_name(ibiog4_o_g)="biog4_o"
12490       gas_name(in2o5_g) = "n2o5 "
12491       gas_name(iclno2_g)= "clno2"
12492       gas_name(iasoaX_g)="asoaX"
12493       gas_name(iasoa1_g)="asoa1"
12494       gas_name(iasoa2_g)="asoa2"
12495       gas_name(iasoa3_g)="asoa3"
12496       gas_name(iasoa4_g)="asoa4"
12497       gas_name(ibsoaX_g)="bsoaX"
12498       gas_name(ibsoa1_g)="bsoa1"
12499       gas_name(ibsoa2_g)="bsoa2"
12500       gas_name(ibsoa3_g)="bsoa3"
12501       gas_name(ibsoa4_g)="bsoa4"
12502       gas_name(igly)="gly"
12503       gas_name(iho)="ho"
12504
12505 ! names of electrolytes
12506       ename(jnh4so4) = 'amso4'
12507       ename(jlvcite) = '(nh4)3h(so4)2'
12508       ename(jnh4hso4)= 'nh4hso4'
12509       ename(jnh4msa) = "ch3so3nh4"
12510       ename(jnh4no3) = 'nh4no3'
12511       ename(jnh4cl)  = 'nh4cl'
12512       ename(jnacl)   = 'nacl'
12513       ename(jnano3)  = 'nano3'
12514       ename(jna2so4) = 'na2so4'
12515       ename(jna3hso4)= 'na3h(so4)2'
12516       ename(jnamsa)  = "ch3so3na"
12517       ename(jnahso4) = 'nahso4'
12518       ename(jcaso4)  = 'caso4'
12519       ename(jcamsa2) = "(ch3so3)2ca"
12520       ename(jcano3)  = 'ca(no3)2'
12521       ename(jcacl2)  = 'cacl2'
12522       ename(jcaco3)  = 'caco3'
12523       ename(jh2so4)  = 'h2so4'
12524       ename(jhhso4)  = 'hhso4'
12525       ename(jhno3)   = 'hno3'
12526       ename(jhcl)    = 'hcl'
12527       ename(jmsa)    = "ch3so3h"
12528
12529 ! molecular weights of electrolytes
12530       mw_electrolyte(jnh4so4) = 132.0
12531       mw_electrolyte(jlvcite) = 247.0
12532       mw_electrolyte(jnh4hso4)= 115.0
12533       mw_electrolyte(jnh4msa) = 113.0
12534       mw_electrolyte(jnh4no3) = 80.0
12535       mw_electrolyte(jnh4cl)  = 53.5
12536       mw_electrolyte(jnacl)   = 58.5
12537       mw_electrolyte(jnano3)  = 85.0
12538       mw_electrolyte(jna2so4) = 142.0
12539       mw_electrolyte(jna3hso4)= 262.0
12540       mw_electrolyte(jnahso4) = 120.0
12541       mw_electrolyte(jnamsa)  = 118.0
12542       mw_electrolyte(jcaso4)  = 136.0
12543       mw_electrolyte(jcamsa2) = 230.0
12544       mw_electrolyte(jcano3)  = 164.0
12545       mw_electrolyte(jcacl2)  = 111.0
12546       mw_electrolyte(jcaco3)  = 100.0
12547       mw_electrolyte(jh2so4)  = 98.0
12548       mw_electrolyte(jhno3)   = 63.0
12549       mw_electrolyte(jhcl)    = 36.5
12550       mw_electrolyte(jmsa)    = 96.0
12551
12552
12553 ! molecular weights of ions [g/mol]
12554       mw_c(jc_h)  =  1.0
12555       mw_c(jc_nh4)= 18.0
12556       mw_c(jc_na) = 23.0
12557       mw_c(jc_ca) = 40.0
12558
12559       mw_a(ja_so4) = 96.0
12560       mw_a(ja_hso4)= 97.0
12561       mw_a(ja_no3) = 62.0
12562       mw_a(ja_cl)  = 35.5
12563       MW_a(ja_msa) = 95.0
12564
12565
12566 ! magnitude of the charges on ions
12567       zc(jc_h)   = 1
12568       zc(jc_nh4) = 1
12569       zc(jc_na)  = 1
12570       zc(jc_ca)  = 2
12571
12572       za(ja_hso4)= 1
12573       za(ja_so4) = 2
12574       za(ja_no3) = 1
12575       za(ja_cl)  = 1
12576       za(ja_msa) = 1
12577
12578
12579 ! densities of pure electrolytes in g/cc
12580       dens_electrolyte(jnh4so4)  = 1.8
12581       dens_electrolyte(jlvcite)  = 1.8
12582       dens_electrolyte(jnh4hso4) = 1.8
12583       dens_electrolyte(jnh4msa)  = 1.8 ! assumed same as nh4hso4
12584       dens_electrolyte(jnh4no3)  = 1.8
12585       dens_electrolyte(jnh4cl)   = 1.8
12586       dens_electrolyte(jnacl)    = 2.2
12587       dens_electrolyte(jnano3)   = 2.2
12588       dens_electrolyte(jna2so4)  = 2.2
12589       dens_electrolyte(jna3hso4) = 2.2
12590       dens_electrolyte(jnahso4)  = 2.2
12591       dens_electrolyte(jnamsa)   = 2.2 ! assumed same as nahso4
12592       dens_electrolyte(jcaso4)   = 2.6
12593       dens_electrolyte(jcamsa2)  = 2.6  ! assumed same as caso4
12594       dens_electrolyte(jcano3)   = 2.6
12595       dens_electrolyte(jcacl2)   = 2.6
12596       dens_electrolyte(jcaco3)   = 2.6
12597       dens_electrolyte(jh2so4)   = 1.8
12598       dens_electrolyte(jhhso4)   = 1.8
12599       dens_electrolyte(jhno3)    = 1.8
12600       dens_electrolyte(jhcl)     = 1.8
12601       dens_electrolyte(jmsa)     = 1.8 ! assumed same as h2so4
12602
12603
12604 ! densities of compounds in g/cc
12605       dens_comp_a(jnh4so4)  = 1.8
12606       dens_comp_a(jlvcite)  = 1.8
12607       dens_comp_a(jnh4hso4) = 1.8
12608       dens_comp_a(jnh4msa)  = 1.8       ! assumed same as nh4hso4
12609       dens_comp_a(jnh4no3)  = 1.7
12610       dens_comp_a(jnh4cl)   = 1.5
12611       dens_comp_a(jnacl)    = 2.2
12612       dens_comp_a(jnano3)   = 2.2
12613       dens_comp_a(jna2so4)  = 2.2
12614       dens_comp_a(jna3hso4) = 2.2
12615       dens_comp_a(jnahso4)  = 2.2
12616       dens_comp_a(jnamsa)   = 2.2       ! assumed same as nahso4
12617       dens_comp_a(jcaso4)   = 2.6
12618       dens_comp_a(jcamsa2)  = 2.6       ! assumed same as caso4
12619       dens_comp_a(jcano3)   = 2.6
12620       dens_comp_a(jcacl2)   = 2.6
12621       dens_comp_a(jcaco3)   = 2.6
12622       dens_comp_a(jh2so4)   = 1.8
12623       dens_comp_a(jhhso4)   = 1.8
12624       dens_comp_a(jhno3)    = 1.8
12625       dens_comp_a(jhcl)     = 1.8
12626       dens_comp_a(jmsa)     = 1.8       ! assumed same as h2so4
12627       dens_comp_a(joc)      = 1.0
12628       dens_comp_a(jbc)      = 1.8
12629       dens_comp_a(join)     = 2.6
12630       dens_comp_a(jh2o)     = 1.0
12631       dens_comp_a(ipcg1_b_c_a) =1.0
12632       dens_comp_a(ipcg2_b_c_a) =1.0
12633       dens_comp_a(ipcg3_b_c_a)=1.0
12634       dens_comp_a(ipcg4_b_c_a)=1.0
12635       dens_comp_a(ipcg5_b_c_a)=1.0
12636       dens_comp_a(ipcg6_b_c_a)=1.0
12637       dens_comp_a(ipcg7_b_c_a)=1.0
12638       dens_comp_a(ipcg8_b_c_a)=1.0
12639       dens_comp_a(ipcg9_b_c_a)=1.0
12640       dens_comp_a(iopcg1_b_c_a)=1.0
12641       dens_comp_a(iopcg2_b_c_a)=1.0
12642       dens_comp_a(iopcg3_b_c_a)=1.0
12643       dens_comp_a(iopcg4_b_c_a)=1.0
12644       dens_comp_a(iopcg5_b_c_a)=1.0
12645       dens_comp_a(iopcg6_b_c_a)=1.0
12646       dens_comp_a(iopcg7_b_c_a)=1.0
12647       dens_comp_a(iopcg8_b_c_a)=1.0
12648       dens_comp_a(ipcg1_b_o_a)=1.0
12649       dens_comp_a(ipcg2_b_o_a)=1.0
12650       dens_comp_a(ipcg3_b_o_a)=1.0
12651       dens_comp_a(ipcg4_b_o_a)=1.0
12652       dens_comp_a(ipcg5_b_o_a)=1.0
12653       dens_comp_a(ipcg6_b_o_a)=1.0
12654       dens_comp_a(ipcg7_b_o_a)=1.0
12655       dens_comp_a(ipcg8_b_o_a)=1.0
12656       dens_comp_a(ipcg9_b_o_a)=1.0
12657       dens_comp_a(iopcg1_b_o_a)=1.0
12658       dens_comp_a(iopcg2_b_o_a)=1.0
12659       dens_comp_a(iopcg3_b_o_a)=1.0
12660       dens_comp_a(iopcg4_b_o_a)=1.0
12661       dens_comp_a(iopcg5_b_o_a)=1.0
12662       dens_comp_a(iopcg6_b_o_a)=1.0
12663       dens_comp_a(iopcg7_b_o_a)=1.0
12664       dens_comp_a(iopcg8_b_o_a)=1.0
12665       dens_comp_a(ipcg1_f_c_a) =1.0
12666       dens_comp_a(ipcg2_f_c_a) =1.0
12667       dens_comp_a(ipcg3_f_c_a)=1.0
12668       dens_comp_a(ipcg4_f_c_a)=1.0
12669       dens_comp_a(ipcg5_f_c_a)=1.0
12670       dens_comp_a(ipcg6_f_c_a)=1.0
12671       dens_comp_a(ipcg7_f_c_a)=1.0
12672       dens_comp_a(ipcg8_f_c_a)=1.0
12673       dens_comp_a(ipcg9_f_c_a)=1.0
12674       dens_comp_a(iopcg1_f_c_a)=1.0
12675       dens_comp_a(iopcg2_f_c_a)=1.0
12676       dens_comp_a(iopcg3_f_c_a)=1.0
12677       dens_comp_a(iopcg4_f_c_a)=1.0
12678       dens_comp_a(iopcg5_f_c_a)=1.0
12679       dens_comp_a(iopcg6_f_c_a)=1.0
12680       dens_comp_a(iopcg7_f_c_a)=1.0
12681       dens_comp_a(iopcg8_f_c_a)=1.0
12682       dens_comp_a(ipcg1_f_o_a)=1.0
12683       dens_comp_a(ipcg2_f_o_a)=1.0
12684       dens_comp_a(ipcg3_f_o_a)=1.0
12685       dens_comp_a(ipcg4_f_o_a)=1.0
12686       dens_comp_a(ipcg5_f_o_a)=1.0
12687       dens_comp_a(ipcg6_f_o_a)=1.0
12688       dens_comp_a(ipcg7_f_o_a)=1.0
12689       dens_comp_a(ipcg8_f_o_a)=1.0
12690       dens_comp_a(ipcg9_f_o_a)=1.0
12691       dens_comp_a(iopcg1_f_o_a)=1.0
12692       dens_comp_a(iopcg2_f_o_a)=1.0
12693       dens_comp_a(iopcg3_f_o_a)=1.0
12694       dens_comp_a(iopcg4_f_o_a)=1.0
12695       dens_comp_a(iopcg5_f_o_a)=1.0
12696       dens_comp_a(iopcg6_f_o_a)=1.0
12697       dens_comp_a(iopcg7_f_o_a)=1.0
12698       dens_comp_a(iopcg8_f_o_a)=1.0
12699       dens_comp_a(ismpa_a)=1.0
12700       dens_comp_a(ismpbb_a)=1.0
12701       dens_comp_a(iglysoa_r1_a)=1.0
12702       dens_comp_a(iglysoa_r2_a)=1.0
12703       dens_comp_a(iglysoa_sfc_a)=1.0
12704       dens_comp_a(iglysoa_nh4_a)=1.0
12705       dens_comp_a(iglysoa_oh_a)=1.0
12706       dens_comp_a(iant1_c_a)=1.0
12707       dens_comp_a(iant2_c_a)=1.0
12708       dens_comp_a(iant3_c_a)=1.0
12709       dens_comp_a(iant4_c_a)=1.0
12710       dens_comp_a(iant1_o_a)=1.0
12711       dens_comp_a(iant2_o_a)=1.0
12712       dens_comp_a(iant3_o_a)=1.0
12713       dens_comp_a(iant4_o_a)=1.0
12714       dens_comp_a(ibiog1_c_a)=1.0
12715       dens_comp_a(ibiog2_c_a)=1.0
12716       dens_comp_a(ibiog3_c_a)=1.0
12717       dens_comp_a(ibiog4_c_a)=1.0
12718       dens_comp_a(ibiog1_o_a)=1.0
12719       dens_comp_a(ibiog2_o_a)=1.0
12720       dens_comp_a(ibiog3_o_a)=1.0
12721       dens_comp_a(ibiog4_o_a)=1.0
12722       dens_comp_a(iasoaX_a)=1.5
12723       dens_comp_a(iasoa1_a)=1.5
12724       dens_comp_a(iasoa2_a)=1.5
12725       dens_comp_a(iasoa3_a)=1.5
12726       dens_comp_a(iasoa4_a)=1.5
12727       dens_comp_a(ibsoaX_a)=1.5
12728       dens_comp_a(ibsoa1_a)=1.5
12729       dens_comp_a(ibsoa2_a)=1.5
12730       dens_comp_a(ibsoa3_a)=1.5
12731       dens_comp_a(ibsoa4_a)=1.5
12732
12733 ! molecular weights of generic aerosol species
12734       mw_aer_mac(iso4_a) = 96.0
12735       mw_aer_mac(ino3_a) = 62.0
12736       mw_aer_mac(icl_a)  = 35.5
12737       mw_aer_mac(imsa_a) = 95.0 ! ch3so3
12738       mw_aer_mac(ico3_a) = 60.0
12739       mw_aer_mac(inh4_a) = 18.0
12740       mw_aer_mac(ina_a)  = 23.0
12741       mw_aer_mac(ica_a)  = 40.0
12742       mw_aer_mac(ioin_a) = 1.0          ! not used
12743       mw_aer_mac(ibc_a)  = 1.0          ! not used
12744       mw_aer_mac(ioc_a)  = 250.0  ! 200 assumed for primary organics
12745       mw_aer_mac(ipcg1_b_c_a) =250.0
12746       mw_aer_mac(ipcg2_b_c_a) =250.0
12747       mw_aer_mac(ipcg3_b_c_a)=250.0
12748       mw_aer_mac(ipcg4_b_c_a)=250.0
12749       mw_aer_mac(ipcg5_b_c_a)=250.0
12750       mw_aer_mac(ipcg6_b_c_a)=250.0
12751       mw_aer_mac(ipcg7_b_c_a)=250.0
12752       mw_aer_mac(ipcg8_b_c_a)=250.0
12753       mw_aer_mac(ipcg9_b_c_a)=250.0
12754       mw_aer_mac(iopcg1_b_c_a)=250.0
12755       mw_aer_mac(iopcg2_b_c_a)=250.0
12756       mw_aer_mac(iopcg3_b_c_a)=250.0
12757       mw_aer_mac(iopcg4_b_c_a)=250.0
12758       mw_aer_mac(iopcg5_b_c_a)=250.0
12759       mw_aer_mac(iopcg6_b_c_a)=250.0
12760       mw_aer_mac(iopcg7_b_c_a)=250.0
12761       mw_aer_mac(iopcg8_b_c_a)=250.0
12762       mw_aer_mac(ipcg1_b_o_a)=250.0
12763       mw_aer_mac(ipcg2_b_o_a)=250.0
12764       mw_aer_mac(ipcg3_b_o_a)=250.0
12765       mw_aer_mac(ipcg4_b_o_a)=250.0
12766       mw_aer_mac(ipcg5_b_o_a)=250.0
12767       mw_aer_mac(ipcg6_b_o_a)=250.0
12768       mw_aer_mac(ipcg7_b_o_a)=250.0
12769       mw_aer_mac(ipcg8_b_o_a)=250.0
12770       mw_aer_mac(ipcg9_b_o_a)=250.0
12771       mw_aer_mac(iopcg1_b_o_a)=250.0
12772       mw_aer_mac(iopcg2_b_o_a)=250.0
12773       mw_aer_mac(iopcg3_b_o_a)=250.0
12774       mw_aer_mac(iopcg4_b_o_a)=250.0
12775       mw_aer_mac(iopcg5_b_o_a)=250.0
12776       mw_aer_mac(iopcg6_b_o_a)=250.0
12777       mw_aer_mac(iopcg7_b_o_a)=250.0
12778       mw_aer_mac(iopcg8_b_o_a)=250.0
12779       mw_aer_mac(ipcg1_f_c_a) =250.0
12780       mw_aer_mac(ipcg2_f_c_a) =250.0
12781       mw_aer_mac(ipcg3_f_c_a)=250.0
12782       mw_aer_mac(ipcg4_f_c_a)=250.0
12783       mw_aer_mac(ipcg5_f_c_a)=250.0
12784       mw_aer_mac(ipcg6_f_c_a)=250.0
12785       mw_aer_mac(ipcg7_f_c_a)=250.0
12786       mw_aer_mac(ipcg8_f_c_a)=250.0
12787       mw_aer_mac(ipcg9_f_c_a)=250.0
12788       mw_aer_mac(iopcg1_f_c_a)=250.0
12789       mw_aer_mac(iopcg2_f_c_a)=250.0
12790       mw_aer_mac(iopcg3_f_c_a)=250.0
12791       mw_aer_mac(iopcg4_f_c_a)=250.0
12792       mw_aer_mac(iopcg5_f_c_a)=250.0
12793       mw_aer_mac(iopcg6_f_c_a)=250.0
12794       mw_aer_mac(iopcg7_f_c_a)=250.0
12795       mw_aer_mac(iopcg8_f_c_a)=250.0
12796       mw_aer_mac(ipcg1_f_o_a)=250.0
12797       mw_aer_mac(ipcg2_f_o_a)=250.0
12798       mw_aer_mac(ipcg3_f_o_a)=250.0
12799       mw_aer_mac(ipcg4_f_o_a)=250.0
12800       mw_aer_mac(ipcg5_f_o_a)=250.0
12801       mw_aer_mac(ipcg6_f_o_a)=250.0
12802       mw_aer_mac(ipcg7_f_o_a)=250.0
12803       mw_aer_mac(ipcg8_f_o_a)=250.0
12804       mw_aer_mac(ipcg9_f_o_a)=250.0
12805       mw_aer_mac(iopcg1_f_o_a)=250.0
12806       mw_aer_mac(iopcg2_f_o_a)=250.0
12807       mw_aer_mac(iopcg3_f_o_a)=250.0
12808       mw_aer_mac(iopcg4_f_o_a)=250.0
12809       mw_aer_mac(iopcg5_f_o_a)=250.0
12810       mw_aer_mac(iopcg6_f_o_a)=250.0
12811       mw_aer_mac(iopcg7_f_o_a)=250.0
12812       mw_aer_mac(iopcg8_f_o_a)=250.0
12813       mw_aer_mac(ismpa_a) = 250.0
12814       mw_aer_mac(ismpbb_a) = 250.0
12815       mw_aer_mac(iglysoa_r1_a) = 250.0
12816       mw_aer_mac(iglysoa_r2_a) = 250.0
12817       mw_aer_mac(iglysoa_sfc_a) = 250.0
12818       mw_aer_mac(iglysoa_nh4_a) = 250.0
12819       mw_aer_mac(iglysoa_oh_a) = 250.0
12820       mw_aer_mac(iant1_c_a) = 250.0
12821       mw_aer_mac(iant2_c_a) = 250.0
12822       mw_aer_mac(iant3_c_a) = 250.0
12823       mw_aer_mac(iant4_c_a) = 250.0
12824       mw_aer_mac(iant1_o_a) = 250.0
12825       mw_aer_mac(iant2_o_a) = 250.0
12826       mw_aer_mac(iant3_o_a) = 250.0
12827       mw_aer_mac(iant4_o_a) = 250.0
12828       mw_aer_mac(ibiog1_c_a) = 250.0
12829       mw_aer_mac(ibiog2_c_a) = 250.0
12830       mw_aer_mac(ibiog3_c_a) = 250.0
12831       mw_aer_mac(ibiog4_c_a) = 250.0
12832       mw_aer_mac(ibiog1_o_a) = 250.0
12833       mw_aer_mac(ibiog2_o_a) = 250.0
12834       mw_aer_mac(ibiog3_o_a) = 250.0
12835       mw_aer_mac(ibiog4_o_a) = 250.0
12836       mw_aer_mac(iasoaX_a) = 250.0
12837       mw_aer_mac(iasoa1_a) = 250.0
12838       mw_aer_mac(iasoa2_a) = 250.0
12839       mw_aer_mac(iasoa3_a) = 250.0
12840       mw_aer_mac(iasoa4_a) = 250.0
12841       mw_aer_mac(ibsoaX_a) = 250.0
12842       mw_aer_mac(ibsoa1_a) = 250.0
12843       mw_aer_mac(ibsoa2_a) = 250.0
12844       mw_aer_mac(ibsoa3_a) = 250.0
12845       mw_aer_mac(ibsoa4_a) = 250.0
12846
12847
12848 ! molecular weights of compounds
12849       mw_comp_a(jnh4so4) = 132.0
12850       mw_comp_a(jlvcite) = 247.0
12851       mw_comp_a(jnh4hso4)= 115.0
12852       mw_comp_a(jnh4msa) = 113.0
12853       mw_comp_a(jnh4no3) = 80.0
12854       mw_comp_a(jnh4cl)  = 53.5
12855       mw_comp_a(jnacl)   = 58.5
12856       mw_comp_a(jnano3)  = 85.0
12857       mw_comp_a(jna2so4) = 142.0
12858       mw_comp_a(jna3hso4)= 262.0
12859       mw_comp_a(jnahso4) = 120.0
12860       mw_comp_a(jnamsa)  = 118.0
12861       mw_comp_a(jcaso4)  = 136.0
12862       mw_comp_a(jcamsa2) = 230.0
12863       mw_comp_a(jcano3)  = 164.0
12864       mw_comp_a(jcacl2)  = 111.0
12865       mw_comp_a(jcaco3)  = 100.0
12866       mw_comp_a(jh2so4)  = 98.0
12867       mw_comp_a(jhhso4)  = 98.0
12868       mw_comp_a(jhno3)   = 63.0
12869       mw_comp_a(jhcl)    = 36.5
12870       mw_comp_a(jmsa)    = 96.0
12871       mw_comp_a(joc)     = 250.0
12872       mw_comp_a(jbc)     = 1.0
12873       mw_comp_a(join)    = 1.0
12874       mw_comp_a(jh2o)    = 18.0
12875       mw_comp_a(jpcg1_b_c) =250.0
12876       mw_comp_a(jpcg2_b_c) =250.0
12877       mw_comp_a(jpcg3_b_c)=250.0
12878       mw_comp_a(jpcg4_b_c)=250.0
12879       mw_comp_a(jpcg5_b_c)=250.0
12880       mw_comp_a(jpcg6_b_c)=250.0
12881       mw_comp_a(jpcg7_b_c)=250.0
12882       mw_comp_a(jpcg8_b_c)=250.0
12883       mw_comp_a(jpcg9_b_c)=250.0
12884       mw_comp_a(jopcg1_b_c)=250.0
12885       mw_comp_a(jopcg2_b_c)=250.0
12886       mw_comp_a(jopcg3_b_c)=250.0
12887       mw_comp_a(jopcg4_b_c)=250.0
12888       mw_comp_a(jopcg5_b_c)=250.0
12889       mw_comp_a(jopcg6_b_c)=250.0
12890       mw_comp_a(jopcg7_b_c)=250.0
12891       mw_comp_a(jopcg8_b_c)=250.0
12892       mw_comp_a(jpcg1_b_o)=250.0
12893       mw_comp_a(jpcg2_b_o)=250.0
12894       mw_comp_a(jpcg3_b_o)=250.0
12895       mw_comp_a(jpcg4_b_o)=250.0
12896       mw_comp_a(jpcg5_b_o)=250.0
12897       mw_comp_a(jpcg6_b_o)=250.0
12898       mw_comp_a(jpcg7_b_o)=250.0
12899       mw_comp_a(jpcg8_b_o)=250.0
12900       mw_comp_a(jpcg9_b_o)=250.0
12901       mw_comp_a(jopcg1_b_o)=250.0
12902       mw_comp_a(jopcg2_b_o)=250.0
12903       mw_comp_a(jopcg3_b_o)=250.0
12904       mw_comp_a(jopcg4_b_o)=250.0
12905       mw_comp_a(jopcg5_b_o)=250.0
12906       mw_comp_a(jopcg6_b_o)=250.0
12907       mw_comp_a(jopcg7_b_o)=250.0
12908       mw_comp_a(jopcg8_b_o)=250.0
12909       mw_comp_a(jpcg1_f_c) =250.0
12910       mw_comp_a(jpcg2_f_c) =250.0
12911       mw_comp_a(jpcg3_f_c)=250.0
12912       mw_comp_a(jpcg4_f_c)=250.0
12913       mw_comp_a(jpcg5_f_c)=250.0
12914       mw_comp_a(jpcg6_f_c)=250.0
12915       mw_comp_a(jpcg7_f_c)=250.0
12916       mw_comp_a(jpcg8_f_c)=250.0
12917       mw_comp_a(jpcg9_f_c)=250.0
12918       mw_comp_a(jopcg1_f_c)=250.0
12919       mw_comp_a(jopcg2_f_c)=250.0
12920       mw_comp_a(jopcg3_f_c)=250.0
12921       mw_comp_a(jopcg4_f_c)=250.0
12922       mw_comp_a(jopcg5_f_c)=250.0
12923       mw_comp_a(jopcg6_f_c)=250.0
12924       mw_comp_a(jopcg7_f_c)=250.0
12925       mw_comp_a(jopcg8_f_c)=250.0
12926       mw_comp_a(jpcg1_f_o)=250.0
12927       mw_comp_a(jpcg2_f_o)=250.0
12928       mw_comp_a(jpcg3_f_o)=250.0
12929       mw_comp_a(jpcg4_f_o)=250.0
12930       mw_comp_a(jpcg5_f_o)=250.0
12931       mw_comp_a(jpcg6_f_o)=250.0
12932       mw_comp_a(jpcg7_f_o)=250.0
12933       mw_comp_a(jpcg8_f_o)=250.0
12934       mw_comp_a(jpcg9_f_o)=250.0
12935       mw_comp_a(jopcg1_f_o)=250.0
12936       mw_comp_a(jopcg2_f_o)=250.0
12937       mw_comp_a(jopcg3_f_o)=250.0
12938       mw_comp_a(jopcg4_f_o)=250.0
12939       mw_comp_a(jopcg5_f_o)=250.0
12940       mw_comp_a(jopcg6_f_o)=250.0
12941       mw_comp_a(jopcg7_f_o)=250.0
12942       mw_comp_a(jopcg8_f_o)=250.0
12943       mw_comp_a(jsmpa)=250.0
12944       mw_comp_a(jsmpbb)=250.0
12945       mw_comp_a(jglysoa_r1)=250.0
12946       mw_comp_a(jglysoa_r2)=250.0
12947       mw_comp_a(jglysoa_sfc)=250.0
12948       mw_comp_a(jglysoa_nh4)=250.0
12949       mw_comp_a(jglysoa_oh)=250.0
12950       mw_comp_a(jant1_c)=250.0
12951       mw_comp_a(jant2_c)=250.0
12952       mw_comp_a(jant3_c)=250.0
12953       mw_comp_a(jant4_c)=250.0
12954       mw_comp_a(jant1_o)=250.0
12955       mw_comp_a(jant2_o)=250.0
12956       mw_comp_a(jant3_o)=250.0
12957       mw_comp_a(jant4_o)=250.0
12958       mw_comp_a(jbiog1_c)=250.0
12959       mw_comp_a(jbiog2_c)=250.0
12960       mw_comp_a(jbiog3_c)=250.0
12961       mw_comp_a(jbiog4_c)=250.0
12962       mw_comp_a(jbiog1_o)=250.0
12963       mw_comp_a(jbiog2_o)=250.0
12964       mw_comp_a(jbiog3_o)=250.0
12965       mw_comp_a(jbiog4_o)=250.0
12966       mw_comp_a(jasoaX)=250.0
12967       mw_comp_a(jasoa1)=250.0
12968       mw_comp_a(jasoa2)=250.0
12969       mw_comp_a(jasoa3)=250.0
12970       mw_comp_a(jasoa4)=250.0
12971       mw_comp_a(jbsoaX)=250.0
12972       mw_comp_a(jbsoa1)=250.0
12973       mw_comp_a(jbsoa2)=250.0
12974       mw_comp_a(jbsoa3)=250.0
12975       mw_comp_a(jbsoa4)=250.0
12976
12977 ! densities of generic aerosol species
12978       dens_aer_mac(iso4_a) = 1.8        ! used
12979       dens_aer_mac(ino3_a) = 1.8        ! used
12980       dens_aer_mac(icl_a)  = 2.2        ! used
12981       dens_aer_mac(imsa_a) = 1.8        ! used
12982       dens_aer_mac(ico3_a) = 2.6        ! used
12983       dens_aer_mac(inh4_a) = 1.8        ! used
12984       dens_aer_mac(ina_a)  = 2.2        ! used
12985       dens_aer_mac(ica_a)  = 2.6        ! used
12986       dens_aer_mac(ioin_a) = 2.6        ! used
12987       dens_aer_mac(ioc_a)  = 1.0        ! used
12988       dens_aer_mac(ibc_a)  = 1.7        ! used
12989       dens_aer_mac(ipcg1_b_c_a) =1.0
12990       dens_aer_mac(ipcg2_b_c_a) =1.0
12991       dens_aer_mac(ipcg3_b_c_a)=1.0
12992       dens_aer_mac(ipcg4_b_c_a)=1.0
12993       dens_aer_mac(ipcg5_b_c_a)=1.0
12994       dens_aer_mac(ipcg6_b_c_a)=1.0
12995       dens_aer_mac(ipcg7_b_c_a)=1.0
12996       dens_aer_mac(ipcg8_b_c_a)=1.0
12997       dens_aer_mac(ipcg9_b_c_a)=1.0
12998       dens_aer_mac(iopcg1_b_c_a)=1.0
12999       dens_aer_mac(iopcg2_b_c_a)=1.0
13000       dens_aer_mac(iopcg3_b_c_a)=1.0
13001       dens_aer_mac(iopcg4_b_c_a)=1.0
13002       dens_aer_mac(iopcg5_b_c_a)=1.0
13003       dens_aer_mac(iopcg6_b_c_a)=1.0
13004       dens_aer_mac(iopcg7_b_c_a)=1.0
13005       dens_aer_mac(iopcg8_b_c_a)=1.0
13006       dens_aer_mac(ipcg1_b_o_a)=1.0
13007       dens_aer_mac(ipcg2_b_o_a)=1.0
13008       dens_aer_mac(ipcg3_b_o_a)=1.0
13009       dens_aer_mac(ipcg4_b_o_a)=1.0
13010       dens_aer_mac(ipcg5_b_o_a)=1.0
13011       dens_aer_mac(ipcg6_b_o_a)=1.0
13012       dens_aer_mac(ipcg7_b_o_a)=1.0
13013       dens_aer_mac(ipcg8_b_o_a)=1.0
13014       dens_aer_mac(ipcg9_b_o_a)=1.0
13015       dens_aer_mac(iopcg1_b_o_a)=1.0
13016       dens_aer_mac(iopcg2_b_o_a)=1.0
13017       dens_aer_mac(iopcg3_b_o_a)=1.0
13018       dens_aer_mac(iopcg4_b_o_a)=1.0
13019       dens_aer_mac(iopcg5_b_o_a)=1.0
13020       dens_aer_mac(iopcg6_b_o_a)=1.0
13021       dens_aer_mac(iopcg7_b_o_a)=1.0
13022       dens_aer_mac(iopcg8_b_o_a)=1.0
13023       dens_aer_mac(ipcg1_f_c_a) =1.0
13024       dens_aer_mac(ipcg2_f_c_a) =1.0
13025       dens_aer_mac(ipcg3_f_c_a)=1.0
13026       dens_aer_mac(ipcg4_f_c_a)=1.0
13027       dens_aer_mac(ipcg5_f_c_a)=1.0
13028       dens_aer_mac(ipcg6_f_c_a)=1.0
13029       dens_aer_mac(ipcg7_f_c_a)=1.0
13030       dens_aer_mac(ipcg8_f_c_a)=1.0
13031       dens_aer_mac(ipcg9_f_c_a)=1.0
13032       dens_aer_mac(iopcg1_f_c_a)=1.0
13033       dens_aer_mac(iopcg2_f_c_a)=1.0
13034       dens_aer_mac(iopcg3_f_c_a)=1.0
13035       dens_aer_mac(iopcg4_f_c_a)=1.0
13036       dens_aer_mac(iopcg5_f_c_a)=1.0
13037       dens_aer_mac(iopcg6_f_c_a)=1.0
13038       dens_aer_mac(iopcg7_f_c_a)=1.0
13039       dens_aer_mac(iopcg8_f_c_a)=1.0
13040       dens_aer_mac(ipcg1_f_o_a)=1.0
13041       dens_aer_mac(ipcg2_f_o_a)=1.0
13042       dens_aer_mac(ipcg3_f_o_a)=1.0
13043       dens_aer_mac(ipcg4_f_o_a)=1.0
13044       dens_aer_mac(ipcg5_f_o_a)=1.0
13045       dens_aer_mac(ipcg6_f_o_a)=1.0
13046       dens_aer_mac(ipcg7_f_o_a)=1.0
13047       dens_aer_mac(ipcg8_f_o_a)=1.0
13048       dens_aer_mac(ipcg9_f_o_a)=1.0
13049       dens_aer_mac(iopcg1_f_o_a)=1.0
13050       dens_aer_mac(iopcg2_f_o_a)=1.0
13051       dens_aer_mac(iopcg3_f_o_a)=1.0
13052       dens_aer_mac(iopcg4_f_o_a)=1.0
13053       dens_aer_mac(iopcg5_f_o_a)=1.0
13054       dens_aer_mac(iopcg6_f_o_a)=1.0
13055       dens_aer_mac(iopcg7_f_o_a)=1.0
13056       dens_aer_mac(iopcg8_f_o_a)=1.0
13057       dens_aer_mac(ismpa_a)=1.0
13058       dens_aer_mac(ismpbb_a)=1.0
13059       dens_aer_mac(iglysoa_r1_a)=1.0
13060       dens_aer_mac(iglysoa_r2_a)=1.0
13061       dens_aer_mac(iglysoa_sfc_a)=1.0
13062       dens_aer_mac(iglysoa_nh4_a)=1.0
13063       dens_aer_mac(iglysoa_oh_a)=1.0
13064       dens_aer_mac(iant1_c_a)=1.0
13065       dens_aer_mac(iant2_c_a)=1.0
13066       dens_aer_mac(iant3_c_a)=1.0
13067       dens_aer_mac(iant4_c_a)=1.0
13068       dens_aer_mac(iant1_o_a)=1.0
13069       dens_aer_mac(iant2_o_a)=1.0
13070       dens_aer_mac(iant3_o_a)=1.0
13071       dens_aer_mac(iant4_o_a)=1.0
13072       dens_aer_mac(ibiog1_c_a)=1.0
13073       dens_aer_mac(ibiog2_c_a)=1.0
13074       dens_aer_mac(ibiog3_c_a)=1.0
13075       dens_aer_mac(ibiog4_c_a)=1.0
13076       dens_aer_mac(ibiog1_o_a)=1.0
13077       dens_aer_mac(ibiog2_o_a)=1.0
13078       dens_aer_mac(ibiog3_o_a)=1.0
13079       dens_aer_mac(ibiog4_o_a)=1.0
13080       dens_aer_mac(iasoaX_a)=1.5
13081       dens_aer_mac(iasoa1_a)=1.5
13082       dens_aer_mac(iasoa2_a)=1.5
13083       dens_aer_mac(iasoa3_a)=1.5
13084       dens_aer_mac(iasoa4_a)=1.5
13085       dens_aer_mac(ibsoaX_a)=1.5
13086       dens_aer_mac(ibsoa1_a)=1.5
13087       dens_aer_mac(ibsoa2_a)=1.5
13088       dens_aer_mac(ibsoa3_a)=1.5
13089       dens_aer_mac(ibsoa4_a)=1.5
13090
13091 ! partial molar volumes of condensing species
13092       partial_molar_vol(ih2so4_g) = 51.83
13093       partial_molar_vol(ihno3_g)  = 31.45
13094       partial_molar_vol(ihcl_g)   = 20.96
13095       partial_molar_vol(inh3_g)   = 24.03
13096       partial_molar_vol(imsa_g)   = 53.33
13097       partial_molar_vol(ipcg1_b_c_g) =250.0
13098       partial_molar_vol(ipcg2_b_c_g) =250.0
13099       partial_molar_vol(ipcg3_b_c_g)=250.0
13100       partial_molar_vol(ipcg4_b_c_g)=250.0
13101       partial_molar_vol(ipcg5_b_c_g)=250.0
13102       partial_molar_vol(ipcg6_b_c_g)=250.0
13103       partial_molar_vol(ipcg7_b_c_g)=250.0
13104       partial_molar_vol(ipcg8_b_c_g)=250.0
13105       partial_molar_vol(ipcg9_b_c_g)=250.0
13106       partial_molar_vol(iopcg1_b_c_g)=250.0
13107       partial_molar_vol(iopcg2_b_c_g)=250.0
13108       partial_molar_vol(iopcg3_b_c_g)=250.0
13109       partial_molar_vol(iopcg4_b_c_g)=250.0
13110       partial_molar_vol(iopcg5_b_c_g)=250.0
13111       partial_molar_vol(iopcg6_b_c_g)=250.0
13112       partial_molar_vol(iopcg7_b_c_g)=250.0
13113       partial_molar_vol(iopcg8_b_c_g)=250.0
13114       partial_molar_vol(ipcg1_b_o_g)=250.0
13115       partial_molar_vol(ipcg2_b_o_g)=250.0
13116       partial_molar_vol(ipcg3_b_o_g)=250.0
13117       partial_molar_vol(ipcg4_b_o_g)=250.0
13118       partial_molar_vol(ipcg5_b_o_g)=250.0
13119       partial_molar_vol(ipcg6_b_o_g)=250.0
13120       partial_molar_vol(ipcg7_b_o_g)=250.0
13121       partial_molar_vol(ipcg8_b_o_g)=250.0
13122       partial_molar_vol(ipcg9_b_o_g)=250.0
13123       partial_molar_vol(iopcg1_b_o_g)=250.0
13124       partial_molar_vol(iopcg2_b_o_g)=250.0
13125       partial_molar_vol(iopcg3_b_o_g)=250.0
13126       partial_molar_vol(iopcg4_b_o_g)=250.0
13127       partial_molar_vol(iopcg5_b_o_g)=250.0
13128       partial_molar_vol(iopcg6_b_o_g)=250.0
13129       partial_molar_vol(iopcg7_b_o_g)=250.0
13130       partial_molar_vol(iopcg8_b_o_g)=250.0
13131       partial_molar_vol(ipcg1_f_c_g) =250.0
13132       partial_molar_vol(ipcg2_f_c_g) =250.0
13133       partial_molar_vol(ipcg3_f_c_g)=250.0
13134       partial_molar_vol(ipcg4_f_c_g)=250.0
13135       partial_molar_vol(ipcg5_f_c_g)=250.0
13136       partial_molar_vol(ipcg6_f_c_g)=250.0
13137       partial_molar_vol(ipcg7_f_c_g)=250.0
13138       partial_molar_vol(ipcg8_f_c_g)=250.0
13139       partial_molar_vol(ipcg9_f_c_g)=250.0
13140       partial_molar_vol(iopcg1_f_c_g)=250.0
13141       partial_molar_vol(iopcg2_f_c_g)=250.0
13142       partial_molar_vol(iopcg3_f_c_g)=250.0
13143       partial_molar_vol(iopcg4_f_c_g)=250.0
13144       partial_molar_vol(iopcg5_f_c_g)=250.0
13145       partial_molar_vol(iopcg6_f_c_g)=250.0
13146       partial_molar_vol(iopcg7_f_c_g)=250.0
13147       partial_molar_vol(iopcg8_f_c_g)=250.0
13148       partial_molar_vol(ipcg1_f_o_g)=250.0
13149       partial_molar_vol(ipcg2_f_o_g)=250.0
13150       partial_molar_vol(ipcg3_f_o_g)=250.0
13151       partial_molar_vol(ipcg4_f_o_g)=250.0
13152       partial_molar_vol(ipcg5_f_o_g)=250.0
13153       partial_molar_vol(ipcg6_f_o_g)=250.0
13154       partial_molar_vol(ipcg7_f_o_g)=250.0
13155       partial_molar_vol(ipcg8_f_o_g)=250.0
13156       partial_molar_vol(ipcg9_f_o_g)=250.0
13157       partial_molar_vol(iopcg1_f_o_g)=250.0
13158       partial_molar_vol(iopcg2_f_o_g)=250.0
13159       partial_molar_vol(iopcg3_f_o_g)=250.0
13160       partial_molar_vol(iopcg4_f_o_g)=250.0
13161       partial_molar_vol(iopcg5_f_o_g)=250.0
13162       partial_molar_vol(iopcg6_f_o_g)=250.0
13163       partial_molar_vol(iopcg7_f_o_g)=250.0
13164       partial_molar_vol(iopcg8_f_o_g)=250.0
13165       partial_molar_vol(ismpa_g)=250.0
13166       partial_molar_vol(ismpbb_g)=250.0
13167       partial_molar_vol(iant1_c_g)=250.0
13168       partial_molar_vol(iant2_c_g)=250.0
13169       partial_molar_vol(iant3_c_g)=250.0
13170       partial_molar_vol(iant4_c_g)=250.0
13171       partial_molar_vol(iant1_o_g)=250.0
13172       partial_molar_vol(iant2_o_g)=250.0
13173       partial_molar_vol(iant3_o_g)=250.0
13174       partial_molar_vol(iant4_o_g)=250.0
13175       partial_molar_vol(ibiog1_c_g)=250.0
13176       partial_molar_vol(ibiog2_c_g)=250.0
13177       partial_molar_vol(ibiog3_c_g)=250.0
13178       partial_molar_vol(ibiog4_c_g)=250.0
13179       partial_molar_vol(ibiog1_o_g)=250.0
13180       partial_molar_vol(ibiog2_o_g)=250.0
13181       partial_molar_vol(ibiog3_o_g)=250.0
13182       partial_molar_vol(ibiog4_o_g)=250.0
13183       partial_molar_vol(in2o5_g)  = 200.0       ! assumed...
13184       partial_molar_vol(iclno2_g) = 200.0       ! assumed...
13185       partial_molar_vol(iasoaX_g)=250.0
13186       partial_molar_vol(iasoa1_g)=250.0
13187       partial_molar_vol(iasoa2_g)=250.0
13188       partial_molar_vol(iasoa3_g)=250.0
13189       partial_molar_vol(iasoa4_g)=250.0
13190       partial_molar_vol(ibsoaX_g)=250.0
13191       partial_molar_vol(ibsoa1_g)=250.0
13192       partial_molar_vol(ibsoa2_g)=250.0
13193       partial_molar_vol(ibsoa3_g)=250.0
13194       partial_molar_vol(ibsoa4_g)=250.0
13195       partial_molar_vol(igly)=58.0
13196       partial_molar_vol(iho)=17.0
13197
13198 ! refractive index
13199       ref_index_a(jnh4so4) = cmplx(1.52,0.)
13200       ref_index_a(jlvcite) = cmplx(1.50,0.)
13201       ref_index_a(jnh4hso4)= cmplx(1.47,0.)
13202       ref_index_a(jnh4msa) = cmplx(1.50,0.)     ! assumed
13203       ref_index_a(jnh4no3) = cmplx(1.50,0.)
13204       ref_index_a(jnh4cl)  = cmplx(1.50,0.)
13205       ref_index_a(jnacl)   = cmplx(1.45,0.)
13206       ref_index_a(jnano3)  = cmplx(1.50,0.)
13207       ref_index_a(jna2so4) = cmplx(1.50,0.)
13208       ref_index_a(jna3hso4)= cmplx(1.50,0.)
13209       ref_index_a(jnahso4) = cmplx(1.50,0.)
13210       ref_index_a(jnamsa)  = cmplx(1.50,0.)     ! assumed
13211       ref_index_a(jcaso4)  = cmplx(1.56,0.006)
13212       ref_index_a(jcamsa2) = cmplx(1.56,0.006)  ! assumed
13213       ref_index_a(jcano3)  = cmplx(1.56,0.006)
13214       ref_index_a(jcacl2)  = cmplx(1.52,0.006)
13215       ref_index_a(jcaco3)  = cmplx(1.68,0.006)
13216       ref_index_a(jh2so4)  = cmplx(1.43,0.)
13217       ref_index_a(jhhso4)  = cmplx(1.43,0.)
13218       ref_index_a(jhno3)   = cmplx(1.50,0.)
13219       ref_index_a(jhcl)    = cmplx(1.50,0.)
13220       ref_index_a(jmsa)    = cmplx(1.43,0.)     ! assumed
13221       ref_index_a(joc)     = cmplx(1.45,0.)
13222       ref_index_a(jbc)     = cmplx(1.82,0.74)
13223       ref_index_a(join)    = cmplx(1.55,0.006)
13224       ref_index_a(jh2o)    = cmplx(1.33,0.)
13225
13226 ! jsalt_index
13227       jsalt_index(jnh4so4) = 5          ! as
13228       jsalt_index(jlvcite) = 2          ! lv
13229       jsalt_index(jnh4hso4)= 1          ! ab
13230       jsalt_index(jnh4no3) = 2          ! an
13231       jsalt_index(jnh4cl)  = 1          ! ac
13232       jsalt_index(jna2so4) = 60         ! ss
13233       jsalt_index(jnahso4) = 10         ! sb
13234       jsalt_index(jnano3)  = 40         ! sn
13235       jsalt_index(jnacl)   = 10         ! sc
13236       jsalt_index(jcano3)  = 120        ! cn
13237       jsalt_index(jcacl2)  = 80         ! cc
13238       jsalt_index(jnh4msa) = 0          ! AM    zero for now
13239       jsalt_index(jnamsa)  = 0          ! SM    zero for now
13240       jsalt_index(jcamsa2) = 0          ! CM    zero for now
13241
13242
13243 ! aerosol indices
13244 !  ac = 1, an = 2, as = 5, sc = 10, sn = 40, ss = 60, cc = 80, cn = 120,
13245 !  ab = 1, lv = 2, sb = 10
13246 !
13247 ! sulfate-poor domain
13248       jsulf_poor(1)   =         1       !       ac
13249       jsulf_poor(2)   =         2       !       an
13250       jsulf_poor(5)   =         3       !       as
13251       jsulf_poor(10)  =         4       !       sc
13252       jsulf_poor(40)  =         5       !       sn
13253       jsulf_poor(60)  =         6       !       ss
13254       jsulf_poor(80)  =         7       !       cc
13255       jsulf_poor(120) =         8       !       cn
13256       jsulf_poor(3)   =         9       !       an + ac
13257       jsulf_poor(6)   =         10      !       as + ac
13258       jsulf_poor(7)   =         11      !       as + an
13259       jsulf_poor(8)   =         12      !       as + an + ac
13260       jsulf_poor(11)  =         13      !       sc + ac
13261       jsulf_poor(41)  =         14      !       sn + ac
13262       jsulf_poor(42)  =         15      !       sn + an
13263       jsulf_poor(43)  =         16      !       sn + an + ac
13264       jsulf_poor(50)  =         17      !       sn + sc
13265       jsulf_poor(51)  =         18      !       sn + sc + ac
13266       jsulf_poor(61)  =         19      !       ss + ac
13267       jsulf_poor(62)  =         20      !       ss + an
13268       jsulf_poor(63)  =         21      !       ss + an + ac
13269       jsulf_poor(65)  =         22      !       ss + as
13270       jsulf_poor(66)  =         23      !       ss + as + ac
13271       jsulf_poor(67)  =         24      !       ss + as + an
13272       jsulf_poor(68)  =         25      !       ss + as + an + ac
13273       jsulf_poor(70)  =         26      !       ss + sc
13274       jsulf_poor(71)  =         27      !       ss + sc + ac
13275       jsulf_poor(100) =         28      !       ss + sn
13276       jsulf_poor(101) =         29      !       ss + sn + ac
13277       jsulf_poor(102) =         30      !       ss + sn + an
13278       jsulf_poor(103) =         31      !       ss + sn + an + ac
13279       jsulf_poor(110) =         32      !       ss + sn + sc
13280       jsulf_poor(111) =         33      !       ss + sn + sc + ac
13281       jsulf_poor(81)  =         34      !       cc + ac
13282       jsulf_poor(90)  =         35      !       cc + sc
13283       jsulf_poor(91)  =         36      !       cc + sc + ac
13284       jsulf_poor(121) =         37      !       cn + ac
13285       jsulf_poor(122) =         38      !       cn + an
13286       jsulf_poor(123) =         39      !       cn + an + ac
13287       jsulf_poor(130) =         40      !       cn + sc
13288       jsulf_poor(131) =         41      !       cn + sc + ac
13289       jsulf_poor(160) =         42      !       cn + sn
13290       jsulf_poor(161) =         43      !       cn + sn + ac
13291       jsulf_poor(162) =         44      !       cn + sn + an
13292       jsulf_poor(163) =         45      !       cn + sn + an + ac
13293       jsulf_poor(170) =         46      !       cn + sn + sc
13294       jsulf_poor(171) =         47      !       cn + sn + sc + ac
13295       jsulf_poor(200) =         48      !       cn + cc
13296       jsulf_poor(201) =         49      !       cn + cc + ac
13297       jsulf_poor(210) =         50      !       cn + cc + sc
13298       jsulf_poor(211) =         51      !       cn + cc + sc + ac
13299 !
13300 ! sulfate-rich domain
13301       jsulf_rich(1)   =         52      !       ab
13302       jsulf_rich(2)   =         53      !       lv
13303       jsulf_rich(10)  =         54      !       sb
13304       jsulf_rich(3)   =         55      !       ab + lv
13305       jsulf_rich(7)   =         56      !       as + lv
13306       jsulf_rich(70)  =         57      !       ss + sb
13307       jsulf_rich(62)  =         58      !       ss + lv
13308       jsulf_rich(67)  =         59      !       ss + as + lv
13309       jsulf_rich(61)  =         60      !       ss + ab
13310       jsulf_rich(63)  =         61      !       ss + lv + ab
13311       jsulf_rich(11)  =         62      !       sb + ab
13312       jsulf_rich(71)  =         63      !       ss + sb + ab
13313       jsulf_rich(5)   =         3       !       as
13314       jsulf_rich(60)  =         6       !       ss
13315       jsulf_rich(65)  =         22      !       ss + as
13316
13317
13318
13319 !
13320 ! polynomial coefficients for binary molality (used in zsr equation)
13321 !
13322 !
13323 ! a_zsr for aw < 0.97
13324 !
13325 ! (nh4)2so4
13326       je = jnh4so4
13327       a_zsr(1,je)  =  1.30894
13328       a_zsr(2,je)  = -7.09922
13329       a_zsr(3,je)  =  20.62831
13330       a_zsr(4,je)  = -32.19965
13331       a_zsr(5,je)  =  25.17026
13332       a_zsr(6,je)  = -7.81632
13333       aw_min(je)   = 0.1
13334 !
13335 ! (nh4)3h(so4)2
13336       je = jlvcite
13337       a_zsr(1,je)  =  1.10725
13338       a_zsr(2,je)  = -5.17978
13339       a_zsr(3,je)  =  12.29534
13340       a_zsr(4,je)  = -16.32545
13341       a_zsr(5,je)  =  11.29274
13342       a_zsr(6,je)  = -3.19164
13343       aw_min(je)   = 0.1
13344 !
13345 ! nh4hso4
13346       je = jnh4hso4
13347       a_zsr(1,je)  =  1.15510
13348       a_zsr(2,je)  = -3.20815
13349       a_zsr(3,je)  =  2.71141
13350       a_zsr(4,je)  =  2.01155
13351       a_zsr(5,je)  = -4.71014
13352       a_zsr(6,je)  =  2.04616
13353       aw_min(je)   = 0.1
13354 !
13355 ! nh4msa (assumed same as nh4hso4)
13356       je = jnh4msa
13357       a_zsr(1,je)  =  1.15510
13358       a_zsr(2,je)  = -3.20815
13359       a_zsr(3,je)  =  2.71141
13360       a_zsr(4,je)  =  2.01155
13361       a_zsr(5,je)  = -4.71014
13362       a_zsr(6,je)  =  2.04616
13363       aw_min(je)   = 0.1
13364 !
13365 ! nh4no3
13366       je = jnh4no3
13367       a_zsr(1,je)  =  0.43507
13368       a_zsr(2,je)  =  6.38220
13369       a_zsr(3,je)  = -30.19797
13370       a_zsr(4,je)  =  53.36470
13371       a_zsr(5,je)  = -43.44203
13372       a_zsr(6,je)  =  13.46158
13373       aw_min(je)   = 0.1
13374 !
13375 ! nh4cl: revised on nov 13, 2003. based on chan and ha (1999) jgr.
13376       je = jnh4cl
13377       a_zsr(1,je)  =  0.45309
13378       a_zsr(2,je)  =  2.65606
13379       a_zsr(3,je)  = -14.7730
13380       a_zsr(4,je)  =  26.2936
13381       a_zsr(5,je)  = -20.5735
13382       a_zsr(6,je)  =  5.94255
13383       aw_min(je)   = 0.1
13384 !
13385 ! nacl
13386       je = jnacl
13387       a_zsr(1,je)  =  0.42922
13388       a_zsr(2,je)  = -1.17718
13389       a_zsr(3,je)  =  2.80208
13390       a_zsr(4,je)  = -4.51097
13391       a_zsr(5,je)  =  3.76963
13392       a_zsr(6,je)  = -1.31359
13393       aw_min(je)   = 0.1
13394 !
13395 ! nano3
13396       je = jnano3
13397       a_zsr(1,je)  =  1.34966
13398       a_zsr(2,je)  = -5.20116
13399       a_zsr(3,je)  =  11.49011
13400       a_zsr(4,je)  = -14.41380
13401       a_zsr(5,je)  =  9.07037
13402       a_zsr(6,je)  = -2.29769
13403       aw_min(je)   = 0.1
13404 !
13405 ! na2so4
13406       je = jna2so4
13407       a_zsr(1,je)  =  0.39888
13408       a_zsr(2,je)  = -1.27150
13409       a_zsr(3,je)  =  3.42792
13410       a_zsr(4,je)  = -5.92632
13411       a_zsr(5,je)  =  5.33351
13412       a_zsr(6,je)  = -1.96541
13413       aw_min(je)   = 0.1
13414 !
13415 ! na3h(so4)2  added on 1/14/2004
13416       je = jna3hso4
13417       a_zsr(1,je)  =  0.31480
13418       a_zsr(2,je)  = -1.01087
13419       a_zsr(3,je)  =  2.44029
13420       a_zsr(4,je)  = -3.66095
13421       a_zsr(5,je)  =  2.77632
13422       a_zsr(6,je)  = -0.86058
13423       aw_min(je)   = 0.1
13424 !
13425 ! nahso4
13426       je = jnahso4
13427       a_zsr(1,je)  =  0.62764
13428       a_zsr(2,je)  = -1.63520
13429       a_zsr(3,je)  =  4.62531
13430       a_zsr(4,je)  = -10.06925
13431       a_zsr(5,je)  =  10.33547
13432       a_zsr(6,je)  = -3.88729
13433       aw_min(je)   = 0.1
13434 !
13435 ! namsa (assumed same as nahso4)
13436       je = jnamsa
13437       a_zsr(1,je)  =  0.62764
13438       a_zsr(2,je)  = -1.63520
13439       a_zsr(3,je)  =  4.62531
13440       a_zsr(4,je)  = -10.06925
13441       a_zsr(5,je)  =  10.33547
13442       a_zsr(6,je)  = -3.88729
13443       aw_min(je)   = 0.1
13444 !
13445 ! ca(no3)2
13446       je = jcano3
13447       a_zsr(1,je)  =  0.38895
13448       a_zsr(2,je)  = -1.16013
13449       a_zsr(3,je)  =  2.16819
13450       a_zsr(4,je)  = -2.23079
13451       a_zsr(5,je)  =  1.00268
13452       a_zsr(6,je)  = -0.16923
13453       aw_min(je)   = 0.1
13454 !
13455 ! cacl2: kim and seinfeld
13456       je = jcacl2
13457       a_zsr(1,je)  =  0.29891
13458       a_zsr(2,je)  = -1.31104
13459       a_zsr(3,je)  =  3.68759
13460       a_zsr(4,je)  = -5.81708
13461       a_zsr(5,je)  =  4.67520
13462       a_zsr(6,je)  = -1.53223
13463       aw_min(je)   = 0.1
13464 !
13465 ! h2so4
13466       je = jh2so4
13467       a_zsr(1,je) =  0.32751
13468       a_zsr(2,je) = -1.00692
13469       a_zsr(3,je) =  2.59750
13470       a_zsr(4,je) = -4.40014
13471       a_zsr(5,je) =  3.88212
13472       a_zsr(6,je) = -1.39916
13473       aw_min(je)  = 0.1
13474 !
13475 ! msa (assumed same as h2so4)
13476       je = jmsa
13477       a_zsr(1,je) =  0.32751
13478       a_zsr(2,je) = -1.00692
13479       a_zsr(3,je) =  2.59750
13480       a_zsr(4,je) = -4.40014
13481       a_zsr(5,je) =  3.88212
13482       a_zsr(6,je) = -1.39916
13483       aw_min(je)  = 0.1
13484 !
13485 ! hhso4
13486       je = jhhso4
13487       a_zsr(1,je) =  0.32751
13488       a_zsr(2,je) = -1.00692
13489       a_zsr(3,je) =  2.59750
13490       a_zsr(4,je) = -4.40014
13491       a_zsr(5,je) =  3.88212
13492       a_zsr(6,je) = -1.39916
13493       aw_min(je)  = 1.0
13494 !
13495 ! hno3
13496       je = jhno3
13497       a_zsr(1,je) =  0.75876
13498       a_zsr(2,je) = -3.31529
13499       a_zsr(3,je) =  9.26392
13500       a_zsr(4,je) = -14.89799
13501       a_zsr(5,je) =  12.08781
13502       a_zsr(6,je) = -3.89958
13503       aw_min(je)  = 0.1
13504 !
13505 ! hcl
13506       je = jhcl
13507       a_zsr(1,je) =  0.31133
13508       a_zsr(2,je) = -0.79688
13509       a_zsr(3,je) =  1.93995
13510       a_zsr(4,je) = -3.31582
13511       a_zsr(5,je) =  2.93513
13512       a_zsr(6,je) = -1.07268
13513       aw_min(je)  = 0.1
13514 !
13515 ! caso4
13516       je = jcaso4
13517       a_zsr(1,je)  =  0.0
13518       a_zsr(2,je)  =  0.0
13519       a_zsr(3,je)  =  0.0
13520       a_zsr(4,je)  =  0.0
13521       a_zsr(5,je)  =  0.0
13522       a_zsr(6,je)  =  0.0
13523       aw_min(je)   = 1.0
13524 !
13525 ! ca(msa)2 (assumed same as ca(no3)2)
13526       je = jcamsa2
13527       a_zsr(1,je)  =  0.38895
13528       a_zsr(2,je)  = -1.16013
13529       a_zsr(3,je)  =  2.16819
13530       a_zsr(4,je)  = -2.23079
13531       a_zsr(5,je)  =  1.00268
13532       a_zsr(6,je)  = -0.16923
13533       aw_min(je)   = 0.1
13534 !
13535 ! caco3
13536       je = jcaco3
13537       a_zsr(1,je)  =  0.0
13538       a_zsr(2,je)  =  0.0
13539       a_zsr(3,je)  =  0.0
13540       a_zsr(4,je)  =  0.0
13541       a_zsr(5,je)  =  0.0
13542       a_zsr(6,je)  =  0.0
13543       aw_min(je)   = 1.0
13544
13545
13546
13547 !-------------------------------------------
13548 ! b_zsr for aw => 0.97 to 0.99999
13549 !
13550 ! (nh4)2so4
13551       b_zsr(jnh4so4)  = 28.0811
13552 !
13553 ! (nh4)3h(so4)2
13554       b_zsr(jlvcite)  = 14.7178
13555 !
13556 ! nh4hso4
13557       b_zsr(jnh4hso4) = 29.4779
13558 !
13559 ! nh4msa
13560       b_zsr(jnh4msa)  = 29.4779 ! assumed same as nh4hso4
13561 !
13562 ! nh4no3
13563       b_zsr(jnh4no3)  = 33.4049
13564 !
13565 ! nh4cl
13566       b_zsr(jnh4cl)   = 30.8888
13567 !
13568 ! nacl
13569       b_zsr(jnacl)    = 29.8375
13570 !
13571 ! nano3
13572       b_zsr(jnano3)   = 32.2756
13573 !
13574 ! na2so4
13575       b_zsr(jna2so4)  = 27.6889
13576 !
13577 ! na3h(so4)2
13578       b_zsr(jna3hso4) = 14.2184
13579 !
13580 ! nahso4
13581       b_zsr(jnahso4)  = 28.3367
13582 !
13583 ! namsa
13584       b_zsr(jnamsa)   = 28.3367 ! assumed same as nahso4
13585 !
13586 ! ca(no3)2
13587       b_zsr(jcano3)   = 18.3661
13588 !
13589 ! cacl2
13590       b_zsr(jcacl2)   = 20.8792
13591 !
13592 ! h2so4
13593       b_zsr(jh2so4)   = 26.7347
13594 !
13595 ! hhso4
13596       b_zsr(jhhso4)   = 26.7347
13597 !
13598 ! hno3
13599       b_zsr(jhno3)    = 28.8257
13600 !
13601 ! hcl
13602       b_zsr(jhcl)     = 27.7108
13603 !
13604 ! msa
13605       b_zsr(jmsa)     = 26.7347 ! assumed same as h2so4
13606 !
13607 ! caso4
13608       b_zsr(jcaso4)   = 0.0
13609 !
13610 ! ca(msa)2
13611       b_zsr(jcamsa2)  = 18.3661 ! assumed same as Ca(NO3)2
13612 !
13613 ! caco3
13614       b_zsr(jcaco3)   = 0.0
13615
13616
13617
13618
13619
13620
13621
13622 !----------------------------------------------------------------
13623 ! parameters for mtem mixing rule (zaveri, easter, and wexler, 2005)
13624 ! log_gamz(ja,je)   a in e
13625 !----------------------------------------------------------------
13626 !
13627 ! (nh4)2so4 in e
13628       ja = jnh4so4
13629
13630 ! in (nh4)2so4
13631       je = jnh4so4
13632       b_mtem(1,ja,je) = -2.94685
13633       b_mtem(2,ja,je) = 17.3328
13634       b_mtem(3,ja,je) = -64.8441
13635       b_mtem(4,ja,je) = 122.7070
13636       b_mtem(5,ja,je) = -114.4373
13637       b_mtem(6,ja,je) = 41.6811
13638
13639 ! in nh4no3
13640       je = jnh4no3
13641       b_mtem(1,ja,je) = -2.7503
13642       b_mtem(2,ja,je) = 4.3806
13643       b_mtem(3,ja,je) = -1.1110
13644       b_mtem(4,ja,je) = -1.7005
13645       b_mtem(5,ja,je) = -4.4207
13646       b_mtem(6,ja,je) = 5.1990
13647
13648 ! in nh4cl (revised on 11/15/2003)
13649       je = jnh4cl
13650       b_mtem(1,ja,je) = -2.06952
13651       b_mtem(2,ja,je) = 7.1240
13652       b_mtem(3,ja,je) = -24.4274
13653       b_mtem(4,ja,je) = 51.1458
13654       b_mtem(5,ja,je) = -54.2056
13655       b_mtem(6,ja,je) = 22.0606
13656
13657 ! in na2so4
13658       je = jna2so4
13659       b_mtem(1,ja,je) = -2.17361
13660       b_mtem(2,ja,je) = 15.9919
13661       b_mtem(3,ja,je) = -69.0952
13662       b_mtem(4,ja,je) = 139.8860
13663       b_mtem(5,ja,je) = -134.9890
13664       b_mtem(6,ja,je) = 49.8877
13665
13666 ! in nano3
13667       je = jnano3
13668       b_mtem(1,ja,je) = -4.4370
13669       b_mtem(2,ja,je) = 24.0243
13670       b_mtem(3,ja,je) = -76.2437
13671       b_mtem(4,ja,je) = 128.6660
13672       b_mtem(5,ja,je) = -110.0900
13673       b_mtem(6,ja,je) = 37.7414
13674
13675 ! in nacl
13676       je = jnacl
13677       b_mtem(1,ja,je) = -1.5394
13678       b_mtem(2,ja,je) = 5.8671
13679       b_mtem(3,ja,je) = -22.7726
13680       b_mtem(4,ja,je) = 47.0547
13681       b_mtem(5,ja,je) = -47.8266
13682       b_mtem(6,ja,je) = 18.8489
13683
13684 ! in hno3
13685       je = jhno3
13686       b_mtem(1,ja,je) = -0.35750
13687       b_mtem(2,ja,je) = -3.82466
13688       b_mtem(3,ja,je) = 4.55462
13689       b_mtem(4,ja,je) = 5.05402
13690       b_mtem(5,ja,je) = -14.7476
13691       b_mtem(6,ja,je) = 8.8009
13692
13693 ! in hcl
13694       je = jhcl
13695       b_mtem(1,ja,je) = -2.15146
13696       b_mtem(2,ja,je) = 5.50205
13697       b_mtem(3,ja,je) = -19.1476
13698       b_mtem(4,ja,je) = 39.1880
13699       b_mtem(5,ja,je) = -39.9460
13700       b_mtem(6,ja,je) = 16.0700
13701
13702 ! in h2so4
13703       je = jh2so4
13704       b_mtem(1,ja,je) = -2.52604
13705       b_mtem(2,ja,je) = 9.76022
13706       b_mtem(3,ja,je) = -35.2540
13707       b_mtem(4,ja,je) = 71.2981
13708       b_mtem(5,ja,je) = -71.8207
13709       b_mtem(6,ja,je) = 28.0758
13710
13711 !
13712 ! in nh4hso4
13713       je = jnh4hso4
13714       b_mtem(1,ja,je) = -4.13219
13715       b_mtem(2,ja,je) = 13.8863
13716       b_mtem(3,ja,je) = -34.5387
13717       b_mtem(4,ja,je) = 56.5012
13718       b_mtem(5,ja,je) = -51.8702
13719       b_mtem(6,ja,je) = 19.6232
13720
13721 !
13722 ! in (nh4)3h(so4)2
13723       je = jlvcite
13724       b_mtem(1,ja,je) = -2.53482
13725       b_mtem(2,ja,je) = 12.3333
13726       b_mtem(3,ja,je) = -46.1020
13727       b_mtem(4,ja,je) = 90.4775
13728       b_mtem(5,ja,je) = -88.1254
13729       b_mtem(6,ja,je) = 33.4715
13730
13731 !
13732 ! in nahso4
13733       je = jnahso4
13734       b_mtem(1,ja,je) = -3.23425
13735       b_mtem(2,ja,je) = 18.7842
13736       b_mtem(3,ja,je) = -78.7807
13737       b_mtem(4,ja,je) = 161.517
13738       b_mtem(5,ja,je) = -154.940
13739       b_mtem(6,ja,je) = 56.2252
13740
13741 !
13742 ! in na3h(so4)2
13743       je = jna3hso4
13744       b_mtem(1,ja,je) = -1.25316
13745       b_mtem(2,ja,je) = 7.40960
13746       b_mtem(3,ja,je) = -34.8929
13747       b_mtem(4,ja,je) = 72.8853
13748       b_mtem(5,ja,je) = -72.4503
13749       b_mtem(6,ja,je) = 27.7706
13750
13751
13752 !-----------------
13753 ! nh4no3 in e
13754       ja = jnh4no3
13755
13756 ! in (nh4)2so4
13757       je = jnh4so4
13758       b_mtem(1,ja,je) = -3.5201
13759       b_mtem(2,ja,je) = 21.6584
13760       b_mtem(3,ja,je) = -72.1499
13761       b_mtem(4,ja,je) = 126.7000
13762       b_mtem(5,ja,je) = -111.4550
13763       b_mtem(6,ja,je) = 38.5677
13764
13765 ! in nh4no3
13766       je = jnh4no3
13767       b_mtem(1,ja,je) = -2.2630
13768       b_mtem(2,ja,je) = -0.1518
13769       b_mtem(3,ja,je) = 17.0898
13770       b_mtem(4,ja,je) = -36.7832
13771       b_mtem(5,ja,je) = 29.8407
13772       b_mtem(6,ja,je) = -7.9314
13773
13774 ! in nh4cl (revised on 11/15/2003)
13775       je = jnh4cl
13776       b_mtem(1,ja,je) = -1.3851
13777       b_mtem(2,ja,je) = -0.4462
13778       b_mtem(3,ja,je) = 8.4567
13779       b_mtem(4,ja,je) = -11.5988
13780       b_mtem(5,ja,je) = 2.9802
13781       b_mtem(6,ja,je) = 1.8132
13782
13783 ! in na2so4
13784       je = jna2so4
13785       b_mtem(1,ja,je) = -1.7602
13786       b_mtem(2,ja,je) = 10.4044
13787       b_mtem(3,ja,je) = -35.5894
13788       b_mtem(4,ja,je) = 64.3584
13789       b_mtem(5,ja,je) = -57.8931
13790       b_mtem(6,ja,je) = 20.2141
13791
13792 ! in nano3
13793       je = jnano3
13794       b_mtem(1,ja,je) = -3.24346
13795       b_mtem(2,ja,je) = 16.2794
13796       b_mtem(3,ja,je) = -48.7601
13797       b_mtem(4,ja,je) = 79.2246
13798       b_mtem(5,ja,je) = -65.8169
13799       b_mtem(6,ja,je) = 22.1500
13800
13801 ! in nacl
13802       je = jnacl
13803       b_mtem(1,ja,je) = -1.75658
13804       b_mtem(2,ja,je) = 7.71384
13805       b_mtem(3,ja,je) = -22.7984
13806       b_mtem(4,ja,je) = 39.1532
13807       b_mtem(5,ja,je) = -34.6165
13808       b_mtem(6,ja,je) = 12.1283
13809
13810 ! in ca(no3)2
13811       je = jcano3
13812       b_mtem(1,ja,je) = -0.97178
13813       b_mtem(2,ja,je) = 6.61964
13814       b_mtem(3,ja,je) = -26.2353
13815       b_mtem(4,ja,je) = 50.5259
13816       b_mtem(5,ja,je) = -47.6586
13817       b_mtem(6,ja,je) = 17.5074
13818
13819 ! in cacl2 added on 12/22/2003
13820       je = jcacl2
13821       b_mtem(1,ja,je) = -0.41515
13822       b_mtem(2,ja,je) = 6.44101
13823       b_mtem(3,ja,je) = -26.4473
13824       b_mtem(4,ja,je) = 49.0718
13825       b_mtem(5,ja,je) = -44.2631
13826       b_mtem(6,ja,je) = 15.3771
13827
13828 ! in hno3
13829       je = jhno3
13830       b_mtem(1,ja,je) = -1.20644
13831       b_mtem(2,ja,je) = 5.70117
13832       b_mtem(3,ja,je) = -18.2783
13833       b_mtem(4,ja,je) = 31.7199
13834       b_mtem(5,ja,je) = -27.8703
13835       b_mtem(6,ja,je) = 9.7299
13836
13837 ! in hcl
13838       je = jhcl
13839       b_mtem(1,ja,je) = -0.680862
13840       b_mtem(2,ja,je) = 3.59456
13841       b_mtem(3,ja,je) = -10.7969
13842       b_mtem(4,ja,je) = 17.8434
13843       b_mtem(5,ja,je) = -15.3165
13844       b_mtem(6,ja,je) = 5.17123
13845
13846
13847 !----------
13848 ! nh4cl in e
13849       ja = jnh4cl
13850
13851 ! in (nh4)2so4
13852       je = jnh4so4
13853       b_mtem(1,ja,je) = -2.8850
13854       b_mtem(2,ja,je) = 20.6970
13855       b_mtem(3,ja,je) = -70.6810
13856       b_mtem(4,ja,je) = 124.3690
13857       b_mtem(5,ja,je) = -109.2880
13858       b_mtem(6,ja,je) = 37.5831
13859
13860 ! in nh4no3
13861       je = jnh4no3
13862       b_mtem(1,ja,je) = -1.9386
13863       b_mtem(2,ja,je) = 1.3238
13864       b_mtem(3,ja,je) = 11.8500
13865       b_mtem(4,ja,je) = -28.1168
13866       b_mtem(5,ja,je) = 21.8543
13867       b_mtem(6,ja,je) = -5.1671
13868
13869 ! in nh4cl (revised on 11/15/2003)
13870       je = jnh4cl
13871       b_mtem(1,ja,je) = -0.9559
13872       b_mtem(2,ja,je) = 0.8121
13873       b_mtem(3,ja,je) = 4.3644
13874       b_mtem(4,ja,je) = -8.9258
13875       b_mtem(5,ja,je) = 4.2362
13876       b_mtem(6,ja,je) = 0.2891
13877
13878 ! in na2so4
13879       je = jna2so4
13880       b_mtem(1,ja,je) = 0.0377
13881       b_mtem(2,ja,je) = 6.0752
13882       b_mtem(3,ja,je) = -30.8641
13883       b_mtem(4,ja,je) = 63.3095
13884       b_mtem(5,ja,je) = -61.0070
13885       b_mtem(6,ja,je) = 22.1734
13886
13887 ! in nano3
13888       je = jnano3
13889       b_mtem(1,ja,je) = -1.8336
13890       b_mtem(2,ja,je) = 12.8160
13891       b_mtem(3,ja,je) = -42.3388
13892       b_mtem(4,ja,je) = 71.1816
13893       b_mtem(5,ja,je) = -60.5708
13894       b_mtem(6,ja,je) = 20.5853
13895
13896 ! in nacl
13897       je = jnacl
13898       b_mtem(1,ja,je) = -0.1429
13899       b_mtem(2,ja,je) = 2.3561
13900       b_mtem(3,ja,je) = -10.4425
13901       b_mtem(4,ja,je) = 20.8951
13902       b_mtem(5,ja,je) = -20.7739
13903       b_mtem(6,ja,je) = 7.9355
13904
13905 ! in ca(no3)2
13906       je = jcano3
13907       b_mtem(1,ja,je) = 0.76235
13908       b_mtem(2,ja,je) = 3.08323
13909       b_mtem(3,ja,je) = -23.6772
13910       b_mtem(4,ja,je) = 53.7415
13911       b_mtem(5,ja,je) = -55.4043
13912       b_mtem(6,ja,je) = 21.2944
13913
13914 ! in cacl2 (revised on 11/27/2003)
13915       je = jcacl2
13916       b_mtem(1,ja,je) = 1.13864
13917       b_mtem(2,ja,je) = -0.340539
13918       b_mtem(3,ja,je) = -8.67025
13919       b_mtem(4,ja,je) = 22.8008
13920       b_mtem(5,ja,je) = -24.5181
13921       b_mtem(6,ja,je) = 9.3663
13922
13923 ! in hno3
13924       je = jhno3
13925       b_mtem(1,ja,je) = 2.42532
13926       b_mtem(2,ja,je) = -14.1755
13927       b_mtem(3,ja,je) = 38.804
13928       b_mtem(4,ja,je) = -58.2437
13929       b_mtem(5,ja,je) = 43.5431
13930       b_mtem(6,ja,je) = -12.5824
13931
13932 ! in hcl
13933       je = jhcl
13934       b_mtem(1,ja,je) = 0.330337
13935       b_mtem(2,ja,je) = 0.0778934
13936       b_mtem(3,ja,je) = -2.30492
13937       b_mtem(4,ja,je) = 4.73003
13938       b_mtem(5,ja,je) = -4.80849
13939       b_mtem(6,ja,je) = 1.78866
13940
13941
13942 !----------
13943 ! na2so4 in e
13944       ja = jna2so4
13945
13946 ! in (nh4)2so4
13947       je = jnh4so4
13948       b_mtem(1,ja,je) = -2.6982
13949       b_mtem(2,ja,je) = 22.9875
13950       b_mtem(3,ja,je) = -98.9840
13951       b_mtem(4,ja,je) = 198.0180
13952       b_mtem(5,ja,je) = -188.7270
13953       b_mtem(6,ja,je) = 69.0548
13954
13955 ! in nh4no3
13956       je = jnh4no3
13957       b_mtem(1,ja,je) = -2.4844
13958       b_mtem(2,ja,je) = 6.5420
13959       b_mtem(3,ja,je) = -9.8998
13960       b_mtem(4,ja,je) = 11.3884
13961       b_mtem(5,ja,je) = -13.6842
13962       b_mtem(6,ja,je) = 7.7411
13963
13964 ! in nh4cl (revised on 11/15/2003)
13965       je = jnh4cl
13966       b_mtem(1,ja,je) = -1.3325
13967       b_mtem(2,ja,je) = 13.0406
13968       b_mtem(3,ja,je) = -56.1935
13969       b_mtem(4,ja,je) = 107.1170
13970       b_mtem(5,ja,je) = -97.3721
13971       b_mtem(6,ja,je) = 34.3763
13972
13973 ! in na2so4
13974       je = jna2so4
13975       b_mtem(1,ja,je) = -1.2832
13976       b_mtem(2,ja,je) = 12.8526
13977       b_mtem(3,ja,je) = -62.2087
13978       b_mtem(4,ja,je) = 130.3876
13979       b_mtem(5,ja,je) = -128.2627
13980       b_mtem(6,ja,je) = 48.0340
13981
13982 ! in nano3
13983       je = jnano3
13984       b_mtem(1,ja,je) = -3.5384
13985       b_mtem(2,ja,je) = 21.3758
13986       b_mtem(3,ja,je) = -70.7638
13987       b_mtem(4,ja,je) = 121.1580
13988       b_mtem(5,ja,je) = -104.6230
13989       b_mtem(6,ja,je) = 36.0557
13990
13991 ! in nacl
13992       je = jnacl
13993       b_mtem(1,ja,je) = 0.2175
13994       b_mtem(2,ja,je) = -0.5648
13995       b_mtem(3,ja,je) = -8.0288
13996       b_mtem(4,ja,je) = 25.9734
13997       b_mtem(5,ja,je) = -32.3577
13998       b_mtem(6,ja,je) = 14.3924
13999
14000 ! in hno3
14001       je = jhno3
14002       b_mtem(1,ja,je) = -0.309617
14003       b_mtem(2,ja,je) = -1.82899
14004       b_mtem(3,ja,je) = -1.5505
14005       b_mtem(4,ja,je) = 13.3847
14006       b_mtem(5,ja,je) = -20.1284
14007       b_mtem(6,ja,je) = 9.93163
14008
14009 ! in hcl
14010       je = jhcl
14011       b_mtem(1,ja,je) = -0.259455
14012       b_mtem(2,ja,je) = -0.819366
14013       b_mtem(3,ja,je) = -4.28964
14014       b_mtem(4,ja,je) = 16.4305
14015       b_mtem(5,ja,je) = -21.8546
14016       b_mtem(6,ja,je) = 10.3044
14017
14018 ! in h2so4
14019       je = jh2so4
14020       b_mtem(1,ja,je) = -1.84257
14021       b_mtem(2,ja,je) = 7.85788
14022       b_mtem(3,ja,je) = -29.9275
14023       b_mtem(4,ja,je) = 61.7515
14024       b_mtem(5,ja,je) = -63.2308
14025       b_mtem(6,ja,je) = 24.9542
14026
14027 ! in nh4hso4
14028       je = jnh4hso4
14029       b_mtem(1,ja,je) = -1.05891
14030       b_mtem(2,ja,je) = 2.84831
14031       b_mtem(3,ja,je) = -21.1827
14032       b_mtem(4,ja,je) = 57.5175
14033       b_mtem(5,ja,je) = -64.8120
14034       b_mtem(6,ja,je) = 26.1986
14035
14036 ! in (nh4)3h(so4)2
14037       je = jlvcite
14038       b_mtem(1,ja,je) = -1.16584
14039       b_mtem(2,ja,je) = 8.50075
14040       b_mtem(3,ja,je) = -44.3420
14041       b_mtem(4,ja,je) = 97.3974
14042       b_mtem(5,ja,je) = -98.4549
14043       b_mtem(6,ja,je) = 37.6104
14044
14045 ! in nahso4
14046       je = jnahso4
14047       b_mtem(1,ja,je) = -1.95805
14048       b_mtem(2,ja,je) = 6.62417
14049       b_mtem(3,ja,je) = -31.8072
14050       b_mtem(4,ja,je) = 77.8603
14051       b_mtem(5,ja,je) = -84.6458
14052       b_mtem(6,ja,je) = 33.4963
14053
14054 ! in na3h(so4)2
14055       je = jna3hso4
14056       b_mtem(1,ja,je) = -0.36045
14057       b_mtem(2,ja,je) = 3.55223
14058       b_mtem(3,ja,je) = -24.0327
14059       b_mtem(4,ja,je) = 54.4879
14060       b_mtem(5,ja,je) = -56.6531
14061       b_mtem(6,ja,je) = 22.4956
14062
14063
14064 !----------
14065 ! nano3 in e
14066       ja = jnano3
14067
14068 ! in (nh4)2so4
14069       je = jnh4so4
14070       b_mtem(1,ja,je) = -2.5888
14071       b_mtem(2,ja,je) = 17.6192
14072       b_mtem(3,ja,je) = -63.2183
14073       b_mtem(4,ja,je) = 115.3520
14074       b_mtem(5,ja,je) = -104.0860
14075       b_mtem(6,ja,je) = 36.7390
14076
14077 ! in nh4no3
14078       je = jnh4no3
14079       b_mtem(1,ja,je) = -2.0669
14080       b_mtem(2,ja,je) = 1.4792
14081       b_mtem(3,ja,je) = 10.5261
14082       b_mtem(4,ja,je) = -27.0987
14083       b_mtem(5,ja,je) = 23.0591
14084       b_mtem(6,ja,je) = -6.0938
14085
14086 ! in nh4cl (revised on 11/15/2003)
14087       je = jnh4cl
14088       b_mtem(1,ja,je) = -0.8325
14089       b_mtem(2,ja,je) = 3.9933
14090       b_mtem(3,ja,je) = -15.3789
14091       b_mtem(4,ja,je) = 30.4050
14092       b_mtem(5,ja,je) = -29.4204
14093       b_mtem(6,ja,je) = 11.0597
14094
14095 ! in na2so4
14096       je = jna2so4
14097       b_mtem(1,ja,je) = -1.1233
14098       b_mtem(2,ja,je) = 8.3998
14099       b_mtem(3,ja,je) = -31.9002
14100       b_mtem(4,ja,je) = 60.1450
14101       b_mtem(5,ja,je) = -55.5503
14102       b_mtem(6,ja,je) = 19.7757
14103
14104 ! in nano3
14105       je = jnano3
14106       b_mtem(1,ja,je) = -2.5386
14107       b_mtem(2,ja,je) = 13.9039
14108       b_mtem(3,ja,je) = -42.8467
14109       b_mtem(4,ja,je) = 69.7442
14110       b_mtem(5,ja,je) = -57.8988
14111       b_mtem(6,ja,je) = 19.4635
14112
14113 ! in nacl
14114       je = jnacl
14115       b_mtem(1,ja,je) = -0.4351
14116       b_mtem(2,ja,je) = 2.8311
14117       b_mtem(3,ja,je) = -11.4485
14118       b_mtem(4,ja,je) = 22.7201
14119       b_mtem(5,ja,je) = -22.4228
14120       b_mtem(6,ja,je) = 8.5792
14121
14122 ! in ca(no3)2
14123       je = jcano3
14124       b_mtem(1,ja,je) = -0.72060
14125       b_mtem(2,ja,je) = 5.64915
14126       b_mtem(3,ja,je) = -23.5020
14127       b_mtem(4,ja,je) = 46.0078
14128       b_mtem(5,ja,je) = -43.8075
14129       b_mtem(6,ja,je) = 16.1652
14130
14131 ! in cacl2
14132       je = jcacl2
14133       b_mtem(1,ja,je) = 0.003928
14134       b_mtem(2,ja,je) = 3.54724
14135       b_mtem(3,ja,je) = -18.6057
14136       b_mtem(4,ja,je) = 38.1445
14137       b_mtem(5,ja,je) = -36.7745
14138       b_mtem(6,ja,je) = 13.4529
14139
14140 ! in hno3
14141       je = jhno3
14142       b_mtem(1,ja,je) = -1.1712
14143       b_mtem(2,ja,je) = 7.20907
14144       b_mtem(3,ja,je) = -22.9215
14145       b_mtem(4,ja,je) = 38.1257
14146       b_mtem(5,ja,je) = -32.0759
14147       b_mtem(6,ja,je) = 10.6443
14148
14149 ! in hcl
14150       je = jhcl
14151       b_mtem(1,ja,je) = 0.738022
14152       b_mtem(2,ja,je) = -1.14313
14153       b_mtem(3,ja,je) = 0.32251
14154       b_mtem(4,ja,je) = 0.838679
14155       b_mtem(5,ja,je) = -1.81747
14156       b_mtem(6,ja,je) = 0.873986
14157
14158
14159 !----------
14160 ! nacl in e
14161       ja = jnacl
14162
14163 ! in (nh4)2so4
14164       je = jnh4so4
14165       b_mtem(1,ja,je) = -1.9525
14166       b_mtem(2,ja,je) = 16.6433
14167       b_mtem(3,ja,je) = -61.7090
14168       b_mtem(4,ja,je) = 112.9910
14169       b_mtem(5,ja,je) = -101.9370
14170       b_mtem(6,ja,je) = 35.7760
14171
14172 ! in nh4no3
14173       je = jnh4no3
14174       b_mtem(1,ja,je) = -1.7525
14175       b_mtem(2,ja,je) = 3.0713
14176       b_mtem(3,ja,je) = 4.8063
14177       b_mtem(4,ja,je) = -17.5334
14178       b_mtem(5,ja,je) = 14.2872
14179       b_mtem(6,ja,je) = -3.0690
14180
14181 ! in nh4cl (revised on 11/15/2003)
14182       je = jnh4cl
14183       b_mtem(1,ja,je) = -0.4021
14184       b_mtem(2,ja,je) = 5.2399
14185       b_mtem(3,ja,je) = -19.4278
14186       b_mtem(4,ja,je) = 33.0027
14187       b_mtem(5,ja,je) = -28.1020
14188       b_mtem(6,ja,je) = 9.5159
14189
14190 ! in na2so4
14191       je = jna2so4
14192       b_mtem(1,ja,je) = 0.6692
14193       b_mtem(2,ja,je) = 4.1207
14194       b_mtem(3,ja,je) = -27.3314
14195       b_mtem(4,ja,je) = 59.3112
14196       b_mtem(5,ja,je) = -58.7998
14197       b_mtem(6,ja,je) = 21.7674
14198
14199 ! in nano3
14200       je = jnano3
14201       b_mtem(1,ja,je) = -1.17444
14202       b_mtem(2,ja,je) = 10.9927
14203       b_mtem(3,ja,je) = -38.9013
14204       b_mtem(4,ja,je) = 66.8521
14205       b_mtem(5,ja,je) = -57.6564
14206       b_mtem(6,ja,je) = 19.7296
14207
14208 ! in nacl
14209       je = jnacl
14210       b_mtem(1,ja,je) = 1.17679
14211       b_mtem(2,ja,je) = -2.5061
14212       b_mtem(3,ja,je) = 0.8508
14213       b_mtem(4,ja,je) = 4.4802
14214       b_mtem(5,ja,je) = -8.4945
14215       b_mtem(6,ja,je) = 4.3182
14216
14217 ! in ca(no3)2
14218       je = jcano3
14219       b_mtem(1,ja,je) = 1.01450
14220       b_mtem(2,ja,je) = 2.10260
14221       b_mtem(3,ja,je) = -20.9036
14222       b_mtem(4,ja,je) = 49.1481
14223       b_mtem(5,ja,je) = -51.4867
14224       b_mtem(6,ja,je) = 19.9301
14225
14226 ! in cacl2 (psc92: revised on 11/27/2003)
14227       je = jcacl2
14228       b_mtem(1,ja,je) = 1.55463
14229       b_mtem(2,ja,je) = -3.20122
14230       b_mtem(3,ja,je) = -0.957075
14231       b_mtem(4,ja,je) = 12.103
14232       b_mtem(5,ja,je) = -17.221
14233       b_mtem(6,ja,je) = 7.50264
14234
14235 ! in hno3
14236       je = jhno3
14237       b_mtem(1,ja,je) = 2.46187
14238       b_mtem(2,ja,je) = -12.6845
14239       b_mtem(3,ja,je) = 34.2383
14240       b_mtem(4,ja,je) = -51.9992
14241       b_mtem(5,ja,je) = 39.4934
14242       b_mtem(6,ja,je) = -11.7247
14243
14244 ! in hcl
14245       je = jhcl
14246       b_mtem(1,ja,je) = 1.74915
14247       b_mtem(2,ja,je) = -4.65768
14248       b_mtem(3,ja,je) = 8.80287
14249       b_mtem(4,ja,je) = -12.2503
14250       b_mtem(5,ja,je) = 8.668751
14251       b_mtem(6,ja,je) = -2.50158
14252
14253
14254 !----------
14255 ! ca(no3)2 in e
14256       ja = jcano3
14257
14258 ! in nh4no3
14259       je = jnh4no3
14260       b_mtem(1,ja,je) = -1.86260
14261       b_mtem(2,ja,je) = 11.6178
14262       b_mtem(3,ja,je) = -30.9069
14263       b_mtem(4,ja,je) = 41.7578
14264       b_mtem(5,ja,je) = -33.7338
14265       b_mtem(6,ja,je) = 12.7541
14266
14267 ! in nh4cl (revised on 11/15/2003)
14268       je = jnh4cl
14269       b_mtem(1,ja,je) = -1.1798
14270       b_mtem(2,ja,je) = 25.9608
14271       b_mtem(3,ja,je) = -98.9373
14272       b_mtem(4,ja,je) = 160.2300
14273       b_mtem(5,ja,je) = -125.9540
14274       b_mtem(6,ja,je) = 39.5130
14275
14276 ! in nano3
14277       je = jnano3
14278       b_mtem(1,ja,je) = -1.44384
14279       b_mtem(2,ja,je) = 13.6044
14280       b_mtem(3,ja,je) = -54.4300
14281       b_mtem(4,ja,je) = 100.582
14282       b_mtem(5,ja,je) = -91.2364
14283       b_mtem(6,ja,je) = 32.5970
14284
14285 ! in nacl
14286       je = jnacl
14287       b_mtem(1,ja,je) = -0.099114
14288       b_mtem(2,ja,je) = 2.84091
14289       b_mtem(3,ja,je) = -16.9229
14290       b_mtem(4,ja,je) = 37.4839
14291       b_mtem(5,ja,je) = -39.5132
14292       b_mtem(6,ja,je) = 15.8564
14293
14294 ! in ca(no3)2
14295       je = jcano3
14296       b_mtem(1,ja,je) = 0.055116
14297       b_mtem(2,ja,je) = 4.58610
14298       b_mtem(3,ja,je) = -27.6629
14299       b_mtem(4,ja,je) = 60.8288
14300       b_mtem(5,ja,je) = -61.4988
14301       b_mtem(6,ja,je) = 23.3136
14302
14303 ! in cacl2 (psc92: revised on 11/27/2003)
14304       je = jcacl2
14305       b_mtem(1,ja,je) = 1.57155
14306       b_mtem(2,ja,je) = -3.18486
14307       b_mtem(3,ja,je) = -3.35758
14308       b_mtem(4,ja,je) = 18.7501
14309       b_mtem(5,ja,je) = -24.5604
14310       b_mtem(6,ja,je) = 10.3798
14311
14312 ! in hno3
14313       je = jhno3
14314       b_mtem(1,ja,je) = 1.04446
14315       b_mtem(2,ja,je) = -3.19066
14316       b_mtem(3,ja,je) = 2.44714
14317       b_mtem(4,ja,je) = 2.07218
14318       b_mtem(5,ja,je) = -6.43949
14319       b_mtem(6,ja,je) = 3.66471
14320
14321 ! in hcl
14322       je = jhcl
14323       b_mtem(1,ja,je) = 1.05723
14324       b_mtem(2,ja,je) = -1.46826
14325       b_mtem(3,ja,je) = -1.0713
14326       b_mtem(4,ja,je) = 4.64439
14327       b_mtem(5,ja,je) = -6.32402
14328       b_mtem(6,ja,je) = 2.78202
14329
14330
14331 !----------
14332 ! cacl2 in e
14333       ja = jcacl2
14334
14335 ! in nh4no3 (psc92: revised on 12/22/2003)
14336       je = jnh4no3
14337       b_mtem(1,ja,je) = -1.43626
14338       b_mtem(2,ja,je) = 13.6598
14339       b_mtem(3,ja,je) = -38.2068
14340       b_mtem(4,ja,je) = 53.9057
14341       b_mtem(5,ja,je) = -44.9018
14342       b_mtem(6,ja,je) = 16.6120
14343
14344 ! in nh4cl (psc92: revised on 11/27/2003)
14345       je = jnh4cl
14346       b_mtem(1,ja,je) = -0.603965
14347       b_mtem(2,ja,je) = 27.6027
14348       b_mtem(3,ja,je) = -104.258
14349       b_mtem(4,ja,je) = 163.553
14350       b_mtem(5,ja,je) = -124.076
14351       b_mtem(6,ja,je) = 37.4153
14352
14353 ! in nano3 (psc92: revised on 12/22/2003)
14354       je = jnano3
14355       b_mtem(1,ja,je) = 0.44648
14356       b_mtem(2,ja,je) = 8.8850
14357       b_mtem(3,ja,je) = -45.5232
14358       b_mtem(4,ja,je) = 89.3263
14359       b_mtem(5,ja,je) = -83.8604
14360       b_mtem(6,ja,je) = 30.4069
14361
14362 ! in nacl (psc92: revised on 11/27/2003)
14363       je = jnacl
14364       b_mtem(1,ja,je) = 1.61927
14365       b_mtem(2,ja,je) = 0.247547
14366       b_mtem(3,ja,je) = -18.1252
14367       b_mtem(4,ja,je) = 45.2479
14368       b_mtem(5,ja,je) = -48.6072
14369       b_mtem(6,ja,je) = 19.2784
14370
14371 ! in ca(no3)2 (psc92: revised on 11/27/2003)
14372       je = jcano3
14373       b_mtem(1,ja,je) = 2.36667
14374       b_mtem(2,ja,je) = -0.123309
14375       b_mtem(3,ja,je) = -24.2723
14376       b_mtem(4,ja,je) = 65.1486
14377       b_mtem(5,ja,je) = -71.8504
14378       b_mtem(6,ja,je) = 28.3696
14379
14380 ! in cacl2 (psc92: revised on 11/27/2003)
14381       je = jcacl2
14382       b_mtem(1,ja,je) = 3.64023
14383       b_mtem(2,ja,je) = -12.1926
14384       b_mtem(3,ja,je) = 20.2028
14385       b_mtem(4,ja,je) = -16.0056
14386       b_mtem(5,ja,je) = 1.52355
14387       b_mtem(6,ja,je) = 2.44709
14388
14389 ! in hno3
14390       je = jhno3
14391       b_mtem(1,ja,je) = 5.88794
14392       b_mtem(2,ja,je) = -29.7083
14393       b_mtem(3,ja,je) = 78.6309
14394       b_mtem(4,ja,je) = -118.037
14395       b_mtem(5,ja,je) = 88.932
14396       b_mtem(6,ja,je) = -26.1407
14397
14398 ! in hcl
14399       je = jhcl
14400       b_mtem(1,ja,je) = 2.40628
14401       b_mtem(2,ja,je) = -6.16566
14402       b_mtem(3,ja,je) = 10.2851
14403       b_mtem(4,ja,je) = -12.9035
14404       b_mtem(5,ja,je) = 7.7441
14405       b_mtem(6,ja,je) = -1.74821
14406
14407
14408 !----------
14409 ! hno3 in e
14410       ja = jhno3
14411
14412 ! in (nh4)2so4
14413       je = jnh4so4
14414       b_mtem(1,ja,je) = -3.57598
14415       b_mtem(2,ja,je) = 21.5469
14416       b_mtem(3,ja,je) = -77.4111
14417       b_mtem(4,ja,je) = 144.136
14418       b_mtem(5,ja,je) = -132.849
14419       b_mtem(6,ja,je) = 47.9412
14420
14421 ! in nh4no3
14422       je = jnh4no3
14423       b_mtem(1,ja,je) = -2.00209
14424       b_mtem(2,ja,je) = -3.48399
14425       b_mtem(3,ja,je) = 34.9906
14426       b_mtem(4,ja,je) = -68.6653
14427       b_mtem(5,ja,je) = 54.0992
14428       b_mtem(6,ja,je) = -15.1343
14429
14430 ! in nh4cl revised on 12/22/2003
14431       je = jnh4cl
14432       b_mtem(1,ja,je) = -0.63790
14433       b_mtem(2,ja,je) = -1.67730
14434       b_mtem(3,ja,je) = 10.1727
14435       b_mtem(4,ja,je) = -14.9097
14436       b_mtem(5,ja,je) = 7.67410
14437       b_mtem(6,ja,je) = -0.79586
14438
14439 ! in nacl
14440       je = jnacl
14441       b_mtem(1,ja,je) = 1.3446
14442       b_mtem(2,ja,je) = -2.5578
14443       b_mtem(3,ja,je) = 1.3464
14444       b_mtem(4,ja,je) = 2.90537
14445       b_mtem(5,ja,je) = -6.53014
14446       b_mtem(6,ja,je) = 3.31339
14447
14448 ! in nano3
14449       je = jnano3
14450       b_mtem(1,ja,je) = -0.546636
14451       b_mtem(2,ja,je) = 10.3127
14452       b_mtem(3,ja,je) = -39.9603
14453       b_mtem(4,ja,je) = 71.4609
14454       b_mtem(5,ja,je) = -63.4958
14455       b_mtem(6,ja,je) = 22.0679
14456
14457 ! in na2so4
14458       je = jna2so4
14459       b_mtem(1,ja,je) = 1.35059
14460       b_mtem(2,ja,je) = 4.34557
14461       b_mtem(3,ja,je) = -35.8425
14462       b_mtem(4,ja,je) = 80.9868
14463       b_mtem(5,ja,je) = -81.6544
14464       b_mtem(6,ja,je) = 30.4841
14465
14466 ! in ca(no3)2
14467       je = jcano3
14468       b_mtem(1,ja,je) = 0.869414
14469       b_mtem(2,ja,je) = 2.98486
14470       b_mtem(3,ja,je) = -22.255
14471       b_mtem(4,ja,je) = 50.1863
14472       b_mtem(5,ja,je) = -51.214
14473       b_mtem(6,ja,je) = 19.2235
14474
14475 ! in cacl2 (km) revised on 12/22/2003
14476       je = jcacl2
14477       b_mtem(1,ja,je) = 1.42800
14478       b_mtem(2,ja,je) = -1.78959
14479       b_mtem(3,ja,je) = -2.49075
14480       b_mtem(4,ja,je) = 10.1877
14481       b_mtem(5,ja,je) = -12.1948
14482       b_mtem(6,ja,je) = 4.64475
14483
14484 ! in hno3 (added on 12/06/2004)
14485       je = jhno3
14486       b_mtem(1,ja,je) = 0.22035
14487       b_mtem(2,ja,je) = 2.94973
14488       b_mtem(3,ja,je) = -12.1469
14489       b_mtem(4,ja,je) = 20.4905
14490       b_mtem(5,ja,je) = -17.3966
14491       b_mtem(6,ja,je) = 5.70779
14492
14493 ! in hcl (added on 12/06/2004)
14494       je = jhcl
14495       b_mtem(1,ja,je) = 1.55503
14496       b_mtem(2,ja,je) = -3.61226
14497       b_mtem(3,ja,je) = 6.28265
14498       b_mtem(4,ja,je) = -8.69575
14499       b_mtem(5,ja,je) = 6.09372
14500       b_mtem(6,ja,je) = -1.80898
14501
14502 ! in h2so4
14503       je = jh2so4
14504       b_mtem(1,ja,je) = 1.10783
14505       b_mtem(2,ja,je) = -1.3363
14506       b_mtem(3,ja,je) = -1.83525
14507       b_mtem(4,ja,je) = 7.47373
14508       b_mtem(5,ja,je) = -9.72954
14509       b_mtem(6,ja,je) = 4.12248
14510
14511 ! in nh4hso4
14512       je = jnh4hso4
14513       b_mtem(1,ja,je) = -0.851026
14514       b_mtem(2,ja,je) = 12.2515
14515       b_mtem(3,ja,je) = -49.788
14516       b_mtem(4,ja,je) = 91.6215
14517       b_mtem(5,ja,je) = -81.4877
14518       b_mtem(6,ja,je) = 28.0002
14519
14520 ! in (nh4)3h(so4)2
14521       je = jlvcite
14522       b_mtem(1,ja,je) = -3.09464
14523       b_mtem(2,ja,je) = 14.9303
14524       b_mtem(3,ja,je) = -43.0454
14525       b_mtem(4,ja,je) = 72.6695
14526       b_mtem(5,ja,je) = -65.2140
14527       b_mtem(6,ja,je) = 23.4814
14528
14529 ! in nahso4
14530       je = jnahso4
14531       b_mtem(1,ja,je) = 1.22973
14532       b_mtem(2,ja,je) = 2.82702
14533       b_mtem(3,ja,je) = -17.5869
14534       b_mtem(4,ja,je) = 28.9564
14535       b_mtem(5,ja,je) = -23.5814
14536       b_mtem(6,ja,je) = 7.91153
14537
14538 ! in na3h(so4)2
14539       je = jna3hso4
14540       b_mtem(1,ja,je) = 1.64773
14541       b_mtem(2,ja,je) = 0.94188
14542       b_mtem(3,ja,je) = -19.1242
14543       b_mtem(4,ja,je) = 46.9887
14544       b_mtem(5,ja,je) = -50.9494
14545       b_mtem(6,ja,je) = 20.2169
14546
14547
14548 !----------
14549 ! hcl in e
14550       ja = jhcl
14551
14552 ! in (nh4)2so4
14553       je = jnh4so4
14554       b_mtem(1,ja,je) = -2.93783
14555       b_mtem(2,ja,je) = 20.5546
14556       b_mtem(3,ja,je) = -75.8548
14557       b_mtem(4,ja,je) = 141.729
14558       b_mtem(5,ja,je) = -130.697
14559       b_mtem(6,ja,je) = 46.9905
14560
14561 ! in nh4no3
14562       je = jnh4no3
14563       b_mtem(1,ja,je) = -1.69063
14564       b_mtem(2,ja,je) = -1.85303
14565       b_mtem(3,ja,je) = 29.0927
14566       b_mtem(4,ja,je) = -58.7401
14567       b_mtem(5,ja,je) = 44.999
14568       b_mtem(6,ja,je) = -11.9988
14569
14570 ! in nh4cl (revised on 11/15/2003)
14571       je = jnh4cl
14572       b_mtem(1,ja,je) = -0.2073
14573       b_mtem(2,ja,je) = -0.4322
14574       b_mtem(3,ja,je) = 6.1271
14575       b_mtem(4,ja,je) = -12.3146
14576       b_mtem(5,ja,je) = 8.9919
14577       b_mtem(6,ja,je) = -2.3388
14578
14579 ! in nacl
14580       je = jnacl
14581       b_mtem(1,ja,je) = 2.95913
14582       b_mtem(2,ja,je) = -7.92254
14583       b_mtem(3,ja,je) = 13.736
14584       b_mtem(4,ja,je) = -15.433
14585       b_mtem(5,ja,je) = 7.40386
14586       b_mtem(6,ja,je) = -0.918641
14587
14588 ! in nano3
14589       je = jnano3
14590       b_mtem(1,ja,je) = 0.893272
14591       b_mtem(2,ja,je) = 6.53768
14592       b_mtem(3,ja,je) = -32.3458
14593       b_mtem(4,ja,je) = 61.2834
14594       b_mtem(5,ja,je) = -56.4446
14595       b_mtem(6,ja,je) = 19.9202
14596
14597 ! in na2so4
14598       je = jna2so4
14599       b_mtem(1,ja,je) = 3.14484
14600       b_mtem(2,ja,je) = 0.077019
14601       b_mtem(3,ja,je) = -31.4199
14602       b_mtem(4,ja,je) = 80.5865
14603       b_mtem(5,ja,je) = -85.392
14604       b_mtem(6,ja,je) = 32.6644
14605
14606 ! in ca(no3)2
14607       je = jcano3
14608       b_mtem(1,ja,je) = 2.60432
14609       b_mtem(2,ja,je) = -0.55909
14610       b_mtem(3,ja,je) = -19.6671
14611       b_mtem(4,ja,je) = 53.3446
14612       b_mtem(5,ja,je) = -58.9076
14613       b_mtem(6,ja,je) = 22.9927
14614
14615 ! in cacl2 (km) revised on 3/13/2003 and again on 11/27/2003
14616       je = jcacl2
14617       b_mtem(1,ja,je) = 2.98036
14618       b_mtem(2,ja,je) = -8.55365
14619       b_mtem(3,ja,je) = 15.2108
14620       b_mtem(4,ja,je) = -15.9359
14621       b_mtem(5,ja,je) = 7.41772
14622       b_mtem(6,ja,je) = -1.32143
14623
14624 ! in hno3 (added on 12/06/2004)
14625       je = jhno3
14626       b_mtem(1,ja,je) = 3.8533
14627       b_mtem(2,ja,je) = -16.9427
14628       b_mtem(3,ja,je) = 45.0056
14629       b_mtem(4,ja,je) = -69.6145
14630       b_mtem(5,ja,je) = 54.1491
14631       b_mtem(6,ja,je) = -16.6513
14632
14633 ! in hcl (added on 12/06/2004)
14634       je = jhcl
14635       b_mtem(1,ja,je) = 2.56665
14636       b_mtem(2,ja,je) = -7.13585
14637       b_mtem(3,ja,je) = 14.8103
14638       b_mtem(4,ja,je) = -21.8881
14639       b_mtem(5,ja,je) = 16.6808
14640       b_mtem(6,ja,je) = -5.22091
14641
14642 ! in h2so4
14643       je = jh2so4
14644       b_mtem(1,ja,je) = 2.50179
14645       b_mtem(2,ja,je) = -6.69364
14646       b_mtem(3,ja,je) = 11.6551
14647       b_mtem(4,ja,je) = -13.6897
14648       b_mtem(5,ja,je) = 7.36796
14649       b_mtem(6,ja,je) = -1.33245
14650
14651 ! in nh4hso4
14652       je = jnh4hso4
14653       b_mtem(1,ja,je) = 0.149955
14654       b_mtem(2,ja,je) = 11.8213
14655       b_mtem(3,ja,je) = -53.9164
14656       b_mtem(4,ja,je) = 101.574
14657       b_mtem(5,ja,je) = -91.4123
14658       b_mtem(6,ja,je) = 31.5487
14659
14660 ! in (nh4)3h(so4)2
14661       je = jlvcite
14662       b_mtem(1,ja,je) = -2.36927
14663       b_mtem(2,ja,je) = 14.8359
14664       b_mtem(3,ja,je) = -44.3443
14665       b_mtem(4,ja,je) = 73.6229
14666       b_mtem(5,ja,je) = -65.3366
14667       b_mtem(6,ja,je) = 23.3250
14668
14669 ! in nahso4
14670       je = jnahso4
14671       b_mtem(1,ja,je) = 2.72993
14672       b_mtem(2,ja,je) = -0.23406
14673       b_mtem(3,ja,je) = -10.4103
14674       b_mtem(4,ja,je) = 13.1586
14675       b_mtem(5,ja,je) = -7.79925
14676       b_mtem(6,ja,je) = 2.30843
14677
14678 ! in na3h(so4)2
14679       je = jna3hso4
14680       b_mtem(1,ja,je) = 3.51258
14681       b_mtem(2,ja,je) = -3.95107
14682       b_mtem(3,ja,je) = -11.0175
14683       b_mtem(4,ja,je) = 38.8617
14684       b_mtem(5,ja,je) = -48.1575
14685       b_mtem(6,ja,je) = 20.4717
14686
14687
14688 !----------
14689 ! 2h.so4 in e
14690       ja = jh2so4
14691
14692 ! in h2so4
14693       je = jh2so4
14694       b_mtem(1,ja,je) = 0.76734
14695       b_mtem(2,ja,je) = -1.12263
14696       b_mtem(3,ja,je) = -9.08728
14697       b_mtem(4,ja,je) = 30.3836
14698       b_mtem(5,ja,je) = -38.4133
14699       b_mtem(6,ja,je) = 17.0106
14700
14701 ! in nh4hso4
14702       je = jnh4hso4
14703       b_mtem(1,ja,je) = -2.03879
14704       b_mtem(2,ja,je) = 15.7033
14705       b_mtem(3,ja,je) = -58.7363
14706       b_mtem(4,ja,je) = 109.242
14707       b_mtem(5,ja,je) = -102.237
14708       b_mtem(6,ja,je) = 37.5350
14709
14710 ! in (nh4)3h(so4)2
14711       je = jlvcite
14712       b_mtem(1,ja,je) = -3.10228
14713       b_mtem(2,ja,je) = 16.6920
14714       b_mtem(3,ja,je) = -59.1522
14715       b_mtem(4,ja,je) = 113.487
14716       b_mtem(5,ja,je) = -110.890
14717       b_mtem(6,ja,je) = 42.4578
14718
14719 ! in (nh4)2so4
14720       je = jnh4so4
14721       b_mtem(1,ja,je) = -3.43885
14722       b_mtem(2,ja,je) = 21.0372
14723       b_mtem(3,ja,je) = -84.7026
14724       b_mtem(4,ja,je) = 165.324
14725       b_mtem(5,ja,je) = -156.101
14726       b_mtem(6,ja,je) = 57.3101
14727
14728 ! in nahso4
14729       je = jnahso4
14730       b_mtem(1,ja,je) = 0.33164
14731       b_mtem(2,ja,je) = 6.55864
14732       b_mtem(3,ja,je) = -33.5876
14733       b_mtem(4,ja,je) = 65.1798
14734       b_mtem(5,ja,je) = -63.2046
14735       b_mtem(6,ja,je) = 24.1783
14736
14737 ! in na3h(so4)2
14738       je = jna3hso4
14739       b_mtem(1,ja,je) = 3.06830
14740       b_mtem(2,ja,je) = -3.18408
14741       b_mtem(3,ja,je) = -19.6332
14742       b_mtem(4,ja,je) = 61.3657
14743       b_mtem(5,ja,je) = -73.4438
14744       b_mtem(6,ja,je) = 31.2334
14745
14746 ! in na2so4
14747       je = jna2so4
14748       b_mtem(1,ja,je) = 2.58649
14749       b_mtem(2,ja,je) = 0.87921
14750       b_mtem(3,ja,je) = -39.3023
14751       b_mtem(4,ja,je) = 101.603
14752       b_mtem(5,ja,je) = -109.469
14753       b_mtem(6,ja,je) = 43.0188
14754
14755 ! in hno3
14756       je = jhno3
14757       b_mtem(1,ja,je) = 1.54587
14758       b_mtem(2,ja,je) = -7.50976
14759       b_mtem(3,ja,je) = 12.8237
14760       b_mtem(4,ja,je) = -10.1452
14761       b_mtem(5,ja,je) = -0.541956
14762       b_mtem(6,ja,je) = 3.34536
14763
14764 ! in hcl
14765       je = jhcl
14766       b_mtem(1,ja,je) = 0.829757
14767       b_mtem(2,ja,je) = -4.11316
14768       b_mtem(3,ja,je) = 3.67111
14769       b_mtem(4,ja,je) = 3.6833
14770       b_mtem(5,ja,je) = -11.2711
14771       b_mtem(6,ja,je) = 6.71421
14772
14773
14774 !----------
14775 ! h.hso4 in e
14776       ja = jhhso4
14777
14778 ! in h2so4
14779       je = jh2so4
14780       b_mtem(1,ja,je) = 2.63953
14781       b_mtem(2,ja,je) = -6.01532
14782       b_mtem(3,ja,je) = 10.0204
14783       b_mtem(4,ja,je) = -12.4840
14784       b_mtem(5,ja,je) = 7.78853
14785       b_mtem(6,ja,je) = -2.12638
14786
14787 ! in nh4hso4
14788       je = jnh4hso4
14789       b_mtem(1,ja,je) = -0.77412
14790       b_mtem(2,ja,je) = 14.1656
14791       b_mtem(3,ja,je) = -53.4087
14792       b_mtem(4,ja,je) = 93.2013
14793       b_mtem(5,ja,je) = -80.5723
14794       b_mtem(6,ja,je) = 27.1577
14795
14796 ! in (nh4)3h(so4)2
14797       je = jlvcite
14798       b_mtem(1,ja,je) = -2.98882
14799       b_mtem(2,ja,je) = 14.4436
14800       b_mtem(3,ja,je) = -40.1774
14801       b_mtem(4,ja,je) = 67.5937
14802       b_mtem(5,ja,je) = -61.5040
14803       b_mtem(6,ja,je) = 22.3695
14804
14805 ! in (nh4)2so4
14806       je = jnh4so4
14807       b_mtem(1,ja,je) = -1.15502
14808       b_mtem(2,ja,je) = 8.12309
14809       b_mtem(3,ja,je) = -38.4726
14810       b_mtem(4,ja,je) = 80.8861
14811       b_mtem(5,ja,je) = -80.1644
14812       b_mtem(6,ja,je) = 30.4717
14813
14814 ! in nahso4
14815       je = jnahso4
14816       b_mtem(1,ja,je) = 1.99641
14817       b_mtem(2,ja,je) = -2.96061
14818       b_mtem(3,ja,je) = 5.54778
14819       b_mtem(4,ja,je) = -14.5488
14820       b_mtem(5,ja,je) = 14.8492
14821       b_mtem(6,ja,je) = -5.1389
14822
14823 ! in na3h(so4)2
14824       je = jna3hso4
14825       b_mtem(1,ja,je) = 2.23816
14826       b_mtem(2,ja,je) = -3.20847
14827       b_mtem(3,ja,je) = -4.82853
14828       b_mtem(4,ja,je) = 20.9192
14829       b_mtem(5,ja,je) = -27.2819
14830       b_mtem(6,ja,je) = 11.8655
14831
14832 ! in na2so4
14833       je = jna2so4
14834       b_mtem(1,ja,je) = 2.56907
14835       b_mtem(2,ja,je) = 1.13444
14836       b_mtem(3,ja,je) = -34.6853
14837       b_mtem(4,ja,je) = 87.9775
14838       b_mtem(5,ja,je) = -93.2330
14839       b_mtem(6,ja,je) = 35.9260
14840
14841 ! in hno3
14842       je = jhno3
14843       b_mtem(1,ja,je) = 2.00024
14844       b_mtem(2,ja,je) = -4.80868
14845       b_mtem(3,ja,je) = 8.29222
14846       b_mtem(4,ja,je) = -11.0849
14847       b_mtem(5,ja,je) = 7.51262
14848       b_mtem(6,ja,je) = -2.07654
14849
14850 ! in hcl
14851       je = jhcl
14852       b_mtem(1,ja,je) = 2.8009
14853       b_mtem(2,ja,je) = -6.98416
14854       b_mtem(3,ja,je) = 14.3146
14855       b_mtem(4,ja,je) = -22.0068
14856       b_mtem(5,ja,je) = 17.5557
14857       b_mtem(6,ja,je) = -5.84917
14858
14859
14860 !----------
14861 ! nh4hso4 in e
14862       ja = jnh4hso4
14863
14864 ! in h2so4
14865       je = jh2so4
14866       b_mtem(1,ja,je) = 0.169160
14867       b_mtem(2,ja,je) = 2.15094
14868       b_mtem(3,ja,je) = -9.62904
14869       b_mtem(4,ja,je) = 18.2631
14870       b_mtem(5,ja,je) = -17.3333
14871       b_mtem(6,ja,je) = 6.19835
14872
14873 ! in nh4hso4
14874       je = jnh4hso4
14875       b_mtem(1,ja,je) = -2.34457
14876       b_mtem(2,ja,je) = 12.8035
14877       b_mtem(3,ja,je) = -35.2513
14878       b_mtem(4,ja,je) = 53.6153
14879       b_mtem(5,ja,je) = -42.7655
14880       b_mtem(6,ja,je) = 13.7129
14881
14882 ! in (nh4)3h(so4)2
14883       je = jlvcite
14884       b_mtem(1,ja,je) = -2.56109
14885       b_mtem(2,ja,je) = 11.1414
14886       b_mtem(3,ja,je) = -30.2361
14887       b_mtem(4,ja,je) = 50.0320
14888       b_mtem(5,ja,je) = -44.1586
14889       b_mtem(6,ja,je) = 15.5393
14890
14891 ! in (nh4)2so4
14892       je = jnh4so4
14893       b_mtem(1,ja,je) = -0.97315
14894       b_mtem(2,ja,je) = 7.06295
14895       b_mtem(3,ja,je) = -29.3032
14896       b_mtem(4,ja,je) = 57.6101
14897       b_mtem(5,ja,je) = -54.9020
14898       b_mtem(6,ja,je) = 20.2222
14899
14900 ! in nahso4
14901       je = jnahso4
14902       b_mtem(1,ja,je) = -0.44450
14903       b_mtem(2,ja,je) = 3.33451
14904       b_mtem(3,ja,je) = -15.2791
14905       b_mtem(4,ja,je) = 30.1413
14906       b_mtem(5,ja,je) = -26.7710
14907       b_mtem(6,ja,je) = 8.78462
14908
14909 ! in na3h(so4)2
14910       je = jna3hso4
14911       b_mtem(1,ja,je) = -0.99780
14912       b_mtem(2,ja,je) = 4.69200
14913       b_mtem(3,ja,je) = -16.1219
14914       b_mtem(4,ja,je) = 29.3100
14915       b_mtem(5,ja,je) = -26.3383
14916       b_mtem(6,ja,je) = 9.20695
14917
14918 ! in na2so4
14919       je = jna2so4
14920       b_mtem(1,ja,je) = -0.52694
14921       b_mtem(2,ja,je) = 7.02684
14922       b_mtem(3,ja,je) = -33.7508
14923       b_mtem(4,ja,je) = 70.0565
14924       b_mtem(5,ja,je) = -68.3226
14925       b_mtem(6,ja,je) = 25.2692
14926
14927 ! in hno3
14928       je = jhno3
14929       b_mtem(1,ja,je) = 0.572926
14930       b_mtem(2,ja,je) = -2.04791
14931       b_mtem(3,ja,je) = 2.1134
14932       b_mtem(4,ja,je) = 0.246654
14933       b_mtem(5,ja,je) = -3.06019
14934       b_mtem(6,ja,je) = 1.98126
14935
14936 ! in hcl
14937       je = jhcl
14938       b_mtem(1,ja,je) = 0.56514
14939       b_mtem(2,ja,je) = 0.22287
14940       b_mtem(3,ja,je) = -2.76973
14941       b_mtem(4,ja,je) = 4.54444
14942       b_mtem(5,ja,je) = -3.86549
14943       b_mtem(6,ja,je) = 1.13441
14944
14945
14946 !----------
14947 ! (nh4)3h(so4)2 in e
14948       ja = jlvcite
14949
14950 ! in h2so4
14951       je = jh2so4
14952       b_mtem(1,ja,je) = -1.44811
14953       b_mtem(2,ja,je) = 6.71815
14954       b_mtem(3,ja,je) = -25.0141
14955       b_mtem(4,ja,je) = 50.1109
14956       b_mtem(5,ja,je) = -50.0561
14957       b_mtem(6,ja,je) = 19.3370
14958
14959 ! in nh4hso4
14960       je = jnh4hso4
14961       b_mtem(1,ja,je) = -3.41707
14962       b_mtem(2,ja,je) = 13.4496
14963       b_mtem(3,ja,je) = -34.8018
14964       b_mtem(4,ja,je) = 55.2987
14965       b_mtem(5,ja,je) = -48.1839
14966       b_mtem(6,ja,je) = 17.2444
14967
14968 ! in (nh4)3h(so4)2
14969       je = jlvcite
14970       b_mtem(1,ja,je) = -2.54479
14971       b_mtem(2,ja,je) = 11.8501
14972       b_mtem(3,ja,je) = -39.7286
14973       b_mtem(4,ja,je) = 74.2479
14974       b_mtem(5,ja,je) = -70.4934
14975       b_mtem(6,ja,je) = 26.2836
14976
14977 ! in (nh4)2so4
14978       je = jnh4so4
14979       b_mtem(1,ja,je) = -2.30561
14980       b_mtem(2,ja,je) = 14.5806
14981       b_mtem(3,ja,je) = -55.1238
14982       b_mtem(4,ja,je) = 103.451
14983       b_mtem(5,ja,je) = -95.2571
14984       b_mtem(6,ja,je) = 34.2218
14985
14986 ! in nahso4
14987       je = jnahso4
14988       b_mtem(1,ja,je) = -2.20809
14989       b_mtem(2,ja,je) = 13.6391
14990       b_mtem(3,ja,je) = -57.8246
14991       b_mtem(4,ja,je) = 117.907
14992       b_mtem(5,ja,je) = -112.154
14993       b_mtem(6,ja,je) = 40.3058
14994
14995 ! in na3h(so4)2
14996       je = jna3hso4
14997       b_mtem(1,ja,je) = -1.15099
14998       b_mtem(2,ja,je) = 6.32269
14999       b_mtem(3,ja,je) = -27.3860
15000       b_mtem(4,ja,je) = 55.4592
15001       b_mtem(5,ja,je) = -54.0100
15002       b_mtem(6,ja,je) = 20.3469
15003
15004 ! in na2so4
15005       je = jna2so4
15006       b_mtem(1,ja,je) = -1.15678
15007       b_mtem(2,ja,je) = 8.28718
15008       b_mtem(3,ja,je) = -37.3231
15009       b_mtem(4,ja,je) = 76.6124
15010       b_mtem(5,ja,je) = -74.9307
15011       b_mtem(6,ja,je) = 28.0559
15012
15013 ! in hno3
15014       je = jhno3
15015       b_mtem(1,ja,je) = 0.01502
15016       b_mtem(2,ja,je) = -3.1197
15017       b_mtem(3,ja,je) = 3.61104
15018       b_mtem(4,ja,je) = 3.05196
15019       b_mtem(5,ja,je) = -9.98957
15020       b_mtem(6,ja,je) = 6.04155
15021
15022 ! in hcl
15023       je = jhcl
15024       b_mtem(1,ja,je) = -1.06477
15025       b_mtem(2,ja,je) = 3.38801
15026       b_mtem(3,ja,je) = -12.5784
15027       b_mtem(4,ja,je) = 25.2823
15028       b_mtem(5,ja,je) = -25.4611
15029       b_mtem(6,ja,je) = 10.0754
15030
15031
15032 !----------
15033 ! nahso4 in e
15034       ja = jnahso4
15035
15036 ! in h2so4
15037       je = jh2so4
15038       b_mtem(1,ja,je) = 0.68259
15039       b_mtem(2,ja,je) = 0.71468
15040       b_mtem(3,ja,je) = -5.59003
15041       b_mtem(4,ja,je) = 11.0089
15042       b_mtem(5,ja,je) = -10.7983
15043       b_mtem(6,ja,je) = 3.82335
15044
15045 ! in nh4hso4
15046       je = jnh4hso4
15047       b_mtem(1,ja,je) = -0.03956
15048       b_mtem(2,ja,je) = 4.52828
15049       b_mtem(3,ja,je) = -25.2557
15050       b_mtem(4,ja,je) = 54.4225
15051       b_mtem(5,ja,je) = -52.5105
15052       b_mtem(6,ja,je) = 18.6562
15053
15054 ! in (nh4)3h(so4)2
15055       je = jlvcite
15056       b_mtem(1,ja,je) = -1.53503
15057       b_mtem(2,ja,je) = 8.27608
15058       b_mtem(3,ja,je) = -28.9539
15059       b_mtem(4,ja,je) = 55.2876
15060       b_mtem(5,ja,je) = -51.9563
15061       b_mtem(6,ja,je) = 18.6576
15062
15063 ! in (nh4)2so4
15064       je = jnh4so4
15065       b_mtem(1,ja,je) = -0.38793
15066       b_mtem(2,ja,je) = 7.14680
15067       b_mtem(3,ja,je) = -38.7201
15068       b_mtem(4,ja,je) = 84.3965
15069       b_mtem(5,ja,je) = -84.7453
15070       b_mtem(6,ja,je) = 32.1283
15071
15072 ! in nahso4
15073       je = jnahso4
15074       b_mtem(1,ja,je) = -0.41982
15075       b_mtem(2,ja,je) = 4.26491
15076       b_mtem(3,ja,je) = -20.2351
15077       b_mtem(4,ja,je) = 42.6764
15078       b_mtem(5,ja,je) = -40.7503
15079       b_mtem(6,ja,je) = 14.2868
15080
15081 ! in na3h(so4)2
15082       je = jna3hso4
15083       b_mtem(1,ja,je) = -0.32912
15084       b_mtem(2,ja,je) = 1.80808
15085       b_mtem(3,ja,je) = -8.01286
15086       b_mtem(4,ja,je) = 15.5791
15087       b_mtem(5,ja,je) = -14.5494
15088       b_mtem(6,ja,je) = 5.27052
15089
15090 ! in na2so4
15091       je = jna2so4
15092       b_mtem(1,ja,je) = 0.10271
15093       b_mtem(2,ja,je) = 5.09559
15094       b_mtem(3,ja,je) = -30.3295
15095       b_mtem(4,ja,je) = 66.2975
15096       b_mtem(5,ja,je) = -66.3458
15097       b_mtem(6,ja,je) = 24.9443
15098
15099 ! in hno3
15100       je = jhno3
15101       b_mtem(1,ja,je) = 0.608309
15102       b_mtem(2,ja,je) = -0.541905
15103       b_mtem(3,ja,je) = -2.52084
15104       b_mtem(4,ja,je) = 6.63297
15105       b_mtem(5,ja,je) = -7.24599
15106       b_mtem(6,ja,je) = 2.88811
15107
15108 ! in hcl
15109       je = jhcl
15110       b_mtem(1,ja,je) = 1.98399
15111       b_mtem(2,ja,je) = -4.51562
15112       b_mtem(3,ja,je) = 8.36059
15113       b_mtem(4,ja,je) = -12.4948
15114       b_mtem(5,ja,je) = 9.67514
15115       b_mtem(6,ja,je) = -3.18004
15116
15117
15118 !----------
15119 ! na3h(so4)2 in e
15120       ja = jna3hso4
15121
15122 ! in h2so4
15123       je = jh2so4
15124       b_mtem(1,ja,je) = -0.83214
15125       b_mtem(2,ja,je) = 4.99572
15126       b_mtem(3,ja,je) = -20.1697
15127       b_mtem(4,ja,je) = 41.4066
15128       b_mtem(5,ja,je) = -42.2119
15129       b_mtem(6,ja,je) = 16.4855
15130
15131 ! in nh4hso4
15132       je = jnh4hso4
15133       b_mtem(1,ja,je) = -0.65139
15134       b_mtem(2,ja,je) = 3.52300
15135       b_mtem(3,ja,je) = -22.8220
15136       b_mtem(4,ja,je) = 56.2956
15137       b_mtem(5,ja,je) = -59.9028
15138       b_mtem(6,ja,je) = 23.1844
15139
15140 ! in (nh4)3h(so4)2
15141       je = jlvcite
15142       b_mtem(1,ja,je) = -1.31331
15143       b_mtem(2,ja,je) = 8.40835
15144       b_mtem(3,ja,je) = -38.1757
15145       b_mtem(4,ja,je) = 80.5312
15146       b_mtem(5,ja,je) = -79.8346
15147       b_mtem(6,ja,je) = 30.0219
15148
15149 ! in (nh4)2so4
15150       je = jnh4so4
15151       b_mtem(1,ja,je) = -1.03054
15152       b_mtem(2,ja,je) = 8.08155
15153       b_mtem(3,ja,je) = -38.1046
15154       b_mtem(4,ja,je) = 78.7168
15155       b_mtem(5,ja,je) = -77.2263
15156       b_mtem(6,ja,je) = 29.1521
15157
15158 ! in nahso4
15159       je = jnahso4
15160       b_mtem(1,ja,je) = -1.90695
15161       b_mtem(2,ja,je) = 11.6241
15162       b_mtem(3,ja,je) = -50.3175
15163       b_mtem(4,ja,je) = 105.884
15164       b_mtem(5,ja,je) = -103.258
15165       b_mtem(6,ja,je) = 37.6588
15166
15167 ! in na3h(so4)2
15168       je = jna3hso4
15169       b_mtem(1,ja,je) = -0.34780
15170       b_mtem(2,ja,je) = 2.85363
15171       b_mtem(3,ja,je) = -17.6224
15172       b_mtem(4,ja,je) = 38.9220
15173       b_mtem(5,ja,je) = -39.8106
15174       b_mtem(6,ja,je) = 15.6055
15175
15176 ! in na2so4
15177       je = jna2so4
15178       b_mtem(1,ja,je) = -0.75230
15179       b_mtem(2,ja,je) = 10.0140
15180       b_mtem(3,ja,je) = -50.5677
15181       b_mtem(4,ja,je) = 106.941
15182       b_mtem(5,ja,je) = -105.534
15183       b_mtem(6,ja,je) = 39.5196
15184
15185 ! in hno3
15186       je = jhno3
15187       b_mtem(1,ja,je) = 0.057456
15188       b_mtem(2,ja,je) = -1.31264
15189       b_mtem(3,ja,je) = -1.94662
15190       b_mtem(4,ja,je) = 10.7024
15191       b_mtem(5,ja,je) = -14.9946
15192       b_mtem(6,ja,je) = 7.12161
15193
15194 ! in hcl
15195       je = jhcl
15196       b_mtem(1,ja,je) = 0.637894
15197       b_mtem(2,ja,je) = -2.29719
15198       b_mtem(3,ja,je) = 0.765361
15199       b_mtem(4,ja,je) = 4.8748
15200       b_mtem(5,ja,je) = -9.25978
15201       b_mtem(6,ja,je) = 4.91773
15202 !
15203 !
15204 !
15205 !----------------------------------------------------------
15206 ! coefficients for %mdrh(t) = d1 + d2*t + d3*t^2 + d4*t^3    (t in kelvin)
15207 ! valid temperature range: 240 - 320 k
15208 !----------------------------------------------------------
15209 !
15210 ! sulfate-poor systems
15211 ! ac
15212       j_index = 1
15213       d_mdrh(j_index,1) = -58.00268351
15214       d_mdrh(j_index,2) = 2.031077573
15215       d_mdrh(j_index,3) = -0.008281218
15216       d_mdrh(j_index,4) = 1.00447e-05
15217
15218 ! an
15219       j_index = 2
15220       d_mdrh(j_index,1) = 1039.137773
15221       d_mdrh(j_index,2) = -11.47847095
15222       d_mdrh(j_index,3) = 0.047702786
15223       d_mdrh(j_index,4) = -6.77675e-05
15224
15225 ! as
15226       j_index = 3
15227       d_mdrh(j_index,1) = 115.8366357
15228       d_mdrh(j_index,2) = 0.491881663
15229       d_mdrh(j_index,3) = -0.00422807
15230       d_mdrh(j_index,4) = 7.29274e-06
15231
15232 ! sc
15233       j_index = 4
15234       d_mdrh(j_index,1) = 253.2424151
15235       d_mdrh(j_index,2) = -1.429957864
15236       d_mdrh(j_index,3) = 0.003727554
15237       d_mdrh(j_index,4) = -3.13037e-06
15238
15239 ! sn
15240       j_index = 5
15241       d_mdrh(j_index,1) = -372.4306506
15242       d_mdrh(j_index,2) = 5.3955633
15243       d_mdrh(j_index,3) = -0.019804438
15244       d_mdrh(j_index,4) = 2.25662e-05
15245
15246 ! ss
15247       j_index = 6
15248       d_mdrh(j_index,1) = 286.1271416
15249       d_mdrh(j_index,2) = -1.670787758
15250       d_mdrh(j_index,3) = 0.004431373
15251       d_mdrh(j_index,4) = -3.57757e-06
15252
15253 ! cc
15254       j_index = 7
15255       d_mdrh(j_index,1) = -1124.07059
15256       d_mdrh(j_index,2) = 14.26364209
15257       d_mdrh(j_index,3) = -0.054816822
15258       d_mdrh(j_index,4) = 6.70107e-05
15259
15260 ! cn
15261       j_index = 8
15262       d_mdrh(j_index,1) = 1855.413934
15263       d_mdrh(j_index,2) = -20.29219473
15264       d_mdrh(j_index,3) = 0.07807482
15265       d_mdrh(j_index,4) = -1.017887858e-4
15266
15267 ! an + ac
15268       j_index = 9
15269       d_mdrh(j_index,1) = 1761.176886
15270       d_mdrh(j_index,2) = -19.29811062
15271       d_mdrh(j_index,3) = 0.075676987
15272       d_mdrh(j_index,4) = -1.0116959e-4
15273
15274 ! as + ac
15275       j_index = 10
15276       d_mdrh(j_index,1) = 122.1074303
15277       d_mdrh(j_index,2) = 0.429692122
15278       d_mdrh(j_index,3) = -0.003928277
15279       d_mdrh(j_index,4) = 6.43275e-06
15280
15281 ! as + an
15282       j_index = 11
15283       d_mdrh(j_index,1) = 2424.634678
15284       d_mdrh(j_index,2) = -26.54031307
15285       d_mdrh(j_index,3) = 0.101625387
15286       d_mdrh(j_index,4) = -1.31544547798e-4
15287
15288 ! as + an + ac
15289       j_index = 12
15290       d_mdrh(j_index,1) = 2912.082599
15291       d_mdrh(j_index,2) = -31.8894185
15292       d_mdrh(j_index,3) = 0.121185849
15293       d_mdrh(j_index,4) = -1.556534623e-4
15294
15295 ! sc + ac
15296       j_index = 13
15297       d_mdrh(j_index,1) = 172.2596493
15298       d_mdrh(j_index,2) = -0.511006195
15299       d_mdrh(j_index,3) = 4.27244597e-4
15300       d_mdrh(j_index,4) = 4.12797e-07
15301
15302 ! sn + ac
15303       j_index = 14
15304       d_mdrh(j_index,1) = 1596.184935
15305       d_mdrh(j_index,2) = -16.37945565
15306       d_mdrh(j_index,3) = 0.060281218
15307       d_mdrh(j_index,4) = -7.6161e-05
15308
15309 ! sn + an
15310       j_index = 15
15311       d_mdrh(j_index,1) = 1916.072988
15312       d_mdrh(j_index,2) = -20.85594868
15313       d_mdrh(j_index,3) = 0.081140141
15314       d_mdrh(j_index,4) = -1.07954274796e-4
15315
15316 ! sn + an + ac
15317       j_index = 16
15318       d_mdrh(j_index,1) = 1467.165935
15319       d_mdrh(j_index,2) = -16.01166196
15320       d_mdrh(j_index,3) = 0.063505582
15321       d_mdrh(j_index,4) = -8.66722e-05
15322
15323 ! sn + sc
15324       j_index = 17
15325       d_mdrh(j_index,1) = 158.447059
15326       d_mdrh(j_index,2) = -0.628167358
15327       d_mdrh(j_index,3) = 0.002014448
15328       d_mdrh(j_index,4) = -3.13037e-06
15329
15330 ! sn + sc + ac
15331       j_index = 18
15332       d_mdrh(j_index,1) = 1115.892468
15333       d_mdrh(j_index,2) = -11.76936534
15334       d_mdrh(j_index,3) = 0.045577399
15335       d_mdrh(j_index,4) = -6.05779e-05
15336
15337 ! ss + ac
15338       j_index = 19
15339       d_mdrh(j_index,1) = 269.5432407
15340       d_mdrh(j_index,2) = -1.319963885
15341       d_mdrh(j_index,3) = 0.002592363
15342       d_mdrh(j_index,4) = -1.44479e-06
15343
15344 ! ss + an
15345       j_index = 20
15346       d_mdrh(j_index,1) = 2841.334784
15347       d_mdrh(j_index,2) = -31.1889487
15348       d_mdrh(j_index,3) = 0.118809274
15349       d_mdrh(j_index,4) = -1.53007e-4
15350
15351 ! ss + an + ac
15352       j_index = 21
15353       d_mdrh(j_index,1) = 2199.36914
15354       d_mdrh(j_index,2) = -24.11926569
15355       d_mdrh(j_index,3) = 0.092932361
15356       d_mdrh(j_index,4) = -1.21774e-4
15357
15358 ! ss + as
15359       j_index = 22
15360       d_mdrh(j_index,1) = 395.0051604
15361       d_mdrh(j_index,2) = -2.521101657
15362       d_mdrh(j_index,3) = 0.006139319
15363       d_mdrh(j_index,4) = -4.43756e-06
15364
15365 ! ss + as + ac
15366       j_index = 23
15367       d_mdrh(j_index,1) = 386.5150675
15368       d_mdrh(j_index,2) = -2.4632138
15369       d_mdrh(j_index,3) = 0.006139319
15370       d_mdrh(j_index,4) = -4.98796e-06
15371
15372 ! ss + as + an
15373       j_index = 24
15374       d_mdrh(j_index,1) = 3101.538491
15375       d_mdrh(j_index,2) = -34.19978105
15376       d_mdrh(j_index,3) = 0.130118605
15377       d_mdrh(j_index,4) = -1.66873e-4
15378
15379 ! ss + as + an + ac
15380       j_index = 25
15381       d_mdrh(j_index,1) = 2307.579403
15382       d_mdrh(j_index,2) = -25.43136774
15383       d_mdrh(j_index,3) = 0.098064728
15384       d_mdrh(j_index,4) = -1.28301e-4
15385
15386 ! ss + sc
15387       j_index = 26
15388       d_mdrh(j_index,1) = 291.8309602
15389       d_mdrh(j_index,2) = -1.828912974
15390       d_mdrh(j_index,3) = 0.005053148
15391       d_mdrh(j_index,4) = -4.57516e-06
15392
15393 ! ss + sc + ac
15394       j_index = 27
15395       d_mdrh(j_index,1) = 188.3914345
15396       d_mdrh(j_index,2) = -0.631345031
15397       d_mdrh(j_index,3) = 0.000622807
15398       d_mdrh(j_index,4) = 4.47196e-07
15399
15400 ! ss + sn
15401       j_index = 28
15402       d_mdrh(j_index,1) = -167.1252839
15403       d_mdrh(j_index,2) = 2.969828002
15404       d_mdrh(j_index,3) = -0.010637255
15405       d_mdrh(j_index,4) = 1.13175e-05
15406
15407 ! ss + sn + ac
15408       j_index = 29
15409       d_mdrh(j_index,1) = 1516.782768
15410       d_mdrh(j_index,2) = -15.7922661
15411       d_mdrh(j_index,3) = 0.058942209
15412       d_mdrh(j_index,4) = -7.5301e-05
15413
15414 ! ss + sn + an
15415       j_index = 30
15416       d_mdrh(j_index,1) = 1739.963163
15417       d_mdrh(j_index,2) = -19.06576022
15418       d_mdrh(j_index,3) = 0.07454963
15419       d_mdrh(j_index,4) = -9.94302e-05
15420
15421 ! ss + sn + an + ac
15422       j_index = 31
15423       d_mdrh(j_index,1) = 2152.104877
15424       d_mdrh(j_index,2) = -23.74998008
15425       d_mdrh(j_index,3) = 0.092256654
15426       d_mdrh(j_index,4) = -1.21953e-4
15427
15428 ! ss + sn + sc
15429       j_index = 32
15430       d_mdrh(j_index,1) = 221.9976265
15431       d_mdrh(j_index,2) = -1.311331272
15432       d_mdrh(j_index,3) = 0.004406089
15433       d_mdrh(j_index,4) = -5.88235e-06
15434
15435 ! ss + sn + sc + ac
15436       j_index = 33
15437       d_mdrh(j_index,1) = 1205.645615
15438       d_mdrh(j_index,2) = -12.71353459
15439       d_mdrh(j_index,3) = 0.048803922
15440       d_mdrh(j_index,4) = -6.41899e-05
15441
15442 ! cc + ac
15443       j_index = 34
15444       d_mdrh(j_index,1) = 506.6737879
15445       d_mdrh(j_index,2) = -3.723520818
15446       d_mdrh(j_index,3) = 0.010814242
15447       d_mdrh(j_index,4) = -1.21087e-05
15448
15449 ! cc + sc
15450       j_index = 35
15451       d_mdrh(j_index,1) = -1123.523841
15452       d_mdrh(j_index,2) = 14.08345977
15453       d_mdrh(j_index,3) = -0.053687823
15454       d_mdrh(j_index,4) = 6.52219e-05
15455
15456 ! cc + sc + ac
15457       j_index = 36
15458       d_mdrh(j_index,1) = -1159.98607
15459       d_mdrh(j_index,2) = 14.44309169
15460       d_mdrh(j_index,3) = -0.054841073
15461       d_mdrh(j_index,4) = 6.64259e-05
15462
15463 ! cn + ac
15464       j_index = 37
15465       d_mdrh(j_index,1) = 756.0747916
15466       d_mdrh(j_index,2) = -8.546826257
15467       d_mdrh(j_index,3) = 0.035798677
15468       d_mdrh(j_index,4) = -5.06629e-05
15469
15470 ! cn + an
15471       j_index = 38
15472       d_mdrh(j_index,1) = 338.668191
15473       d_mdrh(j_index,2) = -2.971223403
15474       d_mdrh(j_index,3) = 0.012294866
15475       d_mdrh(j_index,4) = -1.87558e-05
15476
15477 ! cn + an + ac
15478       j_index = 39
15479       d_mdrh(j_index,1) = -53.18033508
15480       d_mdrh(j_index,2) = 0.663911748
15481       d_mdrh(j_index,3) = 9.16326e-4
15482       d_mdrh(j_index,4) = -6.70354e-06
15483
15484 ! cn + sc
15485       j_index = 40
15486       d_mdrh(j_index,1) = 3623.831129
15487       d_mdrh(j_index,2) = -39.27226457
15488       d_mdrh(j_index,3) = 0.144559515
15489       d_mdrh(j_index,4) = -1.78159e-4
15490
15491 ! cn + sc + ac
15492       j_index = 41
15493       d_mdrh(j_index,1) = 3436.656743
15494       d_mdrh(j_index,2) = -37.16192684
15495       d_mdrh(j_index,3) = 0.136641377
15496       d_mdrh(j_index,4) = -1.68262e-4
15497
15498 ! cn + sn
15499       j_index = 42
15500       d_mdrh(j_index,1) = 768.608476
15501       d_mdrh(j_index,2) = -8.051517149
15502       d_mdrh(j_index,3) = 0.032342332
15503       d_mdrh(j_index,4) = -4.52224e-05
15504
15505 ! cn + sn + ac
15506       j_index = 43
15507       d_mdrh(j_index,1) = 33.58027951
15508       d_mdrh(j_index,2) = -0.308772182
15509       d_mdrh(j_index,3) = 0.004713639
15510       d_mdrh(j_index,4) = -1.19658e-05
15511
15512 ! cn + sn + an
15513       j_index = 44
15514       d_mdrh(j_index,1) = 57.80183041
15515       d_mdrh(j_index,2) = 0.215264604
15516       d_mdrh(j_index,3) = 4.11406e-4
15517       d_mdrh(j_index,4) = -4.30702e-06
15518
15519 ! cn + sn + an + ac
15520       j_index = 45
15521       d_mdrh(j_index,1) = -234.368984
15522       d_mdrh(j_index,2) = 2.721045204
15523       d_mdrh(j_index,3) = -0.006688341
15524       d_mdrh(j_index,4) = 2.31729e-06
15525
15526 ! cn + sn + sc
15527       j_index = 46
15528       d_mdrh(j_index,1) = 3879.080557
15529       d_mdrh(j_index,2) = -42.13562874
15530       d_mdrh(j_index,3) = 0.155235005
15531       d_mdrh(j_index,4) = -1.91387e-4
15532
15533 ! cn + sn + sc + ac
15534       j_index = 47
15535       d_mdrh(j_index,1) = 3600.576985
15536       d_mdrh(j_index,2) = -39.0283489
15537       d_mdrh(j_index,3) = 0.143710316
15538       d_mdrh(j_index,4) = -1.77167e-4
15539
15540 ! cn + cc
15541       j_index = 48
15542       d_mdrh(j_index,1) = -1009.729826
15543       d_mdrh(j_index,2) = 12.9145339
15544       d_mdrh(j_index,3) = -0.049811146
15545       d_mdrh(j_index,4) = 6.09563e-05
15546
15547 ! cn + cc + ac
15548       j_index = 49
15549       d_mdrh(j_index,1) = -577.0919514
15550       d_mdrh(j_index,2) = 8.020324227
15551       d_mdrh(j_index,3) = -0.031469556
15552       d_mdrh(j_index,4) = 3.82181e-05
15553
15554 ! cn + cc + sc
15555       j_index = 50
15556       d_mdrh(j_index,1) = -728.9983499
15557       d_mdrh(j_index,2) = 9.849458215
15558       d_mdrh(j_index,3) = -0.03879257
15559       d_mdrh(j_index,4) = 4.78844e-05
15560
15561 ! cn + cc + sc + ac
15562       j_index = 51
15563       d_mdrh(j_index,1) = -803.7026845
15564       d_mdrh(j_index,2) = 10.61881494
15565       d_mdrh(j_index,3) = -0.041402993
15566       d_mdrh(j_index,4) = 5.08084e-05
15567
15568 !
15569 ! sulfate-rich systems
15570 ! ab
15571       j_index = 52
15572       d_mdrh(j_index,1) = -493.6190458
15573       d_mdrh(j_index,2) = 6.747053851
15574       d_mdrh(j_index,3) = -0.026955267
15575       d_mdrh(j_index,4) = 3.45118e-05
15576
15577 ! lv
15578       j_index = 53
15579       d_mdrh(j_index,1) = 53.37874093
15580       d_mdrh(j_index,2) = 1.01368249
15581       d_mdrh(j_index,3) = -0.005887513
15582       d_mdrh(j_index,4) = 8.94393e-06
15583
15584 ! sb
15585       j_index = 54
15586       d_mdrh(j_index,1) = 206.619047
15587       d_mdrh(j_index,2) = -1.342735684
15588       d_mdrh(j_index,3) = 0.003197691
15589       d_mdrh(j_index,4) = -1.93603e-06
15590
15591 ! ab + lv
15592       j_index = 55
15593       d_mdrh(j_index,1) = -493.6190458
15594       d_mdrh(j_index,2) = 6.747053851
15595       d_mdrh(j_index,3) = -0.026955267
15596       d_mdrh(j_index,4) = 3.45118e-05
15597
15598 ! as + lv
15599       j_index = 56
15600       d_mdrh(j_index,1) = 53.37874093
15601       d_mdrh(j_index,2) = 1.01368249
15602       d_mdrh(j_index,3) = -0.005887513
15603       d_mdrh(j_index,4) = 8.94393e-06
15604
15605 ! ss + sb
15606       j_index = 57
15607       d_mdrh(j_index,1) = 206.619047
15608       d_mdrh(j_index,2) = -1.342735684
15609       d_mdrh(j_index,3) = 0.003197691
15610       d_mdrh(j_index,4) = -1.93603e-06
15611
15612 ! ss + lv
15613       j_index = 58
15614       d_mdrh(j_index,1) = 41.7619047
15615       d_mdrh(j_index,2) = 1.303872053
15616       d_mdrh(j_index,3) = -0.007647908
15617       d_mdrh(j_index,4) = 1.17845e-05
15618
15619 ! ss + as + lv
15620       j_index = 59
15621       d_mdrh(j_index,1) = 41.7619047
15622       d_mdrh(j_index,2) = 1.303872053
15623       d_mdrh(j_index,3) = -0.007647908
15624       d_mdrh(j_index,4) = 1.17845e-05
15625
15626 ! ss + ab
15627       j_index = 60
15628       d_mdrh(j_index,1) = -369.7142842
15629       d_mdrh(j_index,2) = 5.512878771
15630       d_mdrh(j_index,3) = -0.02301948
15631       d_mdrh(j_index,4) = 3.0303e-05
15632
15633 ! ss + lv + ab
15634       j_index = 61
15635       d_mdrh(j_index,1) = -369.7142842
15636       d_mdrh(j_index,2) = 5.512878771
15637       d_mdrh(j_index,3) = -0.02301948
15638       d_mdrh(j_index,4) = 3.0303e-05
15639
15640 ! sb + ab
15641       j_index = 62
15642       d_mdrh(j_index,1) = -162.8095232
15643       d_mdrh(j_index,2) = 2.399326592
15644       d_mdrh(j_index,3) = -0.009336219
15645       d_mdrh(j_index,4) = 1.17845e-05
15646
15647 ! ss + sb + ab
15648       j_index = 63
15649       d_mdrh(j_index,1) = -735.4285689
15650       d_mdrh(j_index,2) = 8.885521857
15651       d_mdrh(j_index,3) = -0.033488456
15652       d_mdrh(j_index,4) = 4.12458e-05
15653
15654       call load_kappa_nonelectro
15655
15656       endif ! first
15657
15658       return
15659       end subroutine load_mosaic_parameters
15660
15661
15662
15663
15664       subroutine load_kappa_nonelectro
15665
15666       use module_data_mosaic_asect, only: &
15667          hygro_oin_aer, hygro_oc_aer, hygro_bc_aer,  &
15668          hygro_pcg1_b_c_aer,  hygro_pcg2_b_c_aer,  hygro_pcg3_b_c_aer,  &
15669          hygro_pcg4_b_c_aer,  hygro_pcg5_b_c_aer,  hygro_pcg6_b_c_aer,  &
15670          hygro_pcg7_b_c_aer,  hygro_pcg8_b_c_aer,  hygro_pcg9_b_c_aer,  &
15671          hygro_pcg1_b_o_aer,  hygro_pcg2_b_o_aer,  hygro_pcg3_b_o_aer,  &
15672          hygro_pcg4_b_o_aer,  hygro_pcg5_b_o_aer,  hygro_pcg6_b_o_aer,  &
15673          hygro_pcg7_b_o_aer,  hygro_pcg8_b_o_aer,  hygro_pcg9_b_o_aer,  &
15674          hygro_opcg1_b_c_aer, hygro_opcg2_b_c_aer, hygro_opcg3_b_c_aer,  &
15675          hygro_opcg4_b_c_aer, hygro_opcg5_b_c_aer, hygro_opcg6_b_c_aer,  &
15676          hygro_opcg7_b_c_aer, hygro_opcg8_b_c_aer,  &
15677          hygro_opcg1_b_o_aer, hygro_opcg2_b_o_aer, hygro_opcg3_b_o_aer,  &
15678          hygro_opcg4_b_o_aer, hygro_opcg5_b_o_aer, hygro_opcg6_b_o_aer,  &
15679          hygro_opcg7_b_o_aer, hygro_opcg8_b_o_aer,  &
15680          hygro_pcg1_f_c_aer,  hygro_pcg2_f_c_aer,  hygro_pcg3_f_c_aer,  &
15681          hygro_pcg4_f_c_aer,  hygro_pcg5_f_c_aer,  hygro_pcg6_f_c_aer,  &
15682          hygro_pcg7_f_c_aer,  hygro_pcg8_f_c_aer,  hygro_pcg9_f_c_aer,  &
15683          hygro_pcg1_f_o_aer,  hygro_pcg2_f_o_aer,  hygro_pcg3_f_o_aer,  &
15684          hygro_pcg4_f_o_aer,  hygro_pcg5_f_o_aer,  hygro_pcg6_f_o_aer,  &
15685          hygro_pcg7_f_o_aer,  hygro_pcg8_f_o_aer,  hygro_pcg9_f_o_aer,  &
15686          hygro_opcg1_f_c_aer, hygro_opcg2_f_c_aer, hygro_opcg3_f_c_aer,  &
15687          hygro_opcg4_f_c_aer, hygro_opcg5_f_c_aer, hygro_opcg6_f_c_aer,  &
15688          hygro_opcg7_f_c_aer, hygro_opcg8_f_c_aer,  &
15689          hygro_opcg1_f_o_aer, hygro_opcg2_f_o_aer, hygro_opcg3_f_o_aer,  &
15690          hygro_opcg4_f_o_aer, hygro_opcg5_f_o_aer, hygro_opcg6_f_o_aer,  &
15691          hygro_opcg7_f_o_aer, hygro_opcg8_f_o_aer,  &
15692          hygro_ant1_c_aer,  hygro_ant2_c_aer,  hygro_ant3_c_aer,  hygro_ant4_c_aer,  &
15693          hygro_ant1_o_aer,  hygro_ant2_o_aer,  hygro_ant3_o_aer,  hygro_ant4_o_aer,  &
15694          hygro_biog1_c_aer, hygro_biog2_c_aer, hygro_biog3_c_aer, hygro_biog4_c_aer,  &
15695          hygro_biog1_o_aer, hygro_biog2_o_aer, hygro_biog3_o_aer, hygro_biog4_o_aer,  &
15696          hygro_smpa_aer, hygro_smpbb_aer,  &
15697          hygro_glysoa_r1_aer,  hygro_glysoa_r2_aer,  hygro_glysoa_oh_aer,  &
15698          hygro_glysoa_nh4_aer, hygro_glysoa_sfc_aer,  &
15699          hygro_asoaX_aer, hygro_asoa1_aer, hygro_asoa2_aer,  &
15700          hygro_asoa3_aer, hygro_asoa4_aer,  &
15701          hygro_bsoaX_aer, hygro_bsoa1_aer, hygro_bsoa2_aer,  &
15702          hygro_bsoa3_aer, hygro_bsoa4_aer
15703
15704       if (ioin_a        > 0) kappa_nonelectro(ioin_a       ) = hygro_oin_aer
15705       if (ioc_a         > 0) kappa_nonelectro(ioc_a        ) = hygro_oc_aer
15706       if (ibc_a         > 0) kappa_nonelectro(ibc_a        ) = hygro_bc_aer
15707
15708       if (ipcg1_b_c_a   > 0) kappa_nonelectro(ipcg1_b_c_a  ) = hygro_pcg1_b_c_aer
15709       if (ipcg2_b_c_a   > 0) kappa_nonelectro(ipcg2_b_c_a  ) = hygro_pcg2_b_c_aer
15710       if (ipcg3_b_c_a   > 0) kappa_nonelectro(ipcg3_b_c_a  ) = hygro_pcg3_b_c_aer
15711       if (ipcg4_b_c_a   > 0) kappa_nonelectro(ipcg4_b_c_a  ) = hygro_pcg4_b_c_aer
15712       if (ipcg5_b_c_a   > 0) kappa_nonelectro(ipcg5_b_c_a  ) = hygro_pcg5_b_c_aer
15713       if (ipcg6_b_c_a   > 0) kappa_nonelectro(ipcg6_b_c_a  ) = hygro_pcg6_b_c_aer
15714       if (ipcg7_b_c_a   > 0) kappa_nonelectro(ipcg7_b_c_a  ) = hygro_pcg7_b_c_aer
15715       if (ipcg8_b_c_a   > 0) kappa_nonelectro(ipcg8_b_c_a  ) = hygro_pcg8_b_c_aer
15716       if (ipcg9_b_c_a   > 0) kappa_nonelectro(ipcg9_b_c_a  ) = hygro_pcg9_b_c_aer
15717       if (ipcg1_b_o_a   > 0) kappa_nonelectro(ipcg1_b_o_a  ) = hygro_pcg1_b_o_aer
15718       if (ipcg2_b_o_a   > 0) kappa_nonelectro(ipcg2_b_o_a  ) = hygro_pcg2_b_o_aer
15719       if (ipcg3_b_o_a   > 0) kappa_nonelectro(ipcg3_b_o_a  ) = hygro_pcg3_b_o_aer
15720       if (ipcg4_b_o_a   > 0) kappa_nonelectro(ipcg4_b_o_a  ) = hygro_pcg4_b_o_aer
15721       if (ipcg5_b_o_a   > 0) kappa_nonelectro(ipcg5_b_o_a  ) = hygro_pcg5_b_o_aer
15722       if (ipcg6_b_o_a   > 0) kappa_nonelectro(ipcg6_b_o_a  ) = hygro_pcg6_b_o_aer
15723       if (ipcg7_b_o_a   > 0) kappa_nonelectro(ipcg7_b_o_a  ) = hygro_pcg7_b_o_aer
15724       if (ipcg8_b_o_a   > 0) kappa_nonelectro(ipcg8_b_o_a  ) = hygro_pcg8_b_o_aer
15725       if (ipcg9_b_o_a   > 0) kappa_nonelectro(ipcg9_b_o_a  ) = hygro_pcg9_b_o_aer
15726       if (iopcg1_b_c_a  > 0) kappa_nonelectro(iopcg1_b_c_a ) = hygro_opcg1_b_c_aer
15727       if (iopcg2_b_c_a  > 0) kappa_nonelectro(iopcg2_b_c_a ) = hygro_opcg2_b_c_aer
15728       if (iopcg3_b_c_a  > 0) kappa_nonelectro(iopcg3_b_c_a ) = hygro_opcg3_b_c_aer
15729       if (iopcg4_b_c_a  > 0) kappa_nonelectro(iopcg4_b_c_a ) = hygro_opcg4_b_c_aer
15730       if (iopcg5_b_c_a  > 0) kappa_nonelectro(iopcg5_b_c_a ) = hygro_opcg5_b_c_aer
15731       if (iopcg6_b_c_a  > 0) kappa_nonelectro(iopcg6_b_c_a ) = hygro_opcg6_b_c_aer
15732       if (iopcg7_b_c_a  > 0) kappa_nonelectro(iopcg7_b_c_a ) = hygro_opcg7_b_c_aer
15733       if (iopcg8_b_c_a  > 0) kappa_nonelectro(iopcg8_b_c_a ) = hygro_opcg8_b_c_aer
15734       if (iopcg1_b_o_a  > 0) kappa_nonelectro(iopcg1_b_o_a ) = hygro_opcg1_b_o_aer
15735       if (iopcg2_b_o_a  > 0) kappa_nonelectro(iopcg2_b_o_a ) = hygro_opcg2_b_o_aer
15736       if (iopcg3_b_o_a  > 0) kappa_nonelectro(iopcg3_b_o_a ) = hygro_opcg3_b_o_aer
15737       if (iopcg4_b_o_a  > 0) kappa_nonelectro(iopcg4_b_o_a ) = hygro_opcg4_b_o_aer
15738       if (iopcg5_b_o_a  > 0) kappa_nonelectro(iopcg5_b_o_a ) = hygro_opcg5_b_o_aer
15739       if (iopcg6_b_o_a  > 0) kappa_nonelectro(iopcg6_b_o_a ) = hygro_opcg6_b_o_aer
15740       if (iopcg7_b_o_a  > 0) kappa_nonelectro(iopcg7_b_o_a ) = hygro_opcg7_b_o_aer
15741       if (iopcg8_b_o_a  > 0) kappa_nonelectro(iopcg8_b_o_a ) = hygro_opcg8_b_o_aer
15742       if (ipcg1_f_c_a   > 0) kappa_nonelectro(ipcg1_f_c_a  ) = hygro_pcg1_f_c_aer
15743       if (ipcg2_f_c_a   > 0) kappa_nonelectro(ipcg2_f_c_a  ) = hygro_pcg2_f_c_aer
15744       if (ipcg3_f_c_a   > 0) kappa_nonelectro(ipcg3_f_c_a  ) = hygro_pcg3_f_c_aer
15745       if (ipcg4_f_c_a   > 0) kappa_nonelectro(ipcg4_f_c_a  ) = hygro_pcg4_f_c_aer
15746       if (ipcg5_f_c_a   > 0) kappa_nonelectro(ipcg5_f_c_a  ) = hygro_pcg5_f_c_aer
15747       if (ipcg6_f_c_a   > 0) kappa_nonelectro(ipcg6_f_c_a  ) = hygro_pcg6_f_c_aer
15748       if (ipcg7_f_c_a   > 0) kappa_nonelectro(ipcg7_f_c_a  ) = hygro_pcg7_f_c_aer
15749       if (ipcg8_f_c_a   > 0) kappa_nonelectro(ipcg8_f_c_a  ) = hygro_pcg8_f_c_aer
15750       if (ipcg9_f_c_a   > 0) kappa_nonelectro(ipcg9_f_c_a  ) = hygro_pcg9_f_c_aer
15751       if (ipcg1_f_o_a   > 0) kappa_nonelectro(ipcg1_f_o_a  ) = hygro_pcg1_f_o_aer
15752       if (ipcg2_f_o_a   > 0) kappa_nonelectro(ipcg2_f_o_a  ) = hygro_pcg2_f_o_aer
15753       if (ipcg3_f_o_a   > 0) kappa_nonelectro(ipcg3_f_o_a  ) = hygro_pcg3_f_o_aer
15754       if (ipcg4_f_o_a   > 0) kappa_nonelectro(ipcg4_f_o_a  ) = hygro_pcg4_f_o_aer
15755       if (ipcg5_f_o_a   > 0) kappa_nonelectro(ipcg5_f_o_a  ) = hygro_pcg5_f_o_aer
15756       if (ipcg6_f_o_a   > 0) kappa_nonelectro(ipcg6_f_o_a  ) = hygro_pcg6_f_o_aer
15757       if (ipcg7_f_o_a   > 0) kappa_nonelectro(ipcg7_f_o_a  ) = hygro_pcg7_f_o_aer
15758       if (ipcg8_f_o_a   > 0) kappa_nonelectro(ipcg8_f_o_a  ) = hygro_pcg8_f_o_aer
15759       if (ipcg9_f_o_a   > 0) kappa_nonelectro(ipcg9_f_o_a  ) = hygro_pcg9_f_o_aer
15760       if (iopcg1_f_c_a  > 0) kappa_nonelectro(iopcg1_f_c_a ) = hygro_opcg1_f_c_aer
15761       if (iopcg2_f_c_a  > 0) kappa_nonelectro(iopcg2_f_c_a ) = hygro_opcg2_f_c_aer
15762       if (iopcg3_f_c_a  > 0) kappa_nonelectro(iopcg3_f_c_a ) = hygro_opcg3_f_c_aer
15763       if (iopcg4_f_c_a  > 0) kappa_nonelectro(iopcg4_f_c_a ) = hygro_opcg4_f_c_aer
15764       if (iopcg5_f_c_a  > 0) kappa_nonelectro(iopcg5_f_c_a ) = hygro_opcg5_f_c_aer
15765       if (iopcg6_f_c_a  > 0) kappa_nonelectro(iopcg6_f_c_a ) = hygro_opcg6_f_c_aer
15766       if (iopcg7_f_c_a  > 0) kappa_nonelectro(iopcg7_f_c_a ) = hygro_opcg7_f_c_aer
15767       if (iopcg8_f_c_a  > 0) kappa_nonelectro(iopcg8_f_c_a ) = hygro_opcg8_f_c_aer
15768       if (iopcg1_f_o_a  > 0) kappa_nonelectro(iopcg1_f_o_a ) = hygro_opcg1_f_o_aer
15769       if (iopcg2_f_o_a  > 0) kappa_nonelectro(iopcg2_f_o_a ) = hygro_opcg2_f_o_aer
15770       if (iopcg3_f_o_a  > 0) kappa_nonelectro(iopcg3_f_o_a ) = hygro_opcg3_f_o_aer
15771       if (iopcg4_f_o_a  > 0) kappa_nonelectro(iopcg4_f_o_a ) = hygro_opcg4_f_o_aer
15772       if (iopcg5_f_o_a  > 0) kappa_nonelectro(iopcg5_f_o_a ) = hygro_opcg5_f_o_aer
15773       if (iopcg6_f_o_a  > 0) kappa_nonelectro(iopcg6_f_o_a ) = hygro_opcg6_f_o_aer
15774       if (iopcg7_f_o_a  > 0) kappa_nonelectro(iopcg7_f_o_a ) = hygro_opcg7_f_o_aer
15775       if (iopcg8_f_o_a  > 0) kappa_nonelectro(iopcg8_f_o_a ) = hygro_opcg8_f_o_aer
15776
15777       if (iant1_c_a     > 0) kappa_nonelectro(iant1_c_a    ) = hygro_ant1_c_aer
15778       if (iant2_c_a     > 0) kappa_nonelectro(iant2_c_a    ) = hygro_ant2_c_aer
15779       if (iant3_c_a     > 0) kappa_nonelectro(iant3_c_a    ) = hygro_ant3_c_aer
15780       if (iant4_c_a     > 0) kappa_nonelectro(iant4_c_a    ) = hygro_ant4_c_aer
15781       if (iant1_o_a     > 0) kappa_nonelectro(iant1_o_a    ) = hygro_ant1_o_aer
15782       if (iant2_o_a     > 0) kappa_nonelectro(iant2_o_a    ) = hygro_ant2_o_aer
15783       if (iant3_o_a     > 0) kappa_nonelectro(iant3_o_a    ) = hygro_ant3_o_aer
15784       if (iant4_o_a     > 0) kappa_nonelectro(iant4_o_a    ) = hygro_ant4_o_aer
15785       if (ibiog1_c_a    > 0) kappa_nonelectro(ibiog1_c_a   ) = hygro_biog1_c_aer
15786       if (ibiog2_c_a    > 0) kappa_nonelectro(ibiog2_c_a   ) = hygro_biog2_c_aer
15787       if (ibiog3_c_a    > 0) kappa_nonelectro(ibiog3_c_a   ) = hygro_biog3_c_aer
15788       if (ibiog4_c_a    > 0) kappa_nonelectro(ibiog4_c_a   ) = hygro_biog4_c_aer
15789       if (ibiog1_o_a    > 0) kappa_nonelectro(ibiog1_o_a   ) = hygro_biog1_o_aer
15790       if (ibiog2_o_a    > 0) kappa_nonelectro(ibiog2_o_a   ) = hygro_biog2_o_aer
15791       if (ibiog3_o_a    > 0) kappa_nonelectro(ibiog3_o_a   ) = hygro_biog3_o_aer
15792       if (ibiog4_o_a    > 0) kappa_nonelectro(ibiog4_o_a   ) = hygro_biog4_o_aer
15793
15794       if (ismpa_a       > 0) kappa_nonelectro(ismpa_a      ) = hygro_smpa_aer
15795       if (ismpbb_a      > 0) kappa_nonelectro(ismpbb_a     ) = hygro_smpbb_aer
15796       if (iglysoa_r1_a  > 0) kappa_nonelectro(iglysoa_r1_a ) = hygro_glysoa_r1_aer
15797       if (iglysoa_r2_a  > 0) kappa_nonelectro(iglysoa_r2_a ) = hygro_glysoa_r2_aer
15798       if (iglysoa_oh_a  > 0) kappa_nonelectro(iglysoa_oh_a ) = hygro_glysoa_oh_aer
15799       if (iglysoa_nh4_a > 0) kappa_nonelectro(iglysoa_nh4_a) = hygro_glysoa_nh4_aer
15800       if (iglysoa_sfc_a > 0) kappa_nonelectro(iglysoa_sfc_a) = hygro_glysoa_sfc_aer
15801       if (iasoaX_a      > 0) kappa_nonelectro(iasoaX_a     ) = hygro_asoaX_aer
15802       if (iasoa1_a      > 0) kappa_nonelectro(iasoa1_a     ) = hygro_asoa1_aer
15803       if (iasoa2_a      > 0) kappa_nonelectro(iasoa2_a     ) = hygro_asoa2_aer
15804       if (iasoa3_a      > 0) kappa_nonelectro(iasoa3_a     ) = hygro_asoa3_aer
15805       if (iasoa4_a      > 0) kappa_nonelectro(iasoa4_a     ) = hygro_asoa4_aer
15806       if (ibsoaX_a      > 0) kappa_nonelectro(ibsoaX_a     ) = hygro_bsoaX_aer
15807       if (ibsoa1_a      > 0) kappa_nonelectro(ibsoa1_a     ) = hygro_bsoa1_aer
15808       if (ibsoa2_a      > 0) kappa_nonelectro(ibsoa2_a     ) = hygro_bsoa2_aer
15809       if (ibsoa3_a      > 0) kappa_nonelectro(ibsoa3_a     ) = hygro_bsoa3_aer
15810       if (ibsoa4_a      > 0) kappa_nonelectro(ibsoa4_a     ) = hygro_bsoa4_aer
15811
15812       return
15813       end subroutine load_kappa_nonelectro
15814
15815
15816
15817
15818 !***********************************************************************
15819 ! updates all temperature dependent thermodynamic parameters
15820 !
15821 ! author: rahul a. zaveri
15822 ! update: jan 2005
15823 !-----------------------------------------------------------------------
15824       subroutine update_thermodynamic_constants(vbs_nbin)
15825 !     implicit none
15826 !     include 'mosaic.h'
15827 ! local variables
15828       integer iv, j_index, ibin, je,vbs_nbin(1)
15829       integer start_ind
15830       real(kind=8) :: tr, rt, term
15831       real(kind=8) :: gam_nh4no3_0, gam_nh4cl_0, m_nh4no3_0, m_nh4cl_0  ! raz update 6/25/2008
15832 ! function
15833 !     real(kind=8) :: fn_keq, fn_po, drh_mutual, bin_molality, molality_0
15834
15835
15836       tr = 298.15                       ! reference temperature
15837       rt = 82.056*t_k/(1.e9*1.e6)       ! [m^3 atm/nmol]
15838
15839 ! gas-liquid
15840       keq_gl(1)= 1.0                                     ! kelvin effect (default)
15841       keq_gl(2)= fn_keq(57.64d0 , 13.79d0, -5.39d0,t_k)*rt     ! nh3(g)  <=> nh3(l)
15842       keq_gl(3)= fn_keq(2.63d6, 29.17d0, 16.83d0,t_k)*rt     ! hno3(g) <=> no3- + h+
15843       keq_gl(4)= fn_keq(2.00d6, 30.20d0, 19.91d0,t_k)*rt     ! hcl(g)  <=> cl- + h+
15844
15845 ! liquid-liquid
15846       keq_ll(1)= fn_keq(1.0502d-2, 8.85d0, 25.14d0,t_k)      ! hso4- <=> so4= + h+
15847       keq_ll(2)= fn_keq(1.805d-5, -1.50d0, 26.92d0,t_k)      ! nh3(l) + h2o = nh4+ + oh-
15848       keq_ll(3)= fn_keq(1.01d-14,-22.52d0, 26.92d0,t_k)      ! h2o(l) <=> h+ + oh-
15849
15850
15851       kp_nh3   = keq_ll(3)/(keq_ll(2)*keq_gl(2))
15852       kp_nh4no3= kp_nh3/keq_gl(3)
15853       kp_nh4cl = kp_nh3/keq_gl(4)
15854
15855
15856 ! solid-gas
15857       keq_sg(1)= fn_keq(4.72d-17,-74.38d0,6.12d0,t_k)/rt**2  ! nh4no3<=>nh3(g)+hno3(g)
15858       keq_sg(2)= fn_keq(8.43d-17,-71.00d0,2.40d0,t_k)/rt**2  ! nh4cl <=>nh3(g)+hcl(g)
15859
15860
15861 ! solid-liquid
15862       keq_sl(jnh4so4) = fn_keq(1.040d0,-2.65d0, 38.57d0, t_k)  ! amso4(s) = 2nh4+ + so4=
15863       keq_sl(jlvcite) = fn_keq(11.8d0, -5.19d0, 54.40d0, t_k)  ! lvcite(s)= 3nh4+ + hso4- + so4=
15864       keq_sl(jnh4hso4)= fn_keq(117.0d0,-2.87d0, 15.83d0, t_k)  ! amhso4(s)= nh4+ + hso4-
15865       keq_sl(jnh4msa) = 1.e15                            ! NH4MSA(s)= NH4+ + MSA-
15866       keq_sl(jnh4no3) = fn_keq(12.21d0,-10.4d0, 17.56d0, t_k)  ! nh4no3(s)= nh4+ + no3-
15867       keq_sl(jnh4cl)  = fn_keq(17.37d0,-6.03d0, 16.92d0, t_k)  ! nh4cl(s) = nh4+ + cl-
15868       keq_sl(jna2so4) = fn_keq(0.491d0, 0.98d0, 39.75d0, t_k)  ! na2so4(s)= 2na+ + so4=
15869       keq_sl(jnahso4) = fn_keq(313.0d0, 0.8d0,  14.79d0, t_k)  ! nahso4(s)= na+ + hso4-
15870       keq_sl(jna3hso4)= 1.e15                            ! na3h(so4)2(s) = 2na+ + hso4- + so4=
15871       keq_sl(jnamsa)  = 1.e15                            ! NaMSA(s) = Na+ + MSA-
15872       keq_sl(jnano3)  = fn_keq(11.95d0,-8.22d0, 16.01d0, t_k)  ! nano3(s) = na+ + no3-
15873       keq_sl(jnacl)   = fn_keq(38.28d0,-1.52d0, 16.89d0, t_k)  ! nacl(s)  = na+ + cl-
15874       keq_sl(jcacl2)  = fn_keq(8.0d11,32.84d0,44.79d0, t_k)*1.e5  ! cacl2(s) = ca++ + 2cl-
15875       keq_sl(jcano3)  = fn_keq(4.31d5, 7.83d0,42.01d0, t_k)*1.e5  ! ca(no3)2(s) = ca++ + 2no3-
15876       keq_sl(jcamsa2) = 1.e15                            ! CaMSA2(s)= Ca+ + 2MSA-
15877
15878       start_ind = 1
15879       if (vbs_nbin(1).eq.0) then
15880         start_ind = ismpa_g
15881       else if (vbs_nbin(1) .eq. 4) then
15882         start_ind = iasoaX_g
15883       else
15884         start_ind = ipcg1_b_c_g
15885       endif
15886
15887       do iv = start_ind, ngas_ioa + ngas_soa
15888         sat_soa(iv) = 0.0       ! [nmol/m^3(air)]
15889       enddo
15890
15891        if (vbs_nbin(1).eq.9) then
15892 ! vapor pressures of soa species
15893       po_soa(ipcg1_b_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15894       po_soa(ipcg2_b_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15895       po_soa(ipcg3_b_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15896       po_soa(ipcg4_b_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15897       po_soa(ipcg5_b_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15898       po_soa(ipcg6_b_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15899       po_soa(ipcg7_b_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15900       po_soa(ipcg8_b_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15901       po_soa(ipcg9_b_c_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15902       po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15903       po_soa(iopcg2_b_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15904       po_soa(iopcg3_b_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15905       po_soa(iopcg4_b_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15906       po_soa(iopcg5_b_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15907       po_soa(iopcg6_b_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15908       po_soa(iopcg7_b_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15909       po_soa(iopcg8_b_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15910       po_soa(ipcg1_b_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15911       po_soa(ipcg2_b_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15912       po_soa(ipcg3_b_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15913       po_soa(ipcg4_b_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15914       po_soa(ipcg5_b_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15915       po_soa(ipcg6_b_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15916       po_soa(ipcg7_b_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15917       po_soa(ipcg8_b_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15918       po_soa(ipcg9_b_o_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15919       po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15920       po_soa(iopcg2_b_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15921       po_soa(iopcg3_b_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15922       po_soa(iopcg4_b_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15923       po_soa(iopcg5_b_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15924       po_soa(iopcg6_b_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15925       po_soa(iopcg7_b_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15926       po_soa(iopcg8_b_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15927       po_soa(ipcg1_f_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15928       po_soa(ipcg2_f_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15929       po_soa(ipcg3_f_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15930       po_soa(ipcg4_f_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15931       po_soa(ipcg5_f_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15932       po_soa(ipcg6_f_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15933       po_soa(ipcg7_f_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15934       po_soa(ipcg8_f_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15935       po_soa(ipcg9_f_c_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15936       po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15937       po_soa(iopcg2_f_c_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15938       po_soa(iopcg3_f_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15939       po_soa(iopcg4_f_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15940       po_soa(iopcg5_f_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15941       po_soa(iopcg6_f_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15942       po_soa(iopcg7_f_c_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15943       po_soa(iopcg8_f_c_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15944       po_soa(ipcg1_f_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15945       po_soa(ipcg2_f_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15946       po_soa(ipcg3_f_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15947       po_soa(ipcg4_f_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15948       po_soa(ipcg5_f_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15949       po_soa(ipcg6_f_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15950       po_soa(ipcg7_f_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15951       po_soa(ipcg8_f_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15952       po_soa(ipcg9_f_o_g) = fn_po(9.91d0, 64.0d0, T_K) ! [Pascal]
15953       po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 112.0d0, T_K) ! [Pascal]
15954       po_soa(iopcg2_f_o_g) = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
15955       po_soa(iopcg3_f_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15956       po_soa(iopcg4_f_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15957       po_soa(iopcg5_f_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15958       po_soa(iopcg6_f_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15959       po_soa(iopcg7_f_o_g) = fn_po(9.91d-2, 76.0d0, T_K) ! [Pascal]
15960       po_soa(iopcg8_f_o_g) = fn_po(9.91d-1, 70.0d0, T_K) ! [Pascal]
15961
15962       po_soa(iant1_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15963       po_soa(iant2_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15964       po_soa(iant3_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15965       po_soa(iant4_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15966       po_soa(iant1_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15967       po_soa(iant2_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15968       po_soa(iant3_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15969       po_soa(iant4_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15970       po_soa(ibiog1_c_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15971       po_soa(ibiog2_c_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15972       po_soa(ibiog3_c_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15973       po_soa(ibiog4_c_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15974       po_soa(ibiog1_o_g) = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
15975       po_soa(ibiog2_o_g) = fn_po(9.91d-5, 94.0d0, T_K) ! [Pascal]
15976       po_soa(ibiog3_o_g) = fn_po(9.91d-4, 88.0d0, T_K) ! [Pascal]
15977       po_soa(ibiog4_o_g) = fn_po(9.91d-3, 82.0d0, T_K) ! [Pascal]
15978       endif
15979
15980       if (vbs_nbin(1).eq.4) then
15981         po_soa(iasoaX_g) = fn_po(9.91d-10, 40.0d0, T_K) ! [Pascal]
15982         po_soa(iasoa1_g) = fn_po(9.91d-6, dhr_approx(0.0d0), T_K) ! [Pascal]
15983         po_soa(iasoa2_g) = fn_po(9.91d-5, dhr_approx(1.0d0), T_K) ! [Pascal]
15984         po_soa(iasoa3_g) = fn_po(9.91d-4, dhr_approx(2.0d0), T_K) ! [Pascal]
15985         po_soa(iasoa4_g) = fn_po(9.91d-3, dhr_approx(3.0d0), T_K) ! [Pascal]
15986         po_soa(ibsoaX_g) = fn_po(9.91d-10, 40.0d0, T_K) ! [Pascal]
15987         po_soa(ibsoa1_g) = fn_po(9.91d-6, dhr_approx(0.0d0), T_K) ! [Pascal]
15988         po_soa(ibsoa2_g) = fn_po(9.91d-5, dhr_approx(1.0d0), T_K) ! [Pascal]
15989         po_soa(ibsoa3_g) = fn_po(9.91d-4, dhr_approx(2.0d0), T_K) ! [Pascal]
15990         po_soa(ibsoa4_g) = fn_po(9.91d-3, dhr_approx(3.0d0), T_K) ! [Pascal]
15991       endif
15992
15993       if (vbs_nbin(1).eq.3) then
15994 ! these values for pcg and opcg gases are the same as vbs_nbin(1)==2
15995 ! below
15996         po_soa(ipcg1_b_c_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
15997         po_soa(ipcg2_b_c_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
15998         po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
15999         po_soa(ipcg1_b_o_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16000         po_soa(ipcg2_b_o_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16001         po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16002         po_soa(ipcg1_f_c_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16003         po_soa(ipcg2_f_c_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16004         po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16005         po_soa(ipcg1_f_o_g)  = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16006         po_soa(ipcg2_f_o_g)  = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16007         po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16008 ! these values for ant and bio gases are from manish wrfchem 3.5
16009         po_soa(iant1_c_g)    = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16010         po_soa(iant2_c_g)    = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16011         po_soa(iant3_c_g)    = fn_po(9.91d-5,  94.0d0, T_K) ! [Pascal]
16012         po_soa(iant4_c_g)    = fn_po(9.91d-4,  88.0d0, T_K) ! [Pascal]
16013         po_soa(ibiog1_c_g)   = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16014         po_soa(ibiog2_c_g)   = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16015         po_soa(ibiog3_c_g)   = fn_po(9.91d-5,  94.0d0, T_K) ! [Pascal]
16016         po_soa(ibiog1_o_g)   = fn_po(9.91d-7, 106.0d0, T_K) ! [Pascal]
16017         po_soa(ibiog2_o_g)   = fn_po(9.91d-6, 100.0d0, T_K) ! [Pascal]
16018       endif
16019
16020       if (vbs_nbin(1).eq.2) then
16021       po_soa(ipcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16022       po_soa(ipcg2_b_c_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16023       po_soa(iopcg1_b_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16024       po_soa(ipcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16025       po_soa(ipcg2_b_o_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16026       po_soa(iopcg1_b_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16027       po_soa(ipcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16028       po_soa(ipcg2_f_c_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16029       po_soa(iopcg1_f_c_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16030       po_soa(ipcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16031       po_soa(ipcg2_f_o_g) = fn_po(9.91d-1, 83.0d0, T_K) ! [Pascal]
16032       po_soa(iopcg1_f_o_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16033       po_soa(iant1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16034       po_soa(iant1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16035       po_soa(ibiog1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16036       po_soa(ibiog1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16037       endif
16038       if (vbs_nbin(1).eq.0) then
16039         po_soa(ismpa_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16040         po_soa(ismpbb_g) = fn_po(9.91d-8, 83.0d0, T_K) ! [Pascal]
16041         po_soa(ibiog1_c_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16042         po_soa(ibiog1_o_g) = fn_po(9.91d-6, 83.0d0, T_K) ! [Pascal]
16043       endif
16044
16045       start_ind = 1
16046       if (vbs_nbin(1).eq.0) then
16047         start_ind = ismpa_g
16048       else if (vbs_nbin(1).eq.4) then
16049         start_ind = iasoaX_g
16050       else
16051         start_ind = ipcg1_b_c_g
16052       end if
16053
16054       do iv = start_ind, ngas_ioa + ngas_soa
16055         sat_soa(iv) = 1.e9*po_soa(iv)/(8.314*t_k)       ! [nmol/m^3(air)]
16056       enddo
16057
16058 ! water surface tension
16059       term = (647.15 - t_k)/647.15
16060       sigma_water = 0.2358*term**1.256 * (1. - 0.625*term) ! surface tension of pure water in n/m
16061
16062 ! mdrh(t)
16063       do j_index = 1, 63
16064         mdrh_t(j_index) = drh_mutual(j_index)
16065       enddo
16066
16067
16068
16069 ! rh dependent parameters
16070       do ibin = 1, nbin_a
16071         ah2o_a(ibin) = ah2o                     ! initialize
16072       enddo
16073
16074       call mtem_compute_log_gamz                ! function of ah2o and t
16075
16076 ! raz update 6/25/2008 - start
16077       gam_nh4no3_0 = 10.**log_gamZ(jnh4no3,jnh4no3)
16078       gam_nh4cl_0  = 10.**log_gamZ(jnh4cl,jnh4cl)
16079
16080       m_nh4no3_0   = molality_0(jnh4no3)
16081       m_nh4cl_0    = molality_0(jnh4cl)
16082
16083       Kp_nh4no3_0  = Kp_nh4no3*(m_nh4no3_0*gam_nh4no3_0)**2
16084       Kp_nh4cl_0   = Kp_nh4cl *(m_nh4cl_0 *gam_nh4cl_0 )**2
16085 ! raz update 6/25/2008 - end
16086
16087
16088
16089       return
16090       end subroutine update_thermodynamic_constants
16091
16092       ! Function to approximate enthalpy of vaporization for
16093       ! semi-volatile organic aerosols as a function of volatility
16094       ! from Epstein et al., ES&T, 2010
16095       ! http://pubs.acs.org/doi/abs/10.1021/es902497z
16096       real(kind=8) function dhr_approx(log10_Csat_298)
16097
16098         real(kind=8), intent(in) :: log10_Csat_298
16099
16100         dhr_approx = -11.0 * log10_Csat_298 + 131.0 ! kJ/mol
16101
16102       end function dhr_approx
16103
16104
16105
16106 !***********************************************************************
16107 ! functions used in mosaic
16108 !
16109 ! author: rahul a. zaveri
16110 ! update: jan 2005
16111 !-----------------------------------------------------------------------
16112
16113
16114
16115 !----------------------------------------------------------
16116       real(kind=8) function fn_keq(keq_298, a, b, t)
16117 !     implicit none
16118 ! subr. arguments
16119       real(kind=8) keq_298, a, b, t
16120 ! local variables
16121       real(kind=8) tt
16122
16123
16124         tt = 298.15/t
16125         fn_keq = keq_298*exp(a*(tt-1.)+b*(1.+log(tt)-tt))
16126
16127       return
16128       end function fn_keq
16129 !----------------------------------------------------------
16130
16131
16132
16133
16134
16135 !----------------------------------------------------------
16136       real(kind=8) function fn_po(po_298, dh, t)        ! touch
16137 !     implicit none
16138 ! subr. arguments
16139       real(kind=8) po_298, dh, t
16140 ! local variables
16141
16142         fn_po = po_298*exp(-(dh/8.314e-3)*(1./t - 3.354016435e-3))
16143
16144       return
16145       end function fn_po
16146 !----------------------------------------------------------
16147
16148
16149
16150
16151
16152 !----------------------------------------------------------
16153       real(kind=8) function drh_mutual(j_index)
16154 !     implicit none
16155 !     include 'mosaic.h'
16156 ! subr. arguments
16157       integer j_index
16158 ! local variables
16159       integer j
16160
16161
16162       j = j_index
16163
16164       if(j_index .eq. 7 .or. j_index .eq. 8 .or.   &
16165         (j_index.ge. 34 .and. j_index .le. 51))then
16166
16167         drh_mutual = 10.0  ! cano3 or cacl2 containing mixtures
16168
16169       else
16170
16171         drh_mutual =  d_mdrh(j,1) + t_k*   &
16172                      (d_mdrh(j,2) + t_k*   &
16173                      (d_mdrh(j,3) + t_k*   &
16174                       d_mdrh(j,4) )) + 1.0
16175
16176       endif
16177
16178
16179       return
16180       end function drh_mutual
16181 !----------------------------------------------------------
16182
16183
16184
16185
16186
16187
16188 !----------------------------------------------------------
16189 ! zsr method at 60% rh
16190 !
16191       real(kind=8) function aerosol_water_up(ibin) ! kg (water)/m^3 (air)
16192 !     implicit none
16193 !     include 'mosaic.h'
16194 ! subr. arguments
16195       integer ibin
16196 ! local variables
16197       integer jp, je
16198       real(kind=8) dum
16199 ! function
16200 !     real(kind=8) bin_molality_60
16201
16202
16203       jp = jtotal
16204       dum = 0.0
16205
16206       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
16207         dum = dum + 1.e-9*electrolyte(je,jp,ibin)/bin_molality_60(je)
16208       enddo
16209
16210       aerosol_water_up = dum
16211
16212       return
16213       end function aerosol_water_up
16214 !----------------------------------------------------------
16215
16216
16217
16218
16219
16220
16221 !----------------------------------------------------------
16222 ! zsr method
16223 !
16224 ! RAZ 5/21/2014: Included organics, oin, and bc in water absorption (but does not include organic-inorganic interactions)
16225 !
16226       real(kind=8) function aerosol_water(jp,ibin) ! kg (water)/m^3 (air)
16227 !     implicit none
16228 !     include 'mosaic.h'
16229 ! subr. arguments
16230       integer jp, ibin
16231 ! local variables
16232       integer ja, je
16233       real(kind=8) dum, tmpa
16234 ! function
16235 !     real(kind=8) bin_molality
16236
16237
16238       dum = 0.0
16239       do je = 1, (nsalt+4)      ! include hno3 and hcl in water calculation
16240         dum = dum + electrolyte(je,jp,ibin)/bin_molality(je,ibin)
16241       enddo
16242
16243       if (mwater_kappa_nonelectro > 0) then
16244          tmpa = 0.0
16245          do ja = 1, naer
16246             if (kappa_nonelectro(ja) > 0.0) then
16247                tmpa = tmpa + (aer(ja,jtotal,ibin)*mw_aer_mac(ja)/dens_aer_mac(ja))*kappa_nonelectro(ja)
16248             end if
16249          end do
16250          dum = dum + 1.0e-3*tmpa*aH2O_a(ibin)/(1.0-aH2O_a(ibin))
16251       end if
16252
16253       aerosol_water = dum*1.e-9  ! kg(water)/m^3(air)
16254
16255       if(aerosol_water .le. 0.0)then
16256         if (iprint_mosaic_diag1 .gt. 0) then
16257           write(6,*)'mosaic aerosol_water - water .le. 0'
16258           write(6,*)'iclm  jclm  ibin  jp = ',   &
16259                      iclm_aer, jclm_aer, ibin, jp
16260           write(6,*)'ah2o, water = ', ah2o, aerosol_water
16261           write(6,*)'dry mass = ', mass_dry_a(ibin)
16262           write(6,*)'soluble mass = ', mass_soluble_a(ibin)
16263           write(6,*)'number = ', num_a(ibin)
16264           do je = 1, nsoluble
16265             write(6,44)ename(je), electrolyte(je,jp,ibin)
16266           enddo
16267           write(6,*)'error in water calculation'
16268           write(6,*)'ibin = ', ibin
16269           write(6,*)'water content cannot be negative or zero'
16270           write(6,*)'setting jaerosolstate to all_solid'
16271         endif
16272
16273         call print_input
16274
16275         jaerosolstate(ibin) = all_solid
16276         jphase(ibin)    = jsolid
16277         jhyst_leg(ibin) = jhyst_lo
16278
16279 !c        write(6,*)'stopping execution in function aerosol_water'
16280 !c        stop
16281       endif
16282
16283 44    format(a7, 2x, e11.3)
16284
16285
16286       return
16287       end function aerosol_water
16288 !----------------------------------------------------------
16289
16290
16291
16292
16293
16294 !----------------------------------------------------------
16295       real(kind=8) function bin_molality(je,ibin)
16296 !     implicit none
16297 !     include 'mosaic.h'
16298 ! subr. arguments
16299       integer je, ibin
16300 ! local variables
16301       real(kind=8) aw, xm
16302
16303
16304       aw = max(ah2o_a(ibin), aw_min(je))
16305       aw = min(aw, 0.999999D0)
16306
16307
16308       if(aw .lt. 0.97)then
16309
16310         xm =     a_zsr(1,je) +   &
16311              aw*(a_zsr(2,je) +   &
16312              aw*(a_zsr(3,je) +   &
16313              aw*(a_zsr(4,je) +   &
16314              aw*(a_zsr(5,je) +   &
16315              aw* a_zsr(6,je) ))))
16316
16317         bin_molality = 55.509*xm/(1. - xm)
16318
16319       else
16320
16321         bin_molality = -b_zsr(je)*log(aw)
16322
16323       endif
16324
16325
16326       return
16327       end function bin_molality
16328 !----------------------------------------------------------
16329
16330
16331
16332
16333
16334 !----------------------------------------------------------
16335       real(kind=8) function bin_molality_60(je)
16336 !     implicit none
16337 !     include 'mosaic.h'
16338 ! subr. arguments
16339       integer je
16340 ! local variables
16341       real(kind=8) aw, xm
16342
16343
16344       aw = 0.6
16345
16346         xm =  a_zsr(1,je) + aw*   &
16347              (a_zsr(2,je) + aw*   &
16348              (a_zsr(3,je) + aw*   &
16349              (a_zsr(4,je) + aw*   &
16350              (a_zsr(5,je) + aw*   &
16351               a_zsr(6,je) ))))
16352
16353       bin_molality_60 = 55.509*xm/(1. - xm)
16354
16355       return
16356       end function bin_molality_60
16357 !----------------------------------------------------------
16358
16359
16360 !----------------------------------------------------------
16361 ! raz update 6/25/2008 - start
16362       real(kind=8) function molality_0(je)
16363 !      implicit none
16364 ! subr. arguments
16365       integer je
16366 ! local variables
16367       real(kind=8) :: aw, xm
16368
16369
16370       aw = max(ah2o, aw_min(je))
16371       aw = min(aw, 0.999999d0)
16372
16373
16374       if(aw .lt. 0.97)then
16375
16376         xm =     a_zsr(1,je) +   &
16377              aw*(a_zsr(2,je) +   &
16378              aw*(a_zsr(3,je) +   &
16379              aw*(a_zsr(4,je) +   &
16380              aw*(a_zsr(5,je) +   &
16381              aw* a_zsr(6,je) ))))
16382
16383         molality_0 = 55.509*xm/(1. - xm)
16384
16385       else
16386
16387         molality_0 = -b_zsr(je)*log(aw)
16388
16389       endif
16390
16391
16392       return
16393       end function molality_0
16394 ! raz update 6/25/2008 - end
16395 !----------------------------------------------------------
16396
16397
16398 !----------------------------------------------------------
16399       real(kind=8) function fnlog_gamz(ja,je)   ! ja in je
16400 !     implicit none
16401 !     include 'mosaic.h'
16402 ! subr. arguments
16403       integer ja, je
16404 ! local variables
16405       real(kind=8) aw
16406
16407
16408       aw = max(ah2o, aw_min(je))
16409
16410       fnlog_gamz = b_mtem(1,ja,je) + aw*   &
16411                   (b_mtem(2,ja,je) + aw*   &
16412                   (b_mtem(3,ja,je) + aw*   &
16413                   (b_mtem(4,ja,je) + aw*   &
16414                   (b_mtem(5,ja,je) + aw*   &
16415                    b_mtem(6,ja,je) ))))
16416
16417       return
16418       end function fnlog_gamz
16419 !----------------------------------------------------------
16420
16421
16422
16423
16424 !----------------------------------------------------------
16425       real(kind=8) function mean_molecular_speed(t, mw) ! in cm/s
16426 !     implicit none
16427 ! subr. arguments
16428       real(kind=8) t, mw        ! t(k)
16429
16430         mean_molecular_speed = 1.455e4 * sqrt(t/mw)
16431
16432       return
16433       end function mean_molecular_speed
16434 !----------------------------------------------------------
16435
16436
16437
16438
16439 !----------------------------------------------------------
16440       real(kind=8) function gas_diffusivity(t, p, mw, vm)       ! in cm^2/s
16441 !     implicit none
16442 ! subr. arguments
16443       real(kind=8) mw, vm, t, p ! t(k), p(atm)
16444
16445
16446       gas_diffusivity = (1.0e-3 * t**1.75 * sqrt(1./mw + 0.035))/   &
16447                              (p * (vm**0.333333 + 2.7189)**2)
16448
16449
16450       return
16451       end function gas_diffusivity
16452 !----------------------------------------------------------
16453
16454
16455
16456
16457 !----------------------------------------------------------
16458       real(kind=8) function fuchs_sutugin(rkn,a)
16459 !     implicit none
16460 ! subr. arguments
16461       real(kind=8) rkn, a
16462 ! local variables
16463       real(kind=8) rnum, denom
16464
16465
16466       rnum  = 0.75*a*(1. + rkn)
16467       denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
16468       fuchs_sutugin = rnum/denom
16469
16470       return
16471       end function fuchs_sutugin
16472 !----------------------------------------------------------
16473
16474
16475
16476 !----------------------------------------------------------
16477     real(kind=8) function acc_n2o5_bert_thorn(mass_h2o,mol_no3,mol_cl,vol)
16478         ! Composition dependent mass accommodation coefficient.
16479         ! After Bertram and Thornton, ACP, 2009
16480         !
16481         ! acc_N2O5 = A*(b-b*exp(-d*[H2O(l)]))
16482         !                       * (1-1/(1+(k3'*[H2O(l)]/[NO3-])+(k4'*[Cl-]/[NO3-])))
16483         ! where:
16484         ! acc_N2O5 = accommodation coefficient of N2O5 on the aerosol
16485         ! A = factor for experimental conditions = 3.2e-8 s
16486         ! b = 1.15e6 s^-1
16487         ! d = 1.3e-1 M^-1
16488         ! [H2O(l)] = H2O Molarity
16489         ! k3' (=k3/k2b) = 6.0e-2
16490         ! k4' (=k4/k2b) = 29e0
16491         ! [Cl-] = Cl- Molarity
16492         ! [NO3-] = NO3- Molarity
16493
16494         ! define set factors for scheme
16495         real(kind=8), parameter :: A_bt  = 3.2e-8
16496         real(kind=8), parameter :: b_bt  = 1.15e6
16497         real(kind=8), parameter :: d_bt  = 1.3e-1
16498         real(kind=8), parameter :: k3_bt = 6.0e-2
16499         real(kind=8), parameter :: k4_bt = 29e0
16500
16501         ! internal conversion factors
16502         real(kind=8), parameter :: nmol_mol = 1e-9      ! convert nmol->mol
16503         real(kind=8), parameter :: m3_litre = 1e3       ! convert m3->litre
16504         real(kind=8), parameter :: mm_h2o   = 18e-3     ! molar mass (kg/mol)
16505
16506         ! input variables
16507         real(kind=8) :: mass_h2o        ! kg(water)/m^3(air)
16508         real(kind=8) :: mol_no3         ! nmol/m^3(air?)
16509         real(kind=8) :: mol_cl          ! nmol/m^3(air?)
16510         real(kind=8) :: vol                     ! cc/cc(air) - wet volume
16511
16512         ! internal variables
16513         real(kind=8) :: part_step
16514         real(kind=8) :: aer_h2o, aer_no3, aer_cl        ! molarity - mol/litre(solution)
16515
16516
16517         ! extract and convert aerosol data from inputs to Moles/litre(solution)
16518         aer_h2o = mass_h2o / (mm_h2o*vol*m3_litre)
16519         aer_no3 = mol_no3*nmol_mol / (vol*m3_litre)
16520         aer_cl  = mol_cl*nmol_mol / (vol*m3_litre)
16521
16522         if(n2o5_flag.eq.1)then ! switch off Cl pathway
16523                 aer_cl = 0.0
16524         end if
16525
16526         if(aer_h2o .ne. 0.0)then
16527                 part_step =  b_bt - b_bt * exp(-d_bt*aer_h2o)
16528                 if(aer_no3 .ne. 0.0)then
16529                         acc_n2o5_bert_thorn = A_bt * part_step *  &
16530                                         (1.0 - 1.0 / (                    &
16531                                                 1.0 +                         &
16532                                                 (k3_bt*aer_h2o/aer_no3) +     &
16533                                                 (k4_bt*aer_cl/aer_no3)        &
16534                                         ))
16535                 else
16536                         acc_n2o5_bert_thorn = A_bt * part_step
16537                 endif
16538         else ! if no aerosol water then don't take up N2O5
16539                 acc_n2o5_bert_thorn = 0.0
16540         endif
16541
16542         return
16543         end function acc_n2o5_bert_thorn
16544 !-------------------------------------------------------------
16545
16546
16547 !-------------------------------------------------------------
16548         real(kind=8) function split_n2o5_bert_thorn(mass_h2o,mol_cl,vol)
16549         ! Hetereogeneous reaction of N2O5 with H2O(l) and Cl-(aq)
16550         ! after Bertram and Thornton, ACP, 2009
16551         ! Subroutine for splitting reaction pathways
16552         !
16553         ! R3f = 1 / (1+(k4'[Cl-])/(k3'[H2O(l)])) (H2O pathway)
16554         ! R4f = 1 / (1+(k3'[H2O(l)])/(k4'[Cl-])) (Cl- pathway)
16555         ! where:
16556         ! R3f = fraction of N2O5 that reacts with H2O
16557         ! R4f = fraction of N2O5 that reacts with Cl-
16558         ! [H2O(l)] = H2O Molarity
16559         ! [Cl-] = Cl- Molarity
16560         ! k3' (=k3/k2b) = 6.0e-2
16561         ! k4' (=k4/k2b) = 29e0
16562         !
16563         ! This function outputs the fraction of N2O5 which reacts
16564         ! with H2O
16565
16566         ! define parameters for the scheme
16567         real(kind=8), parameter :: k3_bt = 6.0e-2
16568         real(kind=8), parameter :: k4_bt = 29e0
16569
16570         ! internal conversion factors
16571         real(kind=8), parameter :: nmol_mol = 1e-9      ! convert nmol->mol
16572         real(kind=8), parameter :: m3_litre = 1e3       ! convert m3->litre
16573         real(kind=8), parameter :: mm_h2o   = 18e-3     ! molar mass (kg/mol)
16574
16575         ! input variables
16576         real(kind=8) :: mass_h2o        ! kg(water)/m^3(air)
16577         real(kind=8) :: mol_cl          ! nmol/m^3(air?)
16578         real(kind=8) :: vol                     ! cc/cc(air) - wet volume
16579
16580         ! internal variables
16581         real(kind=8) :: part_step
16582         real(kind=8) :: aer_h2o, aer_cl ! molarity - mol/litre(solution)
16583
16584
16585         ! extract and convert aerosol data from inputs to Moles/litre(solution)
16586         aer_h2o = mass_h2o / (mm_h2o*vol*m3_litre)
16587         aer_cl  = mol_cl*nmol_mol / (vol*m3_litre)
16588
16589         if(n2o5_flag.eq.1)then ! switch off Cl pathway
16590                 aer_cl = 0.0
16591         end if
16592
16593         if(aer_h2o .ne. 0.0)then
16594                 split_n2o5_bert_thorn = 1e0 / &
16595                                         ( 1e0 + (k4_bt*aer_cl)/(k3_bt*aer_h2o) )
16596         else
16597                 split_n2o5_bert_thorn = 0.0
16598         endif
16599
16600
16601
16602         return
16603         end function split_n2o5_bert_thorn
16604 !-------------------------------------------------------------
16605
16606
16607
16608
16609
16610
16611 !----------------------------------------------------------
16612 ! solution to x^3 + px^2 + qx + r = 0
16613 !
16614       real(kind=8) function cubic( p, q, r )
16615 !     implicit none
16616 ! subr arguments
16617       real(kind=8), intent(in) :: p, q, r
16618 ! local variables
16619       real(kind=8) a, b, d, m, n, third, y
16620       real(kind=8) k, phi, thesign, x(3), duma
16621       integer icase, kk
16622
16623       third = 1.d0/3.d0
16624
16625       a = (1.d0/3.d0)*((3.d0*q) - (p*p))
16626       b = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
16627
16628       d = ( ((a*a*a)/27.d0) + ((b*b)/4.d0) )
16629
16630       if(d .gt. 0.)then !       => 1 real and 2 complex roots
16631         icase = 1
16632       elseif(d .eq. 0.)then !   => 3 real roots, atleast 2 identical
16633         icase = 2
16634       else      ! d < 0         => 3 distinct real roots
16635         icase = 3
16636       endif
16637
16638
16639       goto (1,2,3), icase
16640
16641 ! case 1: d > 0
16642 1     thesign = 1.
16643       if(b .gt. 0.)then
16644         b = -b
16645         thesign = -1.
16646       endif
16647
16648       m = thesign*((-b/2.d0) + (sqrt(d)))**(third)
16649       n = thesign*((-b/2.d0) - (sqrt(d)))**(third)
16650
16651       cubic = real( (m) + (n) - (p/3.d0) )
16652       return
16653
16654 ! case 2: d = 0
16655 2     thesign = 1.
16656       if(b .gt. 0.)then
16657         b = -b
16658         thesign = -1.
16659       endif
16660
16661       m = thesign*(-b/2.d0)**third
16662       n = m
16663
16664       x(1) = real( (m) + (n) - (p/3.d0) )
16665       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
16666       x(2) = real( (-m/2.d0) + (-n/2.d0) - (p/3.d0) )
16667
16668       cubic = 0.
16669       do kk = 1, 3
16670         if(x(kk).gt.cubic) cubic = x(kk)
16671       enddo
16672       return
16673
16674 ! case 3: d < 0
16675 3     if(b.gt.0.)then
16676         thesign = -1.
16677       elseif(b.lt.0.)then
16678         thesign = 1.
16679       endif
16680
16681 ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
16682 !     phi = acos(thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) ))     ! radians
16683       duma = thesign*sqrt( (b*b/4.d0)/(-a*a*a/27.d0) )
16684       duma = min( duma, +1.0D0 )
16685       duma = max( duma, -1.0D0 )
16686       phi  = acos( duma )       ! radians
16687
16688
16689       cubic = 0.
16690       do kk = 1, 3
16691         k = kk-1
16692         y = 2.*sqrt(-a/3.)*cos(phi + 120.*k*0.017453293)
16693         x(kk) = real((y) - (p/3.d0))
16694         if(x(kk).gt.cubic) cubic = x(kk)
16695       enddo
16696       return
16697
16698       end function cubic
16699 !----------------------------------------------------------
16700
16701
16702
16703
16704 !----------------------------------------------------------
16705       real(kind=8) function quadratic(a,b,c)
16706 !     implicit none
16707 ! subr. arguments
16708       real(kind=8) a, b, c
16709 ! local variables
16710       real(kind=8) x, dum, quad1, quad2
16711
16712
16713         if(b .ne. 0.0)then
16714         x = 4.*(a/b)*(c/b)
16715         else
16716         x = 1.e+6
16717         endif
16718
16719         if(abs(x) .lt. 1.e-6)then
16720           dum = (0.5*x) +   &
16721                 (0.125*x**2) +   &
16722                 (0.0625*x**3)
16723
16724           quadratic = (-0.5*b/a)*dum
16725
16726           if(quadratic .lt. 0.)then
16727             quadratic = -b/a - quadratic
16728           endif
16729
16730         else
16731           quad1 = (-b+sqrt(b*b-4.*a*c))/(2.*a)
16732           quad2 = (-b-sqrt(b*b-4.*a*c))/(2.*a)
16733
16734           quadratic = max(quad1, quad2)
16735         endif
16736
16737       return
16738       end function quadratic
16739 !----------------------------------------------------------
16740
16741
16742
16743 !----------------------------------------------------------
16744 ! currently not used
16745
16746 ! two roots of a quadratic equation
16747
16748       subroutine quadratix(a,b,c, qx1,qx2)
16749 !      implicit none
16750 ! subr. arguments
16751       real(kind=8) a, b, c, qx1, qx2
16752 ! local variables
16753       real(kind=8) x, dum
16754
16755
16756       if(b .ne. 0.0)then
16757         x = 4.*(a/b)*(c/b)
16758         else
16759         x = 1.e+6
16760       endif
16761
16762       if(abs(x) .lt. 1.e-6)then
16763         dum = (0.5*x) +   &
16764               (0.125*x**2) +   &
16765               (0.0625*x**3)
16766
16767         qx1 = (-0.5*b/a)*dum
16768         qx2 = -b/a - qx1
16769
16770       else
16771
16772         qx1 = (-b+sqrt(b*b - 4.*a*c))/(2.*a)
16773         qx2 = (-b-sqrt(b*b - 4.*a*c))/(2.*a)
16774
16775       endif
16776
16777       return
16778       end subroutine quadratix
16779
16780
16781 !=====================================================================
16782
16783
16784
16785
16786
16787
16788
16789
16790
16791
16792
16793
16794
16795
16796
16797
16798
16799 !***********************************************************************
16800 !  save aerosol drymass and drydens before aerosol mass transfer is
16801 !  calculated this subr is called from within subr mosaic_dynamic_solver,
16802 !  after the initial calls to check_aerosol_mass, conform_electrolytes,
16803 !  conform_aerosol_number, and aerosol_phase_state, but before the mass
16804 !  transfer is calculated
16805 !
16806 ! author: richard c. easter
16807 !-----------------------------------------------------------------------
16808       subroutine save_pregrow_props
16809
16810       use module_data_mosaic_asect
16811       use module_data_mosaic_other
16812
16813 !     implicit none
16814 !     include 'v33com'
16815 !     include 'v33com9a'
16816 !     include 'v33com9b'
16817 !     include 'mosaic.h'
16818
16819 !   subr arguments (none)
16820
16821 !   local variables
16822       integer ibin, isize, itype
16823
16824
16825 ! air conc in mol/cm^3
16826       cair_mol_cc = cairclm(kclm_aer)
16827
16828 ! compute then save drymass and drydens for each bin
16829       do ibin = 1, nbin_a
16830
16831       call calc_dry_n_wet_aerosol_props( ibin )
16832
16833       call isize_itype_from_ibin( ibin, isize, itype )
16834       drymass_pregrow(isize,itype) = mass_dry_a(ibin)/cair_mol_cc       ! g/mol(air)
16835       if(jaerosolstate(ibin) .eq. no_aerosol) then
16836           drydens_pregrow(isize,itype) = -1.
16837       else
16838           drydens_pregrow(isize,itype) = dens_dry_a(ibin)               ! g/cc
16839       end if
16840
16841       end do
16842
16843       return
16844       end subroutine save_pregrow_props
16845
16846
16847
16848
16849
16850
16851
16852 !***********************************************************************
16853 ! special output
16854 !
16855 ! author: richard c. easter
16856 !-----------------------------------------------------------------------
16857         subroutine specialoutaa( iclm, jclm, kclm, msub, fromwhere )
16858
16859 !       implicit none
16860
16861         integer iclm, jclm, kclm, msub
16862         character*(*) fromwhere
16863
16864         return
16865         end subroutine specialoutaa
16866
16867
16868
16869
16870 !***********************************************************************
16871 ! box model test output
16872 !
16873 ! author: richard c. easter
16874 !-----------------------------------------------------------------------
16875         subroutine aerchem_boxtest_output(   &
16876                 iflag, iclm, jclm, kclm, msub, dtchem )
16877
16878         use module_data_mosaic_asect
16879         use module_data_mosaic_other
16880 !       implicit none
16881
16882 !       include 'v33com'
16883 !       include 'v33com2'
16884 !       include 'v33com9a'
16885
16886         integer iflag, iclm, jclm, kclm, msub
16887         real(kind=8) dtchem
16888
16889 !   local variables
16890         integer lun
16891         parameter (lun=83)
16892         integer, save :: ientryno = -13579
16893         integer icomp, iphase, isize, itype, k, l, m, n
16894
16895         real(kind=8) dtchem_sv1
16896         save dtchem_sv1
16897         real(kind=8) rsub_sv1(l2maxd,kmaxd,nsubareamaxd)
16898
16899
16900 !   bypass unless maerchem_boxtest_output > 0
16901         if (maerchem_boxtest_output .le. 0) return
16902
16903
16904
16905 !
16906 ! *** currently this only works for ntype_aer = 1
16907 !
16908         itype = 1
16909         iphase = ai_phase
16910
16911 !   do initial output
16912         if (ientryno .ne. -13579) goto 1000
16913
16914         ientryno = +1
16915         call peg_message( lunerr, '***' )
16916         call peg_message( lunerr, '*** doing initial aerchem_boxtest_output' )
16917         call peg_message( lunerr, '***' )
16918
16919         write(lun) ltot, ltot2, itot, jtot, ktot
16920         write(lun) (name(l), l=1,ltot2)
16921
16922         write(lun) maerocoag, maerchem, maeroptical
16923         write(lun) msectional, maerosolincw
16924
16925         write(lun) nsize_aer(itype), ntot_mastercomp_aer
16926
16927         do icomp = 1, ntot_mastercomp_aer
16928             write(lun)   &
16929                 name_mastercomp_aer(icomp)
16930             write(lun)   &
16931                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
16932         end do
16933
16934         do isize = 1, nsize_aer(itype)
16935             write(lun)   &
16936                 ncomp_plustracer_aer(itype),   &
16937                 ncomp_aer(itype),   &
16938                 waterptr_aer(isize,itype),   &
16939                 numptr_aer(isize,itype,iphase),   &
16940                 mprognum_aer(isize,itype,iphase)
16941             write(lun)   &
16942               ( mastercompptr_aer(l,itype),   &
16943                 massptr_aer(l,isize,itype,iphase),   &
16944                 l=1,ncomp_plustracer_aer(itype) )
16945             write(lun)   &
16946                 volumcen_sect(isize,itype),   &
16947                 volumlo_sect(isize,itype),   &
16948                 volumhi_sect(isize,itype),   &
16949                 dcen_sect(isize,itype),   &
16950                 dlo_sect(isize,itype),   &
16951                 dhi_sect(isize,itype)
16952             write(lun)   &
16953                 lptr_so4_aer(isize,itype,iphase),   &
16954                 lptr_msa_aer(isize,itype,iphase),   &
16955                 lptr_no3_aer(isize,itype,iphase),   &
16956                 lptr_cl_aer(isize,itype,iphase),   &
16957                 lptr_co3_aer(isize,itype,iphase),   &
16958                 lptr_nh4_aer(isize,itype,iphase),   &
16959                 lptr_na_aer(isize,itype,iphase),   &
16960                 lptr_ca_aer(isize,itype,iphase),   &
16961                 lptr_oin_aer(isize,itype,iphase),   &
16962                 lptr_oc_aer(isize,itype,iphase),   &
16963                 lptr_bc_aer(isize,itype,iphase),   &
16964                 hyswptr_aer(isize,itype)
16965         end do
16966
16967 !
16968 !   test iflag
16969 !
16970 1000    continue
16971         if (iflag .eq. 1) goto 1010
16972         if (iflag .eq. 2) goto 2000
16973         if (iflag .eq. 3) goto 3000
16974         return
16975
16976 !
16977 !   iflag=1 -- save initial values
16978 !
16979 1010    continue
16980         dtchem_sv1 = dtchem
16981         do m = 1, nsubareas
16982         do k = 1, ktot
16983         do l = 1, ltot2
16984             rsub_sv1(l,k,m) = rsub(l,k,m)
16985         end do
16986         end do
16987         end do
16988
16989         return
16990
16991 !
16992 !   iflag=2 -- save intermediate values before doing move_sections
16993 !   (this is deactivated for now)
16994 !
16995 2000    continue
16996         return
16997
16998
16999 !
17000 !   iflag=3 -- do output
17001 !
17002 3000    continue
17003         do m = 1, nsubareas
17004         do k = 1, ktot
17005
17006         write(lun) iymdcur, ihmscur, iclm, jclm, k, m, nsubareas
17007         write(lun) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
17008                 ptotclm(k), afracsubarea(k,m)
17009
17010         write(lun) (rsub_sv1(l,k,m), rsub(l,k,m), l=1,ltot2)
17011
17012         end do
17013         end do
17014
17015
17016         return
17017         end subroutine aerchem_boxtest_output
17018
17019
17020
17021 !***********************************************************************
17022 ! 'debugging' output when mosaic encounters 'fatal error' situation
17023 !
17024 ! author: richard c. easter
17025 !-----------------------------------------------------------------------
17026         subroutine mosaic_aerchem_error_dump( istop, ibin, luna, msga )
17027 !
17028 !   dumps current column information when a fatal computational error occurs
17029 !   when istop>0, the simulation is halted
17030 !
17031         use module_data_mosaic_asect
17032         use module_data_mosaic_other
17033 !       implicit none
17034
17035 !   arguments
17036         integer istop, ibin, luna
17037         character*(*) msga
17038
17039 !   local variables
17040         integer icomp, iphase, isize, itype, k, l, lunb, m, n
17041         real(kind=8) dtchem_sv1
17042
17043
17044 !
17045 ! *** currently this only works for ntype_aer = 1
17046 !
17047         itype = 1
17048
17049
17050         lunb = luna
17051         if (lunb .le. 0) lunb = 6
17052
17053 9000    format( a )
17054 9010    format( 7i10 )
17055 9020    format( 3(1pe19.11) )
17056
17057         write(lunb,9000)
17058         write(lunb,9000) 'begin mosaic_aerchem_error_dump - msga ='
17059         write(lunb,9000) msga
17060         write(lunb,9000) 'i, j, k, msub,ibin ='
17061         write(lunb,9010) iclm_aer, jclm_aer, kclm_aer, mclm_aer, ibin
17062
17063         write(lunb,9010) ltot, ltot2, itot, jtot, ktot
17064         write(lunb,9000) (name(l), l=1,ltot2)
17065
17066         write(lunb,9010) maerocoag, maerchem, maeroptical
17067         write(lunb,9010) msectional, maerosolincw
17068
17069         write(lunb,9010) nsize_aer(itype), ntot_mastercomp_aer
17070
17071         do icomp = 1, ntot_mastercomp_aer
17072             write(lunb,9000)   &
17073                 name_mastercomp_aer(icomp)
17074             write(lunb,9020)   &
17075                 dens_mastercomp_aer(icomp),     mw_mastercomp_aer(icomp)
17076         end do
17077
17078         do isize = 1, nsize_aer(itype)
17079             write(lunb,9010)   &
17080                 ncomp_plustracer_aer(itype),   &
17081                 ncomp_aer(itype),   &
17082                 waterptr_aer(isize,itype),   &
17083                 numptr_aer(isize,itype,iphase),   &
17084                 mprognum_aer(isize,itype,iphase)
17085             write(lunb,9010)   &
17086               ( mastercompptr_aer(l,itype),   &
17087                 massptr_aer(l,isize,itype,iphase),   &
17088                 l=1,ncomp_plustracer_aer(itype) )
17089             write(lunb,9020)   &
17090                 volumcen_sect(isize,itype),   &
17091                 volumlo_sect(isize,itype),   &
17092                 volumhi_sect(isize,itype),   &
17093                 dcen_sect(isize,itype),   &
17094                 dlo_sect(isize,itype),   &
17095                 dhi_sect(isize,itype)
17096             write(lunb,9010)   &
17097                 lptr_so4_aer(isize,itype,iphase),   &
17098                 lptr_msa_aer(isize,itype,iphase),   &
17099                 lptr_no3_aer(isize,itype,iphase),   &
17100                 lptr_cl_aer(isize,itype,iphase),   &
17101                 lptr_co3_aer(isize,itype,iphase),   &
17102                 lptr_nh4_aer(isize,itype,iphase),   &
17103                 lptr_na_aer(isize,itype,iphase),   &
17104                 lptr_ca_aer(isize,itype,iphase),   &
17105                 lptr_oin_aer(isize,itype,iphase),   &
17106                 lptr_oc_aer(isize,itype,iphase),   &
17107                 lptr_bc_aer(isize,itype,iphase),   &
17108                 hyswptr_aer(isize,itype)
17109         end do
17110
17111
17112         dtchem_sv1 = -1.0
17113         do m = 1, nsubareas
17114         do k = 1, ktot
17115
17116         write(lunb,9010) iymdcur, ihmscur, iclm_aer, jclm_aer, k, m, nsubareas
17117         write(lunb,9020) t, dtchem_sv1, cairclm(k), relhumclm(k),   &
17118                 ptotclm(k), afracsubarea(k,m)
17119
17120         write(lunb,9020) (rsub(l,k,m), l=1,ltot2)
17121
17122         end do
17123         end do
17124
17125         write(lunb,9000) 'end mosaic_aerchem_error_dump'
17126
17127
17128         if (istop .gt. 0) call peg_error_fatal( luna, msga )
17129
17130         return
17131         end subroutine mosaic_aerchem_error_dump
17132 !-----------------------------------------------------------------------
17133
17134       end module module_mosaic_therm
17135