Как идиоматически вырваться из вложенного параллельного (OpenMP) цикла Фортрана? - PullRequest
8 голосов
/ 05 июня 2010

Вот последовательный код:

do i = 1, n
   do j = i+1, n
      if ("some_condition(i,j)") then
         result = "here's result"
         return
      end if
   end do
end do

Есть ли более чистый способ выполнения итераций внешнего цикла одновременно, кроме:

  !$OMP PARALLEL private(i,j)
  !$OMP DO 
  do i = 1, n     
     !$OMP FLUSH(found)
     if (found) goto 10
     do j = i+1, n        
        if ("some_condition(i,j)") then
           !$OMP CRITICAL
           !$OMP FLUSH(found)
           if (.not.found) then           
              found = .true.
              result = "here's result"
           end if
           !$OMP FLUSH(found)
           !$OMP END CRITICAL
           goto 10
        end if
     end do
10   continue
  end do
  !$OMP END DO NOWAIT
  !$OMP END PARALLEL

Порядок итераций по i -циклу может быть произвольным, если найден некоторый result (не имеет значения, меняется ли он с запуска на запуск, если он удовлетворяет "some_condition").

Ответы [ 3 ]

1 голос
/ 05 июня 2010

Кажется, что у вашего последовательного кода есть зависимость, которая делает его непригодным для параллельного выполнения. Предположим, что есть несколько значений i & j, которые делают «некоторое условие» истинным - тогда порядок выполнения циклов i & j do определяет, какое из этих условий будет найдено первым, и устанавливает значение результата, после которого возвращается Утверждение завершает поиск дополнительных случаев i, j, что «некоторое условие» является истинным. В последовательном коде циклы do всегда выполняются в одном и том же порядке, поэтому работа программы является детерминированной, и всегда будут обнаруживаться идентичные значения i & j, которые делают истинным «некоторое условие». В параллельной версии различные циклы я выполняю в недетерминированном порядке, так что от запуска к запуску различные значения i могут быть первым i-значением, которое находит истинное «некоторое условие».

Возможно, вы, как программист, знаете, что существует только одно значение i & j, которое приводит к истинному «некоторому условию»? В этом случае короткое замыкание казалось бы нормальным. Но спецификация OpenMP гласит: «Никакой оператор в связанных циклах, кроме операторов DO, не может вызвать переход из циклов ", поэтому прерывание вывода во внутреннем цикле не допускается. Выходной цикл не допускается. Если это так, что всегда есть только одно истинное" некое условие ", вы можете просто удалить" возврат "и потерять ЦП время, когда потоки ищут «какое-то условие», истинно после того, как был найден один случай. Это может все же быть быстрее, чем последовательная программа. С переменной «result» масштабатора она все еще, вероятно, несовместима, имея зависимость от порядок выполнения. Вы можете изменить его на «уменьшение», суммирование результата или вернуть результат в виде 1-D массива измерения (n). Если вам нужно найти наименьшее значение i, которое имеет «некоторое условие» true Вы можете получить это из результата массива, используя встроенную функцию Fortran minloc.

Решение со многими директивами "сбросить" и "критично" не может быть быстрее, чем последовательная версия.

ОБНОВЛЕНИЕ: Основываясь на разъяснении, что возможны несколько результатов и что любой подойдет, один параллельный метод будет состоять в том, чтобы возвращать множественные результаты и позволять последовательному коду выбирать один - превращать «результат» в 1D массив, а не скалер. Вам разрешено закорачивать внутренний j-цикл, потому что он не «связан» с директивой «omp do», поэтому «результат» должен быть только 1D с размерами в соответствии с диапазоном i. Итак, как-то так:

program test1

integer :: i, j
integer, parameter :: n = 10
integer, dimension (n) :: result

result = -999

!omp parallel default (shared) private (i, j)
!omp do
do i = 1, n
   inner: do j = i+1, n
      if ( mod (i+j,14) == 0 ) then
         result (i) = i
         exit inner
      end if
   end do inner
end do
!omp end do
!omp end parallel

write (*, *) 'All results'
write (*, *) result

write (*, *)
write (*, *) 'One result'
write (*, *) result ( maxloc (result, 1) )

end program test1
1 голос
/ 06 июня 2010

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

Я думаю, что ответ @ MSB дает очень хороший совет покак адаптировать ваш существующий подход.Но, возможно, более естественным способом решения этой проблемы было бы создание программой ряда задач (возможно, по одной на каждую итерацию вашего внутреннего цикла) и их распределение на рабочие потоки.Как только какой-либо поток сообщает об успешном выполнении, все потоки могут быть отправлены для выполнения задачи завершения, и ваша программа может продолжить.

Это, конечно, потребует большего переписывания вашей программы и, вероятно, ухудшит последовательное выполнение.Это определенно потребует, чтобы ваша реализация OpenMP поддерживала стандарт v3.0.

И вам может понадобиться больше помощи в этой области, чем я могу справиться, я только начал играть с OpenMP TASKS сам.

1 голос
/ 05 июня 2010

Кажется, $OMP DO не позволяет раньше выйти из цикла. Альтернативой может быть реализация этого вручную.

Дайте каждому потоку фиксированный непрерывный диапазон индексов для обработки

После Руководство по OpenMP: Простое многопоточное программирование для C ++ :

  results = "invalid_value"

  !$OMP PARALLEL private(i,j,thread_num,num_threads,start,end)

  thread_num = OMP_GET_THREAD_NUM()
  num_threads = OMP_GET_NUM_THREADS()
  start = thread_num * n / num_threads + 1
  end = (thread_num + 1) * n / num_threads

  outer: do i = start, end
     !$OMP FLUSH(found)             
     if (found) exit outer
     do j = i+1, n
        if ("some_condition") then
           found = .true.
           !$OMP FLUSH(found)
           results(thread_num+1) = "here's result"
           exit outer
        end if
     end do
  end do outer

  !$OMP END PARALLEL

  ! extract `result` from `results` if any
  do i = 1, size(results)
     if (results(i).ne."invalid_value") result = results(i)
  end do

ОБНОВЛЕНИЕ : заменено goto на exit, введен массив results на основе @ M. Ответ С. Б. .

Если решение существует, этот подход быстрее, чем $OMP DO из-за более раннего выхода.

Дайте каждому потоку одну итерацию за раз для обработки

Использование директивы задачи (рекомендуется @ High Performance Mark ):

  !$OMP PARALLEL
  !$OMP SINGLE
  !$OMP TASK UNTIED
          ! "untied" allows other threads to generate tasks
  do i = 1, n ! i is private
     !$OMP TASK ! implied "flush"
     task:     do j = i+1, n ! i is firstprivate, j is private       
        if (found) exit task
        if ("some_condition(i,j)") then
           !$OMP CRITICAL
           result = "here's result" ! result is shared              
           found = .true.           ! found is shared
           !$OMP END CRITICAL ! implied "flush"
           exit task
        end if
     end do task
     !$OMP END TASK 
  end do 
  !$OMP END TASK
  !$OMP END SINGLE
  !$OMP END PARALLEL

Этот вариант в моих тестах в 2 раза быстрее, чем версия с outer -loop.

...