32 integer,
parameter :: AERO_STATE_TAG_MIX = 4987
34 integer,
parameter :: AERO_STATE_TAG_GATHER = 4988
36 integer,
parameter :: AERO_STATE_TAG_SCATTER = 4989
39 integer,
parameter :: AERO_STATE_WEIGHT_NONE = 1
41 integer,
parameter :: AERO_STATE_WEIGHT_FLAT = 2
43 integer,
parameter :: AERO_STATE_WEIGHT_POWER = 3
45 integer,
parameter :: AERO_STATE_WEIGHT_NUMMASS = 4
47 integer,
parameter :: AERO_STATE_WEIGHT_FLAT_SOURCE = 5
49 integer,
parameter :: AERO_STATE_WEIGHT_POWER_SOURCE = 6
51 integer,
parameter :: AERO_STATE_WEIGHT_NUMMASS_SOURCE = 7
73 real(kind=dp),
pointer :: n_part_ideal(:, :)
90 aero_state%valid_sort = .false.
92 allocate(aero_state%n_part_ideal(0, 0))
107 aero_state%valid_sort = .false.
109 deallocate(aero_state%n_part_ideal)
139 aero_state_to%valid_sort = .false.
141 call
copy_real_2d(aero_state_from%n_part_ideal, aero_state_to%n_part_ideal)
143 aero_state_to%aero_info_array)
172 integer,
intent(in) :: weight_type
175 real(kind=dp),
intent(in),
optional :: exponent
177 aero_state%valid_sort = .false.
179 select case(weight_type)
180 case(aero_state_weight_none)
182 case(aero_state_weight_flat)
184 case(aero_state_weight_power)
185 call
assert_msg(656670336, present(exponent), &
186 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
188 case(aero_state_weight_nummass)
190 case(aero_state_weight_flat_source)
192 case(aero_state_weight_power_source)
193 call
assert_msg(102143848, present(exponent), &
194 "exponent parameter required for AERO_STATE_WEIGHT_POWER")
196 aero_data%n_source, exponent)
197 case(aero_state_weight_nummass_source)
201 call
die_msg(969076992,
"unknown weight_type: " &
216 real(kind=dp),
intent(in) :: n_part
218 integer :: n_group, n_class
222 deallocate(aero_state%n_part_ideal)
223 allocate(aero_state%n_part_ideal(n_group, n_class))
224 aero_state%n_part_ideal = n_part /
real(n_group * n_class, kind=dp)
236 integer,
intent(in) :: source
240 call
assert(932390238, source >= 1)
243 if (n_class > 1)
then
244 call
assert(765048788, source <= n_class)
260 integer,
optional,
intent(in) :: i_group
262 integer,
optional,
intent(in) :: i_class
266 if (present(i_group))
then
267 call
assert(908743823, present(i_class))
268 if (aero_state%valid_sort)
then
270 = aero_state%aero_sorted%group_class%inverse(i_group, &
275 do i_part = 1,aero_state%apa%n_part
276 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
278 (aero_state%apa%particle(i_part)%weight_class == i_class)) &
299 integer,
optional,
intent(in) :: i_group
301 integer,
optional,
intent(in) :: i_class
322 aero_state%valid_sort = .false.
337 logical,
optional,
intent(in) :: allow_resort
339 if (aero_state%valid_sort)
then
341 aero_particle, allow_resort)
356 integer,
intent(in) :: i_part
358 if (aero_state%valid_sort)
then
360 aero_state%apa, i_part)
376 integer,
intent(in) :: i_part
390 record_removal, aero_info)
395 integer,
intent(in) :: i_part
397 logical,
intent(in) :: record_removal
401 if (record_removal)
then
415 i_bin, i_class, aero_particle)
420 integer,
intent(in) :: i_bin
422 integer,
intent(in) :: i_class
426 integer :: i_entry, i_part
428 call
assert(742996300, aero_state%valid_sort)
430 aero_state%aero_sorted%size_class%inverse(i_bin, i_class)%n_entry > 0)
431 i_entry =
pmc_rand_int(aero_state%aero_sorted%size_class%inverse(i_bin, &
433 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
434 i_class)%entry(i_entry)
456 integer,
intent(in) :: i_part
458 real(kind=dp),
intent(in) :: n_part_mean
461 logical,
optional,
intent(in) :: random_weight_group
463 integer :: n_copies, i_dup, new_group
468 aero_particle => aero_state%apa%particle(i_part)
470 if (n_copies == 0)
then
472 aero_info%id = aero_particle%id
473 aero_info%action = aero_info_weight
474 aero_info%other_id = 0
478 elseif (n_copies > 1)
then
480 do i_dup = 1,(n_copies - 1)
483 if (present(random_weight_group))
then
484 if (random_weight_group)
then
487 aero_particle%weight_class, &
495 aero_particle => aero_state%apa%particle(i_part)
527 real(kind=dp),
intent(out) :: reweight_num_conc(aero_state%apa%n_part)
531 do i_part = 1,aero_state%apa%n_part
532 reweight_num_conc(i_part) &
534 aero_state%apa%particle(i_part))
556 real(kind=dp),
intent(in) :: reweight_num_conc(aero_state%apa%n_part)
558 integer :: i_part, i_group, i_class
559 real(kind=dp) :: n_part_old(size(aero_state%awa%weight, 1), &
560 size(aero_state%awa%weight, 2))
561 real(kind=dp) :: n_part_new(size(aero_state%awa%weight, 1), &
562 size(aero_state%awa%weight, 2))
563 real(kind=dp) :: old_num_conc, new_num_conc, n_part_mean
570 do i_part = 1,aero_state%apa%n_part
571 aero_particle => aero_state%apa%particle(i_part)
572 old_num_conc = reweight_num_conc(i_part)
575 n_part_mean = old_num_conc / new_num_conc
576 i_group = aero_particle%weight_group
577 i_class = aero_particle%weight_class
578 n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
580 n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
585 do i_group = 1,
size(aero_state%awa%weight, 1)
586 do i_class = 1,
size(aero_state%awa%weight, 2)
587 if (n_part_old(i_group, i_class) == 0d0) cycle
589 n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
595 do i_part = aero_state%apa%n_part,1,-1
596 aero_particle => aero_state%apa%particle(i_part)
597 old_num_conc = reweight_num_conc(i_part)
600 n_part_mean = old_num_conc / new_num_conc
635 integer :: i_part, i_bin
637 do i_part = 1,aero_state_delta%apa%n_part
639 aero_state_delta%apa%particle(i_part))
642 aero_state_delta%aero_info_array)
652 i_class, n_add, allow_doubling, allow_halving)
657 integer,
intent(in) :: i_group
659 integer,
intent(in) :: i_class
661 real(kind=dp),
intent(in) :: n_add
663 logical,
intent(in) :: allow_doubling
665 logical,
intent(in) :: allow_halving
667 integer :: global_n_part, n_group, n_class
668 real(kind=dp) :: mean_n_part, n_part_new, weight_ratio
669 real(kind=dp) :: n_part_ideal_local_group
675 mean_n_part =
real(global_n_part, kind=dp) /
real(pmc_mpi_size(), kind=dp)
676 n_part_new = mean_n_part + n_add
677 if (n_part_new == 0d0)
return
678 n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
679 /
real(pmc_mpi_size(), kind=dp)
680 if ((n_part_new < n_part_ideal_local_group / 2d0) &
681 .or. (n_part_new > n_part_ideal_local_group * 2d0)) &
683 weight_ratio = n_part_new / n_part_ideal_local_group
685 weight_ratio, allow_doubling, allow_halving)
695 aero_dist, sample_prop, create_time, allow_doubling, allow_halving, &
705 real(kind=dp),
intent(in) :: sample_prop
707 real(kind=dp),
intent(in) :: create_time
709 logical,
intent(in) :: allow_doubling
711 logical,
intent(in) :: allow_halving
713 integer,
intent(out),
optional :: n_part_add
715 real(kind=dp) :: n_samp_avg, radius, total_vol
716 real(kind=dp) :: vols(aero_data%n_spec)
717 integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
718 type(aero_mode_t
),
pointer :: aero_mode
724 n_group =
size(aero_state%awa%weight, 1)
725 n_class =
size(aero_state%awa%weight, 2)
726 if (present(n_part_add))
then
729 do i_group = 1,n_group
730 do i_mode = 1,aero_dist%n_mode
731 aero_mode => aero_dist%mode(i_mode)
737 aero_state%awa%weight(i_group, i_class))
739 i_class, n_samp_avg, allow_doubling, allow_halving)
740 if (n_samp_avg == 0d0) cycle
744 aero_state%awa%weight(i_group, i_class))
746 if (present(n_part_add))
then
747 n_part_add = n_part_add + n_samp
752 aero_state%awa%weight(i_group, i_class), radius)
776 integer,
intent(out) :: i_part
778 call
assert(950725003, aero_state%apa%n_part > 0)
792 sample_prob, removal_action)
799 real(kind=dp),
intent(in) :: sample_prob
802 integer,
intent(in) :: removal_action
804 integer :: n_transfer, i_transfer, i_part
805 logical :: do_add, do_remove
806 real(kind=dp) :: num_conc_from, num_conc_to
809 call
assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
815 do while (i_transfer < n_transfer)
819 aero_state_from%apa%particle(i_part))
821 aero_state_from%apa%particle(i_part))
823 if (num_conc_to == num_conc_from)
then
826 elseif (num_conc_to < num_conc_from)
then
829 if (
pmc_random() < num_conc_to / num_conc_from)
then
834 if (
pmc_random() < num_conc_from / num_conc_to)
then
841 aero_state_from%apa%particle(i_part))
844 if (removal_action /= aero_info_none)
then
846 aero_info%id = aero_state_from%apa%particle(i_part)%id
847 aero_info%action = removal_action
855 i_transfer = i_transfer + 1
867 sample_prob, removal_action)
874 real(kind=dp),
intent(in) :: sample_prob
877 integer,
intent(in) :: removal_action
879 integer :: n_transfer, i_transfer, i_part
880 logical :: do_add, do_remove, overwrite_to
881 real(kind=dp) :: num_conc_from, num_conc_to
884 call
assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
890 do i_transfer = 1,n_transfer
895 aero_state_from%apa%particle(i_part))
896 if (removal_action /= aero_info_none)
then
898 aero_info%id = aero_state_from%apa%particle(i_part)%id
899 aero_info%action = removal_action
908 overwrite_to = .true.
910 sample_prob, overwrite_to)
929 integer :: i_part, i_bin
932 aero_binned%num_conc = 0d0
933 aero_binned%vol_conc = 0d0
934 do i_part = 1,aero_state%apa%n_part
935 aero_particle => aero_state%apa%particle(i_part)
937 if ((i_bin < 1) .or. (i_bin > bin_grid%n_bin))
then
938 call
warn_msg(980232449,
"particle ID " &
940 //
" outside of bin_grid, discarding")
942 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
943 + aero_particle%vol &
945 / bin_grid%widths(i_bin)
946 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
948 / bin_grid%widths(i_bin)
967 do i_part = 1,aero_state%apa%n_part
985 aero_state%apa%particle(1:aero_state%apa%n_part))
1003 aero_state%apa%particle(1:aero_state%apa%n_part), aero_data)
1023 character(len=*),
optional :: include(:)
1025 character(len=*),
optional :: exclude(:)
1030 logical :: use_species(aero_data%n_spec)
1031 integer :: i_name, i_spec
1033 if ((.not. present(include)) .and. (.not. present(exclude)))
then
1035 aero_state%apa%particle(1:aero_state%apa%n_part), aero_data)
1037 if (present(include))
then
1038 use_species = .false.
1039 do i_name = 1,
size(include)
1042 "unknown species: " // trim(include(i_name)))
1043 use_species(i_spec) = .true.
1046 use_species = .true.
1048 if (present(exclude))
then
1049 do i_name = 1,
size(exclude)
1052 "unknown species: " // trim(exclude(i_name)))
1053 use_species(i_spec) = .false.
1057 do i_spec = 1,aero_data%n_spec
1058 if (use_species(i_spec))
then
1061 aero_state%apa%particle(1:aero_state%apa%n_part), &
1082 do i_part = 1,aero_state%apa%n_part
1085 aero_state%apa%particle(i_part))
1101 do i_part = 1,aero_state%apa%n_part
1104 aero_state%apa%particle(i_part))
1129 character(len=*),
optional :: include(:)
1131 character(len=*),
optional :: exclude(:)
1133 character(len=*),
optional :: group(:)
1138 logical :: use_species(aero_data%n_spec), group_species(aero_data%n_spec)
1139 integer :: i_name, i_spec, i_part
1140 real(kind=dp) :: group_mass, non_group_mass, mass
1142 if (present(include))
then
1143 use_species = .false.
1144 do i_name = 1,
size(include)
1147 "unknown species: " // trim(include(i_name)))
1148 use_species(i_spec) = .true.
1151 use_species = .true.
1153 if (present(exclude))
then
1154 do i_name = 1,
size(exclude)
1157 "unknown species: " // trim(exclude(i_name)))
1158 use_species(i_spec) = .false.
1161 if (present(group))
then
1162 group_species = .false.
1163 do i_name = 1,
size(group)
1166 "unknown species: " // trim(group(i_name)))
1167 group_species(i_spec) = .true.
1169 do i_part = 1,aero_state%apa%n_part
1171 non_group_mass = 0d0
1172 do i_spec = 1,aero_data%n_spec
1173 if (use_species(i_spec))
then
1175 aero_state%apa%particle(i_part), i_spec, aero_data)
1176 if (group_species(i_spec))
then
1177 group_mass = group_mass + mass
1179 non_group_mass = non_group_mass + mass
1184 =
entropy([group_mass, non_group_mass])
1187 do i_part = 1,aero_state%apa%n_part
1190 aero_data), use_species))
1206 type(env_state_t
),
intent(in) :: env_state
1213 do i_part = 1,aero_state%apa%n_part
1216 aero_state%apa%particle(i_part), aero_data, env_state)
1231 type(env_state_t
),
intent(in) :: env_state
1238 do i_part = 1,aero_state%apa%n_part
1240 aero_state%apa%particle(i_part), aero_data, env_state)
1260 integer :: i_part, i_bin
1263 aero_binned%num_conc = 0d0
1264 aero_binned%vol_conc = 0d0
1265 do i_part = 1,aero_state%apa%n_part
1266 aero_particle => aero_state%apa%particle(i_part)
1269 if ((i_bin < 1) .or. (i_bin > bin_grid%n_bin))
then
1270 call
warn_msg(503871022,
"particle ID " &
1272 //
" outside of bin_grid, discarding")
1274 aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
1275 + aero_particle%vol &
1277 / bin_grid%widths(i_bin)
1278 aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
1280 / bin_grid%widths(i_bin)
1294 integer,
intent(in) :: i_group
1296 integer,
intent(in) :: i_class
1302 do i_part = 1,aero_state%apa%n_part
1303 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1304 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1313 aero_state%valid_sort = .false.
1326 integer,
intent(in) :: i_group
1328 integer,
intent(in) :: i_class
1334 do i_part = aero_state%apa%n_part,1,-1
1335 if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
1336 .and. (aero_state%apa%particle(i_part)%weight_class == i_class)) &
1339 aero_info%id = aero_state%apa%particle(i_part)%id
1340 aero_info%action = aero_info_halved
1357 initial_state_warning)
1362 logical,
intent(in) :: allow_doubling
1364 logical,
intent(in) :: allow_halving
1366 logical,
intent(in) :: initial_state_warning
1368 integer :: i_group, i_class, n_group, n_class, global_n_part
1370 n_group =
size(aero_state%awa%weight, 1)
1371 n_class =
size(aero_state%awa%weight, 2)
1375 if (allow_doubling)
then
1376 do i_group = 1,n_group
1377 do i_class = 1,n_class
1381 do while ((
real(global_n_part, kind=dp) &
1382 < aero_state%n_part_ideal(i_group, i_class) / 2d0) &
1383 .and. (global_n_part > 0))
1384 if (initial_state_warning)
then
1385 call
warn_msg(716882783,
"doubling particles in initial " &
1398 if (allow_halving)
then
1399 do i_group = 1,n_group
1400 do i_class = 1,n_class
1401 do while (
real(aero_state_total_particles_all_procs(aero_state, &
i_group, i_class), kind=dp) &
1402 > aero_state%n_part_ideal(i_group, i_class) * 2d0)
1403 if (initial_state_warning)
then
1405 "halving particles in initial condition")
1421 weight_ratio, allow_doubling, allow_halving)
1426 integer,
intent(in) :: i_group
1428 integer,
intent(in) :: i_class
1430 real(kind=dp),
intent(in) :: weight_ratio
1432 logical,
intent(in) :: allow_doubling
1434 logical,
intent(in) :: allow_halving
1436 real(kind=dp) :: ratio
1437 integer :: i_part, i_remove, n_remove, i_entry, n_part
1445 n_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1448 if ((weight_ratio > 1d0) .and. (allow_halving .or. (n_part == 0)))
then
1451 n_remove =
prob_round(
real(n_part, kind=dp) &
1452 * (1d0 - 1d0 / weight_ratio))
1453 do i_remove = 1,n_remove
1454 i_entry =
pmc_rand_int(aero_state%aero_sorted%group_class%inverse( &
1455 i_group, i_class)%n_entry)
1456 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1457 i_class)%entry(i_entry)
1459 aero_info%id = aero_state%apa%particle(i_part)%id
1460 aero_info%action = aero_info_halved
1465 elseif ((weight_ratio < 1d0) &
1466 .and. (allow_doubling .or. (n_part == 0)))
then
1469 do i_entry = n_part,1,-1
1470 i_part = aero_state%aero_sorted%group_class%inverse(i_group, &
1471 i_class)%entry(i_entry)
1483 aero_data, specify_prob_transfer)
1488 real(kind=dp),
intent(in) :: del_t
1490 real(kind=dp),
intent(in) :: mix_timescale
1495 real(kind=dp),
optional,
intent(in) :: specify_prob_transfer
1498 integer :: rank, n_proc, i_proc, ierr
1499 integer :: buffer_size, buffer_size_check
1500 character,
allocatable :: buffer(:)
1503 real(kind=dp) :: prob_transfer, prob_not_transferred
1504 real(kind=dp) :: prob_transfer_given_not_transferred
1509 if (n_proc == 1)
then
1516 allocate(aero_state_sends(n_proc))
1517 allocate(aero_state_recvs(n_proc))
1518 do i_proc = 0,(n_proc - 1)
1524 if (present(specify_prob_transfer))
then
1525 prob_transfer = specify_prob_transfer /
real(n_proc, kind=dp)
1527 prob_transfer = (1d0 - exp(- del_t / mix_timescale)) &
1528 /
real(n_proc, kind=dp)
1532 prob_not_transferred = 1d0
1533 do i_proc = 0,(n_proc - 1)
1534 if (i_proc /= rank)
then
1539 prob_transfer_given_not_transferred = prob_transfer &
1540 / prob_not_transferred
1542 aero_state_sends(i_proc + 1), &
1543 prob_transfer_given_not_transferred, aero_info_none)
1544 prob_not_transferred = prob_not_transferred - prob_transfer
1552 do i_proc = 0,(n_proc - 1)
1553 if (i_proc /= rank)
then
1559 do i_proc = 0,(n_proc - 1)
1563 deallocate(aero_state_sends)
1564 deallocate(aero_state_recvs)
1582 character,
allocatable :: sendbuf(:), recvbuf(:)
1583 integer :: sendcounts(size(send)), sdispls(size(send))
1584 integer :: recvcounts(size(send)), rdispls(size(send))
1585 integer :: i_proc, position, old_position, max_sendbuf_size, ierr
1589 max_sendbuf_size = 0
1592 max_sendbuf_size = max_sendbuf_size &
1597 allocate(sendbuf(max_sendbuf_size))
1601 old_position = position
1605 sendcounts(i_proc) = position - old_position
1607 call
assert(393267406, position <= max_sendbuf_size)
1610 allocate(recvbuf(sum(recvcounts)))
1615 sdispls(i_proc) = sdispls(i_proc - 1) + sendcounts(i_proc - 1)
1616 rdispls(i_proc) = rdispls(i_proc - 1) + recvcounts(i_proc - 1)
1619 call mpi_alltoallv(sendbuf, sendcounts, sdispls, mpi_character, recvbuf, &
1620 recvcounts, rdispls, mpi_character, mpi_comm_world, ierr)
1625 call
assert(189739257, position == rdispls(i_proc))
1626 if (recvcounts(i_proc) > 0)
then
1652 real(kind=dp) :: species_volume_conc(aero_data%n_spec)
1653 real(kind=dp) :: total_volume_conc, particle_volume, num_conc
1654 integer :: i_bin, i_class, i_entry, i_part, i_spec
1659 do i_bin = 1,bin_grid%n_bin
1660 species_volume_conc = 0d0
1661 total_volume_conc = 0d0
1662 do i_class = 1,
size(aero_state%awa%weight, 2)
1663 do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1665 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1666 i_class)%entry(i_entry)
1667 aero_particle => aero_state%apa%particle(i_part)
1671 species_volume_conc = species_volume_conc &
1672 + num_conc * aero_particle%vol
1673 total_volume_conc = total_volume_conc + num_conc * particle_volume
1676 do i_class = 1,
size(aero_state%awa%weight, 2)
1677 do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1679 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1680 i_class)%entry(i_entry)
1681 aero_particle => aero_state%apa%particle(i_part)
1683 aero_particle%vol = particle_volume * species_volume_conc &
1708 bin_center, preserve_number)
1718 logical,
intent(in) :: bin_center
1722 logical,
intent(in) :: preserve_number
1724 real(kind=dp) :: total_volume_conc, particle_volume
1725 real(kind=dp) :: new_particle_volume, num_conc, total_num_conc
1726 real(kind=dp) :: lower_volume, upper_volume, center_volume
1727 real(kind=dp) :: lower_function, upper_function, center_function
1728 integer :: i_bin, i_class, i_entry, i_part, i_bisect, n_part
1729 logical :: monotone_increasing, monotone_decreasing
1734 do i_bin = 1,bin_grid%n_bin
1735 do i_class = 1,
size(aero_state%awa%weight, 2)
1736 if (aero_state%aero_sorted%size_class%inverse(i_bin, &
1737 i_class)%n_entry == 0)
then
1741 n_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1743 total_num_conc = 0d0
1744 total_volume_conc = 0d0
1745 do i_entry = 1,aero_state%aero_sorted%size_class%inverse(i_bin, &
1747 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1748 i_class)%entry(i_entry)
1749 aero_particle => aero_state%apa%particle(i_part)
1752 total_num_conc = total_num_conc + num_conc
1754 total_volume_conc = total_volume_conc &
1755 + num_conc * particle_volume
1759 if (bin_center)
then
1760 new_particle_volume =
rad2vol(bin_grid%centers(i_bin))
1765 new_particle_volume = total_volume_conc / num_conc &
1766 /
real(aero_state%aero_sorted%size_class%inverse(i_bin, &
1767 i_class)%n_entry, kind=dp)
1768 elseif (preserve_number)
then
1779 monotone_increasing, monotone_decreasing)
1781 monotone_increasing .or. monotone_decreasing, &
1782 "monotone weight function required for averaging")
1785 do i_entry = 1,n_part
1786 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1787 i_class)%entry(i_entry)
1788 aero_particle => aero_state%apa%particle(i_part)
1790 if (i_part == 1)
then
1791 lower_volume = particle_volume
1792 upper_volume = particle_volume
1794 lower_volume = min(lower_volume, particle_volume)
1795 upper_volume = max(upper_volume, particle_volume)
1798 lower_function =
real(n_part, kind=dp) &
1800 i_class,
vol2rad(lower_volume)) - total_num_conc
1801 upper_function =
real(n_part, kind=dp) &
1803 i_class,
vol2rad(upper_volume)) - total_num_conc
1807 center_volume = (lower_volume + upper_volume) / 2d0
1808 center_function =
real(n_part, kind=dp) &
1810 i_class,
vol2rad(center_volume)) - total_num_conc
1811 if ((lower_function > 0d0 .and. center_function > 0d0) &
1812 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1814 lower_volume = center_volume
1815 lower_function = center_function
1817 upper_volume = center_volume
1818 upper_function = center_function
1822 new_particle_volume = center_volume
1834 monotone_increasing, monotone_decreasing)
1836 monotone_increasing .or. monotone_decreasing, &
1837 "monotone weight function required for averaging")
1840 do i_entry = 1,n_part
1841 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1842 i_class)%entry(i_entry)
1843 aero_particle => aero_state%apa%particle(i_part)
1845 if (i_part == 1)
then
1846 lower_volume = particle_volume
1847 upper_volume = particle_volume
1849 lower_volume = min(lower_volume, particle_volume)
1850 upper_volume = max(upper_volume, particle_volume)
1853 lower_function =
real(n_part, kind=dp) &
1855 aero_state%awa, i_class,
vol2rad(lower_volume)) &
1856 * lower_volume - total_volume_conc
1857 upper_function =
real(n_part, kind=dp) &
1859 aero_state%awa, i_class,
vol2rad(upper_volume)) &
1860 * upper_volume - total_volume_conc
1864 center_volume = (lower_volume + upper_volume) / 2d0
1865 center_function =
real(n_part, kind=dp) &
1867 aero_state%awa, i_class,
vol2rad(center_volume)) &
1868 * center_volume - total_volume_conc
1869 if ((lower_function > 0d0 .and. center_function > 0d0) &
1870 .or. (lower_function < 0d0 .and. center_function < 0d0)) &
1872 lower_volume = center_volume
1873 lower_function = center_function
1875 upper_volume = center_volume
1876 upper_function = center_function
1880 new_particle_volume = center_volume
1883 do i_entry = 1,n_part
1884 i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
1885 i_class)%entry(i_entry)
1886 aero_particle => aero_state%apa%particle(i_part)
1888 aero_particle%vol = aero_particle%vol / particle_volume &
1889 * new_particle_volume
1907 real(kind=dp) :: reweight_num_conc(aero_state%apa%n_part)
1910 aero_state%valid_sort = .false.
1913 if (aero_data%i_water > 0)
then
1914 do i_part = 1,aero_state%apa%n_part
1915 aero_state%apa%particle(i_part)%vol(aero_data%i_water) = 0d0
1917 aero_state%valid_sort = .false.
1932 integer :: total_size, i_group
1949 character,
intent(inout) :: buffer(:)
1951 integer,
intent(inout) :: position
1956 integer :: prev_position, i_group
1958 prev_position = position
1975 character,
intent(inout) :: buffer(:)
1977 integer,
intent(inout) :: position
1982 integer :: prev_position, i_group, n_group
1984 val%valid_sort = .false.
1985 prev_position = position
2008 integer :: n_proc, ierr, status(mpi_status_size)
2009 integer :: buffer_size, max_buffer_size, i_proc, position
2010 character,
allocatable :: buffer(:)
2022 max_buffer_size = max_buffer_size &
2024 allocate(buffer(max_buffer_size))
2027 call
assert(542772170, position <= max_buffer_size)
2028 buffer_size = position
2029 call mpi_send(buffer, buffer_size, mpi_character, 0, &
2030 aero_state_tag_gather, mpi_comm_world, ierr)
2036 do i_proc = 1,(n_proc - 1)
2038 call mpi_probe(i_proc, aero_state_tag_gather, mpi_comm_world, &
2041 call mpi_get_count(status, mpi_character, buffer_size, ierr)
2045 allocate(buffer(buffer_size))
2046 call mpi_recv(buffer, buffer_size, mpi_character, i_proc, &
2047 aero_state_tag_gather, mpi_comm_world, status, ierr)
2053 aero_state_transfer)
2054 call
assert(518174881, position == buffer_size)
2073 dimid_aero_particle)
2078 integer,
intent(in) :: ncid
2080 integer,
intent(out) :: dimid_aero_particle
2082 integer :: status, i_part
2083 integer :: varid_aero_particle
2084 integer :: aero_particle_centers(aero_state%apa%n_part)
2087 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2088 if (status == nf90_noerr)
return
2094 call
pmc_nc_check(nf90_def_dim(ncid,
"aero_particle", &
2095 aero_state%apa%n_part, dimid_aero_particle))
2099 do i_part = 1,aero_state%apa%n_part
2100 aero_particle_centers(i_part) = i_part
2103 "aero_particle", (/ dimid_aero_particle /), &
2104 description=
"dummy dimension variable (no useful value)")
2119 integer,
intent(in) :: ncid
2121 integer,
intent(out) :: dimid_aero_removed
2123 integer :: status, i_remove, dim_size
2124 integer :: varid_aero_removed
2125 integer :: aero_removed_centers(max(aero_state%aero_info_array%n_item,1))
2128 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2129 if (status == nf90_noerr)
return
2135 dim_size = max(aero_state%aero_info_array%n_item, 1)
2137 dim_size, dimid_aero_removed))
2141 do i_remove = 1,dim_size
2142 aero_removed_centers(i_remove) = i_remove
2145 "aero_removed", (/ dimid_aero_removed /), &
2146 description=
"dummy dimension variable (no useful value)")
2153 subroutine aero_state_output_netcdf(aero_state, ncid, aero_data, &
2154 record_removals, record_optical)
2159 integer,
intent(in) :: ncid
2163 logical,
intent(in) :: record_removals
2165 logical,
intent(in) :: record_optical
2167 integer :: dimid_aero_particle, dimid_aero_species, dimid_aero_source
2168 integer :: dimid_aero_removed
2169 integer :: i_part, i_remove
2173 integer :: aero_n_orig_part(aero_state%apa%n_part, aero_data%n_source)
2174 integer :: aero_particle_weight_group(aero_state%apa%n_part)
2175 integer :: aero_particle_weight_class(aero_state%apa%n_part)
2176 real(kind=dp) :: aero_absorb_cross_sect(aero_state%apa%n_part)
2177 real(kind=dp) :: aero_scatter_cross_sect(aero_state%apa%n_part)
2178 real(kind=dp) :: aero_asymmetry(aero_state%apa%n_part)
2179 real(kind=dp) :: aero_refract_shell_real(aero_state%apa%n_part)
2180 real(kind=dp) :: aero_refract_shell_imag(aero_state%apa%n_part)
2181 real(kind=dp) :: aero_refract_core_real(aero_state%apa%n_part)
2182 real(kind=dp) :: aero_refract_core_imag(aero_state%apa%n_part)
2183 real(kind=dp) :: aero_core_vol(aero_state%apa%n_part)
2184 integer :: aero_water_hyst_leg(aero_state%apa%n_part)
2185 real(kind=dp) :: aero_num_conc(aero_state%apa%n_part)
2186 integer :: aero_id(aero_state%apa%n_part)
2187 real(kind=dp) :: aero_least_create_time(aero_state%apa%n_part)
2188 real(kind=dp) :: aero_greatest_create_time(aero_state%apa%n_part)
2189 integer :: aero_removed_id(max(aero_state%aero_info_array%n_item,1))
2190 integer :: aero_removed_action(max(aero_state%aero_info_array%n_item,1))
2191 integer :: aero_removed_other_id(max(aero_state%aero_info_array%n_item,1))
2286 call aero_weight_array_output_netcdf(aero_state%awa, ncid)
2293 if (aero_state%apa%n_part > 0)
then
2295 dimid_aero_particle)
2299 do i_part = 1,aero_state%apa%n_part
2300 particle => aero_state%apa%particle(i_part)
2302 aero_n_orig_part(i_part, :) = particle%n_orig_part
2303 aero_particle_weight_group(i_part) = particle%weight_group
2304 aero_particle_weight_class(i_part) = particle%weight_class
2305 aero_water_hyst_leg(i_part) = particle%water_hyst_leg
2306 aero_num_conc(i_part) &
2308 aero_id(i_part) = particle%id
2309 aero_least_create_time(i_part) = particle%least_create_time
2310 aero_greatest_create_time(i_part) = particle%greatest_create_time
2311 if (record_optical)
then
2312 aero_absorb_cross_sect(i_part) = particle%absorb_cross_sect
2313 aero_scatter_cross_sect(i_part) = particle%scatter_cross_sect
2314 aero_asymmetry(i_part) = particle%asymmetry
2315 aero_refract_shell_real(i_part) =
real(particle%refract_shell)
2316 aero_refract_shell_imag(i_part) = aimag(particle%refract_shell)
2317 aero_refract_core_real(i_part) =
real(particle%refract_core)
2318 aero_refract_core_imag(i_part) = aimag(particle%refract_core)
2319 aero_core_vol(i_part) = particle%core_vol
2323 "aero_particle_mass", (/ dimid_aero_particle, &
2324 dimid_aero_species /), unit=
"kg", &
2325 long_name=
"constituent masses of each aerosol particle")
2327 "aero_n_orig_part", (/ dimid_aero_particle, &
2328 dimid_aero_source /), &
2329 long_name=
"number of original constituent particles from " &
2330 //
"each source that coagulated to form each aerosol particle")
2332 "aero_particle_weight_group", (/ dimid_aero_particle /), &
2333 long_name=
"weight group number of each aerosol particle")
2335 "aero_particle_weight_class", (/ dimid_aero_particle /), &
2336 long_name=
"weight class number of each aerosol particle")
2338 "aero_water_hyst_leg", (/ dimid_aero_particle /), &
2339 long_name=
"leg of the water hysteresis curve leg of each "&
2340 //
"aerosol particle")
2342 "aero_num_conc", (/ dimid_aero_particle /), unit=
"m^{-3}", &
2343 long_name=
"number concentration for each particle")
2345 "aero_id", (/ dimid_aero_particle /), &
2346 long_name=
"unique ID number of each aerosol particle")
2348 "aero_least_create_time", (/ dimid_aero_particle /), unit=
"s", &
2349 long_name=
"least creation time of each aerosol particle", &
2350 description=
"least (earliest) creation time of any original " &
2351 //
"constituent particles that coagulated to form each " &
2352 //
"particle, measured from the start of the simulation")
2354 "aero_greatest_create_time", (/ dimid_aero_particle /), &
2356 long_name=
"greatest creation time of each aerosol particle", &
2357 description=
"greatest (latest) creation time of any original " &
2358 //
"constituent particles that coagulated to form each " &
2359 //
"particle, measured from the start of the simulation")
2360 if (record_optical)
then
2362 "aero_absorb_cross_sect", (/ dimid_aero_particle /), &
2364 long_name=
"optical absorption cross sections of each " &
2365 //
"aerosol particle")
2367 "aero_scatter_cross_sect", (/ dimid_aero_particle /), &
2369 long_name=
"optical scattering cross sections of each " &
2370 //
"aerosol particle")
2372 "aero_asymmetry", (/ dimid_aero_particle /), unit=
"1", &
2373 long_name=
"optical asymmetry parameters of each " &
2374 //
"aerosol particle")
2376 "aero_refract_shell_real", (/ dimid_aero_particle /), &
2378 long_name=
"real part of the refractive indices of the " &
2379 //
"shell of each aerosol particle")
2381 "aero_refract_shell_imag", (/ dimid_aero_particle /), &
2383 long_name=
"imaginary part of the refractive indices of " &
2384 //
"the shell of each aerosol particle")
2386 "aero_refract_core_real", (/ dimid_aero_particle /), &
2388 long_name=
"real part of the refractive indices of the core " &
2389 //
"of each aerosol particle")
2391 "aero_refract_core_imag", (/ dimid_aero_particle /), &
2393 long_name=
"imaginary part of the refractive indices of " &
2394 //
"the core of each aerosol particle")
2396 "aero_core_vol", (/ dimid_aero_particle /), unit=
"m^3", &
2397 long_name=
"volume of the optical cores of each " &
2398 //
"aerosol particle")
2404 if (record_removals)
then
2407 if (aero_state%aero_info_array%n_item >= 1)
then
2408 do i_remove = 1,aero_state%aero_info_array%n_item
2409 aero_removed_id(i_remove) = &
2410 aero_state%aero_info_array%aero_info(i_remove)%id
2411 aero_removed_action(i_remove) = &
2412 aero_state%aero_info_array%aero_info(i_remove)%action
2413 aero_removed_other_id(i_remove) = &
2414 aero_state%aero_info_array%aero_info(i_remove)%other_id
2417 aero_removed_id(1) = 0
2418 aero_removed_action(1) = aero_info_none
2419 aero_removed_other_id(1) = 0
2422 "aero_removed_id", (/ dimid_aero_removed /), &
2423 long_name=
"ID of removed particles")
2425 "aero_removed_action", (/ dimid_aero_removed /), &
2426 long_name=
"reason for particle removal", &
2427 description=
"valid is 0 (invalid entry), 1 (removed due to " &
2428 //
"dilution), 2 (removed due to coagulation -- combined " &
2429 //
"particle ID is in \c aero_removed_other_id), 3 (removed " &
2430 //
"due to populating halving), or 4 (removed due to " &
2431 //
"weighting changes")
2433 "aero_removed_other_id", (/ dimid_aero_removed /), &
2434 long_name=
"ID of other particle involved in removal", &
2435 description=
"if <tt>aero_removed_action(i)</tt> is 2 " &
2436 //
"(due to coagulation), then " &
2437 //
"<tt>aero_removed_other_id(i)</tt> is the ID of the " &
2438 //
"resulting combined particle, or 0 if the new particle " &
2439 //
"was not created")
2442 end subroutine aero_state_output_netcdf
2514 integer,
intent(in) :: ncid
2518 integer :: dimid_aero_particle, dimid_aero_removed, n_info_item, n_part
2519 integer :: i_bin, i_part_in_bin, i_part, i_remove, status
2521 character(len=1000) :: name
2524 integer,
allocatable :: aero_n_orig_part(:,:)
2525 integer,
allocatable :: aero_particle_weight_group(:)
2526 integer,
allocatable :: aero_particle_weight_class(:)
2527 real(kind=dp),
allocatable :: aero_absorb_cross_sect(:)
2528 real(kind=dp),
allocatable :: aero_scatter_cross_sect(:)
2529 real(kind=dp),
allocatable :: aero_asymmetry(:)
2530 real(kind=dp),
allocatable :: aero_refract_shell_real(:)
2531 real(kind=dp),
allocatable :: aero_refract_shell_imag(:)
2532 real(kind=dp),
allocatable :: aero_refract_core_real(:)
2533 real(kind=dp),
allocatable :: aero_refract_core_imag(:)
2534 real(kind=dp),
allocatable :: aero_core_vol(:)
2535 integer,
allocatable :: aero_water_hyst_leg(:)
2536 real(kind=dp),
allocatable :: aero_num_conc(:)
2537 integer,
allocatable :: aero_id(:)
2538 real(kind=dp),
allocatable :: aero_least_create_time(:)
2539 real(kind=dp),
allocatable :: aero_greatest_create_time(:)
2540 integer,
allocatable :: aero_removed_id(:)
2541 integer,
allocatable :: aero_removed_action(:)
2542 integer,
allocatable :: aero_removed_other_id(:)
2544 status = nf90_inq_dimid(ncid,
"aero_particle", dimid_aero_particle)
2545 if (status == nf90_ebaddim)
then
2553 call
pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_particle, &
2557 allocate(aero_n_orig_part(n_part, aero_data%n_source))
2558 allocate(aero_particle_weight_group(n_part))
2559 allocate(aero_particle_weight_class(n_part))
2560 allocate(aero_absorb_cross_sect(n_part))
2561 allocate(aero_scatter_cross_sect(n_part))
2562 allocate(aero_asymmetry(n_part))
2563 allocate(aero_refract_shell_real(n_part))
2564 allocate(aero_refract_shell_imag(n_part))
2565 allocate(aero_refract_core_real(n_part))
2566 allocate(aero_refract_core_imag(n_part))
2567 allocate(aero_core_vol(n_part))
2568 allocate(aero_water_hyst_leg(n_part))
2569 allocate(aero_num_conc(n_part))
2570 allocate(aero_id(n_part))
2571 allocate(aero_least_create_time(n_part))
2572 allocate(aero_greatest_create_time(n_part))
2575 "aero_particle_mass")
2579 "aero_particle_weight_group")
2581 "aero_particle_weight_class")
2583 "aero_absorb_cross_sect", must_be_present=.false.)
2585 "aero_scatter_cross_sect", must_be_present=.false.)
2587 "aero_asymmetry", must_be_present=.false.)
2589 "aero_refract_shell_real", must_be_present=.false.)
2591 "aero_refract_shell_imag", must_be_present=.false.)
2593 "aero_refract_core_real", must_be_present=.false.)
2595 "aero_refract_core_imag", must_be_present=.false.)
2597 "aero_core_vol", must_be_present=.false.)
2599 "aero_water_hyst_leg")
2605 "aero_least_create_time")
2607 "aero_greatest_create_time")
2617 do i_part = 1,n_part
2619 aero_particle%n_orig_part = aero_n_orig_part(i_part, :)
2620 aero_particle%weight_group = aero_particle_weight_group(i_part)
2621 aero_particle%weight_class = aero_particle_weight_class(i_part)
2622 aero_particle%absorb_cross_sect = aero_absorb_cross_sect(i_part)
2623 aero_particle%scatter_cross_sect = aero_scatter_cross_sect(i_part)
2624 aero_particle%asymmetry = aero_asymmetry(i_part)
2625 aero_particle%refract_shell = &
2626 cmplx(aero_refract_shell_real(i_part), &
2627 aero_refract_shell_imag(i_part), kind=dc)
2628 aero_particle%refract_core = cmplx(aero_refract_core_real(i_part), &
2629 aero_refract_core_imag(i_part), kind=dc)
2630 aero_particle%core_vol = aero_core_vol(i_part)
2631 aero_particle%water_hyst_leg = aero_water_hyst_leg(i_part)
2632 aero_particle%id = aero_id(i_part)
2633 aero_particle%least_create_time = aero_least_create_time(i_part)
2634 aero_particle%greatest_create_time = aero_greatest_create_time(i_part)
2644 deallocate(aero_n_orig_part)
2645 deallocate(aero_particle_weight_group)
2646 deallocate(aero_particle_weight_class)
2647 deallocate(aero_absorb_cross_sect)
2648 deallocate(aero_scatter_cross_sect)
2649 deallocate(aero_asymmetry)
2650 deallocate(aero_refract_shell_real)
2651 deallocate(aero_refract_shell_imag)
2652 deallocate(aero_refract_core_real)
2653 deallocate(aero_refract_core_imag)
2654 deallocate(aero_core_vol)
2655 deallocate(aero_water_hyst_leg)
2656 deallocate(aero_num_conc)
2658 deallocate(aero_least_create_time)
2659 deallocate(aero_greatest_create_time)
2661 status = nf90_inq_dimid(ncid,
"aero_removed", dimid_aero_removed)
2662 if ((status /= nf90_noerr) .and. (status /= nf90_ebaddim))
then
2665 if (status == nf90_noerr)
then
2666 call
pmc_nc_check(nf90_inquire_dimension(ncid, dimid_aero_removed, &
2669 allocate(aero_removed_id(max(n_info_item,1)))
2670 allocate(aero_removed_action(max(n_info_item,1)))
2671 allocate(aero_removed_other_id(max(n_info_item,1)))
2676 "aero_removed_action")
2678 "aero_removed_other_id")
2680 if ((n_info_item > 1) .or. (aero_removed_id(1) /= 0))
then
2683 do i_remove = 1,n_info_item
2684 aero_state%aero_info_array%aero_info(i_remove)%id &
2685 = aero_removed_id(i_remove)
2686 aero_state%aero_info_array%aero_info(i_remove)%action &
2687 = aero_removed_action(i_remove)
2688 aero_state%aero_info_array%aero_info(i_remove)%other_id &
2689 = aero_removed_other_id(i_remove)
2693 deallocate(aero_removed_id)
2694 deallocate(aero_removed_action)
2695 deallocate(aero_removed_other_id)
2708 type(bin_grid_t),
optional,
intent(in) :: bin_grid
2710 logical,
optional,
intent(in) :: all_procs_same
2713 aero_state%valid_sort,
size(aero_state%awa%weight, 1), &
2714 size(aero_state%awa%weight, 2), bin_grid, all_procs_same)
2715 aero_state%valid_sort = .true.
2727 logical,
parameter :: continue_on_error = .false.
2729 integer :: i_part, i_bin
2731 if (.not. aero_state%valid_sort)
then
2732 write(0,*)
'SORTED CHECK ERROR: SORT NOT VALID'
2737 size(aero_state%awa%weight, 1),
size(aero_state%awa%weight, 2), &
2745 subroutine aero_particle_set_weight(aero_particle, i_group, i_class)
Sets the aerosol particle weight group.
real(kind=dp) function aero_weight_array_single_num_conc(aero_weight_array, aero_particle)
Compute the number concentration for a particle (m^{-3}).
The aero_sorted_t structure and assocated subroutines.
subroutine aero_state_copy(aero_state_from, aero_state_to)
Copies aerosol to a destination that has already had aero_state_allocate() called on it...
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...
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.
subroutine aero_particle_set_vols(aero_particle, vols)
Sets the aerosol particle volumes.
subroutine aero_particle_array_copy(aero_particle_array_from, aero_particle_array_to)
Copies aero_particle_array_from to aero_particle_array_to, both of which must already be allocated...
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.
subroutine pmc_mpi_unpack_aero_info_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine pmc_nc_write_real_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple real array to a NetCDF file.
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_particle_array_deallocate(aero_particle_array)
Deallocates.
subroutine aero_sorted_add_particle(aero_sorted, aero_particle_array, aero_particle, allow_resort)
Add a new particle to both an aero_sorted and the corresponding aero_particle_array.
The aero_data_t structure and associated subroutines.
integer function pmc_mpi_pack_size_aero_state(val)
Determines the number of bytes required to pack the given value.
subroutine die_msg(code, error_msg)
Error immediately.
subroutine aero_info_deallocate(aero_info)
Deallocates.
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...
1-D arrays of particles, used by aero_state to build a ragged array.
subroutine pmc_mpi_pack_real_array_2d(buffer, position, val)
Packs the given value into the buffer, advancing position.
The aero_info_array_t structure and assoicated subroutines.
subroutine copy_real_2d(source, dest)
Copy a 2D array of reals, reallocating if necessary.
subroutine aero_particle_array_zero(aero_particle_array)
Resets an aero_particle_array to contain zero particles.
subroutine aero_info_array_copy(aero_info_array_from, aero_info_array_to)
Copies aero_info_array_from to aero_info_array_to, both of which must already be allocated.
subroutine aero_state_reset(aero_state)
Resets an aero_state to an empty state.
subroutine aero_particle_zero(aero_particle)
Resets an aero_particle to be zero.
subroutine aero_mode_sample_vols(aero_mode, total_vol, vols)
Return an array of volumes randomly sampled from the volume fractions.
subroutine aero_weight_array_deallocate(aero_weight_array)
Free all storage.
subroutine aero_info_allocate(aero_info)
Allocates and initializes.
real(kind=dp) elemental function rad2vol(r)
Convert radius (m) to volume (m^3).
integer function rand_binomial(n, p)
Generate a Binomial-distributed random number with the given parameters.
real(kind=dp) function entropy(p)
Compute the entropy of a probability mass function (non necessarily normalized).
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_mass_entropies(aero_state, aero_data, include, exclude, group)
Returns the mass-entropies of all particles.
The aero_weight_t structure and associated subroutines.
The aero_dist_t structure and associated subroutines.
subroutine aero_state_scale_weight(aero_state, 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...
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 ...
The aero_particle_t structure and associated subroutines.
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_crit_rel_humids(aero_state, aero_data, env_state)
Returns the critical relative humidity for all particles (1).
subroutine aero_particle_deallocate(aero_particle)
Deallocates memory associated with an aero_particle_t.
elemental real(kind=dp) function aero_particle_species_mass(aero_particle, i_spec, aero_data)
Mass of a single species in the particle (kg).
subroutine aero_state_allocate(aero_state)
Allocates aerosol arrays.
subroutine aero_info_array_allocate(aero_info_array)
Allocates the structure.
The integer_varray_t structure and assocated subroutines.
subroutine aero_info_array_deallocate(aero_info_array)
Deallocates.
subroutine aero_state_add_particles(aero_state, aero_state_delta)
aero_state += aero_state_delta, with the weight of aero_state left unchanged, so the new concentratio...
integer function, dimension(aero_state%apa%n_part) aero_state_ids(aero_state)
Returns the IDs of all particles.
integer function pmc_mpi_pack_size_aero_weight_array(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_nc_check(status)
Check the status of a NetCDF function call.
subroutine aero_particle_allocate_size(aero_particle, n_spec, n_source)
Allocates an aero_particle_t of the given size.
subroutine aero_weight_array_allocate_flat(aero_weight_array, n_class)
Allocates an aero_weight_array as flat weightings.
subroutine aero_particle_set_create_time(aero_particle, create_time)
Sets the creation times for the particle.
subroutine aero_state_add_particle(aero_state, aero_particle, allow_resort)
Add the given particle.
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...
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_diameters(aero_state)
Returns the diameters of all particles.
subroutine aero_state_sample(aero_state_from, aero_state_to, sample_prob, removal_action)
Generates a random sample by removing particles from aero_state_from and adding them to aero_state_to...
subroutine aero_state_mpi_gather(aero_state, aero_state_total)
Gathers data from all processes into one aero_state on process 0.
subroutine aero_state_num_conc_for_reweight(aero_state, reweight_num_conc)
Save the correct number concentrations for later use by aero_state_reweight().
subroutine aero_state_halve(aero_state, i_group, i_class)
Remove approximately half of the particles in the given weight group.
integer function bin_grid_find(bin_grid, val)
Find the bin number that contains a given value.
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
elemental real(kind=dp) function aero_particle_diameter(aero_particle)
Total diameter of the particle (m).
logical function almost_equal(d1, d2)
Tests whether two real numbers are almost equal using only a relative tolerance.
subroutine aero_state_to_binned(bin_grid, aero_data, aero_state, aero_binned)
Create binned number and mass arrays.
elemental subroutine aero_weight_scale(aero_weight, factor)
Scale the weight by the given fraction, so new_weight = old_weight * factor.
subroutine pmc_nc_read_integer_1d(ncid, var, name, must_be_present)
Read a simple integer array from a NetCDF file.
subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
Copies weighting information for an aero_state.
subroutine aero_info_array_add_aero_info(aero_info_array, aero_info)
Adds the given aero_info to the end of the array.
integer function aero_state_weight_class_for_source(aero_state, source)
Determine the appropriate weight class for a source.
subroutine aero_particle_set_source(aero_particle, i_source)
Sets the aerosol particle source.
elemental real(kind=dp) function aero_particle_radius(aero_particle)
Total radius of the particle (m).
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...
subroutine aero_sorted_remake_if_needed(aero_sorted, aero_particle_array, valid_sort, n_group, n_class, bin_grid, all_procs_same)
Remake a sorting if particles are getting too close to the edges.
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...
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_masses(aero_state, aero_data, include, exclude)
Returns the masses of all particles.
Random number generators.
The aero_particle_array_t structure and assoicated subroutines.
real(kind=dp) function aero_mode_number(aero_mode, aero_weight)
Return the total number of computational particles for an aero_mode.
real(kind=dp) function aero_weight_array_num_conc(aero_weight_array, aero_particle)
Compute the number concentration for a particle (m^{-3}).
real(kind=dp) function aero_state_particle_num_conc(aero_state, aero_particle)
The number concentration of a single particle (m^{-3}).
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...
integer function pmc_mpi_size()
Returns the total number of processes.
subroutine aero_info_array_enlarge_to(aero_info_array, n)
Enlarges the given array so that it is at least of size n.
subroutine aero_state_set_weight(aero_state, aero_data, weight_type, exponent)
Sets the weighting functions for an aero_state.
subroutine pmc_nc_write_integer_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple integer array to a NetCDF file.
subroutine aero_info_array_zero(aero_info_array)
Resets an aero_info_array to contain zero particles.
subroutine aero_sorted_check(aero_sorted, aero_particle_array, n_group, n_class, continue_on_error)
Check sorting.
subroutine pmc_mpi_pack_aero_info_array(buffer, position, val)
Packs the given value into 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.
A complete aerosol distribution, consisting of several modes.
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...
Common utility subroutines.
1-D arrays of aero_info_t structure.
subroutine aero_weight_array_input_netcdf(aero_weight_array, ncid)
Read full aero_weight_array.
subroutine aero_state_sort(aero_state, bin_grid, all_procs_same)
Sorts the particles if necessary.
subroutine pmc_nc_read_real_1d(ncid, var, name, must_be_present)
Read a simple real array from a NetCDF file.
subroutine aero_state_dup_particle(aero_state, i_part, n_part_mean, random_weight_group)
Add copies or remove a particle, with a given mean number of resulting particles. ...
subroutine aero_weight_array_allocate(aero_weight_array)
Allocates an aero_weight_array.
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.
The aero_info_t structure and associated subroutines.
An array of aerosol size distribution weighting functions.
integer function pmc_rand_int(n)
Returns a random integer between 1 and n.
subroutine pmc_nc_read_real_2d(ncid, var, name, must_be_present)
Read a simple real 2D array from a NetCDF file.
subroutine aero_state_remove_particle(aero_state, i_part, record_removal, aero_info)
Remove the given particle and possibly record the removal.
The aero_state_t structure and assocated subroutines.
integer function pmc_mpi_rank()
Returns the rank of the current process.
Wrapper functions for MPI.
real(kind=dp) function, dimension(aero_state%apa%n_part) 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_allocate_power(aero_weight_array, n_class, exponent)
Allocates an aero_weight_array as power weightings.
subroutine aero_state_check_sort(aero_state)
Check that the sorted data is consistent.
integer function pmc_mpi_pack_size_real_array_2d(val)
Determines the number of bytes required to pack the given value.
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).
The aero_weight_array_t structure and associated subroutines.
subroutine aero_particle_allocate(aero_particle)
Allocates memory in an aero_particle_t.
subroutine aero_state_mpi_alltoall(send, recv)
Do an MPI all-to-all transfer of aerosol states.
subroutine aero_state_double(aero_state, i_group, i_class)
Doubles number of particles in the given weight group.
integer function rand_poisson(mean)
Generate a Poisson-distributed random number with the given mean.
subroutine pmc_mpi_unpack_aero_weight_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
integer function aero_state_total_particles(aero_state, i_group, i_class)
Returns the total number of particles in an aerosol distribution.
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
subroutine pmc_mpi_pack_aero_weight_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_state_reweight(aero_state, reweight_num_conc)
Reweight all particles after their constituent volumes have been altered.
The current collection of aerosol particles.
subroutine aero_state_make_dry(aero_state, aero_data)
Make all particles dry (water set to zero).
subroutine pmc_mpi_pack_aero_state(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_mode_sample_radius(aero_mode, aero_weight, radius)
Return a radius randomly sampled from the mode distribution.
integer function aero_weight_array_n_class(aero_weight_array)
Return the number of weight classes.
subroutine aero_state_remove_particle_no_info(aero_state, i_part)
Remove the given particle without recording it.
subroutine aero_state_remove_particle_with_info(aero_state, i_part, aero_info)
Remove the given particle and record the removal.
real(kind=dp) function aero_particle_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the critical relative humidity (1).
subroutine aero_info_array_add(aero_info_array, aero_info_array_delta)
Adds aero_info_array_delta to the end of aero_info_array.
Single aerosol particle data structure.
1D grid, either logarithmic or linear.
subroutine pmc_mpi_check_ierr(ierr)
Dies if ierr is not ok.
The bin_grid_t structure and associated subroutines.
subroutine pmc_mpi_unpack_real_array_2d(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine aero_particle_new_id(aero_particle)
Assigns a globally-unique new ID number to the particle.
subroutine aero_state_deallocate(aero_state)
Deallocates a previously allocated aerosol.
subroutine pmc_nc_write_real_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple real 2D array to a NetCDF file.
integer function prob_round(val)
Round val to floor(val) or ceiling(val) with probability proportional to the relative distance from v...
real(kind=dp) function aero_state_total_num_conc(aero_state)
Returns the total number concentration.
Reading formatted text input.
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...
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_dry_diameters(aero_state, aero_data)
Returns the dry diameters of all particles.
subroutine aero_state_add(aero_state, aero_state_delta)
aero_state += aero_state_delta, including combining the weights, so the new concentration is the weig...
The aero_binned_t structure and associated subroutines.
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
subroutine aero_state_input_netcdf(aero_state, ncid, aero_data)
Read full state.
Sorting of particles into bins.
integer function aero_weight_array_n_group(aero_weight_array)
Return the number of weight groups.
subroutine aero_state_zero(aero_state)
Resets an aero_state to have zero particles per bin. This must already have had aero_state_allocate()...
subroutine pmc_nc_write_integer_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple integer 2D array to a NetCDF file.
integer function pmc_mpi_pack_size_aia(val)
Determines the number of bytes required to pack the given value.
subroutine aero_state_sample_particles(aero_state_from, aero_state_to, sample_prob, removal_action)
Generates a random sample by removing particles from aero_state_from and adding them to aero_state_to...
subroutine aero_weight_array_allocate_nummass(aero_weight_array, n_class)
Allocates an aero_weight_array as joint flat/power-3 weightings..
subroutine aero_particle_array_remove_particle(aero_particle_array, index)
Removes the particle at the given index.
real(kind=dp) function, dimension(aero_state%apa%n_part) aero_state_num_concs(aero_state)
Returns the number concentrations of all particles.
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
logical function aero_weight_array_check_flat(aero_weight_array)
Check whether a given aero_weight array is flat in total.
subroutine pmc_mpi_unpack_aero_state(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
real(kind=dp) function, dimension(aero_data%n_spec) aero_particle_species_masses(aero_particle, aero_data)
Mass of all species in the particle (kg).
elemental real(kind=dp) function aero_particle_mass(aero_particle, aero_data)
Total mass of the particle (kg).
real(kind=dp) function aero_particle_approx_crit_rel_humid(aero_particle, aero_data, env_state)
Returns the approximate critical relative humidity (1).
subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
real(kind=dp) elemental function vol2rad(v)
Convert volume (m^3) to radius (m).
subroutine aero_particle_array_allocate(aero_particle_array)
Allocates and initializes.
subroutine pmc_nc_read_integer_2d(ncid, var, name, must_be_present)
Read a simple integer 2D array from a NetCDF file.
elemental real(kind=dp) function aero_particle_volume(aero_particle)
Total volume of the particle (m^3).
real(kind=dp) function aero_particle_solute_radius(aero_particle, aero_data)
Returns the total solute radius (m).
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...
integer function aero_state_total_particles_all_procs(aero_state, i_group, i_class)
Returns the total number of particles across all processes.
subroutine pmc_mpi_alltoall_integer(send, recv)
Does an all-to-all transfer of integers.
Aerosol material properties and associated data.
subroutine aero_state_rand_particle(aero_state, i_part)
Choose a random particle from the aero_state.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine aero_sorted_allocate(aero_sorted)
Allocate an empty structure.
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...
elemental real(kind=dp) function aero_particle_dry_diameter(aero_particle, aero_data)
Total dry diameter of the particle (m).
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_prepare_weight_for_add(aero_state, 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...
Information about removed particles describing the sink.
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.
subroutine aero_sorted_deallocate(aero_sorted)
Deallocates a previously allocated structure.
subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
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.
subroutine aero_particle_copy(aero_particle_from, aero_particle_to)
Copies a particle.
Aerosol number and volume distributions stored per bin.
subroutine aero_weight_array_copy(aero_weight_array_from, aero_weight_array_to)
Copy an aero_weight_array.
elemental subroutine aero_weight_array_normalize(aero_weight_array)
Normalizes the aero_weight_array to a non-zero value.
integer function pmc_mpi_pack_size_apa(val)
Determines the number of bytes required to pack the given value.
subroutine aero_state_rebalance(aero_state, 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...