1

我在调用 SUB EXC_MPI (MOD01) 时遇到了无效的内存引用，并且恰好在 MPI_StartAll 处（已注释）。

! ********** file mod01.f90 ************ !
MODULE MOD01

implicit none
include 'mpif.h'
! alternatively
! use mpi
! implicit none
PRIVATE
! ...
INTERFACE exc_mpi
   MODULE PROCEDURE exc_mpi
END INTERFACE
PUBLIC exc_mpi

CONTAINS

subroutine exc_mpi (X)
!! send and receive from procs PN0 <-> PN1 and PN0 <-> PN2
real, dimension (ni:ns, m, l), intent(inout) :: X

logical, save :: frstime=.true.
integer, save :: mpitype_sn, mpitype_sp, mpitype_rn, mpitype_rp
integer, save :: requests(4), reqcount
integer       :: istatus(MPI_STATUS_SIZE,4), ierr

if (frstime) then
   call exc_init()
   frstime = .false.
end if
call MPI_StartAll(reqcount,requests,ierr)         !!  <-- segfault here
call MPI_WaitAll(reqcount,requests,istatus,ierr)
return

contains

subroutine exc_init

integer :: i0, ierrs(12), ktag

reqcount = 0
ierrs=0
ktag = 1

! find i0

if ( condition1 ) then
! send to PN2
   call MPI_Type_Vector(m*l, messlengthup(PN2), ns-ni+1, MPI_REAL, mpitype_sn, ierrs(1))
   call MPI_Type_Commit(mpitype_sn, ierrs(3))
   call MPI_Send_Init(X(i0, 1, 1), 1, mpitype_sn, PN2-1, ktag, MPI_COMM_WORLD, requests(reqcount+1), ierrs(5))
! recieve from PN2
   call MPI_Type_Vector(m*l, messlengthdo(PN0), ns-ni+1, MPI_REAL, mpitype_rn, ierrs(2))
   call MPI_Type_Commit(mpitype_rn,ierrs(4))
   call MPI_Recv_Init(X(nend(irank)+1, 1, 1), 1, mpitype_rn, PN2-1, ktag+1, MPI_COMM_WORLD, requests(reqcount+2), ierrs(6))
   reqcount = reqcount + 2
end if

if ( condition2 ) then
!   send and rec PN0 <-> PN1
   reqcount = reqcount + 2
end if

return
end subroutine exc_init

end subroutine exc_mpi

! ...

END MODULE MOD01

来电来自：

! ********** file mod02.f90 ************ !
MODULE MOD02

use MOD01, only: exc_mpi 

IMPLICIT NONE
include 'mpif.h'
! alternatively
! use mpi
! implicit none
PRIVATE

! ...

INTERFACE MYSUB
   MODULE PROCEDURE MYSUB
END INTERFACE
PUBLIC MYSUB

CONTAINS

SUBROUTINE MYSUB (Y)

IMPLICIT NONE
REAL,    INTENT(INOUT)   :: Y(nl:nr, m, l) ! ni<=nl, nr>=ns
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Y0
!...
allocate ( Y0(ni-1:ns, 1:m, 1:l) )

DO i = 1, icount

   Y0(nl:nr,:,:) = Y(:,:,:)
   call exc_mpi ( Y0(ni:ns, :, :) )           !  <-- segfault here
   call mpi_barrier (mpi_comm_world, ierr)
   Y0(ni-1,:,:) = 0.
   CALL SUB01

END DO
deallocate (Y0)
RETURN

CONTAINS

SUBROUTINE SUB01
!...
   FRE: DO iterm = 1, m
      DIR: DO iterl = 1, l
         DO itern = nl, nr
!            Y(itern, iterm, iterl) = some_lin_combination(Y0)
         END DO
      END DO DIR
   END DO FRE

END SUBROUTINE SUB01

! ...
END MODULE MOD02

当 MAIN（实际上是模块中的子）第二次调用 MYSUB（上面的代码）时，会在运行时引发分段错误。该错误不是系统性的，从某种意义上说，如果将作业拆分为一定数量的进程，例如 NPMAX，则程序可以工作，这取决于分解的数组。由于 procs 比 NPMAX 多，程序会出现段错误。更多环境条件：

  • 几乎 [编译器 + mpi 独立]：[gfortran+ompi]、[gfortran+mpich] 和 [ifort+mpich] 出现同样的问题。
  • 发生在基于 deb (glibc) 的 mini hpc 和 pc 上（“严重” nec、sun、ibm 上没有问题）

可以看出，MOD02 将不连续的切片数组 Y0 传递给交换过程 (MOD01)。我几乎可以克服故障（NPMAX 增长一个数量级）的唯一方法是来回交换尺寸，但这会导致执行速度减慢大约 2 倍。我敢打赌，永久交换 X/Y/Y0尺寸会解决，但我不想失去像 SUB01 这样的嵌套循环的效率（第一个尺寸比其他尺寸大得多）。

实际上，MOD02 创建了一个临时数组。明确地这样做并不能解决问题。

强制分配堆或堆栈并不能解决问题。

有什么提示吗？谢谢阅读

更新：在每次调用时初始化（在 sub exc_mpi 中的 if 语句中调用 exc_init() ）确实可以解决，但由于 MAIN （未列出）循环很多，因此效率完全低下。

UPDATE2（在@Gilles 之后）：即使传递一个连续的数组（在本例中为 Y1）并且 mpi 没有创建临时数组，此解决方法也不起作用。

SUBROUTINE MYSUB (Y)

IMPLICIT NONE
REAL,    INTENT(INOUT)   :: Y(nl:nr, m, l) ! ni<=nl, nr>=ns
REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Y0, Y1
!...
allocate ( Y0(ni-1:ns, 1:m, 1:l) )
allocate ( Y1(ni:ns, 1:m, 1:l) )

DO i = 1, icount

   Y1(nl:nr,:,:) = Y(:,:,:)
   call exc_mpi ( Y0 )           !  <-- segfault here
   call mpi_barrier (mpi_comm_world, ierr)
   Y0(nl:nr,:,:) = Y1(nl:nr,:,:)
   Y0(ni-1,:,:) = 0.
   CALL SUB01

END DO
deallocate (Y1)
deallocate (Y0)
etc ...
4

0 回答 0