fortran - 如何惯用地打破嵌套并行 (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-loop 上的迭代顺序可以是任意的，只要找到 some result(无论是否存在)只要满足“some_condition”)，就会在不同的运行之间发生变化。

Answer 1

您的顺序代码似乎具有依赖性，使其不适合并行化。假设 i 和 j 的多个值使“某个条件”为真 - 那么 i 和 j do 循环的执行顺序决定首先找到这些条件中的哪一个并设置 result 的值，然后返回语句结束对“某些条件”为真的其他情况 i,j 的搜索。在顺序代码中，do 循环始终以相同的顺序执行，因此程序的操作是确定性的，并且始终会找到使“某些条件”为真的 i 和 j 的相同值。在并发版本中，各种循环 i 以非确定性顺序执行，因此从运行到运行不同的 i 值可能是找到真正的“某些条件”的第一个 i 值。

也许作为一名程序员，您知道 i 和 j 只有一个值会导致真正的“某种条件”？在这种情况下，短路执行似乎没问题。但 OpenMP 规范表示“除了 DO 语句之外，关联循环中的任何语句都不会导致分支循环之外”，因此不允许内循环中的某些内容中止输出循环。如果总是只有一个真实的“某些条件”，则可以删除“返回”并浪费 CPU通过让线程在找到一种情况后寻找“某些条件”是否为真，这可能需要花费一些时间。这可能仍然比顺序程序更快。使用缩放器“结果”变量，它仍然可能不合规，依赖于执行顺序。您可以将其更改为“减少”，对结果求和，或将结果返回为维度 (n) 的一维数组。如果您需要找到“某些条件”为 true 的 i 的最小值，您可以使用 Fortran 内在函数 minloc 从数组结果中获取该值。

具有许多“刷新”和“关键”指令的解决方案可能不会比顺序版本更快。

更新:基于多个结果是可能的并且任何结果都可以的澄清，一种并行方法是返回多个结果并让顺序代码挑选一个 - 将“结果”变成一维数组而不是缩放器。您可以短路内部 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