Fix build on sparc64-linux-gnu.
[official-gcc.git] / libgomp / testsuite / libgomp.fortran / do_concurrent_5.f90
blob6fb9d1e8d964ec245ffc954d6134ab268522148a
1 ! { dg-do run }
2 ! PR 83064 - this used to give wrong results.
3 ! { dg-additional-options "-O1 -ftree-parallelize-loops=2" }
4 ! Original test case by Christian Felter
6 program main
7 use, intrinsic :: iso_fortran_env
8 implicit none
10 integer, parameter :: nsplit = 4
11 integer(int64), parameter :: ne = 2**20
12 integer(int64) :: stride, low(nsplit), high(nsplit), i
13 real(real64), dimension(nsplit) :: pi
14 integer(int64), dimension(:), allocatable :: edof
16 allocate (edof(ne))
17 edof(1::4) = 1
18 edof(2::4) = 2
19 edof(3::4) = 3
20 edof(4::4) = 4
22 stride = ceiling(real(ne)/nsplit)
23 do i = 1, nsplit
24 high(i) = stride*i
25 end do
26 do i = 2, nsplit
27 low(i) = high(i-1) + 1
28 end do
29 low(1) = 1
30 high(nsplit) = ne
32 pi = 0
33 do concurrent (i = 1:nsplit)
34 pi(i) = sum(compute( low(i), high(i) ))
35 end do
36 if (abs (sum(pi) - atan(1.0d0)) > 1e-5) STOP 1
38 contains
40 pure function compute( low, high ) result( ttt )
41 integer(int64), intent(in) :: low, high
42 real(real64), dimension(nsplit) :: ttt
43 integer(int64) :: j, k
45 ttt = 0
47 ! Unrolled loop
48 ! do j = low, high, 4
49 ! k = 1
50 ! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 )
51 ! k = 2
52 ! ttt(k) = ttt(k) + (-1)**(j+2) / real( 2*j+1 )
53 ! k = 3
54 ! ttt(k) = ttt(k) + (-1)**(j+3) / real( 2*j+3 )
55 ! k = 4
56 ! ttt(k) = ttt(k) + (-1)**(j+4) / real( 2*j+5 )
57 ! end do
59 ! Loop with modulo operation
60 ! do j = low, high
61 ! k = mod( j, nsplit ) + 1
62 ! ttt(k) = ttt(k) + (-1)**(j+1) / real( 2*j-1 )
63 ! end do
65 ! Loop with subscripting via host association
66 do j = low, high
67 k = edof(j)
68 ttt(k) = ttt(k) + (-1.0_real64)**(j+1) / real( 2*j-1 )
69 end do
70 end function
72 end program main