mirror of git://gcc.gnu.org/git/gcc.git
85 lines
2.6 KiB
Fortran
85 lines
2.6 KiB
Fortran
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
|