Вопрос о параллельном цикле в MPI - PullRequest
Новая
       69

Вопрос о параллельном цикле в MPI

2 голосов
/ 10 апреля 2011

эй, У меня короткий вопрос об openmpi на фортране: у меня есть такой код: 

I) definitions of vars & linear code, setting up some vars for later usage
II) a while loop which works like that in pseudocode:

nr=1
while(true)
{
  filename='result'//nr//'.bin' (nr converted to string)
  if(!file_exists(filename))
    goto 100

  // file exists... so do something with it
  // calculations, read/write...
  nr=nr+1
}
100 continue
III) some more linear code...

Теперь я хочу сделать это параллельное вычисление с openmpi. Линейный код из I) и III) должен вычисляться только один раз, а циклы while должны выполняться на нескольких процессорах ... Как лучше всего это реализовать? моя проблема в том, как работает цикл while: например, когда процессор 1 вычисляет result1.bin, как напрямую указать процессору 2 вычислить result2.bin? и как это будет работать, если есть 30 файлов, и я использую

mpirun -n 10 my_program

? как MPI «узнает», что после завершения вычисления одного файла, есть больше файлов, «ожидающих» обработки: как только один процессор завершил обработку одного файла, ЭТОТ процессор должен непосредственно начать обработку следующего файла в очереди.

Спасибо, пока!

#

EDIT:

#

Привет, это снова я ... Я тоже хотел попробовать OpenMP, поэтому я использовал кусок вашего кода, который читает существующие файлы, а затем зацикливает их (и обрабатывает их): 

nfiles = 0
do
  write(filename,FMT='(A,I0,A)'), prefix, nfiles+1, suffix
  inquire(file=trim(filename),exist=exists)
  if (not(exists)) exit
    nfiles = nfiles + 1
enddo

сейчас я попробовал следующий код: 

call omp_set_num_threads(2)
!$OMP PARALLEL
!$OMP DO 
do i=startnum, endnum
  write(filename,FMT='(A,I0,A)'), prefix, i, suffix
  ...CODE DIRECTLY HERE TO PROCESS THE FILE...
enddo
!$OMP END DO
!$OMP END PARALLEL

Но это всегда дает мне такие ошибки: «Запрещается переходить из цикла DO, связанного с директивой Open MP DO или PARALLEL DO».

Всегда о кодах с таким кодом: 

read (F_RESULT,*,ERR=1) variable

Где F_RESULT - файловый дескриптор ... Что может быть в этом плохого? переменная определена вне блока цикла, и я уже пытался установить директиву OpenMP на 

private(variable)

чтобы каждый поток имел свою собственную копию, но это не сработало! Спасибо за вашу помощь!

1 Ответ

5 голосов
/ 10 апреля 2011

Вероятно, наиболее разумный способ сделать это - один из процессов заранее подсчитать общее количество файлов, передать его, а затем попросить всех сделать "свои" файлы: 

program processfiles
    use mpi
    implicit none

    integer :: rank, comsize, ierr
    integer :: nfiles
    character(len=6) :: prefix="result"
    character(len=4) :: suffix=".bin"
    character(len=50) :: filename
    integer :: i
    integer :: locnumfiles, startnum, endnum
    logical :: exists

    call MPI_Init(ierr)
    call MPI_Comm_size(MPI_COMM_WORLD, comsize, ierr)
    call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr)

    ! rank zero finds number of files
    if (rank == 0) then
       nfiles = 0
       do
           write(filename,FMT='(A,I0,A)'), prefix, nfiles+1, suffix
           inquire(file=trim(filename),exist=exists)
           if (not(exists)) exit
           nfiles = nfiles + 1
       enddo
    endif
    ! make sure everyone knows
    call MPI_Bcast(nfiles, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)

    if (nfiles /= 0) then
        ! calculate who gets what file
        locnumfiles = nfiles/comsize
        if (locnumfiles * comsize /= nfiles) locnumfiles = locnumfiles + 1
        startnum = locnumfiles * rank + 1
        endnum = startnum + locnumfiles - 1
        if (rank == comsize-1) endnum = nfiles
        do i=startnum, endnum
           write(filename,FMT='(A,I0,A)'), prefix, i, suffix
           call processfile(rank,filename)
        enddo
    else
        if (rank == 0) then
            print *,'No files found; exiting.'
        endif
    endif
    call MPI_Finalize(ierr)

    contains
        subroutine processfile(rank,filename)
            implicit none
            integer, intent(in) :: rank
            character(len=*), intent(in) :: filename
            integer :: unitno
            open(newunit=unitno, file=trim(filename))
            print '(I4,A,A)',rank,': Processing file ', filename
            close(unitno)
        end subroutine processfile
end program processfiles

А потом простой тест: 

$ seq 1 33 | xargs -I num touch "result"num".bin"
$ mpirun -np 2 ./processfiles

   0: Processing file result1.bin                                       
   0: Processing file result2.bin                                       
   0: Processing file result3.bin                                       
   0: Processing file result4.bin                                       
   0: Processing file result5.bin                                       
   0: Processing file result6.bin                                       
   1: Processing file result18.bin                                      
   0: Processing file result7.bin                                       
   0: Processing file result8.bin                                       
   1: Processing file result19.bin                                      
   0: Processing file result9.bin                                       
   1: Processing file result20.bin                                      
   0: Processing file result10.bin                                      
   1: Processing file result21.bin                                      
   1: Processing file result22.bin                                      
   0: Processing file result11.bin                                      
   1: Processing file result23.bin                                      
   0: Processing file result12.bin                                      
   1: Processing file result24.bin                                      
   1: Processing file result25.bin                                      
   0: Processing file result13.bin                                      
   0: Processing file result14.bin                                      
   1: Processing file result26.bin                                      
   1: Processing file result27.bin                                      
   0: Processing file result15.bin                                      
   0: Processing file result16.bin                                      
   1: Processing file result28.bin                                      
   1: Processing file result29.bin                                      
   1: Processing file result30.bin                                      
   0: Processing file result17.bin                                      
   1: Processing file result31.bin                                      
   1: Processing file result32.bin                                      
   1: Processing file result33.bin

Обновлено , чтобы добавить дополнительный вопрос OpenMP:

Таким образом, в первом цикле вычисляется количество файлов до начала параллельной обработки файлов. Этот подсчет файлов должен быть выполнен до параллельной обработки файлов, поскольку в противном случае невозможно разделить работу между процессорами; вам нужно знать, сколько будет «рабочих единиц», прежде чем разбивать работу. (Это не единственный способ сделать что-то, но это самый простой способ).

Аналогично, для циклов OMP DO требуются достаточно структурированные циклы - должен быть простой цикл, подобный do i=1,n, который затем можно легко разбить между потоками. n не нужно компилировать, и приращение не обязательно должно быть единичным, но это должна быть вещь, которая может быть точно известна до того, как цикл фактически будет выполнен. Так, например, вы не можете выйти из цикла из-за какой-то внешней причины (например, отсутствия файла).

Итак, вы хотели бы сделать с OpenMP тот же подсчет файлов и оставить его в покое, но затем в цикле обработка используйте параллельную конструкцию do. Итак, после удаления содержимого MPI у вас будет что-то похожее на: 

    do
        write(filename,FMT='(A,I0,A)'), prefix, nfiles+1, suffix
        inquire(file=trim(filename),exist=exists)
        if (.not.exists) exit
        nfiles = nfiles + 1
    enddo

    if (nfiles /= 0) then
        !$OMP PARALLEL SHARED(nfiles,prefix,suffix) PRIVATE(i,thread,filename)
        thread = omp_get_thread_num()
        !$OMP DO 
        do i=1, nfiles
           write(filename,FMT='(A,I0,A)'), prefix, i, suffix
           call processfile(thread,filename)
        enddo
        !$OMP END DO
        !$OMP END PARALLEL 
    else
        print *,'No files found; exiting.'
    endif

но все остальное было бы таким же. И снова, если вы хотите обрабатывать файлы «inline» (например, не в sburoutine), вы должны поместить код обработки файлов в строку «call processfile ()».

...