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
1031 type(env_state_t),
intent(in) :: env_state
1034 real(kind=dp) :: aero_state_mobility_diameters( &
1035 aero_state_n_part(aero_state))
1039 do i_part = 1,aero_state_n_part(aero_state)
1040 aero_state_mobility_diameters(i_part) &
1042 aero_state%apa%particle(i_part), aero_data, env_state)
1061 type(
aero_data_t),
optional,
intent(in) :: aero_data
1063 character(len=*),
optional,
intent(in) :: include(:)
1065 character(len=*),
optional,
intent(in) :: exclude(:)
1070 logical,
allocatable :: use_species(:)
1071 integer :: i_name, i_spec
1073 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then 1077 call assert_msg(599558703,
present(aero_data), &
1078 "must provide 'aero_data' if using 'include' or 'exclude'")
1080 if (
present(include))
then 1081 use_species = .false.
1082 do i_name = 1,
size(include)
1085 "unknown species: " // trim(include(i_name)))
1086 use_species(i_spec) = .true.
1089 use_species = .true.
1091 if (
present(exclude))
then 1092 do i_name = 1,
size(exclude)
1095 "unknown species: " // trim(exclude(i_name)))
1096 use_species(i_spec) = .false.
1099 aero_state_volumes = 0d0
1101 if (use_species(i_spec))
then 1102 aero_state_volumes = aero_state_volumes &
1128 character(len=*),
optional,
intent(in) :: include(:)
1130 character(len=*),
optional,
intent(in) :: exclude(:)
1136 integer :: i_name, i_spec
1138 if ((.not.
present(include)) .and. (.not.
present(exclude)))
then 1143 if (
present(include))
then 1144 use_species = .false.
1145 do i_name = 1,
size(include)
1148 "unknown species: " // trim(include(i_name)))
1149 use_species(i_spec) = .true.
1152 use_species = .true.
1154 if (
present(exclude))
then 1155 do i_name = 1,
size(exclude)
1158 "unknown species: " // trim(exclude(i_name)))
1159 use_species(i_spec) = .false.
1162 aero_state_masses = 0d0
1164 if (use_species(i_spec))
then 1165 aero_state_masses = aero_state_masses &
1191 aero_state_num_concs(i_part) &
1193 aero_state%apa%particle(i_part), aero_data)
1214 aero_state%apa%particle(i_part), aero_data)
1239 character(len=*),
optional :: include(:)
1241 character(len=*),
optional :: exclude(:)
1243 character(len=*),
optional :: group(:)
1250 integer :: i_name, i_spec, i_part
1251 real(kind=dp) :: group_mass, non_group_mass, mass
1253 if (
present(include))
then 1254 use_species = .false.
1255 do i_name = 1,
size(include)
1258 "unknown species: " // trim(include(i_name)))
1259 use_species(i_spec) = .true.
1262 use_species = .true.
1264 if (
present(exclude))
then 1265 do i_name = 1,
size(exclude)
1268 "unknown species: " // trim(exclude(i_name)))
1269 use_species(i_spec) = .false.
1272 if (
present(group))
then 1273 group_species = .false.
1274 do i_name = 1,
size(group)
1277 "unknown species: " // trim(group(i_name)))
1278 group_species(i_spec) = .true.
1282 non_group_mass = 0d0
1284 if (use_species(i_spec))
then 1286 aero_state%apa%particle(i_part), i_spec, aero_data)
1287 if (group_species(i_spec))
then 1288 group_mass = group_mass + mass
1290 non_group_mass = non_group_mass + mass
1294 aero_state_mass_entropies(i_part) &
1295 =
entropy([group_mass, non_group_mass])
1299 aero_state_mass_entropies(i_part) =
entropy(pack( &
1301 aero_data), use_species))
1320 d_gamma, chi, include, exclude, group)
1327 real(kind=dp),
intent(out) :: d_alpha
1329 real(kind=dp),
intent(out) :: d_gamma
1331 real(kind=dp),
intent(out) :: chi
1333 character(len=*),
optional :: include(:)
1335 character(len=*),
optional :: exclude(:)
1337 character(len=*),
optional :: group(:)
1339 real(kind=dp),
allocatable :: entropies(:), entropies_of_avg_part(:)
1340 real(kind=dp),
allocatable :: masses(:), num_concs(:), &
1341 num_concs_of_avg_part(:), masses_of_avg_part(:)
1349 include, exclude, group)
1351 d_alpha = exp(sum(entropies * masses * num_concs) &
1352 / sum(masses * num_concs))
1356 aero_state_averaged = aero_state
1362 aero_data, include, exclude)
1364 aero_data, include, exclude, group)
1366 d_gamma = exp(sum(entropies_of_avg_part * masses_of_avg_part &
1367 * num_concs_of_avg_part) &
1368 / sum(masses_of_avg_part * num_concs_of_avg_part))
1370 chi = (d_alpha - 1) / (d_gamma - 1)
1384 type(env_state_t),
intent(in) :: env_state
1393 aero_state_approx_crit_rel_humids(i_part) = &
1395 aero_state%apa%particle(i_part), aero_data, env_state)
1410 type(env_state_t),
intent(in) :: env_state
1419 aero_state%apa%particle(i_part), aero_data, env_state)
1439 integer :: i_part, i_bin
1440 real(kind=dp) :: factor
1442 aero_binned%num_conc = 0d0
1443 aero_binned%vol_conc = 0d0
1448 if ((i_bin < 1) .or. (i_bin >
bin_grid_size(bin_grid)))
then 1449 call warn_msg(503871022,
"particle ID " &
1451 //
" outside of bin_grid, discarding")
1454 aero_state%apa%particle(i_part), aero_data) &
1455 / bin_grid%widths(i_bin)
1456 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1457 + aero_state%apa%particle(i_part)%vol * factor
1458 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1475 integer,
intent(in) :: i_group
1477 integer,
intent(in) :: i_class
1483 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1484 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1486 aero_particle = aero_state%apa%particle(i_part)
1491 aero_state%valid_sort = .false.
1504 integer,
intent(in) :: i_group
1506 integer,
intent(in) :: i_class
1512 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1513 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1516 aero_info%id = aero_state%apa%particle(i_part)%id
1533 allow_halving, initial_state_warning)
1540 logical,
intent(in) :: allow_doubling
1542 logical,
intent(in) :: allow_halving
1544 logical,
intent(in) :: initial_state_warning
1546 integer :: i_group, i_class, n_group, n_class, global_n_part
1548 n_group =
size(aero_state%awa%weight, 1)
1549 n_class =
size(aero_state%awa%weight, 2)
1553 if (allow_doubling)
then 1554 do i_group = 1,n_group
1555 do i_class = 1,n_class
1559 do while ((
real(global_n_part, kind=dp) &
1560 < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1561 .and. (global_n_part > 0))
1562 if (initial_state_warning)
then 1563 call warn_msg(716882783,
"doubling particles in initial " &
1576 if (allow_halving)
then 1577 do i_group = 1,n_group
1578 do i_class = 1,n_class
1579 do while (
real(aero_state_total_particles_all_procs(aero_state, &
i_group, i_class), kind=dp) &
1580 > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1581 if (initial_state_warning)
then 1583 "halving particles in initial condition")
1599 i_class, weight_ratio, allow_doubling, allow_halving)
1606 integer,
intent(in) :: i_group
1608 integer,
intent(in) :: i_class
1610 real(kind=dp),
intent(in) :: weight_ratio
1612 logical,
intent(in) :: allow_doubling
1614 logical,
intent(in) :: allow_halving
1616 real(kind=dp) :: ratio
1617 integer :: i_part, i_remove, n_remove, i_entry, n_part
1626 aero_state%aero_sorted%group_class%inverse(i_group, i_class))
1628 if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0)))
then 1631 n_remove =
prob_round(
real(n_part, kind=dp) &
1632 * (1d0 - 1d0 / weight_ratio))
1633 do i_remove = 1,n_remove
1635 aero_state%aero_sorted%group_class%inverse(i_group, i_class)))
1636 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1637 i_class)%entry(i_entry)
1638 aero_info%id = aero_state%apa%particle(i_part)%id
1643 elseif ((weight_ratio < 1d0) &
1644 .and. (allow_doubling .or. (n_part == 0)))
then 1647 do i_entry = n_part,1,-1
1648 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1649 i_class)%entry(i_entry)
1662 aero_data, specify_prob_transfer)
1667 real(kind=dp),
intent(in) :: del_t
1669 real(kind=dp),
intent(in) :: mix_timescale
1674 real(kind=dp),
optional,
intent(in) :: specify_prob_transfer
1677 integer :: rank, n_proc, i_proc, ierr
1678 integer :: buffer_size, buffer_size_check
1679 character,
allocatable :: buffer(:)
1682 real(kind=dp) :: prob_transfer, prob_not_transferred
1683 real(kind=dp) :: prob_transfer_given_not_transferred
1688 if (n_proc == 1)
then 1695 allocate(aero_state_sends(n_proc))
1696 allocate(aero_state_recvs(n_proc))
1699 if (
present(specify_prob_transfer))
then 1700 prob_transfer = specify_prob_transfer /
real(n_proc, kind=
dp)
1702 prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1703 /
real(n_proc, kind=
dp)
1707 prob_not_transferred = 1d0
1708 do i_proc = 0,(n_proc - 1)
1709 if (i_proc /= rank)
then 1714 prob_transfer_given_not_transferred = prob_transfer &
1715 / prob_not_transferred
1717 aero_state_sends(i_proc + 1), aero_data, &
1719 prob_not_transferred = prob_not_transferred - prob_transfer
1727 do i_proc = 0,(n_proc - 1)
1728 if (i_proc /= rank)
then 1735 deallocate(aero_state_sends)
1736 deallocate(aero_state_recvs)
1754 character,
allocatable :: sendbuf(:), recvbuf(:)
1755 integer :: sendcounts(size(send)), sdispls(size(send))
1756 integer :: recvcounts(size(send)), rdispls(size(send))
1757 integer :: i_proc, position, old_position, max_sendbuf_size, ierr
1761 max_sendbuf_size = 0
1764 max_sendbuf_size = max_sendbuf_size &
1769 allocate(sendbuf(max_sendbuf_size))
1773 old_position = position
1777 sendcounts(i_proc) = position - old_position
1779 call assert(393267406, position <= max_sendbuf_size)
1782 allocate(recvbuf(sum(recvcounts)))
1787 sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
1788 rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
1791 call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
1792 recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
1797 call assert(189739257, position == rdispls(i_proc))
1798 if (recvcounts(i_proc) > 0)
then 1825 real(kind=dp) :: total_volume_conc, particle_volume, num_conc
1826 integer :: i_bin, i_class, i_entry, i_part, i_spec
1831 species_volume_conc = 0d0
1832 total_volume_conc = 0d0
1833 do i_class = 1,
size(aero_state%awa%weight, 2)
1835 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1836 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1837 i_class)%entry(i_entry)
1839 aero_state%apa%particle(i_part), aero_data)
1841 aero_state%apa%particle(i_part))
1842 species_volume_conc = species_volume_conc &
1843 + num_conc * aero_state%apa%particle(i_part)%vol
1844 total_volume_conc = total_volume_conc + num_conc * particle_volume
1847 do i_class = 1,
size(aero_state%awa%weight, 2)
1849 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1850 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1851 i_class)%entry(i_entry)
1853 aero_state%apa%particle(i_part))
1854 aero_state%apa%particle(i_part)%vol &
1855 = particle_volume * species_volume_conc / total_volume_conc
1879 bin_center, preserve_number)
1889 logical,
intent(in) :: bin_center
1893 logical,
intent(in) :: preserve_number
1895 real(kind=dp) :: total_volume_conc, particle_volume
1896 real(kind=dp) :: new_particle_volume, num_conc, total_num_conc
1897 real(kind=dp) :: lower_volume, upper_volume, center_volume
1898 real(kind=dp) :: lower_function, upper_function, center_function
1899 integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
1900 logical :: monotone_increasing, monotone_decreasing
1905 do i_class = 1,
size(aero_state%awa%weight, 2)
1907 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) &
1913 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1914 total_num_conc = 0d0
1915 total_volume_conc = 0d0
1917 aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
1918 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1919 i_class)%entry(i_entry)
1921 aero_state%apa%particle(i_part), aero_data)
1922 total_num_conc = total_num_conc + num_conc
1924 aero_state%apa%particle(i_part))
1925 total_volume_conc = total_volume_conc &
1926 + num_conc * particle_volume
1930 if (bin_center)
then 1932 bin_grid%centers(i_bin))
1937 new_particle_volume = total_volume_conc / num_conc &
1938 /
real(integer_varray_n_entry( &
aero_state%aero_sorted%size_class%inverse(i_bin, i_class)), &
1940 elseif (preserve_number)
then 1951 monotone_increasing, monotone_decreasing)
1953 monotone_increasing .or. monotone_decreasing, &
1954 "monotone weight function required for averaging")
1957 do i_entry = 1,n_part
1958 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1959 i_class)%entry(i_entry)
1961 aero_state%apa%particle(i_part))
1962 if (i_part == 1)
then 1963 lower_volume = particle_volume
1964 upper_volume = particle_volume
1966 lower_volume = min(lower_volume, particle_volume)
1967 upper_volume = max(upper_volume, particle_volume)
1970 lower_function =
real(n_part, kind=dp) &
1971 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1972 i_class, aero_data_vol2rad(aero_data, lower_volume)) &
1974 upper_function =
real(n_part, kind=dp) &
1975 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1976 i_class, aero_data_vol2rad(aero_data, upper_volume)) &
1981 center_volume = (lower_volume + upper_volume) / 2d0
1982 center_function =
real(n_part, kind=dp) &
1983 * aero_weight_array_num_conc_at_radius(aero_state%awa, &
1984 i_class, aero_data_vol2rad(aero_data, center_volume)) &
1986 if ((lower_function > 0d0 .and. center_function > 0d0) &
1987 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1989 lower_volume = center_volume
1990 lower_function = center_function
1992 upper_volume = center_volume
1993 upper_function = center_function
1997 new_particle_volume = center_volume
2009 monotone_increasing, monotone_decreasing)
2011 monotone_increasing .or. monotone_decreasing, &
2012 "monotone weight function required for averaging")
2015 do i_entry = 1,n_part
2016 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2017 i_class)%entry(i_entry)
2019 aero_state%apa%particle(i_part))
2020 if (i_part == 1)
then 2021 lower_volume = particle_volume
2022 upper_volume = particle_volume
2024 lower_volume = min(lower_volume, particle_volume)
2025 upper_volume = max(upper_volume, particle_volume)
2028 lower_function =
real(n_part, kind=dp) &
2029 * aero_weight_array_num_conc_at_radius( &
2030 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2031 lower_volume)) * lower_volume - total_volume_conc
2032 upper_function =
real(n_part, kind=dp) &
2033 * aero_weight_array_num_conc_at_radius( &
2034 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2035 upper_volume)) * upper_volume - total_volume_conc
2039 center_volume = (lower_volume + upper_volume) / 2d0
2040 center_function =
real(n_part, kind=dp) &
2041 * aero_weight_array_num_conc_at_radius( &
2042 aero_state%awa, i_class, aero_data_vol2rad(aero_data, &
2043 center_volume)) * center_volume - total_volume_conc
2044 if ((lower_function > 0d0 .and. center_function > 0d0) &
2045 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
2047 lower_volume = center_volume
2048 lower_function = center_function
2050 upper_volume = center_volume
2051 upper_function = center_function
2055 new_particle_volume = center_volume
2058 do i_entry = 1,n_part
2059 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
2060 i_class)%entry(i_entry)
2062 aero_state%apa%particle(i_part))
2063 aero_state%apa%particle(i_part)%vol &
2064 = aero_state%apa%particle(i_part)%vol &
2065 / particle_volume * new_particle_volume
2083 real(kind=dp) :: reweight_num_conc(aero_state%apa%n_part)
2086 aero_state%valid_sort = .false.
2090 if (aero_data%i_water > 0)
then 2092 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
2094 aero_state%valid_sort = .false.
2109 integer :: total_size, i_group
2126 character,
intent(inout) :: buffer(:)
2128 integer,
intent(inout) :: position
2133 integer :: prev_position, i_group
2135 prev_position = position
2152 character,
intent(inout) :: buffer(:)
2154 integer,
intent(inout) :: position
2159 integer :: prev_position, i_group, n_group
2161 val%valid_sort = .false.
2162 prev_position = position
2187 integer :: n_proc, ierr, status(mpi_status_size)
2188 integer :: buffer_size, max_buffer_size, i_proc, position
2189 character,
allocatable :: buffer(:)
2193 aero_state_total = aero_state
2201 max_buffer_size = max_buffer_size &
2203 allocate(buffer(max_buffer_size))
2206 call assert(542772170, position <= max_buffer_size)
2207 buffer_size = position
2208 call mpi_send(buffer, buffer_size, mpi_character, 0, &
2215 do i_proc = 1,(n_proc - 1)
2220 call mpi_get_count(status, mpi_character, buffer_size, ierr)
2224 allocate(buffer(buffer_size))
2225 call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2231 aero_state_transfer)
2232 call assert(518174881, position == buffer_size)
2250 dimid_aero_particle)
2255 integer,
intent(in) :: ncid
2257 integer,
intent(out) :: dimid_aero_particle
2259 integer :: status, i_part
2260 integer :: varid_aero_particle
2264 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2265 if (status == nf90_noerr)
return 2266 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2269 call pmc_nc_check(nf90_redef(ncid))
2271 call pmc_nc_check(nf90_def_dim(ncid,
"aero_particle", &
2274 call pmc_nc_check(nf90_enddef(ncid))
2277 aero_particle_centers(i_part) = i_part
2279 call pmc_nc_write_integer_1d(ncid, aero_particle_centers, &
2280 "aero_particle", (/ dimid_aero_particle /), &
2281 description=
"dummy dimension variable (no useful value)")
2296 integer,
intent(in) :: ncid
2298 integer,
intent(out) :: dimid_aero_removed
2300 integer :: status, i_remove, dim_size
2301 integer :: varid_aero_removed
2302 integer :: aero_removed_centers( &
2306 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2307 if (status == nf90_noerr)
return 2308 if (status /= nf90_ebaddim)
call pmc_nc_check(status)
2311 call pmc_nc_check(nf90_redef(ncid))
2314 call pmc_nc_check(nf90_def_dim(ncid,
"aero_removed", &
2315 dim_size, dimid_aero_removed))
2317 call pmc_nc_check(nf90_enddef(ncid))
2319 do i_remove = 1,dim_size
2320 aero_removed_centers(i_remove) = i_remove
2322 call pmc_nc_write_integer_1d(ncid, aero_removed_centers, &
2323 "aero_removed", (/ dimid_aero_removed /), &
2324 description=
"dummy dimension variable (no useful value)")
2331 subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2332 record_removals, record_optical)
2337 integer,
intent(in) :: ncid
2341 logical,
intent(in) :: record_removals
2343 logical,
intent(in) :: record_optical
2345 integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2346 integer :: dimid_aero_removed
2347 integer :: i_part, i_remove
2349 aero_data_n_spec(aero_data))
2351 aero_data_n_source(aero_data))
2367 integer :: aero_removed_id( &
2369 integer :: aero_removed_action( &
2371 integer :: aero_removed_other_id( &
2467 call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2476 dimid_aero_particle)
2479 aero_particle_mass(i_part, :) &
2480 = aero_state%apa%particle(i_part)%vol * aero_data%density
2481 aero_n_orig_part(i_part, :) &
2482 = aero_state%apa%particle(i_part)%n_orig_part
2483 aero_particle_weight_group(i_part) &
2484 = aero_state%apa%particle(i_part)%weight_group
2485 aero_particle_weight_class(i_part) &
2486 = aero_state%apa%particle(i_part)%weight_class
2487 aero_water_hyst_leg(i_part) &
2488 = aero_state%apa%particle(i_part)%water_hyst_leg
2489 aero_num_conc(i_part) &
2491 aero_state%apa%particle(i_part), aero_data)
2492 aero_id(i_part) = aero_state%apa%particle(i_part)%id
2493 aero_least_create_time(i_part) &
2494 = aero_state%apa%particle(i_part)%least_create_time
2495 aero_greatest_create_time(i_part) &
2496 = aero_state%apa%particle(i_part)%greatest_create_time
2497 if (record_optical)
then 2498 aero_absorb_cross_sect(i_part) &
2499 = aero_state%apa%particle(i_part)%absorb_cross_sect
2500 aero_scatter_cross_sect(i_part) &
2501 = aero_state%apa%particle(i_part)%scatter_cross_sect
2502 aero_asymmetry(i_part) = aero_state%apa%particle(i_part)%asymmetry
2503 aero_refract_shell_real(i_part) &
2504 =
real(aero_state%apa%particle(i_part)%refract_shell)
2505 aero_refract_shell_imag(i_part) &
2506 = aimag(aero_state%apa%particle(i_part)%refract_shell)
2507 aero_refract_core_real(i_part) &
2508 =
real(aero_state%apa%particle(i_part)%refract_core)
2509 aero_refract_core_imag(i_part) &
2510 = aimag(aero_state%apa%particle(i_part)%refract_core)
2511 aero_core_vol(i_part) = aero_state%apa%particle(i_part)%core_vol
2514 call pmc_nc_write_real_2d(ncid, aero_particle_mass, &
2515 "aero_particle_mass", (/ dimid_aero_particle, &
2516 dimid_aero_species /), unit=
"kg", &
2517 long_name=
"constituent masses of each aerosol particle")
2518 call pmc_nc_write_integer_2d(ncid, aero_n_orig_part, &
2519 "aero_n_orig_part", (/ dimid_aero_particle, &
2520 dimid_aero_source /), &
2521 long_name=
"number of original constituent particles from " &
2522 //
"each source that coagulated to form each aerosol particle")
2523 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_group, &
2524 "aero_particle_weight_group", (/ dimid_aero_particle /), &
2525 long_name=
"weight group number of each aerosol particle")
2526 call pmc_nc_write_integer_1d(ncid, aero_particle_weight_class, &
2527 "aero_particle_weight_class", (/ dimid_aero_particle /), &
2528 long_name=
"weight class number of each aerosol particle")
2529 call pmc_nc_write_integer_1d(ncid, aero_water_hyst_leg, &
2530 "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2531 long_name=
"leg of the water hysteresis curve leg of each "&
2532 //
"aerosol particle")
2533 call pmc_nc_write_real_1d(ncid, aero_num_conc, &
2534 "aero_num_conc", (/ dimid_aero_particle /), unit=
"m^{-3}", &
2535 long_name=
"number concentration for each particle")
2536 call pmc_nc_write_integer_1d(ncid, aero_id, &
2537 "aero_id", (/ dimid_aero_particle /), &
2538 long_name=
"unique ID number of each aerosol particle")
2539 call pmc_nc_write_real_1d(ncid, aero_least_create_time, &
2540 "aero_least_create_time", (/ dimid_aero_particle /), unit=
"s", &
2541 long_name=
"least creation time of each aerosol particle", &
2542 description=
"least (earliest) creation time of any original " &
2543 //
"constituent particles that coagulated to form each " &
2544 //
"particle, measured from the start of the simulation")
2545 call pmc_nc_write_real_1d(ncid, aero_greatest_create_time, &
2546 "aero_greatest_create_time", (/ dimid_aero_particle /), &
2548 long_name=
"greatest creation time of each aerosol particle", &
2549 description=
"greatest (latest) creation time of any original " &
2550 //
"constituent particles that coagulated to form each " &
2551 //
"particle, measured from the start of the simulation")
2552 if (record_optical)
then 2553 call pmc_nc_write_real_1d(ncid, aero_absorb_cross_sect, &
2554 "aero_absorb_cross_sect", (/ dimid_aero_particle /), &
2556 long_name=
"optical absorption cross sections of each " &
2557 //
"aerosol particle")
2558 call pmc_nc_write_real_1d(ncid, aero_scatter_cross_sect, &
2559 "aero_scatter_cross_sect", (/ dimid_aero_particle /), &
2561 long_name=
"optical scattering cross sections of each " &
2562 //
"aerosol particle")
2563 call pmc_nc_write_real_1d(ncid, aero_asymmetry, &
2564 "aero_asymmetry", (/ dimid_aero_particle /), unit=
"1", &
2565 long_name=
"optical asymmetry parameters of each " &
2566 //
"aerosol particle")
2567 call pmc_nc_write_real_1d(ncid, aero_refract_shell_real, &
2568 "aero_refract_shell_real", (/ dimid_aero_particle /), &
2570 long_name=
"real part of the refractive indices of the " &
2571 //
"shell of each aerosol particle")
2572 call pmc_nc_write_real_1d(ncid, aero_refract_shell_imag, &
2573 "aero_refract_shell_imag", (/ dimid_aero_particle /), &
2575 long_name=
"imaginary part of the refractive indices of " &
2576 //
"the shell of each aerosol particle")
2577 call pmc_nc_write_real_1d(ncid, aero_refract_core_real, &
2578 "aero_refract_core_real", (/ dimid_aero_particle /), &
2580 long_name=
"real part of the refractive indices of the core " &
2581 //
"of each aerosol particle")
2582 call pmc_nc_write_real_1d(ncid, aero_refract_core_imag, &
2583 "aero_refract_core_imag", (/ dimid_aero_particle /), &
2585 long_name=
"imaginary part of the refractive indices of " &
2586 //
"the core of each aerosol particle")
2587 call pmc_nc_write_real_1d(ncid, aero_core_vol, &
2588 "aero_core_vol", (/ dimid_aero_particle /), unit=
"m^3", &
2589 long_name=
"volume of the optical cores of each " &
2590 //
"aerosol particle")
2596 if (record_removals)
then 2601 aero_removed_id(i_remove) = &
2602 aero_state%aero_info_array%aero_info(i_remove)%id
2603 aero_removed_action(i_remove) = &
2604 aero_state%aero_info_array%aero_info(i_remove)%action
2605 aero_removed_other_id(i_remove) = &
2606 aero_state%aero_info_array%aero_info(i_remove)%other_id
2609 aero_removed_id(1) = 0
2611 aero_removed_other_id(1) = 0
2613 call pmc_nc_write_integer_1d(ncid, aero_removed_id, &
2614 "aero_removed_id", (/ dimid_aero_removed /), &
2615 long_name=
"ID of removed particles")
2616 call pmc_nc_write_integer_1d(ncid, aero_removed_action, &
2617 "aero_removed_action", (/ dimid_aero_removed /), &
2618 long_name=
"reason for particle removal", &
2619 description=
"valid is 0 (invalid entry), 1 (removed due to " &
2620 //
"dilution), 2 (removed due to coagulation -- combined " &
2621 //
"particle ID is in \c aero_removed_other_id), 3 (removed " &
2622 //
"due to populating halving), or 4 (removed due to " &
2623 //
"weighting changes")
2624 call pmc_nc_write_integer_1d(ncid, aero_removed_other_id, &
2625 "aero_removed_other_id", (/ dimid_aero_removed /), &
2626 long_name=
"ID of other particle involved in removal", &
2627 description=
"if <tt>aero_removed_action(i)</tt> is 2 " &
2628 //
"(due to coagulation), then " &
2629 //
"<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2630 //
"resulting combined particle, or 0 if the new particle " &
2631 //
"was not created")
2634 end subroutine aero_state_output_netcdf
2706 integer,
intent(in) :: ncid
2710 integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
2711 integer :: i_bin, i_part_in_bin, i_part, i_remove, status
2713 character(len=1000) :: name
2715 real(kind=dp),
allocatable :: aero_particle_mass(:,:)
2716 integer,
allocatable :: aero_n_orig_part(:,:)
2717 integer,
allocatable :: aero_particle_weight_group(:)
2718 integer,
allocatable :: aero_particle_weight_class(:)
2719 real(kind=dp),
allocatable :: aero_absorb_cross_sect(:)
2720 real(kind=dp),
allocatable :: aero_scatter_cross_sect(:)
2721 real(kind=dp),
allocatable :: aero_asymmetry(:)
2722 real(kind=dp),
allocatable :: aero_refract_shell_real(:)
2723 real(kind=dp),
allocatable :: aero_refract_shell_imag(:)
2724 real(kind=dp),
allocatable :: aero_refract_core_real(:)
2725 real(kind=dp),
allocatable :: aero_refract_core_imag(:)
2726 real(kind=dp),
allocatable :: aero_core_vol(:)
2727 integer,
allocatable :: aero_water_hyst_leg(:)
2728 real(kind=dp),
allocatable :: aero_num_conc(:)
2729 integer,
allocatable :: aero_id(:)
2730 real(kind=dp),
allocatable :: aero_least_create_time(:)
2731 real(kind=dp),
allocatable :: aero_greatest_create_time(:)
2732 integer,
allocatable :: aero_removed_id(:)
2733 integer,
allocatable :: aero_removed_action(:)
2734 integer,
allocatable :: aero_removed_other_id(:)
2738 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2739 if (status == nf90_ebaddim)
then 2744 call pmc_nc_check(status)
2745 call pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
2748 call pmc_nc_read_real_2d(ncid, aero_particle_mass, &
2749 "aero_particle_mass")
2750 call pmc_nc_read_integer_2d(ncid, aero_n_orig_part, &
2752 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_group, &
2753 "aero_particle_weight_group")
2754 call pmc_nc_read_integer_1d(ncid, aero_particle_weight_class, &
2755 "aero_particle_weight_class")
2756 call pmc_nc_read_real_1d(ncid, aero_absorb_cross_sect, &
2757 "aero_absorb_cross_sect", must_be_present=.false.)
2758 call pmc_nc_read_real_1d(ncid, aero_scatter_cross_sect, &
2759 "aero_scatter_cross_sect", must_be_present=.false.)
2760 call pmc_nc_read_real_1d(ncid, aero_asymmetry, &
2761 "aero_asymmetry", must_be_present=.false.)
2762 call pmc_nc_read_real_1d(ncid, aero_refract_shell_real, &
2763 "aero_refract_shell_real", must_be_present=.false.)
2764 call pmc_nc_read_real_1d(ncid, aero_refract_shell_imag, &
2765 "aero_refract_shell_imag", must_be_present=.false.)
2766 call pmc_nc_read_real_1d(ncid, aero_refract_core_real, &
2767 "aero_refract_core_real", must_be_present=.false.)
2768 call pmc_nc_read_real_1d(ncid, aero_refract_core_imag, &
2769 "aero_refract_core_imag", must_be_present=.false.)
2770 call pmc_nc_read_real_1d(ncid, aero_core_vol, &
2771 "aero_core_vol", must_be_present=.false.)
2772 call pmc_nc_read_integer_1d(ncid, aero_water_hyst_leg, &
2773 "aero_water_hyst_leg")
2774 call pmc_nc_read_real_1d(ncid, aero_num_conc, &
2776 call pmc_nc_read_integer_1d(ncid, aero_id, &
2778 call pmc_nc_read_real_1d(ncid, aero_least_create_time, &
2779 "aero_least_create_time")
2780 call pmc_nc_read_real_1d(ncid, aero_greatest_create_time, &
2781 "aero_greatest_create_time")
2786 do i_part = 1,n_part
2787 aero_particle%vol = aero_particle_mass(i_part, :) / aero_data%density
2788 aero_particle%n_orig_part = aero_n_orig_part(i_part, :)
2789 aero_particle%weight_group = aero_particle_weight_group(i_part)
2790 aero_particle%weight_class = aero_particle_weight_class(i_part)
2791 if (
size(aero_absorb_cross_sect) == n_part)
then 2792 aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part)
2794 if (
size(aero_scatter_cross_sect) == n_part)
then 2795 aero_particle%scatter_cross_sect = aero_scatter_cross_sect(i_part)
2797 if (
size(aero_asymmetry) == n_part)
then 2798 aero_particle%asymmetry = aero_asymmetry(i_part)
2800 if ((
size(aero_refract_shell_real) == n_part) &
2801 .and. (
size(aero_refract_shell_imag) == n_part))
then 2802 aero_particle%refract_shell = &
2803 cmplx(aero_refract_shell_real(i_part), &
2804 aero_refract_shell_imag(i_part), kind=
dc)
2806 if ((
size(aero_refract_core_real) == n_part) &
2807 .and. (
size(aero_refract_core_imag) == n_part))
then 2808 aero_particle%refract_core = cmplx(aero_refract_core_real(i_part), &
2809 aero_refract_core_imag(i_part), kind=
dc)
2811 if (
size(aero_core_vol) == n_part)
then 2812 aero_particle%core_vol = aero_core_vol(i_part)
2814 aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
2815 aero_particle%id = aero_id(i_part)
2816 aero_particle%least_create_time = aero_least_create_time(i_part)
2817 aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
2826 call pmc_nc_read_integer_1d(ncid, aero_removed_id, &
2827 "aero_removed_id", must_be_present=.false.)
2828 call pmc_nc_read_integer_1d(ncid, aero_removed_action, &
2829 "aero_removed_action", must_be_present=.false.)
2830 call pmc_nc_read_integer_1d(ncid, aero_removed_other_id, &
2831 "aero_removed_other_id", must_be_present=.false.)
2833 n_info_item =
size(aero_removed_id)
2834 if (n_info_item >= 1)
then 2835 if ((n_info_item > 1) &
2836 .or. ((n_info_item == 1) .and. (aero_removed_id(1) /= 0)))
then 2839 do i_remove = 1,n_info_item
2840 aero_state%aero_info_array%aero_info(i_remove)%id &
2841 = aero_removed_id(i_remove)
2842 aero_state%aero_info_array%aero_info(i_remove)%action &
2843 = aero_removed_action(i_remove)
2844 aero_state%aero_info_array%aero_info(i_remove)%other_id &
2845 = aero_removed_other_id(i_remove)
2855 subroutine aero_state_sort(aero_state, aero_data, bin_grid, all_procs_same)
2862 type(
bin_grid_t),
optional,
intent(in) :: bin_grid
2864 logical,
optional,
intent(in) :: all_procs_same
2867 aero_data, aero_state%valid_sort,
size(aero_state%awa%weight, 1), &
2868 size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
2869 aero_state%valid_sort = .true.
2883 logical,
parameter :: continue_on_error = .false.
2887 if (aero_state%valid_sort)
then 2889 aero_data,
size(aero_state%awa%weight, 1), &
2890 size(aero_state%awa%weight, 2), continue_on_error)
2898 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.
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.
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 real(kind=dp) function aero_particle_diameter(aero_particle, aero_data)
Total diameter of the particle (m).
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...
real(kind=dp) function, dimension(aero_state_n_part(aero_state)) aero_state_diameters(aero_state, aero_data)
Returns the diameters of all particles.
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.