1! { dg-require-effective-target size32plus }
2
3module m
4  implicit none
5  integer r, a(1024), b(1024)
6contains
7subroutine foo (a, b)
8  integer, contiguous :: a(:), b(:)
9  integer :: i
10  !$omp do reduction (inscan, +:r)
11  do i = 1, 1024
12    r = r + a(i)
13    !$omp scan inclusive(r)
14    b(i) = r
15  end do
16end
17
18integer function bar ()
19  integer s, i
20  s = 0
21  !$omp parallel
22  !$omp do reduction (inscan, +:s)
23  do i = 1, 1024
24    s = s + 2 * a(i)
25    !$omp scan inclusive(s)
26    b(i) = s
27  end do
28  !$omp end parallel
29  bar = s
30end
31
32subroutine baz (a, b)
33  integer, contiguous :: a(:), b(:)
34  integer :: i
35  !$omp parallel do reduction (inscan, +:r)
36  do i = 1, 1024
37    r = r + a(i)
38    !$omp scan inclusive(r)
39    b(i) = r
40  end do
41end
42
43integer function qux ()
44  integer s, i
45  s = 0
46  !$omp parallel do reduction (inscan, +:s)
47  do i = 1, 1024
48    s = s + 2 * a(i)
49    !$omp scan inclusive(s)
50    b(i) = s
51  end do
52  qux = s
53end
54end module m
55
56program main
57  use m
58  implicit none
59
60  integer s, i
61  s = 0
62  do i = 1, 1024
63    a(i) = i-1
64    b(i) = -1
65  end do
66
67  !$omp parallel
68  call foo (a, b)
69  !$omp end parallel
70  if (r /= 1024 * 1023 / 2) &
71    stop 1
72  do i = 1, 1024
73    s = s + i-1
74    if (b(i) /= s) then
75      stop 2
76    else
77      b(i) = 25
78    endif
79  end do
80
81  if (bar () /= 1024 * 1023) &
82    stop 3
83  s = 0
84  do i = 1, 1024
85    s = s + 2 * (i-1)
86    if (b(i) /= s) then
87      stop 4
88    else
89      b(i) = -1
90    end if
91  end do
92
93  r = 0
94  call baz (a, b)
95  if (r /= 1024 * 1023 / 2) &
96    stop 5
97  s = 0
98  do i = 1, 1024
99    s = s + i-1
100    if (b(i) /= s) then
101      stop 6
102    else
103      b(i) = -25
104    endif
105  end do
106
107  if (qux () /= 1024 * 1023) &
108    stop 6
109  s = 0
110  do i = 1, 1024
111    s = s + 2 * (i-1)
112    if (b(i) /= s) &
113      stop 7
114  end do
115end program
116