1! { dg-do run }
2!
3use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
4implicit none
5
6intrinsic :: atomic_define
7intrinsic :: atomic_ref
8intrinsic :: atomic_cas
9intrinsic :: atomic_add
10intrinsic :: atomic_and
11intrinsic :: atomic_or
12intrinsic :: atomic_xor
13intrinsic :: atomic_fetch_add
14intrinsic :: atomic_fetch_and
15intrinsic :: atomic_fetch_or
16intrinsic :: atomic_fetch_xor
17integer(atomic_int_kind) :: caf[*], var, var3
18logical(atomic_logical_kind) :: caf_log[*], var2
19integer :: stat, i
20
21caf = 0
22caf_log = .false.
23sync all
24
25if (this_image() == 1) then
26  call atomic_define(caf[num_images()], 5, stat=stat)
27  if (stat /= 0) STOP 1
28  call atomic_define(caf_log[num_images()], .true., stat=stat)
29  if (stat /= 0) STOP 2
30end if
31sync all
32
33if (this_image() == num_images()) then
34  if (caf /= 5) STOP 3
35  if (.not. caf_log) STOP 4
36  var = 99
37  call atomic_ref(var, caf, stat=stat)
38  if (stat /= 0 .or. var /= 5) STOP 5
39  var2 = .false.
40  call atomic_ref(var2, caf_log, stat=stat)
41  if (stat /= 0 .or. .not. var2) STOP 6
42end if
43call atomic_ref(var, caf[num_images()], stat=stat)
44if (stat /= 0 .or. var /= 5) STOP 7
45call atomic_ref(var2, caf_log[num_images()], stat=stat)
46if (stat /= 0 .or. .not. var2) STOP 8
47sync all
48
49! ADD
50caf = 0
51sync all
52
53call atomic_add(caf, this_image(), stat=stat)
54if (stat /= 0) STOP 9
55do i = 1, num_images()
56  call atomic_add(caf[i], 1, stat=stat)
57  if (stat /= 0) STOP 10
58  call atomic_ref(var, caf, stat=stat)
59  if (stat /= 0 .or. var < this_image()) STOP 11
60end do
61sync all
62
63call atomic_ref(var, caf[num_images()], stat=stat)
64if (stat /= 0 .or. var /= num_images() + this_image()) STOP 12
65do i = 1, num_images()
66  call atomic_ref(var, caf[i], stat=stat)
67  if (stat /= 0 .or. var /= num_images() + i) STOP 13
68end do
69sync all
70
71! AND(1)
72caf = 0
73sync all
74
75if (this_image() < storage_size(caf)-2) then
76  do i = this_image(), min(num_images(), storage_size(caf)-2)
77    call atomic_and(caf[i], shiftl(1, this_image()), stat=stat)
78    if (stat /= 0) STOP 14
79  end do
80end if
81sync all
82
83if (this_image() < storage_size(caf)-2) then
84  var3 = 0
85  do i = 1, min(num_images(), storage_size(caf)-2)
86    var3 = iand(var3, shiftl(1, i))
87    call atomic_ref(var, caf[i], stat=stat)
88    if (stat /= 0 .or. var /= var3) STOP 15
89    if (i == this_image()) then
90      call atomic_ref(var, caf[i], stat=stat)
91      if (stat /= 0 .or. var /= var3) STOP 16
92    end if
93  end do
94end if
95sync all
96
97! AND(2)
98caf = -1
99sync all
100
101if (this_image() < storage_size(caf)-2) then
102  do i = this_image(), min(num_images(), storage_size(caf)-2)
103    call atomic_and(caf[i], shiftl(1, this_image()), stat=stat)
104    if (stat /= 0) STOP 17
105  end do
106end if
107sync all
108
109if (this_image() < storage_size(caf)-2) then
110  var3 = -1
111  do i = 1, min(num_images(), storage_size(caf)-2)
112    var3 = iand(var3, shiftl(1, i))
113    call atomic_ref(var, caf[i], stat=stat)
114    if (stat /= 0 .or. var /= var3) STOP 18
115    if (i == this_image()) then
116      call atomic_ref(var, caf[i], stat=stat)
117      if (stat /= 0 .or. var /= var3) STOP 19
118    end if
119  end do
120end if
121sync all
122
123! AND(3)
124caf = 0
125do i = 1, storage_size(caf)-2, 2
126  caf = shiftl(1, i)
127  var3 = shiftl(1, i)
128end do
129sync all
130
131if (this_image() < storage_size(caf)-2) then
132  do i = this_image(), min(num_images(), storage_size(caf)-2)
133    call atomic_and(caf[i], shiftl(1, this_image()), stat=stat)
134    if (stat /= 0) STOP 20
135  end do
136end if
137sync all
138
139if (this_image() < storage_size(caf)-2) then
140  do i = 1, min(num_images(), storage_size(caf)-2)
141    var3 = iand(var3, shiftl(1, i))
142    call atomic_ref(var, caf[i], stat=stat)
143    if (stat /= 0 .or. var /= var3) STOP 21
144    if (i == this_image()) then
145      call atomic_ref(var, caf[i], stat=stat)
146      if (stat /= 0 .or. var /= var3) STOP 22
147    end if
148  end do
149end if
150sync all
151
152! OR(1)
153caf = 0
154sync all
155
156if (this_image() < storage_size(caf)-2) then
157  do i = this_image(), min(num_images(), storage_size(caf)-2)
158    call atomic_or(caf[i], shiftl(1, this_image()), stat=stat)
159    if (stat /= 0) STOP 23
160  end do
161end if
162sync all
163
164if (this_image() < storage_size(caf)-2) then
165  var3 = 0
166  do i = 1, min(num_images(), storage_size(caf)-2)
167    var3 = ior(var3, shiftl(1, i))
168    call atomic_ref(var, caf[i], stat=stat)
169    if (stat /= 0 .or. var /= var3) STOP 24
170    if (i == this_image()) then
171      call atomic_ref(var, caf[i], stat=stat)
172      if (stat /= 0 .or. var /= var3) STOP 25
173    end if
174  end do
175end if
176sync all
177
178! OR(2)
179caf = -1
180sync all
181
182if (this_image() < storage_size(caf)-2) then
183  do i = this_image(), min(num_images(), storage_size(caf)-2)
184    call atomic_or(caf[i], shiftl(1, this_image()), stat=stat)
185    if (stat /= 0) STOP 26
186  end do
187end if
188sync all
189
190if (this_image() < storage_size(caf)-2) then
191  var3 = -1
192  do i = 1, min(num_images(), storage_size(caf)-2)
193    var3 = ior(var3, shiftl(1, i))
194    call atomic_ref(var, caf[i], stat=stat)
195    if (stat /= 0 .or. var /= var3) STOP 27
196    if (i == this_image()) then
197      call atomic_ref(var, caf[i], stat=stat)
198      if (stat /= 0 .or. var /= var3) STOP 28
199    end if
200  end do
201end if
202sync all
203
204! OR(3)
205caf = 0
206do i = 1, storage_size(caf)-2, 2
207  caf = shiftl(1, i)
208  var3 = shiftl(1, i)
209end do
210sync all
211
212if (this_image() < storage_size(caf)-2) then
213  do i = this_image(), min(num_images(), storage_size(caf)-2)
214    call atomic_or(caf[i], shiftl(1, this_image()), stat=stat)
215    if (stat /= 0) STOP 29
216  end do
217end if
218sync all
219
220if (this_image() < storage_size(caf)-2) then
221  do i = 1, min(num_images(), storage_size(caf)-2)
222    var3 = ior(var3, shiftl(1, i))
223    call atomic_ref(var, caf[i], stat=stat)
224    if (stat /= 0 .or. var /= var3) STOP 30
225    if (i == this_image()) then
226      call atomic_ref(var, caf[i], stat=stat)
227      if (stat /= 0 .or. var /= var3) STOP 31
228    end if
229  end do
230end if
231sync all
232
233! XOR(1)
234caf = 0
235sync all
236
237if (this_image() < storage_size(caf)-2) then
238  do i = this_image(), min(num_images(), storage_size(caf)-2)
239    call atomic_xor(caf[i], shiftl(1, this_image()), stat=stat)
240    if (stat /= 0) STOP 32
241  end do
242end if
243sync all
244
245if (this_image() < storage_size(caf)-2) then
246  var3 = 0
247  do i = 1, min(num_images(), storage_size(caf)-2)
248    var3 = ieor(var3, shiftl(1, i))
249    call atomic_ref(var, caf[i], stat=stat)
250    if (stat /= 0 .or. var /= var3) STOP 33
251    if (i == this_image()) then
252      call atomic_ref(var, caf[i], stat=stat)
253      if (stat /= 0 .or. var /= var3) STOP 34
254    end if
255  end do
256end if
257sync all
258
259! XOR(2)
260caf = -1
261sync all
262
263if (this_image() < storage_size(caf)-2) then
264  do i = this_image(), min(num_images(), storage_size(caf)-2)
265    call atomic_xor(caf[i], shiftl(1, this_image()), stat=stat)
266    if (stat /= 0) STOP 35
267  end do
268end if
269sync all
270
271if (this_image() < storage_size(caf)-2) then
272  var3 = -1
273  do i = 1, min(num_images(), storage_size(caf)-2)
274    var3 = ieor(var3, shiftl(1, i))
275    call atomic_ref(var, caf[i], stat=stat)
276    if (stat /= 0 .or. var /= var3) STOP 36
277    if (i == this_image()) then
278      call atomic_ref(var, caf[i], stat=stat)
279      if (stat /= 0 .or. var /= var3) STOP 37
280    end if
281  end do
282end if
283sync all
284
285! XOR(3)
286caf = 0
287do i = 1, storage_size(caf)-2, 2
288  caf = shiftl(1, i)
289  var3 = shiftl(1, i)
290end do
291sync all
292
293if (this_image() < storage_size(caf)-2) then
294  do i = this_image(), min(num_images(), storage_size(caf)-2)
295    call atomic_xor(caf[i], shiftl(1, this_image()), stat=stat)
296    if (stat /= 0) STOP 38
297  end do
298end if
299sync all
300
301if (this_image() < storage_size(caf)-2) then
302  do i = 1, min(num_images(), storage_size(caf)-2)
303    var3 = ieor(var3, shiftl(1, i))
304    call atomic_ref(var, caf[i], stat=stat)
305    if (stat /= 0 .or. var /= var3) STOP 39
306    if (i == this_image()) then
307      call atomic_ref(var, caf[i], stat=stat)
308      if (stat /= 0 .or. var /= var3) STOP 40
309    end if
310  end do
311end if
312sync all
313
314! ADD
315caf = 0
316sync all
317var = -99
318call atomic_fetch_add(caf, this_image(), var, stat=stat)
319if (stat /= 0 .or. var < 0) STOP 41
320if (num_images() == 1 .and. var /= 0) STOP 42
321do i = 1, num_images()
322  var = -99
323  call atomic_fetch_add(caf[i], 1, var, stat=stat)
324  if (stat /= 0 .or. var < 0) STOP 43
325  call atomic_ref(var, caf, stat=stat)
326  if (stat /= 0 .or. var < this_image()) STOP 44
327end do
328sync all
329
330call atomic_ref(var, caf[num_images()], stat=stat)
331if (stat /= 0 .or. var /= num_images() + this_image()) STOP 45
332do i = 1, num_images()
333  call atomic_ref(var, caf[i], stat=stat)
334  if (stat /= 0 .or. var /= num_images() + i) STOP 46
335end do
336sync all
337
338
339! AND(1)
340caf = 0
341sync all
342
343if (this_image() < storage_size(caf)-2) then
344  do i = this_image(), min(num_images(), storage_size(caf)-2)
345    var = 99
346    call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)
347    if (stat /= 0 .or. var /= 0) STOP 47
348  end do
349end if
350sync all
351
352if (this_image() < storage_size(caf)-2) then
353  var3 = 0
354  do i = 1, min(num_images(), storage_size(caf)-2)
355    var3 = iand(var3, shiftl(1, i))
356    call atomic_ref(var, caf[i], stat=stat)
357    if (stat /= 0 .or. var /= var3) STOP 48
358    if (i == this_image()) then
359      call atomic_ref(var, caf[i], stat=stat)
360      if (stat /= 0 .or. var /= var3) STOP 49
361    end if
362  end do
363end if
364sync all
365
366! AND(2)
367caf = -1
368sync all
369
370if (this_image() < storage_size(caf)-2) then
371  do i = this_image(), min(num_images(), storage_size(caf)-2)
372    var = -99
373    call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)
374    if (stat /= 0 .or. var == shiftl(1, this_image())) STOP 50
375  end do
376end if
377sync all
378
379if (this_image() < storage_size(caf)-2) then
380  var3 = -1
381  do i = 1, min(num_images(), storage_size(caf)-2)
382    var3 = iand(var3, shiftl(1, i))
383    call atomic_ref(var, caf[i], stat=stat)
384    if (stat /= 0 .or. var /= var3) STOP 51
385    if (i == this_image()) then
386      call atomic_ref(var, caf[i], stat=stat)
387      if (stat /= 0 .or. var /= var3) STOP 52
388    end if
389  end do
390end if
391sync all
392
393! AND(3)
394caf = 0
395var3 = 0
396do i = 1, storage_size(caf)-2, 2
397  caf = ior(shiftl(1, i), caf)
398  var3 = ior(shiftl(1, i), var3)
399end do
400sync all
401
402if (this_image() < storage_size(caf)-2) then
403  do i = this_image(), min(num_images(), storage_size(caf)-2)
404    var = -99
405    call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)
406    if (stat /= 0 .or. var <= 0) STOP 53
407  end do
408end if
409sync all
410
411if (this_image() < storage_size(caf)-2) then
412  do i = 1, min(num_images(), storage_size(caf)-2)
413    var3 = iand(var3, shiftl(1, i))
414    call atomic_ref(var, caf[i], stat=stat)
415    if (stat /= 0 .or. var /= var3) STOP 54
416    if (i == this_image()) then
417      call atomic_ref(var, caf[i], stat=stat)
418      if (stat /= 0 .or. var /= var3) STOP 55
419    end if
420  end do
421end if
422sync all
423
424
425
426! OR(1)
427caf = 0
428sync all
429
430if (this_image() < storage_size(caf)-2) then
431  do i = this_image(), min(num_images(), storage_size(caf)-2)
432    var = -99
433    call atomic_fetch_or(caf[i], shiftl(1, this_image()), var, stat=stat)
434    if (stat /= 0 .or. var < 0 .or. var == shiftl(1, this_image())) STOP 56
435  end do
436end if
437sync all
438
439if (this_image() < storage_size(caf)-2) then
440  var3 = 0
441  do i = 1, min(num_images(), storage_size(caf)-2)
442    var3 = ior(var3, shiftl(1, i))
443    call atomic_ref(var, caf[i], stat=stat)
444    if (stat /= 0 .or. var /= var3) STOP 57
445    if (i == this_image()) then
446      call atomic_ref(var, caf[i], stat=stat)
447      if (stat /= 0 .or. var /= var3) STOP 58
448    end if
449  end do
450end if
451sync all
452
453! OR(2)
454caf = -1
455sync all
456
457if (this_image() < storage_size(caf)-2) then
458  do i = this_image(), min(num_images(), storage_size(caf)-2)
459    var = -99
460    call atomic_fetch_or(caf[i], shiftl(1, this_image()), var, stat=stat)
461    if (stat /= 0 .or. (var < 0 .and. var /= -1)) STOP 59
462  end do
463end if
464sync all
465
466if (this_image() < storage_size(caf)-2) then
467  var3 = -1
468  do i = 1, min(num_images(), storage_size(caf)-2)
469    var3 = ior(var3, shiftl(1, i))
470    call atomic_ref(var, caf[i], stat=stat)
471    if (stat /= 0 .or. var /= var3) STOP 60
472    if (i == this_image()) then
473      call atomic_ref(var, caf[i], stat=stat)
474      if (stat /= 0 .or. var /= var3) STOP 61
475    end if
476  end do
477end if
478sync all
479
480! OR(3)
481caf = 0
482var3 = 0
483do i = 1, storage_size(caf)-2, 2
484  caf = ior(shiftl(1, i), caf)
485  var3 = ior(shiftl(1, i), var3)
486end do
487sync all
488
489if (this_image() < storage_size(caf)-2) then
490  do i = this_image(), min(num_images(), storage_size(caf)-2)
491    var = -99
492    call atomic_fetch_or(caf[i], shiftl(1, this_image()), var, stat=stat)
493    if (stat /= 0 .or. var <= 0) STOP 62
494  end do
495end if
496sync all
497
498if (this_image() < storage_size(caf)-2) then
499  do i = 1, min(num_images(), storage_size(caf)-2)
500    var3 = ior(var3, shiftl(1, i))
501    call atomic_ref(var, caf[i], stat=stat)
502    if (stat /= 0 .or. var /= var3) STOP 63
503    if (i == this_image()) then
504      call atomic_ref(var, caf[i], stat=stat)
505      if (stat /= 0 .or. var /= var3) STOP 64
506    end if
507  end do
508end if
509sync all
510
511
512! XOR(1)
513caf = 0
514sync all
515
516if (this_image() < storage_size(caf)-2) then
517  do i = this_image(), min(num_images(), storage_size(caf)-2)
518    var = -99
519    call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)
520    if (stat /= 0 .or. var < 0 .or. var == shiftl(1, this_image())) STOP 65
521  end do
522end if
523sync all
524
525if (this_image() < storage_size(caf)-2) then
526  var3 = 0
527  do i = 1, min(num_images(), storage_size(caf)-2)
528    var3 = ieor(var3, shiftl(1, i))
529    call atomic_ref(var, caf[i], stat=stat)
530    if (stat /= 0 .or. var /= var3) STOP 66
531    if (i == this_image()) then
532      call atomic_ref(var, caf[i], stat=stat)
533      if (stat /= 0 .or. var /= var3) STOP 67
534    end if
535  end do
536end if
537sync all
538
539! XOR(2)
540caf = -1
541sync all
542
543if (this_image() < storage_size(caf)-2) then
544  do i = this_image(), min(num_images(), storage_size(caf)-2)
545    var = -99
546    call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)
547    if (stat /= 0 .or. (var < 0 .and. var /= -1)) STOP 68
548  end do
549end if
550sync all
551
552if (this_image() < storage_size(caf)-2) then
553  var3 = -1
554  do i = 1, min(num_images(), storage_size(caf)-2)
555    var3 = ieor(var3, shiftl(1, i))
556    call atomic_ref(var, caf[i], stat=stat)
557    if (stat /= 0 .or. var /= var3) STOP 69
558    if (i == this_image()) then
559      call atomic_ref(var, caf[i], stat=stat)
560      if (stat /= 0 .or. var /= var3) STOP 70
561    end if
562  end do
563end if
564sync all
565
566! XOR(3)
567caf = 0
568var3 = 0
569do i = 1, storage_size(caf)-2, 2
570  caf = ior(shiftl(1, i), caf)
571  var3 = ior(shiftl(1, i), var3)
572end do
573sync all
574
575if (this_image() < storage_size(caf)-2) then
576  do i = this_image(), min(num_images(), storage_size(caf)-2)
577    var = -99
578    call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)
579    if (stat /= 0 .or. var <= 0) STOP 71
580  end do
581end if
582sync all
583
584if (this_image() < storage_size(caf)-2) then
585  do i = 1, min(num_images(), storage_size(caf)-2)
586    var3 = ieor(var3, shiftl(1, i))
587    call atomic_ref(var, caf[i], stat=stat)
588    if (stat /= 0 .or. var /= var3) STOP 72
589    if (i == this_image()) then
590      call atomic_ref(var, caf[i], stat=stat)
591      if (stat /= 0 .or. var /= var3) STOP 73
592    end if
593  end do
594end if
595sync all
596
597! CAS
598caf = 9
599caf_log = .true.
600sync all
601
602if (this_image() == 1) then
603  call atomic_cas(caf[num_images()], compare=5, new=3, old=var, stat=stat)
604  if (stat /= 0 .or. var /= 9) STOP 74
605  call atomic_ref(var, caf[num_images()], stat=stat)
606  if (stat /= 0 .or. var /= 9) STOP 75
607end if
608sync all
609
610if (this_image() == num_images() .and. caf /= 9) STOP 76
611call atomic_ref(var, caf[num_images()], stat=stat)
612if (stat /= 0 .or. var /= 9) STOP 77
613sync all
614
615if (this_image() == 1) then
616  call atomic_cas(caf[num_images()], compare=9, new=3, old=var, stat=stat)
617  if (stat /= 0 .or. var /= 9) STOP 78
618  call atomic_ref(var, caf[num_images()], stat=stat)
619  if (stat /= 0 .or. var /= 3) STOP 79
620end if
621sync all
622
623if (this_image() == num_images() .and. caf /= 3) STOP 80
624call atomic_ref(var, caf[num_images()], stat=stat)
625if (stat /= 0 .or. var /= 3) STOP 81
626sync all
627
628
629if (this_image() == 1) then
630  call atomic_cas(caf_log[num_images()], compare=.false., new=.false., old=var2, stat=stat)
631  if (stat /= 0 .or. var2 .neqv. .true.) STOP 82
632  call atomic_ref(var2, caf_log[num_images()], stat=stat)
633  if (stat /= 0 .or. var2 .neqv. .true.) STOP 83
634end if
635sync all
636
637if (this_image() == num_images() .and. caf_log .neqv. .true.) STOP 84
638call atomic_ref(var2, caf_log[num_images()], stat=stat)
639if (stat /= 0 .or. var2 .neqv. .true.) STOP 85
640sync all
641
642if (this_image() == 1) then
643  call atomic_cas(caf_log[num_images()], compare=.true., new=.false., old=var2, stat=stat)
644  if (stat /= 0 .or. var2 .neqv. .true.) STOP 86
645  call atomic_ref(var2, caf_log[num_images()], stat=stat)
646  if (stat /= 0 .or. var2 .neqv. .false.) STOP 87
647end if
648sync all
649
650if (this_image() == num_images() .and. caf_log .neqv. .false.) STOP 88
651call atomic_ref(var2, caf_log[num_images()], stat=stat)
652if (stat /= 0 .or. var2 .neqv. .false.) STOP 89
653end
654