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