libgomp/testsuite/libgomp.oacc-fortran/update-2.f90

   1 ! Test ACC UPDATE with derived types.
   2
   3 ! { dg-do run }
   4
   5 module dt
   6   integer, parameter :: n = 10
   7   type inner
   8      integer :: d(n)
   9   end type inner
  10   type mytype
  11      integer(8) :: a, b, c(n)
  12      type(inner) :: in
  13   end type mytype
  14 end module dt
  15
  16 program derived_acc
  17   use dt
  18
  19   implicit none
  20   integer i, res
  21   type(mytype) :: var
  22
  23   var%a = 0
  24   var%b = 1
  25   var%c(:) = 10
  26   var%in%d(:) = 100
  27
  28   var%c(:) = 10
  29
  30   !$acc enter data copyin(var)
  31
  32   !$acc parallel loop present(var)
  33   do i = 1, 1
  34      var%a = var%b
  35   end do
  36   !$acc end parallel loop
  37
  38   !$acc update host(var%a)
  39
  40   if (var%a /= var%b) stop 1
  41
  42   var%b = 100
  43
  44   !$acc update device(var%b)
  45
  46   !$acc parallel loop present(var)
  47   do i = 1, 1
  48      var%a = var%b
  49   end do
  50   !$acc end parallel loop
  51
  52   !$acc update host(var%a)
  53
  54   if (var%a /= var%b) stop 2
  55
  56   !$acc parallel loop present (var)
  57   do i = 1, n
  58      var%c(i) = i
  59   end do
  60   !$acc end parallel loop
  61
  62   !$acc update host(var%c)
  63
  64   var%a = -1
  65
  66   do i = 1, n
  67      if (var%c(i) /= i) stop 3
  68      var%c(i) = var%a
  69   end do
  70
  71   !$acc update device(var%a)
  72   !$acc update device(var%c)
  73
  74   res = 0
  75
  76   !$acc parallel loop present(var) reduction(+:res)
  77   do i = 1, n
  78      if (var%c(i) /= var%a) res = res + 1
  79   end do
  80
  81   if (res /= 0) stop 4
  82
  83   var%c(:) = 0
  84
  85   !$acc update device(var%c)
  86
  87   !$acc parallel loop present(var)
  88   do i = 5, 5
  89      var%c(i) = 1
  90   end do
  91   !$acc end parallel loop
  92
  93   !$acc update host(var%c(5))
  94
  95   do i = 1, n
  96      if (i /= 5 .and. var%c(i) /= 0) stop 5
  97      if (i == 5 .and. var%c(i) /= 1) stop 6
  98   end do
  99
 100   !$acc parallel loop present(var)
 101   do i = 1, n
 102      var%in%d = var%a
 103   end do
 104   !$acc end parallel loop
 105
 106   !$acc update host(var%in%d)
 107
 108   do i = 1, n
 109      if (var%in%d(i) /= var%a) stop 7
 110   end do
 111
 112   var%c(:) = 0
 113
 114   !$acc update device(var%c)
 115
 116   var%c(:) = -1
 117
 118   !$acc parallel loop present(var)
 119   do i = n/2, n
 120      var%c(i) = i
 121   end do
 122   !$acc end parallel loop
 123
 124   !$acc update host(var%c(n/2:n))
 125
 126   do i = 1,n
 127      if (i < n/2 .and. var%c(i) /= -1) stop 8
 128      if (i >= n/2 .and. var%c(i) /= i) stop 9
 129   end do
 130
 131   var%in%d(:) = 0
 132   !$acc update device(var%in%d)
 133
 134   !$acc parallel loop present(var)
 135   do i = 5, 5
 136      var%in%d(i) = 1
 137   end do
 138   !$acc end parallel loop
 139
 140   !$acc update host(var%in%d(5))
 141
 142   do i = 1, n
 143      if (i /= 5 .and. var%in%d(i) /= 0) stop 10
 144      if (i == 5 .and. var%in%d(i) /= 1) stop 11
 145   end do
 146
 147   !$acc exit data delete(var)
 148
 149   call derived_acc_subroutine(var)
 150 end program derived_acc
 151
 152 subroutine derived_acc_subroutine(var)
 153   use dt
 154
 155   implicit none
 156   integer i, res
 157   type(mytype) :: var
 158
 159   var%a = 0
 160   var%b = 1
 161   var%c(:) = 10
 162   var%in%d(:) = 100
 163
 164   var%c(:) = 10
 165
 166   !$acc enter data copyin(var)
 167
 168   !$acc parallel loop present(var)
 169   do i = 1, 1
 170      var%a = var%b
 171   end do
 172   !$acc end parallel loop
 173
 174   !$acc update host(var%a)
 175
 176   if (var%a /= var%b) stop 12
 177
 178   var%b = 100
 179
 180   !$acc update device(var%b)
 181
 182   !$acc parallel loop present(var)
 183   do i = 1, 1
 184      var%a = var%b
 185   end do
 186   !$acc end parallel loop
 187
 188   !$acc update host(var%a)
 189
 190   if (var%a /= var%b) stop 13
 191
 192   !$acc parallel loop present (var)
 193   do i = 1, n
 194      var%c(i) = i
 195   end do
 196   !$acc end parallel loop
 197
 198   !$acc update host(var%c)
 199
 200   var%a = -1
 201
 202   do i = 1, n
 203      if (var%c(i) /= i) stop 14
 204      var%c(i) = var%a
 205   end do
 206
 207   !$acc update device(var%a)
 208   !$acc update device(var%c)
 209
 210   res = 0
 211
 212   !$acc parallel loop present(var) reduction(+:res)
 213   do i = 1, n
 214      if (var%c(i) /= var%a) res = res + 1
 215   end do
 216
 217   if (res /= 0) stop 15
 218
 219   var%c(:) = 0
 220
 221   !$acc update device(var%c)
 222
 223   !$acc parallel loop present(var)
 224   do i = 5, 5
 225      var%c(i) = 1
 226   end do
 227   !$acc end parallel loop
 228
 229   !$acc update host(var%c(5))
 230
 231   do i = 1, n
 232      if (i /= 5 .and. var%c(i) /= 0) stop 16
 233      if (i == 5 .and. var%c(i) /= 1) stop 17
 234   end do
 235
 236   !$acc parallel loop present(var)
 237   do i = 1, n
 238      var%in%d = var%a
 239   end do
 240   !$acc end parallel loop
 241
 242   !$acc update host(var%in%d)
 243
 244   do i = 1, n
 245      if (var%in%d(i) /= var%a) stop 18
 246   end do
 247
 248   var%c(:) = 0
 249
 250   !$acc update device(var%c)
 251
 252   var%c(:) = -1
 253
 254   !$acc parallel loop present(var)
 255   do i = n/2, n
 256      var%c(i) = i
 257   end do
 258   !$acc end parallel loop
 259
 260   !$acc update host(var%c(n/2:n))
 261
 262   do i = 1,n
 263      if (i < n/2 .and. var%c(i) /= -1) stop 19
 264      if (i >= n/2 .and. var%c(i) /= i) stop 20
 265   end do
 266
 267   var%in%d(:) = 0
 268   !$acc update device(var%in%d)
 269
 270   !$acc parallel loop present(var)
 271   do i = 5, 5
 272      var%in%d(i) = 1
 273   end do
 274   !$acc end parallel loop
 275
 276   !$acc update host(var%in%d(5))
 277
 278   do i = 1, n
 279      if (i /= 5 .and. var%in%d(i) /= 0) stop 21
 280      if (i == 5 .and. var%in%d(i) /= 1) stop 22
 281   end do
 282
 283   !$acc exit data delete(var)
 284 end subroutine derived_acc_subroutine