MPI,SUBARRAY类型

时间:2014-12-22 14:36:40

标签: fortran mpi

我担心使用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.

当我创建子阵列类型但我不明白为什么时,我猜我的起始坐标是错误的。

我希望你们可以帮助我!感谢阅读,这篇文章很长,但我试着说清楚。

橡树

1 个答案:

答案 0 :(得分:1)

  • 您的数组类型应由MPI_INTEGER组成,而不是MPI_DOUBLE_PRECISION
  • 在这两种情况下,您的MPI_RECV()电话都需要状态参数。