Question

我有一个fortran代码，由于一些$ OMP CRITICAL区域而显示出一些非常令人不满意的性能。这个问题实际上更多的是关于如何避免关键区域以及是否可以删除这些区域？在那些关键区域，我正在更新计数器和读/写值到数组

    i=0
    j=MAX/2
    total = 0

    !$OMP PARALLEL PRIVATE(x,N)

    MAIN_LOOP:do
    $OMP CRITICAL
        total = total + 1
        x = array(i)
        i = i + 1
        if ( i > MAX) i=1 ! if the counter is past the end start form the beginning 
    $OMP END CRITICAL
        if (total > MAX_TOTAL) exit

    ! do some calculations here and get the value of the integer (N)
    ! store (N) copies of x it back in the original array with some offset

    !$OMP CRITICAL
    do p=1,N
    array(j)=x
    j=j+1
    if (j>MAX) j=1
    end do
    !$OMP END CRITICAL

 end do MAIN_LOOP
 $OMP END PARALLEL

我想到的一件简单的事情就是通过使用显式动态循环调度消除total上的计数器。

!$OMP PARALLEL DO SCHEDULE(DYNAMIC) 
MAIN_LOOP:do total = 1,MAX_TOTAL
  ! do the calculation here
end do MAIN_LOOP
!$OMP END PARALLEL DO

我还在考虑为每个线程分配array的不同部分，并使用线程ID进行抵消。这次每个处理器都有自己的计数器，它将存储在一个数组count_i(ID)中，并且还有类似的东西

!this time the size if array is NUM_OMP_THREADS*MAX
   x=array(ID + sum(count_i)) ! get the offset by summing up all values
   ID=omp_get_thread_num()
   count_i(ID)=count_i(ID)+1
if (count_i(ID) > MAX) count_i(ID) = 1

然而，这将使订单混乱并且不会与原始方法相同。此外，将存在一些空白空间，因为不同的线程将无法适应整个范围1:MAX

感谢您的帮助和想法。

Answer 1

你对关键部分的使用在这里有点奇怪。使用关键部分的动机必须是避免在可以读取之前使数组中的条目被破坏。您的代码确实可以完成此任务，但只是意外地通过充当障碍。尝试用OMP障碍替换关键的东西，你仍然应该得到正确的结果和相同的可怕速度。

由于您始终将数据的一半长度写入远离您写入数据的位置，因此可以通过将操作划分为从上半部分读取并写入后半部分的一个步骤来避免关键部分，反之亦然。（编辑：问题编辑完成后，这已不再适用，因此下面的方法无法正常工作）。

nhalf = size(array)/2
!$omp parallel do
do i = 1, nhalf
    array(i+nhalf) = f(array(i))
end do
!$omp parallel do
do i = 1, nhalf
    array(i) = f(array(i+nhalf))
end do

此处f(x)表示您要对数组值执行的任何计算。如果你不想要它，它不一定是一个功能。如果不清除，则此代码首先并行循环遍历数组前半部分中的条目。第一个任务可以通过i = 1,1 + nproc，1 + 2 * nproc等，而第二个任务通过i = 2,2 + nproc，2 + 2 * nproc，依此类推。这可以在没有任何锁定的情况下并行完成，因为在此循环中读取和写入的数组部分之间没有重叠。第二个循环仅在每个任务完成第一个循环后才开始，因此循环之间没有任何破坏。

与您的代码不同，每个线程有一个i，因此不需要锁定来更新它（循环变量自动为私有）。

这假设您只想通过数组进行一次传递。否则你可以循环遍历这两个循环：

do iouter = 1, (max_total+size(array)-1)/size(array)
    nleft = max_total-(iouter-1)*size(array)
    nhalf = size(array)/2
    !$omp parallel do
    do i = 1, min(nhalf,nleft)
        array(i+nhalf) = f(array(i))
    end do
    !$omp parallel do
    do i = 1, min(nhalf,nleft-nhalf)
        array(i) = f(array(i+nhalf))
    end do
end do

编辑：您的新示例令人困惑。我不确定它应该做什么。根据{{1}}的值，数组值可能会在使用之前被破坏。这是故意的吗？如果您不清楚自己在尝试做什么，那么很难回答您的问题。：/

Answer 2

我想了一会儿，我的感觉是这个具体问题没有好的答案。

实际上，乍一看，你的代码看起来像是一个很好的解决问题的方法（虽然我个人认为问题本身有点奇怪）。但是，您的实施存在问题：

如果出于某种原因，其中一个线程在处理迭代时会延迟，会发生什么？试想一下，拥有非常第一个索引的线程需要一段时间来处理它（延迟了某些第三方进程阻塞并将CPU时间放在线程固定/调度的核心上，例如）并且是最后完成...然后它将以与顺序算法完成不同的顺序将其值设置为array。你能在算法中接受这个吗？
即使没有这种＆＃34;极端＆＃34;延迟，您是否可以接受i索引在线程之间分配的顺序与j索引随后更新的顺序不同？如果拥有i+1的帖子在拥有i的帖子之前完成，它将使用索引j而不是索引j+n，因为它应该拥有...

同样，我不确定我是否理解算法的所有细微之处以及错过迭代排序的弹性，但如果排序是重要的，那么这种方法是错误的。在这种情况下，我想正确的并行化可能是这样的（放入子程序使其可编译）：

subroutine loop(array, maxi, max_iteration)
    implicit none
    integer, intent(in) :: maxi, max_iteration
    real, intent(inout) :: array(maxi)
    real :: x
    integer :: iteration, i, j, n, p

    i = 0
    j = maxi/2
    !$omp parallel do ordered private(x, n, p) schedule(static,1)
    do iteration = 1,max_iteration
        !$omp ordered
        x = array(wrap_around(i, maxi))
        !$omp end ordered

        ! do some calculations here and get the value of the integer (n)

        !$omp ordered
        do p = 1,n
           array(wrap_around(j, maxi)) = x
        end do
        !$omp end ordered
    end do
    !$omp end parallel do 
contains
    integer function wrap_around(i, maxi)
        implicit none
        integer, intent(in)    :: maxi
        integer, intent(inout) :: i

        i = i+1
        if (i > maxi) i = 1
        wrap_around = i
    end function wrap_around
end subroutine loop

我希望这会奏效。但是，除非检索到n的循环的中心部分进行了一些严格的计算，否则这不会比顺序版本更快。

是否可以删除以下内容！$ OMP关键区域

2 个答案: