Gathers locally-updated matrix cell values and broadcasts to the global mesh.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(flow_mpi_t), | intent(inout) | :: | flow | |||
| real(kind=rk), | intent(in) | :: | local_global(:,:) | |||
| real(kind=rk), | intent(out) | :: | global(:,:) |
subroutine flow_allgather_owned_matrix(flow, local_global, global) use mod_profiling, only : profiler_start, profiler_stop type(flow_mpi_t), intent(inout) :: flow real(rk), intent(in) :: local_global(:,:) real(rk), intent(out) :: global(:,:) integer :: ierr, ncomp, ncells, nlocal_comp integer :: c, k, r, first, pos, recv_pos ncomp = size(global, 1) ncells = size(global, 2) if (size(local_global, 1) /= ncomp .or. size(local_global, 2) /= ncells) then call fatal_error('mpi_flow', 'owned matrix gather shape mismatch') end if 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) = local_global(k, c) end do end do call profiler_start('MPI_Communication') call MPI_Allgatherv(flow%gather_matrix_sendbuf, nlocal_comp, MPI_DOUBLE_PRECISION, & flow%gather_matrix_recvbuf, flow%gather_matrix_counts, & flow%gather_matrix_displs, MPI_DOUBLE_PRECISION, flow%comm, ierr) call check_mpi(ierr, 'MPI_Allgatherv owned matrix') call profiler_stop('MPI_Communication') global = 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 global(k, c) = flow%gather_matrix_recvbuf(recv_pos) end do end do end do end subroutine flow_allgather_owned_matrix