deep-copy-6.f90 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576
  1. ! { dg-do run }
  2. ! Test of attachment counters and finalize.
  3. program dtype
  4. use openacc
  5. implicit none
  6. integer, parameter :: n = 512
  7. type mytype
  8. integer, allocatable :: a(:)
  9. integer, allocatable :: b(:)
  10. end type mytype
  11. integer i
  12. type(mytype), target :: var
  13. integer, pointer :: hostptr(:)
  14. allocate(var%a(1:n))
  15. allocate(var%b(1:n))
  16. hostptr => var%a
  17. !$acc data copy(var)
  18. do i = 1, n
  19. var%a(i) = 0
  20. var%b(i) = 0
  21. end do
  22. !$acc enter data copyin(var%a(5:n - 5), var%b(5:n - 5))
  23. do i = 1,20
  24. !$acc enter data attach(var%a)
  25. end do
  26. !$acc parallel loop
  27. do i = 5,n - 5
  28. var%a(i) = i
  29. var%b(i) = i * 2
  30. end do
  31. !$acc end parallel loop
  32. if (.not. acc_is_present(var%a(5:n - 5))) stop 11
  33. if (.not. acc_is_present(var%b(5:n - 5))) stop 12
  34. if (.not. acc_is_present(var)) stop 13
  35. !$acc exit data copyout(var%a(5:n - 5), var%b(5:n - 5)) finalize
  36. if (acc_get_device_type() .ne. acc_device_host) then
  37. if (acc_is_present(var%a(5:n - 5))) stop 21
  38. if (acc_is_present(var%b(5:n - 5))) stop 22
  39. end if
  40. if (.not. acc_is_present(var)) stop 23
  41. !$acc end data
  42. ! See 'deep-copy-6-no_finalize.F90'.
  43. if (.not. associated(hostptr, var%a)) stop 30
  44. do i = 1,4
  45. if (var%a(i) .ne. 0) stop 1
  46. if (var%b(i) .ne. 0) stop 2
  47. end do
  48. do i = 5,n - 5
  49. if (i .ne. var%a(i)) stop 3
  50. if (i * 2 .ne. var%b(i)) stop 4
  51. end do
  52. do i = n - 4,n
  53. if (var%a(i) .ne. 0) stop 5
  54. if (var%b(i) .ne. 0) stop 6
  55. end do
  56. deallocate(var%a)
  57. deallocate(var%b)
  58. end program dtype