1! { dg-do run }
2! { dg-additional-options "-w" }
3
4! subroutine reduction with private and firstprivate variables
5
6program reduction
7  integer, parameter    :: n = 100
8  integer               :: i, j, vsum, cs, arr(n)
9
10  call redsub_private (cs, n, arr)
11  call redsub_bogus (cs, n)
12  call redsub_combined (cs, n, arr)
13
14  vsum = 0
15
16  ! Verify the results
17  do i = 1, n
18     vsum = i
19     do j = 1, n
20        vsum = vsum + 1;
21     end do
22     if (vsum .ne. arr(i)) STOP 1
23  end do
24end program reduction
25
26! This subroutine tests a reduction with an explicit private variable.
27
28subroutine redsub_private(sum, n, arr)
29  integer :: sum, n, arr(n)
30  integer :: i, j, v
31
32  !$acc parallel copyout (arr)
33  !$acc loop gang private (v)
34  do j = 1, n
35     v = j
36
37     !$acc loop vector reduction (+:v)
38     do i = 1, 100
39        v = v + 1
40     end do
41
42     arr(j) = v
43  end do
44  !$acc end parallel
45
46  ! verify the results
47  do i = 1, 10
48     if (arr(i) .ne. 100+i) STOP 2
49  end do
50end subroutine redsub_private
51
52
53! Bogus reduction on a firstprivate variable.  The results do
54! survive the parallel region.  The goal here is to ensure that gfortran
55! doesn't ICE.
56
57subroutine redsub_bogus(sum, n)
58  integer :: sum, n, arr(n)
59  integer :: i
60
61  !$acc parallel firstprivate(sum)
62  !$acc loop gang worker vector reduction (+:sum)
63  do i = 1, n
64     sum = sum + 1
65  end do
66  !$acc end parallel
67end subroutine redsub_bogus
68
69! This reduction involving a firstprivate variable yields legitimate results.
70
71subroutine redsub_combined(sum, n, arr)
72  integer :: sum, n, arr(n)
73  integer :: i, j
74
75  !$acc parallel copy (arr) firstprivate(sum)
76  !$acc loop gang
77  do i = 1, n
78     sum = i;
79
80     !$acc loop reduction(+:sum)
81     do j = 1, n
82        sum = sum + 1
83     end do
84
85     arr(i) = sum
86  end do
87  !$acc end parallel
88end subroutine redsub_combined
89