1 module module_mosaic_aerchem_intr
10 !-----------------------------------------------------------------------
11 subroutine aerchemistry( &
12 idiagbb_host, & !intent-ins
13 hostgridinfo, it_host, it_mosaic, dtchem_in, & !intent-ins
14 pr_atm, rh, te, cair_mol_m3, cair_mol_cc, swdownbox, &
15 jaerosolstate, jaerosolstate_bgn, jhyst_leg, & !intent-inouts
16 rbox, dp_dry_a, dp_wet_a, sigmag_a, &
17 gas_avg, gas_netprod_otrproc, &
18 mass_dry_a_bgn, mass_dry_a, dens_dry_a_bgn, dens_dry_a, &
19 aH2O_a, gam_ratio, iter_mesa_out ) !intent-outs
21 ! *** eventually need to pass some performance stats back to mosaic driver
23 use module_data_mosaic_kind, only: r8
24 use module_data_mosaic_main, only: &
25 m_partmc_mosaic, ntot_max, ntot_used
26 use module_data_mosaic_aero, only : &
27 mosaic_vars_aa_type, &
29 mw_aer_mac, mw_comp_a, msectional, msize_framework, &
30 naer, nbin_a, nbin_a_max, ngas_aerchtot, ngas_volatile, &
31 nmax_astem, nmax_mesa, nsalt, &
32 use_cam5mam_soa_params, use_cam5mam_accom_coefs
33 use module_mosaic_box_aerchem, only: mosaic_box_aerchemistry
37 integer, intent(in) :: idiagbb_host
38 integer, intent(in) :: hostgridinfo(6), it_host, it_mosaic
39 real(r8), intent(in) :: dtchem_in, pr_atm, rh, te, cair_mol_m3, cair_mol_cc, swdownbox
41 integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate, jaerosolstate_bgn
42 integer, intent(inout), dimension(nbin_a_max) :: jhyst_leg
44 real(r8), intent(inout), dimension(ntot_used) :: rbox
45 real(r8), intent(inout), dimension(nbin_a_max) :: dp_dry_a, dp_wet_a, sigmag_a
46 real(r8), intent(inout), dimension(ngas_aerchtot) :: gas_avg ! average gas conc. over dtchem time step (nmol/m3)
47 real(r8), intent(inout), dimension(ngas_aerchtot) :: gas_netprod_otrproc
48 ! gas_netprod_otrproc = gas net production rate from other processes
49 ! such as gas-phase chemistry and emissions (nmol/m3/s)
50 ! NOTE - currently in the mosaic box model, gas_netprod_otrproc is set to zero for all
51 ! species, so mosaic_aerchemistry does not apply production and condensation together
52 real(r8), intent(inout), dimension(nbin_a_max) :: mass_dry_a_bgn, mass_dry_a
53 real(r8), intent(inout), dimension(nbin_a_max) :: dens_dry_a_bgn, dens_dry_a
55 integer, intent(out), dimension(nbin_a_max) :: iter_mesa_out
56 real(r8), intent(out), dimension(nbin_a_max) :: aH2O_a, gam_ratio
59 character(len=250) :: infile, tmp_str
61 logical :: debug_mosaic = .false.
63 integer :: ierr, ibin, igas, iaer, istate, iaer_in, istate_in, ibin_in
64 integer :: ierror_grp1, ierror_grp2, istop_mosaic_error_grp1, istop_mosaic_error_grp2
65 integer :: mcall_load_mosaic_parameters, mcall_print_aer_in
69 real(r8) :: dtchem, RH_pc, aH2O, P_atm, T_K, aer_tmp
70 real(r8), dimension(naer,3,nbin_a_max) :: aer
71 real(r8), dimension(ngas_aerchtot) :: gas
72 real(r8), dimension(nbin_a_max) :: num_a, water_a, water_a_hyst
73 real(r8), dimension(naer) :: kappa_nonelectro
74 real(r8) :: uptkrate_h2so4 ! rate of h2so4 uptake by aerosols (1/s)
76 real(r8) :: xsv_misc(5)
77 real(r8), dimension(naer,3,nbin_a_max) :: xsv_aer
78 real(r8), dimension(ngas_aerchtot) :: xsv_gas, xsv_gasavg, xsv_gasprod
79 real(r8), dimension(nbin_a_max) :: xsv_num, xsv_water, xsv_dpdry, xsv_dpwet, xsv_sigmag
80 integer, dimension(nbin_a_max) :: jsv_jhyst, jsv_jstate
82 type (mosaic_vars_aa_type) :: mosaic_vars_aa
87 aH2O = 0.01_r8*RH_pc ! aH2O (aerosol water activity)
88 P_atm = pr_atm ! P(atm)
92 ! on first time step, call load_mosaic_parameters and call print_aer twice
93 ! after first time step, just call print_aer once
94 ! for cam5 or wrfchem, this routine will loop over multiple grid boxes
95 ! call load_mosaic_parameters for first grid box (and all time steps)
96 ! call print_aer never
97 if (it_mosaic <= 1) then
98 mcall_load_mosaic_parameters = 1
99 mcall_print_aer_in = 2
101 mcall_load_mosaic_parameters = 0
102 mcall_print_aer_in = 1
105 call set_kappa_nonelectro( kappa_nonelectro )
107 ! map variables from rbox (and other) arrays to mosaic aerchem working arrays
108 call map_mosaic_species_aerchem_box( 0, jaerosolstate, &
109 rbox, aer, gas, jhyst_leg, num_a, Dp_dry_a, &
110 sigmag_a, water_a, water_a_hyst, cair_mol_m3 )
113 ! save values for possible dump
119 xsv_num(1:nbin_a_max) = num_a(1:nbin_a_max)
120 xsv_water(1:nbin_a_max) = water_a(1:nbin_a_max)
121 xsv_dpdry(1:nbin_a_max) = dp_dry_a(1:nbin_a_max)
122 xsv_dpwet(1:nbin_a_max) = dp_wet_a(1:nbin_a_max)
123 xsv_sigmag(1:nbin_a_max) = sigmag_a(1:nbin_a_max)
124 jsv_jhyst(1:nbin_a_max) = jhyst_leg(1:nbin_a_max)
125 jsv_jstate(1:nbin_a_max) = jaerosolstate(1:nbin_a_max)
126 xsv_gas(1:ngas_aerchtot) = gas(1:ngas_aerchtot)
127 xsv_gasavg(1:ngas_aerchtot) = gas_avg(1:ngas_aerchtot)
128 xsv_gasprod(1:ngas_aerchtot) = gas_netprod_otrproc(1:ngas_aerchtot)
129 xsv_aer(1:naer,1:3,1:nbin_a_max) = aer(1:naer,1:3,1:nbin_a_max)
132 !BSINGH - Following block is introduced to reproduce errors Mosaic
133 ! model encounters in other models (CAM,WRF etc.). This block repopulate
134 ! all the information which is going into the mosaic box (intent-ins and
135 ! intent-inouts). It is a binary read to preserve the accuracy.
136 if(debug_mosaic) then
137 call wrf_error_fatal( 'module_mosaic_aerchem_intr - debug_mosaic must be false' )
139 ! set these control variables
140 use_cam5mam_soa_params = 1
141 use_cam5mam_accom_coefs = 1
143 !Read a binary file which has all the inputs to the mosaic box
147 infile = 'mosaic_error_48.bin'
148 open( unitn, file=trim(infile), status='old', form='unformatted', CONVERT = 'BIG_ENDIAN' )
156 do ibin = 1, nbin_a_max
157 read(unitn)num_a(ibin),water_a(ibin),Dp_dry_a(ibin), &
158 sigmag_a(ibin),dp_wet_a(ibin),jhyst_leg(ibin), &
162 do igas = 1, ngas_aerchtot
163 if (igas <= ngas_volatile) then
164 read(unitn) gas(igas), gas_avg(igas), gas_netprod_otrproc(igas)
166 gas(igas) = 0.0 ; gas_avg(igas) = 0.0 ; gas_netprod_otrproc(igas) = 0.0
170 do ibin = 1, nbin_a_max
173 read(unitn)iaer_in,istate_in,ibin_in, aer_tmp
174 aer(iaer_in,istate_in,ibin_in) = aer_tmp
181 !BSINGH -----xxx ENDS reading file for debugging mosaic xxxx----
185 ! calculate gas-aerosol exchange over timestep dtchem
186 ! (during this calculation there is no transfer of particles between bins)
188 ! aH2O = 0.999 ! min(0.99, aH2O) ! RAZ 2/14/2014
192 allocate( mosaic_vars_aa%iter_mesa(nbin_a_max), stat=ierr )
194 call wrf_error_fatal('*** subr aerchemistry - allocate error for mosaic_vars_aa%iter_mesa')
196 mosaic_vars_aa%it_host = it_host
197 mosaic_vars_aa%it_mosaic = it_mosaic
198 mosaic_vars_aa%hostgridinfo(1:6) = hostgridinfo(1:6)
199 mosaic_vars_aa%idiagbb_host = idiagbb_host
200 mosaic_vars_aa%f_mos_fail = -1
201 mosaic_vars_aa%isteps_astem = 0
202 mosaic_vars_aa%isteps_astem_max = 0
203 mosaic_vars_aa%jastem_call = 0
204 mosaic_vars_aa%jastem_fail = -1
205 mosaic_vars_aa%jmesa_call = 0
206 mosaic_vars_aa%jmesa_fail = 0
207 mosaic_vars_aa%niter_mesa_max = 0
208 mosaic_vars_aa%nmax_astem = nmax_astem
209 mosaic_vars_aa%nmax_mesa = nmax_mesa
210 mosaic_vars_aa%fix_astem_negative = 0
211 mosaic_vars_aa%fix_astem_negative = 1
212 !BSINGH - flag_itr_kel becomes true when kelvin iteration in mdofule_mosaic_ext.F90 are greater then 100
213 mosaic_vars_aa%flag_itr_kel = .false.
214 !BSINGH - zero_water_flag becomes .true. if water is zero in liquid phase
215 mosaic_vars_aa%zero_water_flag = .false.
216 mosaic_vars_aa%cumul_steps_astem = 0.0_r8
217 mosaic_vars_aa%niter_mesa = 0.0_r8
218 mosaic_vars_aa%xnerr_astem_negative(:,:) = 0.0_r8
219 mosaic_vars_aa%iter_mesa(1:nbin_a_max) = 0
220 mosaic_vars_aa%swdown = swdownbox
223 call mosaic_box_aerchemistry( aH2O, T_K, &!Intent-ins
224 P_atm, RH_pc, dtchem, &
225 mcall_load_mosaic_parameters, mcall_print_aer_in, sigmag_a, &
227 jaerosolstate, aer, &!Intent-inouts
228 num_a, water_a, gas, &
229 gas_avg, gas_netprod_otrproc, Dp_dry_a, &
230 dp_wet_a, jhyst_leg, &
232 mass_dry_a_bgn, mass_dry_a, &!Intent-outs
233 dens_dry_a_bgn, dens_dry_a, water_a_hyst, aH2O_a, &
234 uptkrate_h2so4, gam_ratio, jaerosolstate_bgn )
237 istop_mosaic_error_grp1 = 0
238 istop_mosaic_error_grp2 = 0
242 ! if (jASTEM_fail > 0 .or. zero_water_flag .or. f_mos_fail > 0 ) then
243 if (mosaic_vars_aa%jastem_fail > 0 .or. mosaic_vars_aa%zero_water_flag .or. mosaic_vars_aa%f_mos_fail > 0) then
244 !Write error message and stop the model.
245 print '(2a/8i12)', '*** subr aerchemistry - ', &
246 'astem_fail or zero_water error', &
247 it_host, it_mosaic, hostgridinfo(1:6)
248 write(tmp_str,*) 'Error in Mosaic,jASTEM_fail= ', mosaic_vars_aa%jASTEM_fail, &
249 ' zero_water_flag: ', mosaic_vars_aa%zero_water_flag, &
250 ' f_mos_fail:', mosaic_vars_aa%f_mos_fail
251 print*, trim(adjustl(tmp_str))
255 iter_mesa_out(1:nbin_a_max) = mosaic_vars_aa%iter_mesa(1:nbin_a_max)
257 if ( sum(mosaic_vars_aa%xnerr_astem_negative(:,:)) > 0.0_r8 ) then
258 print '(2a/8i12)', '*** subr aerchemistry - ', &
259 'astem_negative error', &
260 it_host, it_mosaic, hostgridinfo(1:6)
262 print '(i2,1p,5e10.2)', n, mosaic_vars_aa%xnerr_astem_negative(:,n)
267 if ( it_mosaic <= 3 .and. hostgridinfo(2) == 1 .and. &
268 hostgridinfo(3) == 1 .and. hostgridinfo(4) == 1 ) then
269 print '(2a/8i12)', '*** subr aerchemistry - ', &
270 'artificial error', &
271 it_host, it_mosaic, hostgridinfo(1:6)
273 print '(i2,1p,5e10.2)', n, mosaic_vars_aa%xnerr_astem_negative(:,n)
278 if (ierror_grp1 > 0 .or. ierror_grp2 > 0) then
279 ! dump initial and final/current values for offline debugging
280 print '(a)', 'naer, nbin, ngas'
281 print '(8i14 )', naer, nbin_a, ngas_aerchtot
283 print '(8i14 )', jsv_jhyst(1:nbin_a)
284 print '(8i14 )', jhyst_leg(1:nbin_a)
285 print '(a)', 'jstate'
286 print '(8i14 )', jsv_jstate(1:nbin_a)
287 print '(8i14 )', jaerosolstate(1:nbin_a)
289 print '(1p,4e28.20)', xsv_misc(1:5)
290 print '(1p,4e28.20)', ah2o, t_k, p_atm, rh_pc, dtchem
292 print '(1p,4e28.20)', xsv_num(1:nbin_a)
293 print '(1p,4e28.20)', num_a(1:nbin_a)
295 print '(1p,4e28.20)', xsv_water(1:nbin_a)
296 print '(1p,4e28.20)', water_a(1:nbin_a)
298 print '(1p,4e28.20)', xsv_dpdry(1:nbin_a)
299 print '(1p,4e28.20)', dp_dry_a(1:nbin_a)
301 print '(1p,4e28.20)', xsv_dpwet(1:nbin_a)
302 print '(1p,4e28.20)', dp_wet_a(1:nbin_a)
303 print '(a)', 'sigmag'
304 print '(1p,4e28.20)', xsv_sigmag(1:nbin_a)
305 print '(1p,4e28.20)', sigmag_a(1:nbin_a)
307 print '(1p,4e28.20)', xsv_gas(1:ngas_aerchtot)
308 print '(1p,4e28.20)', gas(1:ngas_aerchtot)
309 print '(a)', 'gasavg'
310 print '(1p,4e28.20)', xsv_gasavg(1:ngas_aerchtot)
311 print '(1p,4e28.20)', gas_avg(1:ngas_aerchtot)
312 print '(a)', 'gasprod'
313 print '(1p,4e28.20)', xsv_gasprod(1:ngas_aerchtot)
314 print '(1p,4e28.20)', gas_netprod_otrproc(1:ngas_aerchtot)
316 print '(1p,4e28.20)', xsv_aer(1:naer,1:3,1:nbin_a)
317 print '(1p,4e28.20)', aer(1:naer,1:3,1:nbin_a)
320 if ( (istop_mosaic_error_grp1 > 0 .and. ierror_grp1 > 0) .or. &
321 (istop_mosaic_error_grp2 > 0 .and. ierror_grp1 > 0) ) then
322 ! stop if error encountered and the istop... is > 0
323 call wrf_error_fatal('Fortran Stop in subr aerchemistry')
327 deallocate( mosaic_vars_aa%iter_mesa, stat=ierr )
329 print '(2a/8i12)', '*** subr aerchemistry - ', &
330 'deallocate error for mosaic_vars_aa%iter_mesa', &
331 it_host, it_mosaic, hostgridinfo(1:6)
332 call wrf_error_fatal('Fortran Stop in subr aerchemistry')
337 ! map variables to rbox (and other) arrays from mosaic aerchem working arrays
338 call map_mosaic_species_aerchem_box( 1, jaerosolstate, &
339 rbox, aer, gas, jhyst_leg, num_a, Dp_dry_a, &
340 sigmag_a, water_a, water_a_hyst, cair_mol_m3 )
344 end subroutine aerchemistry
349 !-----------------------------------------------------------------------
350 subroutine set_kappa_nonelectro( kappa_nonelectro )
352 use module_data_mosaic_kind, only : r8
354 use module_data_mosaic_aero, only : &
355 ibc_a, ioc_a, ilim2_a, ioin_a, &
356 ipcg1_b_c_a, ipcg2_b_c_a, ipcg3_b_c_a, ipcg4_b_c_a, &
357 ipcg5_b_c_a, ipcg6_b_c_a, ipcg7_b_c_a, ipcg8_b_c_a, ipcg9_b_c_a, &
358 ipcg1_b_o_a, ipcg2_b_o_a, ipcg3_b_o_a, ipcg4_b_o_a, &
359 ipcg5_b_o_a, ipcg6_b_o_a, ipcg7_b_o_a, ipcg8_b_o_a, ipcg9_b_o_a, &
360 iopcg1_b_c_a, iopcg2_b_c_a, iopcg3_b_c_a, iopcg4_b_c_a, &
361 iopcg5_b_c_a, iopcg6_b_c_a, iopcg7_b_c_a, iopcg8_b_c_a, &
362 iopcg1_b_o_a, iopcg2_b_o_a, iopcg3_b_o_a, iopcg4_b_o_a, &
363 iopcg5_b_o_a, iopcg6_b_o_a, iopcg7_b_o_a, iopcg8_b_o_a, &
364 ipcg1_f_c_a, ipcg2_f_c_a, ipcg3_f_c_a, ipcg4_f_c_a, &
365 ipcg5_f_c_a, ipcg6_f_c_a, ipcg7_f_c_a, ipcg8_f_c_a, ipcg9_f_c_a, &
366 ipcg1_f_o_a, ipcg2_f_o_a, ipcg3_f_o_a, ipcg4_f_o_a, &
367 ipcg5_f_o_a, ipcg6_f_o_a, ipcg7_f_o_a, ipcg8_f_o_a, ipcg9_f_o_a, &
368 iopcg1_f_c_a, iopcg2_f_c_a, iopcg3_f_c_a, iopcg4_f_c_a, &
369 iopcg5_f_c_a, iopcg6_f_c_a, iopcg7_f_c_a, iopcg8_f_c_a, &
370 iopcg1_f_o_a, iopcg2_f_o_a, iopcg3_f_o_a, iopcg4_f_o_a, &
371 iopcg5_f_o_a, iopcg6_f_o_a, iopcg7_f_o_a, iopcg8_f_o_a, &
372 iant1_c_a, iant2_c_a, iant3_c_a, iant4_c_a, &
373 iant1_o_a, iant2_o_a, iant3_o_a, iant4_o_a, &
374 ibiog1_c_a, ibiog2_c_a, ibiog3_c_a, ibiog4_c_a, &
375 ibiog1_o_a, ibiog2_o_a, ibiog3_o_a, ibiog4_o_a, &
379 use module_data_mosaic_asect, only: &
380 hygro_oin_aer, hygro_oc_aer, hygro_bc_aer, &
381 hygro_pcg1_b_c_aer, hygro_pcg2_b_c_aer, hygro_pcg3_b_c_aer, &
382 hygro_pcg4_b_c_aer, hygro_pcg5_b_c_aer, hygro_pcg6_b_c_aer, &
383 hygro_pcg7_b_c_aer, hygro_pcg8_b_c_aer, hygro_pcg9_b_c_aer, &
384 hygro_pcg1_b_o_aer, hygro_pcg2_b_o_aer, hygro_pcg3_b_o_aer, &
385 hygro_pcg4_b_o_aer, hygro_pcg5_b_o_aer, hygro_pcg6_b_o_aer, &
386 hygro_pcg7_b_o_aer, hygro_pcg8_b_o_aer, hygro_pcg9_b_o_aer, &
387 hygro_opcg1_b_c_aer, hygro_opcg2_b_c_aer, hygro_opcg3_b_c_aer, &
388 hygro_opcg4_b_c_aer, hygro_opcg5_b_c_aer, hygro_opcg6_b_c_aer, &
389 hygro_opcg7_b_c_aer, hygro_opcg8_b_c_aer, &
390 hygro_opcg1_b_o_aer, hygro_opcg2_b_o_aer, hygro_opcg3_b_o_aer, &
391 hygro_opcg4_b_o_aer, hygro_opcg5_b_o_aer, hygro_opcg6_b_o_aer, &
392 hygro_opcg7_b_o_aer, hygro_opcg8_b_o_aer, &
393 hygro_pcg1_f_c_aer, hygro_pcg2_f_c_aer, hygro_pcg3_f_c_aer, &
394 hygro_pcg4_f_c_aer, hygro_pcg5_f_c_aer, hygro_pcg6_f_c_aer, &
395 hygro_pcg7_f_c_aer, hygro_pcg8_f_c_aer, hygro_pcg9_f_c_aer, &
396 hygro_pcg1_f_o_aer, hygro_pcg2_f_o_aer, hygro_pcg3_f_o_aer, &
397 hygro_pcg4_f_o_aer, hygro_pcg5_f_o_aer, hygro_pcg6_f_o_aer, &
398 hygro_pcg7_f_o_aer, hygro_pcg8_f_o_aer, hygro_pcg9_f_o_aer, &
399 hygro_opcg1_f_c_aer, hygro_opcg2_f_c_aer, hygro_opcg3_f_c_aer, &
400 hygro_opcg4_f_c_aer, hygro_opcg5_f_c_aer, hygro_opcg6_f_c_aer, &
401 hygro_opcg7_f_c_aer, hygro_opcg8_f_c_aer, &
402 hygro_opcg1_f_o_aer, hygro_opcg2_f_o_aer, hygro_opcg3_f_o_aer, &
403 hygro_opcg4_f_o_aer, hygro_opcg5_f_o_aer, hygro_opcg6_f_o_aer, &
404 hygro_opcg7_f_o_aer, hygro_opcg8_f_o_aer, &
405 hygro_ant1_c_aer, hygro_ant2_c_aer, hygro_ant3_c_aer, hygro_ant4_c_aer, &
406 hygro_ant1_o_aer, hygro_ant2_o_aer, hygro_ant3_o_aer, hygro_ant4_o_aer, &
407 hygro_biog1_c_aer, hygro_biog2_c_aer, hygro_biog3_c_aer, hygro_biog4_c_aer, &
408 hygro_biog1_o_aer, hygro_biog2_o_aer, hygro_biog3_o_aer, hygro_biog4_o_aer, &
409 hygro_smpa_aer, hygro_smpbb_aer
411 real(r8), dimension(naer), intent(inout) :: kappa_nonelectro
413 real(r8) :: kappa_soa
415 kappa_nonelectro(1:naer) = 0.0_r8
417 if (msoa_flag1 < 1000) then
418 ! non-vbs soa treatment
419 kappa_nonelectro(ibc_a ) = 0.0001 ! previously kappa_poa = 0.0001
420 kappa_nonelectro(ioc_a ) = 0.0001 ! previously kappa_bc = 0.0001
421 if (1 <= ilim2_a .and. ilim2_a <= naer) &
422 kappa_nonelectro(ilim2_a) = 0.1 ! previously kappa_soa = 0.1
423 kappa_nonelectro(ioin_a ) = 0.06 ! previously kappa_oin = 0.06
430 if (ioin_a > 0) kappa_nonelectro(ioin_a ) = hygro_oin_aer
431 if (ioc_a > 0) kappa_nonelectro(ioc_a ) = hygro_oc_aer
432 if (ibc_a > 0) kappa_nonelectro(ibc_a ) = hygro_bc_aer
434 if (ipcg1_b_c_a > 0) kappa_nonelectro(ipcg1_b_c_a ) = hygro_pcg1_b_c_aer
435 if (ipcg2_b_c_a > 0) kappa_nonelectro(ipcg2_b_c_a ) = hygro_pcg2_b_c_aer
436 if (ipcg3_b_c_a > 0) kappa_nonelectro(ipcg3_b_c_a ) = hygro_pcg3_b_c_aer
437 if (ipcg4_b_c_a > 0) kappa_nonelectro(ipcg4_b_c_a ) = hygro_pcg4_b_c_aer
438 if (ipcg5_b_c_a > 0) kappa_nonelectro(ipcg5_b_c_a ) = hygro_pcg5_b_c_aer
439 if (ipcg6_b_c_a > 0) kappa_nonelectro(ipcg6_b_c_a ) = hygro_pcg6_b_c_aer
440 if (ipcg7_b_c_a > 0) kappa_nonelectro(ipcg7_b_c_a ) = hygro_pcg7_b_c_aer
441 if (ipcg8_b_c_a > 0) kappa_nonelectro(ipcg8_b_c_a ) = hygro_pcg8_b_c_aer
442 if (ipcg9_b_c_a > 0) kappa_nonelectro(ipcg9_b_c_a ) = hygro_pcg9_b_c_aer
443 if (ipcg1_b_o_a > 0) kappa_nonelectro(ipcg1_b_o_a ) = hygro_pcg1_b_o_aer
444 if (ipcg2_b_o_a > 0) kappa_nonelectro(ipcg2_b_o_a ) = hygro_pcg2_b_o_aer
445 if (ipcg3_b_o_a > 0) kappa_nonelectro(ipcg3_b_o_a ) = hygro_pcg3_b_o_aer
446 if (ipcg4_b_o_a > 0) kappa_nonelectro(ipcg4_b_o_a ) = hygro_pcg4_b_o_aer
447 if (ipcg5_b_o_a > 0) kappa_nonelectro(ipcg5_b_o_a ) = hygro_pcg5_b_o_aer
448 if (ipcg6_b_o_a > 0) kappa_nonelectro(ipcg6_b_o_a ) = hygro_pcg6_b_o_aer
449 if (ipcg7_b_o_a > 0) kappa_nonelectro(ipcg7_b_o_a ) = hygro_pcg7_b_o_aer
450 if (ipcg8_b_o_a > 0) kappa_nonelectro(ipcg8_b_o_a ) = hygro_pcg8_b_o_aer
451 if (ipcg9_b_o_a > 0) kappa_nonelectro(ipcg9_b_o_a ) = hygro_pcg9_b_o_aer
452 if (iopcg1_b_c_a > 0) kappa_nonelectro(iopcg1_b_c_a ) = hygro_opcg1_b_c_aer
453 if (iopcg2_b_c_a > 0) kappa_nonelectro(iopcg2_b_c_a ) = hygro_opcg2_b_c_aer
454 if (iopcg3_b_c_a > 0) kappa_nonelectro(iopcg3_b_c_a ) = hygro_opcg3_b_c_aer
455 if (iopcg4_b_c_a > 0) kappa_nonelectro(iopcg4_b_c_a ) = hygro_opcg4_b_c_aer
456 if (iopcg5_b_c_a > 0) kappa_nonelectro(iopcg5_b_c_a ) = hygro_opcg5_b_c_aer
457 if (iopcg6_b_c_a > 0) kappa_nonelectro(iopcg6_b_c_a ) = hygro_opcg6_b_c_aer
458 if (iopcg7_b_c_a > 0) kappa_nonelectro(iopcg7_b_c_a ) = hygro_opcg7_b_c_aer
459 if (iopcg8_b_c_a > 0) kappa_nonelectro(iopcg8_b_c_a ) = hygro_opcg8_b_c_aer
460 if (iopcg1_b_o_a > 0) kappa_nonelectro(iopcg1_b_o_a ) = hygro_opcg1_b_o_aer
461 if (iopcg2_b_o_a > 0) kappa_nonelectro(iopcg2_b_o_a ) = hygro_opcg2_b_o_aer
462 if (iopcg3_b_o_a > 0) kappa_nonelectro(iopcg3_b_o_a ) = hygro_opcg3_b_o_aer
463 if (iopcg4_b_o_a > 0) kappa_nonelectro(iopcg4_b_o_a ) = hygro_opcg4_b_o_aer
464 if (iopcg5_b_o_a > 0) kappa_nonelectro(iopcg5_b_o_a ) = hygro_opcg5_b_o_aer
465 if (iopcg6_b_o_a > 0) kappa_nonelectro(iopcg6_b_o_a ) = hygro_opcg6_b_o_aer
466 if (iopcg7_b_o_a > 0) kappa_nonelectro(iopcg7_b_o_a ) = hygro_opcg7_b_o_aer
467 if (iopcg8_b_o_a > 0) kappa_nonelectro(iopcg8_b_o_a ) = hygro_opcg8_b_o_aer
468 if (ipcg1_f_c_a > 0) kappa_nonelectro(ipcg1_f_c_a ) = hygro_pcg1_f_c_aer
469 if (ipcg2_f_c_a > 0) kappa_nonelectro(ipcg2_f_c_a ) = hygro_pcg2_f_c_aer
470 if (ipcg3_f_c_a > 0) kappa_nonelectro(ipcg3_f_c_a ) = hygro_pcg3_f_c_aer
471 if (ipcg4_f_c_a > 0) kappa_nonelectro(ipcg4_f_c_a ) = hygro_pcg4_f_c_aer
472 if (ipcg5_f_c_a > 0) kappa_nonelectro(ipcg5_f_c_a ) = hygro_pcg5_f_c_aer
473 if (ipcg6_f_c_a > 0) kappa_nonelectro(ipcg6_f_c_a ) = hygro_pcg6_f_c_aer
474 if (ipcg7_f_c_a > 0) kappa_nonelectro(ipcg7_f_c_a ) = hygro_pcg7_f_c_aer
475 if (ipcg8_f_c_a > 0) kappa_nonelectro(ipcg8_f_c_a ) = hygro_pcg8_f_c_aer
476 if (ipcg9_f_c_a > 0) kappa_nonelectro(ipcg9_f_c_a ) = hygro_pcg9_f_c_aer
477 if (ipcg1_f_o_a > 0) kappa_nonelectro(ipcg1_f_o_a ) = hygro_pcg1_f_o_aer
478 if (ipcg2_f_o_a > 0) kappa_nonelectro(ipcg2_f_o_a ) = hygro_pcg2_f_o_aer
479 if (ipcg3_f_o_a > 0) kappa_nonelectro(ipcg3_f_o_a ) = hygro_pcg3_f_o_aer
480 if (ipcg4_f_o_a > 0) kappa_nonelectro(ipcg4_f_o_a ) = hygro_pcg4_f_o_aer
481 if (ipcg5_f_o_a > 0) kappa_nonelectro(ipcg5_f_o_a ) = hygro_pcg5_f_o_aer
482 if (ipcg6_f_o_a > 0) kappa_nonelectro(ipcg6_f_o_a ) = hygro_pcg6_f_o_aer
483 if (ipcg7_f_o_a > 0) kappa_nonelectro(ipcg7_f_o_a ) = hygro_pcg7_f_o_aer
484 if (ipcg8_f_o_a > 0) kappa_nonelectro(ipcg8_f_o_a ) = hygro_pcg8_f_o_aer
485 if (ipcg9_f_o_a > 0) kappa_nonelectro(ipcg9_f_o_a ) = hygro_pcg9_f_o_aer
486 if (iopcg1_f_c_a > 0) kappa_nonelectro(iopcg1_f_c_a ) = hygro_opcg1_f_c_aer
487 if (iopcg2_f_c_a > 0) kappa_nonelectro(iopcg2_f_c_a ) = hygro_opcg2_f_c_aer
488 if (iopcg3_f_c_a > 0) kappa_nonelectro(iopcg3_f_c_a ) = hygro_opcg3_f_c_aer
489 if (iopcg4_f_c_a > 0) kappa_nonelectro(iopcg4_f_c_a ) = hygro_opcg4_f_c_aer
490 if (iopcg5_f_c_a > 0) kappa_nonelectro(iopcg5_f_c_a ) = hygro_opcg5_f_c_aer
491 if (iopcg6_f_c_a > 0) kappa_nonelectro(iopcg6_f_c_a ) = hygro_opcg6_f_c_aer
492 if (iopcg7_f_c_a > 0) kappa_nonelectro(iopcg7_f_c_a ) = hygro_opcg7_f_c_aer
493 if (iopcg8_f_c_a > 0) kappa_nonelectro(iopcg8_f_c_a ) = hygro_opcg8_f_c_aer
494 if (iopcg1_f_o_a > 0) kappa_nonelectro(iopcg1_f_o_a ) = hygro_opcg1_f_o_aer
495 if (iopcg2_f_o_a > 0) kappa_nonelectro(iopcg2_f_o_a ) = hygro_opcg2_f_o_aer
496 if (iopcg3_f_o_a > 0) kappa_nonelectro(iopcg3_f_o_a ) = hygro_opcg3_f_o_aer
497 if (iopcg4_f_o_a > 0) kappa_nonelectro(iopcg4_f_o_a ) = hygro_opcg4_f_o_aer
498 if (iopcg5_f_o_a > 0) kappa_nonelectro(iopcg5_f_o_a ) = hygro_opcg5_f_o_aer
499 if (iopcg6_f_o_a > 0) kappa_nonelectro(iopcg6_f_o_a ) = hygro_opcg6_f_o_aer
500 if (iopcg7_f_o_a > 0) kappa_nonelectro(iopcg7_f_o_a ) = hygro_opcg7_f_o_aer
501 if (iopcg8_f_o_a > 0) kappa_nonelectro(iopcg8_f_o_a ) = hygro_opcg8_f_o_aer
503 if (iant1_c_a > 0) kappa_nonelectro(iant1_c_a ) = hygro_ant1_c_aer
504 if (iant2_c_a > 0) kappa_nonelectro(iant2_c_a ) = hygro_ant2_c_aer
505 if (iant3_c_a > 0) kappa_nonelectro(iant3_c_a ) = hygro_ant3_c_aer
506 if (iant4_c_a > 0) kappa_nonelectro(iant4_c_a ) = hygro_ant4_c_aer
507 if (iant1_o_a > 0) kappa_nonelectro(iant1_o_a ) = hygro_ant1_o_aer
508 if (iant2_o_a > 0) kappa_nonelectro(iant2_o_a ) = hygro_ant2_o_aer
509 if (iant3_o_a > 0) kappa_nonelectro(iant3_o_a ) = hygro_ant3_o_aer
510 if (iant4_o_a > 0) kappa_nonelectro(iant4_o_a ) = hygro_ant4_o_aer
511 if (ibiog1_c_a > 0) kappa_nonelectro(ibiog1_c_a ) = hygro_biog1_c_aer
512 if (ibiog2_c_a > 0) kappa_nonelectro(ibiog2_c_a ) = hygro_biog2_c_aer
513 if (ibiog3_c_a > 0) kappa_nonelectro(ibiog3_c_a ) = hygro_biog3_c_aer
514 if (ibiog4_c_a > 0) kappa_nonelectro(ibiog4_c_a ) = hygro_biog4_c_aer
515 if (ibiog1_o_a > 0) kappa_nonelectro(ibiog1_o_a ) = hygro_biog1_o_aer
516 if (ibiog2_o_a > 0) kappa_nonelectro(ibiog2_o_a ) = hygro_biog2_o_aer
517 if (ibiog3_o_a > 0) kappa_nonelectro(ibiog3_o_a ) = hygro_biog3_o_aer
518 if (ibiog4_o_a > 0) kappa_nonelectro(ibiog4_o_a ) = hygro_biog4_o_aer
520 if (ismpa_a > 0) kappa_nonelectro(ismpa_a ) = hygro_smpa_aer
521 if (ismpbb_a > 0) kappa_nonelectro(ismpbb_a ) = hygro_smpbb_aer
523 end if ! if (msoa_flag1 < 1000) then
526 end subroutine set_kappa_nonelectro
529 !***********************************************************************
530 ! maps gas and aerosol information between
531 ! rbox, jhyst_leg, ... AND
532 ! aerchemistry working arrays (gas, aer, num_a, water_a, ...)
534 ! author: Rahul A. Zaveri
536 !-----------------------------------------------------------------------
537 subroutine map_mosaic_species_aerchem_box( imap, jaerosolstate, &
538 rbox, aer, gas, jhyst_leg, num_a, Dp_dry_a, &
539 sigmag_a, water_a, water_a_hyst, cair_mol_m3 )
541 use module_data_mosaic_kind, only: r8
542 use module_data_mosaic_aero, only: &
543 nbin_a_max, naer, ngas_aerchtot, jtotal, & !Parameters
545 jhyst_lo, jhyst_up, jhyst_undefined, &
546 mhyst_method, mhyst_uporlo_waterhyst, &
548 all_solid, all_liquid, mixed, no_aerosol
549 use module_data_mosaic_asecthp, only: &
550 rbox_aer_ptr, rbox_gas_ptr
551 use module_data_mosaic_main, only: &
552 m_partmc_mosaic, naer_tot, ngas_max, ntot_used, &
553 avogad, mw_air, piover6
557 integer, intent(in) :: imap
558 integer, intent(inout), dimension(nbin_a_max) :: jaerosolstate, jhyst_leg
560 real(r8), intent(in) :: cair_mol_m3
561 real(r8), intent(inout), dimension(ntot_used) :: rbox
562 real(r8), intent(inout), dimension(nbin_a_max) :: num_a, Dp_dry_a, sigmag_a, water_a, water_a_hyst
563 real(r8), intent(inout), dimension(ngas_aerchtot) :: gas
564 real(r8), intent(inout), dimension(naer,3,nbin_a_max) :: aer
567 character(len=256) :: errmsg
568 integer :: ibin, iaer, igas, l, noffset
569 real(r8) :: conv_aer, conv_aerinv
570 real(r8) :: conv_gas, conv_gasinv
571 real(r8) :: conv_num, conv_numinv
572 real(r8) :: conv_wat, conv_watinv
576 if ((imap < 0) .or. (imap > 1)) then
577 write(errmsg,*)'*** map_mosaic_species_BOX fatal error - bad imap =', imap
578 call wrf_error_fatal(trim(adjustl(errmsg)))
582 ! define conversion factors
584 ! gases -- rbox = umol/mol, gas = rbox*conv_gas = nmol/m^3
585 conv_gas = 1.e3_r8*cair_mol_m3
586 conv_gasinv = 1.0_r8/conv_gas
588 ! aerosol mass -- rbox = ug/kg, aer = rbox*conv_aer/mw_aer = nmol/m^3
589 conv_aer = mw_air*cair_mol_m3
590 conv_aerinv = 1.0_r8/conv_aer
592 ! aerosol water -- rbox = ug/kg, water_a = rbox*conv_wat = kg/m^3
593 conv_wat = 1.e-12_r8*mw_air*cair_mol_m3
594 conv_watinv = 1.0_r8/conv_wat
596 ! aerosol number -- rbox = #/kg, num_a = rbox*conv_num = #/cm^3
597 conv_num = 1.e-9_r8*mw_air*cair_mol_m3
598 conv_numinv = 1.0_r8/conv_num
602 ! map from host code arrays (rbox in this case) to
603 ! mosaic aerchem working arrays (gas, aer, num_a, etc)
604 gas(1:ngas_aerchtot) = 0.0_r8
605 aer(1:naer,3,1:nbin_a_max) = 0.0_r8
606 num_a(1:nbin_a_max) = 0.0_r8
607 water_a(1:nbin_a_max) = 0.0_r8
608 water_a_hyst(1:nbin_a_max) = 0.0_r8
610 ! gases -- rbox = mol/mol, gas = nmol/m^3
611 do igas = 1, ngas_aerchtot
612 l = rbox_gas_ptr( igas )
613 if (l > 0) gas(igas) = rbox(l)*conv_gas
616 !print*,'BALLI:in-map:', gas(inh3_g),cnn(knh3),conv1,knh3
618 !BSINGH - 05/28/2013(RCE updates)
619 if (m_partmc_mosaic <= 0) then
620 ! do this only for mosaic box-model (skip for partmc_mosaic)
621 !BSINGH - 05/28/2013(RCE updates ENDS)
623 ! noffset = ngas_max + naer_tot*(ibin - 1)
624 l = rbox_aer_ptr( -1, ibin )
626 num_a(ibin) = rbox(l)*conv_num ! aerosol number -- rbox = #/kg, num_a = #/cm^3
627 ! num_a(ibin) = rbox(noffset + knum_a)*conv_num ! aerosol number -- rbox = #/kg, num_a = #/cm^3
629 l = rbox_aer_ptr( -2, ibin )
631 water_a(ibin) = rbox(l)*conv_wat ! aerosol water -- rbox = ug/kg, water_a = kg/m^3
632 ! water_a(ibin) = rbox(noffset + kwater_a)*conv_wat ! aerosol water -- rbox = ug/kg, water_a = kg/m^3
634 if (mhyst_method == mhyst_uporlo_waterhyst) then
635 ! in this case, rbox holds water_a_hyst
636 l = rbox_aer_ptr( -3, ibin )
638 water_a_hyst(ibin) = rbox(l)*conv_wat ! rbox = ug/kg, water_a_hyst = kg/m^3
639 ! water_a_hyst(ibin) = rbox(noffset + kjhyst_a)*conv_wat ! rbox = ug/kg, water_a_hyst = kg/m^3
640 ! value of jhyst_leg should not matter, so set it to undefined
641 jhyst_leg(ibin) = jhyst_undefined
643 ! in this case, use the incoming jhyst_leg value (unchanged)
644 ! also, input value of water_a_hyst should not be important, so set it to zero
645 water_a_hyst(ibin) = 0.0_r8
649 ! aerosol mass components -- rbox = ug/kg, aer = nmol/m^3
650 ! (for oin, bc, oc, molecular weight = 1.0 so moles = grams)
651 l = rbox_aer_ptr( iaer, ibin )
653 aer(iaer,jtotal,ibin) = rbox(l)*conv_aer/mw_aer_mac(iaer)
654 ! aer(iaer,jtotal,ibin) = rbox(noffset+kwater_a+iaer)*conv_aer/mw_aer_mac(iaer)
658 endif!BSINGH - 05/28/2013(RCE updates)
660 else if (imap == 1) then
661 ! map from mosaic aerchem working arrays (gas, aer, num_a, etc)
662 ! back to host code arrays (rbox in this case)
664 do igas = 1, ngas_aerchtot
665 l = rbox_gas_ptr( igas )
666 if (l > 0) rbox(l) = gas(igas)*conv_gasinv
670 !BSINGH - 05/28/2013(RCE updates)
671 if (m_partmc_mosaic <= 0) then
672 ! do this only for mosaic box-model (skip for partmc_mosaic)
673 !BSINGH - 05/28/2013(RCE updates ENDS)
676 ! noffset = ngas_max + naer_tot*(ibin - 1)
677 l = rbox_aer_ptr( -1, ibin )
679 rbox(l) = num_a(ibin)*conv_numinv
680 ! rbox(noffset + knum_a) = num_a(ibin)*conv_numinv
682 l = rbox_aer_ptr( -2, ibin )
684 rbox(l) = water_a(ibin)*conv_watinv
685 ! rbox(noffset + kwater_a) = water_a(ibin)*conv_watinv
687 if (mhyst_method == mhyst_uporlo_waterhyst) then
688 ! in this case, rbox holds water_a_hyst
689 l = rbox_aer_ptr( -3, ibin )
690 if ( jaerosolstate(ibin) == all_solid .or. &
691 jaerosolstate(ibin) == all_liquid .or. &
692 jaerosolstate(ibin) == mixed ) then
694 rbox(l) = water_a_hyst(ibin)*conv_watinv
695 ! rbox(noffset + kjhyst_a) = water_a_hyst(ibin)*conv_watinv
699 ! rbox(noffset + kjhyst_a) = 0.0_r8
701 ! value of jhyst_leg should not matter, so leave it unchanged
703 ! when mhyst_method /= mhyst_uporlo_waterhyst, do nothing,
704 ! leave both jhyst_leg and rbox unchanged
705 if ( jaerosolstate(ibin) == all_solid .or. &
706 jaerosolstate(ibin) == all_liquid .or. &
707 jaerosolstate(ibin) == mixed ) then
709 ! jhyst_leg(ibin) = jhyst_leg(ibin)
711 jhyst_leg(ibin) = jhyst_undefined
716 l = rbox_aer_ptr( iaer, ibin )
718 rbox(l) = aer(iaer,jtotal,ibin)*conv_aerinv*mw_aer_mac(iaer)
719 ! rbox(noffset+kwater_a+iaer) = aer(iaer,jtotal,ibin)*conv_aerinv*mw_aer_mac(iaer)
723 endif!BSINGH - 05/28/2013(RCE updates)
728 end subroutine map_mosaic_species_aerchem_box
732 end module module_mosaic_aerchem_intr