MPI_GATHERV收集数据时遇消息截断错误的排查求助

云原生阿岚

2026-7-23

Fortran MPI_GATHERV消息截断错误排查

错误信息

Loading compiler version 2022.0.2
Loading tbb version 2021.5.1
Loading compiler-rt version 2022.0.2
Loading oclfpga version 2022.0.2
  Load "debugger" to debug DPC++ applications with the gdb-oneapi debugger.
  Load "dpl" for additional DPC++ APIs: https://github.com/oneapi-src/oneDPL
Loading mkl version 2022.0.2
Loading mpi version 2021.5.1
Abort(69296142) on node 0 (rank 0 in comm 0): Fatal error in PMPI_Gatherv: Message truncated, error stack:
PMPI_Gatherv(397)..........................: MPI_Gatherv failed(sbuf=0x2b6dd01cb240, scount=881724165, MPI_DOUBLE, rbuf=0x2b6f901cc280, rcnts=0x2b6c0fc87fe0, displs=0x2b6c0fc87fc0, datatype=MPI_DOUBLE, root=0, comm=MPI_COMM_WORLD) failed
MPIDI_Gatherv_intra_composition_alpha(2631): 
MPIDI_NM_mpi_gatherv(396)..................: 
MPIR_Gatherv_allcomm_linear_ssend(65)......: 
MPIR_Localcopy(46).........................: Message truncated; -1536141272 bytes received but buffer size is 8056
Loading compiler version 2022.0.2
Loading tbb version 2021.5.1
Loading compiler-rt version 2022.0.2
Loading oclfpga version 2022.0.2
  Load "debugger" to debug DPC++ applications with the gdb-oneapi debugger.
  Load "dpl" for additional DPC++ APIs: https://github.com/oneapi-src/oneDPL
Loading mkl version 2022.0.2
Loading mpi version 2021.5.1
Abort(136405006) on node 0 (rank 0 in comm 0): Fatal error in PMPI_Gatherv: Message truncated, error stack:
PMPI_Gatherv(397)..........................: MPI_Gatherv failed(sbuf=0x2b77a71a9d00, scount=210, MPI_DOUBLE, rbuf=0x2b77a71a9600, rcnts=0x2b77a7197fe0, displs=0x2b77a7197fc0, datatype=MPI_DOUBLE, root=0, comm=MPI_COMM_WORLD) failed
MPIDI_Gatherv_intra_composition_alpha(2631): 
MPIDI_NM_mpi_gatherv(396)..................: 
MPIR_Gatherv_allcomm_linear_ssend(65)......: 
MPIR_Localcopy(46).........................: Message truncated; 1680 bytes received but buffer size is 56

问题代码

MODULE MOU
CONTAINS
SUBROUTINE PRO (br,n1,n2,n3)
IMPLICIT NONE
INTEGER, PARAMETER               ::      dp = SELECTED_REAL_KIND(15,14)
REAL (KIND=dp)                   ::      br(:,:,:,:)
INTEGER                          ::      i, j, k, l
INTEGER                          ::      n1, n2, n3
DO i = 1, n1, 1
   DO j = 1, n2, 1
      DO k = 1, n3, 1
         br(:,i,j,k) = (i*0.85+3.1)/(5.7-j)*(k**3-3.6)*DSQRT(br(:,i,j,k))
      END DO
   END DO
END DO
RETURN
END SUBROUTINE PRO
END MODULE MOU
PROGRAM EXAMPLE
USE MPI
USE MOU
IMPLICIT NONE
INTEGER, PARAMETER               ::      dp = SELECTED_REAL_KIND(15,14)
INTEGER                          ::      i, j, k, l
INTEGER                          ::      nu(4)
INTEGER, ALLOCATABLE             ::      ns(:), rd(:)
INTEGER                          ::      nr, er, rn, ts, rs
REAL (KIND=dp), ALLOCATABLE      ::      ar(:,:,:,:), br(:,:,:,:), cr(:,:,:,:)
INTEGER                          ::      world_size, world_rank, ierr
INTEGER                          ::      nt
INTEGER (KIND=MPI_ADDRESS_KIND)  ::      ra(2)
CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,world_size,ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,world_rank,ierr)
nu(1) = 5
nu(2) = 6
nu(3) = 3
nu(4) = 2
IF (world_rank == 0) THEN
   ALLOCATE (ar(nu(1),nu(2),nu(3),nu(4)))
   DO i = 1, nu(1), 1
      DO j = 1, nu(2), 1
         DO k = 1, nu(3), 1
            DO l = 1, nu(4), 1
               ar(i,j,k,l) = (i+1)*(j/0.5-6.3)*DSQRT(DBLE(k)+3.9)/(l**2+8.3)
            END DO
         END DO
      END DO
   END DO
END IF
CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
ALLOCATE (ns(0:world_size-1))
ALLOCATE (rd(0:world_size-1))
nr = nu(2)/world_size
er = MOD(nu(2),world_size)
j = 0
DO i = 0, world_size-1, 1
   IF (i > er) THEN
      ns(i) = nr
   ELSE
      ns(i) = nr + 1
   END IF
   rd(i) = j
   j = j+ns(i)
END DO
rn = ns(world_rank)
ALLOCATE (br(rn,nu(1),nu(3),nu(4)))
CALL MPI_TYPE_VECTOR(rn,1,nu(2),MPI_DOUBLE,nt,ierr)
CALL MPI_TYPE_COMMIT(nt,ierr)
ra(1) = 0
CALL MPI_TYPE_SIZE(MPI_DOUBLE,ts,ierr)
ra(2) = 1*ts
CALL MPI_TYPE_CREATE_RESIZED(nt,ra(1),ra(2),rs,ierr)
CALL MPI_TYPE_COMMIT(rs,ierr)
br = 0.0d0
CALL MPI_SCATTERV(ar,ns,rd,rs,br,rn*nu(4)*nu(3)*nu(1),MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
CALL PRO(br,nu(1),nu(3),nu(4))
IF (world_rank == 0) THEN
   ALLOCATE (cr(nu(1),nu(2),nu(3),nu(4)))
END IF
CALL MPI_GATHERV(br,rn*nu(4)*nu(3)*nu(1),MPI_DOUBLE,cr,ns,rd,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
IF (world_rank == 0) THEN
   OPEN(UNIT=3, FILE='data.dat', STATUS='REPLACE')
   DO i = nu(1), 1
      DO j = 1, nu(2), 1
         DO k = 1, nu(3), 1
            WRITE (UNIT=3, FMT=*) cr(i,j,k,:)
         END DO
      END DO
   END DO
   DEALLOCATE (ar)
   DEALLOCATE (cr)
   CLOSE (UNIT=3)
END IF
DEALLOCATE (ns)
DEALLOCATE (rd)
DEALLOCATE (br)
STOP
END PROGRAM EXAMPLE

问题根源

MPI_GATHERV参数不匹配：root进程接收时，ns数组存储的是每个进程处理的j维度数量，但数据类型使用MPI_DOUBLE，导致MPI误认为每个进程仅发送ns(i)个double元素，而实际每个进程发送的是ns(i)*nu(1)*nu(3)*nu(4)个double，缓冲区不足触发截断错误。
自定义数据类型冗余且错误：Fortran为列主序存储，ar(:,j,:,:)的内存是连续块，无需自定义MPI类型，错误的类型定义反而导致数据分发逻辑混乱，加剧GATHERV的参数不匹配问题。
循环逻辑错误：输出部分的DO i = nu(1), 1未指定步长，会导致无限循环。
缺失MPI_FINALIZE：未调用MPI_FINALIZE，不符合MPI标准流程。

修复方案（推荐移除自定义类型）

直接基于实际double元素数量计算SCATTERV和GATHERV的计数与位移，代码如下：

MODULE MOU
CONTAINS
SUBROUTINE PRO (br,n1,n2,n3)
IMPLICIT NONE
INTEGER, PARAMETER               ::      dp = SELECTED_REAL_KIND(15,14)
REAL (KIND=dp)                   ::      br(:,:,:,:)
INTEGER                          ::      i, j, k, l
INTEGER                          ::      n1, n2, n3
DO i = 1, n1, 1
   DO j = 1, n2, 1
      DO k = 1, n3, 1
         br(:,i,j,k) = (i*0.85+3.1)/(5.7-j)*(k**3-3.6)*DSQRT(br(:,i,j,k))
      END DO
   END DO
END DO
RETURN
END SUBROUTINE PRO
END MODULE MOU

PROGRAM EXAMPLE
USE MPI
USE MOU
IMPLICIT NONE
INTEGER, PARAMETER               ::      dp = SELECTED_REAL_KIND(15,14)
INTEGER                          ::      i, j, k, l
INTEGER                          ::      nu(4)
INTEGER, ALLOCATABLE             ::      ns(:), rd(:), rcnts(:), displs(:)
INTEGER                          ::      nr, er, rn, ierr
REAL (KIND=dp), ALLOCATABLE      ::      ar(:,:,:,:), br(:,:,:,:), cr(:,:,:,:)
INTEGER                          ::      world_size, world_rank

CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,world_size,ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,world_rank,ierr)

nu(1) = 5
nu(2) = 6
nu(3) = 3
nu(4) = 2

IF (world_rank == 0) THEN
   ALLOCATE (ar(nu(1),nu(2),nu(3),nu(4)))
   DO i = 1, nu(1), 1
      DO j = 1, nu(2), 1
         DO k = 1, nu(3), 1
            DO l = 1, nu(4), 1
               ar(i,j,k,l) = (i+1)*(j/0.5-6.3)*DSQRT(DBLE(k)+3.9)/(l**2+8.3)
            END DO
         END DO
      END DO
   END DO
END IF

CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)

ALLOCATE (ns(0:world_size-1))
ALLOCATE (rd(0:world_size-1))
nr = nu(2)/world_size
er = MOD(nu(2),world_size)
j = 0
DO i = 0, world_size-1, 1
   IF (i > er) THEN
      ns(i) = nr
   ELSE
      ns(i) = nr + 1
   END IF
   rd(i) = j
   j = j+ns(i)
END DO

! 计算每个进程的double元素总数及对应位移
ALLOCATE(rcnts(0:world_size-1), displs(0:world_size-1))
DO i = 0, world_size-1
    rcnts(i) = ns(i)*nu(1)*nu(3)*nu(4)
    displs(i) = rd(i)*nu(1)*nu(3)*nu(4)
END DO

rn = ns(world_rank)
ALLOCATE (br(nu(1),rn,nu(3),nu(4)))  ! 调整维度与ar对齐
br = 0.0d0

! 直接用MPI_DOUBLE分发连续块
CALL MPI_SCATTERV(ar, rcnts, displs, MPI_DOUBLE, br, rcnts(world_rank), MPI_DOUBLE, 0, MPI_COMM_WORLD, ierr)

CALL PRO(br, nu(1), nu(3), nu(4))

IF (world_rank == 0) THEN
   ALLOCATE (cr(nu(1),nu(2),nu(3),nu(4)))
END IF

! GATHERV使用正确的计数和位移
CALL MPI_GATHERV(br, rcnts(world_rank), MPI_DOUBLE, cr, rcnts, displs, MPI_DOUBLE, 0, MPI_COMM_WORLD, ierr)

IF (world_rank == 0) THEN
   OPEN(UNIT=3, FILE='data.dat', STATUS='REPLACE')
   DO i = nu(1), 1, -1  ! 修复循环步长
      DO j = 1, nu(2), 1
         DO k = 1, nu(3), 1
            WRITE (UNIT=3, FMT=*) cr(i,j,k,:)
         END DO
      END DO
   END DO
   DEALLOCATE (ar)
   DEALLOCATE (cr)
   CLOSE (UNIT=3)
END IF

DEALLOCATE (ns)
DEALLOCATE (rd)
DEALLOCATE (rcnts)
DEALLOCATE (displs)
DEALLOCATE (br)

CALL MPI_FINALIZE(ierr)  ! 补充MPI终止调用
STOP
END PROGRAM EXAMPLE

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

MPI_GATHERV收集数据时遇消息截断错误的排查求助

错误信息 #

问题代码 #

问题根源 #

修复方案（推荐移除自定义类型） #

错误信息

问题代码

问题根源

修复方案（推荐移除自定义类型）