MPI_Scatterv用MPI派生数据类型性能远低于扁平化散射的原因

数据老陈

2026-7-19

问题分析与解答

环境信息

ifort版本：(IFORT) 2021.8.0 20221119
操作系统：WSL Ubuntu 20.04LTS

问题描述

需要将1000×1000×1000的3D数组在进程间分发：

扁平化数组后调用MPI_Scatterv：耗时约7.86秒
使用MPI子数组派生类型执行MPI_Scatterv：耗时约165.34秒，但相同数据的MPI_Gatherv仅耗时14.24秒

疑问：为何派生类型的Scatterv与Gatherv性能差异巨大，且远慢于扁平化方案？

核心原因分析

1. 派生类型Scatterv性能低下的根本原因

你当前定义的子数组类型是单个[1, ny, nz]的切片，并通过resize_send_type将步长设为单个real64元素的大小。这意味着MPI_Scatterv在发送时，需要从全局数组中逐个提取离散的[1, ny, nz]切片——每个切片之间间隔了(ny*nz-1)个元素的内存空间。

MPI对离散内存块的传输无法优化为连续大块数据传输，只能逐个处理每个切片，带来了巨量的内存寻址开销和网络小数据包传输开销。而扁平化方案中，数据是连续内存块，MPI可以直接进行高效的大块数据拷贝和网络传输，这就是两者性能差距的核心。

2. Scatterv与Gatherv的性能差异

Gatherv高效的原因：每个进程发送的本地数组array_local是连续的[local_size, ny, nz]内存块。即使使用派生类型，接收端（rank0）可以直接将这些连续块拼接到全局数组的对应位置，MPI底层能将其优化为连续数据传输，开销与扁平化方案接近。
Scatterv低效的原因：rank0需要发送的是全局数组中离散分布的多个小切片，每个切片在内存中不连续，MPI无法合并这些切片为连续块发送，只能逐个处理，导致性能暴跌。

优化方案：修正派生数据类型定义

直接创建对应整个进程分配到的连续子数组的派生类型，而不是单个切片的类型。这样MPI_Scatterv可以一次性发送连续的大块数据，性能可与扁平化方案持平。

关键代码修改示例

! 替换原派生类型创建部分的代码
start_time=MPI_Wtime()
! Scattering using subarray type - 优化版本
sizes = [nx, ny, nz]
recv_sizes=[local_size, ny, nz]
! 每个进程对应的发送子数组大小是连续的local_size个nx维度的块
sub_sizes_send = [local_size, ny, nz]
starts_send = [str_idx-1, 0, 0] ! MPI索引从0开始
starts_recv = [0, 0, 0]

! 创建发送用的子数组类型：对应rank0中当前进程的连续块
call MPI_Type_create_subarray(3, sizes, sub_sizes_send, starts_send, &
  MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, send_type, mpierr)
call MPI_Type_commit(send_type, mpierr)

! 创建接收用的子数组类型：对应本地的连续数组
call MPI_Type_create_subarray(3, recv_sizes, recv_sizes, starts_recv, &
  MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, recv_type, mpierr)
call MPI_Type_commit(recv_type, mpierr)

! 修正sendcounts和displacements：每个进程发送1个连续子数组类型
sendcounts = 1
! displacements对应每个进程在全局数组中的起始nx索引（0-based）
call MPI_Allgather(str_idx-1, 1, MPI_INTEGER, displacements, 1, MPI_INTEGER, &
  MPI_COMM_WORLD, mpierr)

if(rank==0) then
  print*, "Time taken for creating optimized MPI type subarrays: ", MPI_Wtime()-start_time
endif

call MPI_Barrier(mpi_comm_world, mpierr)
start_time=MPI_Wtime()
! 优化后的Scatterv调用
call MPI_Scatterv(array, sendcounts, displacements, send_type, &
  array_local, 1, recv_type, 0, MPI_COMM_WORLD, mpierr)

if(rank==0) then
  print*, "Time taken for scattering using optimized MPI type subarrays: ", MPI_Wtime()-start_time
endif

完整测试代码（修正HTML转义后）

program ex_scatterv
  use mpi
  use iso_fortran_env, only : real64
  implicit none

!allocate arrays
  real(real64), allocatable,dimension(:,:,:) :: array, array_local
  real(real64), allocatable,dimension(:) :: array_flat, array_local_flat
  integer :: rank, num_procs, i, j, k
  integer :: nx, ny, nz, str_idx, end_idx, local_size, local_size_flat
  integer, dimension(:), allocatable :: sendcounts, displacements
  integer :: sizes(3), sub_sizes(3), starts(3), recv_starts(3), recv_sizes(3), &
    send_type, resize_send_type, recv_type, resize_recv_type
  integer(kind=8) :: lb, extent, lb_resize
  real(real64) :: start_time
  integer :: mpierr
  call mpi_init(mpierr)
  call mpi_comm_size(mpi_comm_world, num_procs, mpierr)
  call mpi_comm_rank(mpi_comm_world, rank, mpierr)

!size of array
  nx=1000
  ny=1000
  nz=1000

  if(rank==0) then
    if(num_procs>nx) then
      print*, "Number of procs should be less than or equal to first dimension of the array"
      call MPI_Abort(mpi_comm_world, 1, mpierr)
    endif
  endif

  start_time=MPI_Wtime()
!allocate in the root rank
  if(rank==0) then
    allocate(array(nx,ny,nz))
    allocate(array_flat(nx*ny*nz))
  else !for other procs allocate with zero size
    allocate(array(0,0,0))
  endif

!assign values to the array
  if(rank==0) then
    do k=1,nz
      do j=1,ny
        do i=1,nx
          array(i,j,k) = (i-1)+(j-1)*nx+(k-1)*nx*ny
        end do
      end do
    end do
!print*, "Before scattering..."
!print*, array
!flatten the 3D array
    forall(k=1:nz, j=1:ny, i=1:nx) array_flat(k+(j-1)*nz+(i-1)*ny*nz)=array(i,j,k)
  endif

!distribute the 3d array among different procs
  call distribute_points(nx, rank, num_procs, str_idx, end_idx)
  local_size = end_idx - str_idx + 1
  local_size_flat = local_size*ny*nz

!allocate local(for each rank) arrays
  allocate(array_local_flat(local_size_flat))
  allocate(array_local(local_size, ny, nz))

!allocate sendcoutns and displacements arrays for braodcasting
  allocate(sendcounts(num_procs), displacements(num_procs))

!gather displacements and sendcounts for all ranks
  call MPI_Allgather(str_idx, 1, MPI_INTEGER, displacements, 1, MPI_INTEGER, &
    MPI_COMM_WORLD, mpierr)
  call MPI_Allgather(local_size, 1, MPI_INTEGER, sendcounts, 1, &
    MPI_INTEGER, MPI_COMM_WORLD, mpierr)

!total sendcounts and displacements
  sendcounts = sendcounts*ny*nz
  displacements = displacements - 1 !Array index starts with 0 in MPI (C)
  displacements = displacements*ny*nz

!scatter the flattened array among procs
  call MPI_Scatterv(array_flat, sendcounts, displacements, MPI_DOUBLE_PRECISION, &
    array_local_flat, local_size*ny*nz, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, &
    mpierr)

!form 3D array from flattened local array
  forall(k=1:nz, j=1:ny, i=1:local_size) array_local(i,j,k) = &
    array_local_flat(k+(j-1)*nz+(i-1)*ny*nz)

!print*, "Scattered array: ", rank
!print*, array_local
  if(rank==0) then
    print*, "Time taken by flatten and scatter: ", MPI_Wtime()-start_time
  endif

  call MPI_Barrier(mpi_comm_world, mpierr)
!deallocate(array_flat, array_local_flat)

! -------------------------- 原派生类型代码 --------------------------
  start_time=MPI_Wtime()
!Scatterning using subarray type
  sizes = [nx, ny, nz]
  recv_sizes=[local_size, ny, nz]
  sub_sizes = [1, ny, nz]
  starts = [0, 0, 0]
  recv_starts = [0, 0, 0]

!to get extent of MPI_DOUBLE_PRECISION
  call MPI_Type_get_extent(MPI_DOUBLE_PRECISION, lb, extent, mpierr)

!create a mpi subarray data type for sending data
  call MPI_Type_create_subarray(3, sizes, sub_sizes, starts, &
    MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, send_type, mpierr)
  lb_resize=0
!resize the send subarray for starting at correct location for next send
  call MPI_Type_create_resized(send_type, lb_resize, extent, &
    resize_send_type, mpierr)
  call MPI_Type_commit(resize_send_type, mpierr)

!create a mpi subarray data type for receiving data
  call MPI_Type_create_subarray(3, recv_sizes, sub_sizes, recv_starts, &
    MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, recv_type, mpierr)

!resize the receive subarray for starting at correct location for next receive
  call MPI_Type_create_resized(recv_type, lb_resize, extent, &
    resize_recv_type, mpierr)
  call MPI_Type_commit(resize_recv_type, mpierr)

!sendcounts and displacement for sending and receiving subarrays
  sendcounts=sendcounts/(ny*nz)
  displacements = displacements/(ny*nz)

  if(rank==0) then
    print*, "Time taken for creating MPI type subarrays: ", MPI_Wtime()-start_time
  endif

  call MPI_Barrier(mpi_comm_world, mpierr)
  start_time=MPI_Wtime()
!scatter the subarrays
  call MPI_Scatterv(array, sendcounts, displacements, resize_send_type, &
    array_local, sendcounts, resize_recv_type, 0, MPI_COMM_WORLD, mpierr)

  if(rank==0) then
    print*, "Time taken for scattering using MPI type subarrays: ", MPI_Wtime()-start_time
  endif
  call MPI_Barrier(mpi_comm_world, mpierr)
!print the scattered array
!print*, "Scattered array with subarray: ", rank
!print*, array_local

!do some computations on the scattered local arrays
  array_local = array_local+1

  call MPI_Barrier(mpi_comm_world, mpierr)
  start_time=MPI_Wtime()
!Gather the local arrays to global (array) using the same subarrays
  call MPI_Gatherv(array_local, local_size, resize_recv_type, array, &
    sendcounts, displacements, resize_send_type, 0, MPI_COMM_WORLD, mpierr)

  if(rank==0) then
    print*, "Time taken by MPI_Type_create_subarray Gathering: ", MPI_Wtime()-start_time
  endif

!if(rank==0) then
! print*, "Gathered array: ------------------"
! print*, array
!endif
  call MPI_Finalize(mpierr)

  contains

  subroutine distribute_points(npts, rank, size, start_idx, end_idx)
    implicit none

    integer, intent(in) :: npts, size, rank
    integer, intent(out) :: start_idx, end_idx
    integer :: pts_per_proc

    pts_per_proc = npts/size

    if(rank < mod(npts, size)) then
      pts_per_proc=pts_per_proc + 1
    end if

    if(rank < mod(npts, size)) then
      start_idx = rank * pts_per_proc + 1
      end_idx = (rank + 1) * pts_per_proc
    else
      start_idx = mod(npts, size) + rank*pts_per_proc + 1
      end_idx = mod(npts, size) + (rank + 1) * pts_per_proc
    end if

  end subroutine distribute_points
end program ex_scatterv

内容的提问来源于stack exchange，提问作者nhm

MPI_Scatterv用MPI派生数据类型性能远低于扁平化散射的原因

环境信息 #

问题描述 #

核心原因分析 #