blob: f4d95853acc22befcacf9db4d93b659ab0b272e6 [file] [log] [blame]
 ! { 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