MPI_Scatterv大N时偶发崩溃，请求排查Fortran代码问题

问题现象 #

编写的MPI Fortran代码运行时偶发forrtl: severe (174): SIGSEGV段错误，小N值时有时正常有时崩溃，不同进程数下表现不一，当前示例中任意进程数均无法正常运行。

原代码 #

program crash
  use mpi
  implicit none
  integer,parameter::dp=kind(1.d0)
  integer, parameter :: M =1500,N=M,O=M! Matrix dimension
  integer myrank, numprocs,ierr, root
  integer i, j, k,l,p,local_n,sendcounts
  real(dp) R1(M),RHS(M),RHS1(M)
  real(dp),dimension(:),allocatable::local_A
  real(dp),dimension(:,:),allocatable::local_c,local_c1
  real(dp) summ,B(N,O),B1(N,O),C(M*O),C1(M)
  real(dp) final_product(M,O),rhs_product(O)
  integer,dimension(:),allocatable::displs!,displs1,displs2
  integer,dimension(:),allocatable::sendcounts_list
  real(dp),dimension(:,:),allocatable::local_A_Matrix
  integer status(MPI_STATUS_SIZE)
  integer request
  ! Initialize MPI
  call MPI_Init(ierr)
  call MPI_Comm_size(MPI_COMM_WORLD, numprocs, ierr)
  call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr)

 B=0.d0
 do i=1,N
    do j=1,O
      B(i,j)=(i+1)*myrank+j*myrank+j*i
    enddo
 enddo


 R1=0.d0
   do i=1,N
 R1(i)=i*myrank+1
 enddo



if (myrank<numprocs-mod(M,numprocs)) then
    local_n=M/numprocs
 else
    local_n=M/numprocs+1
 endif


  sendcounts =  local_n * N
   allocate(sendcounts_list(numprocs))
   call MPI_AllGATHER(local_n, 1, MPI_INT, sendcounts_list, 1, MPI_INT,MPI_COMM_WORLD,IERR)



 if(myrank==0) then
     allocate(displs(numprocs))
       displs=0
      do i=2,numprocs
         displs(i) = displs(i-1)+N*sendcounts_list(i-1)
      enddo
  endif


  allocate(local_A(sendcounts))
  local_A=0.d0
  call MPI_Scatterv(Transpose(B),N*sendcounts_list,displs,MPI_Double,local_A,N*local_n, &
                    MPI_Double,0,MPI_COMM_WORLD,ierr)
  deallocate(sendcounts_list)           
  if(myrank==0) then
    deallocate(displs)
  endif  

   allocate(local_A_Matrix(local_n,N))
   local_A_Matrix=reshape(local_A,(/local_n,N/),order=(/2,1/))

   deallocate(local_A)




    call MPI_Finalize(ierr)

  end program crash

问题分析 #

1. 非root进程传递未定义的displs参数 #

MPI_Scatterv调用中，非root进程的displs变量未分配内存（仅root进程allocate了该变量），这会导致MPI函数访问野指针，直接触发段错误。虽然MPI规范中非root进程会忽略发送端参数，但部分MPI实现会检查参数有效性，未初始化的指针会引发崩溃。

2. 直接使用Transpose(B)作为MPI发送缓冲区 #

MPI函数要求发送缓冲区是连续的、实际存在的内存块。Transpose(B)是函数返回的临时数组，其内存可能位于栈上或生命周期极短，MPI无法正确识别其地址；同时所有进程都会执行该转置操作，非root进程的转置操作完全多余且可能引发内存异常。

3. reshape的order参数使用错误 #

local_A存储的是转置后矩阵的local_n行数据（每行N个元素），按连续内存排列为[行1, 行2, ..., 行local_n]。使用order=(/2,1/)会强制reshape按列优先重新排列数据，导致维度不匹配，触发越界访问。

修复后的代码 #

program fixed_crash
  use mpi
  implicit none
  integer,parameter::dp=kind(1.d0)
  integer, parameter :: M =1500,N=M,O=M! Matrix dimension
  integer myrank, numprocs,ierr, root
  integer i, j, local_n,sendcounts
  real(dp) R1(M),RHS(M),RHS1(M)
  real(dp),dimension(:),allocatable::local_A
  real(dp),dimension(:,:),allocatable::local_c,local_c1, transposed_B
  real(dp) summ,B(N,O),B1(N,O),C(M*O),C1(M)
  real(dp) final_product(M,O),rhs_product(O)
  integer,dimension(:),allocatable::displs, sendcounts_list
  real(dp),dimension(:,:),allocatable::local_A_Matrix
  integer status(MPI_STATUS_SIZE)
  integer request

  ! Initialize MPI
  call MPI_Init(ierr)
  call MPI_Comm_size(MPI_COMM_WORLD, numprocs, ierr)
  call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr)

  ! Initialize matrix B
  B=0.d0
  do i=1,N
    do j=1,O
      B(i,j)=(i+1)*myrank+j*myrank+j*i
    enddo
  enddo

  ! Initialize R1
  R1=0.d0
  do i=1,N
    R1(i)=i*myrank+1
  enddo

  ! Calculate local row count
  if (myrank<numprocs-mod(M,numprocs)) then
    local_n=M/numprocs
  else
    local_n=M/numprocs+1
  endif

  sendcounts =  local_n * N
  allocate(sendcounts_list(numprocs))
  call MPI_AllGATHER(local_n, 1, MPI_INT, sendcounts_list, 1, MPI_INT, MPI_COMM_WORLD, ierr)

  ! Allocate displs for all processes (避免野指针问题)
  allocate(displs(numprocs))
  displs=0
  if(myrank==0) then
    do i=2,numprocs
      displs(i) = displs(i-1)+N*sendcounts_list(i-1)
    enddo
  endif

  ! 仅root进程转置B并存储到实际数组
  if(myrank==0) then
    allocate(transposed_B(O,N))
    transposed_B = transpose(B)
  endif

  allocate(local_A(sendcounts))
  local_A=0.d0
  ! root进程使用转置后的实际数组，非root进程发送端参数用dummy值（MPI会忽略）
  call MPI_Scatterv(merge(transposed_B, local_A, myrank==0), &
                    N*sendcounts_list, displs, MPI_Double, &
                    local_A, N*local_n, MPI_Double, &
                    0, MPI_COMM_WORLD, ierr)

  ! 释放临时资源
  deallocate(sendcounts_list, displs)
  if(myrank==0) then
    deallocate(transposed_B)
  endif

  ! 正确reshape为local_n行N列的矩阵
  allocate(local_A_Matrix(local_n,N))
  local_A_Matrix=reshape(local_A,(/local_n,N/))

  deallocate(local_A)

  call MPI_Finalize(ierr)
end program fixed_crash

关键修改点 #

• 所有进程都allocatedispls变量，避免野指针问题，仅root进程初始化其值
• root进程提前将B转置并存储到transposed_B数组，作为MPI_Scatterv的发送缓冲区，非root进程用merge传递dummy值
• 移除reshape的order参数，按默认行优先顺序匹配local_A的内存布局

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