9

这是顺序代码：

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"）。

4

3 回答 3

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

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

于 2010-06-05T09:59:16.100 回答
1

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

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

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

更新： 基于对多个结果是可能的并且任何结果都可以的澄清，一种并行方法是返回多个结果并让顺序代码从中挑选一个——将“结果”放入一维数组而不是缩放器。您可以将内部 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
于 2010-06-05T17:09:40.987 回答
1

另一种方法完全是使用作为 OpenMP 3.0 一部分的 TASK 构造。您似乎想要做的是在线程之间划分循环，计算直到任何线程找到答案，然后让所有线程停止。麻烦的是，让所有线程检查共享标志的必要性是（a）杀死你的性能和（b）让你进入带有 BREAKS 和 CYCLES 的丑陋循环。

我认为@MSB 的回答就如何调整现有方法提供了很好的建议。但是，解决问题的一种更自然的方法可能是让程序创建许多任务（可能为最内层循环的每次迭代创建一个）并将它们分派给工作线程。一旦任何线程报告成功，所有线程都可以发送完成任务，您的程序可以继续。

当然，这需要对程序进行更多的重写，并且可能会使顺序执行变得更糟。它肯定需要您的 OpenMP 实现支持标准的 v3.0。

在这方面，您可能需要比我能管理的更多的帮助，我自己才刚刚开始使用 OpenMP TASKS。

于 2010-06-06T09:14:41.080 回答