Вы будете пинать себя, когда увидите здесь главную проблему; Вы не распределили количество или количество очков.
Кроме того, я настоятельно рекомендую использовать use mpi вместо include mpif.h; оператор использования (до неявного none) вводит интерфейс F90, который имеет намного лучшую проверку типов. Когда вы сделаете это, вы также увидите, что для создания типа с измененным размером вам понадобятся целые числа kind mpi_address_kind.
Обновление :
Хорошо, поэтому для более крупного вопроса о том, как сделать сбор, у вас все было в основном правильно, но вы правы, старты, дисплеи и т. Д. Должны быть проиндексированы нулями, а не 1, потому что фактическая библиотека MPI делать вещи с точки зрения C, даже с привязками FORTRAN. Таким образом, для sendubarray, старты должны быть [1,1]; для подмассива recv это должно быть [0,0], а изменение размера, start должно быть 0, а экстент должен быть sizeof (тип) (и оба должны быть целыми числами типа mpi_address_kind).
Я прикрепляю версию вашего кода с этими обновлениями и с базовыми массивами, имеющими тип символа, чтобы было проще распечатать диагностику и посмотреть, что происходит:
program main
use mpi
implicit none
integer :: ierr, myRank, nProcs
integer :: sendsubarray, recvsubarray, resizedrecvsubarray
integer, dimension(2) :: starts,sizes,subsizes
integer, dimension(:), allocatable :: counts, disps
integer, parameter :: nx_glb=10, ny_glb=10, nx=5, ny=5
character, dimension(:,:), target, allocatable :: mat, matG
character :: c
integer :: i, j, p
integer(kind=mpi_address_kind) :: start, extent
call mpi_init(ierr)
call mpi_comm_rank(mpi_comm_world, myRank, ierr)
call mpi_comm_size(mpi_comm_world, nProcs, ierr)
sizes(1)=nx+2; sizes(2)=ny+2
subsizes(1)=nx; subsizes(2)=ny
starts(1)=1; starts(2)=1
call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
mpi_character, sendsubarray, ierr)
call mpi_type_commit(sendsubarray,ierr)
allocate(mat(1:nx+2,1:ny+2))
mat='.'
forall (i=2:nx+1,j=2:ny+1) mat(i,j)=ACHAR(ICHAR('0')+myRank)
if(myRank.eq.0) then
allocate(matG(nx_glb,ny_glb))
matG='.'
sizes(1)=nx_glb; sizes(2)=ny_glb
subsizes(1)=nx; subsizes(2)=ny
starts(1)=0; starts(2)=0
call mpi_type_create_subarray(2, sizes, subsizes, starts, mpi_order_fortran, &
mpi_character, recvsubarray, ierr)
call mpi_type_commit(recvsubarray, ierr)
extent = sizeof(c)
start = 0
call mpi_type_create_resized(recvsubarray, start, extent, resizedrecvsubarray, ierr)
call mpi_type_commit(resizedrecvsubarray,ierr)
end if
allocate(counts(4),disps(4))
counts(1:4) = (/1, 1, 1, 1/)
disps(1:4) = (/0, 5, 50, 55/)
call mpi_gatherv(mat,1,sendsubarray,matG,counts,disps,resizedrecvsubarray, &
0,mpi_comm_world,ierr)
do p=0,nProcs
if (myRank == p) then
print *, 'Local array for rank ', myRank
do i=1, nx+2
print *, (mat(i,j),j=1,ny+2)
end do
endif
call MPI_Barrier(MPI_COMM_WORLD,ierr)
enddo
if(myRank.eq.0) then
print *, 'Global array: '
do i=1, nx_glb
print *, (matG(i,j),j=1, ny_glb)
end do
end if
call mpi_finalize(ierr)
end program main
С выходом:
Local array for rank 0
.......
.00000.
.00000.
.00000.
.00000.
.00000.
.......
Local array for rank 1
.......
.11111.
.11111.
.11111.
.11111.
.11111.
.......
Local array for rank 2
.......
.22222.
.22222.
.22222.
.22222.
.22222.
.......
Local array for rank 3
.......
.33333.
.33333.
.33333.
.33333.
.33333.
.......
Global array:
0000022222
0000022222
0000022222
0000022222
0000022222
1111133333
1111133333
1111133333
1111133333
1111133333
... имеет смысл? Это очень похоже на C-версию этого вопроса, на которую вы найдете ответы ( MPI_Type_create_subarray и MPI_Gather ), но вы уже выяснили, в основном ...
О, да, еще одна вещь - вам на самом деле не нужно устанавливать указатели на данные send / recv в Fortran. В C вам нужно явно передавать указатели на массивы данных; в Фортране вы можете просто передавать массивы (и они уже передаются «по ссылке», например, эквивалентные указатели передачи C в переменную). Таким образом, вы можете просто передать массив.