libgomp/testsuite/libgomp.fortran/taskloop4.f90

   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) call abort
  15     if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) call abort
  16     call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
  17     if (cnt .ne. 370) call abort
  18     if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) call abort
  19     call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
  20     if (cnt .ne. 7) call abort
  21     if (min_iters .ne. 7 .or. max_iters .ne. 7) call abort
  22     if (ntasks .ne. 1) call abort
  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) call abort
  28     call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
  29     if (cnt .ne. 13 .or. ntasks .ne. 13) call abort
  30   !$omp end single
  31   !$omp end parallel
  32 contains
  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) call abort
  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) call abort
  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
  87 end