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
|
! PR fortran/98858
!
! Assumed-size array with use_device_ptr()
!
program test_use_device_ptr
use iso_c_binding, only: c_ptr, c_loc, c_f_pointer
implicit none
double precision :: alpha
integer, parameter :: lda = 10
integer, allocatable :: mat(:, :)
integer :: i, j
allocate(mat(lda, lda))
do i = 1, lda
do j = 1, lda
mat(j,i) = i*100 + j
end do
end do
!$omp target enter data map(to:mat)
call dgemm(lda, mat)
!$omp target exit data map(from:mat)
do i = 1, lda
do j = 1, lda
if (mat(j,i) /= -(i*100 + j)) stop 1
end do
end do
!$omp target enter data map(to:mat)
call dgemm2(lda, mat)
!$omp target exit data map(from:mat)
do i = 1, lda
do j = 1, lda
if (mat(j,i) /= (i*100 + j)) stop 1
end do
end do
contains
subroutine dgemm(lda, a)
implicit none
integer :: lda
integer, target:: a(lda,*) ! need target attribute to use c_loc
!$omp target data use_device_ptr(a)
call negate_it(c_loc(a), lda)
!$omp end target data
end subroutine
subroutine dgemm2(lda, a)
implicit none
integer :: lda
integer, target:: a(lda,*) ! need target attribute to use c_loc
!$omp target data use_device_addr(a)
call negate_it(c_loc(a), lda)
!$omp end target data
end subroutine
subroutine negate_it(a, n)
type(c_ptr), value :: a
integer, value :: n
integer, pointer :: array(:,:)
! detour due to OpenMP 5.0 oddness
call c_f_pointer(a, array, [n,n])
call do_offload(array, n)
end
subroutine do_offload(aptr, n)
integer, target :: aptr(:,:)
integer, value :: n
!$omp target is_device_ptr(aptr)
call negate_it_tgt(aptr, n)
!$omp end target
end subroutine do_offload
subroutine negate_it_tgt(array, n)
!$omp declare target
integer, value :: n
integer :: array(n,n)
integer :: i, j
!$omp parallel do collapse(2)
do i = 1, n
do j = 1, n
array(j,i) = - array(j,i)
end do
end do
!$omp end parallel do
end subroutine
end program
|
