Parallel processing 用fortran实现MPI分离数组的问题
我编写了以下代码行，目的是将1D数组Parallel processing 用fortran实现MPI分离数组的问题,parallel-processing,fortran,mpi,Parallel Processing,Fortran,Mpi,我编写了以下代码行，目的是将1D数组Jp（仅存在于主进程上）划分到不同的进程（包括主进程）上。 每个进程都必须接收一个非contiguos修改数据块（值在内部循环中更改），我使用MPI_TYPE_index函数创建了一个新格式newF，以选择要发送的正确数据部分。 我使用MPI_RECV或MPI_IRECV来接收数据 问题是，这部分代码可以正常工作，任务的数量可以是任意的（从1到8），直到Jp的元素数量很小，当我增加这个数量（即n=5000）时，并不是所有的进程都会收到数据，分割的数组JpS显示
JpnewFJpJpSprogram test_send
use mpi
implicit none
integer :: rank, nproc, mpi_stat
integer :: n, m, k, io, i, j
integer, allocatable :: Jp(:), JpS(:), JpAux(:)
integer :: count, n_distro,newF
integer, allocatable :: sendcounts(:), displ(:), &
blocklens(:), blockdisp(:), &
request(:)
integer :: ARRAY_OF_STATUS(MPI_STATUS_SIZE), error
data count /3/
call mpi_init(mpi_stat)
call mpi_comm_size(mpi_comm_world, nproc, mpi_stat)
call mpi_comm_rank(mpi_comm_world, rank, mpi_stat)
n = 400*count
allocate(sendcounts(nproc), displ(nproc), &
blocklens(count), blockdisp(count), request(nproc))
if (rank.eq.0) then
allocate(Jp(n+1),JpAux(n+1))
Jp = 0
do i = 1,n+1
Jp(i) = i
enddo
endif
call mpi_barrier(mpi_comm_world, mpi_stat)
m = n/count
n_distro = (m+1)/nproc
k = 0
do i = 1,nproc
if (i<nproc) then
sendcounts(i) = n_distro
else
sendcounts(i) = m - (nproc-1)*n_distro
endif
displ(i) = k
k = k + sendcounts(i)
enddo
call mpi_barrier(mpi_comm_world, mpi_stat)
allocate(JpS(count*sendcounts(rank+1)+1))
call mpi_barrier(mpi_comm_world, mpi_stat)
! call mpi_irecv(JpS, (sendcounts(rank+1))*count+1,mpi_int,0,0,mpi_comm_world, request(rank+1), mpi_stat)
! call mpi_recv(JpS, (sendcounts(rank+1))*count+1,mpi_int,0,0,mpi_comm_world, MPI_STATUS_IGNORE,mpi_stat)
!call mpi_waitall(1,request,ARRAY_OF_STATUS,error)
! call mpi_barrier(mpi_comm_world, mpi_stat)
if (rank.eq.0) then
do i = 0,nproc-1
JpAux = -100000
blocklens = spread(sendcounts(i+1),1,count)
blockdisp = spread(displ(i+1),1,count) + (/ (k*m, k=0,count-1) /)
blocklens(count) = blocklens(count)+1
do j = 1,count
if (j.eq.1) then
JpAux(blockdisp(j)+1:blockdisp(j)+blocklens(j)) = Jp(blockdisp(j)+1:blockdisp(j)+blocklens(j))&
-Jp(blockdisp(j)+1)
else
JpAux(blockdisp(j)+1:blockdisp(j)+blocklens(j)) = Jp( blockdisp(j) + 1 : blockdisp(j) + blocklens(j) )&
-Jp( blockdisp(j)+1 ) + JpAux( blockdisp(j-1) + blocklens(j-1))&
+(Jp( blockdisp(j-1)+blocklens(j-1)+1 )-Jp( blockdisp(j-1)+blocklens(j-1)))
endif
enddo
call mpi_type_indexed(count, blocklens, blockdisp, mpi_int, newF, mpi_stat)
call mpi_type_commit(newF, mpi_stat)
call mpi_isend(JpAux, 1, newF, i, i, mpi_comm_world, request(i+1), mpi_stat)
call mpi_type_free(newF, mpi_stat)
enddo
endif
! call mpi_wait(request(rank+1), ARRAY_OF_STATUS, mpi_stat)
call mpi_barrier(mpi_comm_world, mpi_stat)
!call mpi_waitall(1,request,ARRAY_OF_STATUS,error)
call mpi_recv(JpS, (sendcounts(rank+1))*count+1,mpi_int,0,MPI_ANY_TAG,mpi_comm_world, MPI_STATUS_IGNORE,mpi_stat)
! print*, request
print*, 'rank: ', rank, ', size: ', size(JpS), ', Jp: ', JpS
call mpi_barrier(mpi_comm_world, mpi_stat)
call mpi_finalize(mpi_stat)
end program test_send
程序测试\u发送
使用mpi
隐式无
整数：：秩，nproc，mpi_stat
整数：：n，m，k，io，i，j
整数，可分配：：Jp（：），JpS（：），JpAux（：）
整数：：计数，n_发行版，newF
整数，可分配：：发送计数（：），显示（：）&
blocklens（：），blockdisp（：）&
请求（：）
整数：：数组\u的\u状态（MPI\u状态\u大小），错误
数据计数/3/
调用mpi_init（mpi_stat）
调用mpi_comm_大小（mpi_comm_world、nproc、mpi_stat）
调用mpi_comm_rank（mpi_comm_world，rank，mpi_stat）
n=400*计数
分配（发送计数（nproc），显示（nproc）&
块镜头（计数）、块显示（计数）、请求（nproc））
如果（秩eq.0），则
分配（Jp（n+1），JpAux（n+1））
Jp=0
i=1，n+1吗
Jp（i）=i
结束循环
恩迪夫
调用mpi_屏障（mpi_通信世界，mpi_统计）
m=n/计数
n_发行版=（m+1）/nproc
k=0
i=1吗，nproc
如果（请始终发布并描述您如何运行程序，特别是使用了多少MPI任务。如果您MPI isend（JpAux…）
，则在请求完成之前，不允许修改JpAux
发送缓冲区。此外，在调用MPI WAITALL（）时
，如果该行未注释，则第一个参数为1，这使得它仅等待数组中的第一个请求。