Gitiles
Code Review Sign In
gerrit-public.fairphone.software / toolchain / llvm-project / c387e70c699330dbfb6599a005a281960ca6da70 / . / openmp / testsuite / fortran / omp_atomic.f
blob: ee74450ae84207a4a1d275d2582e51b801a4ed77 [file] [log] [blame]
Jim Cownie18d84732014-05-10 17:02:09 +0000[diff] [blame]1<ompts:test>
2<ompts:testdescription>Test which checks the omp atomic directive by counting up a variable in a parallelized loop with an atomic directive.</ompts:testdescription>
3<ompts:ompversion>2.0</ompts:ompversion>
4<ompts:directive>omp atomic</ompts:directive>
5<ompts:testcode>
6!********************************************************************
7! Functions: omp_atomic
8! change "character*20" into "character (LEN=20)::"
9! get rid of the "tab" key by Zhenying Liu, on Oct. 16, 2005.
10!********************************************************************
11 INTEGER FUNCTION <ompts:testcode:functionname>omp_atomic</ompts:testcode:functionname>()
12 IMPLICIT NONE
13 INCLUDE "omp_testsuite.f"
14 INTEGER sum2, known_sum
15 INTEGER known_product, int_const
16 DOUBLE PRECISION rounding_error, dpt
17 INTEGER double_DIGITS
18 DOUBLE PRECISION dknown_sum
19 INTEGER result
20 PARAMETER (int_const=10,known_product=3628800)
21 PARAMETER (rounding_error=1.E-2)
22<ompts:orphan:vars>
23 INTEGER sum,i,diff,product
24 DOUBLE PRECISION dsum,dt,ddiff
25 LOGICAL logic_and, logic_or, logic_eqv,logic_neqv
26 INTEGER bit_and, bit_or
27 INTEGER exclusiv_bit_or
28 INTEGER min_value, max_value
29 DOUBLE PRECISION dmin, dmax
30 LOGICAL logics(LOOPCOUNT)
31 INTEGER int_array(LOOPCOUNT)
32 DOUBLE PRECISION d_array(LOOPCOUNT)
33 COMMON /orphvars/ sum,product,diff,i,dsum,ddiff,dt,logic_and,
34 & logic_or,logic_eqv,logic_neqv,logics,bit_and,bit_or,int_array,
35 & exclusiv_bit_or,min_value,dmin,dmax,d_array,max_value
36 INTEGER MAX_FACTOR
37 PARAMETER (double_DIGITS=20,MAX_FACTOR=10)
38</ompts:orphan:vars>
39
40 dt = 1./3.
41 known_sum = (LOOPCOUNT * (LOOPCOUNT + 1)) / 2
42 product = 1
43 sum2 = 0
44 sum = 0
45 dsum = 0.
46 result =0
47 logic_and = .true.
48 logic_or = .false.
49 bit_and = 1
50 bit_or = 0
51 exclusiv_bit_or = 0
52!$omp parallel
53<ompts:orphan>
54!$omp do
55 DO i =1, LOOPCOUNT
56<ompts:check>
57!$omp atomic
58</ompts:check>
59 sum = sum + i
60 END DO
61!$omp end do
62</ompts:orphan>
63!$omp end parallel
64
65 IF (known_sum .NE. sum) THEN
66 result = result + 1
67 WRITE(1,*) "Error in sum with integers: Result was ",
68 & sum,"instead of ", known_sum
69 END If
70
71 diff = (LOOPCOUNT * (LOOPCOUNT + 1)) / 2
72
73
74!$omp parallel
75<ompts:orphan>
76!$omp do
77 DO i =1, LOOPCOUNT
78<ompts:check>
79!$omp atomic
80</ompts:check>
81 diff = diff - i
82 END DO
83!$omp end do
84</ompts:orphan>
85!$omp end parallel
86
87 IF ( diff .NE. 0 ) THEN
88 result = result + 1
89 WRITE(1,*) "Error in difference with integers: Result was ",
90 & diff,"instead of 0."
91 END IF
92
93!... Test for doubles
94 dsum = 0.
95 dpt = 1
96
97 DO i=1, DOUBLE_DIGITS
98 dpt= dpt * dt
99 END DO
100 dknown_sum = (1-dpt)/(1-dt)
101!$omp parallel
102<ompts:orphan>
103!$omp do
104 DO i=0,DOUBLE_DIGITS-1
105<ompts:check>
106!$omp atomic
107</ompts:check>
108 dsum = dsum + dt**i
109 END DO
110!$omp end do
111</ompts:orphan>
112!$omp end parallel
113
114
115 IF (dsum .NE. dknown_sum .AND.
116 & ABS(dsum - dknown_sum) .GT. rounding_error ) THEN
117 result = result + 1
118 WRITE(1,*) "Error in sum with doubles: Result was ",
119 & dsum,"instead of ",dknown_sum,"(Difference: ",
120 & dsum - dknown_sum,")"
121 END IF
122 dpt = 1
123
124
125 DO i=1, DOUBLE_DIGITS
126 dpt = dpt*dt
127 END DO
128
129 ddiff = ( 1-dpt)/(1-dt)
130!$omp parallel
131<ompts:orphan>
132!$omp do
133 DO i=0, DOUBLE_DIGITS-1
134<ompts:check>
135!$omp atomic
136</ompts:check>
137 ddiff = ddiff - dt**i
138 END DO
139!$omp end do
140</ompts:orphan>
141!$omp end parallel
142
143 IF ( ABS(ddiff) .GT. rounding_error ) THEN
144 result = result + 1
145 WRITE(1,*) "Error in Difference with doubles: Result was ",
146 & ddiff,"instead of 0.0"
147 END IF
148
149!$omp parallel
150<ompts:orphan>
151!$omp do
152 DO i=1,MAX_FACTOR
153<ompts:check>
154!$omp atomic
155</ompts:check>
156 product = product * i
157 END DO
158!$omp end do
159</ompts:orphan>
160!$omp end parallel
161
162 IF (known_product .NE. product) THEN
163 result = result + 1
164 WRITE(1,*) "Error in Product with integers: Result was ",
165 & product," instead of",known_product
166 END IF
167
168 DO i=1,LOOPCOUNT
169 logics(i) = .TRUE.
170 END DO
171
172!$omp parallel
173<ompts:orphan>
174!$omp do
175 DO i=1,LOOPCOUNT
176<ompts:check>
177!$omp atomic
178</ompts:check>
179 logic_and = logic_and .AND. logics(i)
180 END DO
181!$omp end do
182</ompts:orphan>
183!$omp end parallel
184
185 IF (.NOT. logic_and) THEN
186 result = result + 1
187 WRITE(1,*) "Error in logic AND part 1"
188 END IF
189
190
191 logic_and = .TRUE.
192 logics(LOOPCOUNT/2) = .FALSE.
193
194!$omp parallel
195<ompts:orphan>
196!$omp do
197 DO i=1,LOOPCOUNT
198<ompts:check>
199!$omp atomic
200</ompts:check>
201 logic_and = logic_and .AND. logics(i)
202 END DO
203!$omp end do
204</ompts:orphan>
205!$omp end parallel
206
207 IF (logic_and) THEN
208 result = result + 1
209 WRITE(1,*) "Error in logic AND pass 2"
210 END IF
211
212 DO i=1, LOOPCOUNT
213 logics(i) = .FALSE.
214 END DO
215
216!$omp parallel
217<ompts:orphan>
218!$omp do
219 DO i = 1, LOOPCOUNT
220<ompts:check>
221!$omp atomic
222</ompts:check>
223 logic_or = logic_or .OR. logics(i)
224 END DO
225!$omp end do
226</ompts:orphan>
227!$omp end parallel
228
229 IF (logic_or) THEN
230 result = result + 1
231 WRITE(1,*) "Error in logic OR part 1"
232 END IF
233
234 logic_or = .FALSE.
235 logics(LOOPCOUNT/2) = .TRUE.
236
237!$omp parallel
238<ompts:orphan>
239!$omp do
240 DO i=1,LOOPCOUNT
241<ompts:check>
242!$omp atomic
243</ompts:check>
244 logic_or = logic_or .OR. logics(i)
245 END DO
246!$omp end do
247</ompts:orphan>
248!$omp end parallel
249
250 IF ( .NOT. logic_or ) THEN
251 result = result + 1
252 WRITE(1,*) "Error in logic OR part 2"
253 END IF
254
255!... Test logic EQV, unique in Fortran
256 DO i=1, LOOPCOUNT
257 logics(i) = .TRUE.
258 END DO
259
260 logic_eqv = .TRUE.
261
262!$omp parallel
263<ompts:orphan>
264!$omp do
265 DO i = 1, LOOPCOUNT
266<ompts:check>
267!$omp atomic
268</ompts:check>
269 logic_eqv = logic_eqv .EQV. logics(i)
270 END DO
271!$omp end do
272</ompts:orphan>
273!$omp end parallel
274
275 IF (.NOT. logic_eqv) THEN
276 result = result + 1
277 WRITE(1,*) "Error in logic EQV part 1"
278 END IF
279
280 logic_eqv = .TRUE.
281 logics(LOOPCOUNT/2) = .FALSE.
282
283!$omp parallel
284<ompts:orphan>
285!$omp do
286 DO i=1,LOOPCOUNT
287<ompts:check>
288!$omp atomic
289</ompts:check>
290 logic_eqv = logic_eqv .EQV. logics(i)
291 END DO
292!$omp end do
293</ompts:orphan>
294!$omp end parallel
295
296 IF ( logic_eqv ) THEN
297 result = result + 1
298 WRITE(1,*) "Error in logic EQV part 2"
299 END IF
300
301!... Test logic NEQV, which is unique in Fortran
302 DO i=1, LOOPCOUNT
303 logics(i) = .FALSE.
304 END DO
305
306 logic_neqv = .FALSE.
307
308!$omp parallel
309<ompts:orphan>
310!$omp do
311 DO i = 1, LOOPCOUNT
312<ompts:check>
313!$omp atomic
314</ompts:check>
315 logic_neqv = logic_neqv .OR. logics(i)
316 END DO
317!$omp end do
318</ompts:orphan>
319!$omp end parallel
320
321 IF (logic_neqv) THEN
322 result = result + 1
323 WRITE(1,*) "Error in logic NEQV part 1"
324 END IF
325
326 logic_neqv = .FALSE.
327 logics(LOOPCOUNT/2) = .TRUE.
328
329!$omp parallel
330<ompts:orphan>
331!$omp do
332 DO i=1,LOOPCOUNT
333<ompts:check>
334!$omp atomic
335</ompts:check>
336 logic_neqv = logic_neqv .OR. logics(i)
337 END DO
338!$omp end do
339</ompts:orphan>
340!$omp end parallel
341
342 IF ( .NOT. logic_neqv ) THEN
343 result = result + 1
344 WRITE(1,*) "Error in logic NEQV part 2"
345 END IF
346
347 DO i=1, LOOPCOUNT
348 int_array(i) = 1
349 END DO
350!$omp parallel
351<ompts:orphan>
352!$omp do
353 DO i=1, LOOPCOUNT
354!... iand(I,J): Returns value resulting from boolean AND of
355!... pair of bits in each of I and J.
356<ompts:check>
357!$omp atomic
358</ompts:check>
359 bit_and = IAND(bit_and,int_array(i))
360 END DO
361!$omp end do
362</ompts:orphan>
363!$omp end parallel
364
365 IF ( bit_and .LT. 1 ) THEN
366 result = result + 1
367 WRITE(1,*) "Error in IAND part 1"
368 END If
369
370 bit_and = 1
371 int_array(LOOPCOUNT/2) = 0
372
373!$omp parallel
374<ompts:orphan>
375!$omp do
376 DO i=1, LOOPCOUNT
377<ompts:check>
378!$omp atomic
379</ompts:check>
380 bit_and = IAND ( bit_and, int_array(i) )
381 END DO
382!$omp end do
383</ompts:orphan>
384!$omp end parallel
385
386 IF( bit_and .GE. 1) THEN
387 result = result + 1
388 WRITE(1,*) "Error in IAND part 2"
389 END IF
390
391 DO i=1, LOOPCOUNT
392 int_array(i) = 0
393 END DO
394
395
396!$omp parallel
397<ompts:orphan>
398!$omp do
399 DO i=1, LOOPCOUNT
400!... Ior(I,J): Returns value resulting from boolean OR of
401!... pair of bits in each of I and J.
402<ompts:check>
403!$omp atomic
404</ompts:check>
405 bit_or = Ior(bit_or, int_array(i) )
406 END DO
407!$omp end do
408</ompts:orphan>
409!$omp end parallel
410
411 IF ( bit_or .GE. 1) THEN
412 result = result + 1
413 WRITE(1,*) "Error in Ior part 1"
414 END IF
415
416
417 bit_or = 0
418 int_array(LOOPCOUNT/2) = 1
419!$omp parallel
420<ompts:orphan>
421!$omp do
422 DO i=1, LOOPCOUNT
423<ompts:check>
424!$omp atomic
425</ompts:check>
426 bit_or = IOR(bit_or, int_array(i) )
427 END DO
428!$omp end do
429</ompts:orphan>
430!$omp end parallel
431
432 IF ( bit_or .le. 0) THEN
433 result = result + 1
434 WRITE(1,*) "Error in Ior part 2"
435 END IF
436
437 DO i=1, LOOPCOUNT
438 int_array(i) = 0
439 END DO
440
441!$omp parallel
442<ompts:orphan>
443!$omp do
444 DO i = 1, LOOPCOUNT
445<ompts:check>
446!$omp atomic
447</ompts:check>
448 exclusiv_bit_or = IEOR(exclusiv_bit_or, int_array(i))
449 END DO
450!$omp end do
451</ompts:orphan>
452!$omp end parallel
453
454 IF ( exclusiv_bit_or .GE. 1) THEN
455 result = result + 1
456 WRITE(1,*) "Error in Ieor part 1"
457 END IF
458
459 exclusiv_bit_or = 0
460 int_array(LOOPCOUNT/2) = 1
461
462!$omp parallel
463<ompts:orphan>
464!$omp do
465 DO i = 1, LOOPCOUNT
466<ompts:check>
467!$omp atomic
468</ompts:check>
469 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
470 END DO
471!$omp end do
472</ompts:orphan>
473!$omp end parallel
474
475 IF ( exclusiv_bit_or .LE. 0) THEN
476 result = result + 1
477 WRITE(1,*) "Error in Ieor part 2"
478 END IF
479
480 DO i=1,LOOPCOUNT
481 int_array(i) = 10 - i
482 END DO
483
484 min_value = 65535
485
486!$omp parallel
487<ompts:orphan>
488!$omp do
489 DO i = 1, LOOPCOUNT
490<ompts:check>
491!$omp atomic
492</ompts:check>
493 min_value = min(min_value,int_array(i) )
494 END DO
495!$omp end do
496</ompts:orphan>
497!$omp end parallel
498
499 IF ( min_value .GT. (10-LOOPCOUNT) )THEN
500 result = result + 1
501 WRITE(1,*) "Error in integer MIN"
502 END IF
503
504
505 DO i=1,LOOPCOUNT
506 int_array(i) = i
507 END DO
508
509 max_value = -32768
510
511!$omp parallel
512<ompts:orphan>
513!$omp do
514 DO i = 1, LOOPCOUNT
515<ompts:check>
516!$omp atomic
517</ompts:check>
518 max_value = max(max_value,int_array(i) )
519 END DO
520!$omp end do
521</ompts:orphan>
522!$omp end parallel
523
524 IF ( max_value .LT. LOOPCOUNT )THEN
525 result = result + 1
526 WRITE(1,*) "Error in integer MAX"
527 END IF
528
529!... test double min, max
530 DO i=1,LOOPCOUNT
531 d_array(i) = 10 - i*dt
532 END DO
533
534 dmin = 2**10
535 dt = 0.5
536
537!$omp parallel
538<ompts:orphan>
539!$omp do
540 DO i = 1, LOOPCOUNT
541<ompts:check>
542!$omp atomic
543</ompts:check>
544 dmin= MIN(dmin,d_array(i) )
545 END DO
546!$omp end do
547</ompts:orphan>
548!$omp end parallel
549
550 IF ( dmin .GT. (10-dt) )THEN
551 result = result + 1
552 WRITE(1,*) "Error in double MIN"
553 END IF
554
555
556 DO i=1,LOOPCOUNT
557 d_array(i) = i * dt
558 END DO
559
560 dmax= - (2**10)
561
562!$omp parallel
563<ompts:orphan>
564!$omp do
565 DO i = 1, LOOPCOUNT
566<ompts:check>
567!$omp atomic
568</ompts:check>
569 dmax= max(dmax,d_array(i) )
570 END DO
571!$omp end do
572</ompts:orphan>
573!$omp end parallel
574
575 IF ( dmax .LT. LOOPCOUNT*dt )THEN
576 result = result + 1
577 WRITE(1,*) "Error in double MAX"
578 END IF
579
580 IF ( result .EQ. 0 ) THEN
581 <testfunctionname></testfunctionname>= 1
582 ELSE
583 <testfunctionname></testfunctionname>= 0
584 END IF
585
586 END FUNCTION
587</ompts:testcode>
588</ompts:test>