gcc/testsuite/gfortran.dg/do_concurrent_5.f90

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