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
65contains
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
133end
134