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
5
6program main
7    use, intrinsic :: iso_fortran_env
8    implicit none
9
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
15
16    allocate (edof(ne))
17    edof(1::4) = 1
18    edof(2::4) = 2
19    edof(3::4) = 3
20    edof(4::4) = 4
21
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
31
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
37
38contains
39
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
44
45        ttt = 0
46
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
58
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
64
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
71
72end program main
73