Question

我有一个MPI并行化的代码，它循环遍历n个人，每个人调用一些子程序进行一些计算，然后在循环内部调用一个后处理子程序。

在后处理子程序中，我按以下方式编写我想要的输出：

person_number var1 var2

让我们说每个人都属于不同的级别。问题是当我为person1编写文件时，可能包含rank3变量的person3进程正在执行后处理子例程，因此它会覆盖我的person1数据。

我想要的是找到一种方法，在调用后处理子程序之前暂停其他进程，然后在前一个等级不使用该子程序之后，将其运行到下一个等级，依此类推。

这是代码草图：

call MPI_Init(ierr)

do i = 1, npersons

call subroutine1(arg1,arg2,arg3)

! call it only if post_process not executed by other process
! otherwise wait until it ends and then call it 
call post_process(i, var1, var2)

enddo

call MPI_Finalize(ierr)


subroutine post_process(i, var1, var2)
integer:: i
real*8:: var1, var2
write(111,*) i, var1, var2
end subroutine post_process

Answer 1

阅读你的评论：“另外，我想知道例如过程3是否比过程2更快，如果我可以使用相同的方式但很快排名1完成与例程通知等级3运行例程然后等级3通知等级2.有没有任何自动方式？知道哪个等级在后处理步骤之前等待更长时间？“

这可以通过使用缓冲发送使用irank == 0 和进行所有I / O来准确解决。

在这种情况下，您不希望让进程等待，此处没有障碍，但您希望让它们在准备好后立即发送结果，然后继续计算。当进程0的时候，它将接收所有缓冲的数据并写入它们，然后写入自己的数据。您可以尝试使用标准MPI_SEND（它缓冲到前缀大小），但最好的方法是使用MPI_BSEND并使用MPI_BUFFER_ATTACH()附加正确大小的缓冲区。像这样：

subroutine post_process(i, var1, var2, irank)
integer:: i, irank
real*8:: var1, var2
integer:: ir
real*8:: var1r, var2r
character buffer(100)
integer ipos
boolean flag

if (irank .gt. 0) then
  ipos = 0
  call MPI_PACK(i, 1, MPI_INTEGER, buffer, 100, ipos, MPI_COMM_WORLD, ierr)
  call MPI_PACK(var1, 1, MPI_REAL8, buffer, 100, ipos, MPI_COMM_WORLD, ierr)
  call MPI_PACK(var2, 1, MPI_REAL8, buffer, 100, ipos, MPI_COMM_WORLD, ierr)
  call MPI_BSend( buffer, ipos, MPI_PACKED, 0, 0, MPI_COMM_WORLD, ierr) 
else
  do
    call MPI_IPROBE(MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, flag, MPI_STATUS_IGNORE, ierr)
    if (flag .eq. false) exit
    call MPI_RECV(buffer, 100, MPI_PACKED, MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
    ipos = 0
    call MPI_UNPACK(buffer, 100, ipos, ir, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
    call MPI_UNPACK(buffer, 100, ipos, var1r, 1, MPI_REAL8, MPI_COMM_WORLD, ierr)
    call MPI_UNPACK(buffer, 100, ipos, var2r, 1, MPI_REAL8, MPI_COMM_WORLD, ierr)
    write(111,*) ir, var1r, var2r      
  enddo
  write(111,*) i, var1, var2
end if
end subroutine post_process

Answer 2

我将执行此任务序列化障碍。假设您irank的{{1}}和MPI_COMM_RANK() nprocs的结果为MPI_COMM_SIZE()：

call MPI_Init(ierr)

do i = 1, npersons
call subroutine1(arg1,arg2,arg3)

do ir = 0, nprocs-1
if (ir .eq. irank) then 
  ! call it only if post_process not executed by other process
  ! otherwise wait until it ends and then call it 
  call post_process(i, var1, var2)
endif
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
enddo

enddo

所有流程都在MPI_BARRIER()等待，直到 irank-th 完成，并且也会到达障碍。

我不得不说，由于所有进程都在post_process中的共享文件系统上写入，因此无法保证工作：MPI级别的同步通常非常快（不是针对此进行了MPI优化？），并且可以比共享文件系统（即NFS，GPFS，...）中存在的同步更快，特别是在大型集群上。此外，使用普通的fortran执行写入共享文件...确保您可以随机引发文件损坏，因为不同主机上的缓存和计时。

接近它的典型方法是只让irank == 0的处理器写入文件，所有其他处理器发送数据写入它。更好，使用MPI2 I / O.

Answer 3

首先，通过添加以下行来正确初始化MPI环境：

! Initialization of MPI
call MPI_INIT(ierr) 
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, numproc,ierr)

函数MPI_COMM_RANK将返回变量rank，它是每个进程的标识符（即您示例中的每个person）。您可以使用此变量来定义进程执行程序的顺序。此外，由于MPI程序中的代码由所有进程执行，除非您另有说明，否则您不需要do循环来调用您的第一个子例程。

您可以使用MPI_RECV调用来阻止每个进程执行程序，直到收到消息为止。诀窍是使用变量rank来表示每个进程的数量（在你的例子中，它似乎是从1到n的数字 - 要小心，排名可能从0开始）。告诉您的进程暂停并等待消息，但第一个进程除外，该进程允许执行后处理子例程。一旦进程1完成写入，就告诉它向进程2发送消息。一旦进程2收到消息，它就会开始执行子程序（现在可以安全执行，因为1已完成）并发送消息处理3，依此类推。

您可以尝试实现以下内容：

integer:: tag
character(1):: mess

call subroutine1(arg1,arg2,arg3)  

tag=22    ! or any integer you like
mess='a'  ! The content here doesn't matter

if(rank .gt. 1) call MPI_RECV(mess,1,MPI_CHARACTER,rank-1,tag,MPI_COMM_WORLD,stat,ierr)

do k = 1,npersons
  if (rank .eq. k) then
    call post_process(var1, var2)
    if(rank .lt. npersons) then
      call MPI_SEND(mess,1,MPI_CHARACTER,rank+1,tag,MPI_COMM_WORLD,ierr)
    end if
  end if
end do

等到其他进程不使用子例程

3 个答案: