1! { dg-do run } 2! { dg-options "-O2" } 3 4 integer, save :: u(64), v 5 integer :: min_iters, max_iters, ntasks, cnt 6 procedure(grainsize), pointer :: fn 7 !$omp parallel 8 !$omp single 9 fn => grainsize 10 ! If grainsize is present, # of task loop iters is 11 ! >= grainsize && < 2 * grainsize, 12 ! unless # of loop iterations is smaller than grainsize. 13 call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt) 14 if (cnt .ne. 79) STOP 1 15 if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) STOP 2 16 call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt) 17 if (cnt .ne. 370) STOP 3 18 if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) STOP 4 19 call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt) 20 if (cnt .ne. 7) STOP 5 21 if (min_iters .ne. 7 .or. max_iters .ne. 7) STOP 6 22 if (ntasks .ne. 1) STOP 7 23 fn => num_tasks 24 ! If num_tasks is present, # of task loop iters is 25 ! min (# of loop iters, num_tasks). 26 call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt) 27 if (cnt .ne. 54 .or. ntasks .ne. 9) STOP 8 28 call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt) 29 if (cnt .ne. 13 .or. ntasks .ne. 13) STOP 9 30 !$omp end single 31 !$omp end parallel 32contains 33 subroutine grainsize (a, b, c, d) 34 integer, intent (in) :: a, b, c, d 35 integer :: i, j, k 36 j = 0 37 k = 0 38 !$omp taskloop firstprivate (j, k) grainsize (d) 39 do i = a, b - 1, c 40 if (j .eq. 0) then 41 !$omp atomic capture 42 k = v 43 v = v + 1 44 !$omp end atomic 45 if (k .ge. 64) STOP 10 46 end if 47 j = j + 1 48 u(k + 1) = j 49 end do 50 end subroutine grainsize 51 subroutine num_tasks (a, b, c, d) 52 integer, intent (in) :: a, b, c, d 53 integer :: i, j, k 54 j = 0 55 k = 0 56 !$omp taskloop firstprivate (j, k) num_tasks (d) 57 do i = a, b - 1, c 58 if (j .eq. 0) then 59 !$omp atomic capture 60 k = v 61 v = v + 1 62 !$omp end atomic 63 if (k .ge. 64) STOP 11 64 end if 65 j = j + 1 66 u(k + 1) = j 67 end do 68 end subroutine num_tasks 69 subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt) 70 integer, intent (in) :: a, b, c, d 71 procedure(grainsize), pointer :: fn 72 integer, intent (out) :: num_tasks, min_iters, max_iters, cnt 73 integer :: i 74 u(:) = 0 75 v = 0 76 cnt = 0 77 call fn (a, b, c, d) 78 min_iters = 0 79 max_iters = 0 80 num_tasks = v 81 if (v .ne. 0) then 82 min_iters = minval (u(1:v)) 83 max_iters = maxval (u(1:v)) 84 cnt = sum (u(1:v)) 85 end if 86 end subroutine test 87end 88