如何以惯用的方式打破嵌套并行(OpenMP)Fortran循环？

Question

这是顺序代码:

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").

Answer 1

似乎$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为，根据@MSB 的答案exit引入数组。results

$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

在我的测试中，这个变体比带有 -loop 的版本快 2 倍outer。