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