1! { dg-do run } 2! { dg-options "-fno-inline -fno-ipa-sra -fno-ipa-cp -fno-ipa-cp-clone" } 3! { dg-set-target-env-var OMP_CANCELLATION "true" } 4 5 use omp_lib 6 integer :: x, i, j 7 common /x/ x 8 9 call omp_set_dynamic (.false.) 10 call omp_set_schedule (omp_sched_static, 1) 11 !$omp parallel num_threads(16) private (i, j) 12 call do_some_work 13 !$omp barrier 14 if (omp_get_thread_num ().eq.1) then 15 call sleep (2) 16 !$omp cancellation point parallel 17 end if 18 do j = 3, 16 19 !$omp do schedule(runtime) 20 do i = 0, j - 1 21 call do_some_work 22 end do 23 !$omp enddo nowait 24 end do 25 if (omp_get_thread_num ().eq.0) then 26 call sleep (1) 27 !$omp cancel parallel 28 end if 29 !$omp end parallel 30contains 31 subroutine do_some_work 32 integer :: x 33 common /x/ x 34 !$omp atomic 35 x = x + 1 36 !$omp end atomic 37 endsubroutine do_some_work 38end 39