update-2.f90 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284
  1. ! Test ACC UPDATE with derived types.
  2. ! { dg-do run }
  3. module dt
  4. integer, parameter :: n = 10
  5. type inner
  6. integer :: d(n)
  7. end type inner
  8. type mytype
  9. integer(8) :: a, b, c(n)
  10. type(inner) :: in
  11. end type mytype
  12. end module dt
  13. program derived_acc
  14. use dt
  15. implicit none
  16. integer i, res
  17. type(mytype) :: var
  18. var%a = 0
  19. var%b = 1
  20. var%c(:) = 10
  21. var%in%d(:) = 100
  22. var%c(:) = 10
  23. !$acc enter data copyin(var)
  24. !$acc parallel loop present(var)
  25. do i = 1, 1
  26. var%a = var%b
  27. end do
  28. !$acc end parallel loop
  29. !$acc update host(var%a)
  30. if (var%a /= var%b) stop 1
  31. var%b = 100
  32. !$acc update device(var%b)
  33. !$acc parallel loop present(var)
  34. do i = 1, 1
  35. var%a = var%b
  36. end do
  37. !$acc end parallel loop
  38. !$acc update host(var%a)
  39. if (var%a /= var%b) stop 2
  40. !$acc parallel loop present (var)
  41. do i = 1, n
  42. var%c(i) = i
  43. end do
  44. !$acc end parallel loop
  45. !$acc update host(var%c)
  46. var%a = -1
  47. do i = 1, n
  48. if (var%c(i) /= i) stop 3
  49. var%c(i) = var%a
  50. end do
  51. !$acc update device(var%a)
  52. !$acc update device(var%c)
  53. res = 0
  54. !$acc parallel loop present(var) reduction(+:res)
  55. do i = 1, n
  56. if (var%c(i) /= var%a) res = res + 1
  57. end do
  58. if (res /= 0) stop 4
  59. var%c(:) = 0
  60. !$acc update device(var%c)
  61. !$acc parallel loop present(var)
  62. do i = 5, 5
  63. var%c(i) = 1
  64. end do
  65. !$acc end parallel loop
  66. !$acc update host(var%c(5))
  67. do i = 1, n
  68. if (i /= 5 .and. var%c(i) /= 0) stop 5
  69. if (i == 5 .and. var%c(i) /= 1) stop 6
  70. end do
  71. !$acc parallel loop present(var)
  72. do i = 1, n
  73. var%in%d = var%a
  74. end do
  75. !$acc end parallel loop
  76. !$acc update host(var%in%d)
  77. do i = 1, n
  78. if (var%in%d(i) /= var%a) stop 7
  79. end do
  80. var%c(:) = 0
  81. !$acc update device(var%c)
  82. var%c(:) = -1
  83. !$acc parallel loop present(var)
  84. do i = n/2, n
  85. var%c(i) = i
  86. end do
  87. !$acc end parallel loop
  88. !$acc update host(var%c(n/2:n))
  89. do i = 1,n
  90. if (i < n/2 .and. var%c(i) /= -1) stop 8
  91. if (i >= n/2 .and. var%c(i) /= i) stop 9
  92. end do
  93. var%in%d(:) = 0
  94. !$acc update device(var%in%d)
  95. !$acc parallel loop present(var)
  96. do i = 5, 5
  97. var%in%d(i) = 1
  98. end do
  99. !$acc end parallel loop
  100. !$acc update host(var%in%d(5))
  101. do i = 1, n
  102. if (i /= 5 .and. var%in%d(i) /= 0) stop 10
  103. if (i == 5 .and. var%in%d(i) /= 1) stop 11
  104. end do
  105. !$acc exit data delete(var)
  106. call derived_acc_subroutine(var)
  107. end program derived_acc
  108. subroutine derived_acc_subroutine(var)
  109. use dt
  110. implicit none
  111. integer i, res
  112. type(mytype) :: var
  113. var%a = 0
  114. var%b = 1
  115. var%c(:) = 10
  116. var%in%d(:) = 100
  117. var%c(:) = 10
  118. !$acc enter data copyin(var)
  119. !$acc parallel loop present(var)
  120. do i = 1, 1
  121. var%a = var%b
  122. end do
  123. !$acc end parallel loop
  124. !$acc update host(var%a)
  125. if (var%a /= var%b) stop 12
  126. var%b = 100
  127. !$acc update device(var%b)
  128. !$acc parallel loop present(var)
  129. do i = 1, 1
  130. var%a = var%b
  131. end do
  132. !$acc end parallel loop
  133. !$acc update host(var%a)
  134. if (var%a /= var%b) stop 13
  135. !$acc parallel loop present (var)
  136. do i = 1, n
  137. var%c(i) = i
  138. end do
  139. !$acc end parallel loop
  140. !$acc update host(var%c)
  141. var%a = -1
  142. do i = 1, n
  143. if (var%c(i) /= i) stop 14
  144. var%c(i) = var%a
  145. end do
  146. !$acc update device(var%a)
  147. !$acc update device(var%c)
  148. res = 0
  149. !$acc parallel loop present(var) reduction(+:res)
  150. do i = 1, n
  151. if (var%c(i) /= var%a) res = res + 1
  152. end do
  153. if (res /= 0) stop 15
  154. var%c(:) = 0
  155. !$acc update device(var%c)
  156. !$acc parallel loop present(var)
  157. do i = 5, 5
  158. var%c(i) = 1
  159. end do
  160. !$acc end parallel loop
  161. !$acc update host(var%c(5))
  162. do i = 1, n
  163. if (i /= 5 .and. var%c(i) /= 0) stop 16
  164. if (i == 5 .and. var%c(i) /= 1) stop 17
  165. end do
  166. !$acc parallel loop present(var)
  167. do i = 1, n
  168. var%in%d = var%a
  169. end do
  170. !$acc end parallel loop
  171. !$acc update host(var%in%d)
  172. do i = 1, n
  173. if (var%in%d(i) /= var%a) stop 18
  174. end do
  175. var%c(:) = 0
  176. !$acc update device(var%c)
  177. var%c(:) = -1
  178. !$acc parallel loop present(var)
  179. do i = n/2, n
  180. var%c(i) = i
  181. end do
  182. !$acc end parallel loop
  183. !$acc update host(var%c(n/2:n))
  184. do i = 1,n
  185. if (i < n/2 .and. var%c(i) /= -1) stop 19
  186. if (i >= n/2 .and. var%c(i) /= i) stop 20
  187. end do
  188. var%in%d(:) = 0
  189. !$acc update device(var%in%d)
  190. !$acc parallel loop present(var)
  191. do i = 5, 5
  192. var%in%d(i) = 1
  193. end do
  194. !$acc end parallel loop
  195. !$acc update host(var%in%d(5))
  196. do i = 1, n
  197. if (i /= 5 .and. var%in%d(i) /= 0) stop 21
  198. if (i == 5 .and. var%in%d(i) /= 1) stop 22
  199. end do
  200. !$acc exit data delete(var)
  201. end subroutine derived_acc_subroutine