1! { dg-do run }
2
3function dotprod_ref (B, C, N) result (sum)
4  implicit none
5  real :: B(N), C(N), sum
6  integer :: N, i
7  sum = 0.0e0
8  do i = 1, N
9    sum = sum + B(i) * C(i)
10  end do
11end function
12
13function dotprod (B, C, n) result(sum)
14  real :: B(N), C(N), sum
15  integer :: N, i
16  sum = 0.0e0
17  !$omp target map(to: B, C) map(tofrom: sum)
18    !$omp teams num_teams(8) thread_limit(16) reduction(+:sum)
19      !$omp distribute parallel do reduction(+:sum) &
20      !$omp& dist_schedule(static, 1024) schedule(static, 64)
21      do i = 1, N
22        sum = sum + B(i) * C(i)
23      end do
24    !$omp end teams
25  !$omp end target
26end function
27
28subroutine init (B, C, N)
29  real :: B(N), C(N)
30  integer :: N, i
31  do i = 1, N
32    B(i) = 0.0001 * i
33    C(i) = 0.000001 * i * i
34  end do
35end subroutine
36
37subroutine check (a, b)
38  real :: a, b, err
39  real, parameter :: EPS = 0.0001
40  if (b == 0.0) then
41    err = a
42  else if (a == 0.0) then
43    err = b
44  else
45    err = (a - b) / b
46  end if
47  if (err > EPS .or. err < -EPS) call abort
48end subroutine
49
50program e_54_4
51  integer :: n
52  real :: ref, d
53  real, pointer, dimension(:) :: B, C
54  n = 1024 * 1024
55  allocate (B(n), C(n))
56  call init (B, C, n)
57  ref = dotprod_ref (B, C, n)
58  d = dotprod (B, C, n)
59  call check (ref, d)
60  deallocate (B, C)
61end program
62