如何使用锁定例程和睡眠功能以摆脱显式的同步障碍？

Question

我实现了以下测试代码：

program test
  use OMP_LIB
  implicit none
  integer::num_thread,nthreads
  integer::a=1
  integer(kind = OMP_lock_kind) :: lck !< a lock
  call omp_init_lock(lck)
  !$OMP PARALLEL SHARED(a,lck) PRIVATE(num_thread,nthreads)
  num_thread=OMP_GET_THREAD_NUM() !< le rang du thread 
  nthreads=OMP_GET_NUM_THREADS() !< le nombre de threads

  if (num_thread==0) then
     call omp_set_lock(lck)
     a=a+5
     a=a+7
     call omp_unset_lock(lck)
  end if
  
  !$OMP BARRIER 
  
  if (num_thread == 1) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 2) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 3) then
     a=a+1
  end if

  !$OMP END PARALLEL
  call omp_destroy_lock(lck)
  
  print*,'a is equal to: ',a
  
contains
  recursive subroutine system_sleep(wait)
    use,intrinsic :: iso_c_binding, only: c_int
    integer,intent(in) :: wait
    integer(kind=c_int):: waited
    interface
       function c_usleep(msecs) bind (C,name="usleep")
         import
         integer(c_int) :: c_usleep
         integer(c_int),intent(in),VALUE :: msecs
       end function c_usleep
    end interface
    if(wait.gt.0)then
       waited=c_usleep(int(wait,kind=c_int))
    endif
  end subroutine system_sleep

  recursive subroutine wait(full)
    logical,intent(in)::full
    do
       call system_sleep(1)
       if (full .eqv. .true.) EXIT

    end do
  end subroutine wait
end program test

如您所见，线程仅更新整数 a 的值。我想摆脱第一个同步障碍并用代码块替换它。为此，我考虑使用 sleep 函数和锁定例程以避免并发问题。通过执行这段代码，我得到： a is equal to: 16.

以下代码是没有第一个同步屏障的实现：

program test
  use OMP_LIB
  implicit none
  integer::num_thread,nthreads
  integer::a=1
  integer(kind = OMP_lock_kind) :: lck !< a lock
  call omp_init_lock(lck)
  !$OMP PARALLEL SHARED(a,lck) PRIVATE(num_thread,nthreads)
  num_thread=OMP_GET_THREAD_NUM() !< le rang du thread 
  nthreads=OMP_GET_NUM_THREADS() !< le nombre de threads

  if (num_thread==0) then
     call omp_set_lock(lck)
     a=a+5
     a=a+7
     call omp_unset_lock(lck)
  end if

  if (num_thread .ne. 0) then  
     do
        call omp_set_lock(lck)
        if (a==13) then
           exit
        else
           call omp_unset_lock(lck)
           call system_sleep(1)
        end if            
     end do 
     call omp_unset_lock(lck)
  end if


  if (num_thread == 1) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 2) then
     a=a+1
  end if

  !$OMP BARRIER 
  if (num_thread == 3) then
     a=a+1
  end if

  !$OMP END PARALLEL
  call omp_destroy_lock(lck)
  
  print*,'a is equal to: ',a
  
contains
  recursive subroutine system_sleep(wait)
    use,intrinsic :: iso_c_binding, only: c_int
    integer,intent(in) :: wait
    integer(kind=c_int):: waited
    interface
       function c_usleep(msecs) bind (C,name="usleep")
         import
         integer(c_int) :: c_usleep
         integer(c_int),intent(in),VALUE :: msecs
       end function c_usleep
    end interface
    if(wait.gt.0)then
       waited=c_usleep(int(wait,kind=c_int))
    endif
  end subroutine system_sleep

  recursive subroutine wait(full)
    logical,intent(in)::full
    do
       call system_sleep(1)
       if (full .eqv. .true.) EXIT

    end do
  end subroutine wait
end program test

当我运行此代码时，我得到一个闪烁的光标并且没有显示任何结果。

我不明白线程为什么以及如何处理这段代码。我想提一下条件 a==13 是由于线程号 0 (master) 会将 12 添加到 a 的初始值，即 1。我们只在 master 时离开循环线程完成计算并将 a 设置为值 13.

我希望你能帮助我使这段代码工作。

Answer 1

问题是代码

if (num_thread == 1) then
  a=a+1
end if

不在任何类型的屏障后面，因此它可能发生在一个线程上，而另一个线程正在循环中休眠。这意味着当循环中的线程被唤醒时，a 大于 13，因此无法跳出循环。这反过来意味着陷入循环的线程将永远不会到达 !$OMP BARRIER，因此程序将永远挂起。

这可以通过在 a=a+1 部分之前放置一个障碍来解决，或者将退出循环的条件 (if (a==13) then) 替换为更宽松的 if (a>=13) then。

您可以使用调试器或通过在整个代码中添加 write 语句来识别此类问题，例如作为

if (num_thread==0) then
  call omp_set_lock(lck)
  a=a+5
  a=a+7
  write(*,*) 'a+=12 done'
  call omp_unset_lock(lck)
end if

和

write(*,*) 'Thread ', num_thread, ' of ', nthreads, ' at barrier 1'
!$OMP BARRIER

如何使用锁定例程和睡眠功能以摆脱显式的同步障碍？

How to use the lock routines and the sleep function in order to get rid of the explicite barriers of synchronization?

multithreading

fortran

sleep

locking

openmp