chem/module_mosaic_ext.F

   1 module module_mosaic_ext
   2 contains
   3
   4
   5       ! scm_temp - subr dumpxx is temporary for scm testing
   6       subroutine dumpxx( dumpch, dtchem, t_k, p_atm, ah2o, &
   7          jaerosolstate, jphase, jhyst_leg, &
   8          aer, gas, num_a, water_a, water_a_hyst, dp_dry_a, &
   9          mosaic_vars_aa )
  10
  11       use module_data_mosaic_kind,  only: r8
  12
  13       use module_data_mosaic_aero,  only: &
  14          iso4_a,       ino3_a,       icl_a,        inh4_a,       &
  15          ina_a,        ioin_a,       ioc_a,        ibc_a,        &
  16          ipcg2_b_c_a,  ipcg2_b_o_a,  ipcg1_b_c_a,  ipcg1_b_o_a,  &
  17          iopcg1_b_c_a, iopcg1_b_o_a, ipcg2_f_c_a,  ipcg2_f_o_a,  &
  18          ipcg1_f_c_a,  ipcg1_f_o_a,  iopcg1_f_c_a, iopcg1_f_o_a, &
  19          iant1_c_a,    iant1_o_a,    ibiog1_c_a,   ibiog1_o_a,   &
  20          aer_name, gas_name, &
  21          jtotal, naer, nbin_a, nbin_a_max, ngas_aerchtot, ngas_volatile, &
  22          mosaic_vars_aa_type
  23
  24       implicit none
  25
  26       integer, intent(in), dimension(nbin_a_max) :: jaerosolstate, jphase, jhyst_leg
  27
  28       real(r8), intent(in) :: dtchem, t_k, p_atm, ah2o
  29       real(r8), intent(in), dimension(naer,3,nbin_a_max) :: aer
  30       real(r8), intent(in), dimension(ngas_volatile) :: gas
  31       real(r8), intent(in), dimension(nbin_a_max) :: num_a, water_a, water_a_hyst, dp_dry_a
  32
  33       character(len=*), intent(in) :: dumpch
  34
  35       type (mosaic_vars_aa_type), intent(in) :: mosaic_vars_aa
  36
  37       integer, parameter :: lunaa = 131
  38       integer, parameter :: naer_dump = 24
  39       integer :: ii, iv, ix, jj, kk, ktau
  40       integer :: iaer_dump(naer_dump) = 24
  41       character(len=80)  :: fmtaa
  42       character(len=2)   :: tmpch2
  43       character(len=256) :: tmpchaa
  44       character(len= 32) :: tmpchbb
  45
  46
  47 !     return  ! scm_temp - for non-scm might want to activate this line
  48
  49       if ( mosaic_vars_aa%idiagbb_host < 100 ) return
  50
  51       ii = mosaic_vars_aa%hostgridinfo(2)
  52       jj = mosaic_vars_aa%hostgridinfo(3)
  53       kk = mosaic_vars_aa%hostgridinfo(4)
  54       if ( ii*jj*kk /= 1 ) return
  55
  56       ktau = mosaic_vars_aa%it_host
  57       iaer_dump = &
  58          (/ iso4_a,       ino3_a,       icl_a,        inh4_a,      &
  59             ina_a,        ioin_a,       ioc_a,        ibc_a,       &
  60             ipcg2_b_c_a,  ipcg2_b_o_a,  ipcg1_b_c_a,  ipcg1_b_o_a, &
  61             iopcg1_b_c_a, iopcg1_b_o_a, ipcg2_f_c_a,  ipcg2_f_o_a, &
  62             ipcg1_f_c_a,  ipcg1_f_o_a,  iopcg1_f_c_a, iopcg1_f_o_a, &
  63             iant1_c_a,    iant1_o_a,    ibiog1_c_a,   ibiog1_o_a /)
  64
  65
  66 ! qakola
  67       tmpch2 = dumpch
  68       write(lunaa,'(/2a,i5,3i3)') tmpch2, 'dump', &
  69          ktau, ii, jj, kk
  70       write(lunaa,'(a,f11.2,f11.4,f11.4      )') 't p a ', t_k, p_atm, ah2o
  71 !     if (tmpch2 == 'aa') &
  72 !     write(lunaa,'(a,f11.2                  )') 'cairm3', cair_mol_m3
  73
  74 !     write(lunaa,'(a,1p,8e11.3)') 'gas1:4    ', gas(1:4)
  75
  76       fmtaa = '(a,8i11)'
  77       if (nbin_a > 8) fmtaa = '(a,8i11/(10x,8i11))'
  78       write(lunaa,fmtaa) 'jstate    ', jaerosolstate(1:nbin_a)
  79       write(lunaa,fmtaa) 'jphase    ', jphase(1:nbin_a)
  80       write(lunaa,fmtaa) 'jhyst     ', jhyst_leg(1:nbin_a)
  81
  82       fmtaa = '(a,1p,8e11.3)'
  83       if (nbin_a > 8) fmtaa = '(a,1p,8e11.3/(10x,1p,8e11.3))'
  84       write(lunaa,fmtaa) 'num       ', num_a(1:nbin_a)
  85       write(lunaa,fmtaa) 'dpdry     ', dp_dry_a(1:nbin_a)
  86       write(lunaa,fmtaa) 'water     ', water_a(1:nbin_a)
  87       write(lunaa,fmtaa) 'hyswtr    ', water_a_hyst(1:nbin_a)
  88
  89 !     write(lunaa,'(a,1p,8e11.3)') 'so4       ', aer(iso4_a,jtotal,1:nbin_a)
  90 !     write(lunaa,'(a,1p,8e11.3)') 'no3       ', aer(ino3_a,jtotal,1:nbin_a)
  91 !     write(lunaa,'(a,1p,8e11.3)') 'cl        ', aer(icl_a, jtotal,1:nbin_a)
  92 !     write(lunaa,'(a,1p,8e11.3)') 'nh4       ', aer(inh4_a,jtotal,1:nbin_a)
  93 !!!   write(lunaa,'(a,1p,8e11.3)') 'msa       ', aer(imsa_a,jtotal,1:nbin_a)
  94 !!!   write(lunaa,'(a,1p,8e11.3)') 'co3       ', aer(ico3_a,jtotal,1:nbin_a)
  95 !     write(lunaa,'(a,1p,8e11.3)') 'na        ', aer(ina_a, jtotal,1:nbin_a)
  96 !!!   write(lunaa,'(a,1p,8e11.3)') 'ca        ', aer(ica_a, jtotal,1:nbin_a)
  97 !     write(lunaa,'(a,1p,8e11.3)') 'oin       ', aer(ioin_a,jtotal,1:nbin_a)
  98 !     write(lunaa,'(a,1p,8e11.3)') 'oc        ', aer(ioc_a, jtotal,1:nbin_a)
  99 !     write(lunaa,'(a,1p,8e11.3)') 'bc        ', aer(ibc_a, jtotal,1:nbin_a)
 100
 101
 102 !need to dump soa species
 103       do ix = 1, naer_dump
 104          iv = iaer_dump(ix)
 105          if (iv < 1 .or. iv > naer) cycle
 106          fmtaa = '(a,1p,8e11.3)'
 107          write(tmpchaa,fmtaa) aer_name(iv)(1:10), aer(iv,jtotal,1:min(nbin_a,8))
 108          if (iv <= ngas_aerchtot) then
 109             write(tmpchbb,fmtaa) gas_name(iv)(1:10), gas(iv)
 110             tmpchaa = trim(tmpchaa) // '  ' // trim(tmpchbb)
 111          end if
 112          write(lunaa,'(a)') trim(tmpchaa)
 113          fmtaa = '(10x,1p,8e11.3)'
 114          if (nbin_a > 8) write(lunaa,fmtaa) aer(iv,jtotal,9:nbin_a)
 115       end do ! ix
 116
 117
 118       return
 119       end subroutine dumpxx
 120
 121
 122
 123
 124
 125   !***********************************************************************
 126   ! determines phase state of an aerosol bin. includes kelvin effect.
 127   !
 128   ! author: Rahul A. Zaveri
 129   ! update: Sep 2015
 130   !-----------------------------------------------------------------------
 131   subroutine aerosol_phase_state( ibin, jaerosolstate, jphase, aer,  &
 132        jhyst_leg, electrolyte, epercent, kel, activity, mc, num_a, mass_wet_a, mass_dry_a,    &
 133        mass_soluble_a, vol_dry_a, vol_wet_a, water_a, water_a_hyst, water_a_up, aH2O_a,     &
 134        aH2O, ma, gam, log_gamZ, zc, za, gam_ratio,     &
 135        xeq_a, na_Ma, nc_Mc, xeq_c,       mw_electrolyte, partial_molar_vol, sigma_soln, T_K, & ! RAZ deleted a_zsr
 136        RH_pc, mw_aer_mac, dens_aer_mac, sigma_water, Keq_ll, Keq_sl, MW_a, MW_c,             &
 137        growth_factor, MDRH, MDRH_T, molality0, rtol_mesa, jsalt_present, jsalt_index,       &
 138        jsulf_poor, jsulf_rich, phi_salt_old,                                     &
 139        kappa_nonelectro, mosaic_vars_aa )
 140
 141     use module_data_mosaic_aero,  only: r8, nbin_a_max,                                   &
 142          ngas_aerchtot, ngas_volatile, nelectrolyte,                                      &!Parameters
 143          Ncation, naer, jtotal, all_solid, jhyst_up, all_liquid, Nanion, nrxn_aer_ll,     &
 144          nrxn_aer_sl, nsalt, MDRH_T_NUM, jsulf_poor_NUM, jsulf_rich_NUM,                  &!Parameters
 145          inh4_a, ina_a, ica_a, ico3_a, imsa_a, icl_a, ino3_a, iso4_a,                     & ! TBD
 146          a_zsr,  b_zsr,  aw_min,                                                          &! RAZ added a_zsr,  b_zsr,  aw_min
 147          mosaic_vars_aa_type
 148
 149
 150     implicit none
 151     !Intent -ins
 152
 153     integer, intent(in):: ibin
 154     integer, intent(in), dimension(nsalt) :: jsalt_index
 155     integer, intent(in), dimension(jsulf_poor_NUM) :: jsulf_poor
 156     integer, intent(in), dimension(jsulf_rich_NUM) :: jsulf_rich
 157
 158     real(r8), intent(in) :: aH2O,T_K,RH_pc,rtol_mesa
 159     real(r8), intent(in), dimension(naer) :: mw_aer_mac,dens_aer_mac
 160     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
 161     real(r8), intent(in), dimension(Nanion)  :: za,MW_a
 162     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
 163     real(r8), intent(in), dimension(ngas_aerchtot) :: partial_molar_vol
 164     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
 165
 166     !Intent - inout
 167     integer, intent(inout), dimension(nsalt) :: jsalt_present
 168     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase,jhyst_leg
 169
 170     real(r8), intent(inout) :: sigma_water
 171     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
 172     real(r8), intent(inout), dimension(Nanion)  :: xeq_a,na_Ma
 173     real(r8), intent(inout), dimension(nbin_a_max) :: num_a,mass_wet_a,mass_dry_a
 174     real(r8), intent(inout), dimension(nbin_a_max) :: mass_soluble_a,gam_ratio
 175     real(r8), intent(inout), dimension(nbin_a_max) :: vol_dry_a,vol_wet_a,water_a
 176     real(r8), intent(inout), dimension(nbin_a_max) :: water_a_hyst,water_a_up,aH2O_a
 177     real(r8), intent(inout), dimension(nbin_a_max) :: sigma_soln,growth_factor,MDRH
 178     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0            ! RAZ 5/20/2014
 179     real(r8), intent(inout), dimension (nrxn_aer_ll) :: Keq_ll
 180     real(r8), intent(inout), dimension (nrxn_aer_sl) :: Keq_sl
 181     real(r8), intent(inout), dimension(MDRH_T_NUM) :: MDRH_T
 182     real(r8), intent(inout), dimension(ngas_aerchtot,nbin_a_max) :: kel
 183     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
 184     real(r8), intent(inout), dimension(nelectrolyte,nelectrolyte) :: log_gamZ
 185     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
 186     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
 187     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
 188     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
 189     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: epercent
 190     real(r8), intent(inout), dimension(nsalt) :: phi_salt_old
 191
 192     type (mosaic_vars_aa_type), intent(inout) :: mosaic_vars_aa
 193
 194     ! local variables
 195     character(len=256) :: errmsg
 196     integer, parameter :: aer_pha_sta_diagaa = -1 !BALLI- changed from 100 to -1
 197     integer, parameter :: iter_kelvin_method =  3
 198     ! iter_kelvin_method = 1 - use rahuls original iteration method
 199     ! iter_kelvin_method = 2 - use bisection
 200     ! iter_kelvin_method = 3 - start with rahuls original iteration method, but if it fails, switch to bisection
 201     integer, parameter :: iter_kelvin_meth1_max = 10
 202     integer, parameter :: iter_kelvin_meth2_max = 100
 203     integer :: iaer, iv, itmpa
 204     integer :: iter_kelvin, iter_kelvin_meth1, iter_kelvin_state
 205     integer :: js, je
 206
 207     real(r8) :: aer_H
 208     real(r8):: aH2O_range_bisect_toler
 209     real(r8) :: aH2O_a_new, aH2O_a_old, aH2O_a_oldn, aH2O_a_oldp, aH2O_a_del_state3
 210     real(r8), dimension(nbin_a_max) :: DpmV
 211     real(r8), dimension(nbin_a_max) :: kelvin
 212     real(r8) :: kelvin_old, kelvin_oldn, kelvin_oldp
 213     real(r8) :: kelvin_toler
 214     real(r8) :: rel_err, rel_err_old, rel_err_old2, rel_err_oldn, rel_err_oldp
 215     real(r8) :: term, tmpa
 216     real(r8) :: water_a_old, water_a_oldn, water_a_oldp
 217
 218
 219     if (aer_pha_sta_diagaa >= 3) &
 220     write(*,'(/a,5i5,2f12.8,1p,2e11.3)') 'aer_pha_sta_a', ibin, jhyst_leg(ibin), jaerosolstate(ibin), -1, 0, aH2O, aH2O_a(ibin)
 221     !aH2O = RH_pc*0.01 !**BALLI, this is already done in init subr
 222     aH2O_a(ibin) = aH2O
 223     kelvin(ibin) = 1.0
 224     do iv = 1, ngas_aerchtot
 225        kel(iv,ibin) = 1.0
 226     enddo
 227
 228 !   if(RH_pc .le. 97.0)then     ! RAZ
 229 !      kelvin_toler = 1.e-4
 230 !   else
 231 !      kelvin_toler = 1.e-10    ! RAZ
 232 !   endif
 233 ! define error tolerances become stricter as aH2O approaches 1.0
 234     kelvin_toler = 1.e-6_r8 * max( 1.0_r8-aH2O, 1.0e-4_r8 )
 235     aH2O_range_bisect_toler = 1.e-6_r8 * max( 1.0_r8-aH2O, 1.0e-4_r8 )
 236
 237
 238     ! calculate dry mass and dry volume of a bin
 239     mass_dry_a(ibin) = 0.0          ! initialize to 0.0
 240     vol_dry_a(ibin)  = 0.0          ! initialize to 0.0
 241
 242     aer_H = (2.*aer(iso4_a,jtotal,ibin) +   &
 243          aer(ino3_a,jtotal,ibin) +   &
 244          aer(icl_a,jtotal,ibin)  +   &
 245          aer(imsa_a,jtotal,ibin) +   &
 246          2.*aer(ico3_a,jtotal,ibin))-   &
 247          (2.*aer(ica_a,jtotal,ibin)  +   &
 248          aer(ina_a,jtotal,ibin)  +   &
 249          aer(inh4_a,jtotal,ibin))
 250     aer_H = max(aer_H, 0.0d0)
 251
 252     do iaer = 1, naer
 253        mass_dry_a(ibin) = mass_dry_a(ibin) +   &
 254             aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)  ! ng/m^3(air)
 255        vol_dry_a(ibin)  = vol_dry_a(ibin) +   &
 256             aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
 257     enddo
 258     mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
 259     vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
 260
 261     mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                      ! g/cc(air)
 262     vol_dry_a(ibin)  = vol_dry_a(ibin)*1.e-15                               ! cc(aer)/cc(air) or m^3/m^3(air)
 263
 264     ! wet mass and wet volume
 265     mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3               ! g/cc(air)
 266     vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3                ! cc(aer)/cc(air) or m^3/m^3(air)
 267
 268
 269     water_a_up(ibin) = aerosol_water_up(ibin,electrolyte,aer,kappa_nonelectro,a_zsr)   ! for hysteresis curve determination
 270
 271     iter_kelvin = 0
 272     iter_kelvin_meth1 = 0
 273
 274     iter_kelvin_state = 0
 275     if (iter_kelvin_method == 2) iter_kelvin_state = 2
 276
 277     aH2O_a_old = aH2O
 278     kelvin_old = 1.0_r8
 279     rel_err_old = 1.0e30_r8
 280     rel_err_old2 = 1.0e30_r8
 281     water_a_old = 0.0_r8
 282
 283     aH2O_a_del_state3 = 1.0e-3_r8
 284     aH2O_a_oldn = aH2O
 285     aH2O_a_oldp = aH2O
 286     kelvin_oldp = 1.0_r8
 287     kelvin_oldn = 1.0_r8
 288     rel_err_oldn = 1.0e30_r8
 289     rel_err_oldp = 1.0e30_r8
 290     water_a_oldp = 0.0_r8
 291     water_a_oldn = 0.0_r8
 292     aH2O_a_new = aH2O
 293
 294
 295 10  iter_kelvin = iter_kelvin + 1
 296     aH2O_a(ibin) = aH2O_a_new
 297
 298 ! RAZ uncommented the next 3 lines
 299       do je = 1, nelectrolyte
 300         molality0(je,ibin) = bin_molality(je,ibin,aH2O_a,b_zsr,a_zsr,aw_min)  ! compute aH2O dependent binary molalities  EFFI
 301       enddo
 302     call MESA( ibin, jaerosolstate, jphase, aer, jhyst_leg,         &
 303          electrolyte, epercent, activity, mc, num_a, mass_wet_a, mass_dry_a,              &
 304          mass_soluble_a, vol_dry_a, vol_wet_a, water_a, water_a_hyst, water_a_up, aH2O_a, &
 305          aH2O, ma, gam, log_gamZ, zc, za, gam_ratio, &
 306          xeq_a, na_Ma, nc_Mc, xeq_c, mw_electrolyte, mw_aer_mac, dens_aer_mac, Keq_ll,     &
 307          Keq_sl, MW_c, MW_a, growth_factor, MDRH, MDRH_T, molality0, rtol_mesa,            &
 308          jsalt_present, jsalt_index, jsulf_poor, jsulf_rich, phi_salt_old,    &
 309          kappa_nonelectro, mosaic_vars_aa )
 310
 311     if(jaerosolstate(ibin) .eq. all_solid)then
 312        if (aer_pha_sta_diagaa >= 2) &
 313        write(*,'(a,5i5,2f12.8,1p,2e11.3)') 'aer_pha_sta_b', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 314           iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin)
 315        return
 316     endif
 317     ! new wet mass and wet volume
 318     mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3               ! g/cc(air)
 319     vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3                ! cc(aer)/cc(air) or m^3/m^3(air)
 320
 321     call calculate_kelvin(ibin,num_a,vol_wet_a,aH2O_a,DpmV,kelvin,sigma_soln,T_K,  &
 322          sigma_water)
 323     !      kelvin(ibin) = 1.0
 324     kelvin(ibin) = max( kelvin(ibin), 1.0_r8 )
 325     if (water_a(ibin) <= 0.0_r8) kelvin(ibin) = 1.0_r8
 326
 327     aH2O_a_new = aH2O/kelvin(ibin)
 328
 329 !   if(RH_pc .le. 97.0)then
 330 !     rel_err = abs( (aH2O_a_new - aH2O_a(ibin))/aH2O_a(ibin))
 331 !   else
 332 !     if(water_a(ibin) .gt. 0.0)then
 333 !       rel_err = abs( (water_a(ibin) - water_a_old)/water_a(ibin))
 334 !     else
 335 !       rel_err = 0.0 ! no soluble material is present
 336 !     endif
 337 !   endif
 338 ! the above rel_err involve differences between current and previous
 339 !    iteration values, and is not suitable for bisection
 340 ! this rel_err below uses error from the exact solution, and is suitable for bisection
 341     rel_err = (aH2O_a(ibin)*kelvin(ibin) - aH2O) / max( aH2O, 0.01_r8 )
 342
 343     if (aer_pha_sta_diagaa >= 10) &
 344     write(*,'(a,2i5, 1p,e10.2, 0p,f14.10, 2x,2f14.10, 2x,1p,2e18.10)') &
 345        'iter_kelvin', iter_kelvin_state, iter_kelvin, rel_err, kelvin(ibin), &
 346        aH2O_a(ibin), aH2O_a_new, water_a_old, water_a(ibin)
 347
 348     if (abs(rel_err) <= kelvin_toler) then
 349        iter_kelvin_state = iter_kelvin_state + 100
 350        goto 90
 351     end if
 352
 353     if (iter_kelvin_state <= 0) then
 354        ! doing rahuls original iteration method
 355        itmpa = 0
 356        if (iter_kelvin >= iter_kelvin_meth1_max) then
 357           itmpa = 1
 358        else if (iter_kelvin >= iter_kelvin_meth1_max) then
 359           tmpa = min( rel_err_old, rel_err_old2 )
 360           if (tmpa < 0.0_r8 .and. rel_err <= tmpa) itmpa = 1
 361           tmpa = max( rel_err_old, rel_err_old2 )
 362           if (tmpa > 0.0_r8 .and. rel_err >= tmpa) itmpa = 1
 363        end if
 364
 365        if (itmpa > 0) then
 366           if (iter_kelvin_method <= 1) then
 367              ! quit if number of iterations is too large OR
 368              ! rel_err is outside the range of the previous two rel_err values,
 369              !    and one previous rel_err is positive, and one previous rel_err is negative
 370              aH2O_a(ibin) = aH2O_a_new   ! do this to get same output as prev version
 371              if (aer_pha_sta_diagaa >= 1) &
 372              write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_err', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 373                 iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 374              iter_kelvin_state = 100
 375              goto 90
 376           else
 377              ! switch to method 2 but do not iterate yet
 378              iter_kelvin_state = 1
 379              iter_kelvin_meth1 = iter_kelvin
 380           end if
 381        else
 382           ! save current values to old then do next iteration
 383           aH2O_a_old = aH2O_a(ibin)
 384           kelvin_old = kelvin(ibin)
 385           rel_err_old2 = rel_err_old
 386           rel_err_old = rel_err
 387           water_a_old  = water_a(ibin)
 388        !        aH2O = aH2O_a_new
 389        !        call MTEM_compute_log_gamZ  ! recompute activity coeffs (for surface tension and solid-liquid equilibria)
 390           goto 10
 391        end if
 392     endif
 393
 394     if (iter_kelvin_state == 1) then
 395        ! rahuls original iteration method failed, so do some things before switching to bisection
 396        iter_kelvin_state = 2
 397        if (rel_err < 0.0_r8) then
 398           ! current aH2O_a has negative rel_err so must start at the beginning
 399           aH2O_a_new = aH2O
 400           goto 10
 401        else
 402           ! current aH2O_a has positive rel_err and can be used in bisection
 403           ! do not iterate yet
 404           continue
 405        end if
 406     end if
 407
 408     if (iter_kelvin_state == 2) then
 409        ! this is first "setup" step of bisection, and the algorithm is expecting that
 410        !    the current aH2O_a has hel_err be > 0, and can be used as one of the 2 bisection points
 411        if (rel_err < 0.0_r8) then
 412           ! error should be positive, so this is a fatal error
 413           if (aer_pha_sta_diagaa >= 1) &
 414              write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_er2', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 415                 iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 416           iter_kelvin_state = 100
 417           goto 90
 418        end if
 419        ! current aH2O_a will work as one of the two initial bisection points
 420        ! (the one with a positive error)
 421        aH2O_a_oldp = aH2O_a(ibin)
 422        kelvin_oldp = kelvin(ibin)
 423        rel_err_oldp = rel_err
 424        water_a_oldp  = water_a(ibin)
 425        aH2O_a_new = min( aH2O/kelvin(ibin), 0.999999_r8 )   ! is this needed, or should it be 1.0, or ???
 426        iter_kelvin_state = 3
 427        goto 10
 428     end if
 429
 430     if (iter_kelvin_state == 3) then
 431        ! this is the second "setup" step of bisection, and the algorithm is looking for an aH2O_a
 432        ! that has rel_err < 0, so that the "root" will be bracketed and bisection can begin
 433        if (rel_err < 0.0_r8) then
 434           ! current aH2O_a will work as one of the two initial bisection points
 435           ! (the one with a negative error)
 436           aH2O_a_oldn = aH2O_a(ibin)
 437           kelvin_oldn = kelvin(ibin)
 438           rel_err_oldn = rel_err
 439           water_a_oldn  = water_a(ibin)
 440           aH2O_a_new = 0.5_r8*(aH2O_a_oldn + aH2O_a_oldp)
 441           iter_kelvin_state = 4
 442           goto 10
 443        else
 444           ! need to find a point with a negative error
 445           if ( (rel_err >= rel_err_oldp) .or. &
 446                (aH2O_a_del_state3 >= 0.999_r8) ) then
 447              ! cannot find such a point -- this is a fatal error
 448              if (aer_pha_sta_diagaa >= 1) &
 449                 write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_er3', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 450                    iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 451              iter_kelvin_state = 200
 452              goto 90
 453           else
 454              ! save current aH2O_a as the initial bisection point with positive error
 455              ! then calc aH2O_a_new = aH2O_a(ibin) - aH2O_a_del_state3
 456              ! which will hopefully have a negative error
 457              aH2O_a_oldp = aH2O_a(ibin)
 458              kelvin_oldp = kelvin(ibin)
 459              rel_err_oldp = rel_err
 460              water_a_oldp  = water_a(ibin)
 461              aH2O_a_new = aH2O_a(ibin) - aH2O_a_del_state3
 462              aH2O_a_del_state3 = aH2O_a_del_state3*1.5_r8
 463              if (aH2O_a_new .le. 0.01_r8) then
 464                 aH2O_a_new = 0.01_r8
 465                 aH2O_a_del_state3 = 1.0_r8
 466              end if
 467              goto 10
 468           end if
 469        end if
 470     end if
 471
 472     if (iter_kelvin_state == 4) then
 473        ! at this point, the algorithm is doing bisection
 474        if ( iter_kelvin >= iter_kelvin_meth2_max + iter_kelvin_meth1 ) then
 475           ! maximum iterations is exceeded
 476           if (aer_pha_sta_diagaa >= 1) &
 477              write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_er4', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 478                 iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 479           iter_kelvin_state = 301
 480           goto 90
 481        else if ( abs(aH2O_a_oldp - aH2O_a_oldn) <= aH2O_range_bisect_toler ) then
 482           ! the aH2O_a_oldp to aH2O_a_oldn range is very small, which is treated as convergence
 483 !         if (aer_pha_sta_diagaa >= 1) &
 484 !            write(*,'(a,5i5,2f12.8,1p,4e11.3)') 'iter_kelv_er5', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 485 !               iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler, &
 486 !               aH2O_range_bisect_toler
 487           iter_kelvin_state = 302
 488           goto 90
 489        end if
 490        ! decide if the current aH2O_a should replace the old negative-error point
 491        !    or the old positive-error point
 492        if (rel_err >= 0.0_r8) then
 493           if (rel_err >= rel_err_oldp) then
 494              ! current aH2O_a has positive error, but the error is not smaller
 495              !    than the old positive-error point -- this is a fatal error
 496              if (aer_pha_sta_diagaa >= 1) &
 497                 write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_er6', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 498                    iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 499              iter_kelvin_state = 303
 500              goto 90
 501           else
 502              ! current aH2O_a has positive error and replaces the the old positive-error point
 503              aH2O_a_oldp = aH2O_a(ibin)
 504              kelvin_oldp = kelvin(ibin)
 505              rel_err_oldp = rel_err
 506              water_a_oldp  = water_a(ibin)
 507           end if
 508        else
 509           if (rel_err <= rel_err_oldn) then
 510              ! current aH2O_a has negative error, but the error is not smaller
 511              !    than the old negative-error point -- this is a fatal error
 512              if (aer_pha_sta_diagaa >= 1) &
 513                 write(*,'(a,5i5,2f12.8,1p,3e11.3)') 'iter_kelv_er7', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 514                    iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, kelvin_toler
 515              iter_kelvin_state = 304
 516              goto 90
 517           else
 518              ! current aH2O_a has negative error and replaces the the old negative-error point
 519              aH2O_a_oldn = aH2O_a(ibin)
 520              kelvin_oldn = kelvin(ibin)
 521              rel_err_oldn = rel_err
 522              water_a_oldn  = water_a(ibin)
 523           end if
 524        end if
 525        aH2O_a_new = 0.5_r8*(aH2O_a_oldn + aH2O_a_oldp)
 526        goto 10
 527     end if
 528
 529     write(errmsg,'(a,4i5)') 'iter_kelv fatal err 1', ibin, iter_kelvin, iter_kelvin_state
 530     call wrf_error_fatal(trim(adjustl(errmsg)))
 531
 532
 533     ! kelvin iterations completed
 534 90  if (iter_kelvin_state == 200) then
 535        ! select aH2O_a(ibin) or aH2O_a_oldp, whichever has lowest error
 536        if (abs(rel_err_oldp) < abs(rel_err)) then
 537           aH2O_a(ibin) = aH2O_a_oldp
 538           rel_err = rel_err_oldp
 539        end if
 540     else if (iter_kelvin_state >= 300 .and. iter_kelvin_state <= 304) then
 541        ! select aH2O_a(ibin) or aH2O_a_oldp or aH2O_a_oldn, whichever has lowest error
 542        tmpa = min( abs(rel_err_oldn), abs(rel_err_oldp), abs(rel_err) )
 543        if (abs(rel_err_oldp) == tmpa) then
 544           aH2O_a(ibin) = aH2O_a_oldp
 545           rel_err = rel_err_oldp
 546        else if (abs(rel_err_oldn) == tmpa) then
 547           aH2O_a(ibin) = aH2O_a_oldn
 548           rel_err = rel_err_oldn
 549        end if
 550     end if
 551
 552     if(jaerosolstate(ibin) .eq. all_liquid)jhyst_leg(ibin) = jhyst_up
 553
 554     ! now compute kelvin effect terms for condensing species (nh3, hno3, and hcl)
 555     do iv = 1,  ngas_aerchtot
 556        term = 4.*sigma_soln(ibin)*partial_molar_vol(iv)/   &
 557             (8.3144e7*T_K*DpmV(ibin))
 558        kel(iv,ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
 559     enddo
 560
 561     if (aer_pha_sta_diagaa >= 2) &
 562     write(*,'(a,5i5,2f12.8,1p,e11.3,e14.5)') 'aer_pha_sta_c', ibin, jhyst_leg(ibin), jaerosolstate(ibin), &
 563        iter_kelvin_state, iter_kelvin, aH2O, aH2O_a(ibin), rel_err, water_a(ibin)
 564     return
 565   end subroutine aerosol_phase_state
 566
 567
 568
 569   !**********************************`*************************************
 570   ! MESA: Multicomponent Equilibrium Solver for Aerosols.
 571   ! Computes equilibrum solid and liquid phases by integrating
 572   ! pseudo-transient dissolution and precipitation reactions
 573   !
 574   ! author: Rahul A. Zaveri
 575   ! update: sep 2015
 576   !
 577   ! 9/3/2015 RAZ: Bugfix - fixed phase state calculations for aerosols that dont contain any salts,
 578   !               but can still contain water due to presence of BC, OC, SOA, and OIN, which are now
 579   !               allowed to absorb some water.
 580   !-----------------------------------------------------------------------
 581   subroutine MESA( ibin, jaerosolstate, jphase, aer, jhyst_leg,      &
 582        electrolyte, epercent, activity, mc, num_a, mass_wet_a, mass_dry_a, mass_soluble_a,    &
 583        vol_dry_a, vol_wet_a, water_a, water_a_hyst, water_a_up, aH2O_a, aH2O,                &
 584        ma, gam, log_gamZ, zc, za, gam_ratio, xeq_a,     &
 585        na_Ma, nc_Mc, xeq_c, mw_electrolyte, mw_aer_mac, dens_aer_mac, Keq_ll, Keq_sl, MW_c,    &
 586        MW_a, growth_factor, MDRH, MDRH_T, molality0, rtol_mesa, jsalt_present, jsalt_index,   &
 587        jsulf_poor, jsulf_rich, phi_salt_old,                                       &
 588        kappa_nonelectro, mosaic_vars_aa )
 589
 590     use module_data_mosaic_aero,  only: r8, nbin_a_max, nelectrolyte, Ncation, naer,        &!Parameters
 591          jtotal, all_solid, jsolid, all_liquid, jliquid, jhyst_lo, mhyst_uporlo_jhyst,       &!Parameters
 592          jhyst_up, mhyst_uporlo_waterhyst, nsoluble, nsalt, Nanion, nrxn_aer_sl,            &
 593          nrxn_aer_ll, MDRH_T_NUM, jsulf_poor_NUM, jsulf_rich_NUM,                         &!Parameters
 594          ptol_mol_astem,  mhyst_force_lo,  mhyst_force_up,                               &!Input
 595          jcacl2, jcano3, mhyst_method, ioin_a, ibc_a, jcaco3, jcaso4,                     & !TBD
 596          mosaic_vars_aa_type
 597
 598
 599
 600     implicit none
 601
 602     ! subr arguments
 603     integer, intent(in) :: ibin
 604     integer, intent(inout), dimension(nbin_a_max)  :: jhyst_leg
 605     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase
 606     integer, intent(in), dimension(nsalt) :: jsalt_index
 607     integer, intent(inout), dimension(nsalt) :: jsalt_present
 608     integer, intent(in), dimension(jsulf_poor_NUM) :: jsulf_poor
 609     integer, intent(in), dimension(jsulf_rich_NUM) :: jsulf_rich
 610
 611     real(r8), intent(in) :: aH2O,rtol_mesa
 612     real(r8), intent(in), dimension(naer) :: mw_aer_mac,dens_aer_mac
 613     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
 614     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
 615     real(r8), intent(in), dimension(Nanion)  :: za,MW_a
 616     real(r8), intent(inout), dimension(Nanion)  :: xeq_a,na_Ma
 617     real(r8), intent(inout), dimension(nbin_a_max) :: num_a,mass_wet_a,mass_dry_a
 618     real(r8), intent(inout), dimension(nbin_a_max) :: mass_soluble_a,vol_dry_a
 619     real(r8), intent(inout), dimension(nbin_a_max) :: vol_wet_a,gam_ratio
 620     real(r8), intent(inout), dimension(nbin_a_max) :: water_a,water_a_hyst,water_a_up
 621     real(r8), intent(inout), dimension(nbin_a_max) :: aH2O_a,growth_factor,MDRH
 622     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
 623     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0 !BSINGH(05/23/2014) - Added dimension nbin_a_max
 624     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
 625     real(r8), intent(inout), dimension(nrxn_aer_sl) :: Keq_sl
 626     real(r8), intent(inout), dimension(MDRH_T_NUM) :: MDRH_T
 627     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
 628     real(r8), intent(inout), dimension(nelectrolyte,nelectrolyte) :: log_gamZ
 629     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
 630     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
 631     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
 632     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
 633     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: epercent
 634     real(r8), intent(inout), dimension(nsalt) :: phi_salt_old
 635     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
 636
 637     type (mosaic_vars_aa_type), intent(inout) :: mosaic_vars_aa
 638
 639     ! local variables
 640     integer :: idissolved, j_index, jsalt_dum, jdum, js, je ! 9/3/2015 RAZ: added jsalt_dum
 641     real(r8) :: CRH, solids, sum_soluble, sum_insoluble, XT !BALLI** XT, should it be subr arg?
 642     !real(r8) :: aerosol_water                               ! mosaic func
 643     !real(r8) :: drh_mutual                          ! mosaic func
 644     real(r8) :: H_ion, sum_dum
 645
 646
 647     !! EFFI
 648     !! calculate percent composition
 649     sum_dum = 0.0
 650     do je = 1, nelectrolyte
 651        sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
 652     enddo
 653
 654     if(sum_dum .eq. 0.)sum_dum = 1.0
 655
 656     do je = 1, nelectrolyte
 657        epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
 658     enddo
 659
 660
 661     call calculate_XT(ibin,jtotal,XT,aer)
 662
 663
 664
 665 !! begin new algorithm - 6/3/2015 RAZ
 666     jsalt_dum = 0 ! 9/3/2015 RAZ
 667     do js = 1, nsalt
 668        jsalt_present(js) = 0                        ! default value - salt absent
 669
 670        if(epercent(js,jtotal,ibin) .gt. ptol_mol_astem)then
 671           jsalt_present(js) = 1                     ! salt present
 672           jsalt_dum = jsalt_dum + jsalt_index(js)   ! 9/3/2015 RAZ
 673        endif
 674     enddo
 675
 676
 677     if( (epercent(jcano3,jtotal,ibin) .gt. ptol_mol_astem) .or. &
 678         (epercent(jcacl2,jtotal,ibin) .gt. ptol_mol_astem) )then
 679       CRH = 0.0  ! no crystrallization or efflorescence point
 680     else
 681       CRH = 0.35 ! default value
 682     endif
 683
 684   ! now diagnose MDRH
 685     if(jsalt_dum .eq. 0)then                    ! no salts or acids are present ! 9/3/2015 RAZ: updated algorithm for jsalt_dum = 0
 686
 687        CRH = 0.0
 688        MDRH(ibin) = 0.0
 689        jaerosolstate(ibin) = all_solid
 690        jphase(ibin)    = jsolid
 691        jhyst_leg(ibin) = jhyst_lo
 692        call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,water_a)
 693        water_a(ibin) = aerosol_water(jtotal,ibin,jaerosolstate,jphase,jhyst_leg,   &    ! 9/3/2015 RAZ: water due to nonelectrolytes (OC, BC, SOA, OIN)
 694         electrolyte,aer,kappa_nonelectro,num_a,mass_dry_a,mass_soluble_a,aH2O,molality0)
 695        return
 696
 697     elseif(XT .lt. 1. .and. XT .gt. 0.0)then    ! excess sulfate, always liquid, MDRH=0.0
 698        MDRH(ibin) = 0.0
 699     elseif(XT .ge. 2.0 .or. XT .lt. 0.0)then    ! sulfate poor
 700        j_index = jsulf_poor(jsalt_dum)          ! 9/3/2015 RAZ
 701        MDRH(ibin) = MDRH_T(j_index)
 702     else                                        ! sulfate rich
 703        j_index = jsulf_rich(jsalt_dum)          ! 9/3/2015 RAZ
 704        MDRH(ibin) = MDRH_T(j_index)
 705     endif
 706
 707     CRH = min(CRH, MDRH(ibin)/100.0)            ! 6/3/2015 RAZ
 708
 709 !! end new algorithm - 6/3/2015 RAZ
 710
 711
 712     ! modified step 1: 9/3/2015 RAZ
 713     ! step 1: check if aH2O is below CRH (crystallization or efflorescence point)
 714     if( aH2O_a(ibin).lt.CRH )then
 715        jaerosolstate(ibin) = all_solid
 716        jphase(ibin)    = jsolid
 717        jhyst_leg(ibin) = jhyst_lo
 718        call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,water_a)
 719        water_a(ibin) = aerosol_water(jtotal,ibin,jaerosolstate,jphase,jhyst_leg,   &    ! 9/3/2015 RAZ: water due to nonelectrolytes (OC, BC, SOA, OIN)
 720         electrolyte,aer,kappa_nonelectro,num_a,mass_dry_a,mass_soluble_a,aH2O,molality0)
 721        return
 722     endif
 723
 724
 725     ! step 2: check mhyst_method for supersaturation/metastable state
 726     jdum = 0
 727     if (mhyst_method == mhyst_uporlo_jhyst) then         ! BOX method/logic
 728        if (jhyst_leg(ibin) == jhyst_up) jdum = 1
 729     elseif (mhyst_method == mhyst_uporlo_waterhyst) then ! 3-D method/logic
 730        if (water_a_hyst(ibin) > 0.5*water_a_up(ibin)) jdum = 1
 731        !BSINGH - 05/28/2013(RCE updates)
 732     elseif (mhyst_method == mhyst_force_lo) then
 733        jdum = 0
 734     elseif (mhyst_method == mhyst_force_up) then
 735        jdum = 1
 736        !BSINGH - 05/28/2013(RCE updates ENDS)
 737     else
 738        call wrf_error_fatal('*** MESA - bad mhyst_method')
 739     endif
 740     if (jdum == 1) then ! the aerosol is fully deliquesced in metastable or subsaturated state
 741        call do_full_deliquescence(ibin,aer,electrolyte)
 742
 743        !        call ions_to_electrolytes(jliquid,ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,nc_Mc,xeq_c) ! for Li and Lu surface tension
 744        !        call compute_activities(ibin,jphase,aer,jhyst_leg,electrolyte, &
 745        !activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a,aH2O,ma,gam,log_gamZ,gam_ratio)              ! for Li and Lu surface tension
 746
 747
 748
 749
 750 ! MODIFIED LOGIC IF SOA, POA, BC, OIN ARE ASSUMED TO BE SLIGHTLY HYGROSCOPIC  RAZ 4/16/2014
 751 !       sum_soluble = 0.0
 752 !       do js = 1, nsoluble
 753 !          sum_soluble = sum_soluble + electrolyte(js,jtotal,ibin)
 754 !       enddo
 755 !
 756 !       solids = electrolyte(jcaso4,jtotal,ibin) +   &
 757 !                electrolyte(jcaco3,jtotal,ibin) +   &
 758 !                aer(ioin_a,jtotal,ibin)         +   &
 759 !                aer(ibc_a,jtotal,ibin)
 760 !
 761 !
 762 !       if(sum_soluble .le. 0.0 .and. solids .gt. 0.0)then ! RAZ modified logic
 763 !
 764 !          jdum = 0
 765 !          jaerosolstate(ibin) = all_solid ! no soluble material present, so go back to solid state
 766 !          jphase(ibin) = jsolid
 767 !          call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,water_a)
 768 !
 769 !          ! new wet mass and wet volume
 770 !          mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
 771 !          vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3  ! cc(aer)/cc(air) or m^3/m^3(air)
 772 !          growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)   ! mass growth factor
 773 !
 774 !          return
 775 !
 776 !       elseif(sum_soluble .gt. 0.0)then  ! RAZ modified logic
 777 !
 778           jaerosolstate(ibin) = all_liquid
 779           jhyst_leg(ibin) = jhyst_up
 780           jphase(ibin) = jliquid
 781           water_a(ibin) = aerosol_water(jtotal,ibin,jaerosolstate,jphase,jhyst_leg,   &
 782                electrolyte,aer,kappa_nonelectro,num_a,mass_dry_a,mass_soluble_a,aH2O,molality0)
 783           if(water_a(ibin) .le. 0.0)then     ! one last attempt to catch bad input
 784              jdum = 0
 785              jaerosolstate(ibin) = all_solid ! no soluble material present
 786              jphase(ibin)    = jsolid
 787              jhyst_leg(ibin) = jhyst_lo
 788              call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,water_a)
 789           else
 790              call adjust_liquid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent)
 791              call compute_activities(ibin,jaerosolstate,jphase,aer,jhyst_leg,      &
 792                   electrolyte,activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a, &
 793                   aH2O,ma,gam,log_gamZ,gam_ratio,Keq_ll,molality0,kappa_nonelectro)
 794           endif
 795
 796           ! new wet mass and wet volume
 797           mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3 ! g/cc(air)
 798           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3  ! cc(aer)/cc(air) or m^3/m^3(air)
 799           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)   ! mass growth factor
 800
 801           return
 802
 803 !       endif
 804
 805
 806     endif ! jdum
 807
 808
 809     ! step 3: diagnose phase state based on MDRH
 810     if(aH2O_a(ibin)*100. .lt. MDRH(ibin)) then
 811        jaerosolstate(ibin) = all_solid
 812        jphase(ibin) = jsolid
 813        jhyst_leg(ibin) = jhyst_lo
 814        call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,water_a)
 815        return
 816     endif
 817
 818
 819     ! step 4: none of the above means it must be sub-saturated or mixed-phase
 820 10  call do_full_deliquescence(ibin,aer,electrolyte)
 821     call MESA_PTC( ibin, jaerosolstate, jphase, aer, jhyst_leg,                   &
 822          electrolyte, epercent, activity, mc, num_a, mass_dry_a, mass_wet_a,      &
 823          mass_soluble_a, vol_dry_a, vol_wet_a, water_a, aH2O,                     &
 824          ma, gam, log_gamZ, zc, za, gam_ratio, xeq_a, na_Ma, nc_Mc, xeq_c,        &
 825          mw_electrolyte, mw_aer_mac, dens_aer_mac, Keq_sl, MW_c, MW_a, Keq_ll,    &
 826          growth_factor, molality0, rtol_mesa, jsalt_present, phi_salt_old,        &
 827          kappa_nonelectro, mosaic_vars_aa                                    )     ! determines jaerosolstate(ibin)
 828     return
 829   end subroutine MESA
 830
 831
 832
 833   !***********************************************************************
 834   ! computes kelvin effect term (kelvin => 1.0)
 835   !
 836   ! author: Rahul A. Zaveri
 837   ! update: jan 2005
 838   !-----------------------------------------------------------------------
 839   subroutine calculate_kelvin(ibin,num_a,vol_wet_a,aH2O_a,DpmV,kelvin,sigma_soln,  &
 840        T_K,sigma_water)
 841     use module_data_mosaic_constants, only:  pi
 842     use module_data_mosaic_aero, only: r8,nbin_a_max                                   !Parameters
 843
 844     implicit none
 845
 846     ! subr arguments
 847     integer, intent(in) :: ibin
 848     real(r8), intent(in) :: T_K,sigma_water
 849     real(r8), intent(in), dimension(nbin_a_max) :: num_a
 850     real(r8), intent(inout), dimension(nbin_a_max) :: sigma_soln
 851     real(r8), intent(inout), dimension(nbin_a_max) ::vol_wet_a,aH2O_a,DpmV,kelvin
 852     ! local variables
 853     integer je
 854     real(r8) :: term, sum_dum
 855     real(r8), dimension(nbin_a_max) :: volume_a
 856
 857     volume_a(ibin) = vol_wet_a(ibin)                                ! [cc/cc(air)]
 858     DpmV(ibin)=(6.*volume_a(ibin)/(num_a(ibin)*pi))**(1./3.)        ! [cm]
 859
 860
 861     ! Li and Lu (2001) surface tension model:
 862     !      sum_dum = 0.0
 863     !      do je = 1, nelectrolyte
 864     !        sum_dum = sum_dum + G_MX(je)*
 865     !     &                      alog(1./(1.+K_MX(je)*activity(je,ibin)))
 866     !      enddo
 867     !      sigma_soln(ibin) = sigma_water + 8.3144e7*T_K*sum_dum
 868
 869
 870     ! simpler correlation for solution surface tension:
 871     sigma_soln(ibin) = sigma_water + 49.0*(1. - aH2O_a(ibin))       ! [dyn/cm]
 872
 873
 874
 875     term = 72.*sigma_soln(ibin)/(8.3144e7*T_K*DpmV(ibin))           ! [-]
 876 !    kelvin(ibin) = exp(term)
 877     kelvin(ibin) = 1. + term*(1. + 0.5*term*(1. + term/3.))
 878
 879
 880     return
 881   end subroutine calculate_kelvin
 882
 883
 884
 885   !***********************************************************************
 886   ! computes sulfate ratio
 887   !
 888   ! author: Rahul A. Zaveri
 889   ! update: dec 1999
 890   !-----------------------------------------------------------------------
 891   subroutine calculate_XT(ibin,jp,XT,aer)
 892     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,                         &
 893          imsa_a,iso4_a,ica_a,ina_a,inh4_a
 894
 895     implicit none
 896
 897     ! subr arguments
 898     integer, intent(in) :: ibin, jp
 899     real(r8), intent(inout) :: XT
 900     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
 901
 902
 903     if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
 904        XT   = ( aer(inh4_a,jp,ibin) +   &
 905             aer(ina_a,jp,ibin)  +   &
 906             2.*aer(ica_a,jp,ibin) )/   &
 907             (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
 908     else
 909        XT   = -1.0
 910     endif
 911
 912
 913     return
 914   end subroutine calculate_XT
 915
 916
 917
 918   !***********************************************************************
 919   ! called when aerosol bin is completely solid.
 920   !
 921   ! author: Rahul A. Zaveri
 922   ! update: jan 2005
 923   !-----------------------------------------------------------------------
 924   subroutine adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,  &
 925        water_a)
 926
 927     use module_data_mosaic_aero, only: r8,nbin_a_max,naer,nelectrolyte,jsolid,     &!Parameters
 928          jhyst_lo,jtotal,jliquid,                                                  &!Parameters
 929          inh4_a,ino3_a,icl_a                                                        !TBD
 930
 931     implicit none
 932
 933     ! subr arguments
 934     integer, intent(in) :: ibin
 935     integer, intent(inout), dimension(nbin_a_max) :: jphase,jhyst_leg
 936     real(r8), intent(inout), dimension(nbin_a_max) :: water_a
 937     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
 938     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte,epercent
 939     ! local variables
 940     integer iaer, je
 941
 942
 943     jphase(ibin)    = jsolid
 944     jhyst_leg(ibin) = jhyst_lo   ! lower curve
 945     water_a(ibin)   = 0.0
 946
 947     ! transfer aer(jtotal) to aer(jsolid)
 948     do iaer = 1, naer
 949        aer(iaer, jsolid, ibin) = aer(iaer,jtotal,ibin)
 950        aer(iaer, jliquid,ibin) = 0.0
 951     enddo
 952
 953     ! transfer electrolyte(jtotal) to electrolyte(jsolid)
 954     do je = 1, nelectrolyte
 955        electrolyte(je,jliquid,ibin) = 0.0
 956        epercent(je,jliquid,ibin)    = 0.0
 957        electrolyte(je,jsolid,ibin)  = electrolyte(je,jtotal,ibin)
 958        epercent(je,jsolid,ibin)     = epercent(je,jtotal,ibin)
 959     enddo
 960
 961     ! update aer(jtotal) that may have been affected above
 962     aer(inh4_a,jtotal,ibin) = aer(inh4_a,jsolid,ibin)
 963     aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid,ibin)
 964     aer(icl_a,jtotal,ibin)  = aer(icl_a,jsolid,ibin)
 965
 966
 967     return
 968   end subroutine adjust_solid_aerosol
 969
 970
 971
 972   !***********************************************************************
 973   ! called when aerosol bin is completely liquid.
 974   !
 975   ! author: Rahul A. Zaveri
 976   ! update: jan 2005
 977   !-----------------------------------------------------------------------
 978   subroutine adjust_liquid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent) ! TOUCH
 979
 980     use module_data_mosaic_aero, only: r8,nbin_a_max,naer,nelectrolyte,jliquid,    &!Parameters
 981          jhyst_up,jsolid,jtotal,                                                   &!Parameters
 982          jcaco3,jcaso4,                                                            &
 983          inh4_a,ina_a,ica_a,imsa_a,icl_a,ino3_a,iso4_a
 984
 985     implicit none
 986
 987     ! subr arguments
 988     integer, intent(in) :: ibin
 989     integer, intent(inout), dimension(nbin_a_max) :: jphase,jhyst_leg
 990
 991     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
 992     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
 993     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: epercent
 994     ! local variables
 995     integer :: iaer, je
 996
 997     jphase(ibin)    = jliquid
 998     jhyst_leg(ibin) = jhyst_up   ! upper curve
 999
1000     ! partition all electrolytes into liquid phase
1001     do je = 1, nelectrolyte
1002        electrolyte(je,jsolid,ibin)  = 0.0
1003        epercent(je,jsolid,ibin)     = 0.0
1004        electrolyte(je,jliquid,ibin) = electrolyte(je,jtotal,ibin)
1005        epercent(je,jliquid,ibin)    = epercent(je,jtotal,ibin)
1006     enddo
1007     ! except these electrolytes, which always remain in the solid phase
1008     electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1009     electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1010     epercent(jcaco3,jsolid,ibin)    = epercent(jcaco3,jtotal,ibin)
1011     epercent(jcaso4,jsolid,ibin)    = epercent(jcaso4,jtotal,ibin)
1012     electrolyte(jcaco3,jliquid,ibin)= 0.0
1013     electrolyte(jcaso4,jliquid,ibin)= 0.0
1014     epercent(jcaco3,jliquid,ibin)   = 0.0
1015     epercent(jcaso4,jliquid,ibin)   = 0.0
1016
1017
1018     ! partition all the aer species into
1019     ! solid phase
1020     do iaer = 1, naer
1021     aer(iaer,jsolid,ibin)  = aer(iaer,jtotal,ibin)
1022     end do
1023     aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1024     aer(ino3_a,jsolid,ibin) = 0.0
1025     aer(icl_a,jsolid,ibin)  = 0.0
1026     aer(inh4_a,jsolid,ibin) = 0.0
1027     aer(imsa_a,jsolid,ibin) = 0.0
1028     aer(ina_a,jsolid,ibin)  = 0.0
1029     aer(ica_a,jsolid,ibin)  = electrolyte(jcaco3,jsolid,ibin) +   &
1030                               electrolyte(jcaso4,jsolid,ibin)
1031 !   aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1032 !   aer(ioc_a,jsolid,ibin)  = aer(ioc_a,jtotal,ibin)
1033 !   aer(ibc_a,  jsolid,ibin)= aer(ibc_a,  jtotal,ibin)
1034 !   aer(ioin_a, jsolid,ibin)= aer(ioin_a, jtotal,ibin)
1035 !   aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
1036 !   aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
1037 !   aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
1038 !   aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
1039 !   aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
1040 !   aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
1041 !   aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
1042 !   aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
1043
1044     ! liquid-phase
1045     do iaer = 1, naer
1046     aer(iaer,jliquid,ibin)  = 0.0
1047     end do
1048     aer(iso4_a,jliquid,ibin) = aer(iso4_a,jtotal,ibin) -   &
1049                                aer(iso4_a,jsolid,ibin)
1050     aer(iso4_a,jliquid,ibin) = max(0.d0, aer(iso4_a,jliquid,ibin)) ! RAZ 4/16/2014
1051     aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1052     aer(icl_a,jliquid,ibin)  = aer(icl_a,jtotal,ibin)
1053     aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1054     aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1055     aer(ina_a,jliquid,ibin)  = aer(ina_a,jtotal,ibin)
1056     aer(ica_a,jliquid,ibin)  = aer(ica_a,jtotal,ibin) -   &
1057                                aer(ica_a,jsolid,ibin)
1058     aer(ica_a,jliquid,ibin)  = max(0.d0, aer(ica_a,jliquid,ibin)) ! RAZ 4/16/2014
1059 !   aer(ico3_a,jliquid,ibin) = 0.0
1060 !   aer(ioc_a,jliquid,ibin)  = 0.0
1061 !   aer(ibc_a,  jliquid,ibin)= 0.0
1062 !   aer(ioin_a, jliquid,ibin)= 0.0
1063 !   aer(iaro1_a,jliquid,ibin)= 0.0
1064 !   aer(iaro2_a,jliquid,ibin)= 0.0
1065 !   aer(ialk1_a,jliquid,ibin)= 0.0
1066 !   aer(iole1_a,jliquid,ibin)= 0.0
1067 !   aer(iapi1_a,jliquid,ibin)= 0.0
1068 !   aer(iapi2_a,jliquid,ibin)= 0.0
1069 !   aer(ilim1_a,jliquid,ibin)= 0.0
1070 !   aer(ilim2_a,jliquid,ibin)= 0.0
1071
1072     return
1073   end subroutine adjust_liquid_aerosol
1074
1075
1076
1077   !***********************************************************************
1078   ! this subroutine completely deliquesces an aerosol and partitions
1079   ! all the soluble electrolytes into the liquid phase and insoluble
1080   ! ones into the solid phase. It also calculates the corresponding
1081   ! aer(js,jliquid,ibin) and aer(js,jsolid,ibin) generic species
1082   ! concentrations
1083   !
1084   ! author: Rahul A. Zaveri
1085   ! update: jan 2005
1086   !-----------------------------------------------------------------------
1087   subroutine do_full_deliquescence(ibin,aer,electrolyte)    ! TOUCH
1088     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,nelectrolyte,jtotal,jsolid, &!Parameters
1089          jliquid,                                                                     &!Parameters
1090          jcacl2,jcano3,ioin_a,jcaco3,jcaso4,                                          &
1091          inh4_a,ina_a,ica_a,imsa_a,icl_a,ino3_a,iso4_a
1092
1093
1094
1095     implicit none
1096
1097     ! subr arguments
1098     integer, intent(in) :: ibin
1099     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
1100     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
1101     ! local variables
1102     integer ::  iaer, js
1103
1104     ! partition all electrolytes into liquid phase
1105     do js = 1, nelectrolyte
1106        electrolyte(js,jsolid,ibin)  = 0.0
1107        electrolyte(js,jliquid,ibin) = electrolyte(js,jtotal,ibin)
1108     enddo
1109     !
1110     ! except these electrolytes, which always remain in the solid phase
1111     electrolyte(jcaco3,jsolid,ibin) = electrolyte(jcaco3,jtotal,ibin)
1112     electrolyte(jcaso4,jsolid,ibin) = electrolyte(jcaso4,jtotal,ibin)
1113     electrolyte(jcaco3,jliquid,ibin)= 0.0
1114     electrolyte(jcaso4,jliquid,ibin)= 0.0
1115
1116
1117     ! partition all the generic aer species into solid and liquid phases
1118     ! solid phase
1119     do iaer = 1, naer
1120     aer(iaer,jsolid,ibin)= aer(iaer,jtotal,ibin)
1121     end do
1122     aer(iso4_a,jsolid,ibin) = electrolyte(jcaso4,jsolid,ibin)
1123     aer(ino3_a,jsolid,ibin) = 0.0
1124     aer(icl_a, jsolid,ibin) = 0.0
1125     aer(inh4_a,jsolid,ibin) = 0.0
1126     aer(imsa_a,jsolid,ibin) = 0.0
1127     aer(ina_a, jsolid,ibin) = 0.0
1128     aer(ica_a, jsolid,ibin) = electrolyte(jcaco3,jsolid,ibin) +   &
1129                               electrolyte(jcaso4,jsolid,ibin)
1130 !   aer(ico3_a,jsolid,ibin) = aer(ico3_a,jtotal,ibin)
1131 !   aer(ioc_a, jsolid,ibin) = aer(ioc_a,jtotal,ibin)
1132 !   aer(ibc_a, jsolid,ibin) = aer(ibc_a,jtotal,ibin)
1133 !   aer(ioin_a,jsolid,ibin) = aer(ioin_a,jtotal,ibin)
1134 !   aer(iaro1_a,jsolid,ibin)= aer(iaro1_a,jtotal,ibin)
1135 !   aer(iaro2_a,jsolid,ibin)= aer(iaro2_a,jtotal,ibin)
1136 !   aer(ialk1_a,jsolid,ibin)= aer(ialk1_a,jtotal,ibin)
1137 !   aer(iole1_a,jsolid,ibin)= aer(iole1_a,jtotal,ibin)
1138 !   aer(iapi1_a,jsolid,ibin)= aer(iapi1_a,jtotal,ibin)
1139 !   aer(iapi2_a,jsolid,ibin)= aer(iapi2_a,jtotal,ibin)
1140 !   aer(ilim1_a,jsolid,ibin)= aer(ilim1_a,jtotal,ibin)
1141 !   aer(ilim2_a,jsolid,ibin)= aer(ilim2_a,jtotal,ibin)
1142
1143     ! liquid-phase
1144     do iaer = 1, naer
1145     aer(iaer,jliquid,ibin) = 0.0
1146     end do
1147     aer(iso4_a,jliquid,ibin) = max(0.0_r8, aer(iso4_a,jtotal,ibin) -   &
1148                                electrolyte(jcaso4,jsolid,ibin))      ! added max() RAZ 4/16/2014
1149     aer(ino3_a,jliquid,ibin) = aer(ino3_a,jtotal,ibin)
1150     aer(icl_a, jliquid,ibin) = aer(icl_a,jtotal,ibin)
1151     aer(inh4_a,jliquid,ibin) = aer(inh4_a,jtotal,ibin)
1152     aer(imsa_a,jliquid,ibin) = aer(imsa_a,jtotal,ibin)
1153     aer(ina_a, jliquid,ibin) = aer(ina_a,jtotal,ibin)
1154     aer(ica_a, jliquid,ibin) = electrolyte(jcano3,jtotal,ibin) +   &
1155                                electrolyte(jcacl2,jtotal,ibin)
1156 !   aer(ioc_a, jliquid,ibin) = 0.0
1157 !   aer(ico3_a,jliquid,ibin) = 0.0
1158 !   aer(ibc_a, jliquid,ibin) = 0.0
1159 !   aer(ioin_a,jliquid,ibin) = 0.0
1160 !   aer(iaro1_a,jliquid,ibin)= 0.0
1161 !   aer(iaro2_a,jliquid,ibin)= 0.0
1162 !   aer(ialk1_a,jliquid,ibin)= 0.0
1163 !   aer(iole1_a,jliquid,ibin)= 0.0
1164 !   aer(iapi1_a,jliquid,ibin)= 0.0
1165 !   aer(iapi2_a,jliquid,ibin)= 0.0
1166 !   aer(ilim1_a,jliquid,ibin)= 0.0
1167 !   aer(ilim2_a,jliquid,ibin)= 0.0
1168
1169     return
1170   end subroutine do_full_deliquescence
1171
1172
1173
1174   !***********************************************************************
1175   ! MESA: Multicomponent Equilibrium Solver for Aerosol-phase
1176   ! computes equilibrum solid and liquid phases by integrating
1177   ! pseudo-transient dissolution and precipitation reactions
1178   !
1179   ! author: Rahul A. Zaveri
1180   ! update: jan 2005
1181   ! Reference: Zaveri R.A., R.C. Easter, and L.K. Peters, JGR, 2005b
1182   !-----------------------------------------------------------------------
1183   subroutine MESA_PTC(ibin, jaerosolstate, jphase, aer, jhyst_leg,  &
1184        electrolyte, epercent, activity, mc, num_a, mass_dry_a, mass_wet_a, mass_soluble_a,    &
1185        vol_dry_a, vol_wet_a, water_a, aH2O, ma, gam,   &
1186        log_gamZ, zc, za, gam_ratio, xeq_a, na_Ma, nc_Mc, xeq_c, mw_electrolyte, mw_aer_mac,     &
1187        dens_aer_mac, Keq_sl, MW_c, MW_a, Keq_ll, growth_factor, molality0, rtol_mesa,         &
1188        jsalt_present, phi_salt_old,                                                &
1189        kappa_nonelectro, mosaic_vars_aa )                ! TOUCH
1190
1191     use module_data_mosaic_aero,  only: r8, nbin_a_max, nelectrolyte, Ncation, naer, nsalt,  &!Parameters
1192          jhyst_lo, mixed, all_liquid, jsolid, jliquid, jtotal, mYES,                         &!Parameters
1193          all_solid, Nanion, nrxn_aer_sl, nrxn_aer_ll,                                     &!Parameters
1194          ino3_a, iso4_a, ioc_a, ilim1_a, ilim2_a, inh4_a, ina_a, ica_a, ico3_a, imsa_a, icl_a, &
1195          mosaic_vars_aa_type
1196
1197     implicit none
1198
1199     ! subr arguments
1200     integer, intent(in) :: ibin
1201     integer, intent(inout), dimension(nsalt) :: jsalt_present
1202     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase,jhyst_leg
1203
1204     real(r8), intent(in) :: aH2O,rtol_mesa
1205     real(r8), intent(in), dimension(naer) :: mw_aer_mac,dens_aer_mac
1206     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
1207     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
1208     real(r8), intent(in), dimension(Nanion)  :: za,MW_a
1209     real(r8), intent(inout), dimension(Nanion)  :: xeq_a,na_Ma
1210     real(r8), intent(inout), dimension(nbin_a_max) :: num_a,mass_dry_a,mass_wet_a
1211     real(r8), intent(inout), dimension(nbin_a_max) :: mass_soluble_a,vol_dry_a
1212     real(r8), intent(inout), dimension(nbin_a_max) :: growth_factor
1213     real(r8), intent(inout), dimension(nbin_a_max) :: vol_wet_a,water_a,gam_ratio
1214     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
1215     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0 !BSINGH(05/23/2014) - Added dimension nbin_a_max
1216     real(r8), intent(inout), dimension(nrxn_aer_sl) :: Keq_sl
1217     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
1218     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
1219     real(r8), intent(inout), dimension(nelectrolyte,nelectrolyte) :: log_gamZ
1220     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
1221     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
1222     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
1223     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
1224     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: epercent
1225     real(r8), intent(inout), dimension(nsalt) :: phi_salt_old
1226     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
1227
1228     type (mosaic_vars_aa_type), intent(inout) :: mosaic_vars_aa
1229
1230     ! local variables
1231     integer iaer, iconverge, iconverge_flux, iconverge_mass,   &
1232          idissolved, itdum, js, je, jp
1233
1234     real(r8) :: tau_p(nsalt), tau_d(nsalt)
1235     real(r8) :: frac_solid, sumflux, hsalt_min, alpha, XT, dumdum,   &
1236          H_ion
1237     real(r8) :: phi_prod, alpha_fac, sum_dum
1238     real(r8) :: aer_H,hsalt_max
1239     real(r8), dimension(nelectrolyte) :: eleliquid
1240     real(r8), dimension(nbin_a_max) :: mass_dry_salt
1241     real(r8), dimension(nsalt) :: phi_salt,flux_sl,phi_bar,alpha_salt
1242     real(r8), dimension(nsalt) :: sat_ratio,hsalt
1243
1244     ! function
1245     !real(r8) :: aerosol_water
1246
1247     ! initialize
1248     itdum = 0               ! initialize time
1249     hsalt_max = 1.e25
1250
1251
1252
1253     do js = 1, nsalt
1254        hsalt(js)     = 0.0
1255        sat_ratio(js) = 0.0
1256        phi_salt(js)  = 0.0
1257        flux_sl(js)   = 0.0
1258     enddo
1259
1260
1261
1262     !! EFFI calculate percent composition
1263     sum_dum = 0.0
1264     do je = 1, nelectrolyte
1265        sum_dum = sum_dum + electrolyte(je,jtotal,ibin)
1266     enddo
1267
1268     if(sum_dum .eq. 0.)sum_dum = 1.0
1269
1270     do je = 1, nelectrolyte
1271        epercent(je,jtotal,ibin) = 100.*electrolyte(je,jtotal,ibin)/sum_dum
1272     enddo
1273     !! EFFI
1274
1275
1276
1277     do js = 1, nsalt
1278        jsalt_present(js) = 0                        ! default value - salt absent
1279        if(epercent(js,jtotal,ibin) .gt. 1.0)then
1280           jsalt_present(js) = 1                     ! salt present
1281        endif
1282     enddo
1283
1284
1285     mass_dry_a(ibin) = 0.0
1286
1287     aer_H = (2.*aer(iso4_a,jtotal,ibin) +   &
1288          aer(ino3_a,jtotal,ibin) +   &
1289          aer(icl_a,jtotal,ibin)  +   &
1290          aer(imsa_a,jtotal,ibin) +   &
1291          2.*aer(ico3_a,jtotal,ibin))-   &
1292          (2.*aer(ica_a,jtotal,ibin)  +   &
1293          aer(ina_a,jtotal,ibin)  +   &
1294          aer(inh4_a,jtotal,ibin))
1295     aer_H = max(aer_H, 0.0d0)
1296
1297     do iaer = 1, naer
1298        mass_dry_a(ibin) = mass_dry_a(ibin) +   &
1299             aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)  ! [ng/m^3(air)]
1300        vol_dry_a(ibin)  = vol_dry_a(ibin) +   &
1301             aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)       ! ncc/m^3(air)
1302     enddo
1303     mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
1304     vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
1305
1306     mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                      ! [g/cc(air)]
1307     vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                                ! [cc(aer)/cc(air)]
1308
1309     mass_dry_salt(ibin) = 0.0               ! soluble salts only
1310     do je = 1, nsalt
1311        mass_dry_salt(ibin) = mass_dry_salt(ibin) +   &
1312             electrolyte(je,jtotal,ibin)*mw_electrolyte(je)*1.e-15   ! g/cc(air)
1313     enddo
1314
1315     mosaic_vars_aa%jMESA_call = mosaic_vars_aa%jMESA_call + 1
1316
1317     !----begin pseudo time continuation loop-------------------------------
1318
1319     do 500 itdum = 1, mosaic_vars_aa%Nmax_MESA
1320
1321
1322        ! compute new salt fluxes
1323        call MESA_flux_salt(ibin,jaerosolstate,jphase, aer,jhyst_leg,electrolyte, &
1324             epercent,activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a,aH2O,ma,&
1325             gam,log_gamZ,zc,za,gam_ratio,xeq_a,na_Ma,nc_Mc,xeq_c,mw_electrolyte, &
1326             Keq_sl,MW_c,MW_a,Keq_ll,eleliquid,flux_sl,phi_salt,sat_ratio,        &
1327             molality0,jsalt_present,kappa_nonelectro)
1328
1329
1330        ! check convergence
1331        call MESA_convergence_criterion(ibin,iconverge_mass,iconverge_flux,idissolved, &
1332             aer,electrolyte,mass_dry_a,mass_dry_salt,mw_electrolyte,mw_aer_mac, &
1333             flux_sl,phi_salt,rtol_mesa)
1334
1335        if(iconverge_mass .eq. mYES)then
1336           mosaic_vars_aa%iter_MESA(ibin) = mosaic_vars_aa%iter_MESA(ibin) + itdum
1337           mosaic_vars_aa%niter_MESA = mosaic_vars_aa%niter_MESA + float(itdum)
1338           mosaic_vars_aa%niter_MESA_max = max( mosaic_vars_aa%niter_MESA_max, itdum)
1339           jaerosolstate(ibin) = all_solid
1340           call adjust_solid_aerosol(ibin,jphase,aer,jhyst_leg,electrolyte,epercent,   &
1341                water_a)
1342           jhyst_leg(ibin) = jhyst_lo
1343           growth_factor(ibin) = 1.0
1344           return
1345        elseif(iconverge_flux .eq. mYES)then
1346           mosaic_vars_aa%iter_MESA(ibin) = mosaic_vars_aa%iter_MESA(ibin) + itdum
1347           mosaic_vars_aa%niter_MESA = mosaic_vars_aa%niter_MESA + float(itdum)
1348           mosaic_vars_aa%niter_MESA_max = max( mosaic_vars_aa%niter_MESA_max, itdum)
1349           jaerosolstate(ibin) = mixed
1350           vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3          ! cc(aer)/cc(air) or m^3/m^3(air)
1351           growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)           ! mass growth factor
1352
1353           if(idissolved .eq. myes)then
1354              jaerosolstate(ibin) = all_liquid
1355              !          jhyst_leg(ibin) = jhyst_up  ! ! do this later (to avoid tripping kelvin iterations)
1356           else
1357              jaerosolstate(ibin) = mixed
1358              jhyst_leg(ibin) = jhyst_lo
1359           endif
1360
1361           ! calculate epercent(jsolid) composition in mixed-phase aerosol EFFI
1362           !!        sum_dum = 0.0
1363           !!        jp = jsolid
1364           !!        do je = 1, nelectrolyte
1365           !!          electrolyte(je,jp,ibin) = max(0.d0,electrolyte(je,jp,ibin)) ! remove -ve
1366           !!          sum_dum = sum_dum + electrolyte(je,jp,ibin)
1367           !!        enddo
1368           !!        electrolyte_sum(jp,ibin) = sum_dum
1369           !!        if(sum_dum .eq. 0.)sum_dum = 1.0
1370           !!        do je = 1, nelectrolyte
1371           !!          epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
1372           !!        enddo
1373
1374           return
1375        endif
1376
1377        ! calculate hsalt(js)        ! time step
1378        hsalt_min = 1.e25
1379
1380        do js = 1, nsalt
1381
1382           phi_prod = phi_salt(js) * phi_salt_old(js)
1383
1384           if(itdum .gt. 1 .and. phi_prod .gt. 0.0)then
1385              phi_bar(js) = (abs(phi_salt(js))-abs(phi_salt_old(js)))/   &
1386                   alpha_salt(js)
1387           else
1388              phi_bar(js) = 0.0                      ! oscillating, or phi_salt and/or phi_salt_old may be zero
1389           endif
1390
1391           if(phi_bar(js) .lt. 0.0)then              ! good. phi getting lower. maybe able to take bigger alphas
1392              phi_bar(js) = max(phi_bar(js), -10.0d0)
1393              alpha_fac = 3.0*exp(phi_bar(js))
1394              alpha_salt(js) = min(alpha_fac*abs(phi_salt(js)), 0.9d0)
1395           elseif(phi_bar(js) .gt. 0.0)then  ! bad - phi is getting bigger. so be conservative with alpha
1396              alpha_salt(js) = min(abs(phi_salt(js)), 0.5d0)
1397           else                                      ! very bad - phi is oscillating. be very conservative
1398              alpha_salt(js) = min(abs(phi_salt(js))/3.0d0, 0.5d0)
1399           endif
1400
1401           !        alpha_salt(js) = max(alpha_salt(js), 0.01)
1402
1403           phi_salt_old(js) = phi_salt(js)           ! update old array
1404
1405
1406           if(flux_sl(js) .gt. 0.)then
1407
1408              tau_p(js) = eleliquid(js)/flux_sl(js)  ! precipitation time scale
1409              if(tau_p(js) .eq. 0.0)then
1410                 hsalt(js) = 1.e25
1411                 flux_sl(js) = 0.0
1412                 phi_salt(js)= 0.0
1413              else
1414                 hsalt(js) = alpha_salt(js)*tau_p(js)
1415              endif
1416
1417           elseif(flux_sl(js) .lt. 0.)then
1418
1419              tau_p(js) = -eleliquid(js)/flux_sl(js) ! precipitation time scale
1420              tau_d(js) = -electrolyte(js,jsolid,ibin)/flux_sl(js) ! dissolution time scale
1421              if(tau_p(js) .eq. 0.0)then
1422                 hsalt(js) = alpha_salt(js)*tau_d(js)
1423              else
1424                 hsalt(js) = alpha_salt(js)*min(tau_p(js),tau_d(js))
1425              endif
1426
1427           else
1428
1429              hsalt(js) = 1.e25
1430
1431           endif
1432
1433           hsalt_min = min(hsalt(js), hsalt_min)
1434
1435        enddo
1436
1437        !---------------------------------
1438
1439        ! integrate electrolyte(solid)
1440        do js = 1, nsalt
1441           electrolyte(js,jsolid,ibin) = (   &
1442                (electrolyte(js,jsolid,ibin))  +   &
1443                (hsalt(js)) * (flux_sl(js)) )
1444        enddo
1445
1446
1447        ! compute aer(solid) from electrolyte(solid)
1448        call electrolytes_to_ions(jsolid,ibin,aer,electrolyte)
1449
1450
1451        ! compute new electrolyte(liquid) from mass balance
1452        do iaer = 1, naer
1453           aer(iaer,jliquid,ibin) = ( (aer(iaer,jtotal,ibin)) -   &
1454                (aer(iaer,jsolid,ibin)) )
1455        enddo
1456
1457        !---------------------------------
1458
1459
1460
1461 500 continue     ! end time continuation loop
1462     !--------------------------------------------------------------------
1463     mosaic_vars_aa%jMESA_fail = mosaic_vars_aa%jMESA_fail + 1
1464     mosaic_vars_aa%iter_MESA(ibin) = mosaic_vars_aa%iter_MESA(ibin) + itdum
1465     mosaic_vars_aa%niter_MESA = mosaic_vars_aa%niter_MESA + float(itdum)
1466     jaerosolstate(ibin) = mixed
1467     jhyst_leg(ibin) = jhyst_lo
1468     mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3    ! g/cc(air)
1469     vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3     ! cc(aer)/cc(air) or m^3/m^3(air)
1470     growth_factor(ibin) = mass_wet_a(ibin)/mass_dry_a(ibin)      ! mass growth factor
1471
1472     return
1473   end subroutine MESA_PTC
1474
1475
1476
1477   !***********************************************************************
1478   ! part of MESA: calculates solid-liquid fluxes of soluble salts
1479   !
1480   ! author: Rahul A. Zaveri
1481   ! update: jan 2005
1482   !-----------------------------------------------------------------------
1483   subroutine MESA_flux_salt(ibin, jaerosolstate,jphase,aer,jhyst_leg,electrolyte,  &
1484        epercent,activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a,aH2O,ma,gam,   &
1485        log_gamZ,zc,za,gam_ratio,xeq_a,na_Ma,nc_Mc,xeq_c,mw_electrolyte,Keq_sl,MW_c,&
1486        MW_a,Keq_ll,eleliquid,flux_sl,phi_salt,sat_ratio,molality0,jsalt_present,   &
1487        kappa_nonelectro                                                            )      ! TOUCH
1488
1489     use module_data_mosaic_aero, only: r8,nbin_a_max,nelectrolyte,Ncation,naer,    &!Parameters
1490          jliquid,nsalt,jsolid,Nanion,nrxn_aer_sl,nrxn_aer_ll,nrxn_aer_sl,          &!Parameter
1491          jna3hso4,ica_a,jcano3,jcacl2                                               !TBD
1492
1493     implicit none
1494
1495     ! subr arguments
1496     integer, intent(in) :: ibin
1497     integer, intent(inout), dimension(nsalt) :: jsalt_present
1498     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase,jhyst_leg
1499
1500     real(r8), intent(in) :: aH2O
1501     real(r8), intent(inout), dimension(nsalt) :: flux_sl,phi_salt,sat_ratio
1502     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
1503     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
1504     real(r8), intent(in), dimension(Nanion)  :: za,MW_a
1505     real(r8), intent(inout), dimension(Nanion)  :: xeq_a,na_Ma
1506     real(r8), intent(inout), dimension(nbin_a_max) :: num_a,mass_dry_a,gam_ratio
1507     real(r8), intent(inout), dimension(nbin_a_max) :: mass_soluble_a,water_a
1508     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
1509     real(r8), intent(inout), dimension(nelectrolyte) :: eleliquid
1510     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0 !BSINGH(05/23/2014) - Added dimension nbin_a_max
1511     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
1512     real(r8), intent(inout), dimension(nrxn_aer_sl) :: Keq_sl
1513     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
1514     real(r8), intent(inout), dimension(nelectrolyte,nelectrolyte) :: log_gamZ
1515     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
1516     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
1517     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
1518     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte,epercent
1519     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
1520
1521     ! local variables
1522     integer js, je
1523     real(r8) :: XT, calcium, sum_salt, sum_dum !**BALLI XT should it be subr arg??
1524     real(r8), dimension(nsalt) :: frac_salt_liq,frac_salt_solid
1525
1526
1527     ! compute activities and water content
1528     call ions_to_electrolytes(jliquid,ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,   &
1529          nc_Mc,xeq_c,mw_electrolyte,MW_c,MW_a)
1530     call compute_activities(ibin,jaerosolstate,jphase,aer,jhyst_leg,electrolyte,   &
1531          activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a,aH2O,ma,gam,log_gamZ, &
1532          gam_ratio,Keq_ll,molality0,kappa_nonelectro)
1533     activity(jna3hso4,ibin)   = 0.0
1534
1535     if(water_a(ibin) .le. 0.0)then
1536        do js = 1, nsalt
1537           flux_sl(js) = 0.0
1538        enddo
1539        return
1540     endif
1541
1542
1543     call MESA_estimate_eleliquid(ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,nc_Mc,  &
1544          xeq_c,mw_electrolyte,MW_c,MW_a,eleliquid)
1545
1546     calcium = aer(ica_a,jliquid,ibin)
1547
1548
1549
1550     !! EFFI calculate percent composition
1551     sum_dum = 0.0
1552     do je = 1, nelectrolyte
1553        sum_dum = sum_dum + electrolyte(je,jliquid,ibin)
1554     enddo
1555
1556     if(sum_dum .eq. 0.)sum_dum = 1.0
1557
1558     do je = 1, nelectrolyte
1559        epercent(je,jliquid,ibin) = 100.*electrolyte(je,jliquid,ibin)/sum_dum
1560     enddo
1561     !! EFFI
1562
1563
1564
1565     ! calculate % electrolyte composition in the solid and liquid phases
1566     sum_salt = 0.0
1567     do js = 1, nsalt
1568        sum_salt = sum_salt + electrolyte(js,jsolid,ibin)
1569     enddo
1570
1571     if(sum_salt .eq. 0.0)sum_salt = 1.0
1572     do js = 1, nsalt
1573        frac_salt_solid(js) = electrolyte(js,jsolid,ibin)/sum_salt
1574        frac_salt_liq(js)   = epercent(js,jliquid,ibin)/100.
1575     enddo
1576
1577     ! compute salt fluxes
1578     do js = 1, nsalt             ! soluble solid salts
1579
1580        ! compute new saturation ratio
1581        sat_ratio(js) = activity(js,ibin)/Keq_sl(js)
1582        ! compute relative driving force
1583        phi_salt(js)  = (sat_ratio(js) - 1.0)/max(sat_ratio(js),1.0d0)
1584
1585        ! check if too little solid-phase salt is trying to dissolve
1586        if(sat_ratio(js)       .lt. 1.00 .and.   &
1587             frac_salt_solid(js) .lt. 0.01 .and.   &
1588             frac_salt_solid(js) .gt. 0.0)then
1589           call MESA_dissolve_small_salt(ibin,js,aer,electrolyte)
1590           call MESA_estimate_eleliquid(ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,  &
1591                nc_Mc,xeq_c,mw_electrolyte,MW_c,MW_a,eleliquid)
1592           sat_ratio(js) = activity(js,ibin)/Keq_sl(js)
1593        endif
1594
1595        ! compute flux
1596        flux_sl(js) = sat_ratio(js) - 1.0
1597
1598        ! apply Heaviside function
1599        if( (sat_ratio(js)               .lt. 1.0 .and.   &
1600             electrolyte(js,jsolid,ibin) .eq. 0.0) .or.   &
1601             (calcium .gt. 0.0 .and. frac_salt_liq(js).lt.0.01).or.   &
1602             (calcium .gt. 0.0 .and. jsalt_present(js).eq.0) )then
1603           flux_sl(js) = 0.0
1604           phi_salt(js)= 0.0
1605        endif
1606
1607     enddo
1608
1609
1610     ! force cacl2 and cano3 fluxes to zero
1611     sat_ratio(jcano3) = 1.0
1612     phi_salt(jcano3)  = 0.0
1613     flux_sl(jcano3)   = 0.0
1614
1615     sat_ratio(jcacl2) = 1.0
1616     phi_salt(jcacl2)  = 0.0
1617     flux_sl(jcacl2)   = 0.0
1618
1619
1620     return
1621   end subroutine MESA_flux_salt
1622
1623  !***********************************************************************
1624   ! computes activities
1625   !
1626   ! author: Rahul A. Zaveri
1627   ! update: jan 2007
1628   !-----------------------------------------------------------------------
1629   subroutine compute_activities(ibin,jaerosolstate,jphase,aer,jhyst_leg,           &
1630        electrolyte,activity,mc,num_a,mass_dry_a,mass_soluble_a,water_a,aH2O,ma,gam,&
1631        log_gamZ,gam_ratio,Keq_ll,molality0,kappa_nonelectro)
1632
1633     use module_data_mosaic_aero, only: r8,nbin_a_max,nelectrolyte,Ncation,naer,    &
1634          jliquid,Nanion,nrxn_aer_ll,                                               &
1635          iso4_a,ja_so4,ja_hso4,ino3_a,ja_no3,icl_a,ja_cl,imsa_a,ja_msa,ica_a,jc_ca,&
1636          inh4_a,jc_nh4,ina_a,jc_na,jc_h,jhcl,jhno3,jcacl2,jcano3,jnacl,jnano3,     &
1637          jna2so4,jnh4so4,jnh4cl,jnh4no3,jlvcite,jnh4hso4,jnh4msa,jna3hso4,jnahso4, &
1638          jnamsa,jcamsa2,jh2so4,jhhso4,jmsa                                          !TBD
1639
1640     implicit none
1641
1642     ! subr arguments
1643     integer, intent(in) :: ibin
1644     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase,jhyst_leg
1645
1646     real(r8), intent(in) :: aH2O
1647     real(r8), intent(in), dimension(nbin_a_max) :: num_a
1648     real(r8), intent(inout), dimension(nbin_a_max) :: mass_dry_a,mass_soluble_a
1649     real(r8), intent(inout), dimension(nbin_a_max) :: water_a,gam_ratio
1650     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
1651     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0 !BSINGH(05/23/2014) - Added dimension nbin_a_max
1652     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
1653     real(r8), intent(inout), dimension(nelectrolyte,nelectrolyte) :: log_gamZ
1654     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
1655     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
1656     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
1657     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
1658     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
1659
1660     ! local variables
1661     real(r8), dimension(nelectrolyte) :: log_gam
1662     integer jp, jA
1663     real(r8) :: XT, xmol(Nelectrolyte), sum_elec, dumK, c_bal, a_c !BALLI** should xt be subr arg??
1664     real(r8) :: quad, aq, bq, cq, xq, dum, mSULF
1665     !real(r8) :: aerosol_water     ! mosaic function
1666
1667
1668     water_a(ibin) = aerosol_water(jliquid,ibin,jaerosolstate,jphase, &
1669          jhyst_leg,electrolyte,aer,kappa_nonelectro,num_a,mass_dry_a,mass_soluble_a,aH2O, &
1670          molality0)      ! Kg/m^3(air)
1671     if(water_a(ibin) .eq. 0.0)return
1672
1673
1674     call calculate_XT(ibin,jliquid,XT,aer)
1675
1676
1677     if(XT.ge.2.0 .or. XT.lt.0.)then   ! changed .gt. to .ge.   RAZ 4/16/2014
1678        ! SULFATE POOR: fully dissociated electrolytes
1679
1680
1681        ! anion molalities (mol/kg water)
1682        ma(ja_so4,ibin)  = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
1683        ma(ja_hso4,ibin) = 0.0
1684        ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
1685        ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
1686        ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
1687
1688        ! cation molalities (mol/kg water)
1689        mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
1690        mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
1691        mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
1692        a_c              = (   &
1693             (2.*ma(ja_so4,ibin)+   &
1694             ma(ja_no3,ibin)+   &
1695             ma(ja_cl,ibin) +   &
1696             ma(ja_msa,ibin)) -   &
1697             (2.*mc(jc_ca,ibin) +   &
1698             mc(jc_nh4,ibin)+   &
1699             mc(jc_na,ibin)) )
1700
1701        mc(jc_h,ibin) = 0.5*( (a_c) +   &
1702             (sqrt(a_c**2 + 4.*Keq_ll(3))) )
1703
1704        if(mc(jc_h,ibin) .le. 0.0)then   ! changed .eq. to .le. RAZ 4/16/2014
1705           mc(jc_h,ibin) = 1.e-10
1706        endif
1707
1708
1709        jp = jliquid
1710
1711
1712        sum_elec = 2.*electrolyte(jnh4no3,jp,ibin) +   &
1713             2.*electrolyte(jnh4cl,jp,ibin)  +   &
1714             3.*electrolyte(jnh4so4,jp,ibin) +   &
1715             3.*electrolyte(jna2so4,jp,ibin) +   &
1716             2.*electrolyte(jnano3,jp,ibin)  +   &
1717             2.*electrolyte(jnacl,jp,ibin)   +   &
1718             3.*electrolyte(jcano3,jp,ibin)  +   &
1719             3.*electrolyte(jcacl2,jp,ibin)  +   &
1720             2.*electrolyte(jhno3,jp,ibin)   +   &
1721             2.*electrolyte(jhcl,jp,ibin)
1722
1723        if(sum_elec .eq. 0.0)then
1724           do jA = 1, nelectrolyte
1725              gam(jA,ibin) = 1.0
1726           enddo
1727           goto 10
1728        endif
1729
1730
1731        ! ionic mole fractions
1732        xmol(jnh4no3) = 2.*electrolyte(jnh4no3,jp,ibin)/sum_elec
1733        xmol(jnh4cl)  = 2.*electrolyte(jnh4cl,jp,ibin) /sum_elec
1734        xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
1735        xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
1736        xmol(jnano3)  = 2.*electrolyte(jnano3,jp,ibin) /sum_elec
1737        xmol(jnacl)   = 2.*electrolyte(jnacl,jp,ibin)  /sum_elec
1738        xmol(jcano3)  = 3.*electrolyte(jcano3,jp,ibin) /sum_elec
1739        xmol(jcacl2)  = 3.*electrolyte(jcacl2,jp,ibin) /sum_elec
1740        xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)  /sum_elec
1741        xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)   /sum_elec
1742
1743
1744        jA = jnh4so4
1745        if(xmol(jA).gt.0.0)then
1746           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1747                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1748                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1749                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1750                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1751                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1752                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1753                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1754                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1755                xmol(jhcl)   *log_gamZ(jA,jhcl)
1756           gam(jA,ibin) = 10.**log_gam(jA)
1757           activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2 * ma(ja_so4,ibin) *   &
1758                gam(jnh4so4,ibin)**3
1759        endif
1760
1761
1762
1763 ! RAZ 11/7/2014
1764 ! always calculate gam(jnh4no3), even if xmol(jnh4no3) = 0. this to calculate gam_ratio
1765        jA = jnh4no3
1766 !      if(xmol(jA).gt.0.0)then
1767           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1768                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1769                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1770                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1771                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1772                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1773                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1774                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1775                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1776                xmol(jhcl)   *log_gamZ(jA,jhcl)
1777           gam(jA,ibin) = 10.**log_gam(jA)
1778           activity(jnh4no3,ibin) = mc(jc_nh4,ibin) * ma(ja_no3,ibin) *   &
1779                gam(jnh4no3,ibin)**2
1780 !      endif
1781
1782
1783        jA = jnh4cl
1784        if(xmol(jA).gt.0.0)then
1785           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1786                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1787                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1788                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1789                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1790                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1791                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1792                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1793                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1794                xmol(jhcl)   *log_gamZ(jA,jhcl)
1795           gam(jA,ibin) = 10.**log_gam(jA)
1796           activity(jnh4cl,ibin)  = mc(jc_nh4,ibin) * ma(ja_cl,ibin) *   &
1797                gam(jnh4cl,ibin)**2
1798        endif
1799
1800
1801        jA = jna2so4
1802        if(xmol(jA).gt.0.0)then
1803           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1804                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1805                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1806                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1807                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1808                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1809                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1810                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1811                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1812                xmol(jhcl)   *log_gamZ(jA,jhcl)
1813           gam(jA,ibin) = 10.**log_gam(jA)
1814           activity(jna2so4,ibin) = mc(jc_na,ibin)**2 * ma(ja_so4,ibin) *   &
1815                gam(jna2so4,ibin)**3
1816        endif
1817
1818
1819        jA = jnano3
1820        if(xmol(jA).gt.0.0)then
1821           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1822                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1823                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1824                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1825                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1826                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1827                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1828                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1829                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1830                xmol(jhcl)   *log_gamZ(jA,jhcl)
1831           gam(jA,ibin) = 10.**log_gam(jA)
1832           activity(jnano3,ibin)  = mc(jc_na,ibin) * ma(ja_no3,ibin) *   &
1833                gam(jnano3,ibin)**2
1834        endif
1835
1836
1837
1838        jA = jnacl
1839        if(xmol(jA).gt.0.0)then
1840           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1841                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1842                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1843                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1844                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1845                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1846                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1847                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1848                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1849                xmol(jhcl)   *log_gamZ(jA,jhcl)
1850           gam(jA,ibin) = 10.**log_gam(jA)
1851           activity(jnacl,ibin)   = mc(jc_na,ibin) * ma(ja_cl,ibin) *   &
1852                gam(jnacl,ibin)**2
1853        endif
1854
1855
1856
1857        !c      jA = jcano3
1858        !c      if(xmol(jA).gt.0.0)then
1859        !c      gam(jA,ibin) = 1.0
1860        !c      activity(jcano3,ibin)  = 1.0
1861        !c      endif
1862
1863
1864
1865        !c      jA = jcacl2
1866        !c      if(xmol(jA).gt.0.0)then
1867        !c      gam(jA,ibin) = 1.0
1868        !c      activity(jcacl2,ibin)  = 1.0
1869        !c      endif
1870
1871        jA = jcano3
1872        if(xmol(jA).gt.0.0)then
1873           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1874                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1875                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1876                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1877                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1878                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1879                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1880                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1881                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1882                xmol(jhcl)   *log_gamZ(jA,jhcl)
1883           gam(jA,ibin) = 10.**log_gam(jA)
1884           activity(jcano3,ibin)  = mc(jc_ca,ibin) * ma(ja_no3,ibin)**2 *   &
1885                gam(jcano3,ibin)**3
1886        endif
1887
1888
1889
1890        jA = jcacl2
1891        if(xmol(jA).gt.0.0)then
1892           log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1893                xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1894                xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1895                xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1896                xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1897                xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1898                xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1899                xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1900                xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1901                xmol(jhcl)   *log_gamZ(jA,jhcl)
1902           gam(jA,ibin) = 10.**log_gam(jA)
1903           activity(jcacl2,ibin)  = mc(jc_ca,ibin) * ma(ja_cl,ibin)**2 *   &
1904                gam(jcacl2,ibin)**3
1905        endif
1906
1907
1908        jA = jhno3
1909        log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1910             xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1911             xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1912             xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1913             xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1914             xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1915             xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1916             xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1917             xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1918             xmol(jhcl)   *log_gamZ(jA,jhcl)
1919        gam(jA,ibin) = 10.**log_gam(jA)
1920        activity(jhno3,ibin)   = mc(jc_h,ibin) * ma(ja_no3,ibin) *   &
1921             gam(jhno3,ibin)**2
1922
1923
1924        jA = jhcl
1925        log_gam(jA) = xmol(jnh4no3)*log_gamZ(jA,jnh4no3) +   &
1926             xmol(jnh4cl) *log_gamZ(jA,jnh4cl)  +   &
1927             xmol(jnh4so4)*log_gamZ(jA,jnh4so4) +   &
1928             xmol(jna2so4)*log_gamZ(jA,jna2so4) +   &
1929             xmol(jnano3) *log_gamZ(jA,jnano3)  +   &
1930             xmol(jnacl)  *log_gamZ(jA,jnacl)   +   &
1931             xmol(jcano3) *log_gamZ(jA,jcano3)  +   &
1932             xmol(jcacl2) *log_gamZ(jA,jcacl2)  +   &
1933             xmol(jhno3)  *log_gamZ(jA,jhno3)   +   &
1934             xmol(jhcl)   *log_gamZ(jA,jhcl)
1935        gam(jA,ibin) = 10.**log_gam(jA)
1936        activity(jhcl,ibin)    = mc(jc_h,ibin) * ma(ja_cl,ibin) *   &
1937             gam(jhcl,ibin)**2
1938
1939        !----
1940 10     gam(jlvcite,ibin) = 1.0
1941
1942        gam(jnh4hso4,ibin)= 1.0
1943
1944        gam(jnh4msa,ibin) = 1.0
1945
1946        gam(jna3hso4,ibin) = 1.0
1947
1948        gam(jnahso4,ibin) = 1.0
1949
1950        gam(jnamsa,ibin)  = 1.0
1951
1952        gam(jcamsa2,ibin) = 1.0
1953
1954        activity(jlvcite,ibin) = 0.0
1955
1956        activity(jnh4hso4,ibin)= 0.0
1957
1958        activity(jnh4msa,ibin) = mc(jc_nh4,ibin) * ma(ja_msa,ibin) *   &
1959             gam(jnh4msa,ibin)**2
1960
1961        activity(jna3hso4,ibin)= 0.0
1962
1963        activity(jnahso4,ibin) = 0.0
1964
1965        activity(jnamsa,ibin) = mc(jc_na,ibin) * ma(ja_msa,ibin) *   &
1966             gam(jnamsa,ibin)**2
1967
1968        activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 *   &
1969             gam(jcamsa2,ibin)**3
1970
1971        gam_ratio(ibin) = gam(jnh4no3,ibin)**2/gam(jhno3,ibin)**2
1972
1973
1974     else
1975        !  SULFATE-RICH: solve for SO4= and HSO4- ions
1976
1977        jp = jliquid
1978
1979        sum_elec = 3.*electrolyte(jh2so4,jp,ibin)    +   &
1980             2.*electrolyte(jnh4hso4,jp,ibin)  +   &
1981             5.*electrolyte(jlvcite,jp,ibin)   +   &
1982             3.*electrolyte(jnh4so4,jp,ibin)   +   &
1983             2.*electrolyte(jnahso4,jp,ibin)   +   &
1984             5.*electrolyte(jna3hso4,jp,ibin)  +   &
1985             3.*electrolyte(jna2so4,jp,ibin)   +   &
1986             2.*electrolyte(jhno3,jp,ibin)     +   &
1987             2.*electrolyte(jhcl,jp,ibin)
1988
1989
1990        if(sum_elec .eq. 0.0)then
1991           do jA = 1, nelectrolyte
1992              gam(jA,ibin) = 1.0
1993           enddo
1994           goto 20
1995        endif
1996
1997
1998        xmol(jh2so4)  = 3.*electrolyte(jh2so4,jp,ibin)/sum_elec
1999        xmol(jnh4hso4)= 2.*electrolyte(jnh4hso4,jp,ibin)/sum_elec
2000        xmol(jlvcite) = 5.*electrolyte(jlvcite,jp,ibin)/sum_elec
2001        xmol(jnh4so4) = 3.*electrolyte(jnh4so4,jp,ibin)/sum_elec
2002        xmol(jnahso4) = 2.*electrolyte(jnahso4,jp,ibin)/sum_elec
2003        xmol(jna3hso4)= 5.*electrolyte(jna3hso4,jp,ibin)/sum_elec
2004        xmol(jna2so4) = 3.*electrolyte(jna2so4,jp,ibin)/sum_elec
2005        xmol(jhno3)   = 2.*electrolyte(jhno3,jp,ibin)/sum_elec
2006        xmol(jhcl)    = 2.*electrolyte(jhcl,jp,ibin)/sum_elec
2007
2008
2009        ! 2H.SO4
2010        jA = jh2so4
2011        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2012             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2013             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2014             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2015             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2016             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2017             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2018             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2019             xmol(jhcl)    *log_gamZ(jA,jhcl)
2020        gam(jA,ibin) = 10.**log_gam(jA)
2021
2022
2023        ! H.HSO4
2024        jA = jhhso4
2025        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2026             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2027             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2028             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2029             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2030             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2031             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2032             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2033             xmol(jhcl)    *log_gamZ(jA,jhcl)
2034        gam(jA,ibin) = 10.**log_gam(jA)
2035
2036
2037        ! NH4HSO4
2038        jA = jnh4hso4
2039        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2040             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2041             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2042             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2043             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2044             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2045             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2046             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2047             xmol(jhcl)    *log_gamZ(jA,jhcl)
2048        gam(jA,ibin) = 10.**log_gam(jA)
2049
2050
2051        ! LETOVICITE
2052        jA = jlvcite
2053        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2054             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2055             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2056             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2057             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2058             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2059             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2060             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2061             xmol(jhcl)    *log_gamZ(jA,jhcl)
2062        gam(jA,ibin) = 10.**log_gam(jA)
2063
2064
2065        ! (NH4)2SO4
2066        jA = jnh4so4
2067        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2068             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2069             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2070             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2071             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2072             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2073             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2074             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2075             xmol(jhcl)    *log_gamZ(jA,jhcl)
2076        gam(jA,ibin) = 10.**log_gam(jA)
2077
2078
2079        ! NaHSO4
2080        jA = jnahso4
2081        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2082             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2083             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2084             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2085             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2086             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2087             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2088             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2089             xmol(jhcl)    *log_gamZ(jA,jhcl)
2090        gam(jA,ibin) = 10.**log_gam(jA)
2091
2092
2093        ! Na3H(SO4)2
2094        jA = jna3hso4
2095        !      log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +
2096        !     &              xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+
2097        !     &              xmol(jlvcite) *log_gamZ(jA,jlvcite) +
2098        !     &              xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +
2099        !     &              xmol(jnahso4) *log_gamZ(jA,jnahso4) +
2100        !     &              xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+
2101        !     &              xmol(jna2so4) *log_gamZ(jA,jna2so4) +
2102        !     &              xmol(jhno3)   *log_gamZ(jA,jhno3)   +
2103        !     &              xmol(jhcl)    *log_gamZ(jA,jhcl)
2104        !      gam(jA,ibin) = 10.**log_gam(jA)
2105        gam(jA,ibin) = 1.0
2106
2107
2108        ! Na2SO4
2109        jA = jna2so4
2110        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2111             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2112             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2113             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2114             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2115             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2116             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2117             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2118             xmol(jhcl)    *log_gamZ(jA,jhcl)
2119        gam(jA,ibin) = 10.**log_gam(jA)
2120
2121
2122        ! HNO3
2123        jA = jhno3
2124        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2125             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2126             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2127             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2128             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2129             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2130             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2131             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2132             xmol(jhcl)    *log_gamZ(jA,jhcl)
2133        gam(jA,ibin) = 10.**log_gam(jA)
2134
2135
2136        ! HCl
2137        jA = jhcl
2138        log_gam(jA) = xmol(jh2so4)  *log_gamZ(jA,jh2so4)  +   &
2139             xmol(jnh4hso4)*log_gamZ(jA,jnh4hso4)+   &
2140             xmol(jlvcite) *log_gamZ(jA,jlvcite) +   &
2141             xmol(jnh4so4) *log_gamZ(jA,jnh4so4) +   &
2142             xmol(jnahso4) *log_gamZ(jA,jnahso4) +   &
2143             xmol(jna3hso4)*log_gamZ(jA,jna3hso4)+   &
2144             xmol(jna2so4) *log_gamZ(jA,jna2so4) +   &
2145             xmol(jhno3)   *log_gamZ(jA,jhno3)   +   &
2146             xmol(jhcl)    *log_gamZ(jA,jhcl)
2147        gam(jA,ibin) = 10.**log_gam(jA)
2148
2149
2150 20     gam(jnh4no3,ibin) = 1.0
2151        gam(jnh4cl,ibin)  = 1.0
2152        gam(jnano3,ibin)  = 1.0
2153        gam(jnacl,ibin)   = 1.0
2154        gam(jcano3,ibin)  = 1.0
2155        gam(jcacl2,ibin)  = 1.0
2156
2157        gam(jnh4msa,ibin) = 1.0
2158        gam(jnamsa,ibin)  = 1.0
2159        gam(jcamsa2,ibin) = 1.0
2160
2161
2162
2163        ! compute equilibrium pH
2164        ! cation molalities (mol/kg water)
2165        mc(jc_ca,ibin)   = 1.e-9*aer(ica_a,jliquid,ibin)/water_a(ibin)
2166        mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
2167        mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
2168
2169        ! anion molalities (mol/kg water)
2170        mSULF            = 1.e-9*aer(iso4_a,jliquid,ibin)/water_a(ibin)
2171        ma(ja_hso4,ibin) = 0.0
2172        ma(ja_so4,ibin)  = 0.0
2173        ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
2174        ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
2175        ma(ja_msa,ibin)  = 1.e-9*aer(imsa_a,jliquid,ibin)/water_a(ibin)
2176
2177        gam_ratio(ibin)  = gam(jnh4hso4,ibin)**2/gam(jhhso4,ibin)**2
2178        dumK = Keq_ll(1)*gam(jhhso4,ibin)**2/gam(jh2so4,ibin)**3
2179
2180        c_bal =  mc(jc_nh4,ibin) + mc(jc_na,ibin) + 2.*mc(jc_ca,ibin)   &
2181             - ma(ja_no3,ibin) - ma(ja_cl,ibin) - mSULF - ma(ja_msa,ibin)
2182
2183        aq = 1.0
2184        bq = dumK + c_bal
2185        cq = dumK*(c_bal - mSULF)
2186
2187
2188        !--quadratic solution
2189        if(bq .ne. 0.0)then
2190           xq = 4.*(1./bq)*(cq/bq)
2191        else
2192           xq = 1.e+6
2193        endif
2194
2195        if(abs(xq) .lt. 1.e-6)then
2196           dum = xq*(0.5 + xq*(0.125 + xq*0.0625))
2197           quad = (-0.5*bq/aq)*dum
2198           if(quad .lt. 0.)then
2199              quad = -bq/aq - quad
2200           endif
2201        else
2202           quad = 0.5*(-bq+sqrt(bq*bq - 4.*cq))
2203        endif
2204        !--end of quadratic solution
2205
2206        mc(jc_h,ibin) = max(quad, 1.d-7)
2207        ma(ja_so4,ibin) = mSULF*dumK/(mc(jc_h,ibin) + dumK)
2208        ma(ja_hso4,ibin)= mSULF - ma(ja_so4,ibin)
2209
2210        activity(jcamsa2,ibin) = mc(jc_ca,ibin) * ma(ja_msa,ibin)**2 *   &
2211             gam(jcamsa2,ibin)**3
2212
2213        activity(jnh4so4,ibin) = mc(jc_nh4,ibin)**2 * ma(ja_so4,ibin) *   &
2214             gam(jnh4so4,ibin)**3
2215
2216        activity(jlvcite,ibin) = mc(jc_nh4,ibin)**3 * ma(ja_hso4,ibin) *   &
2217             ma(ja_so4,ibin) * gam(jlvcite,ibin)**5
2218
2219        activity(jnh4hso4,ibin)= mc(jc_nh4,ibin) * ma(ja_hso4,ibin) *   &
2220             gam(jnh4hso4,ibin)**2
2221
2222        activity(jnh4msa,ibin) = mc(jc_nh4,ibin) * ma(ja_msa,ibin) *   &
2223             gam(jnh4msa,ibin)**2
2224
2225        activity(jna2so4,ibin) = mc(jc_na,ibin)**2 * ma(ja_so4,ibin) *   &
2226             gam(jna2so4,ibin)**3
2227
2228        activity(jnahso4,ibin) = mc(jc_na,ibin) * ma(ja_hso4,ibin) *   &
2229             gam(jnahso4,ibin)**2
2230
2231        activity(jnamsa,ibin)  = mc(jc_na,ibin) * ma(ja_msa,ibin) *   &
2232             gam(jnamsa,ibin)**2
2233
2234        !      activity(jna3hso4,ibin)= mc(jc_na,ibin)**3 * ma(ja_hso4,ibin) *
2235        !     &                         ma(ja_so4,ibin) * gam(jna3hso4,ibin)**5
2236
2237        activity(jna3hso4,ibin)= 0.0
2238
2239        activity(jhno3,ibin)   = mc(jc_h,ibin) * ma(ja_no3,ibin) *   &
2240             gam(jhno3,ibin)**2
2241
2242        activity(jhcl,ibin)    = mc(jc_h,ibin) * ma(ja_cl,ibin) *   &
2243             gam(jhcl,ibin)**2
2244
2245        activity(jmsa,ibin)    = mc(jc_h,ibin) * ma(ja_msa,ibin) *   &
2246             gam(jmsa,ibin)**2
2247
2248
2249        ! sulfate-poor species
2250        activity(jnh4no3,ibin) = 0.0
2251
2252        activity(jnh4cl,ibin)  = 0.0
2253
2254        activity(jnano3,ibin)  = 0.0
2255
2256        activity(jnacl,ibin)   = 0.0
2257
2258        activity(jcano3,ibin)  = 0.0
2259
2260        activity(jcacl2,ibin)  = 0.0
2261
2262
2263     endif
2264     return
2265   end subroutine compute_activities
2266
2267
2268
2269   !***********************************************************************
2270   ! part of MESA: checks MESA convergence
2271   !
2272   ! author: Rahul A. Zaveri
2273   ! update: jan 2005
2274   !-----------------------------------------------------------------------
2275   subroutine MESA_convergence_criterion(ibin,iconverge_mass,iconverge_flux,        &
2276        idissolved,aer,electrolyte,mass_dry_a,mass_dry_salt,                        &
2277        mw_electrolyte,mw_aer_mac,flux_sl,phi_salt,rtol_mesa)  ! TOUCH
2278
2279     use module_data_mosaic_aero, only: r8,nbin_a_max,naer,nelectrolyte,nsalt,      &!Parameters
2280          jsolid, mYES, xhyst_up_crustal_thresh,                                    &!Parameters
2281          mno,ioin_a,jcaso4,jcaco3         !TBD
2282
2283     implicit none
2284
2285     ! subr arguments
2286     integer, intent(in) :: ibin
2287     integer, intent(inout) :: iconverge_mass, iconverge_flux, idissolved
2288     real(r8), intent(in) :: rtol_mesa
2289     real(r8), intent(inout), dimension(nsalt) :: flux_sl,phi_salt
2290     real(r8), intent(in),    dimension(nbin_a_max) :: mass_dry_a
2291     real(r8), intent(inout), dimension(nbin_a_max) :: mass_dry_salt
2292     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
2293     real(r8), intent(in), dimension(naer) :: mw_aer_mac
2294     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
2295     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
2296     ! local variables
2297     integer je, js, iaer
2298     real(r8) :: mass_solid, mass_solid_salt,frac_solid, XT, H_ion,   &
2299          crustal_solids, sumflux
2300
2301
2302     idissolved = mno             ! default = not completely dissolved
2303
2304     ! check mass convergence
2305     iconverge_mass = mNO ! default value = no convergence
2306
2307     !      call electrolytes_to_ions(jsolid,ibin,aer,electrolyte)
2308     !      mass_solid = 0.0
2309     !      do iaer = 1, naer
2310     !        mass_solid = mass_solid +
2311     !     &               aer(iaer,jsolid,ibin)*mw_aer_mac(iaer)*1.e-15  ! g/cc(air)
2312     !      enddo
2313
2314     mass_solid_salt = 0.0
2315     do je = 1, nsalt
2316        mass_solid_salt = mass_solid_salt +   &
2317             electrolyte(je,jsolid,ibin)*mw_electrolyte(je)*1.e-15        ! g/cc(air)
2318     enddo
2319
2320
2321
2322     !      frac_solid = mass_solid/mass_dry_a(ibin)
2323
2324
2325     if(mass_dry_salt(ibin) .le. 0.0)then
2326       frac_solid = 0.0
2327     else
2328       frac_solid = mass_solid_salt/mass_dry_salt(ibin)
2329     endif
2330
2331
2332     if(frac_solid .ge. 0.98)then
2333        iconverge_mass = mYES
2334        return
2335     endif
2336
2337
2338
2339     ! check relative driving force convergence
2340     iconverge_flux = mYES
2341     do js = 1, nsalt
2342        if(abs(phi_salt(js)).gt. rtol_mesa)then
2343           iconverge_flux = mNO
2344           return
2345        endif
2346     enddo
2347
2348
2349
2350     ! check if all the fluxes are zero
2351
2352     sumflux = 0.0
2353     do js = 1, nsalt
2354        sumflux = sumflux + abs(flux_sl(js))
2355     enddo
2356
2357 !   crustal_solids = electrolyte(jcaco3,jsolid,ibin) +   &
2358 !        electrolyte(jcaso4,jsolid,ibin) +   &
2359 !        aer(ioin_a,jsolid,ibin)
2360     crustal_solids = electrolyte(jcaco3,jsolid,ibin)*mw_electrolyte(jcaco3) +  &
2361                      electrolyte(jcaso4,jsolid,ibin)*mw_electrolyte(jcaso4) +  &
2362                      aer(ioin_a,jsolid,ibin)*mw_aer_mac(ioin_a)
2363
2364 !   if(sumflux .eq. 0.0 .and. crustal_solids .eq. 0.0)then
2365     if ( sumflux .eq. 0.0 .and. &
2366          crustal_solids .le. xhyst_up_crustal_thresh*(mass_dry_a(ibin)*1.0e15) ) then
2367        ! crustal_solids is ng/m^3, mass_dry_a is g/cm^3
2368        idissolved = myes
2369     endif
2370
2371
2372
2373     return
2374   end subroutine MESA_convergence_criterion
2375
2376
2377
2378   !***********************************************************************
2379   ! computes ions from electrolytes
2380   !
2381   ! author: Rahul A. Zaveri
2382   ! update: jan 2005
2383   !-----------------------------------------------------------------------
2384   subroutine electrolytes_to_ions(jp,ibin,aer,electrolyte)
2385
2386     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &!Parameters
2387          jh2so4,jnh4hso4,jlvcite,jnh4so4,jnahso4,jna3hso4,jna2so4,jcaso4,iso4_a,   &!TBD
2388          jhno3,jnh4no3,jcano3,jnano3,ino3_a,jhcl,jnh4cl,jcacl2,jnacl,icl_a,jmsa,   &!TBD
2389          jcamsa2,jnamsa,jnh4msa,imsa_a,jcaco3,ico3_a,ica_a,ina_a,inh4_a             !TBD
2390     implicit none
2391
2392     ! subr arguments
2393     integer, intent(in) :: jp, ibin
2394     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
2395     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
2396     ! local variables
2397     real(r8) :: sum_dum
2398
2399
2400     aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
2401          electrolyte(jna2so4,jp,ibin) +   &
2402          2.*electrolyte(jna3hso4,jp,ibin)+   &
2403          electrolyte(jnahso4,jp,ibin) +   &
2404          electrolyte(jnh4so4,jp,ibin) +   &
2405          2.*electrolyte(jlvcite,jp,ibin) +   &
2406          electrolyte(jnh4hso4,jp,ibin)+   &
2407          electrolyte(jh2so4,jp,ibin)
2408
2409     aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
2410          2.*electrolyte(jcano3,jp,ibin)  +   &
2411          electrolyte(jnh4no3,jp,ibin) +   &
2412          electrolyte(jhno3,jp,ibin)
2413
2414     aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
2415          2.*electrolyte(jcacl2,jp,ibin)  +   &
2416          electrolyte(jnh4cl,jp,ibin)  +   &
2417          electrolyte(jhcl,jp,ibin)
2418
2419     aer(imsa_a,jp,ibin) = electrolyte(jnh4msa,jp,ibin) +   &
2420          electrolyte(jnamsa,jp,ibin)  +   &
2421          2.*electrolyte(jcamsa2,jp,ibin) +   &
2422          electrolyte(jmsa,jp,ibin)
2423
2424     aer(ico3_a,jp,ibin) = electrolyte(jcaco3,jp,ibin)
2425
2426     aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
2427          electrolyte(jcano3,jp,ibin)  +   &
2428          electrolyte(jcacl2,jp,ibin)  +   &
2429          electrolyte(jcaco3,jp,ibin)  +   &
2430          electrolyte(jcamsa2,jp,ibin)
2431
2432     aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
2433          electrolyte(jnacl,jp,ibin)   +   &
2434          2.*electrolyte(jna2so4,jp,ibin) +   &
2435          3.*electrolyte(jna3hso4,jp,ibin)+   &
2436          electrolyte(jnahso4,jp,ibin) +   &
2437          electrolyte(jnamsa,jp,ibin)
2438
2439     aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
2440          electrolyte(jnh4cl,jp,ibin)  +   &
2441          2.*electrolyte(jnh4so4,jp,ibin) +   &
2442          3.*electrolyte(jlvcite,jp,ibin) +   &
2443          electrolyte(jnh4hso4,jp,ibin)+   &
2444          electrolyte(jnh4msa,jp,ibin)
2445
2446
2447     return
2448   end subroutine electrolytes_to_ions
2449
2450
2451
2452   !***********************************************************************
2453   ! combinatorial method for computing electrolytes from ions
2454   !
2455   ! notes:
2456   !  - to be used for liquid-phase or total-phase only
2457   !  - transfers caso4 and caco3 from liquid to solid phase
2458   !
2459   ! author: Rahul A. Zaveri (based on code provided by A.S. Wexler)
2460   ! update: apr 2005
2461   !-----------------------------------------------------------------------
2462   subroutine ions_to_electrolytes(jp,ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,    &
2463        nc_Mc,xeq_c,mw_electrolyte,MW_c,MW_a)
2464
2465     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,nelectrolyte,ncation,    &!Parameters
2466          nanion,jliquid,jsolid,                                                    &!Parameters
2467          ica_a,iso4_a,jcaso4,imsa_a,ina_a,inh4_a,ja_hso4,ja_so4,ino3_a,ja_no3,     &
2468          icl_a,ja_cl,ja_msa,jc_ca,jc_na,jc_nh4,jc_h,jna2so4,jnahso4,jnamsa,jnano3, &
2469          jnacl,jnh4so4,jnh4hso4,jnh4msa,jnh4no3,jnh4cl,jcano3,jcacl2,jcamsa2,      &
2470          jh2so4,jhno3,jhcl,jmsa,jlvcite,jna3hso4                                    !TBD
2471     implicit none
2472
2473     ! subr arguments
2474     integer, intent(in) :: ibin, jp
2475     real(r8), intent(inout) :: XT
2476     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
2477     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
2478     real(r8), intent(in), dimension(Nanion) :: za,MW_a
2479     real(r8), intent(inout), dimension(Nanion) :: xeq_a,na_Ma
2480     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
2481     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
2482     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
2483     ! local variables
2484     character(len=256) :: errmsg
2485     integer iaer, je, jc, ja, icase
2486     real(r8) :: store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
2487          f_nh4, f_na, xh, xb, xl, xs, cat_net, rem_nh4, rem_na
2488     real(r8) :: nc(ncation), na(nanion)
2489
2490
2491
2492
2493     if(jp .ne. jliquid)then
2494        call wrf_message(' jp must be jliquid')
2495        call wrf_message(' in ions_to_electrolytes sub')
2496        write(errmsg,*)' wrong jp = ', jp
2497        call wrf_error_fatal(trim(adjustl(errmsg)))
2498
2499     endif
2500
2501     ! remove negative concentrations, if any
2502     !      do iaer = 1, naer
2503     !        aer(iaer,jp,ibin) = max(0.0d0, aer(iaer,jp,ibin))    ! EFFI
2504     !      enddo
2505
2506
2507     ! first transfer caso4 from liquid to solid phase (caco3 should not be present here)
2508     store(ica_a)  = aer(ica_a, jp,ibin)
2509     store(iso4_a) = aer(iso4_a,jp,ibin)
2510
2511     call form_caso4(store,jp,ibin,electrolyte)
2512
2513     if(jp .eq. jliquid)then ! transfer caso4 from liquid to solid phase
2514        aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) -   &
2515             electrolyte(jcaso4,jliquid,ibin)
2516
2517        aer(iso4_a,jliquid,ibin)= aer(iso4_a,jliquid,ibin)-   &
2518             electrolyte(jcaso4,jliquid,ibin)
2519
2520        aer(ica_a,jsolid,ibin)  = aer(ica_a,jsolid,ibin) +   &
2521             electrolyte(jcaso4,jliquid,ibin)
2522
2523        aer(iso4_a,jsolid,ibin) = aer(iso4_a,jsolid,ibin) +   &
2524             electrolyte(jcaso4,jliquid,ibin)
2525
2526        electrolyte(jcaso4,jsolid,ibin)=electrolyte(jcaso4,jsolid,ibin)   &
2527             +electrolyte(jcaso4,jliquid,ibin)
2528        electrolyte(jcaso4,jliquid,ibin)= 0.0
2529     endif
2530
2531
2532     ! calculate sulfate ratio
2533     !      call calculate_XT(ibin,jp,XT,aer)              ! EFFI
2534
2535     if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
2536        XT   = ( aer(inh4_a,jp,ibin) +   &
2537             aer(ina_a,jp,ibin)  +   &
2538             2.*aer(ica_a,jp,ibin) )/   &
2539             (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
2540     else
2541        XT   = -1.0
2542     endif
2543
2544
2545
2546
2547 !    if(XT.ge.1.9999 .or. XT.lt.0.)then ! commented out by RAZ 4/16/2014
2548     if(XT.ge.2.0 .or. XT.lt.0.)then     ! Slightly different logic, consistent with that in compute_activities subr. RAZ 4/16/2014
2549        icase = 1  ! sulfate poor: near neutral (acidity is caused by HCl and/or HNO3)
2550     else
2551        icase = 2  ! sulfate rich: acidic (acidity is caused by excess SO4)
2552     endif
2553
2554
2555     ! initialize to zero
2556     do je = 1, nelectrolyte
2557        electrolyte(je,jp,ibin) = 0.0
2558     enddo
2559
2560     !
2561     !---------------------------------------------------------
2562     ! initialize moles of ions depending on the sulfate domain
2563
2564     if(icase.eq.1)then ! XT >= 2 or XT < 0: SULFATE POOR (OR NO SULFATE) DOMAIN. RAZ 4/16/2014
2565
2566        na(ja_hso4)= 0.0
2567        na(ja_so4) = aer(iso4_a,jp,ibin)
2568        na(ja_no3) = aer(ino3_a,jp,ibin)
2569        na(ja_cl)  = aer(icl_a, jp,ibin)
2570        na(ja_msa) = aer(imsa_a,jp,ibin)
2571
2572        nc(jc_ca)  = aer(ica_a, jp,ibin)
2573        nc(jc_na)  = aer(ina_a, jp,ibin)
2574        nc(jc_nh4) = aer(inh4_a,jp,ibin)
2575
2576        cat_net = (   &
2577             (2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa)) -   &
2578             (2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na)) )
2579
2580        if(cat_net .lt. 0.0)then
2581
2582           nc(jc_h) = 0.0
2583
2584        else  ! cat_net must be 0.0 or positive
2585
2586           nc(jc_h) = cat_net
2587
2588        endif
2589
2590
2591        ! now compute equivalent fractions
2592        sum_naza = 0.0
2593        do ja = 1, nanion
2594           sum_naza = sum_naza + na(ja)*za(ja)
2595        enddo
2596
2597        sum_nczc = 0.0
2598        do jc = 1, ncation
2599           sum_nczc = sum_nczc + nc(jc)*zc(jc)
2600        enddo
2601
2602        if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then ! it's ok. this may happen if the aerosol is assumed to be composed of hygroscopic SOA, POA, BC, OIN, but does not contain any inorganic electrolytes
2603 !          write(6,*)'ionic concentrations are zero in ibin', ibin  ! commented out by RAZ 4/16/2014
2604 !          write(6,*)'sum_naza = ', sum_naza          ! commented out by RAZ 4/16/2014
2605 !          write(6,*)'sum_nczc = ', sum_nczc          ! commented out by RAZ 4/16/2014
2606           return
2607        endif
2608
2609        do ja = 1, nanion
2610           xeq_a(ja) = na(ja)*za(ja)/sum_naza
2611        enddo
2612
2613        do jc = 1, ncation
2614           xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2615        enddo
2616
2617        na_Ma(ja_so4) = na(ja_so4) *MW_a(ja_so4)
2618        na_Ma(ja_no3) = na(ja_no3) *MW_a(ja_no3)
2619        na_Ma(ja_cl)  = na(ja_cl)  *MW_a(ja_cl)
2620        na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
2621        na_Ma(ja_hso4)= na(ja_hso4)*MW_a(ja_hso4)
2622
2623        nc_Mc(jc_ca)  = nc(jc_ca) *MW_c(jc_ca)
2624        nc_Mc(jc_na)  = nc(jc_na) *MW_c(jc_na)
2625        nc_Mc(jc_nh4) = nc(jc_nh4)*MW_c(jc_nh4)
2626        nc_Mc(jc_h)   = nc(jc_h)  *MW_c(jc_h)
2627
2628
2629        ! now compute electrolyte moles
2630        if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
2631           electrolyte(jna2so4,jp,ibin) = (xeq_c(jc_na) *na_Ma(ja_so4) +   &
2632                xeq_a(ja_so4)*nc_Mc(jc_na))/   &
2633                mw_electrolyte(jna2so4)
2634        endif
2635
2636        electrolyte(jnahso4,jp,ibin) = 0.0
2637
2638        if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
2639           electrolyte(jnamsa,jp,ibin)  = (xeq_c(jc_na) *na_Ma(ja_msa) +   &
2640                xeq_a(ja_msa)*nc_Mc(jc_na))/   &
2641                mw_electrolyte(jnamsa)
2642        endif
2643
2644        if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
2645           electrolyte(jnano3,jp,ibin)  = (xeq_c(jc_na) *na_Ma(ja_no3) +   &
2646                xeq_a(ja_no3)*nc_Mc(jc_na))/   &
2647                mw_electrolyte(jnano3)
2648        endif
2649
2650        if(xeq_c(jc_na) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
2651           electrolyte(jnacl,jp,ibin)   = (xeq_c(jc_na) *na_Ma(ja_cl) +   &
2652                xeq_a(ja_cl) *nc_Mc(jc_na))/   &
2653                mw_electrolyte(jnacl)
2654        endif
2655
2656        if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_so4) .gt. 0.)then
2657           electrolyte(jnh4so4,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_so4) +   &
2658                xeq_a(ja_so4)*nc_Mc(jc_nh4))/   &
2659                mw_electrolyte(jnh4so4)
2660        endif
2661
2662        electrolyte(jnh4hso4,jp,ibin)= 0.0
2663
2664        if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
2665           electrolyte(jnh4msa,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_msa) +   &
2666                xeq_a(ja_msa)*nc_Mc(jc_nh4))/   &
2667                mw_electrolyte(jnh4msa)
2668        endif
2669
2670        if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
2671           electrolyte(jnh4no3,jp,ibin) = (xeq_c(jc_nh4)*na_Ma(ja_no3) +   &
2672                xeq_a(ja_no3)*nc_Mc(jc_nh4))/   &
2673                mw_electrolyte(jnh4no3)
2674        endif
2675
2676        if(xeq_c(jc_nh4) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
2677           electrolyte(jnh4cl,jp,ibin)  = (xeq_c(jc_nh4)*na_Ma(ja_cl) +   &
2678                xeq_a(ja_cl) *nc_Mc(jc_nh4))/   &
2679                mw_electrolyte(jnh4cl)
2680        endif
2681
2682        if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.0)then
2683           electrolyte(jcano3, jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_no3) +   &
2684                xeq_a(ja_no3)*nc_Mc(jc_ca))/   &
2685                mw_electrolyte(jcano3)
2686        endif
2687
2688        if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
2689           electrolyte(jcacl2,jp,ibin)  = (xeq_c(jc_ca) *na_Ma(ja_cl) +   &
2690                xeq_a(ja_cl) *nc_Mc(jc_ca))/   &
2691                mw_electrolyte(jcacl2)
2692        endif
2693
2694        if(xeq_c(jc_ca) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
2695           electrolyte(jcamsa2,jp,ibin) = (xeq_c(jc_ca) *na_Ma(ja_msa) +   &
2696                xeq_a(ja_msa) *nc_Mc(jc_ca))/   &
2697                mw_electrolyte(jcamsa2)
2698        endif
2699
2700        electrolyte(jh2so4, jp,ibin) = 0.0
2701
2702        if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_no3) .gt. 0.)then
2703           electrolyte(jhno3,jp,ibin)     = (xeq_c(jc_h)  *na_Ma(ja_no3) +   &
2704                xeq_a(ja_no3)*nc_Mc(jc_h))/   &
2705                mw_electrolyte(jhno3)
2706        endif
2707
2708        if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_cl) .gt. 0.)then
2709           electrolyte(jhcl,jp,ibin)    = (xeq_c(jc_h) *na_Ma(ja_cl) +   &
2710                xeq_a(ja_cl)*nc_Mc(jc_h))/   &
2711                mw_electrolyte(jhcl)
2712        endif
2713
2714        if(xeq_c(jc_h) .gt. 0. .and. xeq_a(ja_msa) .gt. 0.)then
2715           electrolyte(jmsa,jp,ibin)    = (xeq_c(jc_h) *na_Ma(ja_msa) +   &
2716                xeq_a(ja_msa)*nc_Mc(jc_h))/   &
2717                mw_electrolyte(jmsa)
2718        endif
2719
2720        !--------------------------------------------------------------------
2721
2722     elseif(icase.eq.2)then ! XT < 2 : SULFATE RICH DOMAIN
2723
2724        store(imsa_a) = aer(imsa_a,jp,ibin)
2725        store(ica_a)  = aer(ica_a, jp,ibin)
2726
2727        call form_camsa2(store,jp,ibin,electrolyte)
2728
2729        sum_na_nh4 = aer(ina_a,jp,ibin) + aer(inh4_a,jp,ibin)
2730
2731        if(sum_na_nh4 .gt. 0.0)then
2732           f_na  = aer(ina_a,jp,ibin)/sum_na_nh4
2733           f_nh4 = aer(inh4_a,jp,ibin)/sum_na_nh4
2734        else
2735           f_na  = 0.0
2736           f_nh4 = 0.0
2737        endif
2738
2739        ! first form msa electrolytes
2740        if(sum_na_nh4 .gt. store(imsa_a))then
2741           electrolyte(jnamsa,jp,ibin)  = f_na *store(imsa_a)
2742           electrolyte(jnh4msa,jp,ibin) = f_nh4*store(imsa_a)
2743           rem_na = max(0.0_r8, aer(ina_a,jp,ibin) - electrolyte(jnamsa,jp,ibin))  ! remaining na  RAZ 4/16/2014
2744           rem_nh4= max(0.0_r8, aer(inh4_a,jp,ibin)- electrolyte(jnh4msa,jp,ibin)) ! remaining nh4 RAZ 4/16/2014
2745        else
2746           electrolyte(jnamsa,jp,ibin)  = aer(ina_a,jp,ibin)
2747           electrolyte(jnh4msa,jp,ibin) = aer(inh4_a,jp,ibin)
2748           electrolyte(jmsa,jp,ibin)    = max(0.0_r8, store(imsa_a) - sum_na_nh4) ! RAZ 4/16/2014
2749           rem_nh4 = 0.0  ! remaining nh4
2750           rem_na  = 0.0  ! remaining na
2751        endif
2752
2753
2754        ! recompute XT
2755        if(aer(iso4_a,jp,ibin).gt.0.0)then
2756           XT = (rem_nh4 + rem_na)/aer(iso4_a,jp,ibin)
2757        else
2758           goto 10
2759        endif
2760
2761        if(XT .le. 1.0)then            ! h2so4 + bisulfate
2762           xh = max(0.0_r8, (1.0_r8 - XT))   ! RAZ 4/16/2014
2763           xb = XT
2764           electrolyte(jh2so4,jp,ibin)   = xh*aer(iso4_a,jp,ibin)
2765           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
2766           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
2767        elseif(XT .le. 1.5)then    ! bisulfate + letovicite
2768           xb = max(0.0_r8, 3.0_r8 - 2.0_r8*XT) ! RAZ 4/16/2014
2769           xl = max(0.0_r8, XT - 1.0_r8)     ! RAZ 4/16/2014
2770           electrolyte(jnh4hso4,jp,ibin) = xb*f_nh4*aer(iso4_a,jp,ibin)
2771           electrolyte(jnahso4,jp,ibin)  = xb*f_na *aer(iso4_a,jp,ibin)
2772           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
2773           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
2774        else                       ! letovicite + sulfate
2775           xl = max(0.0_r8, 2.0_r8 - XT)     ! RAZ 4/16/2014
2776           xs = max(0.0_r8, 2.0_r8*XT - 3.0_r8) ! RAZ 4/16/2014
2777           electrolyte(jlvcite,jp,ibin)  = xl*f_nh4*aer(iso4_a,jp,ibin)
2778           electrolyte(jna3hso4,jp,ibin) = xl*f_na *aer(iso4_a,jp,ibin)
2779           electrolyte(jnh4so4,jp,ibin)  = xs*f_nh4*aer(iso4_a,jp,ibin)
2780           electrolyte(jna2so4,jp,ibin)  = xs*f_na *aer(iso4_a,jp,ibin)
2781        endif
2782
2783        electrolyte(jhno3,jp,ibin) = aer(ino3_a,jp,ibin)
2784        electrolyte(jhcl,jp,ibin)  = aer(icl_a,jp,ibin)
2785
2786     endif
2787     !---------------------------------------------------------
2788     !
2789     ! calculate % composition  EFFI
2790 10  sum_dum = 0.0
2791     !!      do je = 1, nelectrolyte
2792     !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
2793     !!      enddo
2794     !!
2795     !!      if(sum_dum .eq. 0.)sum_dum = 1.0
2796     !!      electrolyte_sum(jp,ibin) = sum_dum
2797     !!
2798     !!      do je = 1, nelectrolyte
2799     !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
2800     !!      enddo
2801     !!
2802
2803     return
2804   end subroutine ions_to_electrolytes
2805
2806
2807
2808   !***********************************************************************
2809   ! part of MESA: calculates liquid electrolytes from ions
2810   !
2811   ! notes:
2812   !  - this subroutine is to be used for liquid-phase or total-phase only
2813   !  - this sub transfers caso4 and caco3 from liquid to solid phase
2814   !
2815   ! author: Rahul A. Zaveri
2816   ! update: jan 2005
2817   !-----------------------------------------------------------------------
2818   subroutine MESA_estimate_eleliquid(ibin,XT,aer,electrolyte,zc,za,xeq_a,na_Ma,    &
2819        nc_Mc,xeq_c,mw_electrolyte,MW_c,MW_a,eleliquid)    ! TOUCH
2820     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,nelectrolyte,ncation,    &!Parameters
2821          nanion,jliquid,                                                           &!Parameters
2822          jh2so4,jhno3,jhcl,jmsa,jlvcite,jnh4no3,jnh4cl,jcamsa2,jcano3,jcacl2,      &
2823          jnano3,jnacl,jnh4so4,jnh4hso4,jnh4msa,jna2so4,jnahso4,jnamsa,iso4_a,      &
2824          ja_so4,ja_no3,ja_cl,imsa_a,ja_msa,jc_ca,ina_a,jc_na,inh4_a,jc_nh4,jc_h,   &
2825          ica_a,ino3_a,icl_a,ja_hso4
2826
2827     implicit none
2828
2829     ! subr arguments
2830     integer, intent(in) :: ibin
2831     real(r8), intent(inout) :: XT
2832     real(r8), intent(in), dimension(Ncation) :: zc,MW_c
2833     real(r8), intent(inout), dimension(Ncation) :: nc_Mc,xeq_c
2834     real(r8), intent(in), dimension(Nanion) :: za,MW_a
2835     real(r8), intent(inout), dimension(Nanion) :: xeq_a,na_Ma
2836     real(r8), intent(in), dimension(nelectrolyte) :: mw_electrolyte
2837     real(r8), intent(inout), dimension(nelectrolyte) :: eleliquid
2838     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
2839     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
2840     ! local variables
2841     integer iaer, je, jc, ja, icase, jp
2842     real(r8) :: store(naer), sum_dum, sum_naza, sum_nczc, sum_na_nh4,   &
2843          f_nh4, f_na, xh, xb, xl, xs, XT_d, XNa_d, XNH4_d,   &
2844          xdum, dum, cat_net
2845     real(r8) :: nc(ncation), na(nanion)
2846     real(r8) :: dum_ca, dum_no3, dum_cl, cano3, cacl2
2847
2848     !nc(:) = 0.0_r8!BSINGH - initialized to zero
2849
2850     ! remove negative concentrations, if any
2851     do iaer =  1, naer
2852        aer(iaer,jliquid,ibin) = max(0.0d0, aer(iaer,jliquid,ibin))
2853     enddo
2854
2855
2856     ! calculate sulfate ratio
2857     call calculate_XT(ibin,jliquid,XT,aer)
2858
2859     if(XT .ge. 2.0 .or. XT.lt.0.)then
2860        icase = 1 ! near neutral (acidity is caused by HCl and/or HNO3)
2861     else
2862        icase = 2 ! acidic (acidity is caused by excess SO4)
2863     endif
2864
2865
2866     ! initialize to zero
2867     do je = 1, nelectrolyte
2868        eleliquid(je) = 0.0
2869     enddo
2870
2871     !
2872     !---------------------------------------------------------
2873     ! initialize moles of ions depending on the sulfate domain
2874
2875     jp = jliquid
2876
2877     if(icase.eq.1)then ! XT >= 2 : SULFATE POOR DOMAIN
2878
2879        dum_ca  = aer(ica_a,jp,ibin)
2880        dum_no3 = aer(ino3_a,jp,ibin)
2881        dum_cl  = aer(icl_a,jp,ibin)
2882
2883        cano3   = min(dum_ca, 0.5*dum_no3)
2884        dum_ca  = max(0.d0, dum_ca - cano3)
2885        dum_no3 = max(0.d0, dum_no3 - 2.*cano3)
2886
2887        cacl2   = min(dum_ca, 0.5*dum_cl)
2888        dum_ca  = max(0.d0, dum_ca - cacl2)
2889        dum_cl  = max(0.d0, dum_cl - 2.*cacl2)
2890
2891        na(ja_hso4)= 0.0
2892        na(ja_so4) = aer(iso4_a,jp,ibin)
2893        na(ja_no3) = aer(ino3_a,jp,ibin)
2894        na(ja_cl)  = aer(icl_a, jp,ibin)
2895        na(ja_msa) = aer(imsa_a,jp,ibin)
2896
2897        nc(jc_ca)  = aer(ica_a, jp,ibin)
2898        nc(jc_na)  = aer(ina_a, jp,ibin)
2899        nc(jc_nh4) = aer(inh4_a,jp,ibin)
2900
2901        cat_net = (   &
2902             (2.*na(ja_so4)+na(ja_no3)+na(ja_cl)+na(ja_msa)) -   &
2903             (2.*nc(jc_ca) +nc(jc_nh4)+nc(jc_na)) )   ! RAZ 11/11/2014: bug fix. remove nc(jc_h)
2904
2905        if(cat_net .lt. 0.0)then
2906
2907           nc(jc_h) = 0.0
2908
2909        else  ! cat_net must be 0.0 or positive
2910
2911           nc(jc_h) = cat_net
2912
2913        endif
2914
2915
2916        ! now compute equivalent fractions
2917        sum_naza = 0.0
2918        do ja = 1, nanion
2919           sum_naza = sum_naza + na(ja)*za(ja)
2920        enddo
2921
2922        sum_nczc = 0.0
2923        do jc = 1, ncation
2924           sum_nczc = sum_nczc + nc(jc)*zc(jc)
2925        enddo
2926
2927        if(sum_naza .eq. 0. .or. sum_nczc .eq. 0.)then
2928           write(6,*)'ionic concentrations are zero in ibin', ibin
2929           write(6,*)'sum_naza = ', sum_naza
2930           write(6,*)'sum_nczc = ', sum_nczc
2931           return
2932        endif
2933
2934        do ja = 1, nanion
2935           xeq_a(ja) = na(ja)*za(ja)/sum_naza
2936        enddo
2937
2938        do jc = 1, ncation
2939           xeq_c(jc) = nc(jc)*zc(jc)/sum_nczc
2940        enddo
2941
2942        na_Ma(ja_so4) = na(ja_so4) *MW_a(ja_so4)
2943        na_Ma(ja_no3) = na(ja_no3) *MW_a(ja_no3)
2944        na_Ma(ja_cl)  = na(ja_cl)  *MW_a(ja_cl)
2945        na_Ma(ja_hso4)= na(ja_hso4)*MW_a(ja_hso4)
2946        na_Ma(ja_msa) = na(ja_msa) *MW_a(ja_msa)
2947
2948        nc_Mc(jc_ca)  = nc(jc_ca) *MW_c(jc_ca)
2949        nc_Mc(jc_na)  = nc(jc_na) *MW_c(jc_na)
2950        nc_Mc(jc_nh4) = nc(jc_nh4)*MW_c(jc_nh4)
2951        nc_Mc(jc_h)   = nc(jc_h)  *MW_c(jc_h)
2952
2953
2954        ! now compute electrolyte moles
2955        eleliquid(jna2so4) = (xeq_c(jc_na) *na_Ma(ja_so4) +   &
2956             xeq_a(ja_so4)*nc_Mc(jc_na))/   &
2957             mw_electrolyte(jna2so4)
2958
2959        eleliquid(jnahso4) = (xeq_c(jc_na) *na_Ma(ja_hso4) +   &
2960             xeq_a(ja_hso4)*nc_Mc(jc_na))/   &
2961             mw_electrolyte(jnahso4)
2962
2963        eleliquid(jnamsa)  = (xeq_c(jc_na) *na_Ma(ja_msa) +   &
2964             xeq_a(ja_msa)*nc_Mc(jc_na))/   &
2965             mw_electrolyte(jnamsa)
2966
2967        eleliquid(jnano3)  = (xeq_c(jc_na) *na_Ma(ja_no3) +   &
2968             xeq_a(ja_no3)*nc_Mc(jc_na))/   &
2969             mw_electrolyte(jnano3)
2970
2971        eleliquid(jnacl)   = (xeq_c(jc_na) *na_Ma(ja_cl) +   &
2972             xeq_a(ja_cl) *nc_Mc(jc_na))/   &
2973             mw_electrolyte(jnacl)
2974
2975        eleliquid(jnh4so4) = (xeq_c(jc_nh4)*na_Ma(ja_so4) +   &
2976             xeq_a(ja_so4)*nc_Mc(jc_nh4))/   &
2977             mw_electrolyte(jnh4so4)
2978
2979        eleliquid(jnh4hso4)= (xeq_c(jc_nh4)*na_Ma(ja_hso4) +   &
2980             xeq_a(ja_hso4)*nc_Mc(jc_nh4))/   &
2981             mw_electrolyte(jnh4hso4)
2982
2983        eleliquid(jnh4msa) = (xeq_c(jc_nh4) *na_Ma(ja_msa) +   &
2984             xeq_a(ja_msa)*nc_Mc(jc_nh4))/   &
2985             mw_electrolyte(jnh4msa)
2986
2987        eleliquid(jnh4no3) = (xeq_c(jc_nh4)*na_Ma(ja_no3) +   &
2988             xeq_a(ja_no3)*nc_Mc(jc_nh4))/   &
2989             mw_electrolyte(jnh4no3)
2990
2991        eleliquid(jnh4cl)  = (xeq_c(jc_nh4)*na_Ma(ja_cl) +   &
2992             xeq_a(ja_cl) *nc_Mc(jc_nh4))/   &
2993             mw_electrolyte(jnh4cl)
2994
2995        eleliquid(jcamsa2) = (xeq_c(jc_ca) *na_Ma(ja_msa) +   &
2996             xeq_a(ja_msa)*nc_Mc(jc_ca))/   &
2997             mw_electrolyte(jcamsa2)
2998
2999        eleliquid(jcano3)  = (xeq_c(jc_ca) *na_Ma(ja_no3) +   &
3000             xeq_a(ja_no3)*nc_Mc(jc_ca))/   &
3001             mw_electrolyte(jcano3)
3002
3003        eleliquid(jcacl2)  = (xeq_c(jc_ca) *na_Ma(ja_cl) +   &
3004             xeq_a(ja_cl) *nc_Mc(jc_ca))/   &
3005             mw_electrolyte(jcacl2)
3006
3007        eleliquid(jh2so4)  = (xeq_c(jc_h)   *na_Ma(ja_hso4) +   &
3008             xeq_a(ja_hso4)*nc_Mc(jc_h))/   &
3009             mw_electrolyte(jh2so4)
3010
3011        eleliquid(jhno3)   = (xeq_c(jc_h)  *na_Ma(ja_no3) +   &
3012             xeq_a(ja_no3)*nc_Mc(jc_h))/   &
3013             mw_electrolyte(jhno3)
3014
3015        eleliquid(jhcl)    = (xeq_c(jc_h) *na_Ma(ja_cl) +   &
3016             xeq_a(ja_cl)*nc_Mc(jc_h))/   &
3017             mw_electrolyte(jhcl)
3018
3019        eleliquid(jmsa)    = (xeq_c(jc_h)  *na_Ma(ja_msa) +   &
3020             xeq_a(ja_msa)*nc_Mc(jc_h))/   &
3021             mw_electrolyte(jmsa)
3022
3023        !--------------------------------------------------------------------
3024
3025     elseif(icase.eq.2)then ! XT < 2 : SULFATE RICH DOMAIN
3026
3027        jp = jliquid
3028
3029        store(iso4_a) = aer(iso4_a,jp,ibin)
3030        store(imsa_a) = aer(imsa_a,jp,ibin)
3031        store(inh4_a) = aer(inh4_a,jp,ibin)
3032        store(ina_a)  = aer(ina_a, jp,ibin)
3033        store(ica_a)  = aer(ica_a, jp,ibin)
3034
3035        call form_camsa2(store,jp,ibin,electrolyte)
3036
3037        sum_na_nh4 = store(ina_a) + store(inh4_a)
3038        if(sum_na_nh4 .gt. 0.0)then
3039           f_nh4 = store(inh4_a)/sum_na_nh4
3040           f_na  = store(ina_a)/sum_na_nh4
3041        else
3042           f_nh4 = 0.0
3043           f_na  = 0.0
3044        endif
3045
3046        ! first form msa electrolytes
3047        if(sum_na_nh4 .gt. store(imsa_a))then
3048           eleliquid(jnh4msa) = f_nh4*store(imsa_a)
3049           eleliquid(jnamsa)  = f_na *store(imsa_a)
3050           store(inh4_a)= store(inh4_a)-eleliquid(jnh4msa) ! remaining nh4
3051           store(ina_a) = store(ina_a) -eleliquid(jnamsa)  ! remaining na
3052        else
3053           eleliquid(jnh4msa) = store(inh4_a)
3054           eleliquid(jnamsa)  = store(ina_a)
3055           eleliquid(jmsa)    = store(imsa_a) - sum_na_nh4
3056           store(inh4_a)= 0.0  ! remaining nh4
3057           store(ina_a) = 0.0  ! remaining na
3058        endif
3059
3060        if(store(iso4_a).eq.0.0)goto 10
3061
3062        XT_d  = XT
3063        XNa_d = 1. + 0.5*store(ina_a)/store(iso4_a)
3064        xdum = store(iso4_a) - store(inh4_a)
3065
3066        dum = ( (2.*store(iso4_a)) -   &
3067             (store(ina_a)) )
3068        if(store(inh4_a) .gt. 0.0 .and. dum .gt. 0.0)then
3069           XNH4_d = 2.*store(inh4_a)/   &
3070                (2.*store(iso4_a) - store(ina_a))
3071        else
3072           XNH4_d = 0.0
3073        endif
3074
3075
3076        IF(store(inh4_a) .gt. 0.0)THEN
3077           if(XT_d .ge. XNa_d)then
3078              eleliquid(jna2so4) = 0.5*store(ina_a)
3079
3080              if(XNH4_d .ge. 5./3.)then
3081                 eleliquid(jnh4so4) = 1.5*store(ina_a)   &
3082                      - 3.*xdum - store(inh4_a)
3083                 eleliquid(jlvcite) = 2.*xdum + store(inh4_a)   &
3084                      - store(ina_a)
3085              elseif(XNH4_d .ge. 1.5)then
3086                 eleliquid(jnh4so4) = store(inh4_a)/5.
3087                 eleliquid(jlvcite) = store(inh4_a)/5.
3088              elseif(XNH4_d .ge. 1.0)then
3089                 eleliquid(jnh4so4) = store(inh4_a)/6.
3090                 eleliquid(jlvcite) = store(inh4_a)/6.
3091                 eleliquid(jnh4hso4)= store(inh4_a)/6.
3092              endif
3093
3094           elseif(XT_d .gt. 1.0)then
3095              eleliquid(jnh4so4)  = store(inh4_a)/6.
3096              eleliquid(jlvcite)  = store(inh4_a)/6.
3097              eleliquid(jnh4hso4) = store(inh4_a)/6.
3098              eleliquid(jna2so4)  = store(ina_a)/3.
3099              eleliquid(jnahso4)  = store(ina_a)/3.
3100           elseif(XT_d .le. 1.0)then
3101              eleliquid(jna2so4)  = store(ina_a)/4.
3102              eleliquid(jnahso4)  = store(ina_a)/2.
3103              eleliquid(jlvcite)  = store(inh4_a)/6.
3104              eleliquid(jnh4hso4) = store(inh4_a)/2.
3105           endif
3106
3107        ELSE
3108
3109           if(XT_d .gt. 1.0)then
3110              eleliquid(jna2so4) = store(ina_a) - store(iso4_a)
3111              eleliquid(jnahso4) = 2.*store(iso4_a) -   &
3112                   store(ina_a)
3113           else
3114              eleliquid(jna2so4) = store(ina_a)/4.
3115              eleliquid(jnahso4) = store(ina_a)/2.
3116           endif
3117
3118
3119        ENDIF
3120
3121
3122
3123     endif
3124     !---------------------------------------------------------
3125
3126
3127 10  return
3128   end subroutine MESA_estimate_eleliquid
3129
3130
3131
3132   !***********************************************************************
3133   ! part of MESA: completely dissolves small amounts of soluble salts
3134   !
3135   ! author: Rahul A. Zaveri
3136   ! update: jan 2005
3137   !-----------------------------------------------------------------------
3138   subroutine MESA_dissolve_small_salt(ibin,js,aer,electrolyte)
3139
3140     use module_data_mosaic_aero, only:r8,naer,nbin_a_max,nelectrolyte,jsolid,      &!Parameters
3141          jliquid,                                                                  &!Parameters
3142          jh2so4,jhno3,jhcl,jlvcite,jnh4no3,jnh4cl,jcamsa2,jcano3,jcacl2,jnano3,    &!TBD
3143          jnacl,jnh4so4,jnh4hso4,jnh4msa,jna2so4,jnahso4,jnamsa,iso4_a,ina_a,       &!TBD
3144          inh4_a,jna3hso4,jcaso4,jcaco3,ica_a,ino3_a,icl_a
3145
3146     implicit none
3147
3148     ! subr arguments
3149     integer, intent(in) :: ibin, js
3150     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
3151     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
3152     !Local variables
3153     integer :: jp
3154
3155     jp = jsolid
3156
3157
3158     if(js .eq. jnh4so4)then
3159        aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
3160             2.*electrolyte(js,jsolid,ibin)
3161        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3162             electrolyte(js,jsolid,ibin)
3163
3164        electrolyte(js,jsolid,ibin) = 0.0
3165
3166        aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
3167             electrolyte(jnh4cl,jp,ibin)  +   &
3168             2.*electrolyte(jnh4so4,jp,ibin) +   &
3169             3.*electrolyte(jlvcite,jp,ibin) +   &
3170             electrolyte(jnh4hso4,jp,ibin)+   &
3171             electrolyte(jnh4msa,jp,ibin)
3172
3173        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3174             electrolyte(jna2so4,jp,ibin) +   &
3175             2.*electrolyte(jna3hso4,jp,ibin)+   &
3176             electrolyte(jnahso4,jp,ibin) +   &
3177             electrolyte(jnh4so4,jp,ibin) +   &
3178             2.*electrolyte(jlvcite,jp,ibin) +   &
3179             electrolyte(jnh4hso4,jp,ibin)+   &
3180             electrolyte(jh2so4,jp,ibin)
3181        return
3182     endif
3183
3184
3185     if(js .eq. jlvcite)then
3186        aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
3187             3.*electrolyte(js,jsolid,ibin)
3188        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3189             2.*electrolyte(js,jsolid,ibin)
3190
3191        electrolyte(js,jsolid,ibin) = 0.0
3192
3193        aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
3194             electrolyte(jnh4cl,jp,ibin)  +   &
3195             2.*electrolyte(jnh4so4,jp,ibin) +   &
3196             3.*electrolyte(jlvcite,jp,ibin) +   &
3197             electrolyte(jnh4hso4,jp,ibin)+   &
3198             electrolyte(jnh4msa,jp,ibin)
3199
3200        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3201             electrolyte(jna2so4,jp,ibin) +   &
3202             2.*electrolyte(jna3hso4,jp,ibin)+   &
3203             electrolyte(jnahso4,jp,ibin) +   &
3204             electrolyte(jnh4so4,jp,ibin) +   &
3205             2.*electrolyte(jlvcite,jp,ibin) +   &
3206             electrolyte(jnh4hso4,jp,ibin)+   &
3207             electrolyte(jh2so4,jp,ibin)
3208        return
3209     endif
3210
3211
3212     if(js .eq. jnh4hso4)then
3213        aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
3214             electrolyte(js,jsolid,ibin)
3215        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3216             electrolyte(js,jsolid,ibin)
3217
3218        electrolyte(js,jsolid,ibin) = 0.0
3219
3220        aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
3221             electrolyte(jnh4cl,jp,ibin)  +   &
3222             2.*electrolyte(jnh4so4,jp,ibin) +   &
3223             3.*electrolyte(jlvcite,jp,ibin) +   &
3224             electrolyte(jnh4hso4,jp,ibin)+   &
3225             electrolyte(jnh4msa,jp,ibin)
3226
3227        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3228             electrolyte(jna2so4,jp,ibin) +   &
3229             2.*electrolyte(jna3hso4,jp,ibin)+   &
3230             electrolyte(jnahso4,jp,ibin) +   &
3231             electrolyte(jnh4so4,jp,ibin) +   &
3232             2.*electrolyte(jlvcite,jp,ibin) +   &
3233             electrolyte(jnh4hso4,jp,ibin)+   &
3234             electrolyte(jh2so4,jp,ibin)
3235        return
3236     endif
3237
3238
3239     if(js .eq. jna2so4)then
3240        aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
3241             2.*electrolyte(js,jsolid,ibin)
3242        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3243             electrolyte(js,jsolid,ibin)
3244
3245        electrolyte(js,jsolid,ibin) = 0.0
3246
3247        aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
3248             electrolyte(jnacl,jp,ibin)   +   &
3249             2.*electrolyte(jna2so4,jp,ibin) +   &
3250             3.*electrolyte(jna3hso4,jp,ibin)+   &
3251             electrolyte(jnahso4,jp,ibin) +   &
3252             electrolyte(jnamsa,jp,ibin)
3253
3254        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3255             electrolyte(jna2so4,jp,ibin) +   &
3256             2.*electrolyte(jna3hso4,jp,ibin)+   &
3257             electrolyte(jnahso4,jp,ibin) +   &
3258             electrolyte(jnh4so4,jp,ibin) +   &
3259             2.*electrolyte(jlvcite,jp,ibin) +   &
3260             electrolyte(jnh4hso4,jp,ibin)+   &
3261             electrolyte(jh2so4,jp,ibin)
3262        return
3263     endif
3264
3265
3266     if(js .eq. jna3hso4)then
3267        aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
3268             3.*electrolyte(js,jsolid,ibin)
3269        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3270             2.*electrolyte(js,jsolid,ibin)
3271
3272        electrolyte(js,jsolid,ibin) = 0.0
3273
3274        aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
3275             electrolyte(jnacl,jp,ibin)   +   &
3276             2.*electrolyte(jna2so4,jp,ibin) +   &
3277             3.*electrolyte(jna3hso4,jp,ibin)+   &
3278             electrolyte(jnahso4,jp,ibin) +   &
3279             electrolyte(jnamsa,jp,ibin)
3280
3281        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3282             electrolyte(jna2so4,jp,ibin) +   &
3283             2.*electrolyte(jna3hso4,jp,ibin)+   &
3284             electrolyte(jnahso4,jp,ibin) +   &
3285             electrolyte(jnh4so4,jp,ibin) +   &
3286             2.*electrolyte(jlvcite,jp,ibin) +   &
3287             electrolyte(jnh4hso4,jp,ibin)+   &
3288             electrolyte(jh2so4,jp,ibin)
3289        return
3290     endif
3291
3292
3293     if(js .eq. jnahso4)then
3294        aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
3295             electrolyte(js,jsolid,ibin)
3296        aer(iso4_a,jliquid,ibin) = aer(iso4_a,jliquid,ibin) +   &
3297             electrolyte(js,jsolid,ibin)
3298
3299        electrolyte(js,jsolid,ibin) = 0.0
3300
3301        aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
3302             electrolyte(jnacl,jp,ibin)   +   &
3303             2.*electrolyte(jna2so4,jp,ibin) +   &
3304             3.*electrolyte(jna3hso4,jp,ibin)+   &
3305             electrolyte(jnahso4,jp,ibin) +   &
3306             electrolyte(jnamsa,jp,ibin)
3307
3308        aer(iso4_a,jp,ibin) = electrolyte(jcaso4,jp,ibin)  +   &
3309             electrolyte(jna2so4,jp,ibin) +   &
3310             2.*electrolyte(jna3hso4,jp,ibin)+   &
3311             electrolyte(jnahso4,jp,ibin) +   &
3312             electrolyte(jnh4so4,jp,ibin) +   &
3313             2.*electrolyte(jlvcite,jp,ibin) +   &
3314             electrolyte(jnh4hso4,jp,ibin)+   &
3315             electrolyte(jh2so4,jp,ibin)
3316        return
3317     endif
3318
3319
3320     if(js .eq. jnh4no3)then
3321        aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
3322             electrolyte(js,jsolid,ibin)
3323        aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
3324             electrolyte(js,jsolid,ibin)
3325
3326        electrolyte(js,jsolid,ibin) = 0.0
3327
3328        aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
3329             electrolyte(jnh4cl,jp,ibin)  +   &
3330             2.*electrolyte(jnh4so4,jp,ibin) +   &
3331             3.*electrolyte(jlvcite,jp,ibin) +   &
3332             electrolyte(jnh4hso4,jp,ibin)+   &
3333             electrolyte(jnh4msa,jp,ibin)
3334
3335        aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
3336             2.*electrolyte(jcano3,jp,ibin)  +   &
3337             electrolyte(jnh4no3,jp,ibin) +   &
3338             electrolyte(jhno3,jp,ibin)
3339        return
3340     endif
3341
3342
3343     if(js .eq. jnh4cl)then
3344        aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) +   &
3345             electrolyte(js,jsolid,ibin)
3346        aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
3347             electrolyte(js,jsolid,ibin)
3348
3349        electrolyte(js,jsolid,ibin) = 0.0
3350
3351        aer(inh4_a,jp,ibin) = electrolyte(jnh4no3,jp,ibin) +   &
3352             electrolyte(jnh4cl,jp,ibin)  +   &
3353             2.*electrolyte(jnh4so4,jp,ibin) +   &
3354             3.*electrolyte(jlvcite,jp,ibin) +   &
3355             electrolyte(jnh4hso4,jp,ibin)+   &
3356             electrolyte(jnh4msa,jp,ibin)
3357
3358        aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
3359             2.*electrolyte(jcacl2,jp,ibin)  +   &
3360             electrolyte(jnh4cl,jp,ibin)  +   &
3361             electrolyte(jhcl,jp,ibin)
3362        return
3363     endif
3364
3365
3366     if(js .eq. jnano3)then
3367        aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
3368             electrolyte(js,jsolid,ibin)
3369        aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
3370             electrolyte(js,jsolid,ibin)
3371
3372        electrolyte(js,jsolid,ibin) = 0.0
3373
3374        aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
3375             electrolyte(jnacl,jp,ibin)   +   &
3376             2.*electrolyte(jna2so4,jp,ibin) +   &
3377             3.*electrolyte(jna3hso4,jp,ibin)+   &
3378             electrolyte(jnahso4,jp,ibin) +   &
3379             electrolyte(jnamsa,jp,ibin)
3380
3381        aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
3382             2.*electrolyte(jcano3,jp,ibin)  +   &
3383             electrolyte(jnh4no3,jp,ibin) +   &
3384             electrolyte(jhno3,jp,ibin)
3385        return
3386     endif
3387
3388
3389     if(js .eq. jnacl)then
3390        aer(ina_a,jliquid,ibin)  = aer(ina_a,jliquid,ibin) +   &
3391             electrolyte(js,jsolid,ibin)
3392        aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin) +   &
3393             electrolyte(js,jsolid,ibin)
3394
3395        electrolyte(js,jsolid,ibin) = 0.0
3396
3397        aer(ina_a,jp,ibin)  = electrolyte(jnano3,jp,ibin)  +   &
3398             electrolyte(jnacl,jp,ibin)   +   &
3399             2.*electrolyte(jna2so4,jp,ibin) +   &
3400             3.*electrolyte(jna3hso4,jp,ibin)+   &
3401             electrolyte(jnahso4,jp,ibin) +   &
3402             electrolyte(jnamsa,jp,ibin)
3403
3404        aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
3405             2.*electrolyte(jcacl2,jp,ibin)  +   &
3406             electrolyte(jnh4cl,jp,ibin)  +   &
3407             electrolyte(jhcl,jp,ibin)
3408        return
3409     endif
3410
3411
3412     if(js .eq. jcano3)then
3413        aer(ica_a,jliquid,ibin)  = aer(ica_a,jliquid,ibin) +   &
3414             electrolyte(js,jsolid,ibin)
3415        aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) +   &
3416             2.*electrolyte(js,jsolid,ibin)
3417
3418        electrolyte(js,jsolid,ibin) = 0.0
3419
3420        aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
3421             electrolyte(jcano3,jp,ibin)  +   &
3422             electrolyte(jcacl2,jp,ibin)  +   &
3423             electrolyte(jcaco3,jp,ibin)  +   &
3424             electrolyte(jcamsa2,jp,ibin)
3425
3426        aer(ino3_a,jp,ibin) = electrolyte(jnano3,jp,ibin)  +   &
3427             2.*electrolyte(jcano3,jp,ibin)  +   &
3428             electrolyte(jnh4no3,jp,ibin) +   &
3429             electrolyte(jhno3,jp,ibin)
3430        return
3431     endif
3432
3433
3434     if(js .eq. jcacl2)then
3435        aer(ica_a,jliquid,ibin) = aer(ica_a,jliquid,ibin) +   &
3436             electrolyte(js,jsolid,ibin)
3437        aer(icl_a,jliquid,ibin) = aer(icl_a,jliquid,ibin) +   &
3438             2.*electrolyte(js,jsolid,ibin)
3439
3440        electrolyte(js,jsolid,ibin) = 0.0
3441
3442        aer(ica_a,jp,ibin)  = electrolyte(jcaso4,jp,ibin)  +   &
3443             electrolyte(jcano3,jp,ibin)  +   &
3444             electrolyte(jcacl2,jp,ibin)  +   &
3445             electrolyte(jcaco3,jp,ibin)  +   &
3446             electrolyte(jcamsa2,jp,ibin)
3447
3448        aer(icl_a,jp,ibin)  = electrolyte(jnacl,jp,ibin)   +   &
3449             2.*electrolyte(jcacl2,jp,ibin)  +   &
3450             electrolyte(jnh4cl,jp,ibin)  +   &
3451             electrolyte(jhcl,jp,ibin)
3452        return
3453     endif
3454
3455     return
3456   end subroutine MESA_dissolve_small_salt
3457
3458
3459
3460   !***********************************************************************
3461   ! electrolyte formation subroutines
3462   !
3463   ! author: Rahul A. Zaveri
3464   ! update: june 2000
3465   !-----------------------------------------------------------------------
3466   subroutine form_caso4(store,jp,ibin,electrolyte)
3467     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
3468          iso4_a,ica_a,jcaso4
3469
3470     implicit none
3471
3472     ! subr arguments
3473     integer, intent(in) :: jp, ibin
3474     real(r8), intent(inout), dimension(naer) :: store
3475     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
3476
3477     electrolyte(jcaso4,jp,ibin) = min(store(ica_a),store(iso4_a))
3478     store(ica_a)  = ( (store(ica_a)) -   &
3479          (electrolyte(jcaso4,jp,ibin)) )
3480     store(iso4_a) = ( (store(iso4_a)) -   &
3481          (electrolyte(jcaso4,jp,ibin)) )
3482     store(ica_a)  = max(0.d0, store(ica_a))
3483     store(iso4_a) = max(0.d0, store(iso4_a))
3484
3485     return
3486   end subroutine form_caso4
3487
3488
3489
3490   subroutine form_camsa2(store,jp,ibin,electrolyte)
3491     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
3492          imsa_a,ica_a,jcamsa2
3493     implicit none
3494
3495     ! subr arguments
3496     integer, intent(in) :: jp, ibin
3497     real(r8), intent(inout), dimension(naer) :: store
3498     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
3499
3500     electrolyte(jcamsa2,jp,ibin) = min(store(ica_a),0.5*store(imsa_a))
3501     store(ica_a)  = ( (store(ica_a)) -   &
3502          (electrolyte(jcamsa2,jp,ibin)) )
3503     store(imsa_a) = ( (store(imsa_a)) -   &
3504          (2.*electrolyte(jcamsa2,jp,ibin)) )
3505     store(ica_a)  = max(0.d0, store(ica_a))
3506     store(imsa_a) = max(0.d0, store(imsa_a))
3507
3508     return
3509   end subroutine form_camsa2
3510
3511
3512
3513   !***********************************************************************
3514   ! computes mass transfer coefficients for each condensing species for
3515   ! all the aerosol bins
3516   !
3517   ! author: Rahul A. Zaveri
3518   ! update: jan 2005
3519   !-----------------------------------------------------------------------
3520   subroutine aerosolmtc( jaerosolstate, num_a, Dp_wet_a, sigmag_a, P_atm, T_K, kg )
3521
3522     use module_data_mosaic_aero,  only: r8, nbin_a_max, nbin_a, naer, naercomp,             &!Parameters
3523          ngas_aerchtot, ngas_volatile, nelectrolyte, ngas_ioa,                              &
3524          mMODAL, no_aerosol, mUNSTRUCTURED, mSECTIONAL, mSIZE_FRAMEWORK,                    &!Input
3525          isoa_first, mw_gas, v_molar_gas,                                                   &!TBD
3526          i_gas2bin_uptk_flag, m_gas2bin_uptk_flag,                                          &
3527          use_cam5mam_accom_coefs, mosaic_vars_aa_type
3528
3529
3530     implicit none
3531
3532     !Subroutine Arguments
3533     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate
3534
3535     real(r8), intent(in) :: P_atm,T_K
3536     real(r8), intent(in), dimension(nbin_a_max) :: num_a
3537     real(r8), intent(in), dimension(nbin_a_max) :: sigmag_a
3538     real(r8), intent(inout), dimension(nbin_a_max) :: Dp_wet_a
3539     real(r8), intent(inout), dimension(ngas_aerchtot,nbin_a_max) :: kg
3540
3541     ! local variables
3542     integer nghq
3543     parameter (nghq = 2)         ! gauss-hermite quadrature order
3544     integer ibin, iq, iv
3545     real(r8) :: tworootpi, root2, beta
3546     parameter (tworootpi = 3.5449077, root2 = 1.4142135, beta = 2.0)
3547     real(r8) :: cdum, Dp, Dp_avg, Fkn, Kn, lnsg, lnDpgn, lnDp, speed,   &
3548                 sumghq, tmpa
3549     real(r8) :: xghq(nghq), wghq(nghq)                           ! quadrature abscissae and weights
3550     real(r8) :: accom(ngas_aerchtot)                             ! keep local
3551     real(r8) :: freepath(ngas_aerchtot)                          ! keep local
3552     real(r8) :: Dg(ngas_aerchtot)                                ! keep local
3553     !real(r8) :: fuchs_sutugin                                   ! mosaic func
3554     !real(r8) :: gas_diffusivity                                 ! mosaic func
3555     !real(r8) :: mean_molecular_speed                            ! mosaic func
3556
3557     ! mass accommodation coefficients
3558     tmpa = 0.1
3559     if ( use_cam5mam_accom_coefs > 0 ) tmpa = 0.65
3560     accom(1:ngas_aerchtot) = tmpa  ! default
3561 !   accom(ih2so4_g)  = tmpa
3562 !   accom(ihno3_g)   = tmpa
3563 !   accom(ihcl_g)    = tmpa
3564 !   accom(inh3_g)    = tmpa
3565 !   accom(imsa_g)    = tmpa
3566 !   accom(iaro1_g)   = tmpa
3567 !   accom(iaro2_g)   = tmpa
3568 !   accom(ialk1_g)   = tmpa
3569 !   accom(iole1_g)   = tmpa
3570 !   accom(iapi1_g)   = tmpa
3571 !   accom(iapi2_g)   = tmpa
3572 !   accom(ilim1_g)   = tmpa
3573 !   accom(ilim2_g)   = tmpa
3574
3575     ! quadrature weights
3576     xghq(1) =  0.70710678
3577     xghq(2) = -0.70710678
3578     wghq(1) =  0.88622693
3579     wghq(2) =  0.88622693
3580
3581
3582     ! calculate gas diffusivity and mean free path for condensing gases
3583     ! ioa
3584     do iv = 1, ngas_ioa
3585        speed  = mean_molecular_speed(T_K,mw_gas(iv))     ! cm/s
3586        Dg(iv) = gas_diffusivity(T_K,P_atm,mw_gas(iv),v_molar_gas(iv)) ! cm^2/s
3587        freepath(iv) = 3.*Dg(iv)/speed                    ! cm
3588     enddo
3589
3590     ! soa
3591     do iv = isoa_first, ngas_volatile
3592        speed = mean_molecular_speed(T_K,mw_gas(iv))      ! cm/s
3593        Dg(iv) = 0.1                                      ! cm^2/s
3594        freepath(iv) = 3.*Dg(iv)/speed
3595     enddo
3596
3597 ! het-rct gases
3598     do iv = (ngas_volatile+1), ngas_aerchtot
3599        speed = mean_molecular_speed(t_k,mw_gas(iv))    ! cm/s
3600        dg(iv) = gas_diffusivity(t_k,p_atm,mw_gas(iv),v_molar_gas(iv)) ! cm^2/s
3601        freepath(iv) = 3.*dg(iv)/speed                  ! cm
3602     enddo
3603
3604
3605     ! calc mass transfer coefficients for gases over various aerosol bins
3606
3607     if (mSIZE_FRAMEWORK .eq. mMODAL) then
3608
3609        ! for modal approach
3610        do 10 ibin = 1, nbin_a
3611
3612           if(jaerosolstate(ibin) .eq. no_aerosol)goto 10
3613
3614           lnsg   = log(sigmag_a(ibin))
3615
3616           ! following 2 lines were incorrect as Dp_wet_a is wet "average" Dp
3617           !       Dpgn_a(ibin) = Dp_wet_a(ibin)  ! cm
3618           !       lnDpgn = log(Dpgn_a(ibin))
3619           ! do this instead which gives
3620           ! lnDpgn = ln( wet geometric-mean Dp of number distribution )
3621           lnDpgn = log(Dp_wet_a(ibin)) - 1.5*lnsg*lnsg
3622
3623           cdum   = tworootpi*num_a(ibin)*   &
3624                exp(beta*lnDpgn + 0.5*(beta*lnsg)**2)
3625
3626           do 20 iv = 1, ngas_aerchtot
3627
3628              sumghq = 0.0_r8
3629              do 30 iq = 1, nghq  ! sum over gauss-hermite quadrature points
3630                 lnDp = lnDpgn + beta*lnsg**2 + root2*lnsg*xghq(iq)
3631                 Dp = exp(lnDp)
3632                 Kn = 2.*freepath(iv)/Dp
3633                 Fkn = fuchs_sutugin(Kn,accom(iv))
3634                 sumghq = sumghq + wghq(iq)*Dp*Fkn/(Dp**beta)
3635 30              continue
3636
3637                 kg(iv,ibin) = cdum*Dg(iv)*sumghq         ! 1/s
3638
3639 20              continue
3640 10     continue
3641
3642     elseif ((mSIZE_FRAMEWORK .eq. mSECTIONAL   ) .or. &
3643          (mSIZE_FRAMEWORK .eq. mUNSTRUCTURED)) then
3644
3645        ! for sectional approach
3646        do 11 ibin = 1, nbin_a
3647
3648           if(jaerosolstate(ibin) .eq. no_aerosol)goto 11
3649
3650           cdum  = 6.283185*Dp_wet_a(ibin)*num_a(ibin)
3651
3652           do 21 iv = 1, ngas_aerchtot
3653              Kn = 2.*freepath(iv)/Dp_wet_a(ibin)
3654              Fkn = fuchs_sutugin(Kn,accom(iv))
3655              kg(iv,ibin) = cdum*Dg(iv)*Fkn              ! 1/s
3656 21           continue
3657
3658 11     continue
3659
3660     else
3661        call wrf_message('Error in the choice of mSIZE_FRAMEWORK')
3662        call wrf_error_fatal('Stopping in subr. aerosolmtc')
3663     endif
3664
3665
3666     if (m_gas2bin_uptk_flag <= 0) then
3667        ! when m_gas2bin_uptk_flag <= 0, some gases cannot condense onto every bin
3668        do ibin = 1, nbin_a
3669           do iv = 1, ngas_aerchtot
3670              if (i_gas2bin_uptk_flag(iv,ibin) <= 0) kg(iv,ibin) = 0.0
3671           end do
3672        end do
3673     end if
3674
3675     return
3676   end subroutine aerosolmtc
3677
3678
3679
3680   !***********************************************************************
3681   ! calculates dry and wet aerosol properties: density, refractive indices
3682   !
3683   ! author: Rahul A. Zaveri
3684   ! update: jan 2005
3685   !-----------------------------------------------------------------------
3686   subroutine calc_dry_n_wet_aerosol_props(                          &
3687      ibin, jaerosolstate, aer, electrolyte, water_a, num_a,         &  ! input
3688      dens_comp_a, mw_comp_a, dens_aer_mac, mw_aer_mac, ref_index_a, &  ! input
3689      Dp_dry_a, Dp_wet_a, dp_core_a,                                 &  ! output
3690      area_dry_a, area_wet_a, mass_dry_a, mass_wet_a,                &  ! output
3691      vol_dry_a, vol_wet_a, dens_dry_a, dens_wet_a,                  &  ! output
3692      ri_shell_a, ri_core_a, ri_avg_a                                )  ! output
3693     !      include 'v33com9a'
3694
3695     use module_data_mosaic_constants,  only: piover4,piover6,third
3696     use module_data_mosaic_aero,  only: r8,nbin_a_max,naer,nelectrolyte,naercomp,  &!Parameters
3697          ngas_soa,no_aerosol,msectional,                                           &!Parameters
3698          maeroptic_aero,msize_framework,                                           &!Input
3699          inh4_a,ina_a,ica_a,ico3_a,imsa_a,icl_a,ino3_a,jtotal,iso4_a,ioc_a,joc,    &!TBD
3700          ibc_a,jbc,ioin_a,join,jh2o, isoa_first, jsoa_first
3701
3702     use module_data_mosaic_asecthp, only: dcen_sect,isize_of_ibin,itype_of_ibin
3703
3704     implicit none
3705
3706     ! subr arguments
3707     integer, intent(in) :: ibin
3708     integer, intent(in), dimension(nbin_a_max) :: jaerosolstate
3709
3710     real(r8), intent(in), dimension(nbin_a_max) :: num_a
3711     real(r8), intent(in), dimension(naer) :: mw_aer_mac,dens_aer_mac
3712     real(r8), intent(in), dimension(naercomp) :: dens_comp_a,mw_comp_a
3713     real(r8), intent(inout), dimension(nbin_a_max) :: Dp_dry_a,Dp_wet_a
3714     real(r8), intent(inout), dimension(nbin_a_max) :: dp_core_a,vol_dry_a
3715     real(r8), intent(inout), dimension(nbin_a_max) :: vol_wet_a,dens_wet_a,water_a
3716     real(r8), intent(inout), dimension(nbin_a_max) :: area_dry_a,area_wet_a
3717     real(r8), intent(inout), dimension(nbin_a_max) :: mass_dry_a,mass_wet_a
3718     real(r8), intent(inout), dimension(nbin_a_max) :: dens_dry_a
3719     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
3720     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
3721
3722     complex, intent(in), dimension(naercomp) :: ref_index_a
3723     complex, intent(inout), dimension(nbin_a_max) :: ri_avg_a,ri_core_a,ri_shell_a
3724     ! local variables
3725     integer i, iaer, isize, itype, j, jc, je, k
3726     real(r8) :: aer_H, duma, vol_core, vol_shell, vol_dum
3727     real(r8),dimension(naercomp) :: comp_a
3728     complex rixvol_tot, rixvol_core, rixvol_shell
3729
3730
3731     ! calculate dry mass and dry volume of a bin
3732     mass_dry_a(ibin) = 0.0                ! initialize to 0.0
3733     vol_dry_a(ibin)  = 0.0                ! initialize to 0.0
3734     area_dry_a(ibin) = 0.0                ! initialize to 0.0
3735
3736     if(jaerosolstate(ibin) .ne. no_aerosol)then
3737
3738        aer_H = (2.*aer(iso4_a,jtotal,ibin) +   &
3739             aer(ino3_a,jtotal,ibin) +   &
3740             aer(icl_a,jtotal,ibin)  +   &
3741             aer(imsa_a,jtotal,ibin) +   &
3742             2.*aer(ico3_a,jtotal,ibin))-   &
3743             (2.*aer(ica_a,jtotal,ibin)  +   &
3744             aer(ina_a,jtotal,ibin)  +   &
3745             aer(inh4_a,jtotal,ibin))
3746        aer_H = max(aer_H, 0.0d0)
3747
3748        do iaer = 1, naer
3749           mass_dry_a(ibin) = mass_dry_a(ibin) +   &
3750                aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)     ! ng/m^3(air)
3751           vol_dry_a(ibin) = vol_dry_a(ibin) +   &
3752                aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer)          ! ncc/m^3(air)
3753        enddo
3754        mass_dry_a(ibin) = mass_dry_a(ibin) + aer_H
3755        vol_dry_a(ibin) = vol_dry_a(ibin) + aer_H
3756
3757        mass_dry_a(ibin) = mass_dry_a(ibin)*1.e-15                 ! g/cc(air)
3758        vol_dry_a(ibin) = vol_dry_a(ibin)*1.e-15                   ! cc(aer)/cc(air)
3759
3760        ! wet mass and wet volume
3761        mass_wet_a(ibin) = mass_dry_a(ibin) + water_a(ibin)*1.e-3  ! g/cc(air)
3762        vol_wet_a(ibin)  = vol_dry_a(ibin) + water_a(ibin)*1.e-3   ! cc(aer)/cc(air)
3763
3764        ! calculate mean dry and wet particle densities
3765        dens_dry_a(ibin) = mass_dry_a(ibin)/vol_dry_a(ibin)                ! g/cc(aerosol)
3766        dens_wet_a(ibin) = mass_wet_a(ibin)/vol_wet_a(ibin)                ! g/cc(aerosol)
3767
3768        ! calculate mean dry and wet particle diameters
3769        Dp_dry_a(ibin)=(vol_dry_a(ibin)/(piover6*num_a(ibin)))**third      ! cm
3770        Dp_wet_a(ibin)=(vol_wet_a(ibin)/(piover6*num_a(ibin)))**third      ! cm
3771
3772        ! calculate mean dry and wet particle surface areas
3773        area_dry_a(ibin)= piover4*num_a(ibin)*Dp_dry_a(ibin)**2    ! cm^2/cc(air)
3774        area_wet_a(ibin)= piover4*num_a(ibin)*Dp_wet_a(ibin)**2    ! cm^2/cc(air)
3775
3776        ! calculate volume average refractive index
3777        !   load comp_a array with component mass concentrations
3778
3779        ! rahul had turned this off, but it is needed
3780        !        if(1 == 1)go to 100               ! TEMP
3781        if (maeroptic_aero <= 0) goto 100
3782
3783        do je = 1, nelectrolyte
3784           comp_a(je)=electrolyte(je,jtotal,ibin)*mw_comp_a(je)*1.e-15     ! g/cc(air)
3785        enddo
3786        comp_a(joc)  = aer(ioc_a,  jtotal,ibin)*mw_comp_a(joc  )*1.e-15    ! g/cc(air)
3787        comp_a(jbc)  = aer(ibc_a,  jtotal,ibin)*mw_comp_a(jbc  )*1.e-15    ! g/cc(air)
3788        comp_a(join) = aer(ioin_a, jtotal,ibin)*mw_comp_a(join )*1.e-15    ! g/cc(air)
3789
3790 !      comp_a(jaro1)= aer(iaro1_a,jtotal,ibin)*mw_comp_a(jaro1)*1.e-15    ! g/cc(air)
3791 !      comp_a(jaro2)= aer(iaro2_a,jtotal,ibin)*mw_comp_a(jaro2)*1.e-15    ! g/cc(air)
3792 !      comp_a(jalk1)= aer(ialk1_a,jtotal,ibin)*mw_comp_a(jalk1)*1.e-15    ! g/cc(air)
3793 !      comp_a(jole1)= aer(iole1_a,jtotal,ibin)*mw_comp_a(jole1)*1.e-15    ! g/cc(air)
3794 !      comp_a(japi1)= aer(iapi1_a,jtotal,ibin)*mw_comp_a(japi1)*1.e-15    ! g/cc(air)
3795 !      comp_a(japi2)= aer(iapi2_a,jtotal,ibin)*mw_comp_a(japi2)*1.e-15    ! g/cc(air)
3796 !      comp_a(jlim1)= aer(ilim1_a,jtotal,ibin)*mw_comp_a(jlim1)*1.e-15    ! g/cc(air)
3797 !      comp_a(jlim2)= aer(ilim2_a,jtotal,ibin)*mw_comp_a(jlim2)*1.e-15    ! g/cc(air)
3798        do k = 1, ngas_soa
3799        j = jsoa_first + k - 1
3800        i = isoa_first + k - 1
3801        comp_a(j) = aer(i,jtotal,ibin)*mw_comp_a(j)*1.e-15    ! g/cc(air)
3802        end do
3803
3804        comp_a(jh2o) = water_a(ibin)*1.e-3                         ! g/cc(air)
3805
3806        rixvol_tot   = (0.0,0.0)
3807        do jc = 1, naercomp
3808           comp_a(jc) = max( 0.0d0, comp_a(jc) )
3809           rixvol_tot = rixvol_tot   &
3810                + ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
3811        enddo
3812        ri_avg_a(ibin) = rixvol_tot/vol_wet_a(ibin)
3813
3814        !
3815        ! shell/core calcs - first set values to default (corresponding to zero core)
3816        !
3817        ri_shell_a(ibin) = ri_avg_a(ibin)
3818        ri_core_a(ibin)  = (0.0,0.0)
3819        Dp_core_a(ibin)  = 0.0
3820
3821        ! sum ri*vol and vol for core species (bc and optionally oin=dust)
3822        ! currently just bc in core, but what about insoluble oin and dust species ???
3823        jc = jbc
3824        rixvol_core  = ref_index_a(jc)*comp_a(jc)/dens_comp_a(jc)
3825        vol_core = comp_a(jc)/dens_comp_a(jc)
3826        vol_core = max( 0.0d0, min( vol_core, vol_wet_a(ibin) ) )
3827
3828        ! neglect core if (core volume) < 1.0d-9*(total volume)
3829        !              or (core volume) < 1.0d-22 cm3 = (0.58 nm)**3
3830        ! neglect shell using similar criteria
3831        vol_dum = max( 1.0d-22, 1.0d-9*vol_wet_a(ibin) )
3832        vol_shell = vol_wet_a(ibin) - vol_core
3833        if (vol_core >= vol_dum) then
3834           if (vol_shell < vol_dum) then
3835              ri_shell_a(ibin)  = (0.0,0.0)
3836              ri_core_a(ibin) = ri_avg_a(ibin)
3837              Dp_core_a(ibin) = Dp_wet_a(ibin)
3838           else
3839              ri_core_a(ibin) = rixvol_core/vol_core
3840              Dp_core_a(ibin) = Dp_wet_a(ibin)   &
3841                   * (vol_core/vol_wet_a(ibin))**third
3842
3843              if (vol_shell >= vol_dum) then
3844                 rixvol_shell = rixvol_tot - rixvol_core
3845                 ri_shell_a(ibin) = rixvol_shell/vol_shell
3846              else
3847                 ri_shell_a(ibin) = (0.0,0.0)
3848              endif
3849           endif
3850        endif
3851
3852     else
3853        ! use defaults when (jaerosolstate(ibin) .eq. no_aerosol)
3854
3855        dens_dry_a(ibin) = 1.0      ! g/cc(aerosol)
3856        dens_wet_a(ibin) = 1.0      ! g/cc(aerosol)
3857        !        Dp_dry_a(ibin) = dcen_sect(ibin)  ! cm
3858        !        Dp_wet_a(ibin) = dcen_sect(ibin)  ! cm
3859        if (msize_framework == msectional) then
3860           isize = isize_of_ibin(ibin)
3861           itype = itype_of_ibin(ibin)
3862           Dp_dry_a(ibin) = dcen_sect(isize,itype)
3863           Dp_wet_a(ibin) = Dp_dry_a(ibin)
3864        end if
3865
3866        ri_avg_a(ibin) = (1.5,0.0)
3867        ri_shell_a(ibin) = (1.5,0.0)
3868        ri_core_a(ibin)  = (0.0,0.0)
3869        Dp_core_a(ibin)  = 0.0
3870
3871     endif   ! if(jaerosolstate(ibin) .ne. no_aerosol)then
3872
3873
3874 100 continue
3875
3876     return
3877   end subroutine calc_dry_n_wet_aerosol_props
3878
3879
3880
3881   !***********************************************************************
3882   ! forms electrolytes from ions
3883   !
3884   ! author: Rahul A. Zaveri
3885   ! update: june 2000
3886   !-----------------------------------------------------------------------
3887   subroutine form_electrolytes(jp,ibin,XT,aer,gas,electrolyte,total_species,tot_cl_in)
3888     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,           &
3889          ngas_aerchtot,ngas_volatile,nelectrolyte,jsolid,            &
3890          imsa_a,iso4_a,ica_a,ina_a,inh4_a,ino3_a,icl_a,ico3_a
3891
3892     implicit none
3893
3894     ! subr arguments
3895     integer, intent(in) :: ibin, jp
3896     real(r8), intent(inout) :: XT
3897     real(r8), intent(inout) :: tot_cl_in
3898     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
3899     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
3900     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
3901     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
3902     ! local variables
3903     integer i, iXT_case, j, je
3904     real(r8) :: sum_dum, XNa_prime, XNH4_prime, XT_prime
3905     real(r8) :: store(naer)
3906
3907     ! remove negative concentrations, if any
3908     !      do i=1,naer
3909     !        aer(i,jp,ibin) = max(0.0d0, aer(i,jp,ibin))  ! EFFI
3910     !      enddo
3911
3912
3913     !      call calculate_XT(ibin,jp,XT,aer)      ! EFFI
3914
3915     if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
3916        XT   = ( aer(inh4_a,jp,ibin) +   &
3917             aer(ina_a,jp,ibin)  +   &
3918             2.*aer(ica_a,jp,ibin) )/   &
3919             (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
3920     else
3921        XT   = -1.0
3922     endif
3923
3924
3925
3926
3927 !   if(XT .ge. 1.9999 .or. XT.lt.0.)then
3928     if(XT .ge. 2.0 .or. XT.lt.0.)then         ! RAZ 11/10/2014
3929        iXT_case = 1       ! near neutral (acidity is caused by HCl and/or HNO3)
3930     else
3931        iXT_case = 2       ! acidic (acidity is caused by excess SO4)
3932     endif
3933
3934     ! initialize
3935     !
3936     ! put total aer(*) into store(*)
3937     store(iso4_a) = aer(iso4_a,jp,ibin)
3938     store(ino3_a) = aer(ino3_a,jp,ibin)
3939     store(icl_a)  = aer(icl_a, jp,ibin)
3940     store(imsa_a) = aer(imsa_a,jp,ibin)
3941     store(ico3_a) = aer(ico3_a,jp,ibin)
3942     store(inh4_a) = aer(inh4_a,jp,ibin)
3943     store(ina_a)  = aer(ina_a, jp,ibin)
3944     store(ica_a)  = aer(ica_a, jp,ibin)
3945
3946     do j=1,nelectrolyte
3947        electrolyte(j,jp,ibin) = 0.0
3948     enddo
3949
3950     !
3951     !---------------------------------------------------------
3952     !
3953     if(iXT_case.eq.1)then
3954
3955        ! XT >= 2   : sulfate deficient
3956        call form_caso4(store,jp,ibin,electrolyte)
3957        call form_camsa2(store,jp,ibin,electrolyte)
3958        call form_na2so4(store,jp,ibin,electrolyte)
3959        call form_namsa(store,jp,ibin,electrolyte)
3960        call form_cano3(store,jp,ibin,electrolyte)
3961        call form_nano3(store,jp,ibin,electrolyte)
3962        call form_nacl(store,jp,ibin,aer,gas,electrolyte,total_species,tot_cl_in)
3963        call form_cacl2(store,jp,ibin,electrolyte)
3964        call form_caco3(store,jp,ibin,aer,electrolyte)
3965        call form_nh4so4(store,jp,ibin,electrolyte)
3966        call form_nh4msa(store,jp,ibin,electrolyte)
3967        call form_nh4no3(store,jp,ibin,electrolyte)
3968        call form_nh4cl(store,jp,ibin,electrolyte)
3969        call form_msa(store,jp,ibin,electrolyte)
3970
3971        if(jp .eq. jsolid)then
3972           call degas_hno3(store,jp,ibin,aer,gas,electrolyte)
3973           call degas_hcl(store,jp,ibin,aer,gas,electrolyte)
3974           call degas_nh3(store,jp,ibin,aer,gas)
3975        else
3976           call form_hno3(store,jp,ibin,electrolyte)
3977           call form_hcl(store,jp,ibin,electrolyte)
3978           call degas_nh3(store,jp,ibin,aer,gas)
3979        endif
3980
3981
3982
3983     elseif(iXT_case.eq.2)then
3984
3985        ! XT < 2   : sulfate enough or sulfate excess
3986
3987        call form_caso4(store,jp,ibin,electrolyte)
3988        call form_camsa2(store,jp,ibin,electrolyte)
3989        call form_namsa(store,jp,ibin,electrolyte)
3990        call form_nh4msa(store,jp,ibin,electrolyte)
3991        call form_msa(store,jp,ibin,electrolyte)
3992
3993        if(store(iso4_a).eq.0.0)goto 10
3994
3995
3996        XT_prime =(store(ina_a)+store(inh4_a))/   &
3997             store(iso4_a)
3998        XNa_prime=0.5*store(ina_a)/store(iso4_a) + 1.
3999
4000        if(XT_prime.ge.XNa_prime)then
4001           call form_na2so4(store,jp,ibin,electrolyte)
4002           XNH4_prime = 0.0
4003           if(store(iso4_a).gt.1.e-15)then
4004              XNH4_prime = store(inh4_a)/store(iso4_a)
4005           endif
4006
4007           if(XNH4_prime .ge. 1.5)then
4008              call form_nh4so4_lvcite(store,jp,ibin,electrolyte)
4009           else
4010              call form_lvcite_nh4hso4(store,jp,ibin,electrolyte)
4011           endif
4012
4013        elseif(XT_prime.ge.1.)then
4014           call form_nh4hso4(store,jp,ibin,electrolyte)
4015           call form_na2so4_nahso4(store,jp,ibin,electrolyte)
4016        elseif(XT_prime.lt.1.)then
4017           call form_nahso4(store,jp,ibin,electrolyte)
4018           call form_nh4hso4(store,jp,ibin,electrolyte)
4019           call form_h2so4(store,jp,ibin,electrolyte)
4020        endif
4021
4022 10     if(jp .eq. jsolid)then
4023           call degas_hno3(store,jp,ibin,aer,gas,electrolyte)
4024           call degas_hcl(store,jp,ibin,aer,gas,electrolyte)
4025           call degas_nh3(store,jp,ibin,aer,gas)
4026        else
4027           call form_hno3(store,jp,ibin,electrolyte)
4028           call form_hcl(store,jp,ibin,electrolyte)
4029           call degas_nh3(store,jp,ibin,aer,gas)
4030        endif
4031
4032     endif ! case 1, 2
4033
4034
4035     ! re-calculate ions to eliminate round-off errors
4036     call electrolytes_to_ions(jp, ibin,aer,electrolyte)
4037     !---------------------------------------------------------
4038     !
4039     ! calculate % composition EFFI
4040     !!      sum_dum = 0.0
4041     !!      do je = 1, nelectrolyte
4042     !!        electrolyte(je,jp,ibin) = max(0.d0,electrolyte(je,jp,ibin)) ! remove -ve  EFFI
4043     !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
4044     !!      enddo
4045     !!
4046     !!      if(sum_dum .eq. 0.)sum_dum = 1.0
4047     !!      electrolyte_sum(jp,ibin) = sum_dum
4048     !!
4049     !!      do je = 1, nelectrolyte
4050     !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
4051     !!      enddo
4052
4053
4054     return
4055   end subroutine form_electrolytes
4056
4057
4058
4059    subroutine form_na2so4(store,jp,ibin,electrolyte)
4060     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4061          iso4_a,ina_a,jna2so4
4062     implicit none
4063
4064     ! subr arguments
4065     integer, intent(in) :: jp, ibin
4066     real(r8), intent(inout), dimension(naer) :: store(naer)
4067     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4068     electrolyte(jna2so4,jp,ibin) = min(.5*store(ina_a),   &
4069          store(iso4_a))
4070     store(ina_a) =( (store(ina_a)) -   &
4071          (2.*electrolyte(jna2so4,jp,ibin)) )
4072     store(iso4_a)=( (store(iso4_a)) -   &
4073          (electrolyte(jna2so4,jp,ibin)) )
4074     store(ina_a) =max(0.d0, store(ina_a))
4075     store(iso4_a)=max(0.d0, store(iso4_a))
4076
4077     return
4078   end subroutine form_na2so4
4079
4080
4081
4082   subroutine form_nahso4(store,jp,ibin,electrolyte)
4083     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4084          iso4_a,ina_a,jnahso4
4085
4086     implicit none
4087
4088     ! subr arguments
4089     integer, intent(in) :: jp, ibin
4090     real(r8), intent(inout), dimension(naer) :: store
4091     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4092
4093     electrolyte(jnahso4,jp,ibin) = min(store(ina_a),   &
4094          store(iso4_a))
4095     store(ina_a)  = ( (store(ina_a)) -   &
4096          (electrolyte(jnahso4,jp,ibin)) )
4097     store(iso4_a) = ( (store(iso4_a)) -   &
4098          (electrolyte(jnahso4,jp,ibin)) )
4099     store(ina_a)  = max(0.d0, store(ina_a))
4100     store(iso4_a) = max(0.d0, store(iso4_a))
4101
4102     return
4103   end subroutine form_nahso4
4104
4105
4106
4107   subroutine form_namsa(store,jp,ibin,electrolyte)
4108     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4109          imsa_a,ina_a,jnamsa
4110     implicit none
4111
4112     ! subr arguments
4113     integer, intent(in) :: jp, ibin
4114     real(r8), intent(inout), dimension(naer)  :: store
4115     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4116
4117     electrolyte(jnamsa,jp,ibin) = min(store(ina_a),   &
4118          store(imsa_a))
4119     store(ina_a)  = ( (store(ina_a)) -   &
4120          (electrolyte(jnamsa,jp,ibin)) )
4121     store(imsa_a) = ( (store(imsa_a)) -   &
4122          (electrolyte(jnamsa,jp,ibin)) )
4123     store(ina_a)  = max(0.d0, store(ina_a))
4124     store(imsa_a) = max(0.d0, store(imsa_a))
4125
4126     return
4127   end subroutine form_namsa
4128
4129
4130
4131   subroutine form_nano3(store,jp,ibin,electrolyte)
4132     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4133          ino3_a,ina_a,jnano3
4134     implicit none
4135
4136     ! subr arguments
4137     integer, intent(in) :: jp, ibin
4138     real(r8), intent(inout), dimension(naer) :: store
4139     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4140
4141     electrolyte(jnano3,jp,ibin)=min(store(ina_a),store(ino3_a))
4142     store(ina_a)  = ( (store(ina_a)) -   &
4143          (electrolyte(jnano3,jp,ibin)) )
4144     store(ino3_a) = ( (store(ino3_a)) -   &
4145          (electrolyte(jnano3,jp,ibin)) )
4146     store(ina_a)  = max(0.d0, store(ina_a))
4147     store(ino3_a) = max(0.d0, store(ino3_a))
4148
4149     return
4150   end subroutine form_nano3
4151
4152
4153
4154   subroutine form_cano3(store,jp,ibin,electrolyte)        ! Ca(NO3)2
4155     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4156          ino3_a,ica_a,jcano3
4157     implicit none
4158
4159     ! subr arguments
4160     integer, intent(in) :: jp, ibin
4161     real(r8), intent(inout), dimension(naer) :: store
4162     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4163
4164     electrolyte(jcano3,jp,ibin) = min(store(ica_a),0.5*store(ino3_a))
4165
4166     store(ica_a)  = ( (store(ica_a)) -   &
4167          (electrolyte(jcano3,jp,ibin)) )
4168     store(ino3_a) = ( (store(ino3_a)) -   &
4169          (2.*electrolyte(jcano3,jp,ibin)) )
4170     store(ica_a)  = max(0.d0, store(ica_a))
4171     store(ino3_a) = max(0.d0, store(ino3_a))
4172
4173     return
4174   end subroutine form_cano3
4175
4176
4177
4178   subroutine form_cacl2(store,jp,ibin,electrolyte)
4179     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4180          icl_a,ica_a,jcacl2
4181
4182     implicit none
4183
4184     ! subr arguments
4185     integer, intent(in) :: jp, ibin
4186     real(r8), intent(inout), dimension(naer) :: store
4187     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4188
4189     electrolyte(jcacl2,jp,ibin) = min(store(ica_a),0.5*store(icl_a))
4190
4191     store(ica_a)  = ( (store(ica_a)) -   &
4192          (electrolyte(jcacl2,jp,ibin)) )
4193     store(icl_a)  = ( (store(icl_a)) -   &
4194          (2.*electrolyte(jcacl2,jp,ibin)) )
4195     store(ica_a)  = max(0.d0, store(ica_a))
4196     store(icl_a)  = max(0.d0, store(icl_a))
4197
4198     return
4199   end subroutine form_cacl2
4200
4201
4202   subroutine form_caco3(store,jp,ibin,aer,electrolyte)
4203     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,jsolid,     &
4204          jtotal,                                                                   &
4205          ica_a,jcaco3,ico3_a
4206
4207     implicit none
4208
4209     ! subr arguments
4210     integer, intent(in) :: jp, ibin
4211     real(r8), intent(inout), dimension(naer) :: store
4212     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4213     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4214
4215     if(jp.eq.jtotal .or. jp.eq.jsolid)then
4216        electrolyte(jcaco3,jp,ibin) = store(ica_a)
4217
4218        aer(ico3_a,jp,ibin)= electrolyte(jcaco3,jp,ibin)   ! force co3 = caco3
4219
4220        store(ica_a) = 0.0
4221        store(ico3_a)= 0.0
4222     endif
4223
4224     return
4225   end subroutine form_caco3
4226
4227
4228
4229   subroutine form_nacl(store,jp,ibin,aer,gas,electrolyte,total_species,tot_cl_in)
4230     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4231          ngas_aerchtot,ngas_volatile,jtotal,jsolid,jliquid,                        &
4232          ina_a,jnacl,icl_a,ihcl_g
4233
4234     implicit none
4235
4236     ! subr arguments
4237     integer, intent(in) :: jp, ibin
4238     real(r8), intent(inout), dimension(naer) :: store
4239     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4240     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
4241     real(r8), intent(inout) :: tot_cl_in
4242     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4243     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4244     ! local
4245
4246     electrolyte(jnacl,jp,ibin) = store(ina_a)
4247
4248     store(ina_a) = 0.0
4249     store(icl_a) = ( (store(icl_a)) -   &
4250          (electrolyte(jnacl,jp,ibin)) )
4251
4252     if(store(icl_a) .lt. 0.)then                          ! cl deficit in aerosol. take some from gas
4253        aer(icl_a,jp,ibin)= aer(icl_a,jp,ibin)- store(icl_a)       ! update aer(icl_a)
4254
4255        if(jp .ne. jtotal)then
4256           aer(icl_a,jtotal,ibin)= aer(icl_a,jliquid,ibin)+ &      ! update for jtotal
4257                aer(icl_a,jsolid,ibin)
4258        endif
4259
4260        gas(ihcl_g) = gas(ihcl_g) + store(icl_a)                   ! update gas(ihcl_g)
4261
4262        if(gas(ihcl_g) .lt. 0.0)then
4263           total_species(ihcl_g) = total_species(ihcl_g) - gas(ihcl_g)     ! update total_species
4264           tot_cl_in = tot_cl_in - gas(ihcl_g)                             ! update tot_cl_in
4265        endif
4266
4267        gas(ihcl_g) = max(0.d0, gas(ihcl_g))                               ! restrict gas(ihcl_g) to >= 0.
4268        store(icl_a) = 0.                                          ! force store(icl_a) to 0.
4269
4270     endif
4271
4272     store(icl_a) = max(0.d0, store(icl_a))
4273
4274     return
4275   end subroutine form_nacl
4276
4277
4278
4279   subroutine form_nh4so4(store,jp,ibin,electrolyte)       ! (nh4)2so4
4280     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4281          iso4_a,inh4_a,jnh4so4
4282     implicit none
4283
4284     ! subr arguments
4285     integer, intent(in) :: jp, ibin
4286     real(r8), intent(inout), dimension(naer) :: store
4287     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4288
4289     electrolyte(jnh4so4,jp,ibin)= min(.5*store(inh4_a),   &
4290          store(iso4_a))
4291     store(inh4_a)= ( (store(inh4_a)) -   &
4292          (2.*electrolyte(jnh4so4,jp,ibin)) )
4293     store(iso4_a)= ( (store(iso4_a)) -   &
4294          (electrolyte(jnh4so4,jp,ibin)) )
4295     store(inh4_a) = max(0.d0, store(inh4_a))
4296     store(iso4_a) = max(0.d0, store(iso4_a))
4297
4298     return
4299   end subroutine form_nh4so4
4300
4301
4302
4303   subroutine form_nh4hso4(store,jp,ibin,electrolyte)      ! nh4hso4
4304     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4305          iso4_a,inh4_a,jnh4hso4
4306     implicit none
4307
4308     ! subr arguments
4309     integer, intent(in) :: jp, ibin
4310     real(r8), intent(inout), dimension(naer) :: store
4311     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4312
4313     electrolyte(jnh4hso4,jp,ibin) = min(store(inh4_a),   &
4314          store(iso4_a))
4315     store(inh4_a)= ( (store(inh4_a)) -   &
4316          (electrolyte(jnh4hso4,jp,ibin)) )
4317     store(iso4_a)= ( (store(iso4_a)) -   &
4318          (electrolyte(jnh4hso4,jp,ibin)) )
4319     store(inh4_a) = max(0.d0, store(inh4_a))
4320     store(iso4_a) = max(0.d0, store(iso4_a))
4321
4322     return
4323   end subroutine form_nh4hso4
4324
4325
4326
4327   subroutine form_nh4msa(store,jp,ibin,electrolyte)
4328     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4329          imsa_a,inh4_a,jnh4msa
4330     implicit none
4331
4332     ! subr arguments
4333     integer, intent(in) :: jp, ibin
4334     real(r8), intent(inout), dimension(naer) :: store
4335     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4336
4337     electrolyte(jnh4msa,jp,ibin) = min(store(inh4_a),   &
4338          store(imsa_a))
4339     store(inh4_a) = ( (store(inh4_a)) -   &
4340          (electrolyte(jnh4msa,jp,ibin)) )
4341     store(imsa_a) = ( (store(imsa_a)) -   &
4342          (electrolyte(jnh4msa,jp,ibin)) )
4343     store(inh4_a) = max(0.d0, store(inh4_a))
4344     store(imsa_a) = max(0.d0, store(imsa_a))
4345
4346     return
4347   end subroutine form_nh4msa
4348
4349
4350
4351   subroutine form_nh4cl(store,jp,ibin,electrolyte)
4352     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4353          icl_a,inh4_a,jnh4cl
4354     implicit none
4355
4356     ! subr arguments
4357     integer, intent(in) :: jp, ibin
4358     real(r8), intent(inout), dimension(naer) :: store
4359     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4360
4361     electrolyte(jnh4cl,jp,ibin) = min(store(inh4_a),   &
4362          store(icl_a))
4363     store(inh4_a) = ( (store(inh4_a)) -   &
4364          (electrolyte(jnh4cl,jp,ibin)) )
4365     store(icl_a)  = ( (store(icl_a)) -   &
4366          (electrolyte(jnh4cl,jp,ibin)) )
4367     store(inh4_a) = max(0.d0, store(inh4_a))
4368     store(icl_a)  = max(0.d0, store(icl_a))
4369
4370     return
4371   end subroutine form_nh4cl
4372
4373
4374
4375   subroutine form_nh4no3(store,jp,ibin,electrolyte)
4376     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4377          ino3_a,inh4_a,jnh4no3
4378     implicit none
4379
4380     ! subr arguments
4381     integer, intent(in) :: jp, ibin
4382     real(r8), intent(inout), dimension(naer) :: store
4383     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4384
4385     electrolyte(jnh4no3,jp,ibin) = min(store(inh4_a),   &
4386          store(ino3_a))
4387     store(inh4_a) = ( (store(inh4_a)) -   &
4388          (electrolyte(jnh4no3,jp,ibin)) )
4389     store(ino3_a) = ( (store(ino3_a)) -   &
4390          (electrolyte(jnh4no3,jp,ibin)) )
4391     store(inh4_a) = max(0.d0, store(inh4_a))
4392     store(ino3_a) = max(0.d0, store(ino3_a))
4393
4394     return
4395   end subroutine form_nh4no3
4396
4397
4398
4399   subroutine form_nh4so4_lvcite(store,jp,ibin,electrolyte) ! (nh4)2so4 + (nh4)3h(so4)2
4400     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4401          iso4_a,inh4_a,jnh4so4,jlvcite
4402     implicit none
4403
4404     ! subr arguments
4405     integer, intent(in) :: jp, ibin
4406     real(r8), intent(inout), dimension(naer) :: store
4407     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4408
4409     electrolyte(jnh4so4,jp,ibin)= ( (2.*store(inh4_a)) -   &
4410          (3.*store(iso4_a)) )
4411     electrolyte(jlvcite,jp,ibin)= ( (2.*store(iso4_a)) -   &
4412          (store(inh4_a)) )
4413     electrolyte(jnh4so4,jp,ibin)= max(0.d0,   &
4414          electrolyte(jnh4so4,jp,ibin))
4415     electrolyte(jlvcite,jp,ibin)= max(0.d0,   &
4416          electrolyte(jlvcite,jp,ibin))
4417     store(inh4_a) = 0.
4418     store(iso4_a) = 0.
4419
4420     return
4421   end subroutine form_nh4so4_lvcite
4422
4423
4424
4425   subroutine form_lvcite_nh4hso4(store,jp,ibin,electrolyte) ! (nh4)3h(so4)2 + nh4hso4
4426     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4427          iso4_a,inh4_a,jlvcite,jnh4hso4
4428     implicit none
4429
4430     ! subr arguments
4431     integer, intent(in) ::  jp, ibin
4432     real(r8), intent(inout), dimension(naer) :: store
4433     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4434
4435     electrolyte(jlvcite,jp,ibin) = ( (store(inh4_a)) -   &
4436          (store(iso4_a)) )
4437     electrolyte(jnh4hso4,jp,ibin)= ( (3.*store(iso4_a)) -   &
4438          (2.*store(inh4_a)) )
4439     electrolyte(jlvcite,jp,ibin) = max(0.d0,   &
4440          electrolyte(jlvcite,jp,ibin))
4441     electrolyte(jnh4hso4,jp,ibin)= max(0.d0,   &
4442          electrolyte(jnh4hso4,jp,ibin))
4443     store(inh4_a) = 0.
4444     store(iso4_a) = 0.
4445
4446     return
4447   end subroutine form_lvcite_nh4hso4
4448
4449
4450
4451   subroutine form_na2so4_nahso4(store,jp,ibin,electrolyte) ! na2so4 + nahso4
4452     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4453          iso4_a,ina_a,jna2so4,jnahso4
4454     implicit none
4455
4456     ! subr arguments
4457     integer, intent(in) :: jp, ibin
4458     real(r8), intent(inout), dimension(naer) :: store
4459     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4460
4461     electrolyte(jna2so4,jp,ibin)= ( (store(ina_a)) -   &
4462          (store(iso4_a)) )
4463     electrolyte(jnahso4,jp,ibin)= ( (2.*store(iso4_a))-   &
4464          (store(ina_a)) )
4465     electrolyte(jna2so4,jp,ibin)= max(0.d0,   &
4466          electrolyte(jna2so4,jp,ibin))
4467     electrolyte(jnahso4,jp,ibin)= max(0.d0,   &
4468          electrolyte(jnahso4,jp,ibin))
4469     store(ina_a)  = 0.
4470     store(iso4_a) = 0.
4471
4472     !     write(6,*)'na2so4 + nahso4'
4473
4474     return
4475   end subroutine form_na2so4_nahso4
4476
4477
4478
4479   subroutine form_h2so4(store,jp,ibin,electrolyte)
4480     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4481          iso4_a,jh2so4
4482     implicit none
4483
4484     ! subr arguments
4485     integer, intent(in) ::  jp, ibin
4486     real(r8), intent(inout), dimension(naer) :: store
4487     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4488
4489     electrolyte(jh2so4,jp,ibin) = max(0.0d0, store(iso4_a))
4490     store(iso4_a) = 0.0
4491
4492     return
4493   end subroutine form_h2so4
4494
4495
4496
4497   subroutine form_msa(store,jp,ibin,electrolyte)
4498     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4499          imsa_a,jmsa
4500     implicit none
4501
4502     ! subr arguments
4503     integer, intent(in) ::  jp, ibin
4504     real(r8), intent(inout), dimension(naer) :: store
4505     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4506
4507     electrolyte(jmsa,jp,ibin) = max(0.0d0, store(imsa_a))
4508     store(imsa_a) = 0.0
4509
4510     return
4511   end subroutine form_msa
4512
4513
4514
4515   subroutine form_hno3(store,jp,ibin,electrolyte)
4516     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4517          ino3_a,jhno3
4518     implicit none
4519
4520     ! subr arguments
4521     integer, intent(in) :: jp, ibin
4522     real(r8), intent(inout), dimension(naer) :: store
4523     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4524
4525     electrolyte(jhno3,jp,ibin) = max(0.0d0, store(ino3_a))
4526     store(ino3_a) = 0.0
4527
4528     return
4529   end subroutine form_hno3
4530
4531
4532
4533   subroutine form_hcl(store,jp,ibin,electrolyte)
4534     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4535          icl_a,jhcl
4536     implicit none
4537
4538     ! subr arguments
4539     integer, intent(in) :: jp, ibin
4540     real(r8), intent(inout), dimension(naer) :: store
4541     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4542
4543     electrolyte(jhcl,jp,ibin) = max(0.0d0, store(icl_a))
4544     store(icl_a) = 0.0
4545
4546     return
4547   end subroutine form_hcl
4548
4549
4550
4551  subroutine degas_hno3(store,jp,ibin,aer,gas,electrolyte)
4552     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4553          ngas_aerchtot,jtotal,jliquid,jsolid,                                      &
4554          ino3_a,ihno3_g,jhno3
4555
4556     implicit none
4557
4558     ! subr arguments
4559     integer, intent(in) :: jp, ibin
4560     real(r8), intent(inout), dimension(naer) :: store
4561     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4562     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4563     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4564
4565     store(ino3_a) = max(0.0d0, store(ino3_a))
4566     gas(ihno3_g) = gas(ihno3_g) + store(ino3_a)
4567     aer(ino3_a,jp,ibin) = ( (aer(ino3_a,jp,ibin)) -   &
4568          (store(ino3_a)) )
4569     aer(ino3_a,jp,ibin) = max(0.0d0,aer(ino3_a,jp,ibin))
4570
4571     ! also do it for jtotal
4572     if(jp .ne. jtotal)then
4573        aer(ino3_a,jtotal,ibin) = aer(ino3_a,jsolid, ibin) +   &
4574             aer(ino3_a,jliquid,ibin)
4575     endif
4576
4577     electrolyte(jhno3,jp,ibin) = 0.0
4578     store(ino3_a) = 0.0
4579
4580     return
4581   end subroutine degas_hno3
4582
4583
4584
4585   subroutine degas_hcl(store,jp,ibin,aer,gas,electrolyte)
4586     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4587          ngas_aerchtot,jtotal,jliquid,jsolid,                                      &
4588          icl_a,ihcl_g,jhcl
4589     implicit none
4590
4591     ! subr arguments
4592     integer, intent(in) :: jp, ibin
4593     real(r8), intent(inout) :: store(naer)
4594     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4595     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4596     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4597
4598     store(icl_a) = max(0.0d0, store(icl_a))
4599     gas(ihcl_g) = gas(ihcl_g) + store(icl_a)
4600     aer(icl_a,jp,ibin) = ( (aer(icl_a,jp,ibin)) -   &
4601          (store(icl_a)) )
4602     aer(icl_a,jp,ibin) = max(0.0d0,aer(icl_a,jp,ibin))
4603
4604     ! also do it for jtotal
4605     if(jp .ne. jtotal)then
4606        aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid, ibin) +   &
4607             aer(icl_a,jliquid,ibin)
4608     endif
4609
4610     electrolyte(jhcl,jp,ibin) = 0.0
4611     store(icl_a) = 0.0
4612
4613     return
4614   end subroutine degas_hcl
4615
4616
4617
4618   subroutine degas_nh3(store,jp,ibin,aer,gas)
4619     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4620          ngas_aerchtot,jtotal,jliquid,jsolid,                                      &
4621          inh3_g,inh4_a
4622
4623     implicit none
4624
4625     ! subr arguments
4626     integer, intent(in) :: jp, ibin
4627     real(r8), intent(inout) :: store(naer)
4628     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4629     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4630
4631     store(inh4_a) = max(0.0d0, store(inh4_a))
4632     gas(inh3_g) = gas(inh3_g) + store(inh4_a)
4633     aer(inh4_a,jp,ibin) = ( (aer(inh4_a,jp,ibin)) -   &
4634          (store(inh4_a)) )
4635     aer(inh4_a,jp,ibin) = max(0.0d0,aer(inh4_a,jp,ibin))
4636
4637     ! also do it for jtotal
4638     if(jp .ne. jtotal)then
4639        aer(inh4_a,jtotal,ibin)= aer(inh4_a,jsolid, ibin) +   &
4640             aer(inh4_a,jliquid,ibin)
4641     endif
4642
4643     store(inh4_a) = 0.0
4644
4645     return
4646   end subroutine degas_nh3
4647
4648
4649
4650   !***********************************************************************
4651   ! subroutines to absorb and degas small amounts of volatile species
4652   !
4653   ! author: Rahul A. Zaveri
4654   ! update: jun 2002
4655   !-----------------------------------------------------------------------
4656   !
4657   ! nh4no3 (liquid)
4658   subroutine absorb_tiny_nh4no3(ibin,aer,gas,electrolyte,delta_nh3_max,            &
4659        delta_hno3_max,electrolyte_sum)
4660     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4661          ngas_aerchtot,jtotal,jliquid,jsolid,                                      &
4662          inh4_a,ino3_a,inh3_g,ihno3_g
4663     implicit none
4664
4665     ! subr arguments
4666     integer, intent(in) :: ibin
4667     real(r8), intent(inout), dimension(nbin_a_max) :: delta_nh3_max,delta_hno3_max
4668     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4669     real(r8), intent(inout), dimension(3,nbin_a_max) :: electrolyte_sum
4670     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4671     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4672     ! local variables
4673     integer je
4674     real(r8) :: small_aer, small_gas, small_amt
4675
4676
4677
4678     !! EFFI
4679     electrolyte_sum(jtotal,ibin) = 0.0
4680     do je = 1, nelectrolyte
4681        electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
4682             electrolyte(je,jtotal,ibin)
4683     enddo
4684     !! EFFI
4685
4686
4687     small_gas = 0.01 * min(delta_nh3_max(ibin),delta_hno3_max(ibin))
4688     small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
4689     if(small_aer .eq. 0.0)small_aer = small_gas
4690
4691     small_amt = min(small_gas, small_aer)
4692
4693     aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
4694     aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
4695
4696     ! update jtotal
4697     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
4698          aer(inh4_a,jliquid,ibin)
4699     aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
4700          aer(ino3_a,jliquid,ibin)
4701
4702     ! update gas
4703     gas(inh3_g)  = ((gas(inh3_g)) - (small_amt))
4704     gas(ihno3_g) = ((gas(ihno3_g)) - (small_amt))
4705
4706     return
4707   end subroutine absorb_tiny_nh4no3
4708
4709
4710
4711   !--------------------------------------------------------------------
4712   ! nh4cl (liquid)
4713   subroutine absorb_tiny_nh4cl(ibin,aer,gas,electrolyte,delta_nh3_max,             &
4714        delta_hcl_max,electrolyte_sum)
4715     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4716          ngas_aerchtot,jtotal,jliquid,jsolid,                                      &
4717          inh4_a,icl_a,inh3_g,ihcl_g
4718     implicit none
4719
4720     ! subr arguments
4721     integer, intent(in) :: ibin
4722     real(r8), intent(inout), dimension(nbin_a_max) :: delta_nh3_max,delta_hcl_max
4723     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4724     real(r8), intent(inout), dimension(3,nbin_a_max) :: electrolyte_sum
4725     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4726     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4727     ! local variables
4728     integer je
4729     real(r8) :: small_aer, small_gas, small_amt
4730
4731
4732     !! EFFI
4733     electrolyte_sum(jtotal,ibin) = 0.0
4734     do je = 1, nelectrolyte
4735        electrolyte_sum(jtotal,ibin) = electrolyte_sum(jtotal,ibin) + &
4736             electrolyte(je,jtotal,ibin)
4737     enddo
4738     !! EFFI
4739
4740
4741
4742     small_gas = 0.01 * min(delta_nh3_max(ibin), delta_hcl_max(ibin))
4743     small_aer = 0.01 * electrolyte_sum(jtotal,ibin)
4744     if(small_aer .eq. 0.0)small_aer = small_gas
4745
4746     small_amt = min(small_gas, small_aer)
4747
4748     aer(inh4_a,jliquid,ibin) = aer(inh4_a,jliquid,ibin) + small_amt
4749     aer(icl_a,jliquid,ibin)  = aer(icl_a,jliquid,ibin)  + small_amt
4750
4751     ! update jtotal
4752     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
4753          aer(inh4_a,jliquid,ibin)
4754     aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
4755          aer(icl_a,jliquid,ibin)
4756
4757     ! update gas
4758     gas(inh3_g) = ((gas(inh3_g)) - (small_amt))
4759     gas(ihcl_g) = ((gas(ihcl_g)) - (small_amt))
4760
4761     return
4762   end subroutine absorb_tiny_nh4cl
4763
4764
4765
4766   !--------------------------------------------------------------------
4767   ! hno3 (liquid)
4768   subroutine absorb_tiny_hno3(ibin,aer,gas,delta_hno3_max)        ! and degas tiny hcl
4769     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4770          ngas_aerchtot,jliquid,jsolid,jtotal,                                      &
4771          icl_a,ino3_a,ihno3_g,ihcl_g
4772     implicit none
4773
4774     ! subr arguments
4775     integer, intent(in) :: ibin
4776     real(r8), intent(inout), dimension(nbin_a_max) :: delta_hno3_max
4777     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4778     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4779     ! local variables
4780     real(r8) :: small_aer, small_amt, small_gas
4781
4782     small_gas = 0.01 * delta_hno3_max(ibin)
4783     small_aer = 0.01 * aer(icl_a,jliquid,ibin)
4784
4785     small_amt = min(small_gas, small_aer)
4786
4787     ! absorb tiny hno3
4788     aer(ino3_a,jliquid,ibin) = aer(ino3_a,jliquid,ibin) + small_amt
4789     aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
4790          aer(ino3_a,jliquid,ibin)
4791     gas(ihno3_g) = ((gas(ihno3_g))-(small_amt))
4792
4793     ! degas tiny hcl
4794     aer(icl_a,jliquid,ibin)  = ((aer(icl_a,jliquid,ibin))-   &
4795          (small_amt))
4796     aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin) +   &
4797          aer(icl_a,jliquid,ibin)
4798
4799     ! update gas
4800     gas(ihcl_g) = gas(ihcl_g) + small_amt
4801
4802     return
4803   end subroutine absorb_tiny_hno3
4804
4805
4806
4807   !--------------------------------------------------------------
4808   ! hcl (liquid)
4809   subroutine absorb_tiny_hcl(ibin,aer,gas,delta_hcl_max)  ! and degas tiny hno3
4810     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4811          ngas_aerchtot,jliquid,jtotal,jsolid,                                      &
4812          ino3_a,icl_a,ihcl_g,ihno3_g
4813     implicit none
4814
4815     ! subr arguments
4816     integer, intent(in) :: ibin
4817     real(r8), intent(inout), dimension(nbin_a_max) :: delta_hcl_max
4818     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4819     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4820     ! local variables
4821     real(r8) :: small_aer, small_amt, small_gas
4822
4823     small_gas = 0.01 * delta_hcl_max(ibin)
4824     small_aer = 0.01 * aer(ino3_a,jliquid,ibin)
4825
4826     small_amt = min(small_gas, small_aer)
4827
4828     ! absorb tiny hcl
4829     aer(icl_a,jliquid,ibin)= aer(icl_a,jliquid,ibin) + small_amt
4830     aer(icl_a,jtotal,ibin) = aer(icl_a,jsolid,ibin) +   &
4831          aer(icl_a,jliquid,ibin)
4832     gas(ihcl_g) = ((gas(ihcl_g))-(small_amt))
4833
4834     ! degas tiny hno3
4835     aer(ino3_a,jliquid,ibin) = ((aer(ino3_a,jliquid,ibin))-   &
4836          (small_amt))
4837     aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
4838          aer(ino3_a,jliquid,ibin)
4839
4840     ! update gas
4841     gas(ihno3_g) = gas(ihno3_g) + small_amt
4842
4843     return
4844   end subroutine absorb_tiny_hcl
4845
4846
4847
4848   !--------------------------------------------------------------
4849   ! nh4no3 (liquid)
4850   subroutine degas_tiny_nh4no3(ibin,aer,gas,electrolyte)
4851     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4852          ngas_aerchtot,jliquid,jsolid,jtotal,                                      &
4853          jnh4no3,inh4_a,ino3_a,inh3_g,ihno3_g
4854     implicit none
4855
4856     ! subr arguments
4857     integer, intent(in) :: ibin
4858     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4859     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4860     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4861     ! local variables
4862     real(r8) :: small_amt
4863
4864     small_amt = 0.01 * electrolyte(jnh4no3,jliquid,ibin)
4865
4866     aer(inh4_a,jliquid,ibin) = ((aer(inh4_a,jliquid,ibin))-   &
4867          (small_amt))
4868     aer(ino3_a,jliquid,ibin) = ((aer(ino3_a,jliquid,ibin))-   &
4869          (small_amt))
4870
4871     ! update jtotal
4872     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
4873          aer(inh4_a,jliquid,ibin)
4874     aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
4875          aer(ino3_a,jliquid,ibin)
4876
4877     ! update gas
4878     gas(inh3_g)  = gas(inh3_g)  + small_amt
4879     gas(ihno3_g) = gas(ihno3_g) + small_amt
4880
4881     return
4882   end subroutine degas_tiny_nh4no3
4883
4884
4885
4886
4887   !--------------------------------------------------------------------
4888   ! nh4cl (liquid)
4889   subroutine degas_tiny_nh4cl(ibin,aer,gas,electrolyte)
4890     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4891          ngas_aerchtot,jliquid,jsolid,jtotal,                                      &
4892          jnh4cl,inh4_a,icl_a,inh3_g,ihcl_g
4893     implicit none
4894
4895     ! subr arguments
4896     integer, intent(in) :: ibin
4897     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4898     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4899     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4900     ! local variables
4901     real(r8) :: small_amt
4902
4903
4904     small_amt = 0.01 * electrolyte(jnh4cl,jliquid,ibin)
4905
4906     aer(inh4_a,jliquid,ibin) = ((aer(inh4_a,jliquid,ibin))-   &
4907          (small_amt))
4908     aer(icl_a,jliquid,ibin)  = ((aer(icl_a,jliquid,ibin))-   &
4909          (small_amt))
4910
4911     ! update jtotal
4912     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
4913          aer(inh4_a,jliquid,ibin)
4914     aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
4915          aer(icl_a,jliquid,ibin)
4916
4917     ! update gas
4918     gas(inh3_g) = gas(inh3_g) + small_amt
4919     gas(ihcl_g) = gas(ihcl_g) + small_amt
4920
4921     return
4922   end subroutine degas_tiny_nh4cl
4923
4924
4925
4926   !***********************************************************************
4927   ! subroutines to equilibrate volatile acids
4928   !
4929   ! author: Rahul A. Zaveri
4930   ! update: may 2002
4931   !-----------------------------------------------------------------------
4932   subroutine equilibrate_acids(ibin,aer,gas,electrolyte,activity,mc,water_a,       &
4933        total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
4934     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4935          ngas_aerchtot,ngas_volatile,Ncation,Nanion,nrxn_aer_gl,nrxn_aer_ll,       &
4936          ihno3_g,ihcl_g
4937     implicit none
4938
4939     ! subr arguments
4940     integer, intent(in) :: ibin
4941     real(r8), intent(inout), dimension(nbin_a_max) :: water_a
4942     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4943     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
4944     real(r8), intent(inout) :: tot_cl_in
4945     real(r8), intent(inout), dimension(nrxn_aer_gl) :: Keq_gl
4946     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
4947     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
4948     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
4949     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
4950     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4951     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4952     ! local variables
4953
4954
4955
4956     if(gas(ihcl_g)*gas(ihno3_g) .gt. 0.)then
4957        call equilibrate_hcl_and_hno3(ibin,aer,gas,electrolyte,activity,mc,water_a, &
4958             total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
4959     elseif(gas(ihcl_g) .gt. 0.)then
4960        call equilibrate_hcl(ibin,aer,gas,electrolyte,activity,mc,water_a,          &
4961             total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
4962     elseif(gas(ihno3_g) .gt. 0.)then
4963        call equilibrate_hno3(ibin,aer,gas,electrolyte,activity,mc,water_a,         &
4964             total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
4965     endif
4966
4967
4968     return
4969   end subroutine equilibrate_acids
4970
4971
4972
4973   ! only hcl
4974   subroutine equilibrate_hcl(ibin,aer,gas,electrolyte,activity,mc,water_a,         &
4975        total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
4976     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
4977          ngas_aerchtot,ngas_volatile,Ncation,jliquid,jsolid,jtotal,Nanion,         &
4978          nrxn_aer_gl,nrxn_aer_ll,                                                  &
4979          ja_so4,ja_hso4,ihcl_g,icl_a,jhcl,ino3_a,ica_a,inh4_a,ina_a,jc_h,jc_ca,    &
4980          jc_nh4,jc_na,ja_cl,ja_no3,jhno3,jnh4cl
4981
4982     implicit none
4983
4984     ! subr arguments
4985     integer, intent(in) :: ibin
4986     real(r8), intent(inout), dimension(nbin_a_max) :: water_a
4987     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
4988     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
4989     real(r8), intent(inout) :: tot_cl_in
4990     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
4991     real(r8), intent(inout), dimension(nrxn_aer_gl) ::Keq_gl
4992     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
4993     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
4994     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
4995     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
4996     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
4997     ! local variables
4998     real(r8) :: a, aerH, aerHSO4, aerSO4, b, c, dum, Kdash_hcl, mH, Tcl,   &
4999          W, XT, Z
5000     !real(r8) :: quadratic                                 ! mosaic func
5001
5002     aerSO4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
5003     aerHSO4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
5004
5005     Tcl = aer(icl_a,jliquid,ibin) + gas(ihcl_g)   ! nmol/m^3(air)
5006     Kdash_hcl = Keq_gl(4)*1.e+18/gam(jhcl,ibin)**2        ! (nmol^2/kg^2)/(nmol/m^3(air))
5007     Z = (   aer(ina_a, jliquid,ibin) +               &  ! nmol/m^3(air)
5008          aer(inh4_a,jliquid,ibin) +   &
5009          2.*aer(ica_a, jliquid,ibin) ) -   &
5010          (2.*aerSO4  +   &
5011          aerHSO4 +   &
5012          aer(ino3_a,jliquid,ibin) )
5013
5014
5015     W     = water_a(ibin)                         ! kg/m^3(air)
5016
5017     Kdash_hcl = Keq_gl(4)*1.e+18/gam(jhcl,ibin)**2        ! (nmol^2/kg^2)/(nmol/m^3(air))
5018     a = 1.0
5019     b = ((Kdash_hcl*W) + (Z/W))*1.e-9
5020     c = Kdash_hcl*(Z - Tcl)*1.e-18
5021
5022
5023     dum = ((b*b)-(4.*a*c))
5024     if (dum .lt. 0.) return               ! no real root
5025
5026
5027     if(c .lt. 0.)then
5028        mH = quadratic(a,b,c)      ! mol/kg(water)
5029        aerH = mH*W*1.e+9
5030        aer(icl_a,jliquid,ibin) = ((aerH) + (Z))
5031     else
5032        mH = sqrt(Keq_ll(3))
5033     endif
5034
5035     call form_electrolytes(jliquid,ibin,XT,aer,gas,electrolyte,total_species,tot_cl_in)
5036
5037     ! update gas phase concentration
5038     gas(ihcl_g) = ( (Tcl)  - (aer(icl_a,jliquid,ibin))  )
5039
5040
5041     ! update the following molalities
5042     ma(ja_so4,ibin)  = 1.e-9*aerSO4/water_a(ibin)
5043     ma(ja_hso4,ibin) = 1.e-9*aerHSO4/water_a(ibin)
5044     ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5045     ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5046
5047     mc(jc_h,ibin)    = mH
5048     mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5049     mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5050     mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5051
5052
5053     ! update the following activities
5054     activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
5055          gam(jhcl,ibin)**2
5056
5057     activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
5058          gam(jhno3,ibin)**2
5059
5060     activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
5061          gam(jnh4cl,ibin)**2
5062
5063
5064     ! also update xyz(jtotal)
5065     aer(icl_a,jtotal,ibin) = aer(icl_a,jliquid,ibin) +   &
5066          aer(icl_a,jsolid,ibin)
5067
5068     electrolyte(jhcl,jtotal,ibin) = electrolyte(jhcl,jliquid,ibin)
5069
5070     return
5071   end subroutine equilibrate_hcl
5072
5073
5074
5075   ! only hno3
5076   subroutine equilibrate_hno3(ibin,aer,gas,electrolyte,activity,mc,water_a,        &
5077        total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
5078     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
5079          ngas_aerchtot,ngas_volatile,Ncation,jliquid,jsolid,jtotal,Nanion,         &
5080          nrxn_aer_gl,nrxn_aer_ll,                                                  &
5081          ja_so4,ja_hso4,ihno3_g,ino3_a,jhno3,icl_a,ica_a,inh4_a,ina_a,jc_h,jc_ca,  &
5082          jc_nh4,jc_na,ja_cl,jhcl,ja_no3,jnh4no3
5083
5084     implicit none
5085
5086     ! subr arguments
5087     integer, intent(in) :: ibin
5088     real(r8), intent(inout), dimension(nbin_a_max) :: water_a
5089     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
5090     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
5091     real(r8), intent(inout) :: tot_cl_in
5092     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
5093     real(r8), intent(inout), dimension(nrxn_aer_gl) :: Keq_gl
5094     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
5095     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
5096     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
5097     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5098     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5099     ! local variables
5100     real(r8) :: a, aerH, aerHSO4, aerSO4, b, c, dum, Kdash_hno3, mH,   &
5101          Tno3, W, XT, Z
5102     !real(r8) :: quadratic                                 ! mosaic func
5103
5104     aerSO4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
5105     aerHSO4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
5106
5107     Tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)        ! nmol/m^3(air)
5108     Kdash_hno3 = Keq_gl(3)*1.e+18/gam(jhno3,ibin)**2      ! (nmol^2/kg^2)/(nmol/m^3(air))
5109     Z = (   aer(ina_a, jliquid,ibin) +               &  ! nmol/m^3(air)
5110          aer(inh4_a,jliquid,ibin) +   &
5111          2.*aer(ica_a, jliquid,ibin) ) -   &
5112          (2.*aerSO4  +   &
5113          aerHSO4 +   &
5114          aer(icl_a,jliquid,ibin) )
5115
5116
5117     W     = water_a(ibin)                         ! kg/m^3(air)
5118
5119     Kdash_hno3 = Keq_gl(3)*1.e+18/gam(jhno3,ibin)**2      ! (nmol^2/kg^2)/(nmol/m^3(air))
5120     a = 1.0
5121     b = ((Kdash_hno3*W) + (Z/W))*1.e-9
5122     c = Kdash_hno3*(Z - Tno3)*1.e-18
5123
5124     dum = ((b*b)-(4.*a*c))
5125     if (dum .lt. 0.) return               ! no real root
5126
5127
5128
5129     if(c .lt. 0.)then
5130        mH = quadratic(a,b,c)      ! mol/kg(water)
5131        aerH = mH*W*1.e+9
5132        aer(ino3_a,jliquid,ibin) = ((aerH) + (Z))
5133     else
5134        mH = sqrt(Keq_ll(3))
5135     endif
5136
5137     call form_electrolytes(jliquid,ibin,XT,aer,gas,electrolyte,total_species,tot_cl_in)
5138
5139     ! update gas phase concentration
5140     gas(ihno3_g)= ( (Tno3) - (aer(ino3_a,jliquid,ibin)) )
5141
5142
5143     ! update the following molalities
5144     ma(ja_so4,ibin)  = 1.e-9*aerSO4/water_a(ibin)
5145     ma(ja_hso4,ibin) = 1.e-9*aerHSO4/water_a(ibin)
5146     ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5147     ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5148
5149     mc(jc_h,ibin)    = mH
5150     mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5151     mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5152     mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5153
5154
5155     ! update the following activities
5156     activity(jhcl,ibin)    = mc(jc_h,ibin)  *ma(ja_cl,ibin)  *   &
5157          gam(jhcl,ibin)**2
5158
5159     activity(jhno3,ibin)   = mc(jc_h,ibin)  *ma(ja_no3,ibin) *   &
5160          gam(jhno3,ibin)**2
5161
5162     activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin) *   &
5163          gam(jnh4no3,ibin)**2
5164
5165
5166     ! also update xyz(jtotal)
5167     aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
5168          aer(ino3_a,jsolid,ibin)
5169
5170     electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
5171
5172     return
5173   end subroutine equilibrate_hno3
5174
5175
5176
5177   ! both hcl and hno3
5178   subroutine equilibrate_hcl_and_hno3(ibin,aer,gas,electrolyte,activity,mc,        &
5179        water_a,total_species,tot_cl_in,ma,gam,Keq_ll,Keq_gl)
5180     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
5181          ngas_aerchtot,ngas_volatile,Ncation,jliquid,jsolid,jtotal,Nanion,         &
5182          nrxn_aer_gl,nrxn_aer_ll,                                                  &
5183          ja_so4,ja_hso4,ihcl_g,icl_a,ihno3_g,ino3_a,jhcl,jhno3,             &
5184          ica_a,inh4_a,ina_a,jc_h,jc_ca,jc_nh4,jc_na,ja_cl,ja_no3,jnh4no3,   &
5185          jnh4cl
5186
5187     implicit none
5188
5189     ! subr arguments
5190     integer, intent(in) :: ibin
5191     real(r8), intent(inout), dimension(nbin_a_max) :: water_a
5192     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
5193     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
5194     real(r8), intent(inout) :: tot_cl_in
5195     real(r8), intent(inout), dimension(nrxn_aer_ll) :: Keq_ll
5196     real(r8), intent(inout), dimension(nrxn_aer_gl) :: Keq_gl
5197     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: activity,gam
5198     real(r8), intent(inout), dimension(Ncation,nbin_a_max) :: mc
5199     real(r8), intent(inout), dimension(Nanion,nbin_a_max) :: ma
5200     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5201     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5202     ! local variables
5203     real(r8) :: aerH, aerHSO4, aerSO4, Kdash_hcl, Kdash_hno3,   &
5204          mH, p, q, r, Tcl, Tno3, W, XT, Z
5205     !real(r8) :: cubic                                     ! mosaic func
5206
5207
5208     aerSO4 = ma(ja_so4,ibin)*water_a(ibin)*1.e+9
5209     aerHSO4= ma(ja_hso4,ibin)*water_a(ibin)*1.e+9
5210
5211     Tcl  = aer(icl_a,jliquid,ibin)  + gas(ihcl_g) ! nmol/m^3(air)
5212     Tno3 = aer(ino3_a,jliquid,ibin) + gas(ihno3_g)        ! nmol/m^3(air)
5213
5214     Kdash_hcl  = Keq_gl(4)*1.e+18/gam(jhcl,ibin)**2       ! (nmol^2/kg^2)/(nmol/m^3(air))
5215     Kdash_hno3 = Keq_gl(3)*1.e+18/gam(jhno3,ibin)**2      ! (nmol^2/kg^2)/(nmol/m^3(air))
5216
5217     Z = (   aer(ina_a, jliquid,ibin) +               &  ! nmol/m^3(air)
5218          aer(inh4_a,jliquid,ibin) +   &
5219          2.*aer(ica_a, jliquid,ibin) ) -   &
5220          (2.*aerSO4 + aerHSO4 )
5221
5222
5223     W = water_a(ibin)
5224
5225     Kdash_hcl  = Keq_gl(4)*1.e+18/gam(jhcl,ibin)**2       ! (nmol^2/kg^2)/(nmol/m^3(air))
5226     Kdash_hno3 = Keq_gl(3)*1.e+18/gam(jhno3,ibin)**2      ! (nmol^2/kg^2)/(nmol/m^3(air))
5227
5228     p = (Z/W + W*(Kdash_hcl + Kdash_hno3))*1.e-9
5229
5230     q = 1.e-18*Kdash_hcl*Kdash_hno3*W**2  +   &
5231          1.e-18*Z*(Kdash_hcl + Kdash_hno3) -   &
5232          1.e-18*Kdash_hcl*Tcl -   &
5233          1.e-18*Kdash_hno3*Tno3
5234
5235     r = 1.e-18*Kdash_hcl*Kdash_hno3*W*(Z - Tcl - Tno3)*1.e-9
5236
5237     mH = cubic(p,q,r)
5238
5239     if(mH .gt. 0.0)then
5240        aerH = mH*W*1.e+9
5241        aer(ino3_a,jliquid,ibin) = Kdash_hno3*W*W*Tno3/   &
5242             (aerH + Kdash_hno3*W*W)
5243        aer(icl_a, jliquid,ibin) = Kdash_hcl*W*W*Tcl/   &
5244             (aerH + Kdash_hcl*W*W)
5245     else
5246        mH = sqrt(Keq_ll(3))
5247     endif
5248
5249     call form_electrolytes(jliquid,ibin,XT,aer,gas,electrolyte,total_species,tot_cl_in)
5250
5251     ! update gas phase concentration
5252     gas(ihno3_g)= ( (Tno3) - (aer(ino3_a,jliquid,ibin)) )
5253     gas(ihcl_g) = ( (Tcl)  - (aer(icl_a,jliquid,ibin))  )
5254
5255
5256     ! update the following molalities
5257     ma(ja_so4,ibin)  = 1.e-9*aerSO4/water_a(ibin)
5258     ma(ja_hso4,ibin) = 1.e-9*aerHSO4/water_a(ibin)
5259     ma(ja_no3,ibin)  = 1.e-9*aer(ino3_a,jliquid,ibin)/water_a(ibin)
5260     ma(ja_cl,ibin)   = 1.e-9*aer(icl_a, jliquid,ibin)/water_a(ibin)
5261
5262     mc(jc_h,ibin)    = mH
5263     mc(jc_ca,ibin)   = 1.e-9*aer(ica_a, jliquid,ibin)/water_a(ibin)
5264     mc(jc_nh4,ibin)  = 1.e-9*aer(inh4_a,jliquid,ibin)/water_a(ibin)
5265     mc(jc_na,ibin)   = 1.e-9*aer(ina_a, jliquid,ibin)/water_a(ibin)
5266
5267
5268     ! update the following activities
5269     activity(jhcl,ibin)    = mc(jc_h,ibin)*ma(ja_cl,ibin)   *   &
5270          gam(jhcl,ibin)**2
5271
5272     activity(jhno3,ibin)   = mc(jc_h,ibin)*ma(ja_no3,ibin)  *   &
5273          gam(jhno3,ibin)**2
5274
5275     activity(jnh4no3,ibin) = mc(jc_nh4,ibin)*ma(ja_no3,ibin)*   &
5276          gam(jnh4no3,ibin)**2
5277
5278     activity(jnh4cl,ibin)  = mc(jc_nh4,ibin)*ma(ja_cl,ibin) *   &
5279          gam(jnh4cl,ibin)**2
5280
5281
5282     ! also update xyz(jtotal)
5283     aer(icl_a,jtotal,ibin)  = aer(icl_a,jliquid,ibin) +   &
5284          aer(icl_a,jsolid,ibin)
5285
5286     aer(ino3_a,jtotal,ibin) = aer(ino3_a,jliquid,ibin) +   &
5287          aer(ino3_a,jsolid,ibin)
5288
5289     electrolyte(jhno3,jtotal,ibin) = electrolyte(jhno3,jliquid,ibin)
5290     electrolyte(jhcl, jtotal,ibin) = electrolyte(jhcl, jliquid,ibin)
5291
5292     return
5293   end subroutine equilibrate_hcl_and_hno3
5294
5295
5296
5297   !***********************************************************************
5298   ! subroutines to evaporate solid volatile species
5299   !
5300   ! author: Rahul A. Zaveri
5301   ! update: sep 2004
5302   !-----------------------------------------------------------------------
5303   !
5304   ! nh4no3 (solid)
5305   subroutine degas_solid_nh4no3(ibin,aer,gas,electrolyte,Keq_sg)
5306     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
5307          ngas_aerchtot,jsolid,jliquid,jtotal,nrxn_aer_sg,                          &
5308          ihno3_g,inh3_g,jnh4no3,inh4_a,ino3_a
5309
5310     implicit none
5311
5312     ! subr arguments
5313     integer, intent(in) :: ibin
5314     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
5315     real(r8), intent(inout), dimension(nrxn_aer_sg) :: Keq_sg
5316     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5317     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5318     ! local variables
5319     integer jp
5320     real(r8) :: a, b, c, xgas, XT
5321     !real(r8) :: quadratic                                 ! mosaic func
5322
5323
5324     jp = jsolid
5325
5326     a = 1.0
5327     b = gas(inh3_g) + gas(ihno3_g)
5328     c = gas(inh3_g)*gas(ihno3_g) - Keq_sg(1)
5329     xgas = quadratic(a,b,c)
5330
5331     if(xgas .ge. electrolyte(jnh4no3,jp,ibin))then ! degas all nh4no3
5332
5333        gas(inh3_g) = gas(inh3_g)  + electrolyte(jnh4no3,jp,ibin)
5334        gas(ihno3_g)= gas(ihno3_g) + electrolyte(jnh4no3,jp,ibin)
5335        aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
5336             electrolyte(jnh4no3,jp,ibin)
5337        aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) -   &
5338             electrolyte(jnh4no3,jp,ibin)
5339
5340     else  ! degas only xgas amount of nh4no3
5341
5342        gas(inh3_g) = gas(inh3_g)  + xgas
5343        gas(ihno3_g)= gas(ihno3_g) + xgas
5344        aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
5345        aer(ino3_a,jp,ibin) = aer(ino3_a,jp,ibin) - xgas
5346     endif
5347
5348
5349     ! update jtotal
5350     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
5351          aer(inh4_a,jliquid,ibin)
5352     aer(ino3_a,jtotal,ibin)  = aer(ino3_a,jsolid,ibin) +   &
5353          aer(ino3_a,jliquid,ibin)
5354
5355     return
5356   end subroutine degas_solid_nh4no3
5357
5358
5359
5360   ! nh4cl (solid)
5361   subroutine degas_solid_nh4cl(ibin,aer,gas,electrolyte,Keq_sg)
5362     use module_data_mosaic_aero, only: r8,naer,nelectrolyte,nbin_a_max,            &
5363          ngas_aerchtot,jsolid,jliquid,jtotal,nrxn_aer_sg,                          &
5364          ihcl_g,inh3_g,jnh4cl,inh4_a,icl_a
5365     implicit none
5366
5367     ! subr arguments
5368     integer, intent(in) :: ibin
5369     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
5370     real(r8), intent(inout), dimension(nrxn_aer_sg) :: Keq_sg
5371     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5372     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5373     ! local variables
5374     integer jp
5375     real(r8) :: a, b, c, xgas, XT
5376     !real(r8) :: quadratic                                 ! mosaic func
5377
5378
5379     jp = jsolid
5380
5381     a = 1.0
5382     b = gas(inh3_g) + gas(ihcl_g)
5383     c = gas(inh3_g)*gas(ihcl_g) - Keq_sg(2)
5384     xgas = quadratic(a,b,c)
5385
5386     if(xgas .ge. electrolyte(jnh4cl,jp,ibin))then ! degas all nh4cl
5387
5388        gas(inh3_g) = gas(inh3_g) + electrolyte(jnh4cl,jp,ibin)
5389        gas(ihcl_g) = gas(ihcl_g) + electrolyte(jnh4cl,jp,ibin)
5390        aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) -   &
5391             electrolyte(jnh4cl,jp,ibin)
5392        aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin) -   &
5393             electrolyte(jnh4cl,jp,ibin)
5394
5395     else  ! degas only xgas amount of nh4cl
5396
5397        gas(inh3_g) = gas(inh3_g) + xgas
5398        gas(ihcl_g) = gas(ihcl_g) + xgas
5399        aer(inh4_a,jp,ibin) = aer(inh4_a,jp,ibin) - xgas
5400        aer(icl_a,jp,ibin)  = aer(icl_a,jp,ibin)  - xgas
5401
5402     endif
5403
5404
5405     ! update jtotal
5406     aer(inh4_a,jtotal,ibin)  = aer(inh4_a,jsolid,ibin) +   &
5407          aer(inh4_a,jliquid,ibin)
5408     aer(icl_a,jtotal,ibin)   = aer(icl_a,jsolid,ibin)  +   &
5409          aer(icl_a,jliquid,ibin)
5410
5411     return
5412   end subroutine degas_solid_nh4cl
5413
5414
5415
5416   !***********************************************************************
5417   ! conforms aerosol generic species to a valid electrolyte composition
5418   !
5419   ! author: Rahul A. Zaveri
5420   ! update: june 2000
5421   !-----------------------------------------------------------------------
5422   subroutine conform_electrolytes(jp,ibin,XT,aer,gas,electrolyte,total_species,tot_cl_in)
5423
5424     use module_data_mosaic_aero, only: r8,naer,nbin_a_max,           &
5425          ngas_aerchtot, ngas_volatile, nelectrolyte,                 &
5426          imsa_a,iso4_a,ica_a,ina_a,inh4_a,ino3_a,icl_a,ico3_a
5427
5428     implicit none
5429
5430     ! subr arguments
5431     integer, intent(in) :: ibin, jp
5432     real(r8), intent(inout) :: XT
5433     real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
5434     real(r8), intent(inout), dimension(ngas_volatile) :: total_species
5435     real(r8), intent(inout) :: tot_cl_in
5436     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5437     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5438     ! local variables
5439     integer i, iXT_case, je
5440     real(r8) :: sum_dum, XNa_prime, XNH4_prime, XT_prime
5441     real(r8) :: store(naer)
5442
5443     ! remove negative concentrations, if any
5444     !      do i=1,naer
5445     !      aer(i,jp,ibin) = max(0.0d0, aer(i,jp,ibin))    ! EFFI
5446     !      enddo
5447
5448
5449     !      call calculate_XT(ibin,jp,XT,aer)      ! EFFI
5450
5451     if( (aer(iso4_a,jp,ibin)+aer(imsa_a,jp,ibin)) .gt.0.0)then
5452        XT   = ( aer(inh4_a,jp,ibin) +   &
5453             aer(ina_a,jp,ibin)  +   &
5454             2.*aer(ica_a,jp,ibin) )/   &
5455             (aer(iso4_a,jp,ibin)+0.5*aer(imsa_a,jp,ibin))
5456     else
5457        XT   = -1.0
5458     endif
5459
5460
5461 !   if(XT .ge. 1.9999 .or. XT.lt.0.)then ! RAZ 11/10/2014
5462     if(XT .ge. 2.0 .or. XT.lt.0.)then ! RAZ 11/10/2014
5463        iXT_case = 1       ! near neutral (acidity is caused by HCl and/or HNO3)
5464     else
5465        iXT_case = 2       ! acidic (acidity is caused by excess SO4)
5466     endif
5467
5468     ! initialize
5469     !
5470     ! put total aer(*) into store(*)
5471     store(iso4_a) = aer(iso4_a,jp,ibin)
5472     store(ino3_a) = aer(ino3_a,jp,ibin)
5473     store(icl_a)  = aer(icl_a, jp,ibin)
5474     store(imsa_a) = aer(imsa_a,jp,ibin)
5475     store(ico3_a) = aer(ico3_a,jp,ibin)
5476     store(inh4_a) = aer(inh4_a,jp,ibin)
5477     store(ina_a)  = aer(ina_a, jp,ibin)
5478     store(ica_a)  = aer(ica_a, jp,ibin)
5479
5480     do je=1,nelectrolyte
5481        electrolyte(je,jp,ibin) = 0.0
5482     enddo
5483
5484     !
5485     !---------------------------------------------------------
5486     !
5487     if(iXT_case.eq.1)then
5488
5489        ! XT >= 2   : sulfate deficient
5490
5491        call form_caso4(store,jp,ibin,electrolyte)
5492        call form_camsa2(store,jp,ibin,electrolyte)
5493        call form_na2so4(store,jp,ibin,electrolyte)
5494        call form_namsa(store,jp,ibin,electrolyte)
5495        call form_cano3(store,jp,ibin,electrolyte)
5496        call form_nano3(store,jp,ibin,electrolyte)
5497        call form_nacl(store,jp,ibin,aer,gas,electrolyte,total_species,tot_cl_in)
5498        call form_cacl2(store,jp,ibin,electrolyte)
5499        call form_caco3(store,jp,ibin,aer,electrolyte)
5500        call form_nh4so4(store,jp,ibin,electrolyte)
5501        call form_nh4msa(store,jp,ibin,electrolyte)
5502        call form_nh4no3(store,jp,ibin,electrolyte)
5503        call form_nh4cl(store,jp,ibin,electrolyte)
5504        call form_msa(store,jp,ibin,electrolyte)
5505        call degas_hno3(store,jp,ibin,aer,gas,electrolyte)
5506        call degas_hcl(store,jp,ibin,aer,gas,electrolyte)
5507        call degas_nh3(store,jp,ibin,aer,gas)
5508
5509     elseif(iXT_case.eq.2)then
5510
5511        ! XT < 2   : sulfate enough or sulfate excess
5512
5513        call form_caso4(store,jp,ibin,electrolyte)
5514        call form_camsa2(store,jp,ibin,electrolyte)
5515        call form_namsa(store,jp,ibin,electrolyte)
5516        call form_nh4msa(store,jp,ibin,electrolyte)
5517        call form_msa(store,jp,ibin,electrolyte)
5518
5519        if(store(iso4_a).eq.0.0)goto 10
5520
5521
5522        XT_prime =(store(ina_a)+store(inh4_a))/   &
5523             store(iso4_a)
5524        XNa_prime=0.5*store(ina_a)/store(iso4_a) + 1.
5525
5526        if(XT_prime.ge.XNa_prime)then
5527           call form_na2so4(store,jp,ibin,electrolyte)
5528           XNH4_prime = 0.0
5529           if(store(iso4_a).gt.1.e-15)then
5530              XNH4_prime = store(inh4_a)/store(iso4_a)
5531           endif
5532
5533           if(XNH4_prime .ge. 1.5)then
5534              call form_nh4so4_lvcite(store,jp,ibin,electrolyte)
5535           else
5536              call form_lvcite_nh4hso4(store,jp,ibin,electrolyte)
5537           endif
5538
5539        elseif(XT_prime.ge.1.)then
5540           call form_nh4hso4(store,jp,ibin,electrolyte)
5541           call form_na2so4_nahso4(store,jp,ibin,electrolyte)
5542        elseif(XT_prime.lt.1.)then
5543           call form_nahso4(store,jp,ibin,electrolyte)
5544           call form_nh4hso4(store,jp,ibin,electrolyte)
5545           call form_h2so4(store,jp,ibin,electrolyte)
5546        endif
5547
5548 10     call degas_hno3(store,jp,ibin,aer,gas,electrolyte)
5549        call degas_hcl(store,jp,ibin,aer,gas,electrolyte)
5550        call degas_nh3(store,jp,ibin,aer,gas)
5551
5552     endif ! case 1, 2
5553
5554
5555     ! re-calculate ions to eliminate round-off errors
5556     call electrolytes_to_ions(jp, ibin,aer,electrolyte)
5557     !---------------------------------------------------------
5558     !
5559     ! calculate % composition  EFFI
5560     !!      sum_dum = 0.0
5561     !!      do je = 1, nelectrolyte
5562     !!        electrolyte(je,jp,ibin) = max(0.d0,electrolyte(je,jp,ibin)) ! remove -ve
5563     !!        sum_dum = sum_dum + electrolyte(je,jp,ibin)
5564     !!      enddo
5565     !!
5566     !!      if(sum_dum .eq. 0.)sum_dum = 1.0
5567     !!      electrolyte_sum(jp,ibin) = sum_dum
5568     !!
5569     !!      do je = 1, nelectrolyte
5570     !!        epercent(je,jp,ibin) = 100.*electrolyte(je,jp,ibin)/sum_dum
5571     !!      enddo
5572     !!
5573     !!
5574     return
5575   end subroutine conform_electrolytes
5576
5577
5578
5579   !----------------------------------------------------------
5580   ! solution to x^3 + px^2 + qx + r = 0
5581   !
5582   function cubic( psngl, qsngl, rsngl )
5583     use module_data_mosaic_kind, only:  r8
5584     implicit none
5585     real(r8) :: cubic
5586     ! subr arguments
5587     real(r8) :: psngl, qsngl, rsngl
5588     ! local variables
5589     real(r8) :: p, q, r, A, B, D, M, N, third, y
5590     real(r8) :: k, phi, thesign, x(3), duma
5591     integer icase, kk
5592
5593     third = 1.d0/3.d0
5594
5595     q = (qsngl)
5596     p = (psngl)
5597     r = (rsngl)
5598
5599     A = (1.d0/3.d0)*((3.d0*q) - (p*p))
5600     B = (1.d0/27.d0)*((2.d0*p*p*p) - (9.d0*p*q) + (27.d0*r))
5601
5602     D = ( ((A*A*A)/27.d0) + ((B*B)/4.d0) )
5603
5604     if(D .gt. 0.)then     !       => 1 real and 2 complex roots
5605        icase = 1
5606     elseif(D .eq. 0.)then !       => 3 real roots, atleast 2 identical
5607        icase = 2
5608     else  ! D < 0         => 3 distinct real roots
5609        icase = 3
5610     endif
5611
5612
5613     goto (1,2,3), icase
5614
5615     ! case 1: D > 0
5616 1   thesign = 1.
5617     if(B .gt. 0.)then
5618        B = -B
5619        thesign = -1.
5620     endif
5621
5622     M = thesign*((-B/2.d0) + (sqrt(D)))**(third)
5623     N = thesign*((-B/2.d0) - (sqrt(D)))**(third)
5624
5625     cubic = ( (M) + (N) - (p/3.d0) )
5626     return
5627
5628     ! case 2: D = 0
5629 2   thesign = 1.
5630     if(B .gt. 0.)then
5631        B = -B
5632        thesign = -1.
5633     endif
5634
5635     M = thesign*(-B/2.d0)**third
5636     N = M
5637
5638     x(1) = ( (M) + (N) - (p/3.d0) )
5639     x(2) = ( (-M/2.d0) + (-N/2.d0) - (p/3.d0) )
5640     x(2) = ( (-M/2.d0) + (-N/2.d0) - (p/3.d0) )
5641
5642     cubic = 0.
5643     do kk = 1, 3
5644        if(x(kk).gt.cubic) cubic = x(kk)
5645     enddo
5646     return
5647
5648     ! case 3: D < 0
5649 3   if(B.gt.0.)then
5650        thesign = -1.
5651     elseif(B.lt.0.)then
5652        thesign = 1.
5653     endif
5654
5655     ! rce 18-nov-2004 -- make sure that acos argument is between +/-1.0
5656     !     phi = acos(thesign*sqrt( (B*B/4.d0)/(-A*A*A/27.d0) ))   ! radians
5657     duma = thesign*sqrt( (B*B/4.d0)/(-A*A*A/27.d0) )
5658     duma = min( duma, +1.0d0 )
5659     duma = max( duma, -1.0d0 )
5660     phi  = acos( duma )   ! radians
5661
5662
5663     cubic = 0.
5664     do kk = 1, 3
5665        k = kk-1
5666        y = 2.*Sqrt(-A/3.)*cos(phi + 120.*k*0.017453293)
5667        x(kk) = ((y) - (p/3.d0))
5668        if(x(kk).gt.cubic) cubic = x(kk)
5669     enddo
5670     return
5671
5672   end function cubic
5673    !----------------------------------------------------------
5674
5675
5676   !----------------------------------------------------------
5677   function quadratic(a,b,c)
5678     use module_data_mosaic_kind, only:  r8
5679     implicit none
5680     real(r8) :: quadratic
5681     ! subr. arguments
5682     real(r8) :: a, b, c
5683     ! local variables
5684     real(r8) :: x, dum, quad1, quad2
5685
5686
5687     if(b .ne. 0.0)then
5688        x = 4.*(a/b)*(c/b)
5689     else
5690        x = 1.e+6
5691     endif
5692
5693     if(abs(x) .lt. 1.e-6)then
5694        dum = ( (0.5*x) +   &
5695             (0.125*x**2) +   &
5696             (0.0625*x**3) )
5697
5698        quadratic = (-0.5*b/a)*dum
5699
5700        if(quadratic .lt. 0.)then
5701           quadratic = -b/a - quadratic
5702        endif
5703
5704     else
5705        quad1 = ((-b)+sqrt((b*b)-(4.*a*c)))/   &
5706             (2.*a)
5707        quad2 = ((-b)-sqrt((b*b)-(4.*a*c)))/   &
5708             (2.*a)
5709
5710        quadratic = max(quad1, quad2)
5711     endif
5712
5713     return
5714   end function quadratic
5715   !----------------------------------------------------------
5716
5717
5718   !----------------------------------------------------------
5719   function mean_molecular_speed(T, MW)    ! in cm/s
5720     use module_data_mosaic_kind, only:  r8
5721     implicit none
5722     real(r8) :: mean_molecular_speed
5723     ! subr. arguments
5724     real(r8) :: T, MW     ! T(K)
5725
5726     mean_molecular_speed = 1.455e4 * sqrt(T/MW)
5727
5728     return
5729   end function mean_molecular_speed
5730   !----------------------------------------------------------
5731
5732   !----------------------------------------------------------
5733   function gas_diffusivity(T, P, MW, Vm)  ! in cm^2/s
5734     use module_data_mosaic_kind, only:  r8
5735     use module_data_mosaic_constants, only:  third
5736     implicit none
5737     real(r8) :: gas_diffusivity
5738     ! subr. arguments
5739     real(r8) :: MW, Vm, T, P      ! T(K), P(atm)
5740
5741
5742     gas_diffusivity = (1.0e-3 * T**1.75 * sqrt(1./MW + 0.035))/   &
5743          (P * (Vm**third + 2.7189)**2)
5744
5745
5746     return
5747   end function gas_diffusivity
5748   !----------------------------------------------------------
5749
5750
5751   !----------------------------------------------------------
5752   function fuchs_sutugin(rkn,a)
5753     use module_data_mosaic_kind, only:  r8
5754     implicit none
5755     real(r8) :: fuchs_sutugin
5756     ! subr. arguments
5757     real(r8) :: rkn, a
5758     ! local variables
5759     real(r8) :: rnum, denom
5760
5761
5762     rnum  = 0.75*a*(1. + rkn)
5763     denom = rkn**2 + rkn + 0.283*rkn*a + 0.75*a
5764     fuchs_sutugin = rnum/denom
5765
5766     return
5767   end function fuchs_sutugin
5768   !----------------------------------------------------------
5769
5770
5771   !----------------------------------------------------------
5772   ! ZSR method at 60% RH
5773   !
5774   function aerosol_water_up( ibin, electrolyte, aer, kappa_nonelectro, a_zsr ) ! kg (water)/m^3 (air)
5775
5776     use module_data_mosaic_aero, only: r8, nelectrolyte, naer, nbin_a_max, jtotal, &
5777         nsalt, ioc_a, ibc_a, ilim2_a, ioin_a, dens_aer_mac, mw_aer_mac ! RAZ 4/16/2014
5778
5779     use module_data_mosaic_asecthp, only: dens_water_aer
5780
5781     implicit none
5782
5783     real(r8) :: aerosol_water_up
5784     ! subr. arguments
5785     integer, intent(in) :: ibin
5786     real(r8), intent(in), dimension (6,nelectrolyte) :: a_zsr
5787     real(r8), intent(in), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5788     real(r8), intent(in), dimension(naer,3,nbin_a_max) :: aer
5789     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
5790
5791     ! local variables
5792     integer :: iaer, jp, je
5793     real(r8) :: tmpa, tmpb, aH2O_60  ! RAZ 4/16/2014
5794     ! function
5795     !real(r8) :: bin_molality_60
5796
5797
5798     aH2O_60 = 0.6
5799
5800     jp = jtotal
5801     tmpa = 0.0_r8
5802
5803     do je = 1, (nsalt+4)  ! include hno3 and hcl in water calculation
5804        tmpa = tmpa + electrolyte(je,jp,ibin)/bin_molality_60(je,a_zsr)
5805     enddo
5806
5807 !   tmpa = tmpa + &
5808 !        ( (aer(ilim2_a,jp,ibin)/dens_aer_mac(ilim2_a))*kappa_nonelectro(ilim2_a) + &                      ! RCE 5/20/2015
5809 !          (aer(ioin_a, jp,ibin)/dens_aer_mac(ioin_a ))*kappa_nonelectro(ioin_a ) + &                      !  "     "
5810 !          (aer(ioc_a,  jp,ibin)/dens_aer_mac(ioc_a  ))*kappa_nonelectro(ioc_a  ) + &                      !  "     "
5811 !          (aer(ibc_a,  jp,ibin)/dens_aer_mac(ibc_a  ))*kappa_nonelectro(ibc_a  ) )*aH2O_60/(1.0-aH2O_60)  ! RCE 5/20/2015
5812
5813     tmpb = 0.0_r8
5814     do iaer = 1, naer
5815        if (kappa_nonelectro(iaer) > 0.0_r8) then
5816           tmpb = tmpb + (aer(iaer,jp,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer))*kappa_nonelectro(iaer)
5817        end if
5818     end do
5819     tmpa = tmpa + tmpb * dens_water_aer * 1.0e-3 * aH2O_60/(1.0-aH2O_60)   ! RCE 1/6/2016 added 1.0e-3 factor
5820
5821     aerosol_water_up = tmpa*1.e-9  ! kg(water)/m^3(air)
5822
5823     return
5824   end function aerosol_water_up
5825   !----------------------------------------------------------
5826
5827
5828   !----------------------------------------------------------
5829   function bin_molality_60(je,a_zsr)            ! TOUCH
5830     use module_data_mosaic_aero, only: r8,nelectrolyte
5831
5832     implicit none
5833
5834     real(r8) :: bin_molality_60
5835     ! subr. arguments
5836     integer, intent(in) ::  je
5837     real(r8), intent(in), dimension (6,nelectrolyte) :: a_zsr
5838     ! local variables
5839     real(r8) :: aw, xm
5840
5841
5842     aw = 0.6_r8
5843
5844     xm =     a_zsr(1,je) +   &
5845          aw*(a_zsr(2,je) +   &
5846          aw*(a_zsr(3,je) +   &
5847          aw*(a_zsr(4,je) +   &
5848          aw*(a_zsr(5,je) +   &
5849          aw* a_zsr(6,je) ))))
5850
5851     bin_molality_60 = 55.509_r8*xm/(1. - xm)
5852
5853     return
5854   end function bin_molality_60
5855   !----------------------------------------------------------
5856
5857
5858   !----------------------------------------------------------
5859   ! ZSR method
5860   function aerosol_water( jp, ibin, jaerosolstate, jphase, jhyst_leg, electrolyte, aer,   &
5861            kappa_nonelectro, num_a, mass_dry_a, mass_soluble_a, aH2O, molality0 ) ! kg (water)/m^3 (air). RAZ added aer
5862
5863     use module_data_mosaic_aero, only: r8, nbin_a_max, nelectrolyte, nsoluble, naer,   &
5864          all_solid, jsolid, jhyst_lo, ioc_a, ibc_a, ilim2_a, ioin_a,   &   ! RAZ 4/16/2014
5865          jtotal, ah2o_max, dens_aer_mac, mw_aer_mac, ename
5866
5867     use module_data_mosaic_asecthp, only: dens_water_aer
5868
5869     implicit none
5870
5871     real(r8) :: aerosol_water
5872     ! subr. arguments
5873     integer, intent(in) :: jp, ibin
5874     integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate,jphase,jhyst_leg
5875
5876     real(r8), intent(in) :: aH2O
5877     real(r8), intent(in), dimension(nbin_a_max) :: num_a,mass_dry_a,mass_soluble_a
5878     real(r8), intent(inout), dimension(nelectrolyte,nbin_a_max) :: molality0 !BSINGH(05/23/2014) - Added dimension nbin_a_max
5879     real(r8), intent(inout), dimension(nelectrolyte,3,nbin_a_max) :: electrolyte
5880     real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
5881     real(r8), intent(in), dimension(naer) :: kappa_nonelectro
5882
5883     ! local variables
5884     integer :: iaer, iclm_aer, jclm_aer, je
5885     real(r8) :: tmpa, tmpb
5886     ! function
5887     real(r8) :: bin_molality
5888
5889
5890
5891     tmpa = 0.0_r8
5892     if (jaerosolstate(ibin) .ne. all_solid) then                     ! RAZ 5/24/2016 - added this "if" check
5893 ! should this be "do je = 1, nsalt+4" as in aerosol_water_up ?
5894 !             or "do je = 1, jxxxx" where jxxxx is the index of the last electrolyte used here ?
5895     do je = 1, 19   ! include hno3 and hcl in water calculation
5896        tmpa = tmpa + electrolyte(je,jp,ibin)/molality0(je,ibin)      ! RAZ 5/20/2014
5897     enddo
5898     endif
5899
5900 ! note that this only considers the ilim2_a soa species
5901
5902 !   tmpa = tmpa + &
5903 !       ( (aer(ioc_a,  jtotal,ibin)/dens_aer_mac(ioc_a  ))*kappa_nonelectro(ioc_a  ) +   &   ! RCE 5/20/2015
5904 !         (aer(ilim2_a,jtotal,ibin)/dens_aer_mac(ilim2_a))*kappa_nonelectro(ilim2_a) +   &   ! RCE 5/20/2015
5905 !         (aer(ioin_a, jtotal,ibin)/dens_aer_mac(ioin_a ))*kappa_nonelectro(ioin_a ) +   &   ! RCE 5/20/2015
5906 !         (aer(ibc_a,  jtotal,ibin)/dens_aer_mac(ibc_a  ))*kappa_nonelectro(ibc_a  ) )   &   ! RCE 5/20/2015
5907 !       * 1.0e-3 * aH2O/(1.0-min(ah2o,ah2o_max))                                             ! RCE 5/20/2015 - need 1.0e-3 factor
5908
5909     tmpb = 0.0_r8
5910     do iaer = 1, naer
5911        if (kappa_nonelectro(iaer) > 0.0_r8) then
5912           tmpb = tmpb + (aer(iaer,jtotal,ibin)*mw_aer_mac(iaer)/dens_aer_mac(iaer))*kappa_nonelectro(iaer)
5913        end if
5914     end do
5915     tmpa = tmpa + tmpb * dens_water_aer * 1.0e-3 * ah2o/(1.0-min(ah2o,ah2o_max))  ! ug(water)/m^3(air)
5916
5917     aerosol_water = tmpa*1.e-9  ! kg(water)/m^3(air)
5918
5919
5920     if (aerosol_water .le. 0.0) then !BALLI- Commented out to avoid slow runtime.
5921        iclm_aer = 0 !BSINGH- THIS IS WRONG!!!
5922        jclm_aer = 0 !BSINGH- THIS IS WRONG!!!
5923        !write(6,*)'iclm  jclm  ibin  jp = ',   &
5924        !     iclm_aer, jclm_aer, ibin, jp      !BSINGH- iclm_aer and jclm_aer are never set but they are used here.***
5925
5926        !write(6,*)'aH2O, water = ', aH2O, aerosol_water
5927        !write(6,*)'dry mass = ', mass_dry_a(ibin)
5928        !write(6,*)'soluble mass = ', mass_soluble_a(ibin)
5929        !write(6,*)'number = ', num_a(ibin)
5930        !do je = 1, nsoluble
5931        !   write(6,44)ename(je), electrolyte(je,jp,ibin)
5932        !enddo
5933        !write(6,*)'Error in water calculation'
5934        !write(6,*)'ibin = ', ibin
5935        !write(6,*)'water content cannot be negative or zero'
5936        !write(6,*)'setting jaerosolstate to all_solid'
5937
5938        !        call print_input
5939
5940        jaerosolstate(ibin) = all_solid
5941        jphase(ibin)    = jsolid
5942        jhyst_leg(ibin) = jhyst_lo
5943
5944     endif
5945
5946 44  format(a7, 2x, e11.3)
5947
5948
5949     return
5950   end function aerosol_water
5951
5952
5953
5954
5955
5956   !----------------------------------------------------------
5957   function bin_molality(je,ibin,aH2O_a,b_zsr,a_zsr,aw_min)
5958     use module_data_mosaic_aero, only:r8,  nbin_a_max, nelectrolyte
5959
5960     implicit none
5961
5962     real(r8) :: bin_molality
5963     ! subr. arguments
5964     integer, intent(in) :: je, ibin
5965     real(r8), intent(in), dimension(nbin_a_max) :: aH2O_a
5966     real(r8), intent(in), dimension(nelectrolyte) :: b_zsr,aw_min
5967     real(r8), intent(in), dimension (6,nelectrolyte) :: a_zsr
5968     ! local variables
5969     real(r8) :: aw, xm
5970
5971
5972     aw = max(aH2O_a(ibin), aw_min(je))
5973     aw = min(aw, 0.999999_r8)
5974
5975
5976     if(aw .lt. 0.97_r8)then
5977
5978        xm =     a_zsr(1,je) +   &
5979             aw*(a_zsr(2,je) +   &
5980             aw*(a_zsr(3,je) +   &
5981             aw*(a_zsr(4,je) +   &
5982             aw*(a_zsr(5,je) +   &
5983             aw* a_zsr(6,je) ))))
5984
5985        bin_molality = 55.509_r8*xm/(1. - xm)
5986
5987     else
5988
5989        bin_molality = -b_zsr(je)*log(aw)
5990
5991     endif
5992
5993
5994     return
5995   end function bin_molality
5996   !----------------------------------------------------------
5997
5998
5999
6000
6001
6002
6003
6004 end module module_mosaic_ext