2 ! Comprehensive run-time test for use_device_addr
4 ! Differs from use_device_addr-1.f90 by using a 4-byte variable (c_float)
6 ! This test case assumes that a 'var' appearing in 'use_device_addr' is
7 ! only used as 'c_loc(var)' - such that only the actual data is used/usable
8 ! on the device - and not meta data ((dynamic) type information, 'present()'
9 ! status, array shape).
11 ! Untested in this test case are:
12 ! - arrays with array descriptor
13 ! - polymorphic variables
14 ! - absent optional arguments
18 implicit none (type, external)
20 public
:: copy3_array
, copy3_scalar
22 subroutine copy3_array_int(from_ptr
, to_ptr
, N
)
24 real(c_float
) :: from_ptr(:)
25 real(c_float
) :: to_ptr(:)
31 to_ptr(i
) = 3 * from_ptr(i
)
34 end subroutine copy3_array_int
36 subroutine copy3_scalar_int(from
, to)
38 real(c_float
) :: from
, to
41 end subroutine copy3_scalar_int
44 subroutine copy3_array(from
, to, N
)
45 type(c_ptr
), value
:: from
, to
47 real(c_float
), pointer :: from_ptr(:), to_ptr(:)
49 call c_f_pointer(from
, from_ptr
, shape
=[N
])
50 call c_f_pointer(to, to_ptr
, shape
=[N
])
52 call do_offload_scalar(from_ptr
,to_ptr
)
54 subroutine do_offload_scalar(from_r
, to_r
)
55 real(c_float
), target
:: from_r(:), to_r(:)
56 ! The extra function is needed as is_device_ptr
57 ! requires non-value, non-pointer dummy arguments
59 !$omp target is_device_ptr(from_r, to_r)
60 call copy3_array_int(from_r
, to_r
, N
)
62 end subroutine do_offload_scalar
63 end subroutine copy3_array
65 subroutine copy3_scalar(from
, to)
66 type(c_ptr
), value
, target
:: from
, to
67 real(c_float
), pointer :: from_ptr(:), to_ptr(:)
69 ! Standard-conform detour of using an array as at time of writing
70 ! is_device_ptr below does not handle scalars
71 call c_f_pointer(from
, from_ptr
, shape
=[1])
72 call c_f_pointer(to, to_ptr
, shape
=[1])
74 call do_offload_scalar(from_ptr
,to_ptr
)
76 subroutine do_offload_scalar(from_r
, to_r
)
77 real(c_float
), target
:: from_r(:), to_r(:)
78 ! The extra function is needed as is_device_ptr
79 ! requires non-value, non-pointer dummy arguments
81 !$omp target is_device_ptr(from_r, to_r)
82 call copy3_scalar_int(from_r(1), to_r(1))
84 end subroutine do_offload_scalar
85 end subroutine copy3_scalar
86 end module target_procs
90 ! Test local dummy arguments (w/o optional)
94 implicit none (type, external)
96 public
:: test_dummy_call_1
, test_dummy_call_2
98 subroutine test_dummy_call_1()
99 integer, parameter :: N
= 1000
102 real(c_float
), target
:: aa
, bb
103 real(c_float
), target
, allocatable
:: cc
, dd
104 real(c_float
), pointer :: ee
, ff
106 ! non-descriptor arrays
107 real(c_float
), target
:: gg(N
), hh(N
)
109 allocate(cc
, dd
, ee
, ff
)
120 call test_dummy_callee_1(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, N
)
121 deallocate(ee
, ff
) ! pointers, only
122 end subroutine test_dummy_call_1
124 subroutine test_dummy_callee_1(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, N
)
126 real(c_float
), target
:: aa
, bb
127 real(c_float
), target
, allocatable
:: cc
, dd
128 real(c_float
), pointer :: ee
, ff
130 ! non-descriptor arrays
131 real(c_float
), target
:: gg(N
), hh(N
)
134 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
135 call copy3_scalar(c_loc(aa
), c_loc(bb
))
136 !$omp end target data
137 if (abs(aa
- 11.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 1
138 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 2
140 !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
141 call copy3_scalar(c_loc(cc
), c_loc(dd
))
142 !$omp end target data
143 if (abs(cc
- 33.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 3
144 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 4
146 !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
147 call copy3_scalar(c_loc(ee
), c_loc(ff
))
148 !$omp end target data
149 if (abs(ee
- 55.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 5
150 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 6
153 !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
154 call copy3_array(c_loc(gg
), c_loc(hh
), N
)
155 !$omp end target data
156 if (any(abs(gg
- 77.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 7
157 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 8
158 end subroutine test_dummy_callee_1
160 ! Save device ptr - and recall pointer
161 subroutine test_dummy_call_2()
162 integer, parameter :: N
= 1000
165 real(c_float
), target
:: aa
, bb
166 real(c_float
), target
, allocatable
:: cc
, dd
167 real(c_float
), pointer :: ee
, ff
169 ! non-descriptor arrays
170 real(c_float
), target
:: gg(N
), hh(N
)
172 type(c_ptr
) :: c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
173 real(c_float
), pointer :: aptr
, bptr
, cptr
, dptr
, eptr
, fptr
174 real(c_float
), pointer :: gptr(:), hptr(:)
176 allocate(cc
, dd
, ee
, ff
)
177 call test_dummy_callee_2(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, &
178 c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
, &
179 aptr
, bptr
, cptr
, dptr
, eptr
, fptr
, gptr
, hptr
, &
182 end subroutine test_dummy_call_2
184 subroutine test_dummy_callee_2(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, &
185 c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
, &
186 aptr
, bptr
, cptr
, dptr
, eptr
, fptr
, gptr
, hptr
, &
189 real(c_float
), target
:: aa
, bb
190 real(c_float
), target
, allocatable
:: cc
, dd
191 real(c_float
), pointer :: ee
, ff
193 ! non-descriptor arrays
194 real(c_float
), target
:: gg(N
), hh(N
)
196 type(c_ptr
) :: c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
197 real(c_float
), pointer :: aptr
, bptr
, cptr
, dptr
, eptr
, fptr
198 real(c_float
), pointer :: gptr(:), hptr(:)
202 real(c_float
) :: dummy
213 !$omp target data map(to:aa) map(from:bb)
214 !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
219 !$omp end target data
221 ! check c_loc ptr once
222 call copy3_scalar(c_aptr
, c_bptr
)
223 !$omp target update from(bb)
224 if (abs(aa
- 111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 9
225 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 10
227 ! check c_loc ptr again after target-value modification
229 !$omp target update to(aa)
230 call copy3_scalar(c_aptr
, c_bptr
)
231 !$omp target update from(bb)
232 if (abs(aa
- 1111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 11
233 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 12
235 ! check Fortran pointer after target-value modification
237 !$omp target update to(aa)
238 call copy3_scalar(c_loc(aptr
), c_loc(bptr
))
239 !$omp target update from(bb)
240 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 13
241 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 14
242 !$omp end target data
244 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 15
245 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 16
248 !$omp target data map(to:cc) map(from:dd)
249 !$omp target data map(alloc:dummy) use_device_addr(cc,dd)
254 !$omp end target data
256 ! check c_loc ptr once
257 call copy3_scalar(c_cptr
, c_dptr
)
258 !$omp target update from(dd)
259 if (abs(cc
- 333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 17
260 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 18
262 ! check c_loc ptr again after target-value modification
264 !$omp target update to(cc)
265 call copy3_scalar(c_cptr
, c_dptr
)
266 !$omp target update from(dd)
267 if (abs(cc
- 3333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 19
268 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 20
270 ! check Fortran pointer after target-value modification
272 !$omp target update to(cc)
273 call copy3_scalar(c_loc(cptr
), c_loc(dptr
))
274 !$omp target update from(dd)
275 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 21
276 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 22
277 !$omp end target data
279 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(dd
)) stop 23
280 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(dd
)) stop 24
283 !$omp target data map(to:ee) map(from:ff)
284 !$omp target data map(alloc:dummy) use_device_addr(ee,ff)
289 !$omp end target data
291 ! check c_loc ptr once
292 call copy3_scalar(c_eptr
, c_fptr
)
293 !$omp target update from(ff)
294 if (abs(ee
- 555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 25
295 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 26
297 ! check c_loc ptr again after target-value modification
299 !$omp target update to(ee)
300 call copy3_scalar(c_eptr
, c_fptr
)
301 !$omp target update from(ff)
302 if (abs(ee
- 5555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 27
303 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 28
305 ! check Fortran pointer after target-value modification
307 !$omp target update to(ee)
308 call copy3_scalar(c_loc(eptr
), c_loc(fptr
))
309 !$omp target update from(ff)
310 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 29
311 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ff
)) stop 30
312 !$omp end target data
314 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 31
315 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 32
318 !$omp target data map(to:gg) map(from:hh)
319 !$omp target data map(alloc:dummy) use_device_addr(gg,hh)
324 !$omp end target data
326 ! check c_loc ptr once
327 call copy3_array(c_gptr
, c_hptr
, N
)
328 !$omp target update from(hh)
329 if (any(abs(gg
- 777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 33
330 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(hh
))) stop 34
332 ! check c_loc ptr again after target-value modification
334 !$omp target update to(gg)
335 call copy3_array(c_gptr
, c_hptr
, N
)
336 !$omp target update from(hh)
337 if (any(abs(gg
- 7777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 35
338 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 36
340 ! check Fortran pointer after target-value modification
342 !$omp target update to(gg)
343 call copy3_array(c_loc(gptr
), c_loc(hptr
), N
)
344 !$omp target update from(hh)
345 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 37
346 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 38
347 !$omp end target data
349 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 39
350 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 40
351 end subroutine test_dummy_callee_2
352 end module test_dummies
356 ! Test local dummy arguments + VALUE (w/o optional)
357 module test_dummies_value
360 implicit none (type, external)
362 public
:: test_dummy_val_call_1
, test_dummy_val_call_2
364 subroutine test_dummy_val_call_1()
365 ! scalars - with value, neither allocatable nor pointer no dimension permitted
366 real(c_float
), target
:: aa
, bb
371 call test_dummy_val_callee_1(aa
, bb
)
372 end subroutine test_dummy_val_call_1
374 subroutine test_dummy_val_callee_1(aa
, bb
)
376 real(c_float
), value
, target
:: aa
, bb
378 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
379 call copy3_scalar(c_loc(aa
), c_loc(bb
))
380 !$omp end target data
381 if (abs(aa
- 11.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 41
382 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 42
383 end subroutine test_dummy_val_callee_1
385 ! Save device ptr - and recall pointer
386 subroutine test_dummy_val_call_2()
387 ! scalars - with value, neither allocatable nor pointer no dimension permitted
388 real(c_float
), target
:: aa
, bb
389 type(c_ptr
) :: c_aptr
, c_bptr
390 real(c_float
), pointer :: aptr
, bptr
392 call test_dummy_val_callee_2(aa
, bb
, c_aptr
, c_bptr
, aptr
, bptr
)
393 end subroutine test_dummy_val_call_2
395 subroutine test_dummy_val_callee_2(aa
, bb
, c_aptr
, c_bptr
, aptr
, bptr
)
396 real(c_float
), value
, target
:: aa
, bb
397 type(c_ptr
), value
:: c_aptr
, c_bptr
398 real(c_float
), pointer :: aptr
, bptr
400 real(c_float
) :: dummy
405 !$omp target data map(to:aa) map(from:bb)
406 !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
411 !$omp end target data
413 ! check c_loc ptr once
414 call copy3_scalar(c_aptr
, c_bptr
)
415 !$omp target update from(bb)
416 if (abs(aa
- 111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 43
417 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 44
419 ! check c_loc ptr again after target-value modification
421 !$omp target update to(aa)
422 call copy3_scalar(c_aptr
, c_bptr
)
423 !$omp target update from(bb)
424 if (abs(aa
- 1111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 45
425 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 46
427 ! check Fortran pointer after target-value modification
429 !$omp target update to(aa)
430 call copy3_scalar(c_loc(aptr
), c_loc(bptr
))
431 !$omp target update from(bb)
432 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 47
433 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 48
434 !$omp end target data
436 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 49
437 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 50
438 end subroutine test_dummy_val_callee_2
439 end module test_dummies_value
443 ! Test local dummy arguments + OPTIONAL
444 ! Values present and ptr associated to nonzero
445 module test_dummies_opt
448 implicit none (type, external)
450 public
:: test_dummy_opt_call_1
, test_dummy_opt_call_2
452 subroutine test_dummy_opt_call_1()
453 integer, parameter :: N
= 1000
456 real(c_float
), target
:: aa
, bb
457 real(c_float
), target
, allocatable
:: cc
, dd
458 real(c_float
), pointer :: ee
, ff
460 ! non-descriptor arrays
461 real(c_float
), target
:: gg(N
), hh(N
)
463 allocate(cc
, dd
, ee
, ff
)
474 call test_dummy_opt_callee_1(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, N
)
475 call test_dummy_opt_callee_1_absent(N
=N
)
476 deallocate(ee
, ff
) ! pointers, only
477 end subroutine test_dummy_opt_call_1
479 subroutine test_dummy_opt_callee_1(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, N
)
481 real(c_float
), optional
, target
:: aa
, bb
482 real(c_float
), optional
, target
, allocatable
:: cc
, dd
483 real(c_float
), optional
, pointer :: ee
, ff
485 ! non-descriptor arrays
486 real(c_float
), optional
, target
:: gg(N
), hh(N
)
489 ! All shall be present - and pointing to non-NULL
490 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 51
491 if (.not
.present(cc
) .or
. .not
.present(dd
)) stop 52
492 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 53
493 if (.not
.present(gg
) .or
. .not
.present(hh
)) stop 54
495 if (.not
.associated(ee
) .or
. .not
.associated(ff
)) stop 55
497 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
498 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 56
499 if (.not
.c_associated(c_loc(aa
)) .or
. .not
.c_associated(c_loc(bb
))) stop 57
500 call copy3_scalar(c_loc(aa
), c_loc(bb
))
501 !$omp end target data
502 if (abs(aa
- 11.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 58
503 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 59
505 !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
506 if (.not
.present(cc
) .or
. .not
.present(dd
)) stop 60
507 if (.not
.c_associated(c_loc(cc
)) .or
. .not
.c_associated(c_loc(dd
))) stop 61
508 call copy3_scalar(c_loc(cc
), c_loc(dd
))
509 !$omp end target data
510 if (abs(cc
- 33.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 62
511 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 63
513 !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
514 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 64
515 if (.not
.associated(ee
) .or
. .not
.associated(ff
)) stop 65
516 if (.not
.c_associated(c_loc(ee
)) .or
. .not
.c_associated(c_loc(ff
))) stop 66
517 call copy3_scalar(c_loc(ee
), c_loc(ff
))
518 !$omp end target data
519 if (abs(ee
- 55.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 67
520 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 68
522 !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
523 if (.not
.present(gg
) .or
. .not
.present(hh
)) stop 69
524 if (.not
.c_associated(c_loc(gg
)) .or
. .not
.c_associated(c_loc(hh
))) stop 70
525 call copy3_array(c_loc(gg
), c_loc(hh
), N
)
526 !$omp end target data
527 if (any(abs(gg
- 77.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 71
528 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 72
529 end subroutine test_dummy_opt_callee_1
531 subroutine test_dummy_opt_callee_1_absent(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, N
)
533 real(c_float
), optional
, target
:: aa
, bb
534 real(c_float
), optional
, target
, allocatable
:: cc
, dd
535 real(c_float
), optional
, pointer :: ee
, ff
537 ! non-descriptor arrays
538 real(c_float
), optional
, target
:: gg(N
), hh(N
)
543 ! All shall be absent
544 if (present(aa
) .or
. present(bb
)) stop 243
545 if (present(cc
) .or
. present(dd
)) stop 244
546 if (present(ee
) .or
. present(ff
)) stop 245
547 if (present(gg
) .or
. present(hh
)) stop 246
549 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
550 if (present(aa
) .or
. present(bb
)) stop 247
551 !$omp end target data
553 !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
554 if (present(cc
) .or
. present(dd
)) stop 248
555 !$omp end target data
557 !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
558 if (present(ee
) .or
. present(ff
)) stop 249
559 !$omp end target data
561 !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
562 if (present(gg
) .or
. present(hh
)) stop 250
563 !$omp end target data
564 end subroutine test_dummy_opt_callee_1_absent
566 ! Save device ptr - and recall pointer
567 subroutine test_dummy_opt_call_2()
568 integer, parameter :: N
= 1000
571 real(c_float
), target
:: aa
, bb
572 real(c_float
), target
, allocatable
:: cc
, dd
573 real(c_float
), pointer :: ee
, ff
575 ! non-descriptor arrays
576 real(c_float
), target
:: gg(N
), hh(N
)
578 type(c_ptr
) :: c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
579 real(c_float
), pointer :: aptr
, bptr
, cptr
, dptr
, eptr
, fptr
580 real(c_float
), pointer :: gptr(:), hptr(:)
582 allocate(cc
, dd
, ee
, ff
)
583 call test_dummy_opt_callee_2(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, &
584 c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
, &
585 aptr
, bptr
, cptr
, dptr
, eptr
, fptr
, gptr
, hptr
, &
588 end subroutine test_dummy_opt_call_2
590 subroutine test_dummy_opt_callee_2(aa
, bb
, cc
, dd
, ee
, ff
, gg
, hh
, &
591 c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
, &
592 aptr
, bptr
, cptr
, dptr
, eptr
, fptr
, gptr
, hptr
, &
595 real(c_float
), optional
, target
:: aa
, bb
596 real(c_float
), optional
, target
, allocatable
:: cc
, dd
597 real(c_float
), optional
, pointer :: ee
, ff
599 ! non-descriptor arrays
600 real(c_float
), optional
, target
:: gg(N
), hh(N
)
602 type(c_ptr
) :: c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
603 real(c_float
), optional
, pointer :: aptr
, bptr
, cptr
, dptr
, eptr
, fptr
604 real(c_float
), optional
, pointer :: gptr(:), hptr(:)
608 real(c_float
) :: dummy
610 ! All shall be present - and pointing to non-NULL
611 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 73
612 if (.not
.present(cc
) .or
. .not
.present(dd
)) stop 74
613 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 75
614 if (.not
.present(gg
) .or
. .not
.present(hh
)) stop 76
616 if (.not
.associated(ee
) .or
. .not
.associated(ff
)) stop 77
627 !$omp target data map(to:aa) map(from:bb)
628 !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
629 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 78
630 if (.not
.c_associated(c_loc(aa
)) .or
. .not
.c_associated(c_loc(bb
))) stop 79
635 if (.not
.c_associated(c_aptr
) .or
. .not
.c_associated(c_bptr
)) stop 80
636 if (.not
.associated(aptr
) .or
. .not
.associated(bptr
)) stop 81
637 !$omp end target data
639 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 82
640 if (.not
.c_associated(c_loc(aa
)) .or
. .not
.c_associated(c_loc(bb
))) stop 83
641 if (.not
.c_associated(c_aptr
) .or
. .not
.c_associated(c_bptr
)) stop 84
642 if (.not
.associated(aptr
) .or
. .not
.associated(bptr
)) stop 85
644 ! check c_loc ptr once
645 call copy3_scalar(c_aptr
, c_bptr
)
646 !$omp target update from(bb)
647 if (abs(aa
- 111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 86
648 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 87
650 ! check c_loc ptr again after target-value modification
652 !$omp target update to(aa)
653 call copy3_scalar(c_aptr
, c_bptr
)
654 !$omp target update from(bb)
655 if (abs(aa
- 1111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 88
656 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 89
658 ! check Fortran pointer after target-value modification
660 !$omp target update to(aa)
661 call copy3_scalar(c_loc(aptr
), c_loc(bptr
))
662 !$omp target update from(bb)
663 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 90
664 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 91
665 !$omp end target data
667 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 92
668 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 93
671 !$omp target data map(to:cc) map(from:dd)
672 !$omp target data map(alloc:dummy) use_device_addr(cc,dd)
673 if (.not
.present(cc
) .or
. .not
.present(dd
)) stop 94
674 if (.not
.c_associated(c_loc(cc
)) .or
. .not
.c_associated(c_loc(dd
))) stop 95
679 if (.not
.c_associated(c_cptr
) .or
. .not
.c_associated(c_dptr
)) stop 96
680 if (.not
.associated(cptr
) .or
. .not
.associated(dptr
)) stop 97
681 !$omp end target data
682 if (.not
.present(cc
) .or
. .not
.present(dd
)) stop 98
683 if (.not
.c_associated(c_loc(cc
)) .or
. .not
.c_associated(c_loc(dd
))) stop 99
684 if (.not
.c_associated(c_cptr
) .or
. .not
.c_associated(c_dptr
)) stop 100
685 if (.not
.associated(cptr
) .or
. .not
.associated(dptr
)) stop 101
687 ! check c_loc ptr once
688 call copy3_scalar(c_cptr
, c_dptr
)
689 !$omp target update from(dd)
690 if (abs(cc
- 333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 102
691 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 103
693 ! check c_loc ptr again after target-value modification
695 !$omp target update to(cc)
696 call copy3_scalar(c_cptr
, c_dptr
)
697 !$omp target update from(dd)
698 if (abs(cc
- 3333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 104
699 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 105
701 ! check Fortran pointer after target-value modification
703 !$omp target update to(cc)
704 call copy3_scalar(c_loc(cptr
), c_loc(dptr
))
705 !$omp target update from(dd)
706 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 106
707 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 107
708 !$omp end target data
710 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(dd
)) stop 108
711 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(dd
)) stop 109
714 !$omp target data map(to:ee) map(from:ff)
715 !$omp target data map(alloc:dummy) use_device_addr(ee,ff)
716 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 110
717 if (.not
.associated(ee
) .or
. .not
.associated(ff
)) stop 111
718 if (.not
.c_associated(c_loc(ee
)) .or
. .not
.c_associated(c_loc(ff
))) stop 112
723 if (.not
.c_associated(c_eptr
) .or
. .not
.c_associated(c_fptr
)) stop 113
724 if (.not
.associated(eptr
) .or
. .not
.associated(fptr
)) stop 114
725 !$omp end target data
726 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 115
727 if (.not
.associated(ee
) .or
. .not
.associated(ff
)) stop 116
728 if (.not
.c_associated(c_loc(ee
)) .or
. .not
.c_associated(c_loc(ff
))) stop 117
729 if (.not
.c_associated(c_eptr
) .or
. .not
.c_associated(c_fptr
)) stop 118
730 if (.not
.associated(eptr
) .or
. .not
.associated(fptr
)) stop 119
732 ! check c_loc ptr once
733 call copy3_scalar(c_eptr
, c_fptr
)
734 !$omp target update from(ff)
735 if (abs(ee
- 555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 120
736 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 121
738 ! check c_loc ptr again after target-value modification
740 !$omp target update to(ee)
741 call copy3_scalar(c_eptr
, c_fptr
)
742 !$omp target update from(ff)
743 if (abs(ee
- 5555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 122
744 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 123
746 ! check Fortran pointer after target-value modification
748 !$omp target update to(ee)
749 call copy3_scalar(c_loc(eptr
), c_loc(fptr
))
750 !$omp target update from(ff)
751 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 124
752 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ff
)) stop 125
753 !$omp end target data
755 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 126
756 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 127
759 !$omp target data map(to:gg) map(from:hh)
760 !$omp target data map(alloc:dummy) use_device_addr(gg,hh)
761 if (.not
.present(gg
) .or
. .not
.present(hh
)) stop 128
762 if (.not
.c_associated(c_loc(gg
)) .or
. .not
.c_associated(c_loc(hh
))) stop 129
767 if (.not
.c_associated(c_gptr
) .or
. .not
.c_associated(c_hptr
)) stop 130
768 if (.not
.associated(gptr
) .or
. .not
.associated(hptr
)) stop 131
769 !$omp end target data
770 if (.not
.present(gg
) .or
. .not
.present(hh
)) stop 132
771 if (.not
.c_associated(c_loc(gg
)) .or
. .not
.c_associated(c_loc(hh
))) stop 133
772 if (.not
.c_associated(c_gptr
) .or
. .not
.c_associated(c_hptr
)) stop 134
773 if (.not
.associated(gptr
) .or
. .not
.associated(hptr
)) stop 135
775 ! check c_loc ptr once
776 call copy3_array(c_gptr
, c_hptr
, N
)
777 !$omp target update from(hh)
778 if (any(abs(gg
- 777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 136
779 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(hh
))) stop 137
781 ! check c_loc ptr again after target-value modification
783 !$omp target update to(gg)
784 call copy3_array(c_gptr
, c_hptr
, N
)
785 !$omp target update from(hh)
786 if (any(abs(gg
- 7777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 138
787 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 139
789 ! check Fortran pointer after target-value modification
791 !$omp target update to(gg)
792 call copy3_array(c_loc(gptr
), c_loc(hptr
), N
)
793 !$omp target update from(hh)
794 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 140
795 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 141
796 !$omp end target data
798 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 142
799 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 143
800 end subroutine test_dummy_opt_callee_2
801 end module test_dummies_opt
805 ! Test local dummy arguments + OPTIONAL + VALUE
807 module test_dummies_opt_value
810 implicit none (type, external)
812 public
:: test_dummy_opt_val_call_1
, test_dummy_opt_val_call_2
814 subroutine test_dummy_opt_val_call_1()
815 ! scalars - with value, neither allocatable nor pointer no dimension permitted
816 real(c_float
), target
:: aa
, bb
821 call test_dummy_opt_val_callee_1(aa
, bb
)
822 end subroutine test_dummy_opt_val_call_1
824 subroutine test_dummy_opt_val_callee_1(aa
, bb
)
826 real(c_float
), optional
, value
, target
:: aa
, bb
828 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 144
830 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
831 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 145
832 if (.not
.c_associated(c_loc(aa
)) .or
. .not
.c_associated(c_loc(bb
))) stop 146
833 call copy3_scalar(c_loc(aa
), c_loc(bb
))
834 !$omp end target data
835 if (abs(aa
- 11.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 147
836 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 148
837 end subroutine test_dummy_opt_val_callee_1
839 ! Save device ptr - and recall pointer
840 subroutine test_dummy_opt_val_call_2()
841 ! scalars - with value, neither allocatable nor pointer no dimension permitted
842 real(c_float
), target
:: aa
, bb
843 type(c_ptr
) :: c_aptr
, c_bptr
844 real(c_float
), pointer :: aptr
, bptr
846 call test_dummy_opt_val_callee_2(aa
, bb
, c_aptr
, c_bptr
, aptr
, bptr
)
847 end subroutine test_dummy_opt_val_call_2
849 subroutine test_dummy_opt_val_callee_2(aa
, bb
, c_aptr
, c_bptr
, aptr
, bptr
)
850 real(c_float
), optional
, value
, target
:: aa
, bb
851 type(c_ptr
), optional
, value
:: c_aptr
, c_bptr
852 real(c_float
), optional
, pointer :: aptr
, bptr
854 real(c_float
) :: dummy
856 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 149
857 if (.not
.present(c_aptr
) .or
. .not
.present(c_bptr
)) stop 150
858 if (.not
.present(aptr
) .or
. .not
.present(bptr
)) stop 151
863 !$omp target data map(to:aa) map(from:bb)
864 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 152
865 if (.not
.present(c_aptr
) .or
. .not
.present(c_bptr
)) stop 153
866 if (.not
.present(aptr
) .or
. .not
.present(bptr
)) stop 154
868 !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
869 if (.not
.present(aa
) .or
. .not
.present(bb
)) stop 155
870 if (.not
.present(c_aptr
) .or
. .not
.present(c_bptr
)) stop 156
871 if (.not
.present(aptr
) .or
. .not
.present(bptr
)) stop 157
877 if (.not
.c_associated(c_aptr
) .or
. .not
.c_associated(c_bptr
)) stop 158
878 if (.not
.associated(aptr
) .or
. .not
.associated(bptr
)) stop 159
879 !$omp end target data
881 ! check c_loc ptr once
882 call copy3_scalar(c_aptr
, c_bptr
)
883 !$omp target update from(bb)
884 if (abs(aa
- 111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 160
885 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 161
887 ! check c_loc ptr again after target-value modification
889 !$omp target update to(aa)
890 call copy3_scalar(c_aptr
, c_bptr
)
891 !$omp target update from(bb)
892 if (abs(aa
- 1111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 162
893 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 163
895 ! check Fortran pointer after target-value modification
897 !$omp target update to(aa)
898 call copy3_scalar(c_loc(aptr
), c_loc(bptr
))
899 !$omp target update from(bb)
900 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 164
901 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 165
902 !$omp end target data
904 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 166
905 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 167
906 end subroutine test_dummy_opt_val_callee_2
907 end module test_dummies_opt_value
914 implicit none (type, external)
916 public
:: test_nullptr_1
918 subroutine test_nullptr_1()
920 real(c_float
), pointer :: aa
, bb
921 real(c_float
), pointer :: ee
, ff
923 real(c_float
), allocatable
, target
:: gg
, hh
925 type(c_ptr
) :: c_aptr
, c_bptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
926 real(c_float
), pointer :: aptr
, bptr
, eptr
, fptr
, gptr
, hptr
933 if (associated(aa
) .or
. associated(bb
)) stop 168
934 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
935 if (c_associated(c_loc(aa
)) .or
. c_associated(c_loc(bb
))) stop 169
940 if (c_associated(c_aptr
) .or
. c_associated(c_bptr
)) stop 170
941 if (associated(aptr
) .or
. associated(bptr
, bb
)) stop 171
942 !$omp end target data
943 if (c_associated(c_aptr
) .or
. c_associated(c_bptr
)) stop 172
944 if (associated(aptr
) .or
. associated(bptr
, bb
)) stop 173
946 if (allocated(gg
)) stop 174
947 !$omp target data map(tofrom:gg) use_device_addr(gg)
948 if (c_associated(c_loc(gg
))) stop 175
951 if (c_associated(c_gptr
)) stop 176
952 if (associated(gptr
)) stop 177
953 if (allocated(gg
)) stop 178
954 !$omp end target data
955 if (c_associated(c_gptr
)) stop 179
956 if (associated(gptr
)) stop 180
957 if (allocated(gg
)) stop 181
959 call test_dummy_opt_nullptr_callee_1(ee
, ff
, hh
, c_eptr
, c_fptr
, c_hptr
, eptr
, fptr
, hptr
)
960 end subroutine test_nullptr_1
962 subroutine test_dummy_opt_nullptr_callee_1(ee
, ff
, hh
, c_eptr
, c_fptr
, c_hptr
, eptr
, fptr
, hptr
)
964 real(c_float
), optional
, pointer :: ee
, ff
965 real(c_float
), optional
, allocatable
, target
:: hh
967 type(c_ptr
), optional
:: c_eptr
, c_fptr
, c_hptr
968 real(c_float
), optional
, pointer :: eptr
, fptr
, hptr
970 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 182
971 if (associated(ee
) .or
. associated(ff
)) stop 183
973 !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
974 if (.not
.present(ee
) .or
. .not
.present(ff
)) stop 184
975 if (associated(ee
) .or
. associated(ff
)) stop 185
976 if (c_associated(c_loc(ee
)) .or
. c_associated(c_loc(ff
))) stop 186
981 if (c_associated(c_eptr
) .or
. c_associated(c_fptr
)) stop 187
982 if (associated(eptr
) .or
. associated(fptr
)) stop 188
983 !$omp end target data
985 if (c_associated(c_eptr
) .or
. c_associated(c_fptr
)) stop 189
986 if (associated(eptr
) .or
. associated(fptr
)) stop 190
987 if (associated(ee
) .or
. associated(ff
)) stop 191
990 if (.not
.present(hh
)) stop 192
991 if (allocated(hh
)) stop 193
993 !$omp target data map(tofrom:hh) use_device_addr(hh)
994 if (.not
.present(hh
)) stop 194
995 if (allocated(hh
)) stop 195
996 if (c_associated(c_loc(hh
))) stop 196
999 if (c_associated(c_hptr
)) stop 197
1000 if (associated(hptr
)) stop 198
1001 if (allocated(hh
)) stop 199
1002 !$omp end target data
1004 if (c_associated(c_hptr
)) stop 200
1005 if (associated(hptr
)) stop 201
1006 if (allocated(hh
)) stop 202
1007 end subroutine test_dummy_opt_nullptr_callee_1
1008 end module test_nullptr
1012 ! Test local variables
1016 implicit none (type, external)
1018 public
:: test_main_1
, test_main_2
1020 ! map + use_device_addr + c_loc
1021 subroutine test_main_1()
1022 integer, parameter :: N
= 1000
1025 real(c_float
), target
:: aa
, bb
1026 real(c_float
), target
, allocatable
:: cc
, dd
1027 real(c_float
), pointer :: ee
, ff
1029 ! non-descriptor arrays
1030 real(c_float
), target
:: gg(N
), hh(N
)
1032 allocate(cc
, dd
, ee
, ff
)
1044 !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
1045 call copy3_scalar(c_loc(aa
), c_loc(bb
))
1046 !$omp end target data
1047 if (abs(aa
- 11.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 203
1048 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 204
1050 !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
1051 call copy3_scalar(c_loc(cc
), c_loc(dd
))
1052 !$omp end target data
1053 if (abs(cc
- 33.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 205
1054 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 206
1056 !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
1057 call copy3_scalar(c_loc(ee
), c_loc(ff
))
1058 !$omp end target data
1059 if (abs(ee
- 55.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 207
1060 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 208
1063 !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
1064 call copy3_array(c_loc(gg
), c_loc(hh
), N
)
1065 !$omp end target data
1066 if (any(abs(gg
- 77.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 209
1067 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 210
1069 deallocate(ee
, ff
) ! pointers, only
1070 end subroutine test_main_1
1072 ! Save device ptr - and recall pointer
1073 subroutine test_main_2
1074 integer, parameter :: N
= 1000
1077 real(c_float
), target
:: aa
, bb
1078 real(c_float
), target
, allocatable
:: cc
, dd
1079 real(c_float
), pointer :: ee
, ff
1081 ! non-descriptor arrays
1082 real(c_float
), target
:: gg(N
), hh(N
)
1084 real(c_float
) :: dummy
1085 type(c_ptr
) :: c_aptr
, c_bptr
, c_cptr
, c_dptr
, c_eptr
, c_fptr
, c_gptr
, c_hptr
1086 real(c_float
), pointer :: aptr
, bptr
, cptr
, dptr
, eptr
, fptr
1087 real(c_float
), pointer :: gptr(:), hptr(:)
1089 allocate(cc
, dd
, ee
, ff
)
1100 !$omp target data map(to:aa) map(from:bb)
1101 !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
1106 !$omp end target data
1108 ! check c_loc ptr once
1109 call copy3_scalar(c_aptr
, c_bptr
)
1110 !$omp target update from(bb)
1111 if (abs(aa
- 111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 211
1112 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 212
1114 ! check c_loc ptr again after target-value modification
1116 !$omp target update to(aa)
1117 call copy3_scalar(c_aptr
, c_bptr
)
1118 !$omp target update from(bb)
1119 if (abs(aa
- 1111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 213
1120 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 214
1122 ! check Fortran pointer after target-value modification
1123 aa
= 11111.0_c_float
1124 !$omp target update to(aa)
1125 call copy3_scalar(c_loc(aptr
), c_loc(bptr
))
1126 !$omp target update from(bb)
1127 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 215
1128 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 216
1129 !$omp end target data
1131 if (abs(aa
- 11111.0_c_float
) > 10.0_c_float
* epsilon(aa
)) stop 217
1132 if (abs(3.0_c_float
* aa
- bb
) > 10.0_c_float
* epsilon(aa
)) stop 218
1135 !$omp target data map(to:cc) map(from:dd)
1136 !$omp target data map(alloc:dummy) use_device_addr(cc,dd)
1141 !$omp end target data
1143 ! check c_loc ptr once
1144 call copy3_scalar(c_cptr
, c_dptr
)
1145 !$omp target update from(dd)
1146 if (abs(cc
- 333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 219
1147 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 220
1149 ! check c_loc ptr again after target-value modification
1151 !$omp target update to(cc)
1152 call copy3_scalar(c_cptr
, c_dptr
)
1153 !$omp target update from(dd)
1154 if (abs(cc
- 3333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 221
1155 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 222
1157 ! check Fortran pointer after target-value modification
1158 cc
= 33333.0_c_float
1159 !$omp target update to(cc)
1160 call copy3_scalar(c_loc(cptr
), c_loc(dptr
))
1161 !$omp target update from(dd)
1162 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(cc
)) stop 223
1163 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(cc
)) stop 224
1164 !$omp end target data
1166 if (abs(cc
- 33333.0_c_float
) > 10.0_c_float
* epsilon(dd
)) stop 225
1167 if (abs(3.0_c_float
* cc
- dd
) > 10.0_c_float
* epsilon(dd
)) stop 226
1170 !$omp target data map(to:ee) map(from:ff)
1171 !$omp target data map(alloc:dummy) use_device_addr(ee,ff)
1176 !$omp end target data
1178 ! check c_loc ptr once
1179 call copy3_scalar(c_eptr
, c_fptr
)
1180 !$omp target update from(ff)
1181 if (abs(ee
- 555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 227
1182 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 228
1184 ! check c_loc ptr again after target-value modification
1186 !$omp target update to(ee)
1187 call copy3_scalar(c_eptr
, c_fptr
)
1188 !$omp target update from(ff)
1189 if (abs(ee
- 5555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 229
1190 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 230
1192 ! check Fortran pointer after target-value modification
1193 ee
= 55555.0_c_float
1194 !$omp target update to(ee)
1195 call copy3_scalar(c_loc(eptr
), c_loc(fptr
))
1196 !$omp target update from(ff)
1197 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 231
1198 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ff
)) stop 232
1199 !$omp end target data
1201 if (abs(ee
- 55555.0_c_float
) > 10.0_c_float
* epsilon(ee
)) stop 233
1202 if (abs(3.0_c_float
* ee
- ff
) > 10.0_c_float
* epsilon(ee
)) stop 234
1205 !$omp target data map(to:gg) map(from:hh)
1206 !$omp target data map(alloc:dummy) use_device_addr(gg,hh)
1211 !$omp end target data
1213 ! check c_loc ptr once
1214 call copy3_array(c_gptr
, c_hptr
, N
)
1215 !$omp target update from(hh)
1216 if (any(abs(gg
- 777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 235
1217 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(hh
))) stop 236
1219 ! check c_loc ptr again after target-value modification
1221 !$omp target update to(gg)
1222 call copy3_array(c_gptr
, c_hptr
, N
)
1223 !$omp target update from(hh)
1224 if (any(abs(gg
- 7777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 237
1225 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 238
1227 ! check Fortran pointer after target-value modification
1228 gg
= 77777.0_c_float
1229 !$omp target update to(gg)
1230 call copy3_array(c_loc(gptr
), c_loc(hptr
), N
)
1231 !$omp target update from(hh)
1232 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 239
1233 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 240
1234 !$omp end target data
1236 if (any(abs(gg
- 77777.0_c_float
) > 10.0_c_float
* epsilon(gg
))) stop 241
1237 if (any(abs(3.0_c_float
* gg
- hh
) > 10.0_c_float
* epsilon(gg
))) stop 242
1240 end subroutine test_main_2
1244 program omp_device_addr
1247 use test_dummies_value
1248 use test_dummies_opt
1249 use test_dummies_opt_value
1251 implicit none (type, external)
1256 call test_dummy_call_1()
1257 call test_dummy_call_2()
1259 call test_dummy_val_call_1()
1260 call test_dummy_val_call_2()
1262 call test_dummy_opt_call_1()
1263 call test_dummy_opt_call_2()
1265 call test_dummy_opt_val_call_1()
1266 call test_dummy_opt_val_call_2()
1268 call test_nullptr_1()
1269 end program omp_device_addr