1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
program main
use omp_lib
use iso_c_binding
implicit none (type, external)
integer :: d, id
integer(kind=1), target :: a(4)
integer(kind=1), pointer :: p, q
d = omp_get_default_device ()
id = omp_get_initial_device ()
if (d < 0 .or. d >= omp_get_num_devices ()) &
d = id
a = transfer (int(z'cdcdcdcd'), mold=a)
!$omp target enter data map (to:a)
a = transfer (int(z'abababab'), mold=a)
p => a(1)
q => a(3)
!$omp target enter data map (alloc:p, q)
if (d /= id) then
if (omp_target_is_present (c_loc(a), d) == 0) &
stop 1
if (omp_target_is_present (c_loc(p), d) == 0) &
stop 2
if (omp_target_is_present (c_loc(q), d) == 0) &
stop 3
end if
!$omp target exit data map (release:a)
if (d /= id) then
if (omp_target_is_present (c_loc(a), d) == 0) &
stop 4
if (omp_target_is_present (c_loc(p), d) == 0) &
stop 5
if (omp_target_is_present (c_loc(q), d) == 0) &
stop 6
end if
!$omp target exit data map (from:q)
if (d /= id) then
if (omp_target_is_present (c_loc(a), d) /= 0) &
stop 7
if (omp_target_is_present (c_loc(p), d) /= 0) &
stop 8
if (omp_target_is_present (c_loc(q), d) /= 0) &
stop 9
if (q /= int(z'cd', kind=1)) &
stop 10
if (p /= int(z'ab', kind=1)) &
stop 11
end if
end program main
|
