Question

PROGRAM ShareNeighbors
IMPLICIT REAL (a-h,o-z)
INCLUDE "mpif.h"
PARAMETER (m = 500, n = 500)
DIMENSION a(m,n), b(m,n)
DIMENSION h(m,n)
INTEGER istatus(MPI_STATUS_SIZE)
INTEGER iprocs, jprocs 
PARAMETER (ROOT = 0) 
integer dims(2),coords(2)
logical   periods(2)
data periods/2*.false./
integer status(MPI_STATUS_SIZE)
integer comm2d,req,source

CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nprocs, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, myrank, ierr)
! Get a new communicator for a decomposition of the domain.  
! Let MPI find a "good" decomposition
dims(1) = 0
dims(2) = 0
CALL MPI_DIMS_CREATE(nprocs,2,dims,ierr)
if (myrank.EQ.Root) then
   print *,nprocs,'processors have been arranged into',dims(1),'X',dims(2),'grid'
endif
CALL MPI_CART_CREATE(MPI_COMM_WORLD,2,dims,periods,.true., &
                  comm2d,ierr)
!   Get my position in this communicator
CALL MPI_COMM_RANK(comm2d,myrank,ierr)
! Get the decomposition
CALL fnd2ddecomp(comm2d,m,n,ista,iend,jsta,jend)
! print *,ista,jsta,iend,jend
ilen = iend - ista + 1
jlen = jend - jsta + 1

CALL MPI_Cart_get(comm2d,2,dims,periods,coords,ierr)
iprocs = dims(1)
jprocs = dims(2)
myranki = coords(1)
myrankj = coords(2)

DO j = jsta, jend
    DO i = ista, iend
    a(i,j) = myrank+1
    ENDDO
ENDDO
! Send data from each processor to Root
call MPI_ISEND(ista,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(iend,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(jsta,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(jend,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(a(ista:iend,jsta:jend),(ilen)*(jlen),MPI_REAL, &
                  Root,1,MPI_COMM_WORLD,req,ierr )
!    Recieved the results from othe precessors   
if (myrank.EQ.Root) then
    do source = 0,nprocs-1
       call MPI_RECV(ista,1,MPI_INTEGER,source,   &
                     1,MPI_COMM_WORLD,status,ierr )
       call MPI_RECV(iend,1,MPI_INTEGER,source,   &
                     1,MPI_COMM_WORLD,status,ierr )
       call MPI_RECV(jsta,1,MPI_INTEGER,source,   &
                     1,MPI_COMM_WORLD,status,ierr )
       call MPI_RECV(jend,1,MPI_INTEGER,source,   &
                    1,MPI_COMM_WORLD,status,ierr )      
        ilen = iend - ista + 1
        jlen = jend - jsta + 1                          
       call MPI_RECV(a(ista:iend,jsta:jend),(ilen)*(jlen),MPI_REAL,   &
                    source,1,MPI_COMM_WORLD,status,ierr)
! print the results
       call ZMINMAX(m,n,ista,iend,jsta,jend,a(:,:),amin,amax)
       print *, 'myid=',source,amin,amax
        call MPI_Wait(req, status, ierr) 
   enddo    
endif

CALL MPI_FINALIZE(ierr)
END

subroutine fnd2ddecomp(comm2d,m,n,ista,iend,jsta,jend)
integer   comm2d
integer   m,n,ista,jsta,iend,jend
integer   dims(2),coords(2),ierr
logical   periods(2)
! Get (i,j) position of a processor from Cartesian topology.
CALL MPI_Cart_get(comm2d,2,dims,periods,coords,ierr)
! Decomposition in first (ie. X) direction
CALL MPE_DECOMP1D(m,dims(1),coords(1),ista,iend)
! Decomposition in second (ie. Y) direction
CALL MPE_DECOMP1D(n,dims(2),coords(2),jsta,jend)

return
end
SUBROUTINE MPE_DECOMP1D(n,numprocs,myid,s,e)
integer n,numprocs,myid,s,e,nlocal,deficit
nlocal  = n / numprocs
s       = myid * nlocal + 1
deficit = mod(n,numprocs)
s       = s + min(myid,deficit)
! Give one more slice to processors
if (myid .lt. deficit) then
    nlocal = nlocal + 1
endif
e = s + nlocal - 1
if (e .gt. n .or. myid .eq. numprocs-1) e = n

return
end
SUBROUTINE ZMINMAX(IX,JX,SX,EX,SY,EY,ZX,ZXMIN,ZXMAX)

INTEGER :: IX,JX,SX,EX,SY,EY
REAL :: ZX(IX,JX)
REAL :: ZXMIN,ZXMAX

ZXMIN=1000.
ZXMAX=-1000.
DO II=SX,EX
   DO JJ=SY,EY  
      IF(ZX(II,JJ).LT.ZXMIN)ZXMIN=ZX(II,JJ)
      IF(ZX(II,JJ).GT.ZXMAX)ZXMAX=ZX(II,JJ)
   ENDDO
ENDDO   

RETURN
END

当我用4个处理器运行上面的代码时，Root接收垃圾值。对于15个处理器，数据传输是正确的。我该怎么解决这个问题？我想这是相关缓冲区，这一点对我来说并不清楚。我该如何明智地处理缓冲区？

Answer 1

<强> 1。问题

您正在进行多次发送

call MPI_ISEND(ista,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(iend,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(jsta,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(jend,1,MPI_INTEGER,Root,1,  &
                  MPI_COMM_WORLD,req,ierr)
call MPI_ISEND(a(ista:iend,jsta:jend),(ilen)*(jlen),MPI_REAL, &
                  Root,1,MPI_COMM_WORLD,req,ierr )

并且所有这些都具有相同的请求变量req。那不行。

<强> 2。问题

您在非阻塞MPI中使用子阵列a(ista:iend,jsta:jend)。这是不允许*。您需要将数组复制到某个临时数组缓冲区或使用MPI派生的子数组数据类型（在此阶段对您来说太难了）。

问题的原因是编译器只为ISend的调用创建一个临时副本。 ISend会记住地址，但不会发送任何内容。然后临时删除，地址变为无效。然后MPI_Wait将尝试使用该地址并将失败。

第3。问题

您的MPI_Wait位置错误。它必须在发出任何if条件之后才能始终执行（如果你总是发送）。

您必须单独收集所有请求，而不是等待所有请求。最好将它们放在一个数组中，并使用MPI_Waitall一次等待所有这些。

记住，如果缓冲区很大，ISend通常不会发送任何内容。交换经常发生在Wait操作期间。至少对于较大的阵列。

<强>建议：

采取一个简单的问题示例，并尝试在两个进程之间仅使用MPI_IRecv和MPI_ISend交换两个小数组。作为简单的测试问题，你可以做到。从中学习，做简单的步骤。不要冒犯，但是你目前对非阻塞MPI的理解太弱，无法编写全面的程序。 MPI很难，非阻塞MPI更难。
使用MPI-2中提供的界面时不允许使用
*。 MPI-3在可能的情况下使用use mpi_f08带来了新的界面。但首先要学习基础知识。

Fortran中的MPI给出了垃圾值

1 个答案: