147 lines
4.1 KiB
Fortran
147 lines
4.1 KiB
Fortran
program main
|
|
use omp_lib
|
|
use iso_c_binding
|
|
implicit none (external, type)
|
|
integer :: d, id, i, j, k, l
|
|
logical :: err
|
|
integer, target :: q(0:127)
|
|
type(c_ptr) :: p
|
|
|
|
integer(kind=c_size_t) :: volume(0:2)
|
|
integer(kind=c_size_t) :: dst_offsets(0:2)
|
|
integer(kind=c_size_t) :: src_offsets(0:2)
|
|
integer(kind=c_size_t) :: dst_dimensions(0:2)
|
|
integer(kind=c_size_t) :: src_dimensions(0:2)
|
|
integer(kind=c_size_t) :: empty(1:0)
|
|
|
|
err = .false.
|
|
d = omp_get_default_device ()
|
|
id = omp_get_initial_device ()
|
|
|
|
if (d < 0 .or. d >= omp_get_num_devices ()) &
|
|
d = id
|
|
|
|
q = [(i, i = 0, 127)]
|
|
p = omp_target_alloc (130 * c_sizeof (q), d)
|
|
if (.not. c_associated (p)) &
|
|
stop 0 ! okay
|
|
|
|
if (omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
|
|
empty, empty, empty, empty, empty, d, id) < 3 &
|
|
.or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
|
|
empty, empty, empty, empty, empty, &
|
|
id, d) < 3 &
|
|
.or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
|
|
empty, empty, empty, empty, empty, &
|
|
id, id) < 3) &
|
|
stop 1
|
|
|
|
if (omp_target_associate_ptr (c_loc (q), p, 128 * c_sizeof (q(0)), &
|
|
c_sizeof (q(0)), d) == 0) then
|
|
volume = [ 128, 0, 0 ]
|
|
dst_offsets = [ 0, 0, 0 ]
|
|
src_offsets = [ 1, 0, 0 ]
|
|
dst_dimensions = [ 128, 0, 0 ]
|
|
src_dimensions = [ 128, 0, 0 ]
|
|
|
|
|
|
if (omp_target_associate_ptr (c_loc (q), p, 128 * sizeof (q(0)), &
|
|
sizeof (q(0)), d) /= 0) &
|
|
stop 2
|
|
|
|
if (omp_target_is_present (c_loc (q), d) /= 1 &
|
|
.or. omp_target_is_present (c_loc (q(32)), d) /= 1 &
|
|
.or. omp_target_is_present (c_loc (q(127)), d) /= 1) &
|
|
stop 3
|
|
|
|
if (omp_target_memcpy (p, c_loc (q), 128 * sizeof (q(0)), sizeof (q(0)), &
|
|
0_c_size_t, d, id) /= 0) &
|
|
stop 4
|
|
|
|
i = 0
|
|
if (d >= 0) i = d
|
|
!$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
|
|
err = .false.
|
|
do j = 0, 127
|
|
if (q(j) /= j) then
|
|
err = .true.
|
|
else
|
|
q(j) = q(j) + 4
|
|
end if
|
|
end do
|
|
!$omp end target
|
|
|
|
if (err) &
|
|
stop 5
|
|
|
|
if (omp_target_memcpy_rect (c_loc (q), p, sizeof (q(0)), 1, volume, &
|
|
dst_offsets, src_offsets, dst_dimensions, &
|
|
src_dimensions, id, d) /= 0) &
|
|
stop 6
|
|
|
|
do i = 0, 127
|
|
if (q(i) /= i + 4) &
|
|
stop 7
|
|
end do
|
|
|
|
volume(2) = 2
|
|
volume(1) = 3
|
|
volume(0) = 6
|
|
dst_offsets(2) = 1
|
|
dst_offsets(1) = 0
|
|
dst_offsets(0) = 0
|
|
src_offsets(2) = 1
|
|
src_offsets(1) = 0
|
|
src_offsets(0) = 3
|
|
dst_dimensions(2) = 2
|
|
dst_dimensions(1) = 3
|
|
dst_dimensions(0) = 6
|
|
src_dimensions(2) = 3
|
|
src_dimensions(1) = 4
|
|
src_dimensions(0) = 6
|
|
|
|
if (omp_target_memcpy_rect (p, c_loc (q), sizeof (q(0)), 3, volume, &
|
|
dst_offsets, src_offsets, dst_dimensions, &
|
|
src_dimensions, d, id) /= 0) &
|
|
stop 8
|
|
|
|
i = 0
|
|
if (d >= 0) i = d
|
|
!$omp target if (d >= 0) device (i) map(alloc:q(1:32)) map(from:err)
|
|
err = .false.
|
|
do j = 0, 5
|
|
do k = 0, 2
|
|
do l = 0, 1
|
|
if (q(j * 6 + k * 2 + l) /= 3 * 12 + 4 + 1 + l + k * 3 + j * 12) &
|
|
err = .true.
|
|
end do
|
|
end do
|
|
end do
|
|
!$omp end target
|
|
|
|
if (err) &
|
|
stop 9
|
|
|
|
if (omp_target_memcpy (p, p, 10 * sizeof (q(1)), 51 * sizeof (q(1)), &
|
|
111 * sizeof (q(1)), d, d) /= 0) &
|
|
stop 10
|
|
|
|
i = 0
|
|
if (d >= 0) i = d
|
|
!$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
|
|
err = .false.
|
|
do j = 1, 9
|
|
if (q(50+j) /= q(110 + j)) &
|
|
err = .true.
|
|
end do
|
|
!$omp end target
|
|
|
|
if (err) &
|
|
stop 11
|
|
|
|
if (omp_target_disassociate_ptr (c_loc (q), d) /= 0) &
|
|
stop 12
|
|
end if
|
|
|
|
call omp_target_free (p, d)
|
|
end program main
|