! { dg-do run } function dotprod_ref (B, C, N) result (sum) implicit none real :: B(N), C(N), sum integer :: N, i sum = 0.0e0 do i = 1, N sum = sum + B(i) * C(i) end do end function function dotprod (B, C, N) result(sum) real :: B(N), C(N), sum integer :: N, i sum = 0.0e0 !$omp target teams map(to: B, C) map(tofrom: sum) & !$omp& reduction(+:sum) !$omp distribute parallel do reduction(+:sum) do i = 1, N sum = sum + B(i) * C(i) end do !$omp end target teams end function subroutine init (B, C, N) real :: B(N), C(N) integer :: N, i do i = 1, N B(i) = 0.0001 * i C(i) = 0.000001 * i * i end do end subroutine subroutine check (a, b) real :: a, b, err real, parameter :: EPS = 0.0001 if (b == 0.0) then err = a else if (a == 0.0) then err = b else err = (a - b) / b end if if (err > EPS .or. err < -EPS) stop 1 end subroutine program e_54_3 integer :: n real :: ref, d real, pointer, dimension(:) :: B, C n = 1024 * 1024 allocate (B(n), C(n)) call init (B, C, n) ref = dotprod_ref (B, C, n) d = dotprod (B, C, n) call check (ref, d) deallocate (B, C) end program