Код MPI master / slave заканчивается перед завершением всех задач - PullRequest
0 голосов
/ 21 октября 2019

Я пытаюсь запускать последовательные задачи параллельно, используя MPI. Я получил очень хорошую помощь от Сигизмондо в этом. Однако я столкнулся с проблемой. Когда я запускаю следующий код, только 8 из 16 задач завершаются, по одной на каждое ядро. Я не уверен, почему главный процессор не отправляет другую работу после того, как один из подчиненных процессоров завершает задачу. Я надеялся получить помощь. Все остальное работает отлично, хотя.

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)
...