flow_allgather_owned_matrix Subroutine

public subroutine flow_allgather_owned_matrix(flow, local_global, global)

Uses

  • proc~~flow_allgather_owned_matrix~~UsesGraph proc~flow_allgather_owned_matrix mod_mpi_flow::flow_allgather_owned_matrix module~mod_profiler mod_profiler proc~flow_allgather_owned_matrix->module~mod_profiler iso_fortran_env iso_fortran_env module~mod_profiler->iso_fortran_env module~mod_kinds mod_kinds module~mod_profiler->module~mod_kinds mpi_f08 mpi_f08 module~mod_profiler->mpi_f08 module~mod_kinds->iso_fortran_env

Gathers locally-updated matrix cell values and broadcasts to the global mesh.

Arguments

Type IntentOptional Attributes Name
type(flow_mpi_t), intent(inout) :: flow
real(kind=rk), intent(in) :: local_global(:,:)
real(kind=rk), intent(out) :: global(:,:)

Calls

proc~~flow_allgather_owned_matrix~~CallsGraph proc~flow_allgather_owned_matrix mod_mpi_flow::flow_allgather_owned_matrix mpi_allgatherv mpi_allgatherv proc~flow_allgather_owned_matrix->mpi_allgatherv proc~check_mpi~2 mod_mpi_flow::check_mpi proc~flow_allgather_owned_matrix->proc~check_mpi~2 proc~fatal_error mod_kinds::fatal_error proc~flow_allgather_owned_matrix->proc~fatal_error proc~prepare_matrix_gather mod_mpi_flow::prepare_matrix_gather proc~flow_allgather_owned_matrix->proc~prepare_matrix_gather proc~profiler_start mod_profiler::profiler_start proc~flow_allgather_owned_matrix->proc~profiler_start proc~profiler_stop mod_profiler::profiler_stop proc~flow_allgather_owned_matrix->proc~profiler_stop proc~check_mpi~2->proc~fatal_error proc~prepare_matrix_gather->proc~fatal_error mpi_wtime mpi_wtime proc~profiler_start->mpi_wtime proc~find_or_create_timer mod_profiler::find_or_create_timer proc~profiler_start->proc~find_or_create_timer proc~profiler_stop->mpi_wtime proc~profiler_stop->proc~find_or_create_timer proc~record_edge mod_profiler::record_edge proc~profiler_stop->proc~record_edge

Called by

proc~~flow_allgather_owned_matrix~~CalledByGraph proc~flow_allgather_owned_matrix mod_mpi_flow::flow_allgather_owned_matrix proc~flow_allgather_owned_vector mod_mpi_flow::flow_allgather_owned_vector proc~flow_allgather_owned_vector->proc~flow_allgather_owned_matrix

Source Code

   subroutine flow_allgather_owned_matrix(flow, local_global, global)
      use mod_profiler, 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