54 integer :: remote_proc
73 request%active = .false.
85 request%active = .false.
104 subroutine mc_coag_dist(coag_kernel_type, env_state, aero_data, &
105 aero_state, del_t, tot_n_samp, tot_n_coag)
108 integer,
intent(in) :: coag_kernel_type
116 real(kind=dp),
intent(in) :: del_t
118 integer,
intent(out) :: tot_n_samp
120 integer,
intent(out) :: tot_n_coag
122 integer,
parameter :: s1 = 1
123 integer,
parameter :: s2 = 1
124 integer,
parameter :: sc = 1
127 logical :: samps_remaining, sent_dones
128 integer :: i_bin, j_bin, n_samp, i_samp, i_proc, n_proc
129 integer :: ierr, status(mpi_status_size), current_i, current_j, i_req
130 real(kind=dp) :: n_samp_real, f_max
131 integer,
allocatable :: n_parts(:,:)
132 real(kind=dp),
allocatable :: magnitudes(:,:)
134 integer,
allocatable :: n_samps(:,:)
135 real(kind=dp),
allocatable :: accept_factors(:,:), k_max(:,:)
136 logical,
allocatable :: procs_done(:)
138 integer :: outgoing_buffer_size_check
142 aero_sorted_n_class(aero_state%aero_sorted) == 1, &
143 "FIXME: mc_coag_dist() can only handle one weight class")
150 if (.not. aero_state%aero_sorted%coag_kernel_bounds_valid)
then 151 call est_k_minmax_binned_unweighted(aero_state%aero_sorted%bin_grid, &
152 coag_kernel_type, aero_data, env_state, &
153 aero_state%aero_sorted%coag_kernel_min, &
154 aero_state%aero_sorted%coag_kernel_max)
155 aero_state%aero_sorted%coag_kernel_bounds_valid = .true.
158 allocate(n_samps(
bin_grid_size(aero_state%aero_sorted%bin_grid), &
160 allocate(accept_factors(
bin_grid_size(aero_state%aero_sorted%bin_grid), &
163 allocate(n_parts(
bin_grid_size(aero_state%aero_sorted%bin_grid), n_proc))
165 aero_state%aero_sorted%size_class%inverse(:, s1)), n_parts)
167 allocate(magnitudes(
size(aero_state%awa%weight), n_proc))
171 aero_weight_total = aero_state%awa
172 aero_weight_total%weight(:, s1)%magnitude = 1d0 / sum(1d0 / magnitudes, 2)
174 allocate(k_max(
bin_grid_size(aero_state%aero_sorted%bin_grid), &
178 call max_coag_num_conc_factor(aero_weight_total, &
179 aero_data, aero_state%aero_sorted%bin_grid, &
180 i_bin, j_bin, s1, s2, sc, f_max)
181 k_max(i_bin, j_bin) &
182 = aero_state%aero_sorted%coag_kernel_max(i_bin, j_bin) * f_max
187 aero_weight_total, k_max, n_samps, accept_factors)
188 tot_n_samp = sum(n_samps)
195 samps_remaining = .true.
198 allocate(procs_done(n_proc))
201 call mpi_buffer_attach(outgoing_buffer, &
204 do while (.not. all(procs_done))
207 current_i, current_j, n_samps, samps_remaining)
210 if (.not. sent_dones)
then 213 do i_proc = 0, (n_proc - 1)
220 call coag_dist_recv(requests, env_state, aero_weight_total, aero_data, &
221 aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
222 magnitudes, procs_done)
229 deallocate(procs_done)
231 deallocate(accept_factors)
233 deallocate(magnitudes)
234 call mpi_buffer_detach(outgoing_buffer, &
235 outgoing_buffer_size_check, ierr)
245 subroutine coag_dist_recv(requests, env_state, aero_weight_total, &
246 aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
247 magnitudes, procs_done)
260 real(kind=dp),
intent(in) :: accept_factors(:,:)
262 integer,
intent(in) :: coag_kernel_type
264 integer,
intent(inout) :: tot_n_coag
266 real(kind=dp),
intent(in) :: magnitudes(:,:)
268 logical,
intent(inout) :: procs_done(:)
271 integer :: status(mpi_status_size), ierr
273 call mpi_probe(mpi_any_source, mpi_any_tag, mpi_comm_world, &
280 aero_data, aero_state, accept_factors, coag_kernel_type, &
281 tot_n_coag, magnitudes)
299 local_bin, remote_bin, n_samps, samps_remaining)
306 integer,
intent(in) :: n_parts(:,:)
308 integer,
intent(inout) :: local_bin
310 integer,
intent(inout) :: remote_bin
312 integer,
intent(inout) :: n_samps(:,:)
314 logical,
intent(inout) :: samps_remaining
316 integer,
parameter :: s1 = 1
317 integer,
parameter :: s2 = 1
318 integer,
parameter :: sc = 1
322 if (.not. samps_remaining)
return 329 if (.not. samps_remaining)
exit outer
330 if (integer_varray_n_entry( &
331 aero_state%aero_sorted%size_class%inverse(local_bin, s2)) &
334 requests(i_req)%remote_proc)
335 requests(i_req)%active = .true.
336 requests(i_req)%local_bin = local_bin
337 requests(i_req)%remote_bin = remote_bin
339 local_bin, s2, requests(i_req)%local_aero_particle)
341 requests(i_req)%remote_bin)
376 integer,
intent(in) :: n_parts(:,:)
378 integer,
intent(in) :: remote_bin
380 integer,
intent(out) :: remote_proc
391 subroutine update_n_samps(n_samps, local_bin, remote_bin, samps_remaining)
394 integer,
intent(inout) :: n_samps(:,:)
396 integer,
intent(inout) :: local_bin
398 integer,
intent(inout) :: remote_bin
400 logical,
intent(inout) :: samps_remaining
404 if (.not. samps_remaining)
return 406 n_bin =
size(n_samps, 1)
408 if (n_samps(local_bin, remote_bin) > 0)
exit 410 remote_bin = remote_bin + 1
411 if (remote_bin > n_bin)
then 413 local_bin = local_bin + 1
415 if (local_bin > n_bin)
exit 418 if (local_bin > n_bin)
then 419 samps_remaining = .false.
421 n_samps(local_bin, remote_bin) = n_samps(local_bin, remote_bin) - 1
431 integer,
intent(in) :: remote_proc
433 integer,
intent(in) :: remote_bin
437 integer :: buffer_size, max_buffer_size, position, ierr
444 call assert(610314213, position <= max_buffer_size)
445 buffer_size = position
446 call mpi_bsend(buffer, buffer_size, mpi_character, remote_proc, &
460 integer,
parameter :: s1 = 1
461 integer,
parameter :: s2 = 1
462 integer,
parameter :: sc = 1
465 integer :: buffer_size, position, request_bin, sent_proc
466 integer :: ierr, remote_proc, status(mpi_status_size)
475 call assert(920139874, status(mpi_tag) &
477 call mpi_get_count(status, mpi_character, buffer_size, ierr)
480 remote_proc = status(mpi_source)
485 call assert(895128380, position == buffer_size)
488 if (integer_varray_n_entry( &
489 aero_state%aero_sorted%size_class%inverse(request_bin, s1)) == 0)
then 493 request_bin, s1, aero_particle)
506 integer,
intent(in) :: dest_proc
508 integer,
intent(in) :: i_bin
512 integer :: buffer_size, max_buffer_size, position, ierr
519 call assert(445960340, position <= max_buffer_size)
520 buffer_size = position
521 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
540 logical :: found_request
541 integer :: buffer_size, position, sent_bin, sent_proc, i_req
542 integer :: ierr, status(mpi_status_size)
548 mpi_comm_world, status, ierr)
550 call assert(918153221, status(mpi_tag) &
552 call mpi_get_count(status, mpi_character, buffer_size, ierr)
555 sent_proc = status(mpi_source)
560 call assert(518172999, position == buffer_size)
563 found_request = .false.
565 if ((requests(i_req)%remote_proc == sent_proc) &
566 .and. (requests(i_req)%remote_bin == sent_bin))
then 567 found_request = .true.
571 call assert(215612776, found_request)
577 requests(i_req)%local_aero_particle, aero_data, &
578 allow_resort=.false.)
592 integer,
intent(in) :: i_bin
594 integer,
intent(in) :: dest_proc
598 integer :: buffer_size, max_buffer_size, position, ierr
602 max_buffer_size = max_buffer_size &
608 call assert(263666386, position <= max_buffer_size)
609 buffer_size = position
610 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
620 aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, &
634 real(kind=dp),
intent(in) :: accept_factors(:,:)
636 integer,
intent(in) :: coag_kernel_type
638 integer,
intent(inout) :: tot_n_coag
640 real(kind=dp),
intent(in) :: magnitudes(:,:)
642 integer,
parameter :: s1 = 1
643 integer,
parameter :: s2 = 1
644 integer,
parameter :: sc = 1
647 logical :: found_request, remove_1, remove_2
648 integer :: buffer_size, position, sent_bin, sent_proc, i_req
649 integer :: ierr, status(mpi_status_size)
652 real(kind=dp) :: k, p
657 mpi_comm_world, status, ierr)
659 call assert(133285061, status(mpi_tag) &
661 call mpi_get_count(status, mpi_character, buffer_size, ierr)
664 sent_proc = status(mpi_source)
670 call assert(753356021, position == buffer_size)
673 found_request = .false.
675 if ((requests(i_req)%remote_proc == sent_proc) &
676 .and. (requests(i_req)%remote_bin == sent_bin))
then 677 found_request = .true.
681 call assert(579308475, found_request)
684 call num_conc_weighted_kernel(coag_kernel_type, &
685 requests(i_req)%local_aero_particle, sent_aero_particle, &
686 s1, s2, sc, aero_data, aero_weight_total, env_state, k)
687 p = k * accept_factors(requests(i_req)%local_bin, sent_bin)
691 tot_n_coag = tot_n_coag + 1
693 requests(i_req)%local_aero_particle, sent_aero_particle, &
694 sent_proc, aero_weight_total, magnitudes, remove_1, remove_2)
701 if (.not. remove_1)
then 705 requests(i_req)%local_aero_particle, aero_data, &
706 allow_resort=.false.)
708 if (.not. remove_2)
then 725 integer,
intent(in) :: dest_proc
729 integer :: buffer_size, max_buffer_size, position, ierr
732 max_buffer_size = max_buffer_size &
737 call assert(898537822, position <= max_buffer_size)
738 buffer_size = position
739 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
756 logical :: found_request
757 integer :: buffer_size, position, sent_proc, ierr
760 integer :: status(mpi_status_size), send_proc
765 mpi_comm_world, status, ierr)
767 call assert(496247788, status(mpi_tag) &
769 call mpi_get_count(status, mpi_character, buffer_size, ierr)
772 sent_proc = status(mpi_source)
777 call assert(833588594, position == buffer_size)
781 allow_resort=.false.)
793 integer,
intent(in) :: dest_proc
797 integer :: buffer_size, ierr
800 call mpi_bsend(buffer, buffer_size, mpi_character, dest_proc, &
813 logical,
intent(inout) :: procs_done(:)
816 integer :: buffer_size, sent_proc, ierr
818 integer :: status(mpi_status_size)
825 call assert(348737947, status(mpi_tag) &
827 call mpi_get_count(status, mpi_character, buffer_size, ierr)
829 call assert(214904056, buffer_size == 0)
830 sent_proc = status(mpi_source)
833 procs_done(sent_proc + 1) = .true.
842 k_max, n_samps, accept_factors)
845 integer,
intent(in) :: n_parts(:,:)
847 real(kind=dp),
intent(in) :: del_t
853 real(kind=dp),
intent(in) :: k_max(:,:)
855 integer,
intent(out) :: n_samps(:,:)
857 real(kind=dp),
intent(out) :: accept_factors(:,:)
859 integer :: i_bin, j_bin, rank, n_bin
860 real(kind=dp) :: n_samp_mean
862 n_bin =
size(k_max, 1)
866 if (n_parts(i_bin, rank + 1) == 0) &
868 do j_bin = i_bin,n_bin
870 sum(n_parts(j_bin, :)), (i_bin == j_bin), &
871 k_max(i_bin, j_bin), del_t, n_samp_mean, &
872 n_samps(i_bin, j_bin), accept_factors(i_bin, j_bin))
880 subroutine coagulate_dist(aero_data, aero_state, aero_particle_1, &
881 aero_particle_2, remote_proc, aero_weight_total, magnitudes, &
893 integer,
intent(in) :: remote_proc
897 real(kind=dp),
intent(in) :: magnitudes(:,:)
899 logical,
intent(out) :: remove_1
901 logical,
intent(out) :: remove_2
903 integer,
parameter :: s1 = 1
904 integer,
parameter :: s2 = 1
905 integer,
parameter :: sc = 1
908 integer :: new_proc, new_group
909 type(aero_info_t) :: aero_info_1, aero_info_2
910 logical :: create_new, id_1_lost, id_2_lost
913 aero_particle_new, s1, s2, sc, aero_data, aero_state%awa, &
914 remove_1, remove_2, create_new, id_1_lost, id_2_lost, &
915 aero_info_1, aero_info_2)
918 call aero_info_array_add_aero_info(aero_state%aero_info_array, &
922 call aero_info_array_add_aero_info(aero_state%aero_info_array, &
930 aero_particle_new%weight_group = new_group
elemental real(kind=dp) function aero_particle_radius(aero_particle, aero_data)
Total radius of the particle (m).
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
integer, parameter coag_dist_tag_request_particle
integer, parameter coag_dist_tag_return_no_particle
subroutine aero_state_sort(aero_state, aero_data, bin_grid, all_procs_same)
Sorts the particles if necessary.
integer function pmc_mpi_rank()
Returns the rank of the current process.
The aero_weight_array_t structure and associated subroutines.
subroutine pmc_mpi_allgather_integer_array(send, recv)
Does an allgather of integer arrays (must be the same size on all processes).
subroutine request_deallocate(request)
Deallocate a request object and set it to be invalid.
integer, parameter coag_dist_max_requests
The bin_grid_t structure and associated subroutines.
subroutine find_rand_remote_proc(n_parts, remote_bin, remote_proc)
integer, parameter coag_dist_tag_return_req_particle
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.
The env_state_t structure and associated subroutines.
subroutine pmc_mpi_unpack_aero_particle(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine recv_return_no_particle(requests, aero_data, aero_state)
subroutine send_return_no_particle(dest_proc, i_bin)
integer, parameter coag_dist_tag_done
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine recv_return_unreq_particle(aero_state, aero_data)
logical function any_requests_active(requests)
Returns .true. if any of the requests are active, otherwise returns .false.
real(kind=dp) function pmc_random()
Returns a random number between 0 and 1.
subroutine send_return_req_particle(aero_particle, i_bin, dest_proc)
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_state_t structure and assocated subroutines.
subroutine pmc_mpi_barrier()
Synchronize all processes.
Aerosol particle coagulation.
subroutine recv_done(procs_done)
Receive a done message.
Parallel aerosol particle coagulation with MPI.
Current environment state.
subroutine coagulate_dist(aero_data, aero_state, aero_particle_1, aero_particle_2, remote_proc, aero_weight_total, magnitudes, remove_1, remove_2)
An array of aerosol size distribution weighting functions.
subroutine die_msg(code, error_msg)
Error immediately.
integer function sample_cts_pdf(pdf)
Sample the given continuous probability density function.
subroutine send_request_particle(remote_proc, remote_bin)
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.
The current collection of aerosol particles.
subroutine add_coagulation_requests(aero_state, requests, n_parts, local_bin, remote_bin, n_samps, samps_remaining)
The aero_data_t structure and associated subroutines.
subroutine send_return_unreq_particle(aero_particle, dest_proc)
Single aerosol particle data structure.
logical function request_is_active(request)
Whether the given reqest object is currectly active.
1D grid, either logarithmic or linear.
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.
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine pmc_mpi_pack_aero_particle(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine request_allocate(request)
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_check_ierr(ierr)
Dies if ierr is not ok.
integer function sample_disc_pdf(pdf)
Sample the given discrete probability density function.
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...
A single outstanding request for a remote particle.
subroutine recv_return_req_particle(requests, env_state, aero_weight_total, aero_data, aero_state, accept_factors, coag_kernel_type, tot_n_coag, magnitudes)
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)
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
integer, parameter coag_dist_outgoing_buffer_size
Size of the outgoing buffer for bsend (bytes).
integer function pmc_mpi_pack_size_aero_particle(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
integer, parameter coag_dist_tag_return_unreq_particle
subroutine send_done(dest_proc)
Send a message saying that this process is finished with its coagulation.
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
subroutine update_n_samps(n_samps, local_bin, remote_bin, samps_remaining)
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.
Common utility subroutines.
subroutine recv_request_particle(aero_state)
Wrapper functions for MPI.
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.
subroutine pmc_mpi_allgather_real_array(send, recv)
Does an allgather of real arrays (must be the same size on all processes).
integer, parameter coag_dist_max_buffer_size
Size of send and receive buffer for each message (bytes).