1! { dg-do run }
2!
3! Test data located inside common blocks.  This test does not exercise
4! ACC DECLARE.  All data clauses are explicit.
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
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 pcopy(/BLOCK/)
32  do i = 1, n
33     x(i) = x(i) + z
34  end do
35  !$acc end parallel loop
36end subroutine incr
37
38program main
39  use consts
40
41  implicit none
42  integer i, j
43  real*4 a(n), b(n), c
44  common /BLOCK/ a, b, c, j
45
46  ! Test copyout, pcopy, device
47
48  !$acc data copyout(a, c)
49
50  c = 1.0
51
52  !$acc update device(c)
53
54  !$acc parallel loop pcopy(a)
55  do i = 1, n
56     a(i) = i
57  end do
58  !$acc end parallel loop
59
60  call incr
61  call incr
62  call incr
63  !$acc end data
64
65  c = 3.0
66  call validate
67
68  ! Test pcopy without copyout
69
70  c = 2.0
71  call incr
72  c = 5.0
73  call validate
74
75  ! Test create, delete, host, copyout, copyin
76
77  !$acc enter data create(b)
78
79  !$acc parallel loop pcopy(b)
80  do i = 1, n
81     b(i) = i
82  end do
83  !$acc end parallel loop
84
85  !$acc update host (b)
86
87  !$acc parallel loop pcopy(b) copyout(a) copyin(c)
88  do i = 1, n
89     a(i) = b(i) + c
90  end do
91  !$acc end parallel loop
92
93  !$acc exit data delete(b)
94
95  call validate
96
97  a(:) = b(:)
98  c = 0.0
99  call validate
100
101  ! Test copy
102
103  c = 1.0
104  !$acc parallel loop copy(/BLOCK/)
105  do i = 1, n
106     a(i) = b(i) + c
107  end do
108  !$acc end parallel loop
109
110  call validate
111
112  ! Test pcopyin, pcopyout FIXME
113
114  c = 2.0
115  !$acc data copyin(b, c) copyout(a)
116
117  !$acc parallel loop pcopyin(b, c) pcopyout(a)
118  do i = 1, n
119     a(i) = b(i) + c
120  end do
121  !$acc end parallel loop
122
123  !$acc end data
124
125  call validate
126
127  ! Test reduction, private
128
129  j = 0
130
131  !$acc parallel private(i) copy(j)
132  !$acc loop reduction(+:j)
133  do i = 1, n
134     j = j + 1
135  end do
136  !$acc end parallel
137
138  if (j .ne. n) stop 2
139
140  ! Test firstprivate, copy
141
142  a(:) = 0
143  c = j
144
145  !$acc parallel loop firstprivate(c) copyout(a)
146  do i = 1, n
147     a(i) = i + c
148  end do
149  !$acc end parallel loop
150
151  call validate
152end program main
153