| 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 |
