Gitiles
Code Review Sign In
gerrit-public.fairphone.software / toolchain / llvm-project / 940cd9368d0c8bc6833f2bc0fc53568d74ea516f / . / openmp / testsuite / fortran / section_reduction.f
blob: d7e70f9aa81d8b784dd43836d32a1ad7a2207183 [file] [log] [blame]
Jim Cownie18d84732014-05-10 17:02:09 +0000[diff] [blame]1<ompts:test>
2<ompts:testdescription>Test which checks the omp sections reduction directive with all its options.</ompts:testdescription>
3<ompts:ompversion>2.0</ompts:ompversion>
4<ompts:directive>omp sections reduction</ompts:directive>
5<ompts:testcode>
6 INTEGER FUNCTION <ompts:testcode:functionname>section_reduction</ompts:testcode:functionname>()
7 IMPLICIT NONE
8 INTEGER sum2, known_sum, i2
9 INTEGER known_product,int_const
10 INTEGER MAX_FACTOR
11 DOUBLE PRECISION dknown_sum,dpt
12 INTEGER result
13 INCLUDE "omp_testsuite.f"
14 PARAMETER (int_const=10,known_product=3628800)
15
16 <ompts:orphan:vars>
17 INTEGER i,dummy
18 INTEGER sum, dIFf
19 DOUBLE PRECISION dt
20 DOUBLE PRECISION dsum, ddIFf
21 INTEGER product
22 LOGICAL logics(LOOPCOUNT)
23 INTEGER int_array(LOOPCOUNT)
24 LOGICAL logic_and, logic_or, logic_eqv,logic_neqv
25 INTEGER bit_and, bit_or
26 INTEGER exclusiv_bit_or
27 INTEGER min_value, max_value
28 DOUBLE PRECISION d_array(LOOPCOUNT)
29 DOUBLE PRECISION dmin, dmax
30
31 INTEGER DOUBLE_DIGITS
32 INTEGER cut1, cut2, cut3, cut4
33 PARAMETER (DOUBLE_DIGITS=20,MAX_FACTOR=10)
34 DOUBLE PRECISION rounding_error
35 PARAMETER (rounding_error=1.E-6)
36
37 COMMON /orphvars/ i,sum,dIFf,product,dt,dsum,ddIFf,logic_and,
38 & logic_or,logic_eqv,logic_neqv,logics,int_array,bit_and,bit_or,
39 & exclusiv_bit_or,min_value,dmin,dmax,d_array,max_value
40
41 cut1 = NINT(LOOPCOUNT / 3.3)
42 cut2 = cut1 + 1
43 cut3 = cut1 * 2
44 cut4 = cut3 + 1
45
46 </ompts:orphan:vars>
47
48 dt = 1./3.
49 known_sum = (LOOPCOUNT * (LOOPCOUNT + 1)) / 2
50 product = 1
51 sum2 = 0
52 sum = 0
53 dsum = 0.
54 result =0
55 logic_and = .true.
56 logic_or = .false.
57 bit_and = 1
58 bit_or = 0
59 exclusiv_bit_or = 0
60 cut1 = NINT(LOOPCOUNT / 3.3)
61 cut2 = cut1 + 1
62 cut3 = cut1 * 2
63 cut4 = cut3 + 1
64
65!$omp parallel
66<ompts:orphan>
67!$omp sections private(i) <ompts:check>reduction(+:sum)</ompts:check>
68!$omp section
69 DO i =1, cut1
70 sum = sum + i
71 END DO
72!$omp section
73 DO i =cut2, cut3
74 sum = sum + i
75 END DO
76!$omp section
77 DO i =cut4, LOOPCOUNT
78 sum = sum + i
79 END DO
80!$omp END sections
81</ompts:orphan>
82!$omp END parallel
83
84 IF (known_sum .NE. sum) THEN
85 result = result + 1
86 WRITE(1,*) "Error in sum with integers: Result was ",
87 & sum,"instead of ", known_sum
88 END IF
89
90 dIFf = known_sum
91
92
93
94!$omp parallel
95<ompts:orphan>
96!$omp sections <ompts:check>reduction (-: dIFf)</ompts:check>
97!$omp section
98 DO i =1, cut1
99 dIFf = dIFf - i
100 END DO
101!$omp section
102 DO i =cut2, cut3
103 dIFf = dIFf - i
104 END DO
105!$omp section
106 DO i =cut4, LOOPCOUNT
107 dIFf = dIFf - i
108 END DO
109!$omp END sections
110</ompts:orphan>
111!$omp END parallel
112
113 IF ( dIFf .NE. 0 ) THEN
114 result = result + 1
115 WRITE(1,*) "Error in dIFference with integers: Result was ",
116 & sum,"instead of 0."
117 END IF
118
119!**********************************************************************!
120! Test for DOubles
121!**********************************************************************!
122 dsum = 0.
123 dpt = 1
124
125 DO i=1, DOUBLE_DIGITS
126 dpt= dpt * dt
127 END DO
128 dknown_sum = (1-dpt)/(1-dt)
129
130!$omp parallel
131<ompts:orphan>
132!$omp sections <ompts:check>reduction(+:dsum)</ompts:check>
133!$omp section
134 DO i=0,6
135 dsum = dsum + dt**i
136 END DO
137!$omp section
138 DO i=7,12
139 dsum = dsum + dt**i
140 END DO
141!$omp section
142 DO i=13,DOUBLE_DIGITS-1
143 dsum = dsum + dt**i
144 END DO
145!$omp END sections
146</ompts:orphan>
147!$omp END parallel
148
149
150 IF (dsum .NE. dknown_sum .AND.
151 & abs(dsum - dknown_sum) .GT. rounding_error ) THEN
152 result = result + 1
153 WRITE(1,*) "Error in sum with DOubles: Result was ",
154 & dsum,"instead of ",dknown_sum,"(DIFference: ",
155 & dsum - dknown_sum,")"
156 END IF
157
158 dpt = 1
159 DO i=1, DOUBLE_DIGITS
160 dpt = dpt*dt
161 END DO
162
163 ddIFf = ( 1-dpt)/(1-dt)
164!$omp parallel
165!$omp sections <ompts:check>reduction(-:ddIFf)</ompts:check>
166!$omp section
167 DO i=0, 6
168 ddIFf = ddIFf - dt**i
169 END DO
170!$omp section
171 DO i=7, 12
172 ddIFf = ddIFf - dt**i
173 END DO
174!$omp section
175 DO i=13, DOUBLE_DIGITS-1
176 ddIFf = ddIFf - dt**i
177 END DO
178!$omp END sections
179!$omp END parallel
180
181 IF ( abs(ddIFf) .GT. rounding_error ) THEN
182 result = result + 1
183 WRITE(1,*) "Error in DIFference with DOubles: Result was ",
184 & ddIFf,"instead of 0.0"
185 END IF
186
187!$omp parallel
188<ompts:orphan>
189!$omp sections <ompts:check>reduction(*:product)</ompts:check>
190!$omp section
191 DO i=1,3
192 product = product * i
193 END DO
194!$omp section
195 DO i=4,6
196 product = product * i
197 END DO
198!$omp section
199 DO i=7,10
200 product = product * i
201 END DO
202!$omp END sections
203</ompts:orphan>
204!$omp END parallel
205
206 IF (known_product .NE. product) THEN
207 result = result + 1
208 WRITE(1,*) "Error in Product with integers: Result was ",
209 & product," instead of",known_product
210 END IF
211
212 DO i=1,LOOPCOUNT
213 logics(i) = .TRUE.
214 END DO
215
216!$omp parallel
217<ompts:orphan>
218!$omp sections <ompts:check>reduction(.and.:logic_and)</ompts:check>
219!$omp section
220 DO i=1,cut1
221 logic_and = logic_and .AND. logics(i)
222 END DO
223!$omp section
224 DO i=cut2,cut3
225 logic_and = logic_and .AND. logics(i)
226 END DO
227!$omp section
228 DO i=cut4,LOOPCOUNT
229 logic_and = logic_and .AND. logics(i)
230 END DO
231!$omp END sections
232</ompts:orphan>
233!$omp END parallel
234
235 IF (.NOT. logic_and) THEN
236 result = result + 1
237 WRITE(1,*) "Error in logic AND part 1"
238 END IF
239
240
241 logic_and = .TRUE.
242 logics(LOOPCOUNT/2) = .FALSE.
243
244!$omp parallel
245<ompts:orphan>
246!$omp sections <ompts:check>reduction(.and.:logic_and)</ompts:check>
247!$omp section
248 DO i=1,cut1
249 logic_and = logic_and .AND. logics(i)
250 END DO
251!$omp section
252 DO i=cut2,cut3
253 logic_and = logic_and .AND. logics(i)
254 END DO
255!$omp section
256 DO i=cut4,LOOPCOUNT
257 logic_and = logic_and .AND. logics(i)
258 END DO
259!$omp END sections
260</ompts:orphan>
261!$omp END parallel
262
263 IF (logic_and) THEN
264 result = result + 1
265 WRITE(1,*) "Error in logic AND pass 2"
266 END IF
267
268 DO i=1, LOOPCOUNT
269 logics(i) = .FALSE.
270 END DO
271
272!$omp parallel
273<ompts:orphan>
274!$omp sections <ompts:check>reduction(.or.:logic_or)</ompts:check>
275!$omp section
276 DO i = 1, cut1
277 logic_or = logic_or .OR. logics(i)
278 END DO
279!$omp section
280 DO i = cut2, cut3
281 logic_or = logic_or .OR. logics(i)
282 END DO
283!$omp section
284 DO i = cut4, LOOPCOUNT
285 logic_or = logic_or .OR. logics(i)
286 END DO
287!$omp END sections
288</ompts:orphan>
289!$omp END parallel
290
291 IF (logic_or) THEN
292 result = result + 1
293 WRITE(1,*) "Error in logic OR part 1"
294 END IF
295
296 logic_or = .FALSE.
297 logics(LOOPCOUNT/2) = .TRUE.
298
299!$omp parallel
300<ompts:orphan>
301!$omp sections <ompts:check>reduction(.or.:logic_or)</ompts:check>
302!$omp section
303 DO i=1,cut1
304 logic_or = logic_or .OR. logics(i)
305 END DO
306!$omp section
307 DO i=cut2,cut3
308 logic_or = logic_or .OR. logics(i)
309 END DO
310!$omp section
311 DO i=cut4,LOOPCOUNT
312 logic_or = logic_or .OR. logics(i)
313 END DO
314!$omp END sections
315</ompts:orphan>
316!$omp END parallel
317
318 IF ( .NOT. logic_or ) THEN
319 result = result + 1
320 WRITE(1,*) "Error in logic OR part 2"
321 END IF
322
323!... Test logic EQV, unique in Fortran
324 DO i=1, LOOPCOUNT
325 logics(i) = .TRUE.
326 END DO
327
328 logic_eqv = .TRUE.
329
330!$omp parallel
331<ompts:orphan>
332!$omp sections <ompts:check>reduction(.eqv.:logic_eqv)</ompts:check>
333!$omp section
334 DO i = 1, cut1
335 logic_eqv = logic_eqv .EQV. logics(i)
336 END DO
337!$omp section
338 DO i = cut2, cut3
339 logic_eqv = logic_eqv .EQV. logics(i)
340 END DO
341!$omp section
342 DO i = cut4, LOOPCOUNT
343 logic_eqv = logic_eqv .EQV. logics(i)
344 END DO
345!$omp END sections
346</ompts:orphan>
347!$omp END parallel
348
349 IF (.NOT. logic_eqv) THEN
350 result = result + 1
351 WRITE(1,*) "Error in logic EQV part 1"
352 END IF
353
354 logic_eqv = .TRUE.
355 logics(LOOPCOUNT/2) = .FALSE.
356
357!$omp parallel
358<ompts:orphan>
359!$omp sections <ompts:check>reduction(.eqv.:logic_eqv)</ompts:check>
360!$omp section
361 DO i=1,cut1
362 logic_eqv = logic_eqv .EQV. logics(i)
363 END DO
364!$omp section
365 DO i=cut2,cut3
366 logic_eqv = logic_eqv .eqv. logics(i)
367 END DO
368!$omp section
369 DO i=cut4,LOOPCOUNT
370 logic_eqv = logic_eqv .eqv. logics(i)
371 END DO
372!$omp END sections
373</ompts:orphan>
374!$omp END parallel
375
376 IF ( logic_eqv ) THEN
377 result = result + 1
378 WRITE(1,*) "Error in logic EQV part 2"
379 END IF
380
381!... Test logic NEQV, which is unique in Fortran
382 DO i=1, LOOPCOUNT
383 logics(i) = .false.
384 END DO
385
386 logic_neqv = .false.
387
388!$omp parallel
389<ompts:orphan>
390!$omp sections <ompts:check>reduction(.neqv.:logic_neqv)</ompts:check>
391!$omp section
392 DO i = 1, cut1
393 logic_neqv = logic_neqv .NEQV. logics(i)
394 END DO
395!$omp section
396 DO i = cut2, cut3
397 logic_neqv = logic_neqv .NEQV. logics(i)
398 END DO
399!$omp section
400 DO i = cut4, LOOPCOUNT
401 logic_neqv = logic_neqv .NEQV. logics(i)
402 END DO
403!$omp END sections
404</ompts:orphan>
405!$omp END parallel
406
407 IF (logic_neqv) THEN
408 result = result + 1
409 WRITE(1,*) "Error in logic NEQV part 1"
410 END IF
411
412 logic_neqv = .FALSE.
413 logics(LOOPCOUNT/2) = .TRUE.
414
415!$omp parallel
416<ompts:orphan>
417!$omp sections <ompts:check>reduction(.neqv.:logic_neqv)</ompts:check>
418!$omp section
419 DO i=1,cut1
420 logic_neqv = logic_neqv .NEQV. logics(i)
421 END DO
422!$omp section
423 DO i=cut2,cut3
424 logic_neqv = logic_neqv .NEQV. logics(i)
425 END DO
426!$omp section
427 DO i=cut4,LOOPCOUNT
428 logic_neqv = logic_neqv .NEQV. logics(i)
429 END DO
430!$omp END sections
431</ompts:orphan>
432!$omp END parallel
433
434 IF ( .NOT. logic_neqv ) THEN
435 result = result + 1
436 write(1,*) "Error in logic NEQV part 2"
437 END IF
438
439 DO i=1, LOOPCOUNT
440 int_array(i) = 1
441 END DO
442
443!$omp parallel
444<ompts:orphan>
445!$omp sections <ompts:check>reduction(iand:bit_and)</ompts:check>
446!... iand(I,J): Returns value resulting from boolean AND of
447!... pair of bits in each of I and J.
448!$omp section
449 DO i=1, cut1
450 bit_and = iand(bit_and,int_array(i))
451 END DO
452!$omp section
453 DO i=cut2, cut3
454 bit_and = iand(bit_and,int_array(i))
455 END DO
456!$omp section
457 DO i=cut4, LOOPCOUNT
458 bit_and = iand(bit_and,int_array(i))
459 END DO
460!$omp END sections
461</ompts:orphan>
462!$omp END parallel
463
464 IF ( bit_and .lt. 1 ) THEN
465 result = result + 1
466 write(1,*) "Error in IAND part 1"
467 END IF
468
469 bit_and = 1
470 int_array(LOOPCOUNT/2) = 0
471
472!$omp parallel
473<ompts:orphan>
474!$omp sections <ompts:check>reduction(iand:bit_and)</ompts:check>
475!$omp section
476 DO i=1, cut1
477 bit_and = iand ( bit_and, int_array(i) )
478 END DO
479!$omp section
480 DO i=cut2, cut3
481 bit_and = iand ( bit_and, int_array(i) )
482 END DO
483!$omp section
484 DO i=cut4, LOOPCOUNT
485 bit_and = iand ( bit_and, int_array(i) )
486 END DO
487!$omp END sections
488</ompts:orphan>
489!$omp END parallel
490
491 IF( bit_and .GE. 1) THEN
492 result = result + 1
493 WRITE(1,*) "Error in IAND part 2"
494 END IF
495
496 DO i=1, LOOPCOUNT
497 int_array(i) = 0
498 END DO
499
500
501!$omp parallel
502<ompts:orphan>
503!$omp sections <ompts:check>reduction(ior:bit_or)</ompts:check>
504!... Ior(I,J): Returns value resulting from boolean OR of
505!... pair of bits in each of I and J.
506!$omp section
507 DO i=1, cut1
508 bit_or = ior(bit_or, int_array(i) )
509 END DO
510!$omp section
511 DO i=cut2, cut3
512 bit_or = ior(bit_or, int_array(i) )
513 END DO
514!$omp section
515 DO i=cut4, LOOPCOUNT
516 bit_or = ior(bit_or, int_array(i) )
517 END DO
518!$omp END sections
519</ompts:orphan>
520!$omp END parallel
521
522 IF ( bit_or .GE. 1) THEN
523 result = result + 1
524 WRITE(1,*) "Error in Ior part 1"
525 END IF
526
527
528 bit_or = 0
529 int_array(LOOPCOUNT/2) = 1
530!$omp parallel
531<ompts:orphan>
532!$omp sections <ompts:check>reduction(ior:bit_or)</ompts:check>
533!$omp section
534 DO i=1, cut1
535 bit_or = Ior(bit_or, int_array(i) )
536 END DO
537!$omp section
538 DO i=cut2, cut3
539 bit_or = Ior(bit_or, int_array(i) )
540 END DO
541!$omp section
542 DO i=cut4, LOOPCOUNT
543 bit_or = Ior(bit_or, int_array(i) )
544 END DO
545!$omp END sections
546</ompts:orphan>
547!$omp END parallel
548
549 IF ( bit_or .LE. 0) THEN
550 result = result + 1
551 WRITE(1,*) "Error in Ior part 2"
552 END IF
553
554 DO i=1, LOOPCOUNT
555 int_array(i) = 0
556 END DO
557
558!$omp parallel
559<ompts:orphan>
560!$omp sections <ompts:check>reduction(ieor:exclusiv_bit_or)</ompts:check>
561!$omp section
562 DO i = 1, cut1
563 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
564 END DO
565!$omp section
566 DO i = cut2, cut3
567 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
568 END DO
569!$omp section
570 DO i = cut4, LOOPCOUNT
571 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
572 END DO
573!$omp END sections
574</ompts:orphan>
575!$omp END parallel
576
577 IF ( exclusiv_bit_or .GE. 1) THEN
578 result = result + 1
579 WRITE(1,*) "Error in Ieor part 1"
580 END IF
581
582 exclusiv_bit_or = 0
583 int_array(LOOPCOUNT/2) = 1
584
585!$omp parallel
586<ompts:orphan>
587!$omp sections <ompts:check>reduction(ieor:exclusiv_bit_or)</ompts:check>
588!$omp section
589 DO i = 1, cut1
590 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
591 END DO
592!$omp section
593 DO i = cut2, cut3
594 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
595 END DO
596!$omp section
597 DO i = cut4, LOOPCOUNT
598 exclusiv_bit_or = ieor(exclusiv_bit_or, int_array(i))
599 END DO
600!$omp END sections
601</ompts:orphan>
602!$omp END parallel
603
604 IF ( exclusiv_bit_or .LE. 0) THEN
605 result = result + 1
606 WRITE(1,*) "Error in Ieor part 2"
607 END IF
608
609 DO i=1,LOOPCOUNT
610 int_array(i) = 10 - i
611 END DO
612
613 min_value = 65535
614
615!$omp parallel
616<ompts:orphan>
617!$omp sections <ompts:check>reduction(min:min_value)</ompts:check>
618!$omp section
619 DO i = 1, cut1
620 min_value = min(min_value,int_array(i) )
621 END DO
622!$omp section
623 DO i = cut2, cut3
624 min_value = min(min_value,int_array(i) )
625 END DO
626!$omp section
627 DO i = cut4, LOOPCOUNT
628 min_value = min(min_value,int_array(i) )
629 END DO
630!$omp END sections
631</ompts:orphan>
632!$omp END parallel
633
634 IF ( min_value .GT. (10-LOOPCOUNT) ) THEN
635 result = result + 1
636 WRITE(1,*) "Error in integer MIN"
637 END IF
638
639
640 DO i=1,LOOPCOUNT
641 int_array(i) = i
642 END DO
643
644 max_value = -32768
645
646!$omp parallel
647<ompts:orphan>
648!$omp sections <ompts:check>reduction(max:max_value)</ompts:check>
649!$omp section
650 DO i = 1, cut1
651 max_value = max(max_value,int_array(i) )
652 END DO
653!$omp section
654 DO i = cut2, cut3
655 max_value = max(max_value,int_array(i) )
656 END DO
657!$omp section
658 DO i = cut4, LOOPCOUNT
659 max_value = max(max_value,int_array(i) )
660 END DO
661!$omp END sections
662</ompts:orphan>
663!$omp END parallel
664
665 IF ( max_value .LT. LOOPCOUNT ) THEN
666 result = result + 1
667 WRITE(1,*) "Error in integer MAX"
668 END IF
669
670!... test DOuble min, max
671 DO i=1,LOOPCOUNT
672 d_array(i) = 10 - i*dt
673 END DO
674
675 dmin = 2**10
676 dt = 0.5
677
678!$omp parallel
679<ompts:orphan>
680!$omp sections <ompts:check>reduction(min:dmin)</ompts:check>
681!$omp section
682 DO i = 1, cut1
683 dmin= min(dmin,d_array(i) )
684 END DO
685!$omp section
686 DO i = cut2, cut3
687 dmin= min(dmin,d_array(i) )
688 END DO
689!$omp section
690 DO i = cut4, LOOPCOUNT
691 dmin= min(dmin,d_array(i) )
692 END DO
693!$omp END sections
694</ompts:orphan>
695!$omp END parallel
696
697 IF ( dmin .GT. (10-dt) ) THEN
698 result = result + 1
699 WRITE(1,*) "Error in DOuble MIN"
700 END IF
701
702
703 DO i=1,LOOPCOUNT
704 d_array(i) = i * dt
705 END DO
706
707 dmax= - (2**10)
708
709!$omp parallel
710<ompts:orphan>
711!$omp sections <ompts:check>reduction(max:dmax)</ompts:check>
712!$omp section
713 DO i = 1, cut1
714 dmax= max(dmax,d_array(i) )
715 END DO
716!$omp section
717 DO i = cut2, cut3
718 dmax= max(dmax,d_array(i) )
719 END DO
720!$omp section
721 DO i = cut4, LOOPCOUNT
722 dmax= max(dmax,d_array(i) )
723 END DO
724!$omp END sections
725</ompts:orphan>
726!$omp END parallel
727
728 IF ( dmax .LT. LOOPCOUNT*dt ) THEN
729 result = result + 1
730 WRITE(1,*) "Error in DOuble MAX"
731 END IF
732
733 IF ( result .EQ. 0 ) THEN
734 <testfunctionname></testfunctionname> = 1
735 ELSE
736 <testfunctionname></testfunctionname> = 0
737 END IF
738
739 CLOSE(2)
740
741 END FUNCTION
742</ompts:testcode>
743</ompts:test>