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