flow_allgather_owned_v4 Subroutine

public subroutine flow_allgather_owned_v4(flow, local_v, local_s, global_v, global_s)

Gathers 4-component cell values (e.g., Velocity + Scalar) in one call.

Arguments

Type IntentOptional Attributes Name
type(flow_mpi_t), intent(inout) :: flow
real(kind=rk), intent(in) :: local_v(:,:)
real(kind=rk), intent(in) :: local_s(:)
real(kind=rk), intent(out) :: global_v(:,:)
real(kind=rk), intent(out) :: global_s(:)

Source Code

   subroutine flow_allgather_owned_v4(flow, local_v, local_s, global_v, global_s)
      use mod_profiling, only : profiler_start, profiler_stop
      type(flow_mpi_t), intent(inout) :: flow
      real(rk), intent(in) :: local_v(:,:), local_s(:)
      real(rk), intent(out) :: global_v(:,:), global_s(:)
      integer :: ierr, nlocal4, ncells
      integer :: c, i, r, first, recv_pos

      ncells = size(global_s)
      if (size(local_s) /= ncells .or. size(global_v, 2) /= ncells .or. &
          size(local_v, 2) /= ncells .or. size(local_v, 1) /= 3 .or. &
          size(global_v, 1) /= 3) then
         call fatal_error('mpi_flow', 'owned v4 gather shape mismatch')
      end if

      call prepare_matrix_gather(flow, 4, ncells, nlocal4)

      ! Pack: (U, V, W, S) for owned cells
      i = 0
      do c = flow%first_cell, flow%last_cell
         flow%gather_matrix_sendbuf(i + 1:i + 3) = local_v(:, c)
         flow%gather_matrix_sendbuf(i + 4) = local_s(c)
         i = i + 4
      end do

      call profiler_start('MPI_Communication')
      call MPI_Allgatherv(flow%gather_matrix_sendbuf, nlocal4, 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 v4')
      call profiler_stop('MPI_Communication')

      global_v = zero
      global_s = 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
            global_v(:, c) = flow%gather_matrix_recvbuf(recv_pos + 1:recv_pos + 3)
            global_s(c) = flow%gather_matrix_recvbuf(recv_pos + 4)
            recv_pos = recv_pos + 4
         end do
      end do
   end subroutine flow_allgather_owned_v4