31 integer,
parameter :: COAG_DIST_OUTGOING_BUFFER_SIZE = 1000000
39 integer,
parameter :: COAG_DIST_MAX_BUFFER_SIZE = 10000
40 integer,
parameter :: COAG_DIST_MAX_REQUESTS = 1
41 integer,
parameter :: COAG_DIST_TAG_REQUEST_PARTICLE = 5321
42 integer,
parameter :: COAG_DIST_TAG_RETURN_REQ_PARTICLE = 5322
43 integer,
parameter :: COAG_DIST_TAG_RETURN_UNREQ_PARTICLE = 5323
44 integer,
parameter :: COAG_DIST_TAG_RETURN_NO_PARTICLE = 5324
45 integer,
parameter :: COAG_DIST_TAG_DONE = 5325
54 integer :: remote_proc
74 request%active = .false.
87 request%active = .false.
107 aero_state, del_t, tot_n_samp, tot_n_coag)
110 integer,
intent(in) :: coag_kernel_type
118 real(kind=dp),
intent(in) :: del_t
120 integer,
intent(out) :: tot_n_samp
122 integer,
intent(out) :: tot_n_coag
124 integer,
parameter :: s1 = 1
125 integer,
parameter :: s2 = 1
126 integer,
parameter :: sc = 1
129 logical :: samps_remaining, sent_dones
130 integer :: i_bin, j_bin, n_samp, i_samp, i_proc, n_proc
131 integer :: ierr, status(mpi_status_size), current_i, current_j, i_req
132 real(kind=dp) :: n_samp_real, f_max
133 integer,
allocatable :: n_parts(:,:)
134 real(kind=dp),
allocatable :: magnitudes(:,:)
135 type(request_t) :: requests(coag_dist_max_requests)
136 integer,
allocatable :: n_samps(:,:)
137 real(kind=dp),
allocatable :: accept_factors(:,:), k_max(:,:)
138 logical,
allocatable :: procs_done(:)
139 integer :: outgoing_buffer(coag_dist_outgoing_buffer_size)
140 integer :: outgoing_buffer_size_check
145 "FIXME: mc_coag_dist() can only handle one weight class")
152 if (.not. aero_state%aero_sorted%coag_kernel_bounds_valid)
then
154 coag_kernel_type, aero_data, env_state, &
155 aero_state%aero_sorted%coag_kernel_min, &
156 aero_state%aero_sorted%coag_kernel_max)
157 aero_state%aero_sorted%coag_kernel_bounds_valid = .true.
160 allocate(n_samps(aero_state%aero_sorted%bin_grid%n_bin, &
161 aero_state%aero_sorted%bin_grid%n_bin))
162 allocate(accept_factors(aero_state%aero_sorted%bin_grid%n_bin, &
163 aero_state%aero_sorted%bin_grid%n_bin))
165 allocate(n_parts(aero_state%aero_sorted%bin_grid%n_bin, n_proc))
167 aero_state%aero_sorted%size_class%inverse(:, s1)%n_entry, n_parts)
169 allocate(magnitudes(
size(aero_state%awa%weight), n_proc))
175 aero_weight_total%weight(:, s1)%magnitude = 1d0 / sum(1d0 / magnitudes, 2)
177 allocate(k_max(aero_state%aero_sorted%bin_grid%n_bin, &
178 aero_state%aero_sorted%bin_grid%n_bin))
179 do i_bin = 1,aero_state%aero_sorted%bin_grid%n_bin
180 do j_bin = 1,aero_state%aero_sorted%bin_grid%n_bin
182 aero_state%aero_sorted%bin_grid, i_bin, j_bin, s1, s2, sc, &
184 k_max(i_bin, j_bin) &
185 = aero_state%aero_sorted%coag_kernel_max(i_bin, j_bin) * f_max
190 aero_weight_total, k_max, n_samps, accept_factors)
191 tot_n_samp = sum(n_samps)
195 do i_req = 1,coag_dist_max_requests
198 samps_remaining = .true.
201 allocate(procs_done(n_proc))
204 call mpi_buffer_attach(outgoing_buffer, &
205 coag_dist_outgoing_buffer_size, ierr)
207 do while (.not. all(procs_done))
210 current_i, current_j, n_samps, samps_remaining)
213 if (.not. sent_dones)
then
216 do i_proc = 0, (n_proc - 1)
223 call
coag_dist_recv(requests, env_state, aero_weight_total, aero_data, &
224 aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
225 magnitudes, procs_done)
228 do i_req = 1,coag_dist_max_requests
232 deallocate(procs_done)
234 deallocate(accept_factors)
236 deallocate(magnitudes)
237 call mpi_buffer_detach(outgoing_buffer, &
238 outgoing_buffer_size_check, ierr)
241 coag_dist_outgoing_buffer_size == outgoing_buffer_size_check)
249 aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
250 magnitudes, procs_done)
253 type(request_t),
intent(inout) :: requests(coag_dist_max_requests)
263 real(kind=dp),
intent(in) :: accept_factors(:,:)
265 integer,
intent(in) :: coag_kernel_type
267 integer,
intent(inout) :: tot_n_coag
269 real(kind=dp),
intent(in) :: magnitudes(:,:)
271 logical,
intent(inout) :: procs_done(:)
274 integer :: status(mpi_status_size), ierr
276 call mpi_probe(mpi_any_source, mpi_any_tag, mpi_comm_world, &
279 if (status(mpi_tag) == coag_dist_tag_request_particle)
then
281 elseif (status(mpi_tag) == coag_dist_tag_return_req_particle)
then
283 aero_data, aero_state, accept_factors, coag_kernel_type, &
284 tot_n_coag, magnitudes)
285 elseif (status(mpi_tag) == coag_dist_tag_return_unreq_particle)
then
287 elseif (status(mpi_tag) == coag_dist_tag_return_no_particle)
then
289 elseif (status(mpi_tag) == coag_dist_tag_done)
then
302 local_bin, remote_bin, n_samps, samps_remaining)
307 type(request_t),
intent(inout) :: requests(coag_dist_max_requests)
309 integer,
intent(in) :: n_parts(:,:)
311 integer,
intent(inout) :: local_bin
313 integer,
intent(inout) :: remote_bin
315 integer,
intent(inout) :: n_samps(:,:)
317 logical,
intent(inout) :: samps_remaining
319 integer,
parameter :: s1 = 1
320 integer,
parameter :: s2 = 1
321 integer,
parameter :: sc = 1
325 if (.not. samps_remaining)
return
327 outer:
do i_req = 1,coag_dist_max_requests
332 if (.not. samps_remaining)
exit outer
333 if (aero_state%aero_sorted%size_class%inverse(local_bin, &
334 s2)%n_entry > 0)
then
336 requests(i_req)%remote_proc)
337 requests(i_req)%active = .true.
338 requests(i_req)%local_bin = local_bin
339 requests(i_req)%remote_bin = remote_bin
341 local_bin, s2, requests(i_req)%local_aero_particle)
343 requests(i_req)%remote_bin)
359 type(request_t),
intent(inout) :: requests(coag_dist_max_requests)
363 do i_req = 1,coag_dist_max_requests
378 integer,
intent(in) :: n_parts(:,:)
380 integer,
intent(in) :: remote_bin
382 integer,
intent(out) :: remote_proc
396 integer,
intent(inout) :: n_samps(:,:)
398 integer,
intent(inout) :: local_bin
400 integer,
intent(inout) :: remote_bin
402 logical,
intent(inout) :: samps_remaining
406 if (.not. samps_remaining)
return
408 n_bin =
size(n_samps, 1)
410 if (n_samps(local_bin, remote_bin) > 0)
exit
412 remote_bin = remote_bin + 1
413 if (remote_bin > n_bin)
then
415 local_bin = local_bin + 1
417 if (local_bin > n_bin)
exit
420 if (local_bin > n_bin)
then
421 samps_remaining = .false.
423 n_samps(local_bin, remote_bin) = n_samps(local_bin, remote_bin) - 1
433 integer,
intent(in) :: remote_proc
435 integer,
intent(in) :: remote_bin
438 character :: buffer(coag_dist_max_buffer_size)
439 integer :: buffer_size, max_buffer_size, position, ierr
443 call
assert(893545122, max_buffer_size <= coag_dist_max_buffer_size)
446 call
assert(610314213, position <= max_buffer_size)
447 buffer_size = position
448 call mpi_bsend(buffer, buffer_size, mpi_character, remote_proc, &
449 coag_dist_tag_request_particle, mpi_comm_world, ierr)
462 integer,
parameter :: s1 = 1
463 integer,
parameter :: s2 = 1
464 integer,
parameter :: sc = 1
467 integer :: buffer_size, position, request_bin, sent_proc
468 integer :: ierr, remote_proc, status(mpi_status_size)
469 character :: buffer(coag_dist_max_buffer_size)
473 call mpi_recv(buffer, coag_dist_max_buffer_size, mpi_character, &
474 mpi_any_source, coag_dist_tag_request_particle, mpi_comm_world, &
477 call
assert(920139874, status(mpi_tag) &
478 == coag_dist_tag_request_particle)
479 call mpi_get_count(status, mpi_character, buffer_size, ierr)
481 call
assert(190658659, buffer_size <= coag_dist_max_buffer_size)
482 remote_proc = status(mpi_source)
487 call
assert(895128380, position == buffer_size)
490 if (aero_state%aero_sorted%size_class%inverse(request_bin, &
491 s1)%n_entry == 0)
then
496 request_bin, s1, aero_particle)
510 integer,
intent(in) :: dest_proc
512 integer,
intent(in) :: i_bin
515 character :: buffer(coag_dist_max_buffer_size)
516 integer :: buffer_size, max_buffer_size, position, ierr
520 call
assert(744787119, max_buffer_size <= coag_dist_max_buffer_size)
523 call
assert(445960340, position <= max_buffer_size)
524 buffer_size = position
525 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
526 coag_dist_tag_return_no_particle, mpi_comm_world, ierr)
537 type(request_t),
intent(inout) :: requests(coag_dist_max_requests)
544 logical :: found_request
545 integer :: buffer_size, position, sent_bin, sent_proc, i_req
546 integer :: ierr, status(mpi_status_size)
547 character :: buffer(coag_dist_max_buffer_size)
550 call mpi_recv(buffer, coag_dist_max_buffer_size, mpi_character, &
551 mpi_any_source, coag_dist_tag_return_no_particle, &
552 mpi_comm_world, status, ierr)
554 call
assert(918153221, status(mpi_tag) &
555 == coag_dist_tag_return_no_particle)
556 call mpi_get_count(status, mpi_character, buffer_size, ierr)
558 call
assert(461111487, buffer_size <= coag_dist_max_buffer_size)
559 sent_proc = status(mpi_source)
564 call
assert(518172999, position == buffer_size)
567 found_request = .false.
568 do i_req = 1,coag_dist_max_requests
569 if ((requests(i_req)%remote_proc == sent_proc) &
570 .and. (requests(i_req)%remote_bin == sent_bin))
then
571 found_request = .true.
575 call
assert(215612776, found_request)
581 requests(i_req)%local_aero_particle, allow_resort=.false.)
595 integer,
intent(in) :: i_bin
597 integer,
intent(in) :: dest_proc
600 character :: buffer(coag_dist_max_buffer_size)
601 integer :: buffer_size, max_buffer_size, position, ierr
605 max_buffer_size = max_buffer_size &
607 call
assert(496283814, max_buffer_size <= coag_dist_max_buffer_size)
611 call
assert(263666386, position <= max_buffer_size)
612 buffer_size = position
613 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
614 coag_dist_tag_return_req_particle, mpi_comm_world, ierr)
623 aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
627 type(request_t),
intent(inout) :: requests(coag_dist_max_requests)
637 real(kind=dp),
intent(in) :: accept_factors(:,:)
639 integer,
intent(in) :: coag_kernel_type
641 integer,
intent(inout) :: tot_n_coag
643 real(kind=dp),
intent(in) :: magnitudes(:,:)
645 integer,
parameter :: s1 = 1
646 integer,
parameter :: s2 = 1
647 integer,
parameter :: sc = 1
650 logical :: found_request, remove_1, remove_2
651 integer :: buffer_size, position, sent_bin, sent_proc, i_req
652 integer :: ierr, status(mpi_status_size)
653 character :: buffer(coag_dist_max_buffer_size)
655 real(kind=dp) :: k, p
658 call mpi_recv(buffer, coag_dist_max_buffer_size, mpi_character, &
659 mpi_any_source, coag_dist_tag_return_req_particle, &
660 mpi_comm_world, status, ierr)
662 call
assert(133285061, status(mpi_tag) &
663 == coag_dist_tag_return_req_particle)
664 call mpi_get_count(status, mpi_character, buffer_size, ierr)
666 call
assert(563012836, buffer_size <= coag_dist_max_buffer_size)
667 sent_proc = status(mpi_source)
674 call
assert(753356021, position == buffer_size)
677 found_request = .false.
678 do i_req = 1,coag_dist_max_requests
679 if ((requests(i_req)%remote_proc == sent_proc) &
680 .and. (requests(i_req)%remote_bin == sent_bin))
then
681 found_request = .true.
685 call
assert(579308475, found_request)
689 requests(i_req)%local_aero_particle, sent_aero_particle, &
690 s1, s2, sc, aero_data, aero_weight_total, env_state, k)
691 p = k * accept_factors(requests(i_req)%local_bin, sent_bin)
695 tot_n_coag = tot_n_coag + 1
697 requests(i_req)%local_aero_particle, sent_aero_particle, &
698 sent_proc, aero_weight_total, magnitudes, remove_1, remove_2)
705 if (.not. remove_1)
then
709 requests(i_req)%local_aero_particle, allow_resort=.false.)
711 if (.not. remove_2)
then
729 integer,
intent(in) :: dest_proc
732 character :: buffer(coag_dist_max_buffer_size)
733 integer :: buffer_size, max_buffer_size, position, ierr
736 max_buffer_size = max_buffer_size &
738 call
assert(414990602, max_buffer_size <= coag_dist_max_buffer_size)
741 call
assert(898537822, position <= max_buffer_size)
742 buffer_size = position
743 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
744 coag_dist_tag_return_unreq_particle, mpi_comm_world, ierr)
758 logical :: found_request
759 integer :: buffer_size, position, sent_proc, ierr
760 character :: buffer(coag_dist_max_buffer_size)
762 integer :: status(mpi_status_size), send_proc
765 call mpi_recv(buffer, coag_dist_max_buffer_size, mpi_character, &
766 mpi_any_source, coag_dist_tag_return_unreq_particle, &
767 mpi_comm_world, status, ierr)
769 call
assert(496247788, status(mpi_tag) &
770 == coag_dist_tag_return_unreq_particle)
771 call mpi_get_count(status, mpi_character, buffer_size, ierr)
773 call
assert(590644042, buffer_size <= coag_dist_max_buffer_size)
774 sent_proc = status(mpi_source)
780 call
assert(833588594, position == buffer_size)
784 allow_resort=.false.)
797 integer,
intent(in) :: dest_proc
800 character :: buffer(coag_dist_max_buffer_size)
801 integer :: buffer_size, ierr
804 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
805 coag_dist_tag_done, mpi_comm_world, ierr)
817 logical,
intent(inout) :: procs_done(:)
820 integer :: buffer_size, sent_proc, ierr
821 character :: buffer(coag_dist_max_buffer_size)
822 integer :: status(mpi_status_size)
825 call mpi_recv(buffer, coag_dist_max_buffer_size, mpi_character, &
826 mpi_any_source, coag_dist_tag_done, mpi_comm_world, &
829 call
assert(348737947, status(mpi_tag) &
830 == coag_dist_tag_done)
831 call mpi_get_count(status, mpi_character, buffer_size, ierr)
833 call
assert(214904056, buffer_size == 0)
834 sent_proc = status(mpi_source)
837 procs_done(sent_proc + 1) = .true.
846 k_max, n_samps, accept_factors)
849 integer,
intent(in) :: n_parts(:,:)
851 real(kind=dp),
intent(in) :: del_t
857 real(kind=dp),
intent(in) :: k_max(:,:)
859 integer,
intent(out) :: n_samps(:,:)
861 real(kind=dp),
intent(out) :: accept_factors(:,:)
863 integer :: i_bin, j_bin, rank, n_bin
864 real(kind=dp) :: n_samp_mean
866 n_bin =
size(k_max, 1)
870 if (n_parts(i_bin, rank + 1) == 0) &
872 do j_bin = i_bin,n_bin
874 sum(n_parts(j_bin, :)), (i_bin == j_bin), &
875 k_max(i_bin, j_bin), del_t, n_samp_mean, &
876 n_samps(i_bin, j_bin), accept_factors(i_bin, j_bin))
885 aero_particle_2, remote_proc, aero_weight_total, magnitudes, &
897 integer,
intent(in) :: remote_proc
901 real(kind=dp),
intent(in) :: magnitudes(:,:)
903 logical,
intent(out) :: remove_1
905 logical,
intent(out) :: remove_2
907 integer,
parameter :: s1 = 1
908 integer,
parameter :: s2 = 1
909 integer,
parameter :: sc = 1
912 integer :: new_proc, new_group
913 type(aero_info_t
) :: aero_info_1, aero_info_2
914 logical :: create_new, id_1_lost, id_2_lost
921 aero_particle_new, s1, s2, sc, aero_data, aero_state%awa, &
922 remove_1, remove_2, create_new, id_1_lost, id_2_lost, &
923 aero_info_1, aero_info_2)
938 aero_particle_new%weight_group = new_group
subroutine coag_dist_recv(requests, env_state, aero_weight_total, aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, magnitudes, procs_done)
subroutine send_request_particle(remote_proc, remote_bin)
subroutine pmc_mpi_pack_aero_particle(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine generate_n_samps(n_parts, del_t, bin_grid, aero_weight_array, k_max, n_samps, accept_factors)
generate the number of samples to do per bin pair.
The aero_data_t structure and associated subroutines.
integer function pmc_mpi_pack_size_integer(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 pmc_mpi_unpack_aero_particle(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine add_coagulation_requests(aero_state, requests, n_parts, local_bin, remote_bin, n_samps, samps_remaining)
logical function any_requests_active(requests)
Returns .true. if any of the requests are active, otherwise returns .false.
subroutine aero_info_allocate(aero_info)
Allocates and initializes.
subroutine num_conc_weighted_kernel(coag_kernel_type, aero_particle_1, aero_particle_2, i_class, j_class, ij_class, aero_data, aero_weight_array, env_state, k)
Compute the kernel value with the given number concentration weighting.
subroutine max_coag_num_conc_factor(aero_weight_array, bin_grid, i_bin, j_bin, i_class, j_class, ij_class, f_max)
Determine the minimum and maximum number concentration factors for coagulation.
subroutine aero_particle_deallocate(aero_particle)
Deallocates memory associated with an aero_particle_t.
The env_state_t structure and associated subroutines.
Aerosol particle coagulation.
subroutine aero_state_add_particle(aero_state, aero_particle, allow_resort)
Add the given particle.
integer function sample_cts_pdf(pdf)
Sample the given continuous probability density function.
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
subroutine request_deallocate(request)
Deallocate a request object and set it to be invalid.
subroutine coagulate_weighting(pt1, pt2, ptc, c1, c2, cc, aero_data, aero_weight_array, remove_1, remove_2, create_new, id_1_lost, id_2_lost, aero_info_1, aero_info_2)
Actually coagulate pt1 and pt2 to form ptc and compute weighting effects, including which particles s...
subroutine aero_info_array_add_aero_info(aero_info_array, aero_info)
Adds the given aero_info to the end of the array.
elemental real(kind=dp) function aero_particle_radius(aero_particle)
Total radius of the particle (m).
subroutine est_k_minmax_binned_unweighted(bin_grid, coag_kernel_type, aero_data, env_state, k_min, k_max)
Estimate an array of minimum and maximum kernel values. Given particles v1 in bin b1 and v2 in bin b2...
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...
Parallel aerosol particle coagulation with MPI.
subroutine send_return_req_particle(aero_particle, i_bin, dest_proc)
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
integer function pmc_mpi_size()
Returns the total number of processes.
subroutine coagulate_dist(aero_data, aero_state, aero_particle_1, aero_particle_2, remote_proc, aero_weight_total, magnitudes, remove_1, remove_2)
subroutine compute_n_samp(ni, nj, same_bin, k_max, del_t, n_samp_mean, n_samp, accept_factor)
Compute the number of samples required for the pair of bins.
Common utility subroutines.
subroutine request_allocate(request)
Current environment state.
subroutine aero_state_sort(aero_state, bin_grid, all_procs_same)
Sorts the particles if necessary.
subroutine aero_weight_array_allocate(aero_weight_array)
Allocates an aero_weight_array.
subroutine send_return_unreq_particle(aero_particle, dest_proc)
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
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.
An array of aerosol size distribution weighting functions.
The aero_state_t structure and assocated subroutines.
integer function pmc_mpi_rank()
Returns the rank of the current process.
subroutine recv_return_no_particle(requests, aero_data, aero_state)
subroutine send_done(dest_proc)
Send a message saying that this process is finished with its coagulation.
Wrapper functions for MPI.
integer function aero_sorted_n_class(aero_sorted)
Returns the number of weight classes.
The aero_weight_array_t structure and associated subroutines.
subroutine update_n_samps(n_samps, local_bin, remote_bin, samps_remaining)
subroutine aero_particle_allocate(aero_particle)
Allocates memory in an aero_particle_t.
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
The current collection of aerosol particles.
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 find_rand_remote_proc(n_parts, remote_bin, remote_proc)
subroutine mc_coag_dist(coag_kernel_type, env_state, aero_data, aero_state, del_t, tot_n_samp, tot_n_coag)
Do coagulation for time del_t.
subroutine pmc_mpi_barrier()
Synchronize all processes.
A single outstanding request for a remote particle.
subroutine recv_return_unreq_particle(aero_state)
integer function sample_disc_pdf(pdf)
Sample the given discrete probability density function.
subroutine recv_request_particle(aero_state)
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
integer function pmc_mpi_pack_size_aero_particle(val)
Determines the number of bytes required to pack the given value.
Aerosol material properties and associated data.
subroutine pmc_mpi_allgather_real_array(send, recv)
Does an allgather of real arrays (must be the same size on all processes).
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine pmc_mpi_allgather_integer_array(send, recv)
Does an allgather of integer arrays (must be the same size on all processes).
subroutine recv_done(procs_done)
Receive a done message.
subroutine recv_return_req_particle(requests, env_state, aero_weight_total, aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, magnitudes)
logical function request_is_active(request)
Whether the given reqest object is currectly active.
subroutine send_return_no_particle(dest_proc, i_bin)
subroutine aero_weight_array_copy(aero_weight_array_from, aero_weight_array_to)
Copy an aero_weight_array.