OpenMP Tasks在负载不对称的Fortran代码中失效问题排查

我正在优化一段已并行化但效率低下的Fortran代码，问题出在线程间操作时长差异极大——尽管各线程任务逻辑相似，但耗时波动非常明显。

原代码逻辑与并行瓶颈 #

• 核心流程：主循环中包含一个耗时的采样函数，采样操作的时长差异显著；每次成功采样后需要执行一系列只能串行的操作，但不同采样点的搜索过程可以并行。
• 当前并行策略：让各线程并行搜索一个采样点，等所有采样完成后再推进主循环、启动新一轮搜索。这种策略在多数场景下有效，但当采样搜索速度远快于后续串行操作，或者搜索难度不均、时长分散时，代码必须等待所有采样完成才能推进，导致效率严重下降。

异步优化尝试与问题 #

为了优化，我希望实现持续搜索新采样点的同时，无需等待所有搜索完成即可推进主循环。具体实现方式：

• 设置状态标记数组live_ready和live_searching，每个元素对应一个线程，标记采样是否完成、是否正在搜索、是否已被主循环使用。
• 在PARALLEL和SINGLE区域的主循环中，创建与线程数相等的OpenMP Task来执行采样搜索。

但实现后遇到了严重问题：

• 启用OpenMP编译后，代码效率极低甚至直接冻结，哪怕设置OMP_NUM_THREADS=1也无法正常运行。
• 如果添加TASKWAIT指令，代码能运行，但完全失去了异步优化的优势。
• 该问题在macOS（Homebrew gfortran）和Linux机器上均复现。

玩具代码的参考情况 #

我编写了一段与主代码结构完全一致的玩具代码（见下文），这段代码能正常运行，但它的并行任务内存分配方式和主代码差异较大。这会不会是问题的根源？该如何解决？恳请各位提供建议。

玩具代码 #

program sim_nf_omp
  use omp_lib

  implicit none
  integer :: n, result
  integer, parameter :: nmax = 10 ! Maximum value for n
  logical, allocatable :: live_ready(:), live_searching(:)
  logical :: early_exit
  real*4 :: rn
  integer :: it, ntries
  integer :: nth

  nth = omp_get_max_threads()
  early_exit = .false.

  allocate(live_ready(nth), live_searching(nth))
  live_ready = .false.
  live_searching = .false.


  !$OMP PARALLEL
  !$OMP SINGLE
  
  main_loop: DO WHILE (.NOT.early_exit)
     
     write(*,*) '############# Thread', omp_get_thread_num(), 'Starting main loop n = ', n, live_ready, live_searching, '############'

           
     ! Launch serach for new sampling points ------------------------------------------------------------------------------------------------------------------
     DO it=1,nth
        
        IF(.NOT.live_ready(it).AND..NOT.live_searching(it).AND..NOT.early_exit) THEN
           
           live_searching(it) = .true.
           !$OMP TASK  DEFAULT(NONE) FIRSTPRIVATE(it) PRIVATE(rn) &
           !$OMP& SHARED(n,live_searching,live_ready)
           write(*,*) 'Thread = ', omp_get_thread_num(), ' starting search it = ', it, 'ready = ', live_ready(it), 'searching = ', live_searching(it)

           ! Simulation of searching for a new sanpling point
           call random_number(rn)
           call busy_work(int(rn * 5.0)) 

           
           live_ready(it) = .true.
           live_searching(it) = .false.
           !$OMP FLUSH(live_ready, live_searching)
           
           write(*,*) 'Thread = ', omp_get_thread_num(), ' finish searching it = ', it, 'ready = ', live_ready(it), 'searching = ', live_searching(it)
           
           !$OMP END TASK
        END IF
     END DO
     ! End of search for new sampling points -----------------------------------------------------------------------------------


     ! Launch routine operations ------------------------------------------------------------------------------------------------
     
     subloop: DO it = 1, nth
        
        IF (live_ready(it).AND..NOT.early_exit) THEN

           ! ....
           ! Some operations to integrate the new sampling point
           ! ....
            
           n = n + 1 
           if(n.ge.nmax) then
              write(*,*) 'Exiting early due to n exceeding nmax'
              early_exit = .true.
           end if
           write(*,*) 'Thread = ', omp_get_thread_num(), 'Integrating new sampling point for n = ', n, 'it = ', it,  'ready = ', live_ready(it), 'searching = ', live_searching(it)
           call busy_work(1)  ! Simulate some work with a sleep
           live_ready(it) = .false.
           !$OMP FLUSH(live_ready)
        ENDIF
     END DO subloop
     
     ! End of routine operations ------------------------------------------------------------------------------------------------
     
     
  END DO main_loop
  
  !$OMP END SINGLE
  !$OMP END PARALLEL

  deallocate(live_ready, live_searching)
  
end program  sim_nf_omp

内容的提问来源于stack exchange，提问作者martinit18