! { 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, block_size, num_teams, block_threads) result (sum) implicit none real :: B(N), C(N), sum integer :: N, block_size, num_teams, block_threads, i, i0 sum = 0.0e0 !$omp target map(to: B, C, block_size, num_teams, block_threads) & !$omp& map(tofrom: sum) !$omp teams num_teams(num_teams) thread_limit(block_threads) & !$omp& reduction(+:sum) !$omp distribute do i0 = 1, N, block_size !$omp parallel do reduction(+:sum) do i = i0, min (i0 + block_size - 1, N) sum = sum + B(i) * C(i) end do end do !$omp end teams !$omp end target 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_1 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, n / 8, 2, 8) call check (ref, d) deallocate (B, C) end program