我担心使用Subarray类型。我尝试在两个触发器之间传输全局域的一部分(由2D数组表示)。没有子阵列结构我没有问题。以下示例说明了我想要做的事情。对于每个MPI进程,整个2D域被等分为两部分,一个包含"零" (左)和另一个包含"一个" (对)。在每个MPI进程中,半域由"真实域"加上保护单元的边界(这就是数组索引从1-ist开始的原因,见下文)。目标很简单:正确的域必须将它的两个第一列发送到两个"保护单元"左边的一列。
有效的代码是以下内容:
PROGRAM TEST
USE mpi
IMPLICIT NONE
INTEGER*4, PARAMETER :: ist = 2 ! Guard cells
INTEGER*4, PARAMETER :: nx = 5, ny = 2 ! Domain size
INTEGER*4, DIMENSION (1-ist:nx+ist,1-ist:ny+ist) :: prim ! A vector
INTEGER*4, DIMENSION (1:ist,1-ist:ny+ist) :: prim_S ! Mini vetctor (Send)
INTEGER*4, DIMENSION (1:ist,1-ist:ny+ist) :: prim_R ! Mini vector (Receive)
! MPI stuff
INTEGER*4, PARAMETER :: ndims = 2
INTEGER*4 :: mpicode, nb_procs, rang, comm, etiquette = 100
LOGICAL, DIMENSION (ndims) :: periods
LOGICAL :: reorganisation
INTEGER*4, DIMENSION (ndims) :: dims
INTEGER*4, DIMENSION (2) :: voisinage
INTEGER*4 :: i, j
!--------------------------------------------------------------------
periods = .FALSE.
reorganisation = .FALSE.
dims(1) = 2
dims(2) = 1
! Initialize MPI
CALL MPI_INIT (mpicode)
CALL MPI_COMM_SIZE (MPI_COMM_WORLD, nb_procs, mpicode)
CALL MPI_COMM_RANK (MPI_COMM_WORLD, rang, mpicode)
WRITE (*,*) "PROCESSUS ", rang, " OK"
! Create topology
CALL MPI_CART_CREATE (MPI_COMM_WORLD, ndims, dims, periods,
& reorganisation, comm, mpicode)
CALL MPI_CART_SHIFT (comm, 0, 1, voisinage(1), voisinage(2),
& mpicode)
! Fill each part of the domain
IF (rang .eq. 0) then
prim = 0
ELSE
prim = 1
END IF
! Print the left side BEFORE communication
IF (rang .eq. 0) then
DO j=1-ist, ny+ist
WRITE (*,*) prim(:,j)
END DO
WRITE(*,*) " "
END IF
IF (rang .eq. 1) then
DO i=1, ist
DO j=1-ist, ny+ist
prim_S(i,j) = prim(i,j)
END DO
END DO
END IF
CALL MPI_BARRIER (MPI_COMM_WORLD, mpicode)
! Communication
IF (rang .eq. 0) then
CALL MPI_RECV (prim_R, size(prim_R), MPI_INTEGER
& , voisinage(2),
& etiquette, comm, mpicode)
END IF
IF (rang .eq. 1) then
CALL MPI_SEND (prim_S, size(prim_S), MPI_INTEGER ,
& voisinage(1),
& etiquette,comm, mpicode)
END IF
IF (rang .eq. 0) then
DO i=nx+1, nx+ist
DO j=1-ist, ny+ist
prim(i,j) = prim_R(i-nx,j)
END DO
END DO
END IF
! Print the left domain AFTER the communication
IF (rang .eq. 0) then
DO j=1-ist, ny+ist
WRITE (*,*) prim(:,j)
END DO
END IF
CALL MPI_FINALIZE(mpicode)
END PROGRAM
所以它正在工作,这是沟通后的输出:
0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 1
0 0 0 0 0 0 0 1 1
事实是,我不太喜欢这种方法,并且由于子阵列类型看起来像是为了这样的目的而创建的,我想使用它。这是代码,等同于之前的代码:
PROGRAM TEST
USE mpi
IMPLICIT NONE
INTEGER*4, PARAMETER :: ist = 2 ! Guard cells
INTEGER*4, PARAMETER :: nx = 5, ny = 2 ! Domain size
INTEGER*4, DIMENSION (1-ist:nx+ist,1-ist:ny+ist) :: prim ! A vector
! MPI stuff
INTEGER*4, PARAMETER :: ndims = 2
INTEGER*4 :: mpicode, nb_procs, rang, comm, etiquette = 100
LOGICAL, DIMENSION (ndims) :: periods
LOGICAL :: reorganisation
INTEGER*4, DIMENSION (ndims) :: dims
INTEGER*4, DIMENSION (6) :: voisinage
INTEGER*4, DIMENSION (2) :: profil_tab, profil_sous_tab
INTEGER*4 :: i, j
INTEGER*4 :: type_envoi_W, type_envoi_E
INTEGER*4 :: type_reception_W, type_reception_E
!--------------------------------------------------------------------
periods = .FALSE.
reorganisation = .FALSE.
dims(1) = 2
dims(2) = 1
CALL MPI_INIT (mpicode)
CALL MPI_COMM_SIZE (MPI_COMM_WORLD, nb_procs, mpicode)
CALL MPI_COMM_RANK (MPI_COMM_WORLD, rang, mpicode)
WRITE (*,*) "PROCESSUS ", rang, " OK"
CALL MPI_CART_CREATE (MPI_COMM_WORLD, ndims, dims, periods,
& reorganisation, comm, mpicode)
CALL MPI_CART_SHIFT (comm, 0, 1, voisinage(1), voisinage(2),
& mpicode)
profil_tab(:) = SHAPE (prim)
profil_sous_tab(:) = (/ist, ny+2*ist/)
! Envoi W
CALL MPI_TYPE_CREATE_SUBARRAY (2, profil_tab, profil_sous_tab,
& (/ist,0/) , MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION
& , type_envoi_W, mpicode)
CALL MPI_TYPE_COMMIT (type_envoi_W, mpicode)
! Reception E
CALL MPI_TYPE_CREATE_SUBARRAY (2, profil_tab, profil_sous_tab,
& (/nx+ist,0/) , MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION,
& type_reception_E, mpicode)
CALL MPI_TYPE_COMMIT (type_reception_E, mpicode)
IF (rang .eq. 0) then
prim = 0
ELSE
prim = 1
END IF
IF (rang .eq. 0) then
DO j=1-ist, ny+ist
WRITE (*,*) prim(:,j)
END DO
WRITE(*,*) " "
END IF
CALL MPI_BARRIER (MPI_COMM_WORLD, mpicode)
IF (rang .eq. 0) then
CALL MPI_RECV (prim, 1, type_reception_E, voisinage(2),
& etiquette, comm, mpicode)
END IF
IF (rang .eq. 1) then
CALL MPI_SEND (prim, 1, type_envoi_W, voisinage(1),
& etiquette,comm, mpicode)
END IF
IF (rang .eq. 0) then
DO j=1-ist, ny+ist
WRITE (*,*) prim(:,j)
END DO
END IF
CALL MPI_FINALIZE(mpicode)
END PROGRAM
输出是奇怪的域,加上分段错误......:
0 0 0 0 0 0 0 0 0
0 0 0 0 0 1 1 1 1
0 0 0 0 0 0 0 0 0
0 0 0 0 0 1 1 1 1
0 0 0 0 0 0 0 0 0
0 0 0 0 0 1 1 1 1
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
当我创建子阵列类型但我不明白为什么时,我猜我的起始坐标是错误的。
我希望你们可以帮助我!感谢阅读,这篇文章很长,但我试着说清楚。
橡树