1! { dg-do run } 2 3module target_procs 4 use iso_c_binding 5 implicit none (type, external) 6 private 7 public :: copy3_array, copy3_scalar, copy3_array1, copy3_array3 8contains 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 93end module target_procs 94 95 96 97module offloading2 98 use iso_c_binding 99 use target_procs 100 implicit none (type, external) 101contains 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 417end module offloading2 418 419 420 421program 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) 597end program omp_device_ptr 598