MPI主/从代码在完成所有任务之前结束

时间:2019-10-21 17:00:36

标签: fortran mpi openmpi hpc

我正在尝试使用MPI并行运行串行任务。我在Sigismondo的帮助下获得了很好的帮助。但是,我遇到了一个问题。当我运行以下代码时,16个任务中只有8个最终完成,每个内核完成一个任务。我不确定为什么其中一个从属处理器完成任务后,主处理器为何不发送其他作业。我希望得到一些帮助。其他一切工作正常。

if(myid.eq.0) then
  pending_tasks = 0
  sent_tasks = 0
 open(100,file="s2p_commands.txt")
 do i=1,(numprocs-1)
    read(100,'(A)') command
    call MPI_SEND(command,200,MPI_CHAR,i,0,MPI_COMM_WORLD,ierr)
    pending_tasks = pending_tasks + 1
    sent_tasks = sent_tasks + 1
 enddo
  ! all procs have one task to work on.
 do
    ! wait for results - from any source
    call MPI_RECV(result,200,MPI_CHAR,MPI_ANY_SOURCE,0,MPI_COMM_WORLD,istatus,ierr)
    free_proc = istatus(MPI_SOURCE)
    if (sent_tasks < nlines) then
      read(100,'(A)') command
      call MPI_SEND(command,200,MPI_CHAR,free_proc,0,MPI_COMM_WORLD,ierr)
      sent_tasks = sent_tasks + 1
    else
      ! all tasks sent, but wait all the results
      pending_tasks = pending_tasks - 1
    endif
     #ifdef debug
     write(6,*) "Processor ",myid," executes: ",trim(command)
     #endif
    if (pending_tasks == 0) EXIT
 enddo
  ! in this point the master can send out the 'QUIT' command to all the slaves
else
  do
    call MPI_RECV(command,200,MPI_CHAR,0,0,MPI_COMM_WORLD,istatus,ierr)
    ! that's a suggestion for a clean exit policy - pseudocode, don't forget
    if (command=='QUIT') EXIT
    call MPI_SEND(result, 200,MPI_CHAR,0,0,MPI_COMM_WORLD,ierr)
  enddo
endif


 time2 = MPI_Wtime()
 call system (trim(command))
 time3 = MPI_Wtime()
 write(6,*) "System call on myid=",myid," took ",time3-time2," seconds"
 if(myid.eq.0)  write(6,*) "Total time was ",time3-time1," seconds" 



call MPI_FINALIZE(ierr)

0 个答案:

没有答案