使用fortran衍生的数据类型在mpi_gather中进行分段错误

Question

我一直在尝试编写一个程序，该程序可以计算数百万个偶极-偶极子相互作用张量及其导数。 由于这些张量可微细地并行化，并且经常退化，因此我决定构造一个查找表（LUT）并分发工作。 最终，它们将被组合成一个大矩阵并被对角线化（最终我将使用scalapack。目前，diag适合nersc的一个节点）。 为了跟踪fortran中的所有索引，我构造了一些派生的数据类型。

type dtlrdr_lut
    sequence
    integer p
    integer q
    integer s
    integer i
    integer ind
    real(dp), dimension(3,3) :: dtlrdr
end type dtlrdr_lut

type dtlrdh_lut
    sequence
    integer p
    integer q
    integer ind
    real(dp), dimension(3, 3) :: TLR
    real(dp), dimension(3, 3, 3, 3) :: dTLRdh
end type dtlrdh_lut

在我想并行化所有这些的子例程中，我具有：

    type(dtlrdr_lut), dimension(:), allocatable :: my_dtlrdr, collected_dtlrdr
    type(dtlrdh_lut), dimension(:), allocatable :: my_dtlrdh, collected_dtlrdh
    integer :: dh_dtype, dr_dtype, dh_types(5), dr_types(6), dh_blocks(5), dr_blocks(6)
    INTEGER(KIND=MPI_ADDRESS_KIND) :: dh_offsets(5), dr_offsets(6)
    if(.not.allocated(my_dtlrdh))    allocate(my_dtlrdh(my_num_pairs))
    if(.not.allocated(my_dtlrdr))    allocate(my_dtlrdr(my_num_pairs*3*nat))

    if(me_image.eq.root_image) then
        if(.not.allocated(collected_dtlrdh))    allocate(collected_dtlrdh(num_pairs))
        if(.not.allocated(collected_dtlrdr))    allocate(collected_dtlrdr(num_pairs*3*nat))
        end if
    call mpi_get_address(my_dtlrdr(1)%p,      dr_offsets(1), ierr)
    call mpi_get_address(my_dtlrdr(1)%q,      dr_offsets(2), ierr)
    call mpi_get_address(my_dtlrdr(1)%s,      dr_offsets(3), ierr)
    call mpi_get_address(my_dtlrdr(1)%i,      dr_offsets(4), ierr)
    call mpi_get_address(my_dtlrdr(1)%ind,    dr_offsets(5), ierr)
    call mpi_get_address(my_dtlrdr(1)%dtlrdr, dr_offsets(6), ierr)
    do i = 2, size(dr_offsets)
      dr_offsets(i) = dr_offsets(i) - dr_offsets(1)
    end do
    dr_offsets(1) = 0
    dr_types = (/MPI_INTEGER, MPI_INTEGER, MPI_INTEGER, MPI_INTEGER, MPI_INTEGER, MPI_DOUBLE_PRECISION/)
    dr_blocks = (/1, 1, 1, 1, 1, 3*3/)
    call mpi_type_struct(6, dr_blocks, dr_offsets, dr_types, dr_dtype, ierr)
    call mpi_type_commit(dr_dtype, ierr)

    call mpi_get_address(my_dtlrdh(1)%p,      dh_offsets(1), ierr)
    call mpi_get_address(my_dtlrdh(1)%q,      dh_offsets(2), ierr)
    call mpi_get_address(my_dtlrdh(1)%ind,    dh_offsets(3), ierr)
    call mpi_get_address(my_dtlrdh(1)%TLR,    dh_offsets(4), ierr)
    call mpi_get_address(my_dtlrdh(1)%dTLRdh, dh_offsets(5), ierr)
    do i = 2, size(dh_offsets)
      dh_offsets(i) = dh_offsets(i) - dh_offsets(1)
    end do
    dh_offsets(1) = 0
    dh_types = (/MPI_INTEGER, MPI_INTEGER, MPI_INTEGER, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION/)
    dh_blocks = (/1, 1, 1, 3*3, 3*3*3*3/)
    call mpi_type_struct(5, dh_blocks, dh_offsets, dh_types, dh_dtype, ierr)
    call mpi_type_commit(dh_dtype, ierr)
    call mpi_gather(my_dtlrdh, my_num_pairs, dh_dtype, &
                     collected_dtlrdh, num_pairs, dh_dtype, &
                     root_image, intra_image_comm)
    call mp_barrier(intra_image_comm)

    call mpi_gather(my_dtlrdr, my_num_pairs*3*nat, dr_dtype, &
                     collected_dtlrdr, num_pairs*3*nat, dr_dtype, &
                     root_image, intra_image_comm)

代码的结果是什么？ 好吧，根进程聚集起来并成为障碍，然后出现段错误：

Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
   Backtrace for this error:
    #0  0x10bac04f2
    #1  0x10bac0cae
    #2  0x7fff8d7c1f19

在流程0的模拟中：

size(my_dtlrdh) = 97
size(collected_dtlrdh) = 194
size(my_dtlrdr) = 873
size(collected_dtlrdr) = 1746

并在过程1

size(my_dtlrdh) = 97
size(collected_dtlrdh) = 3
size(my_dtlrdr) = 873
size(collected_dtlrdr) = 1650521

当我为进程0打印偏移量，块等时，得到：

printing dr vars           0
dr_blocks =  1  1  1  1  1  9
dr_offsets = 0  4  8  12 16 24
dr_types =   7  7  7  7  7  17
dr_dtype =   73

printing dh vars 0
dr_blocks =  1  1  1  9  81
dr_offsets = 0  4  8  16 88
dr_types =   7  7  7  17 17
dr_dtype =   74

对于过程1，我得到：

printing dr vars  1
dr_blocks =   1  1  1  1  1  9
dr_offsets =  0  4  8 12 16 24
dr_types =    7  7  7  7  7 17
dr_dtype =    73

printing dh vars  1
dr_blocks =   1  1  1  9 81
dr_offsets =  0  4  8 16 88
dr_types =    7  7  7 17 17
dr_dtype =    74

但是，proc1上的dtlrdr的随机大小无关紧要，因为它实际上没有接收任何内容。 我似乎无法弄清楚发生了什么，或者为什么没有无效的内存引用，进程1无法通过聚集进行。 有任何想法吗？ 而且，请让我知道你们是否需要我提供更多信息。

Answer 1

您已经忘记了共享的最后3个子例程（即最后一个参数ierr）中的错误状态标志。

我敢打赌，您已经使用了Fortran包含头文件mpif.h，而不是使用了mpi模块。 如果您完成了后者，则将自动检查参数数量，并收到一条错误消息，内容如下：

“此通用子例程调用没有匹配的特定子例程。”

由于参数数量不正确。