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