Fortran OpenMP多worker执行任务队列全部任务触发段错误求解

你的代码出现段错误的核心原因是当master_queue为空时，没有领到新任务的线程依然会尝试执行thread_queue里不存在的任务：

• 当master_queue已经被所有线程抢空时，锁内的if (.not. queue_empty(master_queue))分支不会执行，此时thread_queue里没有有效任务
• 但你没有判断本次是否成功领到任务，直接执行call thread_queue%data(1)%f_ptr(self,var)，此时f_ptr是空指针/野指针，访问0地址触发段错误

你提到的两种正常运行的情况可以对应根因：

1. 注释掉do...end do循环时，每个线程仅执行1次领任务逻辑，第一次领任务时master_queue一定非空，不会触发空指针访问，但只能执行和worker数量相等的任务，达不到你要执行完全部任务的需求
2. 把退出逻辑改成if (.not. queue_empty(master_queue))包裹执行逻辑时，相当于只有领到任务才会执行调用逻辑，自然不会触发段错误；但你去掉了EXIT语句，循环会一直空转永远不会退出，所以你会误以为master_queue永远不为空，其实此时master_queue已经空了，只是程序在无限跑空循环而已。

只需要在领任务时增加是否成功领到任务的标记，没领到任务直接退出循环即可，修改后代码如下：

if ((num_thread  .ne. 0) .and. (num_thread .ne. 1)) then ! ONLY WORKERS 
       if (nthreads-2 .le. last_task-first_task+1) then ! condition:  workers less than tasks 
          call queue_create(thread_queue,last_task-first_task+1) !< create a thread queue of capacity 1
          logical :: has_task
          do             
             has_task = .false.
             call OMP_set_lock(lck)  !< set the lock
             if (.not. queue_empty(master_queue)) then !< if the queue is not empty
                call queue_enqueue_data(thread_queue,master_queue%data(1),success) !< add the first element of the list to the thread queue
                call queue_dequeue_data(master_queue) !< retire the first element of the master queue
                has_task = .true.
             end if
             call OMP_unset_lock(lck) !< unset the lock
    
             ! 没领到任务直接退出，不会执行后续空指针调用
             if (.not. has_task) exit
             
             call thread_queue%data(1)%f_ptr(self,var) !< execute the one and only element of the thread queue

             call queue_dequeue_data(thread_queue) !< retire the element
          end do
          call queue_destroy(thread_queue)  !< destroy the thread queue 
       end if
    end if

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