我可以使用 OpenMP 通过单个线程释放共享变量吗?

Can I deallocate a shared variable by a single thread using OpenMP?

我正在使用 OpenMP 来并行化代码。根据我要问的问题,这是代码中最重要的部分:

    !$OMP PARALLEL PRIVATE(num_thread) &
    !$OMP SHARED(tasklist_GRAD,threads_list,threads_list_all,tasks_ready_master) &
    !$OMP SHARED(threads_list_part1,nthreads)

    num_thread=OMP_GET_THREAD_NUM() ! le rang du thread 
    nthreads=OMP_GET_NUM_THREADS() ! le nombre de threads



    !Thread Application Master (numero 1)
    if (num_thread==1) then
       do ff=1,3 ! 3 tâches
          if (associated(tasklist_GRAD(ff)%f_ptr) .eqv. .true. ) then ! Si tâche attribuée 
             tasks_ready_master(ff) = tasklist_GRAD(ff) ! égalité de pointeurs 
             tasks_ready_master(ff)%state=STATE_READY
          end if
       end do
    end if
    !$OMP BARRIER

    !Thread Master (numero 0)
    if (num_thread==0) then 

       allocate(threads_list(nthreads-2)) ! liste des threads workers 
       do ff=1,nthreads-2 
          threads_list(ff)=ff+1 ! 2,3,..,nombre de threads-2
       end do

       do ff=1,3,nthreads-2
          if (tasks_ready_master(ff)%state==STATE_READY) then
             threads_list_all(ff:ff+nthreads-3)=threads_list(:)
          end if
       end do
       threads_list_part1=threads_list_all(1:3) ! 3 tâches
       deallocate(threads_list)
    end if

    !$OMP BARRIER

如您所见,threads_list是一个共享变量。我的问题很简单。 我是否有权通过 1 个单线程取消分配 shared 变量,或者我是否应该退出 if (num_thread==0) then 以便所有线程完成此操作?

我问这个是因为我收到与内存泄漏相关的错误。

要回答这个问题,因为共享变量只有一个实例化,它只需要被释放一次——但由哪个线程释放并不重要:

ijb@ijb-Latitude-5410:~/work/stack$ cat omp.f90
Program omp_alloc

  Use omp_lib, Only : omp_get_num_threads, omp_get_thread_num

  Implicit None

  Integer, Dimension( : ), Allocatable :: a

  Integer :: ith
  Integer :: nth
  Integer :: i
  
  Allocate( a( 1:4 ) )
  a = [ ( i, i = 1, 4 ) ]

  !$omp parallel default( none ) shared( a ) private( ith, nth )
  nth = omp_get_num_threads()
  ith = omp_get_thread_num ()
  Write( *, * ) ith, nth, 'a = ', a
  ! Barrier to make sure a is printed by all threads before deallocation
  !$omp barrier
  !$omp single
  Write( *, * ) 'Thread ', ith, ' Deallocating'
  Deallocate( a )
  !$omp end single
  !$omp end parallel

  Write( *, * ) Allocated( a )
  
End Program omp_alloc
ijb@ijb-Latitude-5410:~/work/stack$ gfortran-11 --version
GNU Fortran (GCC) 11.1.0
Copyright © 2021 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

ijb@ijb-Latitude-5410:~/work/stack$ gfortran-11 -Wall -Wextra -fcheck=all -O -g -std=f2018 -fopenmp omp.f90 
ijb@ijb-Latitude-5410:~/work/stack$ export OMP_NUM_THREADS=4
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
 Thread            3  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            0  Deallocating
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           4 a =            1           2           3           4
           3           4 a =            1           2           3           4
           1           4 a =            1           2           3           4
           2           4 a =            1           2           3           4
 Thread            2  Deallocating
 F

如果您尝试通过多个线程解除分配,您会得到未定义的行为。在 gfortran 上,至少他通过在尝试释放数组时测试数组是否已分配时看起来像竞争条件来自我证明:

ijb@ijb-Latitude-5410:~/work/stack$ cat omp.f90
Program omp_alloc

  Use omp_lib, Only : omp_get_num_threads, omp_get_thread_num

  Implicit None

  Integer, Dimension( : ), Allocatable :: a

  Integer :: ith
  Integer :: nth
  Integer :: i
  
  Allocate( a( 1:4 ) )
  a = [ ( i, i = 1, 4 ) ]

  !$omp parallel default( none ) shared( a ) private( ith, nth )
  nth = omp_get_num_threads()
  ith = omp_get_thread_num ()
  Write( *, * ) ith, nth, 'a = ', a
  !$omp barrier
  Deallocate( a )
  !$omp end parallel

  Write( *, * ) Allocated( a )
  
End Program omp_alloc
ijb@ijb-Latitude-5410:~/work/stack$ gfortran-11 -Wall -Wextra -fcheck=all -O -g -std=f2018 -fopenmp omp.f90 
ijb@ijb-Latitude-5410:~/work/stack$ export OMP_NUM_THREADS=8
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
           6           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           6           8 a =            1           2           3           4
           0           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
At line 21 of file omp.f90
Fortran runtime error: Attempt to DEALLOCATE unallocated 'a'

Error termination. Backtrace:
#0  0x7fe058962d01 in ???
#1  0x7fe058963849 in ???
#2  0x7fe058963ec6 in ???
#3  0x4012fa in MAIN__._omp_fn.0
    at /home/ijb/work/stack/omp.f90:21
#4  0x7fe0587cb77d in ???
#5  0x7fe058732608 in start_thread
    at /build/glibc-YbNSs7/glibc-2.31/nptl/pthread_create.c:477
#6  0x7fe058657292 in ???
#7  0xffffffffffffffff in ???
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
           6           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           6           8 a =            1           2           3           4
           0           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           6           8 a =            1           2           3           4
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           6           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
 F
ijb@ijb-Latitude-5410:~/work/stack$ ./a.out
           0           8 a =            1           2           3           4
           1           8 a =            1           2           3           4
           3           8 a =            1           2           3           4
           2           8 a =            1           2           3           4
           4           8 a =            1           2           3           4
           7           8 a =            1           2           3           4
           5           8 a =            1           2           3           4
           6           8 a =            1           2           3           4
At line 21 of file omp.f90
Fortran runtime error: Attempt to DEALLOCATE unallocated 'a'

Error termination. Backtrace:
#0  0x7fef41e85d01 in ???
#1  0x7fef41e86849 in ???
#2  0x7fef41e86ec6 in ???
#3  0x4012fa in MAIN__._omp_fn.0
    at /home/ijb/work/stack/omp.f90:21
#4  0x7fef41cee77d in ???
#5  0x7fef41c55608 in start_thread
    at /build/glibc-YbNSs7/glibc-2.31/nptl/pthread_create.c:477
#6  0x7fef41b7a292 in ???
#7  0xffffffffffffffff in ???