79778529

Date: 2025-09-29 21:01:36
Score: 2
Natty:
Report link

Unfortunately, the option -fsanitize=thread does not seem to work with apple ARM...:

gfortran -g -fsanitize=thread -fopenmp -ffree-line-length-none sim_nested_fit_tasks_after_stackoverflow.f90 -o nf_aso
Undefined symbols for architecture arm64:
  "___tsan_func_entry", referenced from:
      _busy_work_ in ccnk6bWp.o
...

neither the archer library is available

I however adapted the suggested code. It looks working but I cannot stop it! It goes far beyond n > nmax. I could put DO WHILE (n.le.nmax) but I need a logical for an eventual early stop. But as it is, it does not. More precisely, the toy code looks like:

program sim_nf_omp
  use omp_lib
  
  implicit none
  integer :: n, result
  integer, parameter :: nmax = 4 ! Maximum value for n
  logical, allocatable :: work_units(:)
  logical :: early_exit, is_ready
  real*4 :: rn
  integer :: it, ntries
  integer :: nth
  
  nth = omp_get_max_threads()
  early_exit = .false.
  n=0
  
  allocate(work_units(nth))
  
  
  !$OMP PARALLEL private(is_ready)
  !$OMP SINGLE

  write(*,*) '############# Thread', nth, 'Starting main program ############', n, nmax

  main_loop: DO WHILE (.not. early_exit)
     
   !   write(*,*) '############# Thread', omp_get_thread_num(), 'Starting main loop n = ', n, '############'
     
          
     ! Launch serach for new sampling points ------------------------------------------------------------------------------------------------------------------
     subloop: DO it=1,nth
        
           !$OMP TASK  DEFAULT(NONE) FIRSTPRIVATE(it) PRIVATE(rn) &
           !$OMP& SHARED(n) DEPEND(out:work_units(it))
           write(*,*) 'Thread = ', omp_get_thread_num(), ' starting search it = ', it

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

           
           write(*,*) 'Thread = ', omp_get_thread_num(), ' finish searching it = ', it
           
           !$OMP END TASK

     ! Launch routine operations ------------------------------------------------------------------------------------------------
     
        
           !$OMP TASK  DEFAULT(NONE) FIRSTPRIVATE(it) PRIORITY(2) &
           !$OMP& SHARED(n,early_exit) DEPEND(in:work_units(it)) DEPEND(mutexinoutset:is_ready)
           ! ....
           ! Some operations to integrate the new sampling point
           ! ....
            
           n = n + 1
   
           if(n.ge.nmax) then
              write(*,*) 'Exiting early due to n exceeding nmax', n, nmax
              early_exit = .true.
           end if
           
           write(*,*) 'Thread = ', omp_get_thread_num(), 'Integrating new sampling point for n = ', n, 'it = ', it
           call busy_work(1)  ! Simulate some work with a sleep
           !$OMP END TASK
     
     ! End of routine operations ------------------------------------------------------------------------------------------------

     END DO subloop
     ! End of search for new sampling points -----------------------------------------------------------------------------------

  END DO main_loop
  
  !$OMP END SINGLE
  !$OMP END PARALLEL

  deallocate(work_units)
  
end program  sim_nf_omp

subroutine busy_work(n)
  integer, intent(in) :: n
  integer :: i
  real :: x
  x = 0.0
  do i = 1, n*100000000
     x = x + sin(real(i))
  end do
end subroutine busy_work

N.B when export OMP_NUM_THREADS=1, the code still stalls.

Reasons:
  • Blacklisted phrase (0.5): I need
  • Blacklisted phrase (1): stackoverflow
  • Blacklisted phrase (0.5): I cannot
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (1):
Posted by: martinit18