CODEWITHSUNDEEP
fortranmpi
Oak R.
Oak R.

Reputation: 9

MPI, SUBARRAY types

I have concerns using the Subarray type. I'm trying to transfer a part of global domain (represented by a 2D array) between two procs. I have no problem achieving this without the sub-array structure. The following example illustrate what I want to do. A whole 2D domain is equally divided into two parts for each MPI processus, one containing "zero" (left) and the other containing "one" (right). On each MPI-processus, the half-domain is made of the "real domain" plus a border of guard cells (that's why the array indexing begin at 1-ist, see below). The objective is simple : right domain has to send it's two first columns into the two "guard cells" columns of the left one.

The code that works is the followng :

  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

So it's working, here is the output after the communication :

       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

The fact is that I don't like this method that much, and as the subarray type looks like created for such purposes, I would like to use it. Here is the code, equivalent as previous :

      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

The output is that weird domain, plus a segmentation fault... :

       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.

I guess I'm wrong with the beginning coordinates when I'm creating the subarray types but I don't understand why.

I wish you guys can help me with that! Thanks for reading, it's quite a long post but I tried to be clear.

Oak

Upvotes: 0

Views: 350

Answers (1)

Jonathan Dursi
Jonathan Dursi

Reputation: 50947

  • Your array type should be composed of MPI_INTEGER, not MPI_DOUBLE_PRECISION.
  • Your MPI_RECV() call in both cases requires a Status argument.

Upvotes: 1

Related Questions