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 teams map(to: B, C) map(tofrom: sum) &
18  !$omp& reduction(+:sum)
19    !$omp distribute parallel do reduction(+:sum)
20    do i = 1, N
21      sum = sum + B(i) * C(i)
22    end do
23  !$omp end target teams
24end function
25
26subroutine init (B, C, N)
27  real :: B(N), C(N)
28  integer :: N, i
29  do i = 1, N
30    B(i) = 0.0001 * i
31    C(i) = 0.000001 * i * i
32  end do
33end subroutine
34
35subroutine check (a, b)
36  real :: a, b, err
37  real, parameter :: EPS = 0.0001
38  if (b == 0.0) then
39    err = a
40  else if (a == 0.0) then
41    err = b
42  else
43    err = (a - b) / b
44  end if
45  if (err > EPS .or. err < -EPS) stop 1
46end subroutine
47
48program e_54_3
49  integer :: n
50  real :: ref, d
51  real, pointer, dimension(:) :: B, C
52  n = 1024 * 1024
53  allocate (B(n), C(n))
54  call init (B, C, n)
55  ref = dotprod_ref (B, C, n)
56  d = dotprod (B, C, n)
57  call check (ref, d)
58  deallocate (B, C)
59end program
60