Я пытаюсь запускать последовательные задачи параллельно, используя 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)