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 (上記のコード) を 2 回目に呼び出すと、実行時にセグメンテーション違反が発生します。分解された配列に依存する NPMAX など、ジョブを特定の数のプロセスに分割する場合にプログラムが機能するという意味で、エラーは体系的ではありません。NPMAX よりも多くの proc を使用すると、プログラムはセグメンテーション違反を起こします。環境条件の詳細:
- ほぼ [コンパイラ + mpi 独立]: [gfortran+ompi]、[gfortran+mpich]、[ifort+mpich] でも同じ問題が発生します。
- deb ベース (glibc) の mini hpc と pcs で発生 (「深刻な」nec、sun、ibm では問題なし)
図からわかるように、MOD02 は交換手順 (MOD01) に、連続していないスライスされた配列 Y0 を渡します。この障害 (NPMAX が 1 桁大きくなる) をほぼ克服できる唯一の方法は、次元を前後に交換することですが、これにより実行速度が約 2 倍遅くなります。ディメンションは解決しますが、SUB01 のようなネストされたサイクルの効率を下げたくありません (最初のディメンションは他のディメンションよりもはるかに大きい)。
実際、MOD02 は一時配列を作成します。それを明示的に行っても問題は解決しません。
ヒープまたはスタックの割り当てを強制しても解決しません。
何かヒントはありますか？読んでくれてありがとう
更新: 呼び出しごとに初期化する (サブ 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 ...