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