在 mpi 中使用可分配数组发送派生类型数据时出现段错误

seg fault when sending derived type data with allocatable array in mpi

我正在尝试在 mpi 广告中发送带有可分配数组的派生类型数据时出现段错误。

program test_type  

 use mpi

 implicit none

 type mytype
  real,allocatable::x(:)
  integer::a
 end type mytype

 type(mytype),allocatable::y(:)
 type(mytype)::z
 integer::n,i,ierr,myid,ntasks,status,request
 integer :: datatype, oldtypes(2), blockcounts(2) 
 integer(KIND=MPI_ADDRESS_KIND) :: offsets(2)

 call mpi_init(ierr)
 call mpi_comm_rank(mpi_comm_world,myid,ierr)
 call mpi_comm_size(mpi_comm_world,ntasks,ierr)

 n=2

 allocate(z%x(n))

 if(myid==0)then
  allocate(y(ntasks-1))
  do i=1,ntasks-1
   allocate(y(i)%x(n))
  enddo
 else
  call random_number(z%x)
  z%a=myid
  write(0,*) "z in process", myid, z%x, z%a
 endif

 call mpi_get_address(z%x,offsets(1),ierr)
 call mpi_get_address(z%a,offsets(2),ierr)
 offsets=offsets-offsets(1)

 oldtypes=(/ mpi_real,mpi_integer /)
 blockcounts=(/ n,1 /)

 write(0,*) "before commit",myid,offsets,blockcounts,oldtypes
 call mpi_type_create_struct(2,blockcounts,offsets,oldtypes,datatype,ierr) 
 call mpi_type_commit(datatype, ierr)
 write(0,*) "after commit",myid,datatype, ierr

 if(myid==0) then   
  do i=1,ntasks-1 
   call mpi_irecv(y(i),1,datatype,1,0,mpi_comm_world,request,ierr) 
   write(0,*) "received", y(i)%x,y(i)%a
  enddo
 else
  call mpi_isend(z,1,datatype,0,0,mpi_comm_world,request,ierr) 
  write(0,*) "sent"
  write(0,*) myid, z%x, z%a
 end if

 call mpi_finalize(ierr)

end program

这是我打印出来的 运行 2 个过程:

before commit           0                     0             -14898056
           2           1          13           7
 after commit           0          73           0
 z in process           1  3.9208680E-07  2.5480442E-02           1
 before commit           1                     0            -491689432
           2           1          13           7
 after commit           1          73           0
 received  0.0000000E+00  0.0000000E+00           0
forrtl: severe (174): SIGSEGV, segmentation fault occurred

它似乎得到负地址偏移量。请帮忙。 谢谢

此代码存在多个问题。

大多数 Fortran 编译器的可分配数组就像 C/C++ 中的指针:数组名称后面的真实对象是包含指向已分配数据的指针的东西。该数据通常分配在堆上,并且可以位于进程的虚拟地址 space 中的任何位置,这解释了负偏移量。顺便说一句,负偏移量在 MPI 数据类型中是完全可以接受的(这就是为什么 MPI_ADDRESS_KIND 指定 有符号 整数种类),所以这里没有什么大问题。

更大的问题是动态分配的事物之间的偏移量通常随每次分配而变化。您可以检查:

ADDR(y(1)%x) - ADDR(y(1)%a)

完全不同
ADDR(y(i)%x) - ADDR(y(i)%a), for i = 2..ntasks-1

(ADDR 这里只是 MPI_GET_ADDRESS 返回的对象地址的简写形式)

即使偏移量与 i 的某些值匹配,这更多的是巧合而不是规则。

这导致以下情况:您使用 z 变量的偏移量构造的类型不能用于发送 y 数组的元素。要解决这个问题,如果可能的话,只需删除 mytype%x 的可分配 属性(例如,如果事先知道 n)。

另一个适用于较小值 ntasks 的选项是定义与 y 数组的元素数量一样多的 MPI 数据类型。然后使用datatype(i),它基于y(i)%xy(i)%a的偏移量,发送y(i)

一个更严重的问题是您使用的是非阻塞 MPI 操作并且在访问数据缓冲区之前从不等待它们完成。此代码根本行不通:

do i=1,ntasks-1 
 call mpi_irecv(y(i),1,datatype,1,0,mpi_comm_world,request,ierr) 
 write(0,*) "received", y(i)%x,y(i)%a
enddo

调用 MPI_IRECV 启动异步接收操作。在执行 WRITE 运算符时,该操作可能仍在进行中,因此正在访问完全随机的数据(某些内存分配器实际上可能在调试模式下将数据归零)。在 MPI_ISENDWRITE 调用之间插入对 MPI_WAIT 的调用,或者使用阻塞接收 MPI_RECV.

使用非阻塞发送调用时也存在类似的问题MPI_ISEND。由于您从不等待请求完成或对其进行测试,因此允许 MPI 库无限期地推迟操作的实际进展,并且发送可能永远不会真正发生。同样,由于在您的情况下绝对没有理由使用非阻塞发送,请将 MPI_ISEND 替换为 MPI_SEND

最后但同样重要的是,等级 0 仅接收来自等级 1 的消息:

call mpi_irecv(y(i),1,datatype,1,0,mpi_comm_world,request,ierr)
                              ^^^

与此同时,所有其他进程都发送到 rank 0。因此,您的程序只有在 运行 有两个 MPI 进程的情况下才能工作。您可能希望将接收呼叫中带下划线的 1 替换为 i.