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