libgomp/testsuite/libgomp.fortran/use_device_ptr-1.f90

   1 ! { dg-do run }
   2
   3 module target_procs
   4   use iso_c_binding
   5   implicit none (type, external)
   6   private
   7   public :: copy3_array, copy3_scalar, copy3_array1, copy3_array3
   8 contains
   9   subroutine copy3_array_int(from_ptr, to_ptr, N)
  10     !$omp declare target
  11     real(c_double) :: from_ptr(:)
  12     real(c_double) :: to_ptr(:)
  13     integer, value :: N
  14     integer :: i
  15
  16     !$omp parallel do
  17     do i = 1, N
  18       to_ptr(i) = 3 * from_ptr(i)
  19     end do
  20     !$omp end parallel do
  21   end subroutine copy3_array_int
  22
  23   subroutine copy3_scalar_int(from, to)
  24     !$omp declare target
  25     real(c_double) :: from, to
  26
  27     to = 3 * from
  28   end subroutine copy3_scalar_int
  29
  30
  31   subroutine copy3_array(from, to, N)
  32     type(c_ptr), value :: from, to
  33     integer, value :: N
  34     real(c_double), pointer :: from_ptr(:), to_ptr(:)
  35
  36     call c_f_pointer(from, from_ptr, shape=[N])
  37     call c_f_pointer(to, to_ptr, shape=[N])
  38
  39     call do_offload_scalar(from_ptr,to_ptr)
  40   contains
  41     subroutine do_offload_scalar(from_r, to_r)
  42       real(c_double), target :: from_r(:), to_r(:)
  43       ! The extra function is needed as is_device_ptr
  44       ! requires non-value, non-pointer dummy arguments
  45
  46       !$omp target is_device_ptr(from_r, to_r)
  47       call copy3_array_int(from_r, to_r, N)
  48       !$omp end target
  49     end subroutine do_offload_scalar
  50   end subroutine copy3_array
  51
  52   subroutine copy3_scalar(from, to)
  53     type(c_ptr), value, target :: from, to
  54     real(c_double), pointer :: from_ptr(:), to_ptr(:)
  55
  56     ! Standard-conform detour of using an array as at time of writing
  57     ! is_device_ptr below does not handle scalars
  58     call c_f_pointer(from, from_ptr, shape=[1])
  59     call c_f_pointer(to, to_ptr, shape=[1])
  60
  61     call do_offload_scalar(from_ptr,to_ptr)
  62   contains
  63     subroutine do_offload_scalar(from_r, to_r)
  64       real(c_double), target :: from_r(:), to_r(:)
  65       ! The extra function is needed as is_device_ptr
  66       ! requires non-value, non-pointer dummy arguments
  67
  68       !$omp target is_device_ptr(from_r, to_r)
  69       call copy3_scalar_int(from_r(1), to_r(1))
  70       !$omp end target
  71     end subroutine do_offload_scalar
  72   end subroutine copy3_scalar
  73
  74   subroutine copy3_array1(from, to)
  75     real(c_double), target :: from(:), to(:)
  76     integer :: N
  77     N = size(from)
  78
  79     !!$omp target is_device_ptr(from, to)
  80     call copy3_array(c_loc(from), c_loc(to), N)
  81     !!$omp end target
  82   end subroutine copy3_array1
  83
  84   subroutine copy3_array3(from, to)
  85     real(c_double), optional, target :: from(:), to(:)
  86     integer :: N
  87     N = size(from)
  88
  89 !    !$omp target is_device_ptr(from, to)
  90     call copy3_array(c_loc(from), c_loc(to), N)
  91 !    !$omp end target
  92   end subroutine copy3_array3
  93 end module target_procs
  94
  95
  96
  97 module offloading2
  98   use iso_c_binding
  99   use target_procs
 100   implicit none (type, external)
 101 contains
 102   ! Same as main program but uses dummy *nonoptional* arguments
 103   subroutine use_device_ptr_sub(AA, BB, CC, DD, EE, FF, AptrA, BptrB, N)
 104     real(c_double), pointer :: AA(:), BB(:)
 105     real(c_double), allocatable, target :: CC(:), DD(:)
 106     real(c_double), target :: EE(N), FF(N), dummy(1)
 107     real(c_double), pointer :: AptrA(:), BptrB(:)
 108     intent(inout) :: AA, BB, CC, DD, EE, FF
 109     integer, value :: N
 110
 111     type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
 112
 113     AA = 11.0_c_double
 114     BB = 22.0_c_double
 115     CC = 33.0_c_double
 116     DD = 44.0_c_double
 117     EE = 55.0_c_double
 118     FF = 66.0_c_double
 119
 120     ! pointer-type array to use_device_ptr
 121     !$omp target data map(to:AA) map(from:BB) use_device_ptr(AA,BB)
 122     call copy3_array(c_loc(AA), c_loc(BB), N)
 123     !$omp end target data
 124
 125     if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) stop 1
 126     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 2
 127
 128     ! allocatable array to use_device_ptr
 129     !$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
 130     call copy3_array(c_loc(CC), c_loc(DD), N)
 131     !$omp end target data
 132
 133     if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) stop 3
 134     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 4
 135
 136     ! fixed-size decriptorless array to use_device_ptr
 137     !$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
 138     call copy3_array(c_loc(EE), c_loc(FF), N)
 139     !$omp end target data
 140
 141     if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) stop 5
 142     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 6
 143
 144
 145
 146     AA = 111.0_c_double
 147     BB = 222.0_c_double
 148     CC = 333.0_c_double
 149     DD = 444.0_c_double
 150     EE = 555.0_c_double
 151     FF = 666.0_c_double
 152
 153     ! pointer-type array to use_device_ptr
 154     !$omp target data map(to:AA) map(from:BB)
 155     !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
 156     tgt_aptr = c_loc(AA)
 157     tgt_bptr = c_loc(BB)
 158     AptrA => AA
 159     BptrB => BB
 160     !$omp end target data
 161
 162     call copy3_array(tgt_aptr, tgt_bptr, N)
 163     !$omp target update from(BB)
 164     if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 7
 165     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 8
 166
 167     AA = 1111.0_c_double
 168     !$omp target update to(AA)
 169     call copy3_array(tgt_aptr, tgt_bptr, N)
 170     !$omp target update from(BB)
 171     if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 9
 172     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 10
 173
 174     ! AprtA tests
 175     AA = 7.0_c_double
 176     !$omp target update to(AA)
 177     call copy3_array(c_loc(AptrA), c_loc(BptrB), N)
 178     !$omp target update from(BB)
 179     if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) stop 11
 180     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 12
 181
 182     AA = 77.0_c_double
 183     !$omp target update to(AA)
 184     call copy3_array1(AptrA, BptrB)
 185     !$omp target update from(BB)
 186     if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) stop 13
 187     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 14
 188
 189 !    AA = 777.0_c_double
 190 !    !$omp target update to(AA)
 191 !    call copy3_array2(AptrA, BptrB)
 192 !    !$omp target update from(BB)
 193 !    if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 15
 194 !    if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 16
 195
 196     AA = 7777.0_c_double
 197     !$omp target update to(AA)
 198     call copy3_array3(AptrA, BptrB)
 199     !$omp target update from(BB)
 200     if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 17
 201     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 18
 202
 203 !    AA = 77777.0_c_double
 204 !    !$omp target update to(AA)
 205 !    call copy3_array4(AptrA, BptrB)
 206 !    !$omp target update from(BB)
 207     !$omp end target data
 208 !
 209 !    if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 19
 210 !    if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 20
 211
 212
 213
 214     ! allocatable array to use_device_ptr
 215     !$omp target data map(to:CC) map(from:DD)
 216     !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
 217     tgt_cptr = c_loc(CC)
 218     tgt_dptr = c_loc(DD)
 219     !$omp end target data
 220
 221     call copy3_array(tgt_cptr, tgt_dptr, N)
 222     !$omp target update from(DD)
 223     if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 21
 224     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 22
 225
 226     CC = 3333.0_c_double
 227     !$omp target update to(CC)
 228     call copy3_array(tgt_cptr, tgt_dptr, N)
 229     !$omp target update from(DD)
 230     !$omp end target data
 231
 232     if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 23
 233     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 24
 234
 235
 236
 237     ! fixed-size decriptorless array to use_device_ptr
 238     !$omp target data map(to:EE) map(from:FF)
 239     !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
 240     tgt_eptr = c_loc(EE)
 241     tgt_fptr = c_loc(FF)
 242     !$omp end target data
 243
 244     call copy3_array(tgt_eptr, tgt_fptr, N)
 245     !$omp target update from(FF)
 246     if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 25
 247     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 26
 248
 249     EE = 5555.0_c_double
 250     !$omp target update to(EE)
 251     call copy3_array(tgt_eptr, tgt_fptr, N)
 252     !$omp target update from(FF)
 253     !$omp end target data
 254
 255     if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 27
 256     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 28
 257   end subroutine use_device_ptr_sub
 258
 259
 260
 261   ! Same as main program but uses dummy *optional* arguments
 262   subroutine use_device_ptr_sub2(AA, BB, CC, DD, EE, FF, AptrA, BptrB, N)
 263     real(c_double), optional, pointer :: AA(:), BB(:)
 264     real(c_double), optional, allocatable, target :: CC(:), DD(:)
 265     real(c_double), optional, target :: EE(N), FF(N)
 266     real(c_double), pointer :: AptrA(:), BptrB(:)
 267     intent(inout) :: AA, BB, CC, DD, EE, FF
 268     real(c_double), target :: dummy(1)
 269     integer, value :: N
 270
 271     type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
 272
 273     AA = 11.0_c_double
 274     BB = 22.0_c_double
 275     CC = 33.0_c_double
 276     DD = 44.0_c_double
 277     EE = 55.0_c_double
 278     FF = 66.0_c_double
 279
 280     ! pointer-type array to use_device_ptr
 281     !$omp target data map(to:AA) map(from:BB) use_device_ptr(AA,BB)
 282     call copy3_array(c_loc(AA), c_loc(BB), N)
 283     !$omp end target data
 284
 285     if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) stop 29
 286     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 30
 287
 288     ! allocatable array to use_device_ptr
 289     !$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
 290     call copy3_array(c_loc(CC), c_loc(DD), N)
 291     !$omp end target data
 292
 293     if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) stop 31
 294     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 32
 295
 296     ! fixed-size decriptorless array to use_device_ptr
 297     !$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
 298     call copy3_array(c_loc(EE), c_loc(FF), N)
 299     !$omp end target data
 300
 301     if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) stop 33
 302     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 34
 303
 304
 305
 306     AA = 111.0_c_double
 307     BB = 222.0_c_double
 308     CC = 333.0_c_double
 309     DD = 444.0_c_double
 310     EE = 555.0_c_double
 311     FF = 666.0_c_double
 312
 313     ! pointer-type array to use_device_ptr
 314     !$omp target data map(to:AA) map(from:BB)
 315     !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
 316     tgt_aptr = c_loc(AA)
 317     tgt_bptr = c_loc(BB)
 318     AptrA => AA
 319     BptrB => BB
 320     !$omp end target data
 321
 322     call copy3_array(tgt_aptr, tgt_bptr, N)
 323     !$omp target update from(BB)
 324     if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 35
 325     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 36
 326
 327     AA = 1111.0_c_double
 328     !$omp target update to(AA)
 329     call copy3_array(tgt_aptr, tgt_bptr, N)
 330     !$omp target update from(BB)
 331     if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 37
 332     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 38
 333
 334     ! AprtA tests
 335     AA = 7.0_c_double
 336     !$omp target update to(AA)
 337     call copy3_array(c_loc(AptrA), c_loc(BptrB), N)
 338     !$omp target update from(BB)
 339     if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) stop 39
 340     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 40
 341
 342     AA = 77.0_c_double
 343     !$omp target update to(AA)
 344     call copy3_array1(AptrA, BptrB)
 345     !$omp target update from(BB)
 346     if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) stop 41
 347     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 42
 348
 349 !    AA = 777.0_c_double
 350 !    !$omp target update to(AA)
 351 !    call copy3_array2(AptrA, BptrB)
 352 !    !$omp target update from(BB)
 353 !    if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 43
 354 !    if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 44
 355
 356     AA = 7777.0_c_double
 357     !$omp target update to(AA)
 358     call copy3_array3(AptrA, BptrB)
 359     !$omp target update from(BB)
 360     if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 45
 361     if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 46
 362
 363 !    AA = 77777.0_c_double
 364 !    !$omp target update to(AA)
 365 !    call copy3_array4(AptrA, BptrB)
 366 !    !$omp target update from(BB)
 367     !$omp end target data
 368 !
 369 !    if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 47
 370 !    if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 48
 371
 372
 373
 374     ! allocatable array to use_device_ptr
 375     !$omp target data map(to:CC) map(from:DD)
 376     !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
 377     tgt_cptr = c_loc(CC)
 378     tgt_dptr = c_loc(DD)
 379     !$omp end target data
 380
 381     call copy3_array(tgt_cptr, tgt_dptr, N)
 382     !$omp target update from(DD)
 383     if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 49
 384     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 50
 385
 386     CC = 3333.0_c_double
 387     !$omp target update to(CC)
 388     call copy3_array(tgt_cptr, tgt_dptr, N)
 389     !$omp target update from(DD)
 390     !$omp end target data
 391
 392     if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 51
 393     if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 52
 394
 395
 396
 397     ! fixed-size decriptorless array to use_device_ptr
 398     !$omp target data map(to:EE) map(from:FF)
 399     !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
 400     tgt_eptr = c_loc(EE)
 401     tgt_fptr = c_loc(FF)
 402     !$omp end target data
 403
 404     call copy3_array(tgt_eptr, tgt_fptr, N)
 405     !$omp target update from(FF)
 406     if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 53
 407     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 54
 408
 409     EE = 5555.0_c_double
 410     !$omp target update to(EE)
 411     call copy3_array(tgt_eptr, tgt_fptr, N)
 412     !$omp end target data
 413
 414     if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 55
 415     if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 56
 416   end subroutine use_device_ptr_sub2
 417 end module offloading2
 418
 419
 420
 421 program omp_device_ptr
 422   use iso_c_binding
 423   use target_procs
 424   use offloading2
 425   implicit none (type, external)
 426
 427   integer, parameter :: N = 1000
 428   real(c_double), pointer :: AA(:), BB(:), arg_AA(:), arg_BB(:), arg2_AA(:), arg2_BB(:)
 429   real(c_double), allocatable, target :: CC(:), DD(:), arg_CC(:), arg_DD(:), arg2_CC(:), arg2_DD(:)
 430   real(c_double), target :: EE(N), FF(N), dummy(1), arg_EE(N), arg_FF(N), arg2_EE(N), arg2_FF(N)
 431
 432   real(c_double), pointer :: AptrA(:), BptrB(:)
 433   type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
 434
 435   allocate(AA(N), BB(N), CC(N), DD(N))
 436
 437   AA = 11.0_c_double
 438   BB = 22.0_c_double
 439   CC = 33.0_c_double
 440   DD = 44.0_c_double
 441   EE = 55.0_c_double
 442   FF = 66.0_c_double
 443
 444   ! pointer-type array to use_device_ptr
 445   !$omp target data map(to:AA) map(from:BB) use_device_ptr(AA,BB)
 446   call copy3_array(c_loc(AA), c_loc(BB), N)
 447   !$omp end target data
 448
 449   if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) stop 57
 450   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 58
 451
 452   ! allocatable array to use_device_ptr
 453   !$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
 454   call copy3_array(c_loc(CC), c_loc(DD), N)
 455   !$omp end target data
 456
 457   if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) stop 59
 458   if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 60
 459
 460   ! fixed-size decriptorless array to use_device_ptr
 461   !$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
 462   call copy3_array(c_loc(EE), c_loc(FF), N)
 463   !$omp end target data
 464
 465   if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) stop 61
 466   if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 62
 467
 468
 469
 470   AA = 111.0_c_double
 471   BB = 222.0_c_double
 472   CC = 333.0_c_double
 473   DD = 444.0_c_double
 474   EE = 555.0_c_double
 475   FF = 666.0_c_double
 476
 477   ! pointer-type array to use_device_ptr
 478   !$omp target data map(to:AA) map(from:BB)
 479   !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
 480   tgt_aptr = c_loc(AA)
 481   tgt_bptr = c_loc(BB)
 482   AptrA => AA
 483   BptrB => BB
 484   !$omp end target data
 485
 486   call copy3_array(tgt_aptr, tgt_bptr, N)
 487   !$omp target update from(BB)
 488   if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 63
 489   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 64
 490
 491   AA = 1111.0_c_double
 492   !$omp target update to(AA)
 493   call copy3_array(tgt_aptr, tgt_bptr, N)
 494   !$omp target update from(BB)
 495   if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) stop 65
 496   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 66
 497
 498   ! AprtA tests
 499   AA = 7.0_c_double
 500   !$omp target update to(AA)
 501   call copy3_array(c_loc(AptrA), c_loc(BptrB), N)
 502   !$omp target update from(BB)
 503   if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) stop 67
 504   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 68
 505
 506   AA = 77.0_c_double
 507   !$omp target update to(AA)
 508   call copy3_array1(AptrA, BptrB)
 509   !$omp target update from(BB)
 510   if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) stop 69
 511   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 70
 512
 513 !  AA = 777.0_c_double
 514 !  !$omp target update to(AA)
 515 !  call copy3_array2(AptrA, BptrB)
 516 !  !$omp target update from(BB)
 517 !  if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 71
 518 !  if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 72
 519
 520   AA = 7777.0_c_double
 521   !$omp target update to(AA)
 522   call copy3_array3(AptrA, BptrB)
 523   !$omp target update from(BB)
 524   if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 73
 525   if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 74
 526
 527 !  AA = 77777.0_c_double
 528 !  !$omp target update to(AA)
 529 !  call copy3_array4(AptrA, BptrB)
 530 !  !$omp target update from(BB)
 531   !$omp end target data
 532 !
 533 !  if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) stop 75
 534 !  if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) stop 76
 535
 536
 537
 538   ! allocatable array to use_device_ptr
 539   !$omp target data map(to:CC) map(from:DD)
 540   !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
 541   tgt_cptr = c_loc(CC)
 542   tgt_dptr = c_loc(DD)
 543   !$omp end target data
 544
 545   call copy3_array(tgt_cptr, tgt_dptr, N)
 546   !$omp target update from(DD)
 547   if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 77
 548   if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 78
 549
 550   CC = 3333.0_c_double
 551   !$omp target update to(CC)
 552   call copy3_array(tgt_cptr, tgt_dptr, N)
 553   !$omp target update from(DD)
 554   !$omp end target data
 555
 556   if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) stop 79
 557   if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) stop 80
 558
 559
 560
 561   ! fixed-size decriptorless array to use_device_ptr
 562   !$omp target data map(to:EE) map(from:FF)
 563   !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
 564   tgt_eptr = c_loc(EE)
 565   tgt_fptr = c_loc(FF)
 566   !$omp end target data
 567
 568   call copy3_array(tgt_eptr, tgt_fptr, N)
 569   !$omp target update from(FF)
 570   if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 81
 571   if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 82
 572
 573   EE = 5555.0_c_double
 574   !$omp target update to(EE)
 575   call copy3_array(tgt_eptr, tgt_fptr, N)
 576   !$omp target update from(FF)
 577   !$omp end target data
 578
 579   if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) stop 83
 580   if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) stop 84
 581
 582
 583
 584   deallocate(AA, BB)  ! Free pointers only
 585
 586   AptrA => null()
 587   BptrB => null()
 588   allocate(arg_AA(N), arg_BB(N), arg_CC(N), arg_DD(N))
 589   call use_device_ptr_sub(arg_AA, arg_BB, arg_CC, arg_DD, arg_EE, arg_FF, AptrA, BptrB, N)
 590   deallocate(arg_AA, arg_BB)
 591
 592   AptrA => null()
 593   BptrB => null()
 594   allocate(arg2_AA(N), arg2_BB(N), arg2_CC(N), arg2_DD(N))
 595   call use_device_ptr_sub2(arg2_AA, arg2_BB, arg2_CC, arg2_DD, arg2_EE, arg2_FF, AptrA, BptrB, N)
 596   deallocate(arg2_AA, arg2_BB)
 597 end program omp_device_ptr