pointersfortranopenmpderived-types

Strange behavior with pointers in derived types when using OpenMP


I am having trouble identifying a problem in an OpenMP parallelized Fortran code. In doing so, I created a small reproducible that mimics the derived types I am using in the code. The small reproducible shows some unexpected behavior that could point to the root of the problem, so I would like to understand what is happening. I am posting the code below:

module my_subroutines

  use, intrinsic :: iso_fortran_env
  
  implicit none

  type array_int32
    integer(kind=int32), dimension(:), allocatable :: arr
  end type array_int32

  type array_int32_ptr
    type(array_int32), pointer :: p => NULL()
  end type array_int32_ptr

contains

  subroutine print_rows(tid, row_ptr)
    
    implicit none

    integer(int32), intent(in) :: tid
    type(array_int32_ptr), dimension(2), target, intent(inout) :: row_ptr

    integer(kind=int32), pointer :: index => NULL()
    integer(kind=int32) :: i, j

    j = 1
    row_ptr(j)%p%arr(1) = 1000
    index => row_ptr(j)%p%arr(1)
    write(*,'(2(A,I0))') ' - row_ptr(1)p%arr(1) on thread ', tid, ': ', index

    j = 2
    row_ptr(j)%p%arr(1) = 1000
    index => row_ptr(j)%p%arr(1)
    write(*,'(2(A,I0))') ' - row_ptr(2)p%arr(1) on thread ', tid, ': ', index

  end subroutine print_rows

end module my_subroutines

program test
  
  use, intrinsic :: iso_fortran_env
  use my_subroutines
  use omp_lib

  implicit none
   
  type(array_int32_ptr), dimension(2) :: row_ptr
  type(array_int32), dimension(2), target :: row
  integer(kind=int32) :: i, tid

  !$omp parallel default(none) &
  !$omp private(i, tid, row, row_ptr)

  tid = omp_get_thread_num()
  
  allocate(row(1)%arr(10))
  allocate(row(2)%arr(20))

  row(1)%arr = (/ (i, i=1,size(row(1)%arr) )/)
  row(2)%arr = (/ (i, i=1,size(row(2)%arr) )/)

  row_ptr(1)%p => row(1)
  row_ptr(2)%p => row(2)

  call print_rows(tid, row_ptr)

  row_ptr(1)%p => row(2)
  row_ptr(2)%p => row(1)

  call print_rows(tid, row_ptr)

  deallocate(row(1)%arr, row(2)%arr)

  !$omp end parallel
    
end program test

and here is an example output running on 3 threads (which is not deterministic, pointing to some memory leak within the code):

 - row_ptr(1)p%arr(1) on thread 0: 1000
 - row_ptr(1)p%arr(1) on thread 1: 1000
 - row_ptr(2)p%arr(1) on thread 1: 1000
 - row_ptr(1)p%arr(1) on thread 1: 1000
 - row_ptr(2)p%arr(1) on thread 1: 1000
 - row_ptr(1)p%arr(1) on thread 2: 1987284000
 - row_ptr(2)p%arr(1) on thread 2: 1000
 - row_ptr(1)p%arr(1) on thread 2: 1000
 - row_ptr(2)p%arr(1) on thread 2: 1000
 - row_ptr(2)p%arr(1) on thread 0: 2121468960
 - row_ptr(1)p%arr(1) on thread 0: 1000
 - row_ptr(2)p%arr(1) on thread 0: 1000

Solution

  • The problem is that you've initialized index in the print_rows subroutine, so giving it the save attribute, and so making it shared - hence the race condition. The simple solution, and I'm 90% sure there's a duplicate that says this but I can't find it, is just not to initialize index. However given that all you seem to want here is a shorthand for a long derived type component name, and that all pointers in Fortran are evil, maybe a better solution is to use Associate and get rid of the index pointer variable altogether. gfortran results below, ifx is similar:

    ijb@ijb-Latitude-5410:~/work/stack$ gfortran --version
    GNU Fortran (GCC) 14.1.0
    Copyright © 2024 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$ cat pp.f90
    module my_subroutines
    
      use, intrinsic :: iso_fortran_env
      
      implicit none
    
      type array_int32
        integer(kind=int32), dimension(:), allocatable :: arr
      end type array_int32
    
      type array_int32_ptr
        type(array_int32), pointer :: p => NULL()
      end type array_int32_ptr
    
    contains
    
      subroutine print_rows(tid, row_ptr)
        
        implicit none
    
        integer(int32), intent(in) :: tid
        type(array_int32_ptr), dimension(2), target, intent(inout) :: row_ptr
    
    !!$    integer(kind=int32), pointer :: index => Null()
        integer(kind=int32) :: i, j
    
        j = 1
        row_ptr(j)%p%arr(1) = 1000
    !!$    index => row_ptr(j)%p%arr(1)
        Associate( index => row_ptr(j)%p%arr(1) )
          write(*,'(2(A,I0))') ' - row_ptr(1)p%arr(1) on thread ', tid, ': ', index
        End Associate
    
        j = 2
        row_ptr(j)%p%arr(1) = 1000
    !!$    index => row_ptr(j)%p%arr(1)
        Associate( index => row_ptr(j)%p%arr(1) )
          write(*,'(2(A,I0))') ' - row_ptr(2)p%arr(1) on thread ', tid, ': ', index
        End Associate
    
      end subroutine print_rows
    
    end module my_subroutines
    
    program test
      
      use, intrinsic :: iso_fortran_env
      use my_subroutines
      use omp_lib
    
      implicit none
       
      type(array_int32_ptr), dimension(2) :: row_ptr
      type(array_int32), dimension(2), target :: row
      integer(kind=int32) :: i, tid
    
      !$omp parallel default(none) &
      !$omp private(i, tid, row, row_ptr)
    
      tid = omp_get_thread_num()
      
      allocate(row(1)%arr(10))
      allocate(row(2)%arr(20))
    
      row(1)%arr = (/ (i, i=1,size(row(1)%arr) )/)
      row(2)%arr = (/ (i, i=1,size(row(2)%arr) )/)
    
      row_ptr(1)%p => row(1)
      row_ptr(2)%p => row(2)
    
      call print_rows(tid, row_ptr)
    
      row_ptr(1)%p => row(2)
      row_ptr(2)%p => row(1)
    
      call print_rows(tid, row_ptr)
    
      deallocate(row(1)%arr, row(2)%arr)
    
      !$omp end parallel
        
    end program test
    ijb@ijb-Latitude-5410:~/work/stack$ gfortran -fopenmp -Wall -Wextra -fcheck=all -std=f2018 -g -O pp.f90 
    pp.f90:25:28:
    
       25 |     integer(kind=int32) :: i, j
          |                            1
    Warning: Unused variable ‘i’ declared at (1) [-Wunused-variable]
    ijb@ijb-Latitude-5410:~/work/stack$ export OMP_NUM_THREADS=4
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
    ijb@ijb-Latitude-5410:~/work/stack$ ./a.out 
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 0: 1000
     - row_ptr(2)p%arr(1) on thread 0: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 1: 1000
     - row_ptr(2)p%arr(1) on thread 1: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 2: 1000
     - row_ptr(2)p%arr(1) on thread 2: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000
     - row_ptr(1)p%arr(1) on thread 3: 1000
     - row_ptr(2)p%arr(1) on thread 3: 1000