Parallel processing 是否可以删除以下内容$OMP临界区

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

    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 

我还考虑将

数组的不同部分分配给每个线程，并使用线程
ID
进行偏移。这一次，每个处理器都有自己的计数器，这些计数器将存储在数组
count\u 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

我将感谢你的帮助和想法
 您对关键部分的使用在这里有点奇怪。使用临界区的动机必须是避免数组中的条目在读取之前被破坏。您的代码确实通过充当屏障来实现这一点，但这只是偶然的。尝试用OMP屏障替换关键的东西，你仍然应该得到正确的结果和同样可怕的速度

由于总是在距离写入位置有一半长度的地方写入数组，因此可以通过将操作分为一个步骤来避免关键部分，该步骤从前半部分读取，然后写入后半部分，反之亦然。（编辑：编辑问题后，这不再正确，因此下面的方法将不起作用）

这里
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

编辑：您的新示例令人困惑。我不知道它应该做什么。根据
N
的值，数组值可能会在使用前被删除。这是故意的吗？当你不清楚自己想做什么时，很难回答你的问题/
 我想了一会儿，我的感觉是这个具体问题没有好的答案

事实上，乍一看，您的代码似乎是解决上述问题的好方法（尽管我个人觉得问题本身有点奇怪）。但是，您的实施中存在以下问题：


如果由于某种原因，其中一个线程在处理其迭代时被延迟，会发生什么情况？想象一下，拥有第一个索引的线程需要一段时间来处理它（例如，延迟了某个第三方进程，占用了线程被固定/调度的核心上的CPU时间），并且是最后一个完成的线程。。。然后，它将以与顺序算法完全不同的顺序将其值设置回
array
。这是你可以接受的算法吗
即使没有这种“极端”延迟，您能接受
i
索引在线程之间的分布顺序与
j
索引随后更新的顺序不同吗？如果拥有
i+1
的线程在拥有
i
的线程之前完成，它将使用索引
j
而不是索引
j+n

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

我希望这能奏效。但是，除非检索到
n
的循环的中心部分进行了认真的计算，否则这不会比顺序版本快。
我不知道您可以在OpenMP区域内调用exit…这里的
MAX\u TOTAL
是什么，它与
大小（数组）相比如何
和
MAX
？
MAX\u TOTAL
是循环
MAIN\u循环：do
应该执行的迭代次数。这与
do total=1，MAX_total
Alexander Cska是一样的：那么，代码可能会在数组中进行多次或多次传递？我真的不确定您的代码实际执行的是您想要的还是您认为它执行的：在您的代码片段中，
x
由所有线程按顺序共享和更新（无特定顺序的一个接一个）.所以你不知道它有什么值，但你用它来计算，知道它可以在你背后的任何时刻发生变化，当另一个线程到达
临界
部分…这是什么意思？这不起作用，因为主循环和数组偏移索引不是线性链接的。我正在生成许多
I
和
j
值在主循环的一个周期内。关键区域是，没有两个线程在
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

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