lib-10.f90 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. ! { dg-do run }
  2. program main
  3. implicit none
  4. include "openacc_lib.h"
  5. integer, target :: a_3d_i(10, 10, 10)
  6. complex a_3d_c(10, 10, 10)
  7. real a_3d_r(10, 10, 10)
  8. integer i, j, k
  9. complex c
  10. real r
  11. integer, parameter :: i_size = sizeof (i)
  12. integer, parameter :: c_size = sizeof (c)
  13. integer, parameter :: r_size = sizeof (r)
  14. call acc_init (acc_device_default)
  15. call set3d (.FALSE., a_3d_i, a_3d_c, a_3d_r)
  16. call acc_copyin (a_3d_i)
  17. call acc_copyin (a_3d_c)
  18. call acc_copyin (a_3d_r)
  19. if (acc_is_present (a_3d_i) .neqv. .TRUE.) STOP 1
  20. if (acc_is_present (a_3d_c) .neqv. .TRUE.) STOP 2
  21. if (acc_is_present (a_3d_r) .neqv. .TRUE.) STOP 3
  22. do i = 1, 10
  23. do j = 1, 10
  24. do k = 1, 10
  25. if (acc_is_present (a_3d_i(i, j, k), i_size) .neqv. .TRUE.) STOP 4
  26. if (acc_is_present (a_3d_c(i, j, k), i_size) .neqv. .TRUE.) STOP 5
  27. if (acc_is_present (a_3d_r(i, j, k), i_size) .neqv. .TRUE.) STOP 6
  28. end do
  29. end do
  30. end do
  31. contains
  32. subroutine set3d (clear, a_i, a_c, a_r)
  33. logical clear
  34. integer, dimension (:,:,:), intent (inout) :: a_i
  35. complex, dimension (:,:,:), intent (inout) :: a_c
  36. real, dimension (:,:,:), intent (inout) :: a_r
  37. integer i, j, k
  38. integer lb1, ub1, lb2, ub2, lb3, ub3
  39. lb1 = lbound (a_i, 1)
  40. ub1 = ubound (a_i, 1)
  41. lb2 = lbound (a_i, 2)
  42. ub2 = ubound (a_i, 2)
  43. lb3 = lbound (a_i, 3)
  44. ub3 = ubound (a_i, 3)
  45. do i = lb1, ub1
  46. do j = lb2, ub2
  47. do k = lb3, ub3
  48. if (clear) then
  49. a_i(i, j, k) = 0
  50. a_c(i, j, k) = cmplx (0.0, 0.0)
  51. a_r(i, j, k) = 0.0
  52. else
  53. a_i(i, j, k) = i
  54. a_c(i, j, k) = cmplx (i, j)
  55. a_r(i, j, k) = i
  56. end if
  57. end do
  58. end do
  59. end do
  60. end subroutine
  61. end program