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