e.55.1.f90 1.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  1. ! { dg-do run }
  2. module e_55_1_mod
  3. integer, parameter :: N = 100000, CHUNKSZ = 10000
  4. real :: Y(N), Z(N)
  5. end module
  6. subroutine init ()
  7. use e_55_1_mod, only : Y, Z, N
  8. integer :: i
  9. do i = 1, N
  10. Y(i) = 0.1 * i
  11. Z(i) = Y(i)
  12. end do
  13. end subroutine
  14. subroutine check ()
  15. use e_55_1_mod, only : Y, Z, N
  16. real :: err
  17. real, parameter :: EPS = 0.00001
  18. integer :: i
  19. do i = 1, N
  20. if (Y(i) == 0.0) then
  21. err = Z(i)
  22. else if (Z(i) == 0.0) then
  23. err = Y(i)
  24. else
  25. err = (Y(i) - Z(i)) / Z(i)
  26. end if
  27. if (err > EPS .or. err < -EPS) call abort
  28. end do
  29. end subroutine
  30. real function F (z)
  31. !$omp declare target
  32. real, intent(in) :: z
  33. F = -z
  34. end function
  35. subroutine pipedF ()
  36. use e_55_1_mod, only: Z, N, CHUNKSZ
  37. integer :: C, i
  38. real :: F
  39. do C = 1, N, CHUNKSZ
  40. !$omp task
  41. !$omp target map(Z(C:C+CHUNKSZ-1))
  42. !$omp parallel do
  43. do i = C, C+CHUNKSZ-1
  44. Z(i) = F (Z(i))
  45. end do
  46. !$omp end target
  47. !$omp end task
  48. end do
  49. end subroutine
  50. subroutine pipedF_ref ()
  51. use e_55_1_mod, only: Y, N
  52. integer :: i
  53. real :: F
  54. do i = 1, N
  55. Y(i) = F (Y(i))
  56. end do
  57. end subroutine
  58. program e_55_1
  59. call init ()
  60. call pipedF ()
  61. call pipedF_ref ()
  62. call check ()
  63. end program