Как вырваться из вложенного параллельного (OpenMP) цикла Fortran идиоматически?
вот:
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
найдено (не имеет значения, изменяется ли он с run на run до тех пор, пока он удовлетворяет "some_condition"
).
3 ответов
Кажется, что ваш последовательный код имеет зависимость, которая делает его непригодным для параллельного выполнения. Предположим, что существует несколько значений i & j, которые делают" некоторое условие " истинным - тогда порядок выполнения циклов i & j do определяет, какое из этих условий найдено первым и задает значение результата, после чего оператор return завершает поиск дополнительных случаев i,j, что "некоторое условие" истинно. В последовательном коде циклы do всегда выполняются одинаково порядок, поэтому работа программы детерминирована и одинаковые значения i & j, которые делают" некоторое условие " истинным, всегда будут найдены. В параллельной версии различные циклы я выполняю в недетерминированном порядке, так что от запуска до запуска разных значений i может быть первым i-значением, которое находит истинное "некоторое условие".
возможно, вы как программист знаете, что существует только одно значение i & j, которое приводит к истинному "некоторому условию"? В этом случае короткое замыкание выполнение, казалось бы, ОК. Но спецификация OpenMP говорит, что " ни один оператор в связанных циклах, кроме операторов DO, не может вызвать ветвь из циклов", поэтому что - то во внутреннем цикле прерывает выходной цикл, не допускается. Если это так, что всегда есть только одно истинное "некоторое условие", вы можете просто удалить" возврат "и тратить время процессора, заставляя потоки искать" некоторое условие " истинно после того, как один случай был найден. Что еще может быть быстрее, чем последовательная программа. С переменной scaler "result" она по-прежнему, вероятно, несовместима, имея зависимость от порядка выполнения. Вы можете изменить его на "уменьшение", суммируя результат или возвращая результат как 1-D массив измерения (n). Если вам нужно найти наименьшее значение i, которое имеет "некоторое условие" true, вы можете получить это из результата массива, используя функцию Fortran instrinsic minloc.
решение со многими директивами" flush "и" critical " может не быть быстрее, чем последовательная версия.
обновление: основываясь на разъяснении, что возможны несколько результатов и что любой будет делать, один параллельный метод будет возвращать результаты mutiple и позволять последовательному коду выбрать один из них-сделать "результат" в массив 1D, а не масштабирование. Вам разрешено короткое замыкание внутреннего j-контура, потому что он не "связан" с директивой "omp do", поэтому "результат" должен быть только 1D, размеренный в соответствии с диапазоном i. Так что ... что-то вроде этого:--2-->
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
другой подход полностью состоял бы в использовании конструкции задачи, которая является частью OpenMP 3.0. То, что вы, похоже, пытаетесь сделать, это разделить свои петли на потоки, вычислить, пока любой поток не найдет ответ, а затем остановить все потоки. Проблема в том, что необходимость проверки всех потоков общим флагом (a) убивает вашу производительность и (b) приводит вас к уродливым циклам с перерывами и циклами.
Я думаю, что ответ @M. S. B. дает очень хороший совет о том, как адаптировать существующий подход. Но, возможно, более естественным способом решения проблемы было бы создание программой ряда задач (возможно, по одной для каждой итерации вашего внутреннего цикла) и отправка их в рабочие потоки. После того, как любой поток сообщает об успехе, все потоки могут быть отправлены задача завершения, и ваша программа может продолжить.
Это, конечно, потребует больше переписывания вашей программы и, вероятно, сделает последовательное выполнение хуже. Это, безусловно, требует, чтобы реализация OpenMP поддерживает v3.0 стандарта.
и вам может понадобиться больше помощи в этой области, чем я могу управлять, я только начал играть с задачами OpenMP сам.
кажется $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
by exit
, представленного results
массив на основе @М. С. Б.!--14-->.
если решение существует этот подход быстрее, чем $OMP DO
из-за более раннего выхода.
дайте каждому потоку одну итерацию за раз для обработки
используя директиву задачи (предложенную @Высокая Производительность 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.