1! { dg-do run }
2
3! real reductions
4
5program reduction_2
6  implicit none
7
8  integer, parameter    :: n = 10, ng = 8, nw = 4, vl = 32
9  integer               :: i
10  real                  :: vresult, rg, rw, rv, rc
11  real, parameter       :: e = 0.001
12  logical               :: lrg, lrw, lrv, lrc, lvresult
13  real, dimension (n)   :: array
14
15  do i = 1, n
16     array(i) = i
17  end do
18
19  !
20  ! '+' reductions
21  !
22
23  rg = 0
24  rw = 0
25  rv = 0
26  rc = 0
27  vresult = 0
28
29  !$acc parallel num_gangs(ng) copy(rg)
30  !$acc loop reduction(+:rg) gang
31  do i = 1, n
32     rg = rg + array(i)
33  end do
34  !$acc end parallel
35
36  !$acc parallel num_workers(nw) copy(rw)
37  !$acc loop reduction(+:rw) worker
38  do i = 1, n
39     rw = rw + array(i)
40  end do
41  !$acc end parallel
42
43  !$acc parallel vector_length(vl) copy(rv)
44  !$acc loop reduction(+:rv) vector
45  do i = 1, n
46     rv = rv + array(i)
47  end do
48  !$acc end parallel
49
50  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
51  !$acc loop reduction(+:rc) gang worker vector
52  do i = 1, n
53     rc = rc + array(i)
54  end do
55  !$acc end parallel
56
57  ! Verify the results
58  do i = 1, n
59     vresult = vresult + array(i)
60  end do
61
62  if (rg .ne. vresult) call abort
63  if (rw .ne. vresult) call abort
64  if (rv .ne. vresult) call abort
65  if (rc .ne. vresult) call abort
66
67  !
68  ! '*' reductions
69  !
70
71  rg = 1
72  rw = 1
73  rv = 1
74  rc = 1
75  vresult = 1
76
77  !$acc parallel num_gangs(ng) copy(rg)
78  !$acc loop reduction(*:rg) gang
79  do i = 1, n
80     rg = rg * array(i)
81  end do
82  !$acc end parallel
83
84  !$acc parallel num_workers(nw) copy(rw)
85  !$acc loop reduction(*:rw) worker
86  do i = 1, n
87     rw = rw * array(i)
88  end do
89  !$acc end parallel
90
91  !$acc parallel vector_length(vl) copy(rv)
92  !$acc loop reduction(*:rv) vector
93  do i = 1, n
94     rv = rv * array(i)
95  end do
96  !$acc end parallel
97
98  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
99  !$acc loop reduction(*:rc) gang worker vector
100  do i = 1, n
101     rc = rc * array(i)
102  end do
103  !$acc end parallel
104
105  ! Verify the results
106  do i = 1, n
107     vresult = vresult * array(i)
108  end do
109
110  if (abs (rg - vresult) .ge. e) call abort
111  if (abs (rw - vresult) .ge. e) call abort
112  if (abs (rv - vresult) .ge. e) call abort
113  if (abs (rc - vresult) .ge. e) call abort
114
115  !
116  ! 'max' reductions
117  !
118
119  rg = 0
120  rw = 0
121  rg = 0
122  rc = 0
123  vresult = 0
124
125  !$acc parallel num_gangs(ng) copy(rg)
126  !$acc loop reduction(max:rg) gang
127  do i = 1, n
128     rg = max (rg, array(i))
129  end do
130  !$acc end parallel
131
132  !$acc parallel num_workers(nw) copy(rw)
133  !$acc loop reduction(max:rw) worker
134  do i = 1, n
135     rw = max (rw, array(i))
136  end do
137  !$acc end parallel
138
139  !$acc parallel vector_length(vl) copy(rv)
140  !$acc loop reduction(max:rv) vector
141  do i = 1, n
142     rv = max (rv, array(i))
143  end do
144  !$acc end parallel
145
146  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
147  !$acc loop reduction(max:rc) gang worker vector
148  do i = 1, n
149     rc = max (rc, array(i))
150  end do
151  !$acc end parallel
152
153  ! Verify the results
154  do i = 1, n
155     vresult = max (vresult, array(i))
156  end do
157
158  if (abs (rg - vresult) .ge. e) call abort
159  if (abs (rw - vresult) .ge. e) call abort
160  if (abs (rg - vresult) .ge. e) call abort
161  if (abs (rc - vresult) .ge. e) call abort
162
163  !
164  ! 'min' reductions
165  !
166
167  rg = 0
168  rw = 0
169  rv = 0
170  rc = 0
171  vresult = 0
172
173  !$acc parallel num_gangs(ng) copy(rg)
174  !$acc loop reduction(min:rg) gang
175  do i = 1, n
176     rg = min (rg, array(i))
177  end do
178  !$acc end parallel
179
180  !$acc parallel num_workers(nw) copy(rw)
181  !$acc loop reduction(min:rw) worker
182  do i = 1, n
183     rw = min (rw, array(i))
184  end do
185  !$acc end parallel
186
187  !$acc parallel vector_length(vl) copy(rv)
188  !$acc loop reduction(min:rv) vector
189  do i = 1, n
190     rv = min (rv, array(i))
191  end do
192  !$acc end parallel
193
194  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
195  !$acc loop reduction(min:rc) gang worker vector
196  do i = 1, n
197     rc = min (rc, array(i))
198  end do
199  !$acc end parallel
200
201  ! Verify the results
202  do i = 1, n
203     vresult = min (vresult, array(i))
204  end do
205
206  if (rg .ne. vresult) call abort
207  if (rv .ne. vresult) call abort
208  if (rw .ne. vresult) call abort
209  if (rc .ne. vresult) call abort
210
211  !
212  ! '.and.' reductions
213  !
214
215  lrg = .true.
216  lrw = .true.
217  lrv = .true.
218  lrc = .true.
219  lvresult = .true.
220
221  !$acc parallel num_gangs(ng) copy(lrg)
222  !$acc loop reduction(.and.:lrg) gang
223  do i = 1, n
224     lrg = lrg .and. (array(i) .ge. 5)
225  end do
226  !$acc end parallel
227
228  !$acc parallel num_workers(nw) copy(lrw)
229  !$acc loop reduction(.and.:lrw) worker
230  do i = 1, n
231     lrw = lrw .and. (array(i) .ge. 5)
232  end do
233  !$acc end parallel
234
235  !$acc parallel vector_length(vl) copy(lrv)
236  !$acc loop reduction(.and.:lrv) vector
237  do i = 1, n
238     lrv = lrv .and. (array(i) .ge. 5)
239  end do
240  !$acc end parallel
241
242  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
243  !$acc loop reduction(.and.:lrc) gang worker vector
244  do i = 1, n
245     lrc = lrc .and. (array(i) .ge. 5)
246  end do
247  !$acc end parallel
248
249  ! Verify the results
250  do i = 1, n
251     lvresult = lvresult .and. (array(i) .ge. 5)
252  end do
253
254  if (lrg .neqv. lvresult) call abort
255  if (lrw .neqv. lvresult) call abort
256  if (lrv .neqv. lvresult) call abort
257  if (lrc .neqv. lvresult) call abort
258
259  !
260  ! '.or.' reductions
261  !
262
263  lrg = .false.
264  lrw = .false.
265  lrv = .false.
266  lrc = .false.
267  lvresult = .false.
268
269  !$acc parallel num_gangs(ng) copy(lrg)
270  !$acc loop reduction(.or.:lrg) gang
271  do i = 1, n
272     lrg = lrg .or. (array(i) .ge. 5)
273  end do
274  !$acc end parallel
275
276  !$acc parallel num_workers(nw) copy(lrw)
277  !$acc loop reduction(.or.:lrw) worker
278  do i = 1, n
279     lrw = lrw .or. (array(i) .ge. 5)
280  end do
281  !$acc end parallel
282
283  !$acc parallel vector_length(vl) copy(lrv)
284  !$acc loop reduction(.or.:lrv) vector
285  do i = 1, n
286     lrv = lrv .or. (array(i) .ge. 5)
287  end do
288  !$acc end parallel
289
290  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
291  !$acc loop reduction(.or.:lrc) gang worker vector
292  do i = 1, n
293     lrc = lrc .or. (array(i) .ge. 5)
294  end do
295  !$acc end parallel
296
297  ! Verify the results
298  do i = 1, n
299     lvresult = lvresult .or. (array(i) .ge. 5)
300  end do
301
302  if (lrg .neqv. lvresult) call abort
303  if (lrw .neqv. lvresult) call abort
304  if (lrv .neqv. lvresult) call abort
305  if (lrc .neqv. lvresult) call abort
306
307  !
308  ! '.eqv.' reductions
309  !
310
311  lrg = .true.
312  lrw = .true.
313  lrv = .true.
314  lrc = .true.
315  lvresult = .true.
316
317  !$acc parallel num_gangs(ng) copy(lrg)
318  !$acc loop reduction(.eqv.:lrg) gang
319  do i = 1, n
320     lrg = lrg .eqv. (array(i) .ge. 5)
321  end do
322  !$acc end parallel
323
324  !$acc parallel num_workers(nw) copy(lrw)
325  !$acc loop reduction(.eqv.:lrw) worker
326  do i = 1, n
327     lrw = lrw .eqv. (array(i) .ge. 5)
328  end do
329  !$acc end parallel
330
331  !$acc parallel vector_length(vl) copy(lrv)
332  !$acc loop reduction(.eqv.:lrv) vector
333  do i = 1, n
334     lrv = lrv .eqv. (array(i) .ge. 5)
335  end do
336  !$acc end parallel
337
338  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
339  !$acc loop reduction(.eqv.:lrc) gang worker vector
340  do i = 1, n
341     lrc = lrc .eqv. (array(i) .ge. 5)
342  end do
343  !$acc end parallel
344
345  ! Verify the results
346  do i = 1, n
347     lvresult = lvresult .eqv. (array(i) .ge. 5)
348  end do
349
350  if (lrg .neqv. lvresult) call abort
351  if (lrw .neqv. lvresult) call abort
352  if (lrv .neqv. lvresult) call abort
353  if (lrc .neqv. lvresult) call abort
354
355  !
356  ! '.neqv.' reductions
357  !
358
359  lrg = .true.
360  lrw = .true.
361  lrv = .true.
362  lrc = .true.
363  lvresult = .true.
364
365  !$acc parallel num_gangs(ng) copy(lrg)
366  !$acc loop reduction(.neqv.:lrg) gang
367  do i = 1, n
368     lrg = lrg .neqv. (array(i) .ge. 5)
369  end do
370  !$acc end parallel
371
372  !$acc parallel num_workers(nw) copy(lrw)
373  !$acc loop reduction(.neqv.:lrw) worker
374  do i = 1, n
375     lrw = lrw .neqv. (array(i) .ge. 5)
376  end do
377  !$acc end parallel
378
379  !$acc parallel vector_length(vl) copy(lrv)
380  !$acc loop reduction(.neqv.:lrv) vector
381  do i = 1, n
382     lrv = lrv .neqv. (array(i) .ge. 5)
383  end do
384  !$acc end parallel
385
386  !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
387  !$acc loop reduction(.neqv.:lrc) gang worker vector
388  do i = 1, n
389     lrc = lrc .neqv. (array(i) .ge. 5)
390  end do
391  !$acc end parallel
392
393  ! Verify the results
394  do i = 1, n
395     lvresult = lvresult .neqv. (array(i) .ge. 5)
396  end do
397
398  if (lrg .neqv. lvresult) call abort
399  if (lrw .neqv. lvresult) call abort
400  if (lrv .neqv. lvresult) call abort
401  if (lrc .neqv. lvresult) call abort
402end program reduction_2
403