e.51.6.f90 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
  1. ! { dg-do run }
  2. ! { dg-require-effective-target offload_device }
  3. module e_51_6_mod
  4. integer, parameter :: THRESHOLD = 500
  5. contains
  6. subroutine init (v1, v2, N)
  7. integer :: i, N
  8. real :: v1(N), v2(N)
  9. do i = 1, N
  10. v1(i) = i + 2.0
  11. v2(i) = i - 3.0
  12. end do
  13. end subroutine
  14. subroutine init_again (v1, v2, N)
  15. integer :: i, N
  16. real :: v1(N), v2(N)
  17. do i = 1, N
  18. v1(i) = i - 3.0
  19. v2(i) = i + 2.0
  20. end do
  21. end subroutine
  22. subroutine check (p, N)
  23. integer :: i, N
  24. real, parameter :: EPS = 0.00001
  25. real :: diff, p(N)
  26. do i = 1, N
  27. diff = p(i) - 2 * (i + 2.0) * (i - 3.0)
  28. if (diff > EPS .or. -diff > EPS) call abort
  29. end do
  30. end subroutine
  31. subroutine vec_mult (N)
  32. use omp_lib, only: omp_is_initial_device
  33. real :: p(N), v1(N), v2(N)
  34. integer :: i, N
  35. call init (v1, v2, N)
  36. !$omp target data if(N > THRESHOLD) map(from: p)
  37. !$omp target if(N > THRESHOLD) map(to: v1, v2)
  38. if (omp_is_initial_device ()) call abort
  39. !$omp parallel do
  40. do i = 1, N
  41. p(i) = v1(i) * v2(i)
  42. end do
  43. !$omp end target
  44. call init_again (v1, v2, N)
  45. !$omp target if(N > THRESHOLD) map(to: v1, v2)
  46. if (omp_is_initial_device ()) call abort
  47. !$omp parallel do
  48. do i = 1, N
  49. p(i) = p(i) + v1(i) * v2(i)
  50. end do
  51. !$omp end target
  52. !$omp end target data
  53. call check (p, N)
  54. end subroutine
  55. end module
  56. program e_51_6
  57. use e_51_6_mod, only : vec_mult
  58. integer :: n
  59. n = 1000
  60. call vec_mult (n)
  61. end program