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.