Specify minimum buffer size (per process) for communication
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(mg_t), | intent(inout) | :: | mg | |||
| integer, | intent(out) | :: | n_send(0:mg%n_cpu-1) | |||
| integer, | intent(out) | :: | n_recv(0:mg%n_cpu-1) | |||
| integer, | intent(out) | :: | dsize |
subroutine mg_restrict_buffer_size(mg, n_send, n_recv, dsize) type(mg_t), intent(inout) :: mg integer, intent(out) :: n_send(0:mg%n_cpu-1) integer, intent(out) :: n_recv(0:mg%n_cpu-1) integer, intent(out) :: dsize integer :: n_out(0:mg%n_cpu-1, mg%first_normal_lvl:mg%highest_lvl) integer :: n_in(0:mg%n_cpu-1, mg%first_normal_lvl:mg%highest_lvl) integer :: lvl, i, id, p_id, p_rank integer :: i_c, c_id, c_rank, min_lvl n_out(:, :) = 0 n_in(:, :) = 0 min_lvl = max(mg%lowest_lvl+1, mg%first_normal_lvl) do lvl = min_lvl, mg%highest_lvl ! Number of messages to receive (at lvl-1) do i = 1, size(mg%lvls(lvl-1)%my_parents) id = mg%lvls(lvl-1)%my_parents(i) do i_c = 1, mg_num_children c_id = mg%boxes(id)%children(i_c) if (c_id > mg_no_box) then c_rank = mg%boxes(c_id)%rank if (c_rank /= mg%my_rank) then n_in(c_rank, lvl) = n_in(c_rank, lvl) + 1 end if end if end do end do ! Number of messages to send do i = 1, size(mg%lvls(lvl)%my_ids) id = mg%lvls(lvl)%my_ids(i) p_id = mg%boxes(id)%parent p_rank = mg%boxes(p_id)%rank if (p_rank /= mg%my_rank) then n_out(p_rank, lvl) = n_out(p_rank, lvl) + 1 end if end do end do allocate(mg%comm_restrict%n_send(0:mg%n_cpu-1,& mg%first_normal_lvl:mg%highest_lvl)) allocate(mg%comm_restrict%n_recv(0:mg%n_cpu-1,& mg%first_normal_lvl:mg%highest_lvl)) mg%comm_restrict%n_send = n_out mg%comm_restrict%n_recv = n_in dsize = (mg%box_size/2)**1 n_send = maxval(n_out, dim=2) n_recv = maxval(n_in, dim=2) end subroutine mg_restrict_buffer_size