1! Miscellaneous tests for private variables.
2
3! { dg-do run }
4
5
6! Test of gang-private variables declared on loop directive.
7
8subroutine t1()
9  integer :: x, i, arr(32)
10
11  do i = 1, 32
12     arr(i) = i
13  end do
14
15  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
16  !$acc loop gang private(x)
17  do i = 1, 32
18     x = i * 2;
19     arr(i) = arr(i) + x
20  end do
21  !$acc end parallel
22
23  do i = 1, 32
24     if (arr(i) .ne. i * 3) STOP 1
25  end do
26end subroutine t1
27
28
29! Test of gang-private variables declared on loop directive, with broadcasting
30! to partitioned workers.
31
32subroutine t2()
33  integer :: x, i, j, arr(0:32*32)
34
35  do i = 0, 32*32-1
36     arr(i) = i
37  end do
38
39  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
40  !$acc loop gang private(x)
41  do i = 0, 31
42     x = i * 2;
43
44     !$acc loop worker
45     do j = 0, 31
46        arr(i * 32 + j) = arr(i * 32 + j) + x
47     end do
48  end do
49  !$acc end parallel
50
51  do i = 0, 32 * 32 - 1
52     if (arr(i) .ne. i + (i / 32) * 2) STOP 2
53  end do
54end subroutine t2
55
56
57! Test of gang-private variables declared on loop directive, with broadcasting
58! to partitioned vectors.
59
60subroutine t3()
61  integer :: x, i, j, arr(0:32*32)
62
63  do i = 0, 32*32-1
64     arr(i) = i
65  end do
66
67  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
68  !$acc loop gang private(x)
69  do i = 0, 31
70     x = i * 2;
71
72     !$acc loop vector
73     do j = 0, 31
74        arr(i * 32 + j) = arr(i * 32 + j) + x
75     end do
76  end do
77  !$acc end parallel
78
79  do i = 0, 32 * 32 - 1
80     if (arr(i) .ne. i + (i / 32) * 2) STOP 3
81  end do
82end subroutine t3
83
84
85! Test of gang-private addressable variable declared on loop directive, with
86! broadcasting to partitioned workers.
87
88subroutine t4()
89  type vec3
90     integer x, y, z, attr(13)
91  end type vec3
92
93  integer i, j, arr(0:32*32)
94  type(vec3) pt
95
96  do i = 0, 32*32-1
97     arr(i) = i
98  end do
99
100  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
101  !$acc loop gang private(pt)
102  do i = 0, 31
103     pt%x = i
104     pt%y = i * 2
105     pt%z = i * 4
106     pt%attr(5) = i * 6
107
108     !$acc loop vector
109     do j = 0, 31
110        arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5);
111     end do
112  end do
113  !$acc end parallel
114
115  do i = 0, 32 * 32 - 1
116     if (arr(i) .ne. i + (i / 32) * 13) STOP 4
117  end do
118end subroutine t4
119
120
121! Test of vector-private variables declared on loop directive.
122
123subroutine t5()
124  integer :: x, i, j, k, idx, arr(0:32*32*32)
125
126  do i = 0, 32*32*32-1
127     arr(i) = i
128  end do
129
130  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
131  !$acc loop gang
132  do i = 0, 31
133     !$acc loop worker
134     do j = 0, 31
135        !$acc loop vector private(x)
136        do k = 0, 31
137           x = ieor(i, j * 3)
138           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
139        end do
140        !$acc loop vector private(x)
141        do k = 0, 31
142           x = ior(i, j * 5)
143           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
144        end do
145     end do
146  end do
147  !$acc end parallel
148
149  do i = 0, 32 - 1
150     do j = 0, 32 -1
151        do k = 0, 32 - 1
152           idx = i * 1024 + j * 32 + k
153           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
154              STOP 5
155           end if
156        end do
157     end do
158  end do
159end subroutine t5
160
161
162! Test of vector-private variables declared on loop directive. Array type.
163
164subroutine t6()
165  integer :: i, j, k, idx, arr(0:32*32*32), pt(2)
166
167  do i = 0, 32*32*32-1
168     arr(i) = i
169  end do
170
171  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
172  !$acc loop gang
173  do i = 0, 31
174     !$acc loop worker
175     do j = 0, 31
176        !$acc loop vector private(x, pt)
177        do k = 0, 31
178           pt(1) = ieor(i, j * 3)
179           pt(2) = ior(i, j * 5)
180           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
181           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
182        end do
183     end do
184  end do
185  !$acc end parallel
186
187  do i = 0, 32 - 1
188     do j = 0, 32 -1
189        do k = 0, 32 - 1
190           idx = i * 1024 + j * 32 + k
191           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
192              STOP 6
193           end if
194        end do
195     end do
196  end do
197end subroutine t6
198
199
200! Test of worker-private variables declared on a loop directive.
201
202subroutine t7()
203  integer :: x, i, j, arr(0:32*32)
204  common x
205
206  do i = 0, 32*32-1
207     arr(i) = i
208  end do
209
210  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
211  !$acc loop gang private(x)
212  do i = 0, 31
213     !$acc loop worker private(x)
214     do j = 0, 31
215        x = ieor(i, j * 3)
216        arr(i * 32 + j) = arr(i * 32 + j) + x
217     end do
218  end do
219  !$acc end parallel
220
221  do i = 0, 32 * 32 - 1
222     if (arr(i) .ne. i + ieor(i / 32, mod(i, 32) * 3)) STOP 7
223  end do
224end subroutine t7
225
226
227! Test of worker-private variables declared on a loop directive, broadcasting
228! to vector-partitioned mode.
229
230subroutine t8()
231  integer :: x, i, j, k, idx, arr(0:32*32*32)
232
233  do i = 0, 32*32*32-1
234     arr(i) = i
235  end do
236
237  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
238  !$acc loop gang
239  do i = 0, 31
240     !$acc loop worker private(x)
241     do j = 0, 31
242        x = ieor(i, j * 3)
243
244        !$acc loop vector
245        do k = 0, 31
246           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
247        end do
248     end do
249  end do
250  !$acc end parallel
251
252  do i = 0, 32 - 1
253     do j = 0, 32 -1
254        do k = 0, 32 - 1
255           idx = i * 1024 + j * 32 + k
256           if (arr(idx) .ne. idx + ieor(i, j * 3) * k) STOP 8
257        end do
258     end do
259  end do
260end subroutine t8
261
262
263! Test of worker-private variables declared on a loop directive, broadcasting
264! to vector-partitioned mode.  Back-to-back worker loops.
265
266subroutine t9()
267  integer :: x, i, j, k, idx, arr(0:32*32*32)
268
269  do i = 0, 32*32*32-1
270     arr(i) = i
271  end do
272
273  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
274  !$acc loop gang
275  do i = 0, 31
276     !$acc loop worker private(x)
277     do j = 0, 31
278        x = ieor(i, j * 3)
279
280        !$acc loop vector
281        do k = 0, 31
282           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
283        end do
284     end do
285
286     !$acc loop worker private(x)
287     do j = 0, 31
288        x = ior(i, j * 5)
289
290        !$acc loop vector
291        do k = 0, 31
292           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
293        end do
294     end do
295  end do
296  !$acc end parallel
297
298  do i = 0, 32 - 1
299     do j = 0, 32 -1
300        do k = 0, 32 - 1
301           idx = i * 1024 + j * 32 + k
302           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
303              STOP 9
304           end if
305        end do
306     end do
307  end do
308end subroutine t9
309
310
311! Test of worker-private variables declared on a loop directive, broadcasting
312! to vector-partitioned mode.  Successive vector loops.  */
313
314subroutine t10()
315  integer :: x, i, j, k, idx, arr(0:32*32*32)
316
317  do i = 0, 32*32*32-1
318     arr(i) = i
319  end do
320
321  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
322  !$acc loop gang
323  do i = 0, 31
324     !$acc loop worker private(x)
325     do j = 0, 31
326        x = ieor(i, j * 3)
327
328        !$acc loop vector
329        do k = 0, 31
330           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
331        end do
332
333        x = ior(i, j * 5)
334
335        !$acc loop vector
336        do k = 0, 31
337           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
338        end do
339     end do
340  end do
341  !$acc end parallel
342
343  do i = 0, 32 - 1
344     do j = 0, 32 -1
345        do k = 0, 32 - 1
346           idx = i * 1024 + j * 32 + k
347           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
348              STOP 10
349           end if
350        end do
351     end do
352  end do
353end subroutine t10
354
355
356! Test of worker-private variables declared on a loop directive, broadcasting
357! to vector-partitioned mode.  Addressable worker variable.
358
359subroutine t11()
360  integer :: i, j, k, idx, arr(0:32*32*32)
361  integer, target :: x
362  integer, pointer :: p
363
364  do i = 0, 32*32*32-1
365     arr(i) = i
366  end do
367
368  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
369  !$acc loop gang
370  do i = 0, 31
371     !$acc loop worker private(x, p)
372     do j = 0, 31
373        p => x
374        x = ieor(i, j * 3)
375
376        !$acc loop vector
377        do k = 0, 31
378           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
379        end do
380
381        p = ior(i, j * 5)
382
383        !$acc loop vector
384        do k = 0, 31
385           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + x * k
386        end do
387     end do
388  end do
389  !$acc end parallel
390
391  do i = 0, 32 - 1
392     do j = 0, 32 -1
393        do k = 0, 32 - 1
394           idx = i * 1024 + j * 32 + k
395           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
396              STOP 11
397           end if
398        end do
399     end do
400  end do
401end subroutine t11
402
403
404! Test of worker-private variables declared on a loop directive, broadcasting
405! to vector-partitioned mode.  Aggregate worker variable.
406
407subroutine t12()
408  type vec2
409     integer x, y
410  end type vec2
411
412  integer :: i, j, k, idx, arr(0:32*32*32)
413  type(vec2) :: pt
414
415  do i = 0, 32*32*32-1
416     arr(i) = i
417  end do
418
419  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
420  !$acc loop gang
421  do i = 0, 31
422     !$acc loop worker private(pt)
423     do j = 0, 31
424        pt%x = ieor(i, j * 3)
425        pt%y = ior(i, j * 5)
426
427        !$acc loop vector
428        do k = 0, 31
429           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt%x * k
430        end do
431
432        !$acc loop vector
433        do k = 0, 31
434           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt%y * k
435        end do
436     end do
437  end do
438  !$acc end parallel
439
440  do i = 0, 32 - 1
441     do j = 0, 32 -1
442        do k = 0, 32 - 1
443           idx = i * 1024 + j * 32 + k
444           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
445              STOP 12
446           end if
447        end do
448     end do
449  end do
450end subroutine t12
451
452
453! Test of worker-private variables declared on loop directive, broadcasting
454! to vector-partitioned mode.  Array worker variable.
455
456subroutine t13()
457  integer :: i, j, k, idx, arr(0:32*32*32), pt(2)
458
459  do i = 0, 32*32*32-1
460     arr(i) = i
461  end do
462
463  !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
464  !$acc loop gang
465  do i = 0, 31
466     !$acc loop worker private(pt)
467     do j = 0, 31
468        pt(1) = ieor(i, j * 3)
469        pt(2) = ior(i, j * 5)
470
471        !$acc loop vector
472        do k = 0, 31
473           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
474        end do
475
476        !$acc loop vector
477        do k = 0, 31
478           arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
479        end do
480     end do
481  end do
482  !$acc end parallel
483
484  do i = 0, 32 - 1
485     do j = 0, 32 -1
486        do k = 0, 32 - 1
487           idx = i * 1024 + j * 32 + k
488           if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
489              STOP 13
490           end if
491        end do
492     end do
493  end do
494end subroutine t13
495
496
497! Test of gang-private variables declared on the parallel directive.
498
499subroutine t14()
500  use openacc
501  integer :: x = 5
502  integer, parameter :: n = 32
503  integer :: arr(n)
504
505  do i = 1, n
506    arr(i) = 3
507  end do
508
509  !$acc parallel private(x) copy(arr) num_gangs(n) num_workers(8) vector_length(32)
510    !$acc loop gang(static:1)
511    do i = 1, n
512      x = i * 2;
513    end do
514
515   !$acc loop gang(static:1)
516    do i = 1, n
517      if (acc_on_device (acc_device_host) .eqv. .TRUE.) x = i * 2
518      arr(i) = arr(i) + x
519    end do
520  !$acc end parallel
521
522  do i = 1, n
523    if (arr(i) .ne. (3 + i * 2)) STOP 14
524  end do
525
526end subroutine t14
527
528
529program main
530  call t1()
531  call t2()
532  call t3()
533  call t4()
534  call t5()
535  call t6()
536  call t7()
537  call t8()
538  call t9()
539  call t10()
540  call t11()
541  call t12()
542  call t13()
543  call t14()
544end program main
545