38 subroutine mosaic_init(env_state, aero_data, del_t, do_optical)
41 use module_data_mosaic_aero,
only: alpha_astem, rtol_eqb_astem, &
42 ptol_mol_astem, mgas_aer_xfer, mdynamic_solver
44 use module_data_mosaic_main,
only: tbeg_sec, dt_sec, rlon, rlat, &
45 zalt_m, rh, te, pr_atm, cair_mlc, cair_molm3, ppb, avogad, &
46 mmode, mgas, maer, mcld, maeroptic, mshellcore, &
47 msolar, mphoto, lun_aeroptic, naerbin
55 real(kind=
dp),
intent(in) :: del_t
57 logical,
intent(in) :: do_optical
62 subroutine loadperoxyparameters()
63 end subroutine loadperoxyparameters
64 subroutine init_data_modules()
65 end subroutine init_data_modules
66 subroutine allocatememory()
67 end subroutine allocatememory
70 call init_data_modules
93 rtol_eqb_astem = 0.01d0
94 ptol_mol_astem = 0.01d0
98 tbeg_sec = env_state%start_day*24*3600 + &
99 nint(env_state%start_time)
102 rlon =
deg2rad(env_state%longitude)
103 rlat =
deg2rad(env_state%latitude)
104 zalt_m = env_state%altitude
107 rh = env_state%rel_humid * 100.d0
109 pr_atm = env_state%pressure /
const%air_std_press
110 cair_mlc = avogad*pr_atm/(82.056d0*te)
111 cair_molm3 = 1d6*pr_atm/(82.056d0*te)
114 call loadperoxyparameters
117 if (lun_aeroptic <= 0 ) lun_aeroptic =
get_unit()
120 call assert_msg(111041803, aero_data%i_water > 0, &
121 "MOSAIC requires H2O as an aerosol species")
132 #ifdef PMC_USE_MOSAIC
135 subroutine deallocatememory()
136 end subroutine deallocatememory
139 call deallocatememory()
148 aero_state, gas_data, gas_state)
150 #ifdef PMC_USE_MOSAIC
151 use module_data_mosaic_aero,
only: nbin_a, aer, num_a, jhyst_leg, &
157 use module_data_mosaic_main,
only: tbeg_sec, tcur_sec, tmid_sec, &
158 dt_sec, dt_min, dt_aeroptic_min, rh, te, pr_atm, cnn, cair_mlc, &
159 cair_molm3, ppb, avogad, msolar, naerbin
173 #ifdef PMC_USE_MOSAIC
175 real(kind=
dp) :: time_utc
176 real(kind=
dp) :: tmar21_sec
178 integer :: i_part, i_spec, i_spec_mosaic
179 real(kind=
dp) :: num_conc
183 subroutine allocatememory()
184 end subroutine allocatememory
185 subroutine deallocatememory()
186 end subroutine deallocatememory
190 tmar21_sec = real((79*24 + 12)*3600, kind=
dp)
191 tcur_sec = real(tbeg_sec, kind=
dp) + env_state%elapsed_time
194 time_utc = env_state%start_time/3600d0
195 time_utc = time_utc + dt_sec/3600d0
197 do while (time_utc >= 24d0)
198 time_utc = time_utc - 24d0
201 tmid_sec = tcur_sec + 0.5d0*dt_sec
202 if(tmid_sec .ge. tmar21_sec)
then
203 tmid_sec = tmid_sec - tmar21_sec
205 tmid_sec = tmid_sec &
206 + dble(((365-79)*24 - 12)*3600)
212 dt_aeroptic_min = 0d0
217 conv_fac(i_spec) = 1.d9 * aero_data%density(i_spec) &
218 / aero_data%molec_weight(i_spec)
222 rh = env_state%rel_humid * 100.d0
224 pr_atm = env_state%pressure /
const%air_std_press
225 cair_mlc = avogad*pr_atm/(82.056d0*te)
226 cair_molm3 = 1d6*pr_atm/(82.056d0*te)
231 if (nbin_a > naerbin)
then
232 call deallocatememory()
234 call allocatememory()
240 num_conc = aero_weight_array_num_conc(aero_state%awa, &
241 aero_state%apa%particle(i_part), aero_data)
243 i_spec_mosaic = aero_data%mosaic_index(i_spec)
244 if (i_spec_mosaic > 0)
then
246 aer(i_spec_mosaic, 3, i_part) &
247 = aero_state%apa%particle(i_part)%vol(i_spec) &
248 * conv_fac(i_spec) * num_conc
254 aero_state%apa%particle(i_part)%vol(aero_data%i_water) &
255 * aero_data%density(aero_data%i_water) * num_conc
256 num_a(i_part) = 1d-6 * num_conc
257 jhyst_leg(i_part) = aero_state%apa%particle(i_part)%water_hyst_leg
263 i_spec_mosaic = gas_data%mosaic_index(i_spec)
264 if (i_spec_mosaic > 0)
then
266 cnn(i_spec_mosaic) = gas_state%mix_rat(i_spec) * cair_mlc / ppb
270 particle_error = .false.
282 #ifdef PMC_USE_MOSAIC
283 use module_data_mosaic_aero,
only: nbin_a, aer, num_a, jhyst_leg, &
289 use module_data_mosaic_main,
only: tbeg_sec, tcur_sec, tmid_sec, &
290 dt_sec, dt_min, dt_aeroptic_min, rh, te, pr_atm, cnn, cair_mlc, &
291 cair_molm3, ppb, avogad, msolar, cos_sza
305 character(len=PMC_UUID_LEN),
intent(in) :: uuid
307 #ifdef PMC_USE_MOSAIC
310 integer :: i_part, i_spec, i_spec_mosaic
311 real(kind=
dp),
allocatable :: reweight_num_conc(:)
314 if (any(particle_error) .eqv. .true.)
then
316 aero_state, gas_data, gas_state, env_state, &
317 int(env_state%elapsed_time / dt_sec), tcur_sec, dt_sec, 1, &
318 .false., .false., uuid)
325 conv_fac(i_spec) = 1d9 * aero_data%density(i_spec) &
326 / aero_data%molec_weight(i_spec)
330 env_state%rel_humid = rh / 100d0
332 env_state%pressure = pr_atm *
const%air_std_press
333 if (msolar == 1)
then
334 env_state%solar_zenith_angle = acos(cos_sza)
336 cair_mlc = avogad*pr_atm/(82.056d0*te)
337 cair_molm3 = 1d6*pr_atm/(82.056d0*te)
342 i_spec_mosaic = gas_data%mosaic_index(i_spec)
343 if (i_spec_mosaic > 0)
then
345 gas_state%mix_rat(i_spec) = cnn(i_spec_mosaic) / cair_mlc * ppb
350 aero_state%valid_sort = .false.
357 num_conc = aero_weight_array_num_conc(aero_state%awa, &
358 aero_state%apa%particle(i_part), aero_data)
360 i_spec_mosaic = aero_data%mosaic_index(i_spec)
361 if (i_spec_mosaic > 0)
then
362 aero_state%apa%particle(i_part)%vol(i_spec) = &
364 aer(i_spec_mosaic, 3, i_part) / (conv_fac(i_spec) * num_conc)
367 aero_state%apa%particle(i_part)%water_hyst_leg = jhyst_leg(i_part)
370 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = &
371 water_a(i_part) / aero_data%density(aero_data%i_water) / num_conc
375 if (any(particle_error) .eqv. .true.)
then
377 aero_state, gas_data, gas_state, env_state, &
378 int(env_state%elapsed_time / dt_sec), tcur_sec, dt_sec, 1,&
379 .false., .false., uuid)
381 if (particle_error(i_part))
then
384 reweight_num_conc(i_part) = reweight_num_conc( &
412 gas_state, do_optical, uuid)
414 #ifdef PMC_USE_MOSAIC
415 use module_data_mosaic_main,
only: msolar
429 logical,
intent(in) :: do_optical
431 character(len=PMC_UUID_LEN),
intent(in) :: uuid
433 #ifdef PMC_USE_MOSAIC
436 subroutine solarzenithangle()
437 end subroutine solarzenithangle
438 subroutine integratechemistry()
439 end subroutine integratechemistry
440 #ifdef PMC_USE_MOSAIC_MULTI_OPT
441 subroutine aerosol_optical(i_wavelength)
442 integer,
optional :: i_wavelength
443 end subroutine aerosol_optical
445 subroutine aerosol_optical()
446 end subroutine aerosol_optical
454 if (msolar == 1)
then
455 call solarzenithangle
458 call integratechemistry
466 aero_state, gas_data, gas_state)
484 aero_state, gas_data, gas_state)
486 #ifdef PMC_USE_MOSAIC
487 use module_data_mosaic_aero,
only: ri_shell_a, ri_core_a, &
488 ext_cross, scat_cross, asym_particle, dp_core_a
502 #ifdef PMC_USE_MOSAIC
505 #ifdef PMC_USE_MOSAIC_MULTI_OPT
506 subroutine aerosol_optical(i_wavelength)
507 integer,
optional :: i_wavelength
508 end subroutine aerosol_optical
510 subroutine aerosol_optical()
511 end subroutine aerosol_optical
527 #ifdef PMC_USE_MOSAIC_MULTI_OPT
528 aero_state%apa%particle(i_part)%absorb_cross_sect = &
529 (ext_cross(i_part,:) - scat_cross(i_part,:)) / 1d4
530 aero_state%apa%particle(i_part)%scatter_cross_sect = &
531 scat_cross(i_part,:) / 1d4
532 aero_state%apa%particle(i_part)%asymmetry = &
533 asym_particle(i_part,:)
534 aero_state%apa%particle(i_part)%refract_shell = &
535 cmplx(ri_shell_a(i_part,:), kind=
dc)
536 aero_state%apa%particle(i_part)%refract_core =&
537 cmplx(ri_core_a(i_part,:), kind=
dc)
538 aero_state%apa%particle(i_part)%core_vol = &
541 aero_state%apa%particle(i_part)%absorb_cross_sect = (ext_cross(i_part) &
542 - scat_cross(i_part)) / 1d4
543 aero_state%apa%particle(i_part)%scatter_cross_sect = &
544 scat_cross(i_part) / 1d4
545 aero_state%apa%particle(i_part)%asymmetry = asym_particle(i_part)
546 aero_state%apa%particle(i_part)%refract_shell = &
547 cmplx(ri_shell_a(i_part), kind=
dc)
548 aero_state%apa%particle(i_part)%refract_core =&
549 cmplx(ri_core_a(i_part), kind=
dc)
550 aero_state%apa%particle(i_part)%core_vol = &
563 aero_state, gas_data, gas_state)
565 #ifdef PMC_USE_MOSAIC
566 use module_data_mosaic_aero,
only: ri_shell_a, ri_core_a, &
567 ext_cross, scat_cross, asym_particle, dp_core_a
581 #ifdef PMC_USE_MOSAIC
584 subroutine load_mosaic_parameters()
585 end subroutine load_mosaic_parameters
586 #ifdef PMC_USE_MOSAIC_MULTI_OPT
587 subroutine aerosol_optical(i_wavelength)
588 integer,
optional :: i_wavelength
589 end subroutine aerosol_optical
591 subroutine aerosol_optical()
592 end subroutine aerosol_optical
596 call load_mosaic_parameters
605 aero_state, gas_data, gas_state)
615 aero_state, gas_data, gas_state, i_wavelength)
617 #ifdef PMC_USE_MOSAIC
618 use module_data_mosaic_main,
only: rh, pr_atm, te
619 use module_data_mosaic_aero,
only: ri_shell_a, ri_core_a, &
620 ext_cross, scat_cross, asym_particle, dp_core_a, &
621 p_atm, rh_pc, ah2o, t_k
635 integer,
intent(in) :: i_wavelength
637 #ifdef PMC_USE_MOSAIC
640 #ifdef PMC_USE_MOSAIC_MULTI_OPT
641 subroutine aerosol_optical(i_wavelength)
642 integer,
optional :: i_wavelength
643 end subroutine aerosol_optical
645 subroutine aerosol_optical()
646 end subroutine aerosol_optical
648 subroutine load_mosaic_parameters()
649 end subroutine load_mosaic_parameters
654 call load_mosaic_parameters
664 #ifdef PMC_USE_MOSAIC_MULTI_OPT
665 call aerosol_optical(i_wavelength)
668 aero_state, gas_data, gas_state)
680 #ifdef PMC_USE_MOSAIC
681 #ifdef PMC_USE_MOSAIC_MULTI_OPT
682 use module_data_mosaic_aero,
only: wavelength
688 if(
allocated(aero_data%wavelengths))
deallocate(aero_data%wavelengths)
689 allocate(aero_data%wavelengths(
n_swbands))
690 aero_data%wavelengths = 0.0d0
691 #ifdef PMC_USE_MOSAIC_MULTI_OPT
693 aero_data%wavelengths(i) = wavelength(i) * 1d-9
696 aero_data%wavelengths = 550.0d0 * 1d-9