flow_allgather_owned_v4 Subroutine

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

Uses

  • proc~~flow_allgather_owned_v4~~UsesGraph proc~flow_allgather_owned_v4 mod_mpi_flow::flow_allgather_owned_v4 module~mod_profiler mod_profiler proc~flow_allgather_owned_v4->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 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(:)

Calls

proc~~flow_allgather_owned_v4~~CallsGraph proc~flow_allgather_owned_v4 mod_mpi_flow::flow_allgather_owned_v4 mpi_allgatherv mpi_allgatherv proc~flow_allgather_owned_v4->mpi_allgatherv proc~check_mpi~2 mod_mpi_flow::check_mpi proc~flow_allgather_owned_v4->proc~check_mpi~2 proc~fatal_error mod_kinds::fatal_error proc~flow_allgather_owned_v4->proc~fatal_error proc~prepare_matrix_gather mod_mpi_flow::prepare_matrix_gather proc~flow_allgather_owned_v4->proc~prepare_matrix_gather proc~profiler_start mod_profiler::profiler_start proc~flow_allgather_owned_v4->proc~profiler_start proc~profiler_stop mod_profiler::profiler_stop proc~flow_allgather_owned_v4->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

Source Code

   subroutine flow_allgather_owned_v4(flow, local_v, local_s, global_v, global_s)
      use mod_profiler, 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