0
我擔心使用子數組類型。我試圖在兩個特效之間傳輸全局域(由二維數組表示)的一部分。如果沒有子陣列結構,我沒有問題。以下示例說明我想要做什麼。對於每個MPI過程,整個2D域均等分爲兩個部分,一個包含「零」(左),另一個包含「一個」(右)。在每個MPI過程中,半域由「真實域」加上保護單元的邊界組成(這就是爲什麼數組索引開始於1-ist,見下文)。目標很簡單:右側的域必須將兩個第一列發送到左側的兩個「保護單元」列中。MPI,SUBARRAY類型
,工程的代碼是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
所以它的工作,這裏是通信後的輸出:
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.
我想我錯了年初座標時我創建子數組類型,但我不明白爲什麼。
我希望你們能幫助我!感謝閱讀,這是一個相當長的帖子,但我試圖澄清。
橡樹
謝謝,它工作:) –