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