blob: 66a0b88f612fecf70a24f7ec46247606c6d1e42a [file] [log] [blame]
program main
use omp_lib
use iso_c_binding
implicit none (external, type)
integer :: d, id, i, j
integer, target :: a, b(1:2), c(1:2), e(0:127)
type(c_ptr) :: p1, p2, p3, q, devptrs(0:63)
a = 42;
q = c_loc (a);
e = [(i, i = 0, 127)]
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: a, b, c(2), e(32:95)) device(d)
!$omp target map(from: p1, p2, p3, devptrs) map(alloc: a, b, c(2), e(32:95)) device(d)
p1 = c_loc (a);
p2 = c_loc (b);
p3 = c_loc (c(2))
devptrs = [(c_loc (e(i)), i = 32, 95)]
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), p2) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d), p2) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), p3) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d))) &
stop 0
do j = 0, 31
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 1
end do
do j = 32, 95
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d), devptrs(j-32))) &
stop 2
end do
do j = 96, 128
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 3
end do
!$omp end target data
if (c_associated (omp_get_mapped_ptr (c_loc (a), d)) &
.or. c_associated (omp_get_mapped_ptr (q, d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (b), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d))) &
stop 4
do j = 0, 127
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 5
end do
!$omp target enter data map (alloc: a, b, c(2), e(32:95)) device (d)
!$omp target map(from: p1, p2, p3, devptrs) map(alloc: a, b, c(2), e(32:95)) device(d)
p1 = c_loc (a);
p2 = c_loc (b);
p3 = c_loc (c(2))
devptrs = [(c_loc (e(i)), i = 32, 95)]
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), p1) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), p2) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), p3) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d))) &
stop 6
do j = 0, 31
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 7
end do
do j = 32, 95
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d), devptrs(j-32))) &
stop 8
end do
do j = 96, 128
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 9
end do
!$omp target exit data map (delete: a, b, c(2), e(32:95)) device (d)
if (c_associated (omp_get_mapped_ptr (c_loc (a), d)) &
.or. c_associated (omp_get_mapped_ptr (q, d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (b), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d)) &
.or. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d))) &
stop 10
do j = 0, 127
if (c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 11
end do
else ! d == id
!$omp target data map(alloc: a, b, c(2), e(32:95)) device(d)
!$omp target map(from: p1, p2, p3, devptrs) map(alloc: a, b, c(2), e(32:95)) device(d)
p1 = c_loc (a);
p2 = c_loc (b);
p3 = c_loc (c(2))
devptrs = [(c_loc (e(i)), i = 32, 95)]
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), c_loc (a)) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), q) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), c_loc (b)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d), c_loc (b(1))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), c_loc (c(2))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d), c_loc (c(1)))) &
stop 12
do j = 0, 127
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d), c_loc (e(j)))) &
stop 13
end do
!$omp end target data
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), c_loc (a)) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), q) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), c_loc (b)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d), c_loc (b(1))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), c_loc (c(2))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d), c_loc (c(1)))) &
stop 14
do j = 0, 127
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d))) &
stop 15
end do
!$omp target enter data map (alloc: a, b, c(2), e(32:95)) device (d)
!$omp target map(from: p1, p2, p3, devptrs) map(alloc: a, b, c(2), e(32:95)) device(d)
p1 = c_loc (a);
p2 = c_loc (b);
p3 = c_loc (c(2))
devptrs = [(c_loc (e(i)), i = 32, 95)]
!$omp end target
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), c_loc (a)) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), q) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), c_loc (b)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d), c_loc (b(1))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), c_loc (c(2))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d), c_loc (c(1)))) &
stop 16
do j = 0, 127
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d), c_loc (e(j)))) &
stop 17
end do
!$omp target exit data map (delete: a, b, c(2), e(32:95)) device (d)
if (.not. c_associated (omp_get_mapped_ptr (c_loc (a), d), c_loc (a)) &
.or. .not. c_associated (omp_get_mapped_ptr (q, d), q) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b), d), c_loc (b)) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (b(1)), d), c_loc (b(1))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(2)), d), c_loc (c(2))) &
.or. .not. c_associated (omp_get_mapped_ptr (c_loc (c(1)), d), c_loc (c(1)))) &
stop 18
do j = 0, 127
if (.not. c_associated (omp_get_mapped_ptr (c_loc (e(j)), d), c_loc (e(j)))) &
stop 19
end do
end if
end program main