73 real(kind=
dp),
allocatable :: n_part_ideal(:, :)
78 type(aero_rep_update_data_single_particle_number_t) :: update_number
99 subroutine spec_file_read_aero_state_weighting_type(file, weighting_type, &
105 integer,
intent(out) :: weighting_type
108 real(kind=
dp),
intent(out) :: exponent
110 character(len=SPEC_LINE_MAX_VAR_LEN) :: weighting_name
133 if (trim(weighting_name) ==
'flat')
then
135 elseif (trim(weighting_name) ==
'power')
then
138 elseif (trim(weighting_name) ==
'nummass')
then
140 elseif (trim(weighting_name) ==
'flat_source')
then
142 elseif (trim(weighting_name) ==
'power_source')
then
145 elseif (trim(weighting_name) ==
'nummass_source')
then
149 "Unknown weighting type: " // trim(weighting_name))
152 end subroutine spec_file_read_aero_state_weighting_type
164 aero_state_to%awa = aero_state_from%awa
179 integer,
intent(in) :: weight_type
182 real(kind=
dp),
intent(in),
optional :: exponent
184 aero_state%valid_sort = .false.
185 select case(weight_type)
190 call assert_msg(656670336,
present(exponent), &
191 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
199 call assert_msg(102143848,
present(exponent), &
200 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
207 call die_msg(969076992,
"unknown weight_type: " &
222 real(kind=
dp),
intent(in) :: n_part
224 integer :: n_group, n_class
228 if (
allocated(aero_state%n_part_ideal))
then
229 deallocate(aero_state%n_part_ideal)
231 allocate(aero_state%n_part_ideal(n_group, n_class))
232 aero_state%n_part_ideal = n_part / real(n_group * n_class, kind=
dp)
244 integer,
intent(in) :: source
248 call assert(932390238, source >= 1)
251 if (n_class > 1)
then
252 call assert(765048788, source <= n_class)
268 integer,
optional,
intent(in) :: i_group
270 integer,
optional,
intent(in) :: i_class
274 if (
present(i_group))
then
275 call assert(908743823,
present(i_class))
276 if (aero_state%valid_sort)
then
279 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
284 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
286 (aero_state%apa%particle(i_part)%weight_class == i_class)) &
307 integer,
optional,
intent(in) :: i_group
309 integer,
optional,
intent(in) :: i_class
328 aero_state%valid_sort = .false.
346 logical,
optional,
intent(in) :: allow_resort
348 if (aero_state%valid_sort)
then
350 aero_particle, aero_data, allow_resort)
365 integer,
intent(in) :: i_part
367 if (aero_state%valid_sort)
then
369 aero_state%apa, i_part)
385 integer,
intent(in) :: i_part
399 record_removal, aero_info)
404 integer,
intent(in) :: i_part
406 logical,
intent(in) :: record_removal
410 if (record_removal)
then
424 i_bin, i_class, aero_particle)
429 integer,
intent(in) :: i_bin
431 integer,
intent(in) :: i_class
435 integer :: i_entry, i_part
437 call assert(742996300, aero_state%valid_sort)
439 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) > 0)
441 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)))
442 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
443 i_class)%entry(i_entry)
444 aero_particle = aero_state%apa%particle(i_part)
460 n_part_mean, random_weight_group)
467 integer,
intent(in) :: i_part
469 real(kind=
dp),
intent(in) :: n_part_mean
472 logical,
optional,
intent(in) :: random_weight_group
474 integer :: n_copies, i_dup, new_group
479 if (n_copies == 0)
then
480 aero_info%id = aero_state%apa%particle(i_part)%id
482 aero_info%other_id = 0
485 elseif (n_copies > 1)
then
486 do i_dup = 1,(n_copies - 1)
487 new_aero_particle = aero_state%apa%particle(i_part)
489 if (
present(random_weight_group))
then
490 if (random_weight_group)
then
493 aero_state%apa%particle(i_part)%weight_class, &
510 aero_particle, aero_data)
537 real(kind=
dp),
intent(out) &
543 reweight_num_conc(i_part) &
545 aero_state%apa%particle(i_part), aero_data)
570 real(kind=
dp),
intent(in) &
573 integer :: i_part, i_group, i_class
574 real(kind=
dp) :: n_part_old(
size(aero_state%awa%weight, 1), &
575 size(aero_state%awa%weight, 2))
576 real(kind=
dp) :: n_part_new(
size(aero_state%awa%weight, 1), &
577 size(aero_state%awa%weight, 2))
578 real(kind=
dp) :: old_num_conc, new_num_conc, n_part_mean
585 old_num_conc = reweight_num_conc(i_part)
587 aero_state%apa%particle(i_part), aero_data)
588 n_part_mean = old_num_conc / new_num_conc
589 i_group = aero_state%apa%particle(i_part)%weight_group
590 i_class = aero_state%apa%particle(i_part)%weight_class
591 n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
593 n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
598 do i_group = 1,
size(aero_state%awa%weight, 1)
599 do i_class = 1,
size(aero_state%awa%weight, 2)
600 if (n_part_old(i_group, i_class) == 0d0) cycle
602 n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
609 old_num_conc = reweight_num_conc(i_part)
612 aero_state%apa%particle(i_part), aero_data)
613 n_part_mean = old_num_conc / new_num_conc
653 integer :: i_part, i_bin
655 do i_part = 1,aero_state_delta%apa%n_part
657 aero_state_delta%apa%particle(i_part), aero_data)
660 aero_state_delta%aero_info_array)
670 i_group, i_class, n_add, allow_doubling, allow_halving)
677 integer,
intent(in) :: i_group
679 integer,
intent(in) :: i_class
681 real(kind=
dp),
intent(in) :: n_add
683 logical,
intent(in) :: allow_doubling
685 logical,
intent(in) :: allow_halving
687 integer :: global_n_part, n_group, n_class
688 real(kind=
dp) :: mean_n_part, n_part_new, weight_ratio
689 real(kind=
dp) :: n_part_ideal_local_group
696 n_part_new = mean_n_part + n_add
697 if (n_part_new == 0d0)
return
698 n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
700 if ((n_part_new < n_part_ideal_local_group / 2d0) &
701 .or. (n_part_new > n_part_ideal_local_group * 2d0)) &
703 weight_ratio = n_part_new / n_part_ideal_local_group
705 i_class, weight_ratio, allow_doubling, allow_halving)
715 aero_dist, sample_prop, create_time, allow_doubling, allow_halving, &
725 real(kind=
dp),
intent(in) :: sample_prop
727 real(kind=
dp),
intent(in) :: create_time
729 logical,
intent(in) :: allow_doubling
731 logical,
intent(in) :: allow_halving
733 integer,
intent(out),
optional :: n_part_add
735 real(kind=
dp) :: n_samp_avg, radius, total_vol
737 integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
740 n_group =
size(aero_state%awa%weight, 1)
741 n_class =
size(aero_state%awa%weight, 2)
742 if (
present(n_part_add))
then
745 do i_group = 1,n_group
748 aero_dist%mode(i_mode)%source)
751 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
752 aero_state%awa%weight(i_group, i_class))
754 i_group, i_class, n_samp_avg, allow_doubling, allow_halving)
755 if (n_samp_avg == 0d0) cycle
758 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
759 aero_state%awa%weight(i_group, i_class))
761 if (
present(n_part_add))
then
762 n_part_add = n_part_add + n_samp
766 call aero_mode_sample_radius(aero_dist%mode(i_mode), aero_data, &
767 aero_state%awa%weight(i_group, i_class), radius)
769 call aero_mode_sample_vols(aero_dist%mode(i_mode), total_vol, &
776 aero_dist%mode(i_mode)%source)
792 integer,
intent(out) :: i_part
808 aero_data, sample_prob, removal_action)
817 real(kind=
dp),
intent(in) :: sample_prob
820 integer,
intent(in) :: removal_action
822 integer :: n_transfer, i_transfer, i_part
823 logical :: do_add, do_remove
824 real(kind=
dp) :: num_conc_from, num_conc_to
827 call assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
833 do while (i_transfer < n_transfer)
837 aero_state_from%apa%particle(i_part), aero_data)
839 aero_state_from%apa%particle(i_part), aero_data)
841 if (num_conc_to == num_conc_from)
then
844 elseif (num_conc_to < num_conc_from)
then
847 if (
pmc_random() < num_conc_to / num_conc_from)
then
852 if (
pmc_random() < num_conc_from / num_conc_to)
then
859 aero_state_from%apa%particle(i_part), aero_data)
863 aero_info%id = aero_state_from%apa%particle(i_part)%id
864 aero_info%action = removal_action
871 i_transfer = i_transfer + 1
883 aero_data, sample_prob, removal_action)
892 real(kind=
dp),
intent(in) :: sample_prob
895 integer,
intent(in) :: removal_action
897 integer :: n_transfer, i_transfer, i_part
898 logical :: do_add, do_remove, overwrite_to
899 real(kind=
dp) :: num_conc_from, num_conc_to
902 call assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
908 do i_transfer = 1,n_transfer
913 aero_state_from%apa%particle(i_part), aero_data)
915 aero_info%id = aero_state_from%apa%particle(i_part)%id
916 aero_info%action = removal_action
924 overwrite_to = .true.
926 sample_prob, overwrite_to)
945 integer :: i_part, i_bin
946 real(kind=
dp) :: factor
948 aero_binned%num_conc = 0d0
949 aero_binned%vol_conc = 0d0
954 call warn_msg(980232449,
"particle ID " &
956 //
" outside of bin_grid, discarding")
959 aero_state%apa%particle(i_part), aero_data) &
960 / bin_grid%widths(i_bin)
961 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
962 + aero_state%apa%particle(i_part)%vol * factor
963 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
999 character(len=*),
optional,
intent(in) :: include(:)
1001 character(len=*),
optional,
intent(in) :: exclude(:)
1042 type(env_state_t),
intent(in) :: env_state
1053 aero_state%apa%particle(i_part), aero_data, env_state)
1072 type(
aero_data_t),
optional,
intent(in) :: aero_data
1074 character(len=*),
optional,
intent(in) :: include(:)
1076 character(len=*),
optional,
intent(in) :: exclude(:)
1081 logical,
allocatable :: use_species(:)
1082 integer :: i_name, i_spec
1084 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then
1088 call assert_msg(599558703,
present(aero_data), &
1089 "must provide 'aero_data' if using 'include' or 'exclude'")
1091 if (
present(include))
then
1092 use_species = .false.
1093 do i_name = 1,
size(include)
1096 "unknown species: " // trim(include(i_name)))
1097 use_species(i_spec) = .true.
1100 use_species = .true.
1102 if (
present(exclude))
then
1103 do i_name = 1,
size(exclude)
1106 "unknown species: " // trim(exclude(i_name)))
1107 use_species(i_spec) = .false.
1112 if (use_species(i_spec))
then
1139 character(len=*),
optional,
intent(in) :: include(:)
1141 character(len=*),
optional,
intent(in) :: exclude(:)
1147 integer :: i_name, i_spec
1149 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then
1154 if (
present(include))
then
1155 use_species = .false.
1156 do i_name = 1,
size(include)
1159 "unknown species: " // trim(include(i_name)))
1160 use_species(i_spec) = .true.
1163 use_species = .true.
1165 if (
present(exclude))
then
1166 do i_name = 1,
size(exclude)
1169 "unknown species: " // trim(exclude(i_name)))
1170 use_species(i_spec) = .false.
1175 if (use_species(i_spec))
then
1204 aero_state%apa%particle(i_part), aero_data)
1225 aero_state%apa%particle(i_part), aero_data)
1251 character(len=*),
optional :: include(:)
1253 character(len=*),
optional :: exclude(:)
1255 character(len=*),
optional :: group(:)
1257 character(len=*),
optional :: groups(:,:)
1264 integer :: i_name, i_spec, i_part, i_group, n_group
1266 real(kind=
dp) :: group_mass, non_group_mass, mass
1267 real(kind=
dp),
allocatable :: group_masses(:)
1269 if (
present(include))
then
1270 use_species = .false.
1271 do i_name = 1,
size(include)
1274 "unknown species: " // trim(include(i_name)))
1275 use_species(i_spec) = .true.
1278 use_species = .true.
1280 if (
present(exclude))
then
1281 do i_name = 1,
size(exclude)
1284 "unknown species: " // trim(exclude(i_name)))
1285 use_species(i_spec) = .false.
1288 if (
present(group))
then
1289 group_species = .false.
1290 do i_name = 1,
size(group)
1293 "unknown species: " // trim(group(i_name)))
1294 group_species(i_spec) = .true.
1298 non_group_mass = 0d0
1300 if (use_species(i_spec))
then
1302 aero_state%apa%particle(i_part), i_spec, aero_data)
1303 if (group_species(i_spec))
then
1304 group_mass = group_mass + mass
1306 non_group_mass = non_group_mass + mass
1311 =
entropy([group_mass, non_group_mass])
1313 else if (
present(groups))
then
1314 call assert_msg(161633285, .not.
present(include), &
1315 "cannot specify both 'include' and 'groups' arguments")
1316 call assert_msg(273540426, .not.
present(exclude), &
1317 "cannot specify both 'exclude' and 'groups' arguments")
1318 call assert_msg(499993914, .not.
present(group), &
1319 "cannot specify both 'group' and 'groups' arguments")
1321 n_group =
size(groups, 1)
1324 species_group_numbers = 0
1325 do i_group = 1, n_group
1326 do i_name = 1,
size(groups, 2)
1327 if (len_trim(groups(i_group, i_name)) > 0)
then
1329 groups(i_group, i_name))
1331 "unknown species: " // trim(groups(i_group, i_name)))
1332 if (use_species(i_spec))
then
1333 species_group_numbers(i_spec) = i_group
1339 allocate(group_masses(n_group))
1344 aero_state%apa%particle(i_part), i_spec, aero_data)
1345 i_group = species_group_numbers(i_spec)
1346 if (i_group > 0)
then
1347 group_masses(i_group) = group_masses(i_group) + mass
1356 aero_data), use_species))
1378 d_gamma, chi, include, exclude, group, groups)
1385 real(kind=
dp),
intent(out) :: d_alpha
1387 real(kind=
dp),
intent(out) :: d_gamma
1389 real(kind=
dp),
intent(out) :: chi
1391 character(len=*),
optional :: include(:)
1393 character(len=*),
optional :: exclude(:)
1395 character(len=*),
optional :: group(:)
1397 character(len=*),
optional :: groups(:,:)
1399 real(kind=
dp),
allocatable :: entropies(:), entropies_of_avg_part(:)
1400 real(kind=
dp),
allocatable :: masses(:), num_concs(:), &
1401 num_concs_of_avg_part(:), masses_of_avg_part(:)
1407 if (
present(groups))
then
1408 call assert_msg(726652236, .not.
present(include), &
1409 "cannot specify both 'include' and 'groups' arguments")
1410 call assert_msg(891097454, .not.
present(exclude), &
1411 "cannot specify both 'exclude' and 'groups' arguments")
1412 call assert_msg(938789093, .not.
present(group), &
1413 "cannot specify both 'group' and 'groups' arguments")
1415 include=pack(groups, len_trim(groups) > 0))
1423 include, exclude, group, groups)
1425 d_alpha = exp(sum(entropies * masses * num_concs) &
1426 / sum(masses * num_concs))
1430 aero_state_averaged = aero_state
1435 if (
present(groups))
then
1437 include=pack(groups, len_trim(groups) > 0))
1443 aero_data, include, exclude, group, groups)
1445 d_gamma = exp(sum(entropies_of_avg_part * masses_of_avg_part &
1446 * num_concs_of_avg_part) &
1447 / sum(masses_of_avg_part * num_concs_of_avg_part))
1449 chi = (d_alpha - 1) / (d_gamma - 1)
1463 type(env_state_t),
intent(in) :: env_state
1474 aero_state%apa%particle(i_part), aero_data, env_state)
1489 type(env_state_t),
intent(in) :: env_state
1498 aero_state%apa%particle(i_part), aero_data, env_state)
1518 integer :: i_part, i_bin
1519 real(kind=
dp) :: factor
1521 aero_binned%num_conc = 0d0
1522 aero_binned%vol_conc = 0d0
1527 if ((i_bin < 1) .or. (i_bin >
bin_grid_size(bin_grid)))
then
1528 call warn_msg(503871022,
"particle ID " &
1530 //
" outside of bin_grid, discarding")
1533 aero_state%apa%particle(i_part), aero_data) &
1534 / bin_grid%widths(i_bin)
1535 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1536 + aero_state%apa%particle(i_part)%vol * factor
1537 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1554 integer,
intent(in) :: i_group
1556 integer,
intent(in) :: i_class
1562 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1563 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1565 aero_particle = aero_state%apa%particle(i_part)
1570 aero_state%valid_sort = .false.
1583 integer,
intent(in) :: i_group
1585 integer,
intent(in) :: i_class
1591 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1592 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1595 aero_info%id = aero_state%apa%particle(i_part)%id
1612 allow_halving, initial_state_warning)
1619 logical,
intent(in) :: allow_doubling
1621 logical,
intent(in) :: allow_halving
1623 logical,
intent(in) :: initial_state_warning
1625 integer :: i_group, i_class, n_group, n_class, global_n_part
1627 n_group =
size(aero_state%awa%weight, 1)
1628 n_class =
size(aero_state%awa%weight, 2)
1632 if (allow_doubling)
then
1633 do i_group = 1,n_group
1634 do i_class = 1,n_class
1638 do while ((real(global_n_part, kind=
dp) &
1639 < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1640 .and. (global_n_part > 0))
1641 if (initial_state_warning)
then
1642 call warn_msg(716882783,
"doubling particles in initial " &
1655 if (allow_halving)
then
1656 do i_group = 1,n_group
1657 do i_class = 1,n_class
1659 i_group, i_class), kind=
dp) &
1660 > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1661 if (initial_state_warning)
then
1663 "halving particles in initial condition")
1679 i_class, weight_ratio, allow_doubling, allow_halving)
1686 integer,
intent(in) :: i_group
1688 integer,
intent(in) :: i_class
1690 real(kind=
dp),
intent(in) :: weight_ratio
1692 logical,
intent(in) :: allow_doubling
1694 logical,
intent(in) :: allow_halving
1696 real(kind=
dp) :: ratio
1697 integer :: i_part, i_remove, n_remove, i_entry, n_part
1706 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
1708 if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0)))
then
1712 * (1d0 - 1d0 / weight_ratio))
1713 do i_remove = 1,n_remove
1715 aero_state%aero_sorted%group_class%inverse(i_group, i_class)))
1716 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1717 i_class)%entry(i_entry)
1718 aero_info%id = aero_state%apa%particle(i_part)%id
1723 elseif ((weight_ratio < 1d0) &
1724 .and. (allow_doubling .or. (n_part == 0)))
then
1727 do i_entry = n_part,1,-1
1728 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1729 i_class)%entry(i_entry)
1742 aero_data, specify_prob_transfer)
1747 real(kind=
dp),
intent(in) :: del_t
1749 real(kind=
dp),
intent(in) :: mix_timescale
1754 real(kind=
dp),
optional,
intent(in) :: specify_prob_transfer
1757 integer :: rank, n_proc, i_proc, ierr
1758 integer :: buffer_size, buffer_size_check
1759 character,
allocatable :: buffer(:)
1762 real(kind=
dp) :: prob_transfer, prob_not_transferred
1763 real(kind=
dp) :: prob_transfer_given_not_transferred
1768 if (n_proc == 1)
then
1775 allocate(aero_state_sends(n_proc))
1776 allocate(aero_state_recvs(n_proc))
1779 if (
present(specify_prob_transfer))
then
1780 prob_transfer = specify_prob_transfer / real(n_proc, kind=
dp)
1782 prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1783 / real(n_proc, kind=
dp)
1787 prob_not_transferred = 1d0
1788 do i_proc = 0,(n_proc - 1)
1789 if (i_proc /= rank)
then
1794 prob_transfer_given_not_transferred = prob_transfer &
1795 / prob_not_transferred
1797 aero_state_sends(i_proc + 1), aero_data, &
1799 prob_not_transferred = prob_not_transferred - prob_transfer
1807 do i_proc = 0,(n_proc - 1)
1808 if (i_proc /= rank)
then
1815 deallocate(aero_state_sends)
1816 deallocate(aero_state_recvs)
1834 character,
allocatable :: sendbuf(:), recvbuf(:)
1835 integer :: sendcounts(size(send)), sdispls(size(send))
1836 integer :: recvcounts(size(send)), rdispls(size(send))
1837 integer :: i_proc, position, old_position, max_sendbuf_size, ierr
1841 max_sendbuf_size = 0
1844 max_sendbuf_size = max_sendbuf_size &
1849 allocate(sendbuf(max_sendbuf_size))
1853 old_position = position
1857 sendcounts(i_proc) = position - old_position
1859 call assert(393267406, position <= max_sendbuf_size)
1862 allocate(recvbuf(sum(recvcounts)))
1867 sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
1868 rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
1871 call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
1872 recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
1877 call assert(189739257, position == rdispls(i_proc))
1878 if (recvcounts(i_proc) > 0)
then
1905 real(kind=
dp) :: total_volume_conc, particle_volume, num_conc
1906 integer :: i_bin, i_class, i_entry, i_part, i_spec
1911 species_volume_conc = 0d0
1912 total_volume_conc = 0d0
1913 do i_class = 1,
size(aero_state%awa%weight, 2)
1915 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1916 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1917 i_class)%entry(i_entry)
1919 aero_state%apa%particle(i_part), aero_data)
1921 aero_state%apa%particle(i_part))
1922 species_volume_conc = species_volume_conc &
1923 + num_conc * aero_state%apa%particle(i_part)%vol
1924 total_volume_conc = total_volume_conc + num_conc * particle_volume
1927 do i_class = 1,
size(aero_state%awa%weight, 2)
1929 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1930 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1931 i_class)%entry(i_entry)
1933 aero_state%apa%particle(i_part))
1934 aero_state%apa%particle(i_part)%vol &
1935 = particle_volume * species_volume_conc / total_volume_conc
1959 bin_center, preserve_number)
1969 logical,
intent(in) :: bin_center
1973 logical,
intent(in) :: preserve_number
1975 real(kind=
dp) :: total_volume_conc, particle_volume
1976 real(kind=
dp) :: new_particle_volume, num_conc, total_num_conc
1977 real(kind=
dp) :: lower_volume, upper_volume, center_volume
1978 real(kind=
dp) :: lower_function, upper_function, center_function
1979 integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
1980 logical :: monotone_increasing, monotone_decreasing
1985 do i_class = 1,
size(aero_state%awa%weight, 2)
1987 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) &
1993 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1994 total_num_conc = 0d0
1995 total_volume_conc = 0d0
1997 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1998 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1999 i_class)%entry(i_entry)
2001 aero_state%apa%particle(i_part), aero_data)
2002 total_num_conc = total_num_conc + num_conc
2004 aero_state%apa%particle(i_part))
2005 total_volume_conc = total_volume_conc &
2006 + num_conc * particle_volume
2010 if (bin_center)
then
2012 bin_grid%centers(i_bin))
2017 new_particle_volume = total_volume_conc / num_conc &
2019 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)), &
2021 elseif (preserve_number)
then
2032 monotone_increasing, monotone_decreasing)
2034 monotone_increasing .or. monotone_decreasing, &
2035 "monotone weight function required for averaging")
2038 do i_entry = 1,n_part
2039 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2040 i_class)%entry(i_entry)
2042 aero_state%apa%particle(i_part))
2043 if (i_part == 1)
then
2044 lower_volume = particle_volume
2045 upper_volume = particle_volume
2047 lower_volume = min(lower_volume, particle_volume)
2048 upper_volume = max(upper_volume, particle_volume)
2051 lower_function = real(n_part, kind=
dp) &
2055 upper_function = real(n_part, kind=
dp) &
2062 center_volume = (lower_volume + upper_volume) / 2d0
2063 center_function = real(n_part, kind=
dp) &
2067 if ((lower_function > 0d0 .and. center_function > 0d0) &
2068 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2070 lower_volume = center_volume
2071 lower_function = center_function
2073 upper_volume = center_volume
2074 upper_function = center_function
2078 new_particle_volume = center_volume
2090 monotone_increasing, monotone_decreasing)
2092 monotone_increasing .or. monotone_decreasing, &
2093 "monotone weight function required for averaging")
2096 do i_entry = 1,n_part
2097 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2098 i_class)%entry(i_entry)
2100 aero_state%apa%particle(i_part))
2101 if (i_part == 1)
then
2102 lower_volume = particle_volume
2103 upper_volume = particle_volume
2105 lower_volume = min(lower_volume, particle_volume)
2106 upper_volume = max(upper_volume, particle_volume)
2109 lower_function = real(n_part, kind=
dp) &
2112 lower_volume)) * lower_volume - total_volume_conc
2113 upper_function = real(n_part, kind=
dp) &
2116 upper_volume)) * upper_volume - total_volume_conc
2120 center_volume = (lower_volume + upper_volume) / 2d0
2121 center_function = real(n_part, kind=
dp) &
2124 center_volume)) * center_volume - total_volume_conc
2125 if ((lower_function > 0d0 .and. center_function > 0d0) &
2126 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2128 lower_volume = center_volume
2129 lower_function = center_function
2131 upper_volume = center_volume
2132 upper_function = center_function
2136 new_particle_volume = center_volume
2139 do i_entry = 1,n_part
2140 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2141 i_class)%entry(i_entry)
2143 aero_state%apa%particle(i_part))
2144 aero_state%apa%particle(i_part)%vol &
2145 = aero_state%apa%particle(i_part)%vol &
2146 / particle_volume * new_particle_volume
2164 real(kind=
dp) :: reweight_num_conc(aero_state%apa%n_part)
2167 aero_state%valid_sort = .false.
2171 if (aero_data%i_water > 0)
then
2173 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
2175 aero_state%valid_sort = .false.
2190 integer :: total_size, i_group
2207 character,
intent(inout) :: buffer(:)
2209 integer,
intent(inout) :: position
2214 integer :: prev_position, i_group
2216 prev_position = position
2233 character,
intent(inout) :: buffer(:)
2235 integer,
intent(inout) :: position
2240 integer :: prev_position, i_group, n_group
2242 val%valid_sort = .false.
2243 prev_position = position
2268 integer :: n_proc, ierr, status(MPI_STATUS_SIZE)
2269 integer :: buffer_size, max_buffer_size, i_proc, position
2270 character,
allocatable :: buffer(:)
2274 aero_state_total = aero_state
2282 max_buffer_size = max_buffer_size &
2284 allocate(buffer(max_buffer_size))
2287 call assert(542772170, position <= max_buffer_size)
2288 buffer_size = position
2289 call mpi_send(buffer, buffer_size, mpi_character, 0, &
2296 do i_proc = 1,(n_proc - 1)
2301 call mpi_get_count(status, mpi_character, buffer_size, ierr)
2305 allocate(buffer(buffer_size))
2306 call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2312 aero_state_transfer)
2313 call assert(518174881, position == buffer_size)
2331 dimid_aero_particle)
2336 integer,
intent(in) :: ncid
2338 integer,
intent(out) :: dimid_aero_particle
2340 integer :: status, i_part
2341 integer :: varid_aero_particle
2342 integer :: aero_particle_centers(aero_state_n_part(aero_state))
2345 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2346 if (status == nf90_noerr)
return
2347 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2350 call pmc_nc_check(nf90_redef(ncid))
2352 call pmc_nc_check(nf90_def_dim(ncid,
"aero_particle", &
2353 aero_state_n_part(aero_state), dimid_aero_particle))
2355 call pmc_nc_check(nf90_enddef(ncid))
2357 do i_part = 1,aero_state_n_part(aero_state)
2358 aero_particle_centers(i_part) = i_part
2360 call pmc_nc_write_integer_1d(ncid, aero_particle_centers, &
2361 "aero_particle", (/ dimid_aero_particle /), &
2362 description=
"dummy dimension variable (no useful value)")
2377 integer,
intent(in) :: ncid
2379 integer,
intent(out) :: dimid_aero_removed
2381 integer :: status, i_remove, dim_size
2382 integer :: varid_aero_removed
2383 integer :: aero_removed_centers( &
2384 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2387 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2388 if (status == nf90_noerr)
return
2389 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2392 call pmc_nc_check(nf90_redef(ncid))
2394 dim_size = max(1, aero_info_array_n_item(aero_state%aero_info_array))
2395 call pmc_nc_check(nf90_def_dim(ncid,
"aero_removed", &
2396 dim_size, dimid_aero_removed))
2398 call pmc_nc_check(nf90_enddef(ncid))
2400 do i_remove = 1,dim_size
2401 aero_removed_centers(i_remove) = i_remove
2403 call pmc_nc_write_integer_1d(ncid, aero_removed_centers, &
2404 "aero_removed", (/ dimid_aero_removed /), &
2405 description=
"dummy dimension variable (no useful value)")
2412 subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2413 record_removals, record_optical)
2418 integer,
intent(in) :: ncid
2422 logical,
intent(in) :: record_removals
2424 logical,
intent(in) :: record_optical
2426 integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2427 integer :: dimid_aero_removed
2428 integer :: i_part, i_remove
2431 integer :: aero_n_orig_part(aero_state_n_part(aero_state), &
2432 aero_data_n_source(aero_data))
2433 integer :: aero_particle_weight_group(aero_state_n_part(aero_state))
2434 integer :: aero_particle_weight_class(aero_state_n_part(aero_state))
2435 real(kind=
dp) :: aero_absorb_cross_sect(aero_state_n_part(aero_state))
2436 real(kind=
dp) :: aero_scatter_cross_sect(aero_state_n_part(aero_state))
2437 real(kind=
dp) :: aero_asymmetry(aero_state_n_part(aero_state))
2438 real(kind=
dp) :: aero_refract_shell_real(aero_state_n_part(aero_state))
2439 real(kind=
dp) :: aero_refract_shell_imag(aero_state_n_part(aero_state))
2440 real(kind=
dp) :: aero_refract_core_real(aero_state_n_part(aero_state))
2441 real(kind=
dp) :: aero_refract_core_imag(aero_state_n_part(aero_state))
2442 real(kind=
dp) :: aero_core_vol(aero_state_n_part(aero_state))
2443 integer :: aero_water_hyst_leg(aero_state_n_part(aero_state))
2444 real(kind=
dp) :: aero_num_conc(aero_state_n_part(aero_state))
2445 integer :: aero_id(aero_state_n_part(aero_state))
2446 real(kind=
dp) :: aero_least_create_time(aero_state_n_part(aero_state))
2447 real(kind=
dp) :: aero_greatest_create_time(aero_state_n_part(aero_state))
2448 integer :: aero_removed_id( &
2449 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2450 integer :: aero_removed_action( &
2451 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2452 integer :: aero_removed_other_id( &
2453 max(1, aero_info_array_n_item(aero_state%aero_info_array)))
2548 call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2555 if (aero_state_n_part(aero_state) > 0)
then
2557 dimid_aero_particle)
2559 do i_part = 1,aero_state_n_part(aero_state)
2561 = aero_state%apa%particle(i_part)%vol * aero_data%density
2562 aero_n_orig_part(i_part, :) &
2563 = aero_state%apa%particle(i_part)%n_orig_part
2564 aero_particle_weight_group(i_part) &
2565 = aero_state%apa%particle(i_part)%weight_group
2566 aero_particle_weight_class(i_part) &
2567 = aero_state%apa%particle(i_part)%weight_class
2568 aero_water_hyst_leg(i_part) &
2569 = aero_state%apa%particle(i_part)%water_hyst_leg
2570 aero_num_conc(i_part) &
2572 aero_state%apa%particle(i_part), aero_data)
2573 aero_id(i_part) = aero_state%apa%particle(i_part)%id
2574 aero_least_create_time(i_part) &
2575 = aero_state%apa%particle(i_part)%least_create_time
2576 aero_greatest_create_time(i_part) &
2577 = aero_state%apa%particle(i_part)%greatest_create_time
2578 if (record_optical)
then
2579 aero_absorb_cross_sect(i_part) &
2580 = aero_state%apa%particle(i_part)%absorb_cross_sect
2581 aero_scatter_cross_sect(i_part) &
2582 = aero_state%apa%particle(i_part)%scatter_cross_sect
2583 aero_asymmetry(i_part) = aero_state%apa%particle(i_part)%asymmetry
2584 aero_refract_shell_real(i_part) &
2585 = real(aero_state%apa%particle(i_part)%refract_shell)
2586 aero_refract_shell_imag(i_part) &
2587 = aimag(aero_state%apa%particle(i_part)%refract_shell)
2588 aero_refract_core_real(i_part) &
2589 = real(aero_state%apa%particle(i_part)%refract_core)
2590 aero_refract_core_imag(i_part) &
2591 = aimag(aero_state%apa%particle(i_part)%refract_core)
2592 aero_core_vol(i_part) = aero_state%apa%particle(i_part)%core_vol
2596 "aero_particle_mass", (/ dimid_aero_particle, &
2597 dimid_aero_species /), unit=
"kg", &
2598 long_name=
"constituent masses of each aerosol particle")
2599 call pmc_nc_write_integer_2d(ncid, aero_n_orig_part, &
2600 "aero_n_orig_part", (/ dimid_aero_particle, &
2601 dimid_aero_source /), &
2602 long_name=
"number of original constituent particles from " &
2603 //
"each source that coagulated to form each aerosol particle")
2604 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_group, &
2605 "aero_particle_weight_group", (/ dimid_aero_particle /), &
2606 long_name=
"weight group number of each aerosol particle")
2607 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_class, &
2608 "aero_particle_weight_class", (/ dimid_aero_particle /), &
2609 long_name=
"weight class number of each aerosol particle")
2610 call pmc_nc_write_integer_1d(ncid, aero_water_hyst_leg, &
2611 "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2612 long_name=
"leg of the water hysteresis curve leg of each "&
2613 //
"aerosol particle")
2614 call pmc_nc_write_real_1d(ncid, aero_num_conc, &
2615 "aero_num_conc", (/ dimid_aero_particle /), unit=
"m^{-3}", &
2616 long_name=
"number concentration for each particle")
2617 call pmc_nc_write_integer_1d(ncid, aero_id, &
2618 "aero_id", (/ dimid_aero_particle /), &
2619 long_name=
"unique ID number of each aerosol particle")
2620 call pmc_nc_write_real_1d(ncid, aero_least_create_time, &
2621 "aero_least_create_time", (/ dimid_aero_particle /), unit=
"s", &
2622 long_name=
"least creation time of each aerosol particle", &
2623 description=
"least (earliest) creation time of any original " &
2624 //
"constituent particles that coagulated to form each " &
2625 //
"particle, measured from the start of the simulation")
2626 call pmc_nc_write_real_1d(ncid, aero_greatest_create_time, &
2627 "aero_greatest_create_time", (/ dimid_aero_particle /), &
2629 long_name=
"greatest creation time of each aerosol particle", &
2630 description=
"greatest (latest) creation time of any original " &
2631 //
"constituent particles that coagulated to form each " &
2632 //
"particle, measured from the start of the simulation")
2633 if (record_optical)
then
2634 call pmc_nc_write_real_1d(ncid, aero_absorb_cross_sect, &
2635 "aero_absorb_cross_sect", (/ dimid_aero_particle /), &
2637 long_name=
"optical absorption cross sections of each " &
2638 //
"aerosol particle")
2639 call pmc_nc_write_real_1d(ncid, aero_scatter_cross_sect, &
2640 "aero_scatter_cross_sect", (/ dimid_aero_particle /), &
2642 long_name=
"optical scattering cross sections of each " &
2643 //
"aerosol particle")
2644 call pmc_nc_write_real_1d(ncid, aero_asymmetry, &
2645 "aero_asymmetry", (/ dimid_aero_particle /), unit=
"1", &
2646 long_name=
"optical asymmetry parameters of each " &
2647 //
"aerosol particle")
2648 call pmc_nc_write_real_1d(ncid, aero_refract_shell_real, &
2649 "aero_refract_shell_real", (/ dimid_aero_particle /), &
2651 long_name=
"real part of the refractive indices of the " &
2652 //
"shell of each aerosol particle")
2653 call pmc_nc_write_real_1d(ncid, aero_refract_shell_imag, &
2654 "aero_refract_shell_imag", (/ dimid_aero_particle /), &
2656 long_name=
"imaginary part of the refractive indices of " &
2657 //
"the shell of each aerosol particle")
2658 call pmc_nc_write_real_1d(ncid, aero_refract_core_real, &
2659 "aero_refract_core_real", (/ dimid_aero_particle /), &
2661 long_name=
"real part of the refractive indices of the core " &
2662 //
"of each aerosol particle")
2663 call pmc_nc_write_real_1d(ncid, aero_refract_core_imag, &
2664 "aero_refract_core_imag", (/ dimid_aero_particle /), &
2666 long_name=
"imaginary part of the refractive indices of " &
2667 //
"the core of each aerosol particle")
2668 call pmc_nc_write_real_1d(ncid, aero_core_vol, &
2669 "aero_core_vol", (/ dimid_aero_particle /), unit=
"m^3", &
2670 long_name=
"volume of the optical cores of each " &
2671 //
"aerosol particle")
2677 if (record_removals)
then
2680 if (aero_info_array_n_item(aero_state%aero_info_array) >= 1)
then
2681 do i_remove = 1,aero_info_array_n_item(aero_state%aero_info_array)
2682 aero_removed_id(i_remove) = &
2683 aero_state%aero_info_array%aero_info(i_remove)%id
2684 aero_removed_action(i_remove) = &
2685 aero_state%aero_info_array%aero_info(i_remove)%action
2686 aero_removed_other_id(i_remove) = &
2687 aero_state%aero_info_array%aero_info(i_remove)%other_id
2690 aero_removed_id(1) = 0
2692 aero_removed_other_id(1) = 0
2694 call pmc_nc_write_integer_1d(ncid, aero_removed_id, &
2695 "aero_removed_id", (/ dimid_aero_removed /), &
2696 long_name=
"ID of removed particles")
2697 call pmc_nc_write_integer_1d(ncid, aero_removed_action, &
2698 "aero_removed_action", (/ dimid_aero_removed /), &
2699 long_name=
"reason for particle removal", &
2700 description=
"valid is 0 (invalid entry), 1 (removed due to " &
2701 //
"dilution), 2 (removed due to coagulation -- combined " &
2702 //
"particle ID is in \c aero_removed_other_id), 3 (removed " &
2703 //
"due to populating halving), or 4 (removed due to " &
2704 //
"weighting changes")
2705 call pmc_nc_write_integer_1d(ncid, aero_removed_other_id, &
2706 "aero_removed_other_id", (/ dimid_aero_removed /), &
2707 long_name=
"ID of other particle involved in removal", &
2708 description=
"if <tt>aero_removed_action(i)</tt> is 2 " &
2709 //
"(due to coagulation), then " &
2710 //
"<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2711 //
"resulting combined particle, or 0 if the new particle " &
2712 //
"was not created")
2715 end subroutine aero_state_output_netcdf
2787 integer,
intent(in) :: ncid
2791 integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
2792 integer :: i_bin, i_part_in_bin, i_part, i_remove, status
2794 character(len=1000) :: name
2797 integer,
allocatable :: aero_n_orig_part(:,:)
2798 integer,
allocatable :: aero_particle_weight_group(:)
2799 integer,
allocatable :: aero_particle_weight_class(:)
2800 real(kind=
dp),
allocatable :: aero_absorb_cross_sect(:)
2801 real(kind=
dp),
allocatable :: aero_scatter_cross_sect(:)
2802 real(kind=
dp),
allocatable :: aero_asymmetry(:)
2803 real(kind=
dp),
allocatable :: aero_refract_shell_real(:)
2804 real(kind=
dp),
allocatable :: aero_refract_shell_imag(:)
2805 real(kind=
dp),
allocatable :: aero_refract_core_real(:)
2806 real(kind=
dp),
allocatable :: aero_refract_core_imag(:)
2807 real(kind=
dp),
allocatable :: aero_core_vol(:)
2808 integer,
allocatable :: aero_water_hyst_leg(:)
2809 real(kind=
dp),
allocatable :: aero_num_conc(:)
2810 integer,
allocatable :: aero_id(:)
2811 real(kind=
dp),
allocatable :: aero_least_create_time(:)
2812 real(kind=
dp),
allocatable :: aero_greatest_create_time(:)
2813 integer,
allocatable :: aero_removed_id(:)
2814 integer,
allocatable :: aero_removed_action(:)
2815 integer,
allocatable :: aero_removed_other_id(:)
2819 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2820 if (status == nf90_ebaddim)
then
2825 call pmc_nc_check(status)
2826 call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
2830 "aero_particle_mass")
2831 call pmc_nc_read_integer_2d(ncid, aero_n_orig_part, &
2833 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_group, &
2834 "aero_particle_weight_group")
2835 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_class, &
2836 "aero_particle_weight_class")
2837 call pmc_nc_read_real_1d(ncid, aero_absorb_cross_sect, &
2838 "aero_absorb_cross_sect", must_be_present=.false.)
2839 call pmc_nc_read_real_1d(ncid, aero_scatter_cross_sect, &
2840 "aero_scatter_cross_sect", must_be_present=.false.)
2841 call pmc_nc_read_real_1d(ncid, aero_asymmetry, &
2842 "aero_asymmetry", must_be_present=.false.)
2843 call pmc_nc_read_real_1d(ncid, aero_refract_shell_real, &
2844 "aero_refract_shell_real", must_be_present=.false.)
2845 call pmc_nc_read_real_1d(ncid, aero_refract_shell_imag, &
2846 "aero_refract_shell_imag", must_be_present=.false.)
2847 call pmc_nc_read_real_1d(ncid, aero_refract_core_real, &
2848 "aero_refract_core_real", must_be_present=.false.)
2849 call pmc_nc_read_real_1d(ncid, aero_refract_core_imag, &
2850 "aero_refract_core_imag", must_be_present=.false.)
2851 call pmc_nc_read_real_1d(ncid, aero_core_vol, &
2852 "aero_core_vol", must_be_present=.false.)
2853 call pmc_nc_read_integer_1d(ncid, aero_water_hyst_leg, &
2854 "aero_water_hyst_leg")
2855 call pmc_nc_read_real_1d(ncid, aero_num_conc, &
2857 call pmc_nc_read_integer_1d(ncid, aero_id, &
2859 call pmc_nc_read_real_1d(ncid, aero_least_create_time, &
2860 "aero_least_create_time")
2861 call pmc_nc_read_real_1d(ncid, aero_greatest_create_time, &
2862 "aero_greatest_create_time")
2867 do i_part = 1,n_part
2869 aero_particle%n_orig_part = aero_n_orig_part(i_part, :)
2870 aero_particle%weight_group = aero_particle_weight_group(i_part)
2871 aero_particle%weight_class = aero_particle_weight_class(i_part)
2872 if (
size(aero_absorb_cross_sect) == n_part)
then
2873 aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part)
2875 if (
size(aero_scatter_cross_sect) == n_part)
then
2876 aero_particle%scatter_cross_sect = aero_scatter_cross_sect(i_part)
2878 if (
size(aero_asymmetry) == n_part)
then
2879 aero_particle%asymmetry = aero_asymmetry(i_part)
2881 if ((
size(aero_refract_shell_real) == n_part) &
2882 .and. (
size(aero_refract_shell_imag) == n_part))
then
2883 aero_particle%refract_shell = &
2884 cmplx(aero_refract_shell_real(i_part), &
2885 aero_refract_shell_imag(i_part), kind=
dc)
2887 if ((
size(aero_refract_core_real) == n_part) &
2888 .and. (
size(aero_refract_core_imag) == n_part))
then
2889 aero_particle%refract_core = cmplx(aero_refract_core_real(i_part), &
2890 aero_refract_core_imag(i_part), kind=
dc)
2892 if (
size(aero_core_vol) == n_part)
then
2893 aero_particle%core_vol = aero_core_vol(i_part)
2895 aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
2896 aero_particle%id = aero_id(i_part)
2897 aero_particle%least_create_time = aero_least_create_time(i_part)
2898 aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
2909 call pmc_nc_read_integer_1d(ncid, aero_removed_id, &
2910 "aero_removed_id", must_be_present=.false.)
2911 call pmc_nc_read_integer_1d(ncid, aero_removed_action, &
2912 "aero_removed_action", must_be_present=.false.)
2913 call pmc_nc_read_integer_1d(ncid, aero_removed_other_id, &
2914 "aero_removed_other_id", must_be_present=.false.)
2916 n_info_item =
size(aero_removed_id)
2917 if (n_info_item >= 1)
then
2918 if ((n_info_item > 1) &
2919 .or. ((n_info_item == 1) .and. (aero_removed_id(1) /= 0)))
then
2922 do i_remove = 1,n_info_item
2923 aero_state%aero_info_array%aero_info(i_remove)%id &
2924 = aero_removed_id(i_remove)
2925 aero_state%aero_info_array%aero_info(i_remove)%action &
2926 = aero_removed_action(i_remove)
2927 aero_state%aero_info_array%aero_info(i_remove)%other_id &
2928 = aero_removed_other_id(i_remove)
2945 type(
bin_grid_t),
optional,
intent(in) :: bin_grid
2947 logical,
optional,
intent(in) :: all_procs_same
2950 aero_data, aero_state%valid_sort,
size(aero_state%awa%weight, 1), &
2951 size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
2952 aero_state%valid_sort = .true.
2966 logical,
parameter :: continue_on_error = .false.
2970 if (aero_state%valid_sort)
then
2972 aero_data,
size(aero_state%awa%weight, 1), &
2973 size(aero_state%awa%weight, 2), continue_on_error)
2989 type(camp_core_t),
intent(in) :: camp_core
2991 select type( aero_rep => aero_data%aero_rep_ptr)
2992 type is(aero_rep_single_particle_t)
2994 call camp_core%initialize_update_object(aero_rep, &
2995 aero_state%update_number)
2997 call die_msg(927605681,
"Wrong aerosol representation type")