79 real(kind=
dp),
allocatable :: n_part_ideal(:, :)
84 type(aero_rep_update_data_single_particle_number_t) :: update_number
105 subroutine spec_file_read_aero_state_weighting_type(file, weighting_type, &
111 integer,
intent(out) :: weighting_type
114 real(kind=
dp),
intent(out) :: exponent
116 character(len=SPEC_LINE_MAX_VAR_LEN) :: weighting_name
139 if (trim(weighting_name) ==
'flat')
then
141 elseif (trim(weighting_name) ==
'power')
then
144 elseif (trim(weighting_name) ==
'nummass')
then
146 elseif (trim(weighting_name) ==
'flat_source')
then
148 elseif (trim(weighting_name) ==
'power_source')
then
151 elseif (trim(weighting_name) ==
'nummass_source')
then
153 elseif (trim(weighting_name) ==
'flat_specified')
then
155 elseif (trim(weighting_name) ==
'power_specified')
then
158 elseif (trim(weighting_name) ==
'nummass_specified')
then
162 "Unknown weighting type: " // trim(weighting_name))
165 end subroutine spec_file_read_aero_state_weighting_type
177 aero_state_to%awa = aero_state_from%awa
192 integer,
intent(in) :: weight_type
195 real(kind=
dp),
intent(in),
optional :: exponent
197 aero_state%valid_sort = .false.
198 select case(weight_type)
203 call assert_msg(656670336,
present(exponent), &
204 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
212 call assert_msg(102143848,
present(exponent), &
213 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
223 call assert_msg(430273501,
present(exponent), &
224 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
231 call die_msg(969076992,
"unknown weight_type: " &
246 real(kind=
dp),
intent(in) :: n_part
248 integer :: n_group, n_class
252 if (
allocated(aero_state%n_part_ideal))
then
253 deallocate(aero_state%n_part_ideal)
255 allocate(aero_state%n_part_ideal(n_group, n_class))
256 aero_state%n_part_ideal = n_part / real(n_group * n_class, kind=
dp)
268 integer,
intent(in) :: source
272 call assert(932390238, source >= 1)
275 if (n_class > 1)
then
276 call assert(765048788, source <= n_class)
292 integer,
optional,
intent(in) :: i_group
294 integer,
optional,
intent(in) :: i_class
298 if (
present(i_group))
then
299 call assert(908743823,
present(i_class))
300 if (aero_state%valid_sort)
then
303 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
308 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
310 (aero_state%apa%particle(i_part)%weight_class == i_class)) &
331 integer,
optional,
intent(in) :: i_group
333 integer,
optional,
intent(in) :: i_class
337 aero_state, i_group, i_class)
357 aero_state%valid_sort = .false.
375 logical,
optional,
intent(in) :: allow_resort
377 if (aero_state%valid_sort)
then
379 aero_particle, aero_data, allow_resort)
394 integer,
intent(in) :: i_part
396 if (aero_state%valid_sort)
then
398 aero_state%apa, i_part)
414 integer,
intent(in) :: i_part
428 record_removal, aero_info)
433 integer,
intent(in) :: i_part
435 logical,
intent(in) :: record_removal
439 if (record_removal)
then
453 i_bin, i_class, aero_particle)
458 integer,
intent(in) :: i_bin
460 integer,
intent(in) :: i_class
464 integer :: i_entry, i_part
466 call assert(742996300, aero_state%valid_sort)
468 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) > 0)
470 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)))
471 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
472 i_class)%entry(i_entry)
473 aero_particle = aero_state%apa%particle(i_part)
489 n_part_mean, random_weight_group)
496 integer,
intent(in) :: i_part
498 real(kind=
dp),
intent(in) :: n_part_mean
501 logical,
optional,
intent(in) :: random_weight_group
503 integer :: n_copies, i_dup, new_group
506 logical :: record_removal
509 if (n_copies == 0)
then
510 aero_info%id = aero_state%apa%particle(i_part)%id
512 aero_info%other_id = 0
514 record_removal = .false.
516 record_removal = .true.
519 record_removal, aero_info)
520 elseif (n_copies > 1)
then
521 do i_dup = 1,(n_copies - 1)
522 new_aero_particle = aero_state%apa%particle(i_part)
524 if (
present(random_weight_group))
then
525 if (random_weight_group)
then
528 aero_state%apa%particle(i_part)%weight_class, &
545 aero_particle, aero_data)
572 real(kind=
dp),
intent(out) &
578 reweight_num_conc(i_part) &
580 aero_state%apa%particle(i_part), aero_data)
605 real(kind=
dp),
intent(in) &
608 integer :: i_part, i_group, i_class
609 real(kind=
dp) :: n_part_old(
size(aero_state%awa%weight, 1), &
610 size(aero_state%awa%weight, 2))
611 real(kind=
dp) :: n_part_new(
size(aero_state%awa%weight, 1), &
612 size(aero_state%awa%weight, 2))
613 real(kind=
dp) :: old_num_conc, new_num_conc, n_part_mean
620 old_num_conc = reweight_num_conc(i_part)
622 aero_state%apa%particle(i_part), aero_data)
623 n_part_mean = old_num_conc / new_num_conc
624 i_group = aero_state%apa%particle(i_part)%weight_group
625 i_class = aero_state%apa%particle(i_part)%weight_class
626 n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
628 n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
633 do i_group = 1,
size(aero_state%awa%weight, 1)
634 do i_class = 1,
size(aero_state%awa%weight, 2)
635 if (n_part_old(i_group, i_class) == 0d0) cycle
637 n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
644 old_num_conc = reweight_num_conc(i_part)
647 aero_state%apa%particle(i_part), aero_data)
648 n_part_mean = old_num_conc / new_num_conc
688 integer :: i_part, i_bin
690 do i_part = 1,aero_state_delta%apa%n_part
692 aero_state_delta%apa%particle(i_part), aero_data)
695 aero_state_delta%aero_info_array)
705 i_group, i_class, n_add, allow_doubling, allow_halving)
712 integer,
intent(in) :: i_group
714 integer,
intent(in) :: i_class
716 real(kind=
dp),
intent(in) :: n_add
718 logical,
intent(in) :: allow_doubling
720 logical,
intent(in) :: allow_halving
722 integer :: global_n_part, n_group, n_class
723 real(kind=
dp) :: mean_n_part, n_part_new, weight_ratio
724 real(kind=
dp) :: n_part_ideal_local_group
730 mean_n_part = real(global_n_part, kind=
dp)
736 n_part_new = mean_n_part + n_add
737 if (n_part_new == 0d0)
return
739 n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class)
741 n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
744 if ((n_part_new < n_part_ideal_local_group / 2d0) &
745 .or. (n_part_new > n_part_ideal_local_group * 2d0)) &
747 weight_ratio = n_part_new / n_part_ideal_local_group
749 i_class, weight_ratio, allow_doubling, allow_halving)
759 aero_dist, sample_prop, characteristic_factor, create_time, &
760 allow_doubling, allow_halving, n_part_add)
769 real(kind=
dp),
intent(in) :: sample_prop
771 real(kind=
dp),
intent(in) :: characteristic_factor
773 real(kind=
dp),
intent(in) :: create_time
775 logical,
intent(in) :: allow_doubling
777 logical,
intent(in) :: allow_halving
779 integer,
intent(out),
optional :: n_part_add
781 real(kind=
dp) :: n_samp_avg, radius, total_vol
783 real(kind=
dp) :: size_factor
784 integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
787 n_group =
size(aero_state%awa%weight, 1)
788 n_class =
size(aero_state%awa%weight, 2)
789 if (
present(n_part_add))
then
792 do i_group = 1,n_group
795 aero_mode_get_weight_class(aero_dist%mode(i_mode)))
797 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
798 aero_state%awa%weight(i_group, i_class))
800 i_group, i_class, n_samp_avg, allow_doubling, allow_halving)
801 if (n_samp_avg == 0d0) cycle
804 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
805 aero_state%awa%weight(i_group, i_class))
807 size_factor = min((1.0d0 / (characteristic_factor * n_samp_avg)), &
810 if (
present(n_part_add))
then
811 n_part_add = n_part_add + n_samp
815 call aero_mode_sample_radius(aero_dist%mode(i_mode), aero_data, &
816 aero_state%awa%weight(i_group, i_class), radius, size_factor)
818 call aero_mode_sample_vols(aero_dist%mode(i_mode), total_vol, &
824 aero_dist%mode(i_mode)%source, create_time)
825 aero_particle%n_primary_parts = 1
841 integer,
intent(out) :: i_part
857 aero_data, sample_prob, removal_action)
866 real(kind=
dp),
intent(in) :: sample_prob
869 integer,
intent(in) :: removal_action
871 integer :: n_transfer, i_transfer, i_part
872 integer :: i_group, i_class
873 logical :: do_add, do_remove
874 real(kind=
dp) :: num_conc_from, num_conc_to
876 integer :: n_parts_before
878 call assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
883 do while (i_transfer < n_transfer)
887 aero_state_from%apa%particle(i_part), aero_data)
889 aero_state_from%apa%particle(i_part), aero_data)
890 if (num_conc_to == num_conc_from)
then
893 elseif (num_conc_to < num_conc_from)
then
896 if (
pmc_random() < num_conc_to / num_conc_from)
then
901 if (
pmc_random() < num_conc_from / num_conc_to)
then
908 aero_state_from%apa%particle(i_part), aero_data)
910 if (.not. do_remove)
then
912 particle(aero_state_to%apa%n_part))
917 aero_info%id = aero_state_from%apa%particle(i_part)%id
918 aero_info%action = removal_action
925 i_transfer = i_transfer + 1
937 aero_data, sample_prob, removal_action)
946 real(kind=
dp),
intent(in) :: sample_prob
949 integer,
intent(in) :: removal_action
951 integer :: n_transfer, i_transfer, i_part
952 logical :: do_add, do_remove, overwrite_to
953 real(kind=
dp) :: num_conc_from, num_conc_to
956 call assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
962 do i_transfer = 1,n_transfer
967 aero_state_from%apa%particle(i_part), aero_data)
969 aero_info%id = aero_state_from%apa%particle(i_part)%id
970 aero_info%action = removal_action
978 overwrite_to = .true.
980 sample_prob, overwrite_to)
999 integer :: i_part, i_bin
1000 real(kind=
dp) :: factor
1002 aero_binned%num_conc = 0d0
1003 aero_binned%vol_conc = 0d0
1007 if ((i_bin < 1) .or. (i_bin >
bin_grid_size(bin_grid)))
then
1008 call warn_msg(980232449,
"particle ID " // trim( &
1010 //
" outside of bin_grid, discarding")
1013 aero_state%apa%particle(i_part), aero_data) &
1014 / bin_grid%widths(i_bin)
1015 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1016 + aero_state%apa%particle(i_part)%vol * factor
1017 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1053 character(len=*),
optional,
intent(in) :: include(:)
1055 character(len=*),
optional,
intent(in) :: exclude(:)
1096 type(env_state_t),
intent(in) :: env_state
1107 aero_state%apa%particle(i_part), aero_data, env_state)
1126 type(
aero_data_t),
optional,
intent(in) :: aero_data
1128 character(len=*),
optional,
intent(in) :: include(:)
1130 character(len=*),
optional,
intent(in) :: exclude(:)
1135 logical,
allocatable :: use_species(:)
1136 integer :: i_name, i_spec
1138 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then
1142 call assert_msg(599558703,
present(aero_data), &
1143 "must provide 'aero_data' if using 'include' or 'exclude'")
1145 if (
present(include))
then
1146 use_species = .false.
1147 do i_name = 1,
size(include)
1150 "unknown species: " // trim(include(i_name)))
1151 use_species(i_spec) = .true.
1154 use_species = .true.
1156 if (
present(exclude))
then
1157 do i_name = 1,
size(exclude)
1160 "unknown species: " // trim(exclude(i_name)))
1161 use_species(i_spec) = .false.
1166 if (use_species(i_spec))
then
1193 character(len=*),
optional,
intent(in) :: include(:)
1195 character(len=*),
optional,
intent(in) :: exclude(:)
1201 integer :: i_name, i_spec
1203 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then
1208 if (
present(include))
then
1209 use_species = .false.
1210 do i_name = 1,
size(include)
1213 "unknown species: " // trim(include(i_name)))
1214 use_species(i_spec) = .true.
1217 use_species = .true.
1219 if (
present(exclude))
then
1220 do i_name = 1,
size(exclude)
1223 "unknown species: " // trim(exclude(i_name)))
1224 use_species(i_spec) = .false.
1229 if (use_species(i_spec))
then
1258 aero_state%apa%particle(i_part), aero_data)
1279 aero_state%apa%particle(i_part), aero_data)
1297 if (aero_data%i_water > 0)
then
1299 if (aero_state%apa%particle(i_part)%vol(aero_data%i_water) > 0d0) &
1303 aero_state%apa%particle(i_part), aero_data)
1329 integer :: i_part, i_source, i_comp
1330 real(kind=
dp) :: source_weighted_conc
1336 aero_state%apa%particle(i_part))
1337 i_source = aero_state%apa%particle(i_part)%component(i_comp)% &
1341 * (aero_state%apa%particle(i_part)%n_primary_parts &
1352 aero_data, i_group, i_class)
1363 integer :: i_part, i_entry, n_entry
1367 aero_state%aero_sorted%group_class%inverse(i_group,i_class))
1368 do i_entry = 1,n_entry
1369 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1370 i_class)%entry(i_entry)
1373 aero_state%apa%particle(i_part), aero_data)
1399 character(len=*),
optional :: include(:)
1401 character(len=*),
optional :: exclude(:)
1403 character(len=*),
optional :: group(:)
1405 character(len=*),
optional :: groups(:,:)
1412 integer :: i_name, i_spec, i_part, i_group, n_group
1414 real(kind=
dp) :: group_mass, non_group_mass, mass
1415 real(kind=
dp),
allocatable :: group_masses(:)
1417 if (
present(include))
then
1418 use_species = .false.
1419 do i_name = 1,
size(include)
1422 "unknown species: " // trim(include(i_name)))
1423 use_species(i_spec) = .true.
1426 use_species = .true.
1428 if (
present(exclude))
then
1429 do i_name = 1,
size(exclude)
1432 "unknown species: " // trim(exclude(i_name)))
1433 use_species(i_spec) = .false.
1436 if (
present(group))
then
1437 group_species = .false.
1438 do i_name = 1,
size(group)
1441 "unknown species: " // trim(group(i_name)))
1442 group_species(i_spec) = .true.
1446 non_group_mass = 0d0
1448 if (use_species(i_spec))
then
1450 aero_state%apa%particle(i_part), i_spec, aero_data)
1451 if (group_species(i_spec))
then
1452 group_mass = group_mass + mass
1454 non_group_mass = non_group_mass + mass
1459 =
entropy([group_mass, non_group_mass])
1461 else if (
present(groups))
then
1462 call assert_msg(161633285, .not.
present(include), &
1463 "cannot specify both 'include' and 'groups' arguments")
1464 call assert_msg(273540426, .not.
present(exclude), &
1465 "cannot specify both 'exclude' and 'groups' arguments")
1466 call assert_msg(499993914, .not.
present(group), &
1467 "cannot specify both 'group' and 'groups' arguments")
1469 n_group =
size(groups, 1)
1472 species_group_numbers = 0
1473 do i_group = 1, n_group
1474 do i_name = 1,
size(groups, 2)
1475 if (len_trim(groups(i_group, i_name)) > 0)
then
1477 groups(i_group, i_name))
1479 "unknown species: " // trim(groups(i_group, i_name)))
1480 if (use_species(i_spec))
then
1481 species_group_numbers(i_spec) = i_group
1487 allocate(group_masses(n_group))
1492 aero_state%apa%particle(i_part), i_spec, aero_data)
1493 i_group = species_group_numbers(i_spec)
1494 if (i_group > 0)
then
1495 group_masses(i_group) = group_masses(i_group) + mass
1504 aero_data), use_species))
1526 d_gamma, chi, include, exclude, group, groups)
1533 real(kind=
dp),
intent(out) :: d_alpha
1535 real(kind=
dp),
intent(out) :: d_gamma
1537 real(kind=
dp),
intent(out) :: chi
1539 character(len=*),
optional :: include(:)
1541 character(len=*),
optional :: exclude(:)
1543 character(len=*),
optional :: group(:)
1545 character(len=*),
optional :: groups(:,:)
1547 real(kind=
dp),
allocatable :: entropies(:), entropies_of_avg_part(:)
1548 real(kind=
dp),
allocatable :: masses(:), num_concs(:), &
1549 num_concs_of_avg_part(:), masses_of_avg_part(:)
1555 if (
present(groups))
then
1556 call assert_msg(726652236, .not.
present(include), &
1557 "cannot specify both 'include' and 'groups' arguments")
1558 call assert_msg(891097454, .not.
present(exclude), &
1559 "cannot specify both 'exclude' and 'groups' arguments")
1560 call assert_msg(938789093, .not.
present(group), &
1561 "cannot specify both 'group' and 'groups' arguments")
1563 include=pack(groups, len_trim(groups) > 0))
1571 include, exclude, group, groups)
1573 d_alpha = exp(sum(entropies * masses * num_concs) &
1574 / sum(masses * num_concs))
1578 aero_state_averaged = aero_state
1583 if (
present(groups))
then
1585 include=pack(groups, len_trim(groups) > 0))
1591 aero_data, include, exclude, group, groups)
1593 d_gamma = exp(sum(entropies_of_avg_part * masses_of_avg_part &
1594 * num_concs_of_avg_part) &
1595 / sum(masses_of_avg_part * num_concs_of_avg_part))
1597 chi = (d_alpha - 1) / (d_gamma - 1)
1611 type(env_state_t),
intent(in) :: env_state
1622 aero_state%apa%particle(i_part), aero_data, env_state)
1637 type(env_state_t),
intent(in) :: env_state
1646 aero_state%apa%particle(i_part), aero_data, env_state)
1666 integer :: i_part, i_bin
1667 real(kind=
dp) :: factor
1669 aero_binned%num_conc = 0d0
1670 aero_binned%vol_conc = 0d0
1675 if ((i_bin < 1) .or. (i_bin >
bin_grid_size(bin_grid)))
then
1676 call warn_msg(503871022,
"particle ID " // trim( &
1678 //
" outside of bin_grid, discarding")
1681 aero_state%apa%particle(i_part), aero_data) &
1682 / bin_grid%widths(i_bin)
1683 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1684 + aero_state%apa%particle(i_part)%vol * factor
1685 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1702 integer,
intent(in) :: i_group
1704 integer,
intent(in) :: i_class
1710 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1711 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1713 aero_particle = aero_state%apa%particle(i_part)
1718 aero_state%valid_sort = .false.
1731 integer,
intent(in) :: i_group
1733 integer,
intent(in) :: i_class
1737 logical :: record_removal
1740 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1741 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1744 aero_info%id = aero_state%apa%particle(i_part)%id
1747 record_removal = .false.
1749 record_removal = .true.
1752 record_removal, aero_info)
1766 allow_halving, initial_state_warning)
1773 logical,
intent(in) :: allow_doubling
1775 logical,
intent(in) :: allow_halving
1777 logical,
intent(in) :: initial_state_warning
1779 integer :: i_group, i_class, n_group, n_class, global_n_part
1781 n_group =
size(aero_state%awa%weight, 1)
1782 n_class =
size(aero_state%awa%weight, 2)
1786 if (allow_doubling)
then
1787 do i_group = 1,n_group
1788 do i_class = 1,n_class
1792 do while ((real(global_n_part, kind=
dp) &
1793 < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1794 .and. (global_n_part > 0))
1795 if (initial_state_warning)
then
1796 call warn_msg(716882783,
"doubling particles in initial " &
1809 if (allow_halving)
then
1810 do i_group = 1,n_group
1811 do i_class = 1,n_class
1813 i_group, i_class), kind=
dp) &
1814 > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1815 if (initial_state_warning)
then
1817 "halving particles in initial condition")
1833 i_class, weight_ratio, allow_doubling, allow_halving)
1840 integer,
intent(in) :: i_group
1842 integer,
intent(in) :: i_class
1844 real(kind=
dp),
intent(in) :: weight_ratio
1846 logical,
intent(in) :: allow_doubling
1848 logical,
intent(in) :: allow_halving
1850 real(kind=
dp) :: ratio
1851 integer :: i_part, i_remove, n_remove, i_entry, n_part
1853 logical :: record_removal
1861 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
1863 if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0)))
then
1867 * (1d0 - 1d0 / weight_ratio))
1868 do i_remove = 1,n_remove
1870 aero_state%aero_sorted%group_class%inverse(i_group, i_class)))
1871 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1872 i_class)%entry(i_entry)
1873 aero_info%id = aero_state%apa%particle(i_part)%id
1876 record_removal = .false.
1878 record_removal = .true.
1881 record_removal, aero_info)
1883 elseif ((weight_ratio < 1d0) &
1884 .and. (allow_doubling .or. (n_part == 0)))
then
1887 do i_entry = n_part,1,-1
1888 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1889 i_class)%entry(i_entry)
1902 aero_data, specify_prob_transfer)
1907 real(kind=
dp),
intent(in) :: del_t
1909 real(kind=
dp),
intent(in) :: mix_timescale
1914 real(kind=
dp),
optional,
intent(in) :: specify_prob_transfer
1917 integer :: rank, n_proc, i_proc, ierr
1918 integer :: buffer_size, buffer_size_check
1919 character,
allocatable :: buffer(:)
1922 real(kind=
dp) :: prob_transfer, prob_not_transferred
1923 real(kind=
dp) :: prob_transfer_given_not_transferred
1928 if (n_proc == 1)
then
1935 allocate(aero_state_sends(n_proc))
1936 allocate(aero_state_recvs(n_proc))
1939 if (
present(specify_prob_transfer))
then
1940 prob_transfer = specify_prob_transfer / real(n_proc, kind=
dp)
1942 prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1943 / real(n_proc, kind=
dp)
1947 prob_not_transferred = 1d0
1948 do i_proc = 0,(n_proc - 1)
1949 if (i_proc /= rank)
then
1954 prob_transfer_given_not_transferred = prob_transfer &
1955 / prob_not_transferred
1957 aero_state_sends(i_proc + 1), aero_data, &
1959 prob_not_transferred = prob_not_transferred - prob_transfer
1967 do i_proc = 0,(n_proc - 1)
1968 if (i_proc /= rank)
then
1975 deallocate(aero_state_sends)
1976 deallocate(aero_state_recvs)
1994 character,
allocatable :: sendbuf(:), recvbuf(:)
1995 integer :: sendcounts(size(send)), sdispls(size(send))
1996 integer :: recvcounts(size(send)), rdispls(size(send))
1997 integer :: i_proc, position, old_position, max_sendbuf_size, ierr
2001 max_sendbuf_size = 0
2004 max_sendbuf_size = max_sendbuf_size &
2009 allocate(sendbuf(max_sendbuf_size))
2013 old_position = position
2017 sendcounts(i_proc) = position - old_position
2019 call assert(393267406, position <= max_sendbuf_size)
2022 allocate(recvbuf(sum(recvcounts)))
2027 sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
2028 rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
2031 call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
2032 recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
2037 call assert(189739257, position == rdispls(i_proc))
2038 if (recvcounts(i_proc) > 0)
then
2065 real(kind=
dp) :: total_volume_conc, particle_volume, num_conc
2066 integer :: i_bin, i_class, i_entry, i_part, i_spec
2071 species_volume_conc = 0d0
2072 total_volume_conc = 0d0
2073 do i_class = 1,
size(aero_state%awa%weight, 2)
2075 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
2076 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2077 i_class)%entry(i_entry)
2079 aero_state%apa%particle(i_part), aero_data)
2081 aero_state%apa%particle(i_part))
2082 species_volume_conc = species_volume_conc &
2083 + num_conc * aero_state%apa%particle(i_part)%vol
2084 total_volume_conc = total_volume_conc + num_conc * particle_volume
2087 do i_class = 1,
size(aero_state%awa%weight, 2)
2089 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
2090 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2091 i_class)%entry(i_entry)
2093 aero_state%apa%particle(i_part))
2094 aero_state%apa%particle(i_part)%vol &
2095 = particle_volume * species_volume_conc / total_volume_conc
2119 bin_center, preserve_number)
2129 logical,
intent(in) :: bin_center
2133 logical,
intent(in) :: preserve_number
2135 real(kind=
dp) :: total_volume_conc, particle_volume
2136 real(kind=
dp) :: new_particle_volume, num_conc, total_num_conc
2137 real(kind=
dp) :: lower_volume, upper_volume, center_volume
2138 real(kind=
dp) :: lower_function, upper_function, center_function
2139 integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
2140 logical :: monotone_increasing, monotone_decreasing
2145 do i_class = 1,
size(aero_state%awa%weight, 2)
2147 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) &
2153 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
2154 total_num_conc = 0d0
2155 total_volume_conc = 0d0
2157 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
2158 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2159 i_class)%entry(i_entry)
2161 aero_state%apa%particle(i_part), aero_data)
2162 total_num_conc = total_num_conc + num_conc
2164 aero_state%apa%particle(i_part))
2165 total_volume_conc = total_volume_conc &
2166 + num_conc * particle_volume
2170 if (bin_center)
then
2172 bin_grid%centers(i_bin))
2177 new_particle_volume = total_volume_conc / num_conc &
2179 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)), &
2181 elseif (preserve_number)
then
2192 monotone_increasing, monotone_decreasing)
2194 monotone_increasing .or. monotone_decreasing, &
2195 "monotone weight function required for averaging")
2198 do i_entry = 1,n_part
2199 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2200 i_class)%entry(i_entry)
2202 aero_state%apa%particle(i_part))
2203 if (i_part == 1)
then
2204 lower_volume = particle_volume
2205 upper_volume = particle_volume
2207 lower_volume = min(lower_volume, particle_volume)
2208 upper_volume = max(upper_volume, particle_volume)
2211 lower_function = real(n_part, kind=
dp) &
2215 upper_function = real(n_part, kind=
dp) &
2222 center_volume = (lower_volume + upper_volume) / 2d0
2223 center_function = real(n_part, kind=
dp) &
2227 if ((lower_function > 0d0 .and. center_function > 0d0) &
2228 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2230 lower_volume = center_volume
2231 lower_function = center_function
2233 upper_volume = center_volume
2234 upper_function = center_function
2238 new_particle_volume = center_volume
2250 monotone_increasing, monotone_decreasing)
2252 monotone_increasing .or. monotone_decreasing, &
2253 "monotone weight function required for averaging")
2256 do i_entry = 1,n_part
2257 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2258 i_class)%entry(i_entry)
2260 aero_state%apa%particle(i_part))
2261 if (i_part == 1)
then
2262 lower_volume = particle_volume
2263 upper_volume = particle_volume
2265 lower_volume = min(lower_volume, particle_volume)
2266 upper_volume = max(upper_volume, particle_volume)
2269 lower_function = real(n_part, kind=
dp) &
2272 lower_volume)) * lower_volume - total_volume_conc
2273 upper_function = real(n_part, kind=
dp) &
2276 upper_volume)) * upper_volume - total_volume_conc
2280 center_volume = (lower_volume + upper_volume) / 2d0
2281 center_function = real(n_part, kind=
dp) &
2284 center_volume)) * center_volume - total_volume_conc
2285 if ((lower_function > 0d0 .and. center_function > 0d0) &
2286 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2288 lower_volume = center_volume
2289 lower_function = center_function
2291 upper_volume = center_volume
2292 upper_function = center_function
2296 new_particle_volume = center_volume
2299 do i_entry = 1,n_part
2300 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2301 i_class)%entry(i_entry)
2303 aero_state%apa%particle(i_part))
2304 aero_state%apa%particle(i_part)%vol &
2305 = aero_state%apa%particle(i_part)%vol &
2306 / particle_volume * new_particle_volume
2324 real(kind=
dp) :: reweight_num_conc(aero_state%apa%n_part)
2327 aero_state%valid_sort = .false.
2331 if (aero_data%i_water > 0)
then
2333 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
2335 aero_state%valid_sort = .false.
2350 integer :: total_size, i_group
2367 character,
intent(inout) :: buffer(:)
2369 integer,
intent(inout) :: position
2374 integer :: prev_position, i_group
2376 prev_position = position
2393 character,
intent(inout) :: buffer(:)
2395 integer,
intent(inout) :: position
2400 integer :: prev_position, i_group, n_group
2402 val%valid_sort = .false.
2403 prev_position = position
2428 integer :: n_proc, ierr, status(MPI_STATUS_SIZE)
2429 integer :: buffer_size, max_buffer_size, i_proc, position
2430 character,
allocatable :: buffer(:)
2434 aero_state_total = aero_state
2442 max_buffer_size = max_buffer_size &
2444 allocate(buffer(max_buffer_size))
2447 call assert(542772170, position <= max_buffer_size)
2448 buffer_size = position
2449 call mpi_send(buffer, buffer_size, mpi_character, 0, &
2456 do i_proc = 1,(n_proc - 1)
2461 call mpi_get_count(status, mpi_character, buffer_size, ierr)
2465 allocate(buffer(buffer_size))
2466 call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2473 aero_state_transfer)
2474 call assert(518174881, position == buffer_size)
2492 dimid_aero_particle)
2497 integer,
intent(in) :: ncid
2499 integer,
intent(out) :: dimid_aero_particle
2501 integer :: status, i_part
2502 integer :: varid_aero_particle
2503 integer :: aero_particle_centers(aero_state_n_part(aero_state))
2506 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2507 if (status == nf90_noerr)
return
2508 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2511 call pmc_nc_check(nf90_redef(ncid))
2513 call pmc_nc_check(nf90_def_dim(ncid,
"aero_particle", &
2514 aero_state_n_part(aero_state), dimid_aero_particle))
2516 call pmc_nc_check(nf90_enddef(ncid))
2518 do i_part = 1,aero_state_n_part(aero_state)
2519 aero_particle_centers(i_part) = i_part
2521 call pmc_nc_write_integer_1d(ncid, aero_particle_centers, &
2522 "aero_particle", (/ dimid_aero_particle /), &
2523 description=
"dummy dimension variable (no useful value)")
2538 integer,
intent(in) :: ncid
2540 integer,
intent(out) :: dimid_aero_removed
2542 integer :: status, i_remove, dim_size
2543 integer :: varid_aero_removed
2544 integer :: aero_removed_centers( &
2545 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2548 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2549 if (status == nf90_noerr)
return
2550 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2553 call pmc_nc_check(nf90_redef(ncid))
2555 dim_size = max(1, aero_info_array_n_item(aero_state%aero_info_array))
2556 call pmc_nc_check(nf90_def_dim(ncid,
"aero_removed", &
2557 dim_size, dimid_aero_removed))
2559 call pmc_nc_check(nf90_enddef(ncid))
2561 do i_remove = 1,dim_size
2562 aero_removed_centers(i_remove) = i_remove
2564 call pmc_nc_write_integer_1d(ncid, aero_removed_centers, &
2565 "aero_removed", (/ dimid_aero_removed /), &
2566 description=
"dummy dimension variable (no useful value)")
2576 dimid_aero_components)
2581 integer,
intent(in) :: ncid
2583 integer,
intent(out) :: dimid_aero_components
2585 integer :: status, dim_size
2588 status = nf90_inq_dimid(ncid,
"aero_components", dimid_aero_components)
2589 if (status == nf90_noerr)
return
2590 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2593 call pmc_nc_check(nf90_redef(ncid))
2596 call pmc_nc_check(nf90_def_dim(ncid,
"aero_components", &
2597 dim_size, dimid_aero_components))
2599 call pmc_nc_check(nf90_enddef(ncid))
2606 subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2607 record_removals, record_optical)
2612 integer,
intent(in) :: ncid
2616 logical,
intent(in) :: record_removals
2618 logical,
intent(in) :: record_optical
2620 integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2621 integer :: dimid_aero_removed
2622 integer :: dimid_aero_components
2623 integer :: dimid_optical_wavelengths
2624 integer :: i_part, i_remove
2627 integer :: aero_particle_weight_group(aero_state_n_part(aero_state))
2628 integer :: aero_particle_weight_class(aero_state_n_part(aero_state))
2629 real(kind=
dp) :: aero_absorb_cross_sect(aero_state_n_part(aero_state), &
2631 real(kind=
dp) :: aero_scatter_cross_sect(aero_state_n_part(aero_state), &
2633 real(kind=
dp) :: aero_asymmetry(aero_state_n_part(aero_state),
n_swbands)
2634 real(kind=
dp) :: aero_refract_shell_real(aero_state_n_part(aero_state), &
2636 real(kind=
dp) :: aero_refract_shell_imag(aero_state_n_part(aero_state), &
2638 real(kind=
dp) :: aero_refract_core_real(aero_state_n_part(aero_state), &
2640 real(kind=
dp) :: aero_refract_core_imag(aero_state_n_part(aero_state), &
2642 real(kind=
dp) :: aero_core_vol(aero_state_n_part(aero_state))
2643 integer :: aero_water_hyst_leg(aero_state_n_part(aero_state))
2644 real(kind=
dp) :: aero_num_conc(aero_state_n_part(aero_state))
2645 integer(kind=8) :: aero_id(aero_state_n_part(aero_state))
2646 real(kind=
dp) :: aero_least_create_time(aero_state_n_part(aero_state))
2647 real(kind=
dp) :: aero_greatest_create_time(aero_state_n_part(aero_state))
2648 integer(kind=8) :: aero_removed_id( &
2649 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2650 integer :: aero_removed_action( &
2651 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2652 integer(kind=8) :: aero_removed_other_id( &
2653 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2654 integer :: aero_component_particle_num(aero_state_total_n_components( &
2656 integer :: aero_component_source_num(aero_state_total_n_components( &
2658 real(kind=
dp) :: aero_component_create_time( &
2659 aero_state_total_n_components(aero_state))
2660 integer :: aero_component_len(aero_state_n_part(aero_state))
2661 integer :: aero_component_start_ind(aero_state_n_part(aero_state))
2662 integer :: aero_particle_n_primary_parts(aero_state_n_part(aero_state))
2663 integer :: array_position, i_comp, next_start_component_ind
2760 call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2767 if (record_optical)
then
2769 dimid_optical_wavelengths)
2772 if (aero_state_n_part(aero_state) > 0)
then
2774 dimid_aero_particle)
2776 dimid_aero_components)
2777 next_start_component_ind = 1
2778 do i_part = 1,aero_state_n_part(aero_state)
2780 = aero_state%apa%particle(i_part)%vol * aero_data%density
2782 aero_state%apa%particle(i_part))
2783 aero_component_start_ind(i_part) = next_start_component_ind
2784 next_start_component_ind = next_start_component_ind &
2785 + aero_component_len(i_part)
2786 do i_comp = 1,aero_component_len(i_part)
2787 array_position = aero_component_start_ind(i_part) + i_comp - 1
2788 aero_component_particle_num(array_position) = i_part
2789 aero_component_source_num(array_position) &
2790 = aero_state%apa%particle(i_part)%component(i_comp)%source_id
2791 aero_component_create_time(array_position) &
2792 = aero_state%apa%particle(i_part)%component( &
2795 aero_particle_weight_group(i_part) &
2796 = aero_state%apa%particle(i_part)%weight_group
2797 aero_particle_weight_class(i_part) &
2798 = aero_state%apa%particle(i_part)%weight_class
2799 aero_water_hyst_leg(i_part) &
2800 = aero_state%apa%particle(i_part)%water_hyst_leg
2801 aero_num_conc(i_part) &
2803 aero_state%apa%particle(i_part), aero_data)
2804 aero_id(i_part) = aero_state%apa%particle(i_part)%id
2805 aero_least_create_time(i_part) &
2806 = aero_state%apa%particle(i_part)%least_create_time
2807 aero_greatest_create_time(i_part) &
2808 = aero_state%apa%particle(i_part)%greatest_create_time
2809 aero_particle_n_primary_parts(i_part) &
2810 = aero_state%apa%particle(i_part)%n_primary_parts
2811 if (record_optical)
then
2812 aero_absorb_cross_sect(i_part,:) &
2813 = aero_state%apa%particle(i_part)%absorb_cross_sect
2814 aero_scatter_cross_sect(i_part,:) &
2815 = aero_state%apa%particle(i_part)%scatter_cross_sect
2816 aero_asymmetry(i_part,:) &
2817 = aero_state%apa%particle(i_part)%asymmetry
2818 aero_refract_shell_real(i_part,:) &
2819 = real(aero_state%apa%particle(i_part)%refract_shell)
2820 aero_refract_shell_imag(i_part,:) &
2821 = aimag(aero_state%apa%particle(i_part)%refract_shell)
2822 aero_refract_core_real(i_part,:) &
2823 = real(aero_state%apa%particle(i_part)%refract_core)
2824 aero_refract_core_imag(i_part,:) &
2825 = aimag(aero_state%apa%particle(i_part)%refract_core)
2826 aero_core_vol(i_part) = aero_state%apa%particle(i_part)%core_vol
2830 "aero_particle_mass", (/ dimid_aero_particle, &
2831 dimid_aero_species /), unit=
"kg", &
2832 long_name=
"constituent masses of each aerosol particle")
2834 call pmc_nc_write_integer_1d(ncid, aero_component_len, &
2835 "aero_component_len", (/ dimid_aero_particle /), &
2836 long_name=
"number of aero_components for each aerosol particle")
2837 call pmc_nc_write_integer_1d(ncid, aero_component_start_ind, &
2838 "aero_component_start_ind", (/ dimid_aero_particle /), &
2839 long_name=
"start index of aero_component for each aerosol " &
2841 call pmc_nc_write_integer_1d(ncid, aero_component_particle_num, &
2842 "aero_component_particle_num", (/ dimid_aero_components /), &
2843 long_name=
"associated aerosol particle number for each component")
2844 call pmc_nc_write_integer_1d(ncid, aero_component_source_num, &
2845 "aero_component_source_num", (/ dimid_aero_components /), &
2846 long_name=
"associated source number for each component")
2847 call pmc_nc_write_real_1d(ncid, aero_component_create_time, &
2848 "aero_component_create_time", (/ dimid_aero_components /), &
2849 long_name=
"associated creation time for each component")
2850 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_group, &
2851 "aero_particle_weight_group", (/ dimid_aero_particle /), &
2852 long_name=
"weight group number of each aerosol particle")
2853 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_class, &
2854 "aero_particle_weight_class", (/ dimid_aero_particle /), &
2855 long_name=
"weight class number of each aerosol particle")
2856 call pmc_nc_write_integer_1d(ncid, aero_water_hyst_leg, &
2857 "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2858 long_name=
"leg of the water hysteresis curve leg of each "&
2859 //
"aerosol particle")
2860 call pmc_nc_write_real_1d(ncid, aero_num_conc, &
2861 "aero_num_conc", (/ dimid_aero_particle /), unit=
"m^{-3}", &
2862 long_name=
"number concentration for each particle")
2863 call pmc_nc_write_integer64_1d(ncid, aero_id, &
2864 "aero_id", (/ dimid_aero_particle /), &
2865 long_name=
"unique ID number of each aerosol particle")
2866 call pmc_nc_write_real_1d(ncid, aero_least_create_time, &
2867 "aero_least_create_time", (/ dimid_aero_particle /), unit=
"s", &
2868 long_name=
"least creation time of each aerosol particle", &
2869 description=
"least (earliest) creation time of any original " &
2870 //
"constituent particles that coagulated to form each " &
2871 //
"particle, measured from the start of the simulation")
2872 call pmc_nc_write_real_1d(ncid, aero_greatest_create_time, &
2873 "aero_greatest_create_time", (/ dimid_aero_particle /), &
2875 long_name=
"greatest creation time of each aerosol particle", &
2876 description=
"greatest (latest) creation time of any original " &
2877 //
"constituent particles that coagulated to form each " &
2878 //
"particle, measured from the start of the simulation")
2879 call pmc_nc_write_integer_1d(ncid, aero_particle_n_primary_parts, &
2880 "aero_particle_n_primary_parts", (/ dimid_aero_particle /), &
2881 unit=
"1", long_name=
"number of primary particles that contribute" &
2882 //
"to each particle.")
2883 if (record_optical)
then
2884 call pmc_nc_write_real_2d(ncid, aero_absorb_cross_sect, &
2885 "aero_absorb_cross_sect", (/ dimid_aero_particle, &
2886 dimid_optical_wavelengths /), unit=
"m^2", &
2887 long_name=
"optical absorption cross sections of each " &
2888 //
"aerosol particle")
2889 call pmc_nc_write_real_2d(ncid, aero_scatter_cross_sect, &
2890 "aero_scatter_cross_sect", (/ dimid_aero_particle, &
2891 dimid_optical_wavelengths /), unit=
"m^2", &
2892 long_name=
"optical scattering cross sections of each " &
2893 //
"aerosol particle")
2894 call pmc_nc_write_real_2d(ncid, aero_asymmetry, &
2895 "aero_asymmetry", (/ dimid_aero_particle, &
2896 dimid_optical_wavelengths /), unit=
"1", &
2897 long_name=
"optical asymmetry parameters of each " &
2898 //
"aerosol particle")
2899 call pmc_nc_write_real_2d(ncid, aero_refract_shell_real, &
2900 "aero_refract_shell_real", (/ dimid_aero_particle, &
2901 dimid_optical_wavelengths /), unit=
"1", &
2902 long_name=
"real part of the refractive indices of the " &
2903 //
"shell of each aerosol particle")
2904 call pmc_nc_write_real_2d(ncid, aero_refract_shell_imag, &
2905 "aero_refract_shell_imag", (/ dimid_aero_particle, &
2906 dimid_optical_wavelengths /), unit=
"1", &
2907 long_name=
"imaginary part of the refractive indices of " &
2908 //
"the shell of each aerosol particle")
2909 call pmc_nc_write_real_2d(ncid, aero_refract_core_real, &
2910 "aero_refract_core_real", (/ dimid_aero_particle, &
2911 dimid_optical_wavelengths /), unit=
"1", &
2912 long_name=
"real part of the refractive indices of the core " &
2913 //
"of each aerosol particle")
2914 call pmc_nc_write_real_2d(ncid, aero_refract_core_imag, &
2915 "aero_refract_core_imag", (/ dimid_aero_particle, &
2916 dimid_optical_wavelengths /), unit=
"1", &
2917 long_name=
"imaginary part of the refractive indices of " &
2918 //
"the core of each aerosol particle")
2919 call pmc_nc_write_real_1d(ncid, aero_core_vol, &
2920 "aero_core_vol", (/ dimid_aero_particle /), unit=
"m^3", &
2921 long_name=
"volume of the optical cores of each " &
2922 //
"aerosol particle")
2928 if (record_removals)
then
2931 if (aero_info_array_n_item(aero_state%aero_info_array) >= 1)
then
2932 do i_remove = 1,aero_info_array_n_item(aero_state%aero_info_array)
2933 aero_removed_id(i_remove) = &
2934 aero_state%aero_info_array%aero_info(i_remove)%id
2935 aero_removed_action(i_remove) = &
2936 aero_state%aero_info_array%aero_info(i_remove)%action
2937 aero_removed_other_id(i_remove) = &
2938 aero_state%aero_info_array%aero_info(i_remove)%other_id
2941 aero_removed_id(1) = 0
2943 aero_removed_other_id(1) = 0
2945 call pmc_nc_write_integer64_1d(ncid, aero_removed_id, &
2946 "aero_removed_id", (/ dimid_aero_removed /), &
2947 long_name=
"ID of removed particles")
2948 call pmc_nc_write_integer_1d(ncid, aero_removed_action, &
2949 "aero_removed_action", (/ dimid_aero_removed /), &
2950 long_name=
"reason for particle removal", &
2951 description=
"valid is 0 (invalid entry), 1 (removed due to " &
2952 //
"dilution), 2 (removed due to coagulation -- combined " &
2953 //
"particle ID is in \c aero_removed_other_id), 3 (removed " &
2954 //
"due to populating halving), or 4 (removed due to " &
2955 //
"weighting changes")
2956 call pmc_nc_write_integer64_1d(ncid, aero_removed_other_id, &
2957 "aero_removed_other_id", (/ dimid_aero_removed /), &
2958 long_name=
"ID of other particle involved in removal", &
2959 description=
"if <tt>aero_removed_action(i)</tt> is 2 " &
2960 //
"(due to coagulation), then " &
2961 //
"<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2962 //
"resulting combined particle, or 0 if the new particle " &
2963 //
"was not created")
2966 end subroutine aero_state_output_netcdf
3038 integer,
intent(in) :: ncid
3042 integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
3043 integer :: i_bin, i_part_in_bin, i_part, i_remove, status
3045 character(len=1000) :: name
3048 integer,
allocatable :: aero_particle_weight_group(:)
3049 integer,
allocatable :: aero_particle_weight_class(:)
3050 real(kind=
dp),
allocatable :: aero_absorb_cross_sect(:,:)
3051 real(kind=
dp),
allocatable :: aero_scatter_cross_sect(:,:)
3052 real(kind=
dp),
allocatable :: aero_asymmetry(:,:)
3053 real(kind=
dp),
allocatable :: aero_refract_shell_real(:,:)
3054 real(kind=
dp),
allocatable :: aero_refract_shell_imag(:,:)
3055 real(kind=
dp),
allocatable :: aero_refract_core_real(:,:)
3056 real(kind=
dp),
allocatable :: aero_refract_core_imag(:,:)
3057 real(kind=
dp),
allocatable :: aero_core_vol(:)
3058 integer,
allocatable :: aero_water_hyst_leg(:)
3059 real(kind=
dp),
allocatable :: aero_num_conc(:)
3060 integer(kind=8),
allocatable :: aero_id(:)
3061 real(kind=
dp),
allocatable :: aero_least_create_time(:)
3062 real(kind=
dp),
allocatable :: aero_greatest_create_time(:)
3063 integer,
allocatable :: aero_removed_id(:)
3064 integer,
allocatable :: aero_removed_action(:)
3065 integer(kind=8),
allocatable :: aero_removed_other_id(:)
3066 integer,
allocatable :: aero_component_particle_num(:)
3067 integer,
allocatable :: aero_component_source_num(:)
3068 integer,
allocatable :: aero_component_len(:)
3069 integer,
allocatable :: aero_component_start_ind(:)
3070 integer,
allocatable :: aero_particle_n_primary_parts(:)
3071 real(kind=
dp),
allocatable :: aero_component_create_time(:)
3077 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
3078 if (status == nf90_ebaddim)
then
3083 call pmc_nc_check(status)
3084 call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
3088 "aero_particle_mass")
3089 call pmc_nc_read_integer_1d(ncid, aero_particle_n_primary_parts, &
3090 "aero_particle_n_primary_parts")
3091 call pmc_nc_read_integer_1d(ncid, aero_component_particle_num, &
3092 "aero_component_particle_num")
3093 call pmc_nc_read_integer_1d(ncid, aero_component_source_num, &
3094 "aero_component_source_num")
3095 call pmc_nc_read_real_1d(ncid, aero_component_create_time, &
3096 "aero_component_create_time")
3097 call pmc_nc_read_integer_1d(ncid, aero_component_len,
"aero_component_len")
3098 call pmc_nc_read_integer_1d(ncid, aero_component_start_ind, &
3099 "aero_component_start_ind")
3100 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_group, &
3101 "aero_particle_weight_group")
3102 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_class, &
3103 "aero_particle_weight_class")
3104 call pmc_nc_read_real_2d(ncid, aero_absorb_cross_sect, &
3105 "aero_absorb_cross_sect", must_be_present=.false.)
3106 call pmc_nc_read_real_2d(ncid, aero_scatter_cross_sect, &
3107 "aero_scatter_cross_sect", must_be_present=.false.)
3108 call pmc_nc_read_real_2d(ncid, aero_asymmetry, &
3109 "aero_asymmetry", must_be_present=.false.)
3110 call pmc_nc_read_real_2d(ncid, aero_refract_shell_real, &
3111 "aero_refract_shell_real", must_be_present=.false.)
3112 call pmc_nc_read_real_2d(ncid, aero_refract_shell_imag, &
3113 "aero_refract_shell_imag", must_be_present=.false.)
3114 call pmc_nc_read_real_2d(ncid, aero_refract_core_real, &
3115 "aero_refract_core_real", must_be_present=.false.)
3116 call pmc_nc_read_real_2d(ncid, aero_refract_core_imag, &
3117 "aero_refract_core_imag", must_be_present=.false.)
3118 call pmc_nc_read_real_1d(ncid, aero_core_vol, &
3119 "aero_core_vol", must_be_present=.false.)
3120 call pmc_nc_read_integer_1d(ncid, aero_water_hyst_leg, &
3121 "aero_water_hyst_leg")
3122 call pmc_nc_read_real_1d(ncid, aero_num_conc, &
3124 call pmc_nc_read_integer64_1d(ncid, aero_id, &
3126 call pmc_nc_read_real_1d(ncid, aero_least_create_time, &
3127 "aero_least_create_time")
3128 call pmc_nc_read_real_1d(ncid, aero_greatest_create_time, &
3129 "aero_greatest_create_time")
3134 do i_part = 1,n_part
3137 aero_particle%n_primary_parts = aero_particle_n_primary_parts(i_part)
3138 if (
allocated(aero_particle%component)) &
3139 deallocate(aero_particle%component)
3140 allocate(aero_particle%component(aero_component_len(i_part)))
3141 do i_comp = 1,aero_component_len(i_part)
3142 aero_particle%component(i_comp)%source_id = &
3143 aero_component_source_num(aero_component_start_ind(i_part) &
3145 aero_particle%component(i_comp)%create_time = &
3146 aero_component_create_time(aero_component_start_ind(i_part) &
3149 aero_particle%weight_group = aero_particle_weight_group(i_part)
3150 aero_particle%weight_class = aero_particle_weight_class(i_part)
3151 if (
size(aero_absorb_cross_sect, 1) == n_part)
then
3152 aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part, :)
3154 if (
size(aero_scatter_cross_sect, 1) == n_part)
then
3155 aero_particle%scatter_cross_sect = &
3156 aero_scatter_cross_sect(i_part, :)
3158 if (
size(aero_asymmetry, 1) == n_part)
then
3159 aero_particle%asymmetry = aero_asymmetry(i_part, :)
3161 if ((
size(aero_refract_shell_real, 1) == n_part) &
3162 .and. (
size(aero_refract_shell_imag, 1) == n_part))
then
3163 aero_particle%refract_shell = &
3164 cmplx(aero_refract_shell_real(i_part, :), &
3165 aero_refract_shell_imag(i_part, :), kind=
dc)
3167 if ((
size(aero_refract_core_real, 1) == n_part) &
3168 .and. (
size(aero_refract_core_imag, 1) == n_part))
then
3169 aero_particle%refract_core = cmplx(aero_refract_core_real( &
3170 i_part, :), aero_refract_core_imag(i_part, :), kind=
dc)
3172 if (
size(aero_core_vol) == n_part)
then
3173 aero_particle%core_vol = aero_core_vol(i_part)
3175 aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
3176 aero_particle%id = aero_id(i_part)
3177 aero_particle%least_create_time = aero_least_create_time(i_part)
3178 aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
3189 call pmc_nc_read_integer_1d(ncid, aero_removed_id, &
3190 "aero_removed_id", must_be_present=.false.)
3191 call pmc_nc_read_integer_1d(ncid, aero_removed_action, &
3192 "aero_removed_action", must_be_present=.false.)
3193 call pmc_nc_read_integer64_1d(ncid, aero_removed_other_id, &
3194 "aero_removed_other_id", must_be_present=.false.)
3196 n_info_item =
size(aero_removed_id)
3197 if (n_info_item >= 1)
then
3198 if ((n_info_item > 1) &
3199 .or. ((n_info_item == 1) .and. (aero_removed_id(1) /= 0)))
then
3202 do i_remove = 1,n_info_item
3203 aero_state%aero_info_array%aero_info(i_remove)%id &
3204 = aero_removed_id(i_remove)
3205 aero_state%aero_info_array%aero_info(i_remove)%action &
3206 = aero_removed_action(i_remove)
3207 aero_state%aero_info_array%aero_info(i_remove)%other_id &
3208 = aero_removed_other_id(i_remove)
3225 type(
bin_grid_t),
optional,
intent(in) :: bin_grid
3227 logical,
optional,
intent(in) :: all_procs_same
3230 aero_data, aero_state%valid_sort,
size(aero_state%awa%weight, 1), &
3231 size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
3232 aero_state%valid_sort = .true.
3246 logical,
parameter :: continue_on_error = .false.
3250 if (aero_state%valid_sort)
then
3252 aero_data,
size(aero_state%awa%weight, 1), &
3253 size(aero_state%awa%weight, 2), continue_on_error)
3262 subroutine aero_state_initialize(aero_state, aero_data, camp_core)
3269 type(camp_core_t),
intent(in) :: camp_core
3271 select type( aero_rep => aero_data%aero_rep_ptr)
3272 type is(aero_rep_single_particle_t)
3274 call camp_core%initialize_update_object(aero_rep, &
3275 aero_state%update_number)
3277 call die_msg(927605681,
"Wrong aerosol representation type")
3280 end subroutine aero_state_initialize
3311 aero_state%apa%particle(i_part))
3327 integer :: wavelength
3330 real(kind=
dp) :: b_scat
3338 b_scat = b_scat + num_concs(i_part) &
3339 * aero_state%apa%particle(i_part)%scatter_cross_sect(wavelength)
3357 integer :: wavelength
3360 real(kind=
dp) :: b_abs
3368 b_abs = b_abs + num_concs(i_part) &
3369 * aero_state%apa%particle(i_part)%absorb_cross_sect(wavelength)
3381 bin_values, i_wavelength)
3390 real(kind=
dp),
allocatable :: bin_values(:)
3392 integer :: i_wavelength
3396 integer :: i_bin, i_part
3407 * aero_state%apa%particle(i_part)%scatter_cross_sect( &
3418 bin_values, i_wavelength)
3427 real(kind=
dp),
allocatable :: bin_values(:)
3429 integer :: i_wavelength
3433 integer :: i_bin, i_part
3444 * aero_state%apa%particle(i_part)%absorb_cross_sect( &
3467 bin_grid, bin_values, d_alpha, d_gamma, chi, include, exclude, group, &
3477 real(kind=
dp),
allocatable,
intent(in) :: bin_values(:)
3479 real(kind=
dp),
allocatable,
intent(inout) :: d_alpha(:)
3481 real(kind=
dp),
allocatable,
intent(inout) :: d_gamma(:)
3483 real(kind=
dp),
allocatable,
intent(inout) :: chi(:)
3485 character(len=*),
optional :: include(:)
3487 character(len=*),
optional :: exclude(:)
3489 character(len=*),
optional :: group(:)
3491 character(len=*),
optional :: groups(:,:)
3499 if (
allocated(d_alpha))
deallocate(d_alpha)
3500 if (
allocated(d_gamma))
deallocate(d_gamma)
3501 if (
allocated(chi))
deallocate(chi)
3511 aero_state_size_range = aero_state
3520 d_alpha(i_bin), d_gamma(i_bin), chi(i_bin), include, exclude, &
3539 aero_state_to = aero_state_from
3545 aero_state_to%n_part_ideal = aero_state_from%n_part_ideal
3547 aero_state_to%update_number = aero_state_from%update_number