libgomp/testsuite/libgomp.fortran/taskloop2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O2" }
   3 ! { dg-additional-options "-msse2" { target sse2_runtime } }
   4 ! { dg-additional-options "-mavx" { target avx_runtime } }
   5
   6   integer, save :: u(1024), v(1024), w(1024), m
   7   integer :: i
   8   v = (/ (i, i = 1, 1024) /)
   9   w = (/ (i + 1, i = 1, 1024) /)
  10   !$omp parallel
  11   !$omp single
  12   call f1 (1, 1024)
  13   !$omp end single
  14   !$omp end parallel
  15   do i = 1, 1024
  16     if (u(i) .ne. 2 * i + 1) call abort
  17     v(i) = 1024 - i
  18     w(i) = 512 - i
  19   end do
  20   !$omp parallel
  21   !$omp single
  22     call f2 (2, 1022, 17)
  23   !$omp end single
  24   !$omp end parallel
  25   do i = 1, 1024
  26     if (i .lt. 2 .or. i .gt. 1022) then
  27       if (u(i) .ne. 2 * i + 1) call abort
  28     else
  29       if (u(i) .ne. 1536 - 2 * i) call abort
  30     end if
  31     v(i) = i
  32     w(i) = i + 1
  33   end do
  34   if (m .ne. (1023 + 2 * (1021 * 5 + 17) + 9)) call abort
  35   !$omp parallel
  36   !$omp single
  37     call f3 (1, 1024)
  38   !$omp end single
  39   !$omp end parallel
  40   do i = 1, 1024
  41     if (u(i) .ne. 2 * i + 1) call abort
  42     v(i) = 1024 - i
  43     w(i) = 512 - i
  44   end do
  45   if (m .ne. 1025) call abort
  46   !$omp parallel
  47   !$omp single
  48     call f4 (0, 31, 1, 32)
  49   !$omp end single
  50   !$omp end parallel
  51   do i = 1, 1024
  52     if (u(i) .ne. 1536 - 2 * i) call abort
  53     v(i) = i
  54     w(i) = i + 1
  55   end do
  56   if (m .ne. 32 + 33 + 1024) call abort
  57   !$omp parallel
  58   !$omp single
  59     call f5 (0, 31, 1, 32)
  60   !$omp end single
  61   !$omp end parallel
  62   do i = 1, 1024
  63     if (u(i) .ne. 2 * i + 1) call abort
  64   end do
  65   if (m .ne. 32 + 33) call abort
  66 contains
  67   subroutine f1 (a, b)
  68     integer, intent(in) :: a, b
  69     integer :: d
  70     !$omp taskloop simd default(none) shared(u, v, w) nogroup
  71     do d = a, b
  72       u(d) = v(d) + w(d)
  73     end do
  74     ! d is predetermined linear, so we can't let the tasks continue past
  75     ! end of this function.
  76     !$omp taskwait
  77   end subroutine f1
  78   subroutine f2 (a, b, cx)
  79     integer, intent(in) :: a, b, cx
  80     integer :: c, d, e
  81     c = cx
  82     !$omp taskloop simd default(none) shared(u, v, w) linear(d:1) linear(c:5) lastprivate(e)
  83     do d = a, b
  84       u(d) = v(d) + w(d)
  85       c = c + 5
  86       e = c + 9
  87     end do
  88     !$omp end taskloop simd
  89     m = d + c + e
  90   end subroutine f2
  91   subroutine f3 (a, b)
  92     integer, intent(in) :: a, b
  93     integer, target :: d
  94     integer, pointer :: p
  95     !$omp taskloop simd default(none) shared(u, v, w) private (p)
  96     do d = a, b
  97       p => d
  98       u(d) = v(d) + w(d)
  99       p => null()
 100     end do
 101     m = d
 102   end subroutine f3
 103   subroutine f4 (a, b, c, d)
 104     integer, intent(in) :: a, b, c, d
 105     integer, target :: e, f
 106     integer, pointer :: p, q
 107     integer :: g, r
 108     !$omp taskloop simd default(none) shared(u, v, w) lastprivate(g) collapse(2) private (r, p, q)
 109     do e = a, b
 110       do f = c, d
 111         p => e
 112         q => f
 113         r = 32 * e + f
 114         u(r) = v(r) + w(r)
 115         g = r
 116         p => null()
 117         q => null()
 118       end do
 119     end do
 120     m = e + f + g
 121   end subroutine f4
 122   subroutine f5 (a, b, c, d)
 123     integer, intent(in) :: a, b, c, d
 124     integer :: e, f, r
 125     !$omp taskloop simd default(none) shared(u, v, w) collapse(2) private (r)
 126     do e = a, b
 127       do f = c, d
 128         r = 32 * e + f
 129         u(r) = v(r) + w(r)
 130       end do
 131     end do
 132     m = e + f
 133   end subroutine f5
 134 end