Как убежать из вложенной параллели (OpenMP) цикл Фортрана идиоматически?
Вот последовательный код:
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 ответа
Похоже, что $OMP DO не позволяет выйти из цикла раньше. Альтернативой может быть реализация этого вручную.
Дать каждому потоку фиксированный непрерывный диапазон индексов для обработки
Следуя Guide into OpenMP: Easy multithreading programming for 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
UPDATE: заменил goto на exit, ввел массив results на основе @M. S. B.'s answer.
Если решение существует, то этот подход быстрее, чем $OMP DO из-за более раннего выхода.
Дайте каждому потоку по одной итерации для обработки
Используя директиву task (предложенную @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.
Другим подходом может быть использование конструкции TASK, которая является частью OpenMP 3.0. Похоже, вы пытаетесь разделить циклы по потокам, вычислять, пока любой поток не найдет ответ, затем все потоки останавливаются. Проблема в том, что необходимость проверки всеми потоками общего флага (а) убивает вашу производительность и (б) приводит вас к уродливым циклам с BREAKS и CYCLES.
Я думаю, что ответ @M.S.B. дает очень хороший совет о том, как адаптировать существующий подход. Но, возможно, более естественным способом решения проблемы было бы создание программой ряда задач (возможно, по одной на каждую итерацию вашего внутреннего цикла) и рассылка их рабочим потокам. Как только какой-либо поток сообщит об успехе, всем потокам можно будет послать задачу финализации, и ваша программа сможет продолжить работу.
Это, конечно, потребует переписывания вашей программы и, вероятно, ухудшит последовательное выполнение. Это определенно потребует, чтобы ваша реализация OpenMP поддерживала v3.0 стандарта.
И вам может понадобиться больше помощи в этой области, чем я могу оказать, я сам только начал играть с OpenMP TASKS.
Похоже, что ваш последовательный код имеет зависимость, которая делает его непригодным для параллельного выполнения. Предположим, что существует несколько значений i и j, которые делают "некоторое условие" истинным - тогда порядок выполнения циклов i и j do определяет, какое из этих условий найдено первым и устанавливает значение результата, после чего оператор return завершает поиск дополнительных случаев i,j, когда "некоторое условие" истинно. В последовательном коде циклы do всегда выполняются в одном и том же порядке, поэтому работа программы детерминирована, и всегда будут найдены одинаковые значения i & j, которые делают "некоторое условие" истинным. В параллельной версии различные циклы i выполняются в недетерминированном порядке, так что от запуска к запуску различные значения i могут быть первым значением i, которое находит истинное "некоторое условие".
Возможно, вы как программист знаете, что существует только одно значение i & j, которое приводит к истинному "некоторому условию"? В этом случае короткое замыкание выполнения будет выглядеть нормально. Но в спецификации OpenMP говорится, что "Ни один оператор в связанных циклах, кроме операторов DO, не может вызвать ответвление из циклов", так что если что-то во внутреннем цикле прервет выходной цикл, это не разрешено. Если дело обстоит так, что всегда существует только одно истинное "некоторое условие", вы можете просто удалить "return" и тратить процессорное время, заставляя потоки искать "некоторое условие" истинным после того, как найден единственный случай. Это все равно может быть быстрее, чем последовательная программа. Переменная "результат" с масштабированием, вероятно, все еще не соответствует требованиям, имея зависимость от порядка выполнения. Вы можете изменить ее на "уменьшающую", суммирующую результат, или вернуть результат в виде одномерного массива размерности (n). Если вам нужно найти наименьшее значение i, при котором "некоторое условие" истинно, вы можете получить его из результата массива, используя встроенную в Фортран функцию minloc.
Решение с большим количеством директив "flush" и "critical" может оказаться не быстрее последовательной версии.
UPDATE: Исходя из уточнения, что несколько результатов возможны и что подойдет любой, одним из параллельных методов было бы возвращать несколько результатов и позволять последовательному коду выбирать один из них - превратить "результат" в одномерный массив, а не в скалер. Вам разрешено замыкать внутренний j-петлю, потому что она не "связана" с директивой "omp do", поэтому "результат" должен быть только одномерным, с размерами в соответствии с диапазоном 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