1! { dg-do run }
2!
3! Test data located inside common blocks.  This test does not exercise
4! ACC DECLARE.  Most of the data clauses are implicit.
5
6module consts
7  integer, parameter :: n = 100
8end module consts
9
10subroutine validate
11  use consts
12
13  implicit none
14  integer i, j
15  real*4 x(n), y(n), z
16  common /BLOCK/ x, y, z, j
17
18  do i = 1, n
19     if (abs(x(i) - i - z) .ge. 0.0001) stop 1
20  end do
21end subroutine validate
22
23subroutine incr_parallel
24  use consts
25
26  implicit none
27  integer i, j
28  real*4 x(n), y(n), z
29  common /BLOCK/ x, y, z, j
30
31  !$acc parallel loop
32  do i = 1, n
33     x(i) = x(i) + z
34  end do
35  !$acc end parallel loop
36end subroutine incr_parallel
37
38subroutine incr_kernels
39  use consts
40
41  implicit none
42  integer i, j
43  real*4 x(n), y(n), z
44  common /BLOCK/ x, y, z, j
45
46  !$acc kernels
47  do i = 1, n
48     x(i) = x(i) + z
49  end do
50  !$acc end kernels
51end subroutine incr_kernels
52
53program main
54  use consts
55
56  implicit none
57  integer i, j
58  real*4 a(n), b(n), c
59  common /BLOCK/ a, b, c, j
60
61  !$acc data copyout(a, c)
62
63  c = 1.0
64
65  !$acc update device(c)
66
67  !$acc parallel loop
68  do i = 1, n
69     a(i) = i
70  end do
71  !$acc end parallel loop
72
73  call incr_parallel
74  call incr_parallel
75  call incr_parallel
76  !$acc end data
77
78  c = 3.0
79  call validate
80
81  ! Test pcopy without copyout
82
83  c = 2.0
84  call incr_kernels
85  c = 5.0
86  call validate
87
88  !$acc kernels
89  do i = 1, n
90     b(i) = i
91  end do
92  !$acc end kernels
93
94  !$acc parallel loop
95  do i = 1, n
96     a(i) = b(i) + c
97  end do
98  !$acc end parallel loop
99
100  call validate
101
102  a(:) = b(:)
103  c = 0.0
104  call validate
105
106  ! Test copy
107
108  c = 1.0
109  !$acc parallel loop
110  do i = 1, n
111     a(i) = b(i) + c
112  end do
113  !$acc end parallel loop
114
115  call validate
116
117  c = 2.0
118  !$acc data copyin(b, c) copyout(a)
119
120  !$acc kernels
121  do i = 1, n
122     a(i) = b(i) + c
123  end do
124  !$acc end kernels
125
126  !$acc end data
127
128  call validate
129
130  j = 0
131
132  !$acc parallel loop reduction(+:j)
133  do i = 1, n
134     j = j + 1
135  end do
136  !$acc end parallel loop
137
138  if (j .ne. n) stop 2
139end program main
140