libgomp/testsuite/libgomp.fortran/taskloop2.f90

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