Gathers owned matrix cell values to rank 0 only.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(flow_mpi_t), | intent(inout) | :: | flow | |||
| real(kind=rk), | intent(in) | :: | field(:,:) | |||
| real(kind=rk), | intent(inout) | :: | root_field(:,:) |
subroutine flow_gather_owned_matrix_root(flow, field, root_field) use mod_profiling, only : profiler_start, profiler_stop type(flow_mpi_t), intent(inout) :: flow real(rk), intent(in) :: field(:,:) real(rk), intent(inout) :: root_field(:,:) integer :: ierr, ncomp, ncells, nlocal_comp integer :: c, k, r, first, pos, recv_pos ncomp = size(field, 1) ncells = size(field, 2) call prepare_matrix_gather(flow, ncomp, ncells, nlocal_comp) pos = 0 do c = flow%first_cell, flow%last_cell do k = 1, ncomp pos = pos + 1 flow%gather_matrix_sendbuf(pos) = field(k, c) end do end do call profiler_start('MPI_Communication') call MPI_Gatherv(flow%gather_matrix_sendbuf, nlocal_comp, MPI_DOUBLE_PRECISION, & flow%gather_matrix_recvbuf, flow%gather_matrix_counts, & flow%gather_matrix_displs, MPI_DOUBLE_PRECISION, 0, flow%comm, ierr) call check_mpi(ierr, 'MPI_Gatherv owned matrix root') call profiler_stop('MPI_Communication') if (flow%rank == 0) then root_field = zero do r = 1, flow%nprocs first = flow%gather_firsts(r) recv_pos = flow%gather_matrix_displs(r) do c = first, first + flow%gather_counts(r) - 1 do k = 1, ncomp recv_pos = recv_pos + 1 root_field(k, c) = flow%gather_matrix_recvbuf(recv_pos) end do end do end do end if end subroutine flow_gather_owned_matrix_root