Search code examples
multithreadingfortranopenmpshared-memorymaster-slave

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


I am using OpenMP in order to parallelize a code. Here is the most important part of the code according to the question that I will ask:

    !$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

As you can see, threads_list is a shared variable. My question is very simple. Do I have the right to deallocate a shared variable by 1 single thread or should I retire the if (num_thread==0) then in order to get this done by all the threads ?

I'm asking this since I got an error related to memory leaks.


Solution

  • To answer the question as there is only one instantiation of the shared variable, it need be deallocated only once - but it doesn't matter by which thread:

    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
    

    If you try to deallocate by multiple threads you get undefined behaviour. On gfortran at least his manifests it self by looking like a race condition on the test on whether the array is allocated when you try to deallocate it:

    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 ???