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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
program main
use omp_lib
implicit none
integer, allocatable :: aaa(:,:,:)
integer :: i
allocate (aaa(-4:10,-3:8,2))
aaa(:,:,:) = reshape ([(i, i = 1, size(aaa))], shape(aaa))
do i = 0, omp_get_num_devices()
!$omp target data map(to: aaa) device(i)
call test_addr (aaa, i)
call test_ptr (aaa, i)
!$omp end target data
end do
deallocate (aaa)
contains
subroutine test_addr (aaaa, dev)
use iso_c_binding
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
integer, value :: dev
integer :: i
type(c_ptr) :: ptr
logical :: is_shared
is_shared = .false.
!$omp target device(dev) map(to: is_shared)
is_shared = .true.
!$omp end target
allocate (bbbb(-4:10,-3:8,2))
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
!$omp target enter data map(to: bbbb) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
!$omp parallel do shared(bbbb, aaaa)
do i = 1,1
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
ptr = c_loc (aaaa)
!$omp target data use_device_addr(bbbb, aaaa) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
if (is_shared) then
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
end if
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
!$omp target has_device_addr(bbbb, aaaa) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
!$omp end target
!$omp end target data
end do
!$omp target exit data map(delete: bbbb) device(dev)
deallocate (bbbb)
end subroutine test_addr
subroutine test_ptr (aaaa, dev)
use iso_c_binding
integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:)
integer, value :: dev
integer :: i
type(c_ptr) :: ptr
logical :: is_shared
is_shared = .false.
!$omp target device(dev) map(to: is_shared)
is_shared = .true.
!$omp end target
allocate (bbbb(-4:10,-3:8,2))
bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb))
!$omp target enter data map(to: bbbb) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1
if (any (shape (aaaa) /= [15, 12, 2])) error stop 2
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3
if (any (shape (bbbb) /= [15, 12, 2])) error stop 4
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
!$omp parallel do shared(bbbb, aaaa)
do i = 1,1
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5
if (any (shape (aaaa) /= [15, 12, 2])) error stop 6
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7
if (any (shape (bbbb) /= [15, 12, 2])) error stop 8
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
ptr = c_loc (aaaa)
!$omp target data use_device_ptr(bbbb, aaaa) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
if (is_shared) then
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
end if
if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop
! Uses has_device_addr due to PR fortran/105318
!!$omp target is_device_ptr(bbbb, aaaa) device(dev)
!$omp target has_device_addr(bbbb, aaaa) device(dev)
if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9
if (any (shape (aaaa) /= [15, 12, 2])) error stop 10
if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11
if (any (shape (bbbb) /= [15, 12, 2])) error stop 12
if (any (aaaa /= -bbbb)) error stop 5
if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) &
error stop 6
!$omp end target
!$omp end target data
end do
!$omp target exit data map(delete: bbbb) device(dev)
deallocate (bbbb)
end subroutine test_ptr
end program main
|
