73 real(kind=dp),
allocatable :: n_part_ideal(:, :)
95 subroutine spec_file_read_aero_state_weighting_type(file, weighting_type, &
101 integer,
intent(out) :: weighting_type
104 real(kind=dp),
intent(out) :: exponent
106 character(len=SPEC_LINE_MAX_VAR_LEN) :: weighting_name
129 if (trim(weighting_name) ==
'flat')
then 131 elseif (trim(weighting_name) ==
'power')
then 134 elseif (trim(weighting_name) ==
'nummass')
then 136 elseif (trim(weighting_name) ==
'flat_source')
then 138 elseif (trim(weighting_name) ==
'power_source')
then 141 elseif (trim(weighting_name) ==
'nummass_source')
then 145 "Unknown weighting type: " // trim(weighting_name))
148 end subroutine spec_file_read_aero_state_weighting_type
160 aero_state_to%awa = aero_state_from%awa
175 integer,
intent(in) :: weight_type
178 real(kind=dp),
intent(in),
optional :: exponent
180 aero_state%valid_sort = .false.
181 select case(weight_type)
186 call assert_msg(656670336,
present(exponent), &
187 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
195 call assert_msg(102143848,
present(exponent), &
196 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
203 call die_msg(969076992,
"unknown weight_type: " &
218 real(kind=dp),
intent(in) :: n_part
220 integer :: n_group, n_class
224 if (
allocated(aero_state%n_part_ideal))
then 225 deallocate(aero_state%n_part_ideal)
227 allocate(aero_state%n_part_ideal(n_group, n_class))
228 aero_state%n_part_ideal = n_part /
real(n_group * n_class, kind=
dp)
240 integer,
intent(in) :: source
244 call assert(932390238, source >= 1)
247 if (n_class > 1)
then 248 call assert(765048788, source <= n_class)
264 integer,
optional,
intent(in) :: i_group
266 integer,
optional,
intent(in) :: i_class
270 if (
present(i_group))
then 271 call assert(908743823,
present(i_class))
272 if (aero_state%valid_sort)
then 275 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
280 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
282 (aero_state%apa%particle(i_part)%weight_class == i_class)) &
303 integer,
optional,
intent(in) :: i_group
305 integer,
optional,
intent(in) :: i_class
324 aero_state%valid_sort = .false.
342 logical,
optional,
intent(in) :: allow_resort
344 if (aero_state%valid_sort)
then 346 aero_particle, aero_data, allow_resort)
361 integer,
intent(in) :: i_part
363 if (aero_state%valid_sort)
then 365 aero_state%apa, i_part)
381 integer,
intent(in) :: i_part
395 record_removal, aero_info)
400 integer,
intent(in) :: i_part
402 logical,
intent(in) :: record_removal
406 if (record_removal)
then 420 i_bin, i_class, aero_particle)
425 integer,
intent(in) :: i_bin
427 integer,
intent(in) :: i_class
431 integer :: i_entry, i_part
433 call assert(742996300, aero_state%valid_sort)
435 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) > 0)
437 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)))
438 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
439 i_class)%entry(i_entry)
440 aero_particle = aero_state%apa%particle(i_part)
456 n_part_mean, random_weight_group)
463 integer,
intent(in) :: i_part
465 real(kind=dp),
intent(in) :: n_part_mean
468 logical,
optional,
intent(in) :: random_weight_group
470 integer :: n_copies, i_dup, new_group
475 if (n_copies == 0)
then 476 aero_info%id = aero_state%apa%particle(i_part)%id
478 aero_info%other_id = 0
481 elseif (n_copies > 1)
then 482 do i_dup = 1,(n_copies - 1)
483 new_aero_particle = aero_state%apa%particle(i_part)
485 if (
present(random_weight_group))
then 486 if (random_weight_group)
then 489 aero_state%apa%particle(i_part)%weight_class, &
506 aero_particle, aero_data)
533 real(kind=dp),
intent(out) &
539 reweight_num_conc(i_part) &
541 aero_state%apa%particle(i_part), aero_data)
566 real(kind=dp),
intent(in) &
569 integer :: i_part, i_group, i_class
570 real(kind=dp) :: n_part_old(size(aero_state%awa%weight, 1), &
571 size(aero_state%awa%weight, 2))
572 real(kind=dp) :: n_part_new(size(aero_state%awa%weight, 1), &
573 size(aero_state%awa%weight, 2))
574 real(kind=dp) :: old_num_conc, new_num_conc, n_part_mean
581 old_num_conc = reweight_num_conc(i_part)
583 aero_state%apa%particle(i_part), aero_data)
584 n_part_mean = old_num_conc / new_num_conc
585 i_group = aero_state%apa%particle(i_part)%weight_group
586 i_class = aero_state%apa%particle(i_part)%weight_class
587 n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
589 n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
594 do i_group = 1,
size(aero_state%awa%weight, 1)
595 do i_class = 1,
size(aero_state%awa%weight, 2)
596 if (n_part_old(i_group, i_class) == 0d0) cycle
598 n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
605 old_num_conc = reweight_num_conc(i_part)
608 aero_state%apa%particle(i_part), aero_data)
609 n_part_mean = old_num_conc / new_num_conc
621 subroutine aero_state_add(aero_state, aero_state_delta, aero_data)
649 integer :: i_part, i_bin
651 do i_part = 1,aero_state_delta%apa%n_part
653 aero_state_delta%apa%particle(i_part), aero_data)
656 aero_state_delta%aero_info_array)
666 i_group, i_class, n_add, allow_doubling, allow_halving)
673 integer,
intent(in) :: i_group
675 integer,
intent(in) :: i_class
677 real(kind=dp),
intent(in) :: n_add
679 logical,
intent(in) :: allow_doubling
681 logical,
intent(in) :: allow_halving
683 integer :: global_n_part, n_group, n_class
684 real(kind=dp) :: mean_n_part, n_part_new, weight_ratio
685 real(kind=dp) :: n_part_ideal_local_group
691 mean_n_part =
real(global_n_part, kind=dp) /
real(pmc_mpi_size(), kind=
dp)
692 n_part_new = mean_n_part + n_add
693 if (n_part_new == 0d0)
return 694 n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
695 /
real(pmc_mpi_size(), kind=
dp)
696 if ((n_part_new < n_part_ideal_local_group / 2d0) &
697 .or. (n_part_new > n_part_ideal_local_group * 2d0)) &
699 weight_ratio = n_part_new / n_part_ideal_local_group
701 i_class, weight_ratio, allow_doubling, allow_halving)
711 aero_dist, sample_prop, create_time, allow_doubling, allow_halving, &
721 real(kind=dp),
intent(in) :: sample_prop
723 real(kind=dp),
intent(in) :: create_time
725 logical,
intent(in) :: allow_doubling
727 logical,
intent(in) :: allow_halving
729 integer,
intent(out),
optional :: n_part_add
731 real(kind=dp) :: n_samp_avg, radius, total_vol
733 integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
736 n_group =
size(aero_state%awa%weight, 1)
737 n_class =
size(aero_state%awa%weight, 2)
738 if (
present(n_part_add))
then 741 do i_group = 1,n_group
744 aero_dist%mode(i_mode)%source)
747 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
748 aero_state%awa%weight(i_group, i_class))
750 i_group, i_class, n_samp_avg, allow_doubling, allow_halving)
751 if (n_samp_avg == 0d0) cycle
754 n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
755 aero_state%awa%weight(i_group, i_class))
757 if (
present(n_part_add))
then 758 n_part_add = n_part_add + n_samp
762 call aero_mode_sample_radius(aero_dist%mode(i_mode), aero_data, &
763 aero_state%awa%weight(i_group, i_class), radius)
765 call aero_mode_sample_vols(aero_dist%mode(i_mode), total_vol, &
772 aero_dist%mode(i_mode)%source)
788 integer,
intent(out) :: i_part
804 aero_data, sample_prob, removal_action)
813 real(kind=dp),
intent(in) :: sample_prob
816 integer,
intent(in) :: removal_action
818 integer :: n_transfer, i_transfer, i_part
819 logical :: do_add, do_remove
820 real(kind=dp) :: num_conc_from, num_conc_to
823 call assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
829 do while (i_transfer < n_transfer)
833 aero_state_from%apa%particle(i_part), aero_data)
835 aero_state_from%apa%particle(i_part), aero_data)
837 if (num_conc_to == num_conc_from)
then 840 elseif (num_conc_to < num_conc_from)
then 843 if (
pmc_random() < num_conc_to / num_conc_from)
then 848 if (
pmc_random() < num_conc_from / num_conc_to)
then 855 aero_state_from%apa%particle(i_part), aero_data)
859 aero_info%id = aero_state_from%apa%particle(i_part)%id
860 aero_info%action = removal_action
867 i_transfer = i_transfer + 1
879 aero_data, sample_prob, removal_action)
888 real(kind=dp),
intent(in) :: sample_prob
891 integer,
intent(in) :: removal_action
893 integer :: n_transfer, i_transfer, i_part
894 logical :: do_add, do_remove, overwrite_to
895 real(kind=dp) :: num_conc_from, num_conc_to
898 call assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
904 do i_transfer = 1,n_transfer
909 aero_state_from%apa%particle(i_part), aero_data)
911 aero_info%id = aero_state_from%apa%particle(i_part)%id
912 aero_info%action = removal_action
920 overwrite_to = .true.
922 sample_prob, overwrite_to)
941 integer :: i_part, i_bin
942 real(kind=dp) :: factor
944 aero_binned%num_conc = 0d0
945 aero_binned%vol_conc = 0d0
950 call warn_msg(980232449,
"particle ID " &
952 //
" outside of bin_grid, discarding")
955 aero_state%apa%particle(i_part), aero_data) &
956 / bin_grid%widths(i_bin)
957 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
958 + aero_state%apa%particle(i_part)%vol * factor
959 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
980 aero_state_ids(i_part) = aero_state%apa%particle(i_part)%id
995 character(len=*),
optional,
intent(in) :: include(:)
997 character(len=*),
optional,
intent(in) :: exclude(:)
1038 type(env_state_t),
intent(in) :: env_state
1041 real(kind=dp) :: aero_state_mobility_diameters( &
1042 aero_state_n_part(aero_state))
1046 do i_part = 1,aero_state_n_part(aero_state)
1047 aero_state_mobility_diameters(i_part) &
1049 aero_state%apa%particle(i_part), aero_data, env_state)
1068 type(
aero_data_t),
optional,
intent(in) :: aero_data
1070 character(len=*),
optional,
intent(in) :: include(:)
1072 character(len=*),
optional,
intent(in) :: exclude(:)
1077 logical,
allocatable :: use_species(:)
1078 integer :: i_name, i_spec
1080 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then 1084 call assert_msg(599558703,
present(aero_data), &
1085 "must provide 'aero_data' if using 'include' or 'exclude'")
1087 if (
present(include))
then 1088 use_species = .false.
1089 do i_name = 1,
size(include)
1092 "unknown species: " // trim(include(i_name)))
1093 use_species(i_spec) = .true.
1096 use_species = .true.
1098 if (
present(exclude))
then 1099 do i_name = 1,
size(exclude)
1102 "unknown species: " // trim(exclude(i_name)))
1103 use_species(i_spec) = .false.
1106 aero_state_volumes = 0d0
1108 if (use_species(i_spec))
then 1109 aero_state_volumes = aero_state_volumes &
1135 character(len=*),
optional,
intent(in) :: include(:)
1137 character(len=*),
optional,
intent(in) :: exclude(:)
1143 integer :: i_name, i_spec
1145 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then 1150 if (
present(include))
then 1151 use_species = .false.
1152 do i_name = 1,
size(include)
1155 "unknown species: " // trim(include(i_name)))
1156 use_species(i_spec) = .true.
1159 use_species = .true.
1161 if (
present(exclude))
then 1162 do i_name = 1,
size(exclude)
1165 "unknown species: " // trim(exclude(i_name)))
1166 use_species(i_spec) = .false.
1169 aero_state_masses = 0d0
1171 if (use_species(i_spec))
then 1172 aero_state_masses = aero_state_masses &
1198 aero_state_num_concs(i_part) &
1200 aero_state%apa%particle(i_part), aero_data)
1221 aero_state%apa%particle(i_part), aero_data)
1246 character(len=*),
optional :: include(:)
1248 character(len=*),
optional :: exclude(:)
1250 character(len=*),
optional :: group(:)
1257 integer :: i_name, i_spec, i_part
1258 real(kind=dp) :: group_mass, non_group_mass, mass
1260 if (
present(include))
then 1261 use_species = .false.
1262 do i_name = 1,
size(include)
1265 "unknown species: " // trim(include(i_name)))
1266 use_species(i_spec) = .true.
1269 use_species = .true.
1271 if (
present(exclude))
then 1272 do i_name = 1,
size(exclude)
1275 "unknown species: " // trim(exclude(i_name)))
1276 use_species(i_spec) = .false.
1279 if (
present(group))
then 1280 group_species = .false.
1281 do i_name = 1,
size(group)
1284 "unknown species: " // trim(group(i_name)))
1285 group_species(i_spec) = .true.
1289 non_group_mass = 0d0
1291 if (use_species(i_spec))
then 1293 aero_state%apa%particle(i_part), i_spec, aero_data)
1294 if (group_species(i_spec))
then 1295 group_mass = group_mass + mass
1297 non_group_mass = non_group_mass + mass
1301 aero_state_mass_entropies(i_part) &
1302 =
entropy([group_mass, non_group_mass])
1306 aero_state_mass_entropies(i_part) =
entropy(pack( &
1308 aero_data), use_species))
1327 d_gamma, chi, include, exclude, group)
1334 real(kind=dp),
intent(out) :: d_alpha
1336 real(kind=dp),
intent(out) :: d_gamma
1338 real(kind=dp),
intent(out) :: chi
1340 character(len=*),
optional :: include(:)
1342 character(len=*),
optional :: exclude(:)
1344 character(len=*),
optional :: group(:)
1346 real(kind=dp),
allocatable :: entropies(:), entropies_of_avg_part(:)
1347 real(kind=dp),
allocatable :: masses(:), num_concs(:), &
1348 num_concs_of_avg_part(:), masses_of_avg_part(:)
1356 include, exclude, group)
1358 d_alpha = exp(sum(entropies * masses * num_concs) &
1359 / sum(masses * num_concs))
1363 aero_state_averaged = aero_state
1369 aero_data, include, exclude)
1371 aero_data, include, exclude, group)
1373 d_gamma = exp(sum(entropies_of_avg_part * masses_of_avg_part &
1374 * num_concs_of_avg_part) &
1375 / sum(masses_of_avg_part * num_concs_of_avg_part))
1377 chi = (d_alpha - 1) / (d_gamma - 1)
1391 type(env_state_t),
intent(in) :: env_state
1400 aero_state_approx_crit_rel_humids(i_part) = &
1402 aero_state%apa%particle(i_part), aero_data, env_state)
1417 type(env_state_t),
intent(in) :: env_state
1426 aero_state%apa%particle(i_part), aero_data, env_state)
1446 integer :: i_part, i_bin
1447 real(kind=dp) :: factor
1449 aero_binned%num_conc = 0d0
1450 aero_binned%vol_conc = 0d0
1455 if ((i_bin < 1) .or. (i_bin >
bin_grid_size(bin_grid)))
then 1456 call warn_msg(503871022,
"particle ID " &
1458 //
" outside of bin_grid, discarding")
1461 aero_state%apa%particle(i_part), aero_data) &
1462 / bin_grid%widths(i_bin)
1463 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1464 + aero_state%apa%particle(i_part)%vol * factor
1465 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1482 integer,
intent(in) :: i_group
1484 integer,
intent(in) :: i_class
1490 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1491 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1493 aero_particle = aero_state%apa%particle(i_part)
1498 aero_state%valid_sort = .false.
1511 integer,
intent(in) :: i_group
1513 integer,
intent(in) :: i_class
1519 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1520 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1523 aero_info%id = aero_state%apa%particle(i_part)%id
1540 allow_halving, initial_state_warning)
1547 logical,
intent(in) :: allow_doubling
1549 logical,
intent(in) :: allow_halving
1551 logical,
intent(in) :: initial_state_warning
1553 integer :: i_group, i_class, n_group, n_class, global_n_part
1555 n_group =
size(aero_state%awa%weight, 1)
1556 n_class =
size(aero_state%awa%weight, 2)
1560 if (allow_doubling)
then 1561 do i_group = 1,n_group
1562 do i_class = 1,n_class
1566 do while ((
real(global_n_part, kind=dp) &
1567 < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1568 .and. (global_n_part > 0))
1569 if (initial_state_warning)
then 1570 call warn_msg(716882783,
"doubling particles in initial " &
1583 if (allow_halving)
then 1584 do i_group = 1,n_group
1585 do i_class = 1,n_class
1586 do while (
real(aero_state_total_particles_all_procs(aero_state, &
i_group, i_class), kind=dp) &
1587 > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1588 if (initial_state_warning)
then 1590 "halving particles in initial condition")
1606 i_class, weight_ratio, allow_doubling, allow_halving)
1613 integer,
intent(in) :: i_group
1615 integer,
intent(in) :: i_class
1617 real(kind=dp),
intent(in) :: weight_ratio
1619 logical,
intent(in) :: allow_doubling
1621 logical,
intent(in) :: allow_halving
1623 real(kind=dp) :: ratio
1624 integer :: i_part, i_remove, n_remove, i_entry, n_part
1633 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
1635 if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0)))
then 1638 n_remove =
prob_round(
real(n_part, kind=dp) &
1639 * (1d0 - 1d0 / weight_ratio))
1640 do i_remove = 1,n_remove
1642 aero_state%aero_sorted%group_class%inverse(i_group, i_class)))
1643 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1644 i_class)%entry(i_entry)
1645 aero_info%id = aero_state%apa%particle(i_part)%id
1650 elseif ((weight_ratio < 1d0) &
1651 .and. (allow_doubling .or. (n_part == 0)))
then 1654 do i_entry = n_part,1,-1
1655 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1656 i_class)%entry(i_entry)
1669 aero_data, specify_prob_transfer)
1674 real(kind=dp),
intent(in) :: del_t
1676 real(kind=dp),
intent(in) :: mix_timescale
1681 real(kind=dp),
optional,
intent(in) :: specify_prob_transfer
1684 integer :: rank, n_proc, i_proc, ierr
1685 integer :: buffer_size, buffer_size_check
1686 character,
allocatable :: buffer(:)
1689 real(kind=dp) :: prob_transfer, prob_not_transferred
1690 real(kind=dp) :: prob_transfer_given_not_transferred
1695 if (n_proc == 1)
then 1702 allocate(aero_state_sends(n_proc))
1703 allocate(aero_state_recvs(n_proc))
1706 if (
present(specify_prob_transfer))
then 1707 prob_transfer = specify_prob_transfer /
real(n_proc, kind=
dp)
1709 prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1710 /
real(n_proc, kind=
dp)
1714 prob_not_transferred = 1d0
1715 do i_proc = 0,(n_proc - 1)
1716 if (i_proc /= rank)
then 1721 prob_transfer_given_not_transferred = prob_transfer &
1722 / prob_not_transferred
1724 aero_state_sends(i_proc + 1), aero_data, &
1726 prob_not_transferred = prob_not_transferred - prob_transfer
1734 do i_proc = 0,(n_proc - 1)
1735 if (i_proc /= rank)
then 1742 deallocate(aero_state_sends)
1743 deallocate(aero_state_recvs)
1761 character,
allocatable :: sendbuf(:), recvbuf(:)
1762 integer :: sendcounts(size(send)), sdispls(size(send))
1763 integer :: recvcounts(size(send)), rdispls(size(send))
1764 integer :: i_proc, position, old_position, max_sendbuf_size, ierr
1768 max_sendbuf_size = 0
1771 max_sendbuf_size = max_sendbuf_size &
1776 allocate(sendbuf(max_sendbuf_size))
1780 old_position = position
1784 sendcounts(i_proc) = position - old_position
1786 call assert(393267406, position <= max_sendbuf_size)
1789 allocate(recvbuf(sum(recvcounts)))
1794 sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
1795 rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
1798 call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
1799 recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
1804 call assert(189739257, position == rdispls(i_proc))
1805 if (recvcounts(i_proc) > 0)
then 1832 real(kind=dp) :: total_volume_conc, particle_volume, num_conc
1833 integer :: i_bin, i_class, i_entry, i_part, i_spec
1838 species_volume_conc = 0d0
1839 total_volume_conc = 0d0
1840 do i_class = 1,
size(aero_state%awa%weight, 2)
1842 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1843 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1844 i_class)%entry(i_entry)
1846 aero_state%apa%particle(i_part), aero_data)
1848 aero_state%apa%particle(i_part))
1849 species_volume_conc = species_volume_conc &
1850 + num_conc * aero_state%apa%particle(i_part)%vol
1851 total_volume_conc = total_volume_conc + num_conc * particle_volume
1854 do i_class = 1,
size(aero_state%awa%weight, 2)
1856 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1857 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1858 i_class)%entry(i_entry)
1860 aero_state%apa%particle(i_part))
1861 aero_state%apa%particle(i_part)%vol &
1862 = particle_volume * species_volume_conc / total_volume_conc
1886 bin_center, preserve_number)
1896 logical,
intent(in) :: bin_center
1900 logical,
intent(in) :: preserve_number
1902 real(kind=dp) :: total_volume_conc, particle_volume
1903 real(kind=dp) :: new_particle_volume, num_conc, total_num_conc
1904 real(kind=dp) :: lower_volume, upper_volume, center_volume
1905 real(kind=dp) :: lower_function, upper_function, center_function
1906 integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
1907 logical :: monotone_increasing, monotone_decreasing
1912 do i_class = 1,
size(aero_state%awa%weight, 2)
1914 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) &
1920 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1921 total_num_conc = 0d0
1922 total_volume_conc = 0d0
1924 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1925 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1926 i_class)%entry(i_entry)
1928 aero_state%apa%particle(i_part), aero_data)
1929 total_num_conc = total_num_conc + num_conc
1931 aero_state%apa%particle(i_part))
1932 total_volume_conc = total_volume_conc &
1933 + num_conc * particle_volume
1937 if (bin_center)
then 1939 bin_grid%centers(i_bin))
1944 new_particle_volume = total_volume_conc / num_conc &
1945 /
real(integer_varray_n_entry( &
aero_state%aero_sorted%size_class%inverse(i_bin, i_class)), &
1947 elseif (preserve_number)
then 1958 monotone_increasing, monotone_decreasing)
1960 monotone_increasing .or. monotone_decreasing, &
1961 "monotone weight function required for averaging")
1964 do i_entry = 1,n_part
1965 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1966 i_class)%entry(i_entry)
1968 aero_state%apa%particle(i_part))
1969 if (i_part == 1)
then 1970 lower_volume = particle_volume
1971 upper_volume = particle_volume
1973 lower_volume = min(lower_volume, particle_volume)
1974 upper_volume = max(upper_volume, particle_volume)
1977 lower_function =
real(n_part, kind=dp) &
1978 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1979 i_class, aero_data_vol2rad(aero_data, lower_volume)) &
1981 upper_function =
real(n_part, kind=dp) &
1982 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1983 i_class, aero_data_vol2rad(aero_data, upper_volume)) &
1988 center_volume = (lower_volume + upper_volume) / 2d0
1989 center_function =
real(n_part, kind=dp) &
1990 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1991 i_class, aero_data_vol2rad(aero_data, center_volume)) &
1993 if ((lower_function > 0d0 .and. center_function > 0d0) &
1994 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1996 lower_volume = center_volume
1997 lower_function = center_function
1999 upper_volume = center_volume
2000 upper_function = center_function
2004 new_particle_volume = center_volume
2016 monotone_increasing, monotone_decreasing)
2018 monotone_increasing .or. monotone_decreasing, &
2019 "monotone weight function required for averaging")
2022 do i_entry = 1,n_part
2023 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2024 i_class)%entry(i_entry)
2026 aero_state%apa%particle(i_part))
2027 if (i_part == 1)
then 2028 lower_volume = particle_volume
2029 upper_volume = particle_volume
2031 lower_volume = min(lower_volume, particle_volume)
2032 upper_volume = max(upper_volume, particle_volume)
2035 lower_function =
real(n_part, kind=dp) &
2036 * aero_weight_array_num_conc_at_radius( &
2037 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2038 lower_volume)) * lower_volume - total_volume_conc
2039 upper_function =
real(n_part, kind=dp) &
2040 * aero_weight_array_num_conc_at_radius( &
2041 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2042 upper_volume)) * upper_volume - total_volume_conc
2046 center_volume = (lower_volume + upper_volume) / 2d0
2047 center_function =
real(n_part, kind=dp) &
2048 * aero_weight_array_num_conc_at_radius( &
2049 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2050 center_volume)) * center_volume - total_volume_conc
2051 if ((lower_function > 0d0 .and. center_function > 0d0) &
2052 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2054 lower_volume = center_volume
2055 lower_function = center_function
2057 upper_volume = center_volume
2058 upper_function = center_function
2062 new_particle_volume = center_volume
2065 do i_entry = 1,n_part
2066 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2067 i_class)%entry(i_entry)
2069 aero_state%apa%particle(i_part))
2070 aero_state%apa%particle(i_part)%vol &
2071 = aero_state%apa%particle(i_part)%vol &
2072 / particle_volume * new_particle_volume
2090 real(kind=dp) :: reweight_num_conc(aero_state%apa%n_part)
2093 aero_state%valid_sort = .false.
2097 if (aero_data%i_water > 0)
then 2099 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
2101 aero_state%valid_sort = .false.
2116 integer :: total_size, i_group
2133 character,
intent(inout) :: buffer(:)
2135 integer,
intent(inout) :: position
2140 integer :: prev_position, i_group
2142 prev_position = position
2159 character,
intent(inout) :: buffer(:)
2161 integer,
intent(inout) :: position
2166 integer :: prev_position, i_group, n_group
2168 val%valid_sort = .false.
2169 prev_position = position
2194 integer :: n_proc, ierr, status(mpi_status_size)
2195 integer :: buffer_size, max_buffer_size, i_proc, position
2196 character,
allocatable :: buffer(:)
2200 aero_state_total = aero_state
2208 max_buffer_size = max_buffer_size &
2210 allocate(buffer(max_buffer_size))
2213 call assert(542772170, position <= max_buffer_size)
2214 buffer_size = position
2215 call mpi_send(buffer, buffer_size, mpi_character, 0, &
2222 do i_proc = 1,(n_proc - 1)
2227 call mpi_get_count(status, mpi_character, buffer_size, ierr)
2231 allocate(buffer(buffer_size))
2232 call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2238 aero_state_transfer)
2239 call assert(518174881, position == buffer_size)
2257 dimid_aero_particle)
2262 integer,
intent(in) :: ncid
2264 integer,
intent(out) :: dimid_aero_particle
2266 integer :: status, i_part
2267 integer :: varid_aero_particle
2271 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2272 if (status == nf90_noerr)
return 2273 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2276 call pmc_nc_check(nf90_redef(ncid))
2278 call pmc_nc_check(nf90_def_dim(ncid,
"aero_particle", &
2281 call pmc_nc_check(nf90_enddef(ncid))
2284 aero_particle_centers(i_part) = i_part
2286 call pmc_nc_write_integer_1d(ncid, aero_particle_centers, &
2287 "aero_particle", (/ dimid_aero_particle /), &
2288 description=
"dummy dimension variable (no useful value)")
2303 integer,
intent(in) :: ncid
2305 integer,
intent(out) :: dimid_aero_removed
2307 integer :: status, i_remove, dim_size
2308 integer :: varid_aero_removed
2309 integer :: aero_removed_centers( &
2313 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2314 if (status == nf90_noerr)
return 2315 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2318 call pmc_nc_check(nf90_redef(ncid))
2321 call pmc_nc_check(nf90_def_dim(ncid,
"aero_removed", &
2322 dim_size, dimid_aero_removed))
2324 call pmc_nc_check(nf90_enddef(ncid))
2326 do i_remove = 1,dim_size
2327 aero_removed_centers(i_remove) = i_remove
2329 call pmc_nc_write_integer_1d(ncid, aero_removed_centers, &
2330 "aero_removed", (/ dimid_aero_removed /), &
2331 description=
"dummy dimension variable (no useful value)")
2338 subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2339 record_removals, record_optical)
2344 integer,
intent(in) :: ncid
2348 logical,
intent(in) :: record_removals
2350 logical,
intent(in) :: record_optical
2352 integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2353 integer :: dimid_aero_removed
2354 integer :: i_part, i_remove
2356 aero_data_n_spec(aero_data))
2358 aero_data_n_source(aero_data))
2374 integer :: aero_removed_id( &
2376 integer :: aero_removed_action( &
2378 integer :: aero_removed_other_id( &
2474 call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2483 dimid_aero_particle)
2486 aero_particle_mass(i_part, :) &
2487 = aero_state%apa%particle(i_part)%vol * aero_data%density
2488 aero_n_orig_part(i_part, :) &
2489 = aero_state%apa%particle(i_part)%n_orig_part
2490 aero_particle_weight_group(i_part) &
2491 = aero_state%apa%particle(i_part)%weight_group
2492 aero_particle_weight_class(i_part) &
2493 = aero_state%apa%particle(i_part)%weight_class
2494 aero_water_hyst_leg(i_part) &
2495 = aero_state%apa%particle(i_part)%water_hyst_leg
2496 aero_num_conc(i_part) &
2498 aero_state%apa%particle(i_part), aero_data)
2499 aero_id(i_part) = aero_state%apa%particle(i_part)%id
2500 aero_least_create_time(i_part) &
2501 = aero_state%apa%particle(i_part)%least_create_time
2502 aero_greatest_create_time(i_part) &
2503 = aero_state%apa%particle(i_part)%greatest_create_time
2504 if (record_optical)
then 2505 aero_absorb_cross_sect(i_part) &
2506 = aero_state%apa%particle(i_part)%absorb_cross_sect
2507 aero_scatter_cross_sect(i_part) &
2508 = aero_state%apa%particle(i_part)%scatter_cross_sect
2509 aero_asymmetry(i_part) = aero_state%apa%particle(i_part)%asymmetry
2510 aero_refract_shell_real(i_part) &
2511 =
real(aero_state%apa%particle(i_part)%refract_shell)
2512 aero_refract_shell_imag(i_part) &
2513 = aimag(aero_state%apa%particle(i_part)%refract_shell)
2514 aero_refract_core_real(i_part) &
2515 =
real(aero_state%apa%particle(i_part)%refract_core)
2516 aero_refract_core_imag(i_part) &
2517 = aimag(aero_state%apa%particle(i_part)%refract_core)
2518 aero_core_vol(i_part) = aero_state%apa%particle(i_part)%core_vol
2521 call pmc_nc_write_real_2d(ncid, aero_particle_mass, &
2522 "aero_particle_mass", (/ dimid_aero_particle, &
2523 dimid_aero_species /), unit=
"kg", &
2524 long_name=
"constituent masses of each aerosol particle")
2525 call pmc_nc_write_integer_2d(ncid, aero_n_orig_part, &
2526 "aero_n_orig_part", (/ dimid_aero_particle, &
2527 dimid_aero_source /), &
2528 long_name=
"number of original constituent particles from " &
2529 //
"each source that coagulated to form each aerosol particle")
2530 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_group, &
2531 "aero_particle_weight_group", (/ dimid_aero_particle /), &
2532 long_name=
"weight group number of each aerosol particle")
2533 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_class, &
2534 "aero_particle_weight_class", (/ dimid_aero_particle /), &
2535 long_name=
"weight class number of each aerosol particle")
2536 call pmc_nc_write_integer_1d(ncid, aero_water_hyst_leg, &
2537 "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2538 long_name=
"leg of the water hysteresis curve leg of each "&
2539 //
"aerosol particle")
2540 call pmc_nc_write_real_1d(ncid, aero_num_conc, &
2541 "aero_num_conc", (/ dimid_aero_particle /), unit=
"m^{-3}", &
2542 long_name=
"number concentration for each particle")
2543 call pmc_nc_write_integer_1d(ncid, aero_id, &
2544 "aero_id", (/ dimid_aero_particle /), &
2545 long_name=
"unique ID number of each aerosol particle")
2546 call pmc_nc_write_real_1d(ncid, aero_least_create_time, &
2547 "aero_least_create_time", (/ dimid_aero_particle /), unit=
"s", &
2548 long_name=
"least creation time of each aerosol particle", &
2549 description=
"least (earliest) creation time of any original " &
2550 //
"constituent particles that coagulated to form each " &
2551 //
"particle, measured from the start of the simulation")
2552 call pmc_nc_write_real_1d(ncid, aero_greatest_create_time, &
2553 "aero_greatest_create_time", (/ dimid_aero_particle /), &
2555 long_name=
"greatest creation time of each aerosol particle", &
2556 description=
"greatest (latest) creation time of any original " &
2557 //
"constituent particles that coagulated to form each " &
2558 //
"particle, measured from the start of the simulation")
2559 if (record_optical)
then 2560 call pmc_nc_write_real_1d(ncid, aero_absorb_cross_sect, &
2561 "aero_absorb_cross_sect", (/ dimid_aero_particle /), &
2563 long_name=
"optical absorption cross sections of each " &
2564 //
"aerosol particle")
2565 call pmc_nc_write_real_1d(ncid, aero_scatter_cross_sect, &
2566 "aero_scatter_cross_sect", (/ dimid_aero_particle /), &
2568 long_name=
"optical scattering cross sections of each " &
2569 //
"aerosol particle")
2570 call pmc_nc_write_real_1d(ncid, aero_asymmetry, &
2571 "aero_asymmetry", (/ dimid_aero_particle /), unit=
"1", &
2572 long_name=
"optical asymmetry parameters of each " &
2573 //
"aerosol particle")
2574 call pmc_nc_write_real_1d(ncid, aero_refract_shell_real, &
2575 "aero_refract_shell_real", (/ dimid_aero_particle /), &
2577 long_name=
"real part of the refractive indices of the " &
2578 //
"shell of each aerosol particle")
2579 call pmc_nc_write_real_1d(ncid, aero_refract_shell_imag, &
2580 "aero_refract_shell_imag", (/ dimid_aero_particle /), &
2582 long_name=
"imaginary part of the refractive indices of " &
2583 //
"the shell of each aerosol particle")
2584 call pmc_nc_write_real_1d(ncid, aero_refract_core_real, &
2585 "aero_refract_core_real", (/ dimid_aero_particle /), &
2587 long_name=
"real part of the refractive indices of the core " &
2588 //
"of each aerosol particle")
2589 call pmc_nc_write_real_1d(ncid, aero_refract_core_imag, &
2590 "aero_refract_core_imag", (/ dimid_aero_particle /), &
2592 long_name=
"imaginary part of the refractive indices of " &
2593 //
"the core of each aerosol particle")
2594 call pmc_nc_write_real_1d(ncid, aero_core_vol, &
2595 "aero_core_vol", (/ dimid_aero_particle /), unit=
"m^3", &
2596 long_name=
"volume of the optical cores of each " &
2597 //
"aerosol particle")
2603 if (record_removals)
then 2608 aero_removed_id(i_remove) = &
2609 aero_state%aero_info_array%aero_info(i_remove)%id
2610 aero_removed_action(i_remove) = &
2611 aero_state%aero_info_array%aero_info(i_remove)%action
2612 aero_removed_other_id(i_remove) = &
2613 aero_state%aero_info_array%aero_info(i_remove)%other_id
2616 aero_removed_id(1) = 0
2618 aero_removed_other_id(1) = 0
2620 call pmc_nc_write_integer_1d(ncid, aero_removed_id, &
2621 "aero_removed_id", (/ dimid_aero_removed /), &
2622 long_name=
"ID of removed particles")
2623 call pmc_nc_write_integer_1d(ncid, aero_removed_action, &
2624 "aero_removed_action", (/ dimid_aero_removed /), &
2625 long_name=
"reason for particle removal", &
2626 description=
"valid is 0 (invalid entry), 1 (removed due to " &
2627 //
"dilution), 2 (removed due to coagulation -- combined " &
2628 //
"particle ID is in \c aero_removed_other_id), 3 (removed " &
2629 //
"due to populating halving), or 4 (removed due to " &
2630 //
"weighting changes")
2631 call pmc_nc_write_integer_1d(ncid, aero_removed_other_id, &
2632 "aero_removed_other_id", (/ dimid_aero_removed /), &
2633 long_name=
"ID of other particle involved in removal", &
2634 description=
"if <tt>aero_removed_action(i)</tt> is 2 " &
2635 //
"(due to coagulation), then " &
2636 //
"<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2637 //
"resulting combined particle, or 0 if the new particle " &
2638 //
"was not created")
2641 end subroutine aero_state_output_netcdf
2713 integer,
intent(in) :: ncid
2717 integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
2718 integer :: i_bin, i_part_in_bin, i_part, i_remove, status
2720 character(len=1000) :: name
2722 real(kind=dp),
allocatable :: aero_particle_mass(:,:)
2723 integer,
allocatable :: aero_n_orig_part(:,:)
2724 integer,
allocatable :: aero_particle_weight_group(:)
2725 integer,
allocatable :: aero_particle_weight_class(:)
2726 real(kind=dp),
allocatable :: aero_absorb_cross_sect(:)
2727 real(kind=dp),
allocatable :: aero_scatter_cross_sect(:)
2728 real(kind=dp),
allocatable :: aero_asymmetry(:)
2729 real(kind=dp),
allocatable :: aero_refract_shell_real(:)
2730 real(kind=dp),
allocatable :: aero_refract_shell_imag(:)
2731 real(kind=dp),
allocatable :: aero_refract_core_real(:)
2732 real(kind=dp),
allocatable :: aero_refract_core_imag(:)
2733 real(kind=dp),
allocatable :: aero_core_vol(:)
2734 integer,
allocatable :: aero_water_hyst_leg(:)
2735 real(kind=dp),
allocatable :: aero_num_conc(:)
2736 integer,
allocatable :: aero_id(:)
2737 real(kind=dp),
allocatable :: aero_least_create_time(:)
2738 real(kind=dp),
allocatable :: aero_greatest_create_time(:)
2739 integer,
allocatable :: aero_removed_id(:)
2740 integer,
allocatable :: aero_removed_action(:)
2741 integer,
allocatable :: aero_removed_other_id(:)
2745 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2746 if (status == nf90_ebaddim)
then 2751 call pmc_nc_check(status)
2752 call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
2755 call pmc_nc_read_real_2d(ncid, aero_particle_mass, &
2756 "aero_particle_mass")
2757 call pmc_nc_read_integer_2d(ncid, aero_n_orig_part, &
2759 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_group, &
2760 "aero_particle_weight_group")
2761 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_class, &
2762 "aero_particle_weight_class")
2763 call pmc_nc_read_real_1d(ncid, aero_absorb_cross_sect, &
2764 "aero_absorb_cross_sect", must_be_present=.false.)
2765 call pmc_nc_read_real_1d(ncid, aero_scatter_cross_sect, &
2766 "aero_scatter_cross_sect", must_be_present=.false.)
2767 call pmc_nc_read_real_1d(ncid, aero_asymmetry, &
2768 "aero_asymmetry", must_be_present=.false.)
2769 call pmc_nc_read_real_1d(ncid, aero_refract_shell_real, &
2770 "aero_refract_shell_real", must_be_present=.false.)
2771 call pmc_nc_read_real_1d(ncid, aero_refract_shell_imag, &
2772 "aero_refract_shell_imag", must_be_present=.false.)
2773 call pmc_nc_read_real_1d(ncid, aero_refract_core_real, &
2774 "aero_refract_core_real", must_be_present=.false.)
2775 call pmc_nc_read_real_1d(ncid, aero_refract_core_imag, &
2776 "aero_refract_core_imag", must_be_present=.false.)
2777 call pmc_nc_read_real_1d(ncid, aero_core_vol, &
2778 "aero_core_vol", must_be_present=.false.)
2779 call pmc_nc_read_integer_1d(ncid, aero_water_hyst_leg, &
2780 "aero_water_hyst_leg")
2781 call pmc_nc_read_real_1d(ncid, aero_num_conc, &
2783 call pmc_nc_read_integer_1d(ncid, aero_id, &
2785 call pmc_nc_read_real_1d(ncid, aero_least_create_time, &
2786 "aero_least_create_time")
2787 call pmc_nc_read_real_1d(ncid, aero_greatest_create_time, &
2788 "aero_greatest_create_time")
2793 do i_part = 1,n_part
2794 aero_particle%vol = aero_particle_mass(i_part, :) / aero_data%density
2795 aero_particle%n_orig_part = aero_n_orig_part(i_part, :)
2796 aero_particle%weight_group = aero_particle_weight_group(i_part)
2797 aero_particle%weight_class = aero_particle_weight_class(i_part)
2798 if (
size(aero_absorb_cross_sect) == n_part)
then 2799 aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part)
2801 if (
size(aero_scatter_cross_sect) == n_part)
then 2802 aero_particle%scatter_cross_sect = aero_scatter_cross_sect(i_part)
2804 if (
size(aero_asymmetry) == n_part)
then 2805 aero_particle%asymmetry = aero_asymmetry(i_part)
2807 if ((
size(aero_refract_shell_real) == n_part) &
2808 .and. (
size(aero_refract_shell_imag) == n_part))
then 2809 aero_particle%refract_shell = &
2810 cmplx(aero_refract_shell_real(i_part), &
2811 aero_refract_shell_imag(i_part), kind=
dc)
2813 if ((
size(aero_refract_core_real) == n_part) &
2814 .and. (
size(aero_refract_core_imag) == n_part))
then 2815 aero_particle%refract_core = cmplx(aero_refract_core_real(i_part), &
2816 aero_refract_core_imag(i_part), kind=
dc)
2818 if (
size(aero_core_vol) == n_part)
then 2819 aero_particle%core_vol = aero_core_vol(i_part)
2821 aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
2822 aero_particle%id = aero_id(i_part)
2823 aero_particle%least_create_time = aero_least_create_time(i_part)
2824 aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
2833 call pmc_nc_read_integer_1d(ncid, aero_removed_id, &
2834 "aero_removed_id", must_be_present=.false.)
2835 call pmc_nc_read_integer_1d(ncid, aero_removed_action, &
2836 "aero_removed_action", must_be_present=.false.)
2837 call pmc_nc_read_integer_1d(ncid, aero_removed_other_id, &
2838 "aero_removed_other_id", must_be_present=.false.)
2840 n_info_item =
size(aero_removed_id)
2841 if (n_info_item >= 1)
then 2842 if ((n_info_item > 1) &
2843 .or. ((n_info_item == 1) .and. (aero_removed_id(1) /= 0)))
then 2846 do i_remove = 1,n_info_item
2847 aero_state%aero_info_array%aero_info(i_remove)%id &
2848 = aero_removed_id(i_remove)
2849 aero_state%aero_info_array%aero_info(i_remove)%action &
2850 = aero_removed_action(i_remove)
2851 aero_state%aero_info_array%aero_info(i_remove)%other_id &
2852 = aero_removed_other_id(i_remove)
2862 subroutine aero_state_sort(aero_state, aero_data, bin_grid, all_procs_same)
2869 type(
bin_grid_t),
optional,
intent(in) :: bin_grid
2871 logical,
optional,
intent(in) :: all_procs_same
2874 aero_data, aero_state%valid_sort,
size(aero_state%awa%weight, 1), &
2875 size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
2876 aero_state%valid_sort = .true.
2890 logical,
parameter :: continue_on_error = .false.
2894 if (aero_state%valid_sort)
then 2896 aero_data,
size(aero_state%awa%weight, 1), &
2897 size(aero_state%awa%weight, 2), continue_on_error)
2905 subroutine aero_state_add_particles(aero_state, aero_state_delta, aero_data)
aero_state += aero_state_delta, with the weight of aero_state left unchanged, so the new concentratio...
subroutine aero_state_sample(aero_state_from, aero_state_to, aero_data, sample_prob, removal_action)
Generates a random sample by removing particles from aero_state_from and adding them to aero_state_to...
integer, parameter aero_info_halved
Particle was removed due to halving of the aerosol population.
subroutine aero_state_input_netcdf(aero_state, ncid, aero_data)
Read full state.
elemental real(kind=dp) function aero_particle_radius(aero_particle, aero_data)
Total radius of the particle (m).
subroutine aero_state_halve(aero_state, i_group, i_class)
Remove approximately half of the particles in the given weight group.
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
subroutine aero_state_prepare_weight_for_add(aero_state, aero_data, i_group, i_class, n_add, allow_doubling, allow_halving)
Change the weight if necessary to ensure that the addition of about n_add computational particles wil...
integer function aero_state_total_particles_all_procs(aero_state, i_group, i_class)
Returns the total number of particles across all processes.
real(kind=dp) function aero_weight_array_single_num_conc(aero_weight_array, aero_particle, aero_data)
Compute the number concentration for a particle (m^{-3}).
subroutine aero_state_netcdf_dim_aero_particle(aero_state, ncid, dimid_aero_particle)
Write the aero particle dimension to the given NetCDF file if it is not already present and in any ca...
subroutine aero_state_to_binned_dry(bin_grid, aero_data, aero_state, aero_binned)
Does the same thing as aero_state_to_bin() but based on dry radius.
real(kind=dp) function entropy(p)
Compute the entropy of a probability mass function (non necessarily normalized).
elemental real(kind=dp) function aero_particle_mass(aero_particle, aero_data)
Total mass of the particle (kg).
subroutine aero_weight_array_check_monotonicity(aero_weight_array, monotone_increasing, monotone_decreasing)
Determine whether all weight functions in an array are monotone increasing, monotone decreasing...
subroutine aero_state_mix(aero_state, del_t, mix_timescale, aero_data, specify_prob_transfer)
Mix the aero_states between all processes. Currently uses a simple all-to-all diffusion.
integer, parameter aero_info_weight
Particle was removed due to adjustments in the particle's weighting function.
subroutine aero_state_scale_weight(aero_state, aero_data, i_group, i_class, weight_ratio, allow_doubling, allow_halving)
Scale the weighting of the given group/class by the given ratio, altering particle number as necessar...
Random number generators.
An input file with extra data for printing messages.
integer function rand_poisson(mean)
Generate a Poisson-distributed random number with the given mean.
elemental integer function aero_particle_array_n_part(aero_particle_array)
Return the current number of particles.
subroutine aero_state_sort(aero_state, aero_data, bin_grid, all_procs_same)
Sorts the particles if necessary.
real(kind=dp) function aero_particle_solute_radius(aero_particle, aero_data)
Returns the total solute radius (m).
real(kind=dp) function, dimension( aero_state_n_part(aero_state)) aero_state_mobility_diameters(aero_state, aero_data, env_state)
Returns the mobility diameters of all particles.
1-D array of particles, used by aero_state to store the particles.
elemental integer function aero_info_array_n_item(aero_info_array)
Return the current number of items.
real(kind=dp) function aero_particle_mobility_diameter(aero_particle, aero_data, env_state)
Mobility diameter of the particle (m).
subroutine aero_state_rand_particle(aero_state, i_part)
Choose a random particle from the aero_state.
subroutine aero_particle_set_source(aero_particle, i_source)
Sets the aerosol particle source.
integer, parameter aero_state_weight_flat_source
Flat weighting by source.
subroutine aero_state_dup_particle(aero_state, aero_data, i_part, n_part_mean, random_weight_group)
Add copies or remove a particle, with a given mean number of resulting particles. ...
integer function pmc_mpi_rank()
Returns the rank of the current process.
The aero_weight_array_t structure and associated subroutines.
subroutine pmc_mpi_alltoall_integer(send, recv)
Does an all-to-all transfer of integers.
integer function pmc_mpi_pack_size_apa(val)
Determines the number of bytes required to pack the given value.
subroutine aero_info_array_add_aero_info(aero_info_array, aero_info)
Adds the given aero_info to the end of the array.
subroutine aero_state_rebalance(aero_state, aero_data, allow_doubling, allow_halving, initial_state_warning)
Double or halve the particle population in each weight group to maintain close to n_part_ideal partic...
subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, aero_data, valid_sort, n_group, n_class, bin_grid, all_procs_same)
Remake a sorting if particles are getting too close to the edges.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_diameters(aero_state, aero_data, include, exclude)
Returns the diameters of all particles.
real(kind=dp) elemental function sphere_vol2rad(v)
Convert mass-equivalent volume (m^3) to geometric radius (m) for spherical particles.
subroutine aero_weight_array_set_nummass(aero_weight_array, n_class)
Allocates an aero_weight_array as joint flat/power-3 weightings..
integer, parameter aero_state_tag_scatter
MPI tag for scattering between processes.
The bin_grid_t structure and associated subroutines.
subroutine aero_info_array_zero(aero_info_array)
Sets an aero_info_array to contain zero data.
real(kind=dp) elemental function aero_data_rad2vol(aero_data, r)
Convert geometric radius (m) to mass-equivalent volume (m^3).
real(kind=dp) function aero_state_particle_num_conc(aero_state, aero_particle, aero_data)
The number concentration of a single particle (m^{-3}).
The aero_particle_array_t structure and assoicated subroutines.
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
real(kind=dp) function aero_particle_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the critical relative humidity (1).
real(kind=dp) function, dimension(aero_data_n_spec(aero_data)) aero_particle_species_masses(aero_particle, aero_data)
Mass of all species in the particle (kg).
elemental integer function integer_varray_n_entry(integer_varray)
Return the current number of entries.
The aero_dist_t structure and associated subroutines.
subroutine aero_info_array_add(aero_info_array, aero_info_array_delta)
Adds aero_info_array_delta to the end of aero_info_array.
integer function pmc_mpi_pack_size_aero_weight_array(val)
Determines the number of bytes required to pack the given value.
subroutine aero_data_netcdf_dim_aero_species(aero_data, ncid, dimid_aero_species)
Write the aero species dimension to the given NetCDF file if it is not already present and in any cas...
integer, parameter aero_state_tag_gather
MPI tag for gathering between processes.
subroutine pmc_mpi_pack_aero_info_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_particle_array_remove_particle(aero_particle_array, index)
Removes the particle at the given index.
real(kind=dp) function aero_particle_approx_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the approximate critical relative humidity (1).
subroutine aero_particle_set_weight(aero_particle, i_group, i_class)
Sets the aerosol particle weight group.
subroutine aero_state_add_aero_dist_sample(aero_state, aero_data, aero_dist, sample_prop, create_time, allow_doubling, allow_halving, n_part_add)
Generates a Poisson sample of an aero_dist, adding to aero_state, with the given sample proportion...
subroutine aero_state_mpi_gather(aero_state, aero_state_total, aero_data)
Gathers data from all processes into one aero_state on process 0.
The aero_particle_t structure and associated subroutines.
elemental real(kind=dp) function aero_particle_species_volume(aero_particle, i_spec)
Volume of a single species in the particle (m^3).
subroutine aero_info_array_enlarge_to(aero_info_array, n)
Possibly enlarges the given array, ensuring that it is at least of size n.
elemental integer function aero_state_n_part(aero_state)
Return the current number of particles.
subroutine aero_particle_new_id(aero_particle)
Assigns a globally-unique new ID number to the particle.
The aero_sorted_t structure and assocated subroutines.
subroutine pmc_mpi_unpack_aero_weight_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine aero_weight_array_input_netcdf(aero_weight_array, ncid)
Read full aero_weight_array.
real(kind=dp) function aero_weight_array_num_conc_at_radius(aero_weight_array, i_class, radius)
Compute the total number concentration at a given radius (m^3).
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
subroutine spec_file_read_real(file, name, var)
Read a real number from a spec file that must have the given name.
integer function pmc_mpi_pack_size_aero_state(val)
Determines the number of bytes required to pack the given value.
The aero_state_t structure and assocated subroutines.
subroutine aero_particle_array_zero(aero_particle_array)
Resets an aero_particle_array to contain zero particles.
subroutine aero_particle_set_create_time(aero_particle, create_time)
Sets the creation times for the particle.
integer function pmc_mpi_pack_size_real_array_2d(val)
Determines the number of bytes required to pack the given value.
subroutine aero_state_to_binned(bin_grid, aero_data, aero_state, aero_binned)
Create binned number and mass arrays.
subroutine aero_state_set_n_part_ideal(aero_state, n_part)
Set the ideal number of particles to the given value. The aero_state%awa must be already set correctl...
A complete aerosol distribution, consisting of several modes.
subroutine aero_state_double(aero_state, aero_data, i_group, i_class)
Doubles number of particles in the given weight group.
1-D arrays of aero_info_t structure.
subroutine aero_particle_array_check(aero_particle_array, aero_data, continue_on_error)
Check that the particle array data is consistent.
subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
Copies weighting information for an aero_state.
subroutine aero_state_reweight(aero_state, aero_data, reweight_num_conc)
Reweight all particles after their constituent volumes have been altered.
subroutine aero_state_remove_particle_no_info(aero_state, i_part)
Remove the given particle without recording it.
integer, parameter aero_state_tag_mix
MPI tag for mixing particles between processes.
subroutine aero_weight_array_set_flat(aero_weight_array, n_class)
Allocates an aero_weight_array as flat weightings.
subroutine aero_state_remove_particle_with_info(aero_state, i_part, aero_info)
Remove the given particle and record the removal.
real(kind=dp) elemental function rad2diam(r)
Convert radius (m) to diameter (m).
An array of aerosol size distribution weighting functions.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_num_concs(aero_state, aero_data)
Returns the number concentrations of all particles.
real(kind=dp) function aero_weight_array_num_conc(aero_weight_array, aero_particle, aero_data)
Compute the number concentration for a particle (m^{-3}).
subroutine die_msg(code, error_msg)
Error immediately.
integer function aero_state_total_particles(aero_state, i_group, i_class)
Returns the total number of particles in an aerosol distribution.
subroutine aero_weight_array_set_power(aero_weight_array, n_class, exponent)
Allocates an aero_weight_array as power weightings.
elemental integer function bin_grid_size(bin_grid)
Return the number of bins in the grid, or -1 if the bin grid is not allocated.
integer, parameter aero_info_none
No information.
subroutine pmc_mpi_pack_aero_state(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_sorted_check(aero_sorted, aero_particle_array, aero_data, n_group, n_class, continue_on_error)
Check sorting.
subroutine aero_particle_set_vols(aero_particle, vols)
Sets the aerosol particle volumes.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_masses(aero_state, aero_data, include, exclude)
Returns the masses of all particles.
The current collection of aerosol particles.
subroutine spec_file_die_msg(code, file, msg)
Exit with an error message containing filename and line number.
integer function pmc_rand_int(n)
Returns a random integer between 1 and n.
subroutine pmc_mpi_unpack_aero_state(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
The integer_varray_t structure and assocated subroutines.
elemental subroutine aero_weight_scale(aero_weight, factor)
Scale the weight by the given fraction, so new_weight = old_weight * factor.
The aero_data_t structure and associated subroutines.
subroutine aero_state_netcdf_dim_aero_removed(aero_state, ncid, dimid_aero_removed)
Write the aero removed dimension to the given NetCDF file if it is not already present and in any cas...
integer, parameter aero_state_weight_nummass_source
Coupled number/mass weighting by source.
Single aerosol particle data structure.
1D grid, either logarithmic or linear.
subroutine aero_state_bin_average_size(aero_state, bin_grid, aero_data, bin_center, preserve_number)
Set each aerosol particle to have its original species ratios, but total volume given by the average ...
subroutine aero_state_make_dry(aero_state, aero_data)
Make all particles dry (water set to zero).
subroutine aero_state_remove_rand_particle_from_bin(aero_state, i_bin, i_class, aero_particle)
Remove a randomly chosen particle from the given bin and return it.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_dry_diameters(aero_state, aero_data)
Returns the dry diameters of all particles.
subroutine bin_grid_make(bin_grid, type, n_bin, min, max)
Generates the bin grid given the range and number of bins.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_approx_crit_rel_humids(aero_state, aero_data, env_state)
Returns the approximate critical relative humidity for all particles (1).
subroutine aero_weight_array_combine(aero_weight_array, aero_weight_array_delta)
Combine aero_weight_array_delta into aero_weight_array with a harmonic mean.
integer function aero_state_weight_class_for_source(aero_state, source)
Determine the appropriate weight class for a source.
subroutine aero_state_mixing_state_metrics(aero_state, aero_data, d_alpha, d_gamma, chi, include, exclude, group)
Returns the mixing state metrics of the population.
Reading formatted text input.
subroutine aero_state_sample_particles(aero_state_from, aero_state_to, aero_data, sample_prob, removal_action)
Generates a random sample by removing particles from aero_state_from and adding them to aero_state_to...
integer, parameter aero_state_weight_nummass
Coupled number/mass weighting scheme.
integer, parameter aero_state_weight_power
Power-law weighting scheme.
integer function aero_weight_array_rand_group(aero_weight_array, i_class, radius)
Choose a random group at the given radius, with probability inversely proportional to group weight at...
subroutine pmc_mpi_pack_aero_weight_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
logical function aero_weight_array_check_flat(aero_weight_array)
Check whether a given aero_weight array is flat in total.
integer function bin_grid_find(bin_grid, val)
Find the bin number that contains a given value.
integer function prob_round(val)
Round val to floor(val) or ceiling(val) with probability proportional to the relative distance from v...
subroutine aero_sorted_remove_particle(aero_sorted, aero_particle_array, i_part)
Remove a particle from both an aero_sorted and the corresponding aero_particle_array.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_mass_entropies(aero_state, aero_data, include, exclude, group)
Returns the mass-entropies of all particles.
elemental real(kind=dp) function aero_particle_volume(aero_particle)
Total volume of the particle (m^3).
Sorting of particles into bins.
subroutine pmc_mpi_check_ierr(ierr)
Dies if ierr is not ok.
subroutine aero_state_num_conc_for_reweight(aero_state, aero_data, reweight_num_conc)
Save the correct number concentrations for later use by aero_state_reweight().
subroutine aero_particle_zero(aero_particle, aero_data)
Resets an aero_particle to be zero.
elemental subroutine aero_weight_array_normalize(aero_weight_array)
Normalizes the aero_weight_array to a non-zero value.
subroutine aero_data_netcdf_dim_aero_source(aero_data, ncid, dimid_aero_source)
Write the aero source dimension to the given NetCDF file if it is not already present and in any case...
subroutine aero_state_add(aero_state, aero_state_delta, aero_data)
aero_state += aero_state_delta, including combining the weights, so the new concentration is the weig...
subroutine aero_state_zero(aero_state)
Resets an aero_state to have zero particles per bin.
integer, parameter dp
Kind of a double precision real number.
subroutine pmc_mpi_unpack_real_array_2d(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
integer function pmc_mpi_pack_size_aia(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
integer, parameter aero_state_weight_flat
Single flat weighting scheme.
integer, parameter aero_state_weight_none
Single flat weighting scheme.
The aero_info_t structure and associated subroutines.
subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
elemental integer function aero_data_n_source(aero_data)
Return the number of aerosol sources, or -1 if uninitialized.
The aero_info_array_t structure and assoicated subroutines.
subroutine spec_file_read_string(file, name, var)
Read a string from a spec file that must have a given name.
subroutine aero_state_bin_average_comp(aero_state, bin_grid, aero_data)
Set each aerosol particle to have its original total volume, but species volume ratios given by the t...
elemental integer function aero_dist_n_mode(aero_dist)
Return the number of modes.
integer, parameter bin_grid_type_log
Logarithmically spaced bin grid.
elemental integer function aero_data_n_spec(aero_data)
Return the number of aerosol species, or -1 if uninitialized.
subroutine aero_state_check(aero_state, aero_data)
Check that aerosol state data is consistent.
integer function aero_weight_array_n_group(aero_weight_array)
Return the number of weight groups.
subroutine pmc_mpi_pack_real_array_2d(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_state_set_weight(aero_state, aero_data, weight_type, exponent)
Sets the weighting functions for an aero_state.
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
integer, parameter aero_state_weight_power_source
Power-law weighting by source.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_crit_rel_humids(aero_state, aero_data, env_state)
Returns the critical relative humidity for all particles (1).
integer function aero_weight_array_n_class(aero_weight_array)
Return the number of weight classes.
subroutine aero_weight_array_shift(aero_weight_array_from, aero_weight_array_to, sample_prop, overwrite_to)
Adjust source and destination weights to reflect moving sample_prop proportion of particles from aero...
integer function pmc_mpi_size()
Returns the total number of processes.
Aerosol material properties and associated data.
subroutine aero_state_add_particle(aero_state, aero_particle, aero_data, allow_resort)
Add the given particle.
subroutine aero_state_mpi_alltoall(send, recv)
Do an MPI all-to-all transfer of aerosol states.
Common utility subroutines.
The aero_binned_t structure and associated subroutines.
real(kind=dp) function aero_state_total_num_conc(aero_state, aero_data)
Returns the total number concentration.
Wrapper functions for MPI.
integer function, dimension(aero_state_n_part(aero_state)) aero_state_ids(aero_state)
Returns the IDs of all particles.
integer, parameter dc
Kind of a double precision complex number.
Information about removed particles describing the sink.
integer function rand_binomial(n, p)
Generate a Binomial-distributed random number with the given parameters.
subroutine aero_state_remove_particle(aero_state, i_part, record_removal, aero_info)
Remove the given particle and possibly record the removal.
The aero_weight_t structure and associated subroutines.
elemental real(kind=dp) function aero_particle_dry_diameter(aero_particle, aero_data)
Total dry diameter of the particle (m).
integer function aero_data_spec_by_name(aero_data, name)
Returns the number of the species in aero_data with the given name, or returns 0 if there is no such ...
subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, aero_particle, aero_data, allow_resort)
Add a new particle to both an aero_sorted and the corresponding aero_particle_array.
subroutine pmc_mpi_allreduce_sum_integer(val, val_sum)
Computes the sum of val across all processes, storing the result in val_sum on all processes...
elemental real(kind=dp) function aero_particle_species_mass(aero_particle, i_spec, aero_data)
Mass of a single species in the particle (kg).
Aerosol number and volume distributions stored per bin.
subroutine pmc_mpi_unpack_aero_info_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine aero_particle_array_add_particle(aero_particle_array, aero_particle)
Adds the given particle to the end of the array.
logical function almost_equal(d1, d2)
Tests whether two real numbers are almost equal using only a relative tolerance.
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_volumes(aero_state, aero_data, include, exclude)
Returns the volumes of all particles.