1! { dg-do run }
2
3! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
4! aspects of that functionality.
5
6! subroutine reduction
7
8program reduction
9  integer, parameter    :: n = 40, c = 10
10  integer               :: i, vsum, gs, ws, vs, cs, ns
11
12  call redsub_gang (gs, n, c)
13  call redsub_worker (ws, n, c)
14  call redsub_vector (vs, n, c)
15  call redsub_combined (cs, n, c)
16  call redsub_nested (ns, n, c)
17
18  vsum = 0
19
20  ! Verify the results
21  do i = 1, n
22     vsum = vsum + c
23  end do
24
25  if (gs .ne. vsum) STOP 1
26  if (ws .ne. vsum) STOP 2
27  if (vs .ne. vsum) STOP 3
28  if (cs .ne. vsum) STOP 4
29  if (ns .ne. vsum) STOP 5
30end program reduction
31
32subroutine redsub_gang(sum, n, c)
33  integer :: sum, n, c
34
35  sum = 0
36
37  !$acc parallel copyin (n, c) num_gangs(n) copy(sum)
38  !$acc loop reduction(+:sum) gang
39  do i = 1, n
40     sum = sum + c
41  end do
42  !$acc end parallel
43end subroutine redsub_gang
44
45subroutine redsub_worker(sum, n, c)
46  integer :: sum, n, c
47
48  sum = 0
49
50  !$acc parallel copyin (n, c) num_workers(4) vector_length (32) copy(sum)
51  ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-1 }
52  !$acc loop reduction(+:sum) worker
53  do i = 1, n
54     sum = sum + c
55  end do
56  !$acc end parallel
57end subroutine redsub_worker
58
59subroutine redsub_vector(sum, n, c)
60  integer :: sum, n, c
61
62  sum = 0
63
64  !$acc parallel copyin (n, c) vector_length(32) copy(sum)
65  !$acc loop reduction(+:sum) vector
66  do i = 1, n
67     sum = sum + c
68  end do
69  !$acc end parallel
70end subroutine redsub_vector
71
72subroutine redsub_combined(sum, n, c)
73  integer :: sum, n, c
74
75  sum = 0
76
77  !$acc parallel num_gangs (8) num_workers (4) vector_length(32) copy(sum)
78  !$acc loop reduction(+:sum) gang worker vector
79  do i = 1, n
80     sum = sum + c
81  end do
82  !$acc end parallel
83end subroutine redsub_combined
84
85subroutine redsub_nested(sum, n, c)
86  integer :: sum, n, c
87  integer :: ii, jj
88
89  ii = n / 10;
90  jj = 10;
91  sum = 0
92
93  !$acc parallel num_gangs (8) copy(sum)
94  !$acc loop reduction(+:sum) gang
95  do i = 1, ii
96     !$acc loop reduction(+:sum) vector
97     do j = 1, jj
98        sum = sum + c
99     end do
100  end do
101  !$acc end parallel
102end subroutine redsub_nested
103