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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
program main
use omp_lib
use iso_c_binding
implicit none (external, type)
integer :: d, id
type(c_ptr) :: p1, p2
type t
integer :: m1, m2
end type t
type(t), target :: s
d = omp_get_default_device ()
id = omp_get_initial_device ()
if (d < 0 .or. d >= omp_get_num_devices ()) &
d = id
if (d /= id) then
!$omp target data map(alloc: s, s%m2) device(d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
stop 0
!$omp end target data
if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
stop 1
!$omp target enter data map (alloc: s, s%m2) device (d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), p2)) &
stop 2
!$omp target exit data map (delete: s, s%m2) device (d)
if (c_associated (omp_get_mapped_ptr (c_loc (s), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d))) &
stop 3
else ! d == id
!$omp target data map(alloc: s, s%m2) device(d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 4
!$omp end target data
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 5
!$omp target enter data map (alloc: s, s%m2) device (d)
!$omp target map(from: p1, p2) map(alloc: s, s%m2) device(d)
p1 = c_loc (s);
p2 = c_loc (s%m2);
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 6
!$omp target exit data map (delete: s, s%m2) device (d)
if (.not. c_associated (omp_get_mapped_ptr (c_loc (s), d), c_loc (s)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (s%m2), d), c_loc (s%m2))) &
stop 7
end if
end program main
|
