Gửi mảng 2D ở Fortran với MPI_Gather

Question

Tôi muốn gửi khối dữ liệu 2d bằng cách sử dụng MPI_GATHER.For ví dụ tôi có mảng 2x3 trên mỗi nút và tôi muốn mảng 8x3 trên gốc, nếu tôi có 4 nút. đối với mảng 1d MPI_GATHER sắp xếp dữ liệu theo thứ hạng MPI nhưng đối với dữ liệu 2d, nó tạo ra sự lộn xộn !. Cách sạch sẽ để đặt khối theo thứ tự là gì?

tôi mong đợi đầu ra của mã này:

program testmpi 
    use mpi 
implicit none 
integer :: send (2,3) 
integer :: rec (4,3) 
integer :: ierror,my_rank,i,j 
call MPI_Init(ierror) 
MPI_DATA_TYPE type_col 
! find out process rank 
call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierror) 
if (my_rank==0) then 
send=1 
do i=1,2 
    print*,(send(i,j),j=1,3) 
enddo 
endif 
if (my_rank==1) then 
send=5 
! do 1,2 
! print*,(send(i,j),j=1,3) 
! enddo 
endif 
call MPI_GATHER(send,6,MPI_INTEGER,rec,6,MPI_INTEGER,0,MPI_COMM_WORLD,ierror) 
if (my_rank==0) then 
    print*,'<><><><><>rec' 
do i=1,4 
    print*,(rec(i,j),j=1,3) 
enddo 
endif 
call MPI_Finalize(ierror) 
end program testmpi 

là một cái gì đó như thế này:

1   1   1 
    1   1   1 
    5   5   5 
    5   5   5 

nhưng có vẻ như thế này:

1   1   5 
    1   1   5 
    1   5   5 
    1   5   5 

Answer 1

Sau đây một Fortran đen bản dịch của this answer. Tôi đã nghĩ rằng điều này là không cần thiết, nhưng sự khác biệt nhiều trong lập chỉ mục mảng và bố trí bộ nhớ có thể có nghĩa là nó là giá trị làm một phiên bản Fortran.

Hãy để tôi bắt đầu bằng cách nói rằng bạn thường không thực sự muốn làm điều này - phân tán và thu thập các khối dữ liệu khổng lồ từ một số quy trình "chính". Thông thường, bạn muốn mỗi công việc được chugging đi vào mảnh ghép của riêng nó, và bạn nên nhắm đến việc không bao giờ có một bộ xử lý cần một "cái nhìn tổng thể" của toàn bộ dữ liệu; ngay sau khi bạn yêu cầu điều đó, bạn giới hạn khả năng mở rộng và kích thước vấn đề. Nếu bạn đang làm điều này cho I/O - một quá trình đọc dữ liệu, sau đó phân tán nó, sau đó tập hợp nó trở lại để viết, bạn sẽ muốn cuối cùng để nhìn vào MPI-IO.

Nhận câu hỏi của bạn, tuy nhiên, Bộ KH & ĐT có các cách rất hay để kéo dữ liệu tùy ý ra khỏi bộ nhớ, và phân tán/thu thập dữ liệu đó đến và từ một bộ xử lý. Thật không may là đòi hỏi một số lượng hợp lý các khái niệm MPI - Các loại MPI, phạm vi mở rộng và các hoạt động tập thể. Rất nhiều ý tưởng cơ bản được thảo luận trong câu trả lời cho câu hỏi này - MPI_Type_create_subarray and MPI_Gather.

Hãy xem xét mảng số nguyên 1d toàn cục mà tác vụ 0 có mà bạn muốn phân phối cho một số nhiệm vụ MPI, để mỗi chúng có được một phần trong mảng cục bộ của chúng. Giả sử bạn có 4 tác vụ và mảng toàn cục là [0,1,2,3,4,5,6,7]. Bạn có thể có nhiệm vụ 0 gửi bốn tin nhắn (bao gồm cả một bản thân) để phân phối này, và khi đó là thời gian để tái lắp ráp, nhận được bốn tin nhắn để bó nó lại với nhau; nhưng điều đó rõ ràng là tốn rất nhiều thời gian với số lượng lớn các quy trình. Có các thói quen tối ưu hóa cho các loại hoạt động này - phân tán/thu thập các hoạt động. Vì vậy, trong trường hợp này 1d bạn muốn làm một cái gì đó như thế này:

integer, dimension(8) :: global  ! only root has this 
integer, dimension(2) :: local  ! everyone has this 
integer, parameter :: root = 0 
integer :: rank, comsize 
integer :: i, ierr 

call MPI_Init(ierr) 
call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierr) 
call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) 

if (rank == root) then 
    global = [ (i, i=1,8) ] 
endif 

call MPI_Scatter(global, 2, MPI_INTEGER, & ! send everyone 2 ints from global 
       local, 2, MPI_INTEGER, & ! each proc recieves 2 into 
       root,     & ! sending process is root, 
       MPI_COMM_WORLD, ierr)  ! all procs in COMM_WORLD participate 

Sau đó, dữ liệu của các bộ vi xử lý sẽ như thế nào

task 0: local:[1,2] global: [1,2,3,4,5,6,7,8] 
task 1: local:[3,4] global: [garbage] 
task 2: local:[5,6] global: [garbage] 
task 3: local:[7,8] global: [garbage] 

Đó là, các hoạt động phân tán mất mảng toàn cầu và gửi tiếp giáp 2-int khối cho tất cả các bộ vi xử lý.

Để tái lắp ráp mảng, chúng ta sử dụng() hoạt động MPI_Gather, mà làm việc giống hệt nhau nhưng ngược lại:

local = local + rank 

call MPI_Gather (local, 2, MPI_INTEGER, & ! everyone sends 2 ints from local 
       global, 2, MPI_INTEGER, & ! root receives 2 ints each proc into global 
       root,     & ! receiving process is root, 
       MPI_COMM_WORLD, ierr)  ! all procs in COMM_WORLD participate 

Và bây giờ các mảng trông giống như:

task 0: local:[1,2] global: [1,2,4,5,7,8,10,11] 
task 1: local:[4,5] global: [garbage-] 
task 2: local:[7,8] global: [garbage-] 
task 3: local:[10,11] global: [garbage-] 

Thu thập mang tất cả dữ liệu trở lại.

Điều gì sẽ xảy ra nếu số điểm dữ liệu không phân chia đồng đều số lượng quy trình và chúng tôi cần gửi số lượng mặt hàng khác nhau cho từng quy trình?Sau đó, bạn cần một phiên bản tổng quát của phân tán, MPI_Scatterv, cho phép bạn chỉ định số lượng cho mỗi bộ xử lý và chuyển vị - nơi trong mảng toàn cục mà phần dữ liệu bắt đầu. Vì vậy, chúng ta hãy nói với cùng một nhiệm vụ 4 bạn có một loạt các ký tự [a, b, c, d, e, f, g, h, i] với 9 ký tự, và bạn sẽ chỉ định mỗi quá trình hai ký tự ngoại trừ , có ba. Sau đó, bạn sẽ cần

character, dimension(9) :: global 
character, dimension(3) :: local 
integer, dimension(4) :: counts 
integer, dimension(4) :: displs 

if (rank == root) then 
    global = [ (achar(i+ichar('a')), i=0,8) ] 
endif 
local = ['-','-','-'] 

counts = [2,2,2,3] 
displs = [0,2,4,6] 

mycounts = counts(rank+1) 

call MPI_Scatterv(global, counts, displs,   & ! proc i gets counts(i) chars from displs(i) 
        MPI_CHARACTER,     & 
        local, mycounts, MPI_CHARACTER, & ! I get mycounts chars into 
        root,       & ! root rank does sending 
        MPI_COMM_WORLD, ierr)    ! all procs in COMM_WORLD participate 

Bây giờ các dữ liệu trông giống như

task 0: local:"ab-" global: "abcdefghi" 
task 1: local:"cd-" global: *garbage* 
task 2: local:"ef-" global: *garbage* 
task 3: local:"ghi" global: *garbage* 

Bây giờ bạn đã sử dụng scatterv để phân phối các khoản đột xuất dữ liệu. Sự dịch chuyển trong mỗi trường hợp là hai * hạng (được đo bằng ký tự; chuyển vị là đơn vị của các kiểu được gửi cho một phân tán hoặc nhận được cho một tập hợp; nó không phải là byte hoặc cái gì đó) từ đầu mảng, và đếm là [2,2,2,3]. Nếu nó là bộ vi xử lý đầu tiên chúng tôi muốn có 3 ký tự, chúng tôi sẽ đặt số đếm = [3,2,2,2] và chuyển vị sẽ là [0,3,5,7]. Gatherv một lần nữa hoạt động chính xác như nhau nhưng ngược lại; các mảng đếm và chuyển sẽ vẫn giữ nguyên.

Bây giờ, đối với 2D, điều này hơi phức tạp hơn một chút. Nếu chúng ta muốn gửi các sublocks 2d của một mảng 2d, dữ liệu chúng ta đang gửi bây giờ không còn tiếp giáp nữa. Nếu chúng tôi đưa (nói) subblocks 3x3 của một mảng 6x6 đến 4 bộ vi xử lý, dữ liệu chúng tôi đang gửi có lỗ hổng trong nó:

2D Array 

    --------- 
    |000|222| 
    |000|222| 
    |000|222| 
    |---+---| 
    |111|333| 
    |111|333| 
    |111|333| 
    --------- 

Actual layout in memory 

    [000111000111000111222333222333222333] 

(Lưu ý rằng tất cả các máy tính hiệu suất cao đi xuống đến tìm hiểu cách bố trí Nếu chúng tôi muốn gửi dữ liệu được đánh dấu "1" đến nhiệm vụ 1, chúng tôi cần bỏ qua ba giá trị, gửi ba giá trị, bỏ qua ba giá trị, gửi ba giá trị, bỏ qua ba giá trị, gửi ba giá trị. Một biến chứng thứ hai là nơi các tiểu vùng dừng lại và bắt đầu; lưu ý rằng vùng "1" không bắt đầu khi vùng "0" dừng; sau phần tử cuối cùng của vùng "0", vị trí tiếp theo trong bộ nhớ là một phần theo cách thông qua vùng "1".

Trước tiên, hãy giải quyết vấn đề bố cục đầu tiên - cách chỉ lấy dữ liệu chúng tôi muốn gửi. Chúng tôi luôn có thể sao chép tất cả dữ liệu vùng "0" sang vùng khác, mảng liền kề và gửi đi; nếu chúng tôi lên kế hoạch đủ cẩn thận, chúng tôi thậm chí có thể làm điều đó theo cách mà chúng tôi có thể gọi MPI_Scatter về kết quả. Nhưng chúng tôi không muốn phải chuyển đổi toàn bộ cấu trúc dữ liệu chính theo cách đó.

Cho đến nay, tất cả các loại dữ liệu MPI mà chúng tôi đã sử dụng là những loại đơn giản - MPI_INTEGER chỉ định (nói) 4 byte liên tiếp. Tuy nhiên, MPI cho phép bạn tạo các kiểu dữ liệu riêng của mình mô tả các bố cục dữ liệu phức tạp tùy ý trong bộ nhớ. Và trường hợp hình chữ nhật - chữ nhật này của một mảng - là đủ phổ biến mà there's a specific call for that. Đối với trường hợp 2 chiều, chúng tôi mô tả ở trên,

integer :: newtype; 
integer, dimension(2) :: sizes, subsizes, starts 

sizes = [6,6]  ! size of global array 
subsizes = [3,3]  ! size of sub-region 
starts = [0,0]  ! let's say we're looking at region "0" 
        ! which begins at offset [0,0] 

call MPI_Type_create_subarray(2, sizes, subsizes, starts, MPI_ORDER_FORTRAN, MPI_INTEGER, newtype, ierr) 
call MPI_Type_commit(newtype, ierr) 

Điều này tạo ra loại chỉ chọn vùng "0" từ mảng toàn cầu. Lưu ý rằng ngay cả trong Fortran, tham số bắt đầu được đưa ra như là một sự bù trừ (ví dụ, dựa trên 0) từ đầu mảng, chứ không phải chỉ mục (ví dụ: dựa trên 1).

Chúng ta có thể gửi chỉ là phần dữ liệu nay đến một bộ xử lý

call MPI_Send(global, 1, newtype, dest, tag, MPI_COMM_WORLD, ierr) ! send region "0" 

và quá trình tiếp nhận có thể nhận được nó vào một mảng địa phương. Lưu ý rằng quá trình nhận, nếu nó chỉ nhận nó vào một mảng 3x3, không thể mô tả những gì nó nhận được như là một loại newtype; không còn mô tả bố cục bộ nhớ, vì không có bỏ qua lớn giữa phần cuối của một hàng và bắt đầu tiếp theo.Thay vào đó, nó chỉ nhận được một khối 3 * 3 = 9 số nguyên:

call MPI_Recv(local, 3*3, MPI_INTEGER, 0, tag, MPI_COMM_WORLD, ierr) 

Lưu ý rằng chúng ta có thể làm điều này cho các tiểu vùng khác nữa, hoặc bằng cách tạo ra một loại khác nhau (với mảng bắt đầu khác nhau) cho các khối khác, hoặc chỉ bằng cách gửi bắt đầu từ vị trí đầu tiên của khối cụ thể:

if (rank == root) then 
    call MPI_Send(global(4,1), 1, newtype, 1, tag, MPI_COMM_WORLD, ierr) 
    call MPI_Send(global(1,4), 1, newtype, 2, tag, MPI_COMM_WORLD, ierr) 
    call MPI_Send(global(4,4), 1, newtype, 3, tag, MPI_COMM_WORLD, ierr) 
    local = global(1:3, 1:3) 
else 
    call MPI_Recv(local, 3*3, MPI_INTEGER, 0, tag, MPI_COMM_WORLD, rstatus, ierr) 
endif 

Bây giờ chúng ta hiểu làm thế nào để xác định các tiểu vùng, chỉ có một điều nữa để thảo luận trước khi sử dụng phân tán/tập hợp các hoạt động, và đó là "kích thước" của các loại này. Chúng tôi không thể chỉ sử dụng MPI_Scatter() (hoặc thậm chí phân tán) với các loại này được nêu ra, bởi vì các loại này có một phạm vi 15 số nguyên; có nghĩa là, nơi chúng kết thúc là 15 số nguyên sau khi chúng bắt đầu - và nơi chúng kết thúc không xếp hàng độc đáo với vị trí khối tiếp theo bắt đầu, vì vậy chúng tôi không thể sử dụng phân tán - nó sẽ chọn sai vị trí để bắt đầu gửi dữ liệu tới bộ xử lý tiếp theo. Tất nhiên, chúng ta có thể sử dụng MPI_Scatterv() và chỉ định chính các chuyển vị, và đó là những gì chúng ta sẽ làm - ngoại trừ sự dịch chuyển nằm trong các đơn vị của kích cỡ gửi-gửi, và điều đó cũng không giúp chúng ta; các khối bắt đầu tại các số nguyên của (0,3,18,21) số nguyên từ đầu của mảng toàn cầu, và thực tế là một khối kết thúc 15 số nguyên từ nơi nó bắt đầu không cho phép chúng tôi thể hiện những chuyển vị trong bội số nguyên ở tất cả .

Để giải quyết vấn đề này, MPI cho phép bạn đặt mức độ của loại cho mục đích của các tính toán này. Nó không cắt ngắn loại; nó chỉ được sử dụng để tìm ra nơi yếu tố tiếp theo bắt đầu cho phần tử cuối cùng. Đối với các loại như thế này với các lỗ hổng trong chúng, nó thường hữu dụng để thiết lập mức độ là một cái gì đó nhỏ hơn khoảng cách trong bộ nhớ đến cuối thực tế của loại.

Chúng tôi có thể đặt mức độ là bất kỳ điều gì thuận tiện cho chúng tôi. Chúng tôi chỉ có thể làm cho 1 số nguyên, và sau đó thiết lập chuyển vị trong đơn vị của số nguyên. Trong trường hợp này, mặc dù, tôi muốn đặt mức độ là 3 số nguyên - kích thước của một cột phụ - theo cách đó, khối "1" bắt đầu ngay lập tức sau khối "0" và chặn "3" bắt đầu ngay lập tức sau khi chặn " 2 ". Thật không may, nó không hoàn toàn hoạt động như độc đáo khi nhảy từ khối "2" để chặn "3", nhưng điều đó không thể tránh được.

Vì vậy, để làm tan tác dân subblocks trong trường hợp này, chúng tôi muốn làm như sau:

integer(kind=MPI_ADDRESS_KIND) :: extent 

starts = [0,0] 
sizes = [6, 6] 
subsizes = [3, 3] 

call MPI_Type_create_subarray(2, sizes, subsizes, starts,  & 
           MPI_ORDER_FORTRAN, MPI_INTEGER, & 
           newtype, ierr) 
call MPI_Type_size(MPI_INTEGER, intsize, ierr) 
extent = 3*intsize 
call MPI_Type_create_resized(newtype, 0, extent, resizedtype, ierr) 
call MPI_Type_commit(resizedtype, ierr) 

Dưới đây chúng tôi đã tạo kiểu khối giống như trước, nhưng chúng tôi đã thay đổi kích cỡ nó; chúng tôi đã không thay đổi nơi mà các loại "bắt đầu" (0) nhưng chúng tôi đã thay đổi nơi nó "kết thúc" (3 số nguyên). Chúng tôi đã không đề cập đến điều này trước đây, nhưng cần có MPI_Type_commit để có thể sử dụng loại; nhưng bạn chỉ cần cam kết loại cuối cùng bạn thực sự sử dụng, không phải bất kỳ bước trung gian nào. Bạn sử dụng MPI_Type_free để giải phóng loại cam kết khi bạn hoàn tất.

Vì vậy, bây giờ, cuối cùng, chúng ta có thể scatterv các khối: các thao tác dữ liệu trên là một chút phức tạp, nhưng khi nó đã được thực hiện, scatterv trông giống như trước đây:

counts = 1   ! we will send one of these new types to everyone 
displs = [0,1,6,7] ! the starting point of everyone's data 
        ! in the global array, in block extents 

call MPI_Scatterv(global, counts, displs, & ! proc i gets counts(i) types from displs(i) 
     resizedtype,      & 
     local, 3*3, MPI_INTEGER,   & ! I'm receiving 3*3 int 
     root, MPI_COMM_WORLD, ierr)   !... from (root, MPI_COMM_WORLD) 

Và bây giờ chúng tôi đang thực hiện, sau một chuyến tham quan nhỏ, phân tán và các loại có nguồn gốc từ MPI.

Mã ví dụ hiển thị cả thao tác thu thập và hoạt động phân tán, với mảng ký tự, theo sau.Chạy chương trình:

$ mpirun -np 4 ./scatter2d 
global array is: 
000222 
000222 
000222 
111333 
111333 
111333 
Rank   0 received: 
000 
000 
000 
Rank   1 received: 
111 
111 
111 
Rank   2 received: 
222 
222 
222 
Rank   3 received: 
333 
333 
333 
Rank   0 sending: 
111 
111 
111 
Rank   1 sending: 
222 
222 
222 
Rank   2 sending: 
333 
333 
333 
Rank   3 sending: 
444 
444 
444 
    Root received: 
111333 
111333 
111333 
222444 
222444 
222444 

và mã sau:

program scatter 
    use mpi 
    implicit none 

    integer, parameter :: gridsize = 6 ! size of array 
    integer, parameter :: procgridsize = 2 ! size of process grid 
    character, allocatable, dimension (:,:) :: global, local 
    integer, dimension(procgridsize**2) :: counts, displs 
    integer, parameter :: root = 0 
    integer :: rank, comsize 
    integer :: localsize 
    integer :: i, j, row, col, ierr, p, charsize 
    integer, dimension(2) :: sizes, subsizes, starts 

    integer :: newtype, resizedtype 
    integer, parameter :: tag = 1 
    integer, dimension(MPI_STATUS_SIZE) :: rstatus 
    integer(kind=MPI_ADDRESS_KIND) :: extent, begin 

    call MPI_Init(ierr) 
    call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierr) 
    call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) 

    if (comsize /= procgridsize**2) then 
     if (rank == root) then 
      print *, 'Only works with np = ', procgridsize**2, ' for now.' 
     endif 
     call MPI_Finalize(ierr) 
     stop 
    endif 

    localsize = gridsize/procgridsize 
    allocate(local(localsize, localsize)) 
    if (rank == root) then 
     allocate(global(gridsize, gridsize)) 
     forall(col=1:procgridsize, row=1:procgridsize) 
      global((row-1)*localsize+1:row*localsize, & 
        (col-1)*localsize+1:col*localsize) = & 
        achar(ichar('0')+(row-1)+(col-1)*procgridsize) 
     end forall 

     print *, 'global array is: ' 
     do i=1,gridsize 
      print *, global(i,:) 
     enddo 
    endif 
    starts = [0,0] 
    sizes = [gridsize, gridsize] 
    subsizes = [localsize, localsize] 

    call MPI_Type_create_subarray(2, sizes, subsizes, starts,  & 
            MPI_ORDER_FORTRAN, MPI_CHARACTER, & 
            newtype, ierr) 
    call MPI_Type_size(MPI_CHARACTER, charsize, ierr) 
    extent = localsize*charsize 
    begin = 0 
    call MPI_Type_create_resized(newtype, begin, extent, resizedtype, ierr) 
    call MPI_Type_commit(resizedtype, ierr) 

    counts = 1   ! we will send one of these new types to everyone 
    forall(col=1:procgridsize, row=1:procgridsize) 
     displs(1+(row-1)+procgridsize*(col-1)) = (row-1) + localsize*procgridsize*(col-1) 
    endforall 

    call MPI_Scatterv(global, counts, displs, & ! proc i gets counts(i) types from displs(i) 
      resizedtype,      & 
      local, localsize**2, MPI_CHARACTER, & ! I'm receiving localsize**2 chars 
      root, MPI_COMM_WORLD, ierr)   !... from (root, MPI_COMM_WORLD) 

    do p=1, comsize 
     if (rank == p-1) then 
      print *, 'Rank ', rank, ' received: ' 
      do i=1, localsize 
       print *, local(i,:) 
      enddo 
     endif 
     call MPI_Barrier(MPI_COMM_WORLD, ierr) 
    enddo 

    local = achar(ichar(local) + 1) 

    do p=1, comsize 
     if (rank == p-1) then 
      print *, 'Rank ', rank, ' sending: ' 
      do i=1, localsize 
       print *, local(i,:) 
      enddo 
     endif 
     call MPI_Barrier(MPI_COMM_WORLD, ierr) 
    enddo 

    call MPI_Gatherv(local, localsize**2, MPI_CHARACTER, & ! I'm sending localsize**2 chars 
         global, counts, displs, resizedtype,& 
         root, MPI_COMM_WORLD, ierr) 

    if (rank == root) then 
     print *, ' Root received: ' 
     do i=1,gridsize 
      print *, global(i,:) 
     enddo 
    endif 

    call MPI_Type_free(newtype,ierr) 
    if (rank == root) deallocate(global) 
    deallocate(local) 
    call MPI_Finalize(ierr) 

end program scatter 

Vì vậy, đó là giải pháp chung. Đối với trường hợp cụ thể của bạn, nơi chúng ta chỉ cần thêm hàng, chúng ta không cần Gatherv, chúng ta có thể sử dụng một tập hợp, vì trong trường hợp này, tất cả các chuyển vị đều giống nhau - trước đây, trong trường hợp khối 2d có một chuyển vị 'xuống', và sau đó nhảy vào chuyển vị đó khi bạn đi 'ngang qua' đến cột tiếp theo của các khối. Ở đây, sự dịch chuyển luôn luôn ở một mức độ so với mức trước đó, vì vậy chúng ta không cần phải chuyển vị một cách rõ ràng. Vì vậy, một mã cuối cùng trông giống như:

program testmpi 
use mpi 
    implicit none 
    integer, dimension(:,:), allocatable :: send, recv 
    integer, parameter :: nsendrows = 2, nsendcols = 3 
    integer, parameter :: root = 0 
    integer :: ierror, my_rank, comsize, i, j, ierr 
    integer :: blocktype, resizedtype 
    integer, dimension(2) :: starts, sizes, subsizes 
    integer (kind=MPI_Address_kind) :: start, extent 
    integer :: intsize 

    call MPI_Init(ierror) 
    call MPI_Comm_rank(MPI_COMM_WORLD, my_rank, ierror) 
    call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierror) 

    allocate(send(nsendrows, nsendcols)) 

    send = my_rank 

    if (my_rank==root) then 
     ! we're going to append the local arrays 
     ! as groups of send rows 
     allocate(recv(nsendrows*comsize, nsendcols)) 
    endif 

    ! describe what these subblocks look like inside the full concatenated array 
    sizes = [ nsendrows*comsize, nsendcols ] 
    subsizes = [ nsendrows, nsendcols ] 
    starts = [ 0, 0 ] 

    call MPI_Type_create_subarray(2, sizes, subsizes, starts,  & 
            MPI_ORDER_FORTRAN, MPI_INTEGER, & 
            blocktype, ierr) 

    start = 0 
    call MPI_Type_size(MPI_INTEGER, intsize, ierr) 
    extent = intsize * nsendrows 

    call MPI_Type_create_resized(blocktype, start, extent, resizedtype, ierr) 
    call MPI_Type_commit(resizedtype, ierr) 

    call MPI_Gather(send, nsendrows*nsendcols, MPI_INTEGER, & ! everyone send 3*2 ints 
        recv, 1, resizedtype,     & ! root gets 1 resized type from everyone 
        root, MPI_COMM_WORLD, ierr) 

    if (my_rank==0) then 
    print*,'<><><><><>recv' 
    do i=1,nsendrows*comsize 
     print*,(recv(i,j),j=1,nsendcols) 
    enddo 
    endif 
    call MPI_Finalize(ierror) 

end program testmpi 

Chạy này với 3 quá trình cung cấp cho:

$ mpirun -np 3 ./testmpi 
<><><><><>recv 
      0   0   0 
      0   0   0 
      1   1   1 
      1   1   1 
      2   2   2 
      2   2   2