flow_gather_owned_matrix_root Subroutine

public subroutine flow_gather_owned_matrix_root(flow, field, root_field)

Gathers owned matrix cell values to rank 0 only.

Arguments

Type IntentOptional Attributes Name
type(flow_mpi_t), intent(inout) :: flow
real(kind=rk), intent(in) :: field(:,:)
real(kind=rk), intent(inout) :: root_field(:,:)

Source Code

   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