diff mbox series

Fortran/OpenMP: Add memory routines existing for C/C++

Message ID 2683f60a-9971-ce70-16af-7dc700039f8e@codesourcery.com
State New
Headers show
Series Fortran/OpenMP: Add memory routines existing for C/C++ | expand

Commit Message

Tobias Burnus Aug. 18, 2021, 9 a.m. UTC 
The added routines existed before for C/C++ (being part of OpenMP 5.0)
but not for Fortran (new there since OpenMP 5.1) – as those are all bind(C),
it only affects 'omp_lib' and uses the C interface otherwise.

Note 1: OpenMP 5.1 added additional (target) memory routines for
C/C++ and Fortran; those are not included here.

---------------- Note 2 -----------------------
'omp_lib.h' is included in as declaration-construct in the
specification-part of a file (i.e. possibly after an implicit statement);
hence, it cannot contain a use-stmt.  Additionally, it needs to support
both free- and fixed-form source files.
While thought to be compatible with Fortran 77, nothing actually requires
that only Fortran 77 code is used and gfortran only supports -std=f95 or
higher.

Hence, (rightly!) assuming that only gfortran compiles that file,
Fortran 90 + 95 features can be used; the code already uses TYPE.

However, the the attached patch also BIND(C) + IMPORT, which are
Fortran 2003 features, effectively preventing the compilation with
-std=f95.

My impression is that old code (Fortran IV, 66, 77, older 90/95) code
tends to use vendor extension (preventing the compilation with -std=f*)
and users do not care about setting -std=f* flags.
Or the code is old but still maintained. But in that case, new features
of Fortran 2003 (and later) intentionally and/or accidentally get used,
already preventing the compilation with -std=f95.

Thus, I think it is okay to use a Fortran 2003 feature.
---------------- End of Note 2 -----------------------

The testcases are those for C/C++ converted to Fortran.
Comments? OK?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

Comments

Jakub Jelinek Aug. 18, 2021, 9:09 a.m. UTC | #1 
On Wed, Aug 18, 2021 at 11:00:47AM +0200, Tobias Burnus wrote:
> ---------------- Note 2 -----------------------
> 'omp_lib.h' is included in as declaration-construct in the
> specification-part of a file (i.e. possibly after an implicit statement);
> hence, it cannot contain a use-stmt.  Additionally, it needs to support
> both free- and fixed-form source files.
> While thought to be compatible with Fortran 77, nothing actually requires
> that only Fortran 77 code is used and gfortran only supports -std=f95 or
> higher.
> 
> Hence, (rightly!) assuming that only gfortran compiles that file,
> Fortran 90 + 95 features can be used; the code already uses TYPE.
> 
> However, the the attached patch also BIND(C) + IMPORT, which are
> Fortran 2003 features, effectively preventing the compilation with
> -std=f95.
> 
> My impression is that old code (Fortran IV, 66, 77, older 90/95) code
> tends to use vendor extension (preventing the compilation with -std=f*)
> and users do not care about setting -std=f* flags.
> Or the code is old but still maintained. But in that case, new features
> of Fortran 2003 (and later) intentionally and/or accidentally get used,
> already preventing the compilation with -std=f95.
> 
> Thus, I think it is okay to use a Fortran 2003 feature.

Perhaps we could add some new !GCC$ extension that would temporarily
turn off errors about new language features (or temporarily switch language
version), slightly similar to
#pragma GCC push_options
#pragma GCC ...
...
#pragma GCC pop_options
except that in C/C++ one can't change the language version (but on the other
side we have __extension__ and system headers surpressing some diagnostics).

> libgomp/ChangeLog:
> 
> 	* omp_lib.f90.in (omp_alloc, omp_free, omp_target_alloc,
> 	omp_target_free. omp_target_is_present, omp_target_memcpy,
> 	omp_target_memcpy_rect, omp_target_associate_ptr,
> 	omp_target_disassociate_ptr): Add interface.
> 	* omp_lib.h.in (omp_alloc, omp_free, omp_target_alloc,
> 	omp_target_free. omp_target_is_present, omp_target_memcpy,
> 	omp_target_memcpy_rect, omp_target_associate_ptr,
> 	omp_target_disassociate_ptr): Add interface.
> 	* testsuite/libgomp.fortran/alloc-1.F90: Remove local
> 	interface block for omp_alloc + omp_free.
> 	* testsuite/libgomp.fortran/alloc-4.f90: Likewise.
> 	* testsuite/libgomp.fortran/refcount-1.f90: New test.
> 	* testsuite/libgomp.fortran/target-12.f90: New test.
> 
>  libgomp/omp_lib.f90.in                           |  94 +++++++++++++++
>  libgomp/omp_lib.h.in                             |  97 +++++++++++++++
>  libgomp/testsuite/libgomp.fortran/alloc-1.F90    |  16 ---
>  libgomp/testsuite/libgomp.fortran/alloc-4.f90    |  16 ---
>  libgomp/testsuite/libgomp.fortran/refcount-1.f90 |  61 ++++++++++
>  libgomp/testsuite/libgomp.fortran/target-12.f90  | 147 +++++++++++++++++++++++
>  6 files changed, 399 insertions(+), 32 deletions(-)

Ok.

	Jakub
diff mbox series

Patch

Fortran/OpenMP: Add memory routines existing for C/C++

This patch adds the Fortran interface for omp_alloc/omp_free
and the omp_target_* memory routines, which were added in
OpenMP 5.0 for C/C++ but only OpenMP 5.1 added them for Fortran.

Those functions use BIND(C), i.e. on the libgomp side, the same
interface as for C/C++ is used.

Note: By using BIND(C) in omp_lib.h, files including this file
no longer compiler with -std=f95 but require at least -std=f2003.

libgomp/ChangeLog:

	* omp_lib.f90.in (omp_alloc, omp_free, omp_target_alloc,
	omp_target_free. omp_target_is_present, omp_target_memcpy,
	omp_target_memcpy_rect, omp_target_associate_ptr,
	omp_target_disassociate_ptr): Add interface.
	* omp_lib.h.in (omp_alloc, omp_free, omp_target_alloc,
	omp_target_free. omp_target_is_present, omp_target_memcpy,
	omp_target_memcpy_rect, omp_target_associate_ptr,
	omp_target_disassociate_ptr): Add interface.
	* testsuite/libgomp.fortran/alloc-1.F90: Remove local
	interface block for omp_alloc + omp_free.
	* testsuite/libgomp.fortran/alloc-4.f90: Likewise.
	* testsuite/libgomp.fortran/refcount-1.f90: New test.
	* testsuite/libgomp.fortran/target-12.f90: New test.

 libgomp/omp_lib.f90.in                           |  94 +++++++++++++++
 libgomp/omp_lib.h.in                             |  97 +++++++++++++++
 libgomp/testsuite/libgomp.fortran/alloc-1.F90    |  16 ---
 libgomp/testsuite/libgomp.fortran/alloc-4.f90    |  16 ---
 libgomp/testsuite/libgomp.fortran/refcount-1.f90 |  61 ++++++++++
 libgomp/testsuite/libgomp.fortran/target-12.f90  | 147 +++++++++++++++++++++++
 6 files changed, 399 insertions(+), 32 deletions(-)

diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index 6394e65bbf7..a36a5626123 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -670,6 +670,100 @@ 
           end subroutine omp_display_env_8
         end interface
 
+        interface
+          function omp_alloc (size, allocator) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+            import :: omp_allocator_handle_kind
+            type(c_ptr) :: omp_alloc
+            integer(c_size_t), value :: size
+            integer(omp_allocator_handle_kind), value :: allocator
+          end function omp_alloc
+        end interface
+
+        interface
+          subroutine omp_free(ptr, allocator) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr
+            import :: omp_allocator_handle_kind
+            type(c_ptr), value :: ptr
+            integer(omp_allocator_handle_kind), value :: allocator
+          end subroutine
+        end interface
+
+        interface
+          function omp_target_alloc (size, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+            type(c_ptr) :: omp_target_alloc
+            integer(c_size_t), value :: size
+            integer(c_int), value :: device_num
+          end function omp_target_alloc
+        end interface
+
+        interface
+          subroutine omp_target_free (device_ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            type(c_ptr), value :: device_ptr
+            integer(c_int), value :: device_num
+          end subroutine omp_target_free
+        end interface
+
+        interface
+          function omp_target_is_present (ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            integer(c_int) :: omp_target_is_present
+            type(c_ptr), value :: ptr
+            integer(c_int), value :: device_num
+          end function omp_target_is_present
+        end interface
+
+        interface
+          function omp_target_memcpy (dst, src, length, dst_offset, &
+                                      src_offset, dst_device_num, &
+                                      src_device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+            integer(c_int) :: omp_target_memcpy
+            type(c_ptr), value :: dst, src
+            integer(c_size_t), value :: length, dst_offset, src_offset
+            integer(c_int), value :: dst_device_num, src_device_num
+          end function omp_target_memcpy
+        end interface
+
+        interface
+          function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
+                                           volume, dst_offsets, src_offsets, &
+                                           dst_dimensions, src_dimensions, &
+                                           dst_device_num, src_device_num) &
+              bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+            integer(c_int) :: omp_target_memcpy_rect
+            type(c_ptr), value :: dst, src
+            integer(c_size_t), value :: element_size
+            integer(c_int), value :: num_dims, dst_device_num, src_device_num
+            integer(c_size_t), intent(in) :: volume(*), dst_offsets(*),  &
+                                             src_offsets(*), dst_dimensions(*), &
+                                             src_dimensions(*)
+          end function omp_target_memcpy_rect
+        end interface
+
+        interface
+          function omp_target_associate_ptr (host_ptr, device_ptr, size, &
+                                             device_offset, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+            integer(c_int) :: omp_target_associate_ptr
+            type(c_ptr), value :: host_ptr, device_ptr
+            integer(c_size_t), value :: size, device_offset
+            integer(c_int), value :: device_num
+          end function omp_target_associate_ptr
+        end interface
+
+        interface
+          function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+            use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+            integer(c_int) :: omp_target_disassociate_ptr
+            type(c_ptr), value :: ptr
+            integer(c_int), value :: device_num
+          end function omp_target_disassociate_ptr
+        end interface
+
 #if _OPENMP >= 201811
 !GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
 #endif
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index f2ad445f924..1c2eacba554 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -271,3 +271,100 @@ 
       integer (omp_allocator_handle_kind) omp_get_default_allocator
 
       external omp_display_env
+
+      interface
+        function omp_alloc (size, allocator) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+          use, intrinsic :: omp_lib_kinds
+          type(c_ptr) :: omp_alloc
+          integer(c_size_t), value :: size
+          integer(omp_allocator_handle_kind), value :: allocator
+        end function omp_alloc
+      end interface
+
+      interface
+        subroutine omp_free(ptr, allocator) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr
+          use, intrinsic :: omp_lib_kinds
+          type(c_ptr), value :: ptr
+          integer(omp_allocator_handle_kind), value :: allocator
+        end subroutine
+      end interface
+
+      interface
+        function omp_target_alloc (size, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+          type(c_ptr) :: omp_target_alloc
+          integer(c_size_t), value :: size
+          integer(c_int), value :: device_num
+        end function omp_target_alloc
+      end interface
+
+      interface
+        subroutine omp_target_free (device_ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          type(c_ptr), value :: device_ptr
+          integer(c_int), value :: device_num
+        end subroutine omp_target_free
+      end interface
+
+      interface
+        function omp_target_is_present (ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          integer(c_int) :: omp_target_is_present
+          type(c_ptr), value :: ptr
+          integer(c_int), value :: device_num
+        end function omp_target_is_present
+      end interface
+
+      interface
+        function omp_target_memcpy (dst, src, length, dst_offset,          &
+     &                              src_offset, dst_device_num,            &
+     &                              src_device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+          integer(c_int) :: omp_target_memcpy
+          type(c_ptr), value :: dst, src
+          integer(c_size_t), value :: length, dst_offset, src_offset
+          integer(c_int), value :: dst_device_num, src_device_num
+        end function omp_target_memcpy
+      end interface
+
+      interface
+        function omp_target_memcpy_rect (dst,src,element_size, num_dims,   &
+     &                                   volume, dst_offsets,              &
+     &                                   src_offsets, dst_dimensions,      &
+     &                                   src_dimensions, dst_device_num,   &
+     &                                   src_device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+          integer(c_int) :: omp_target_memcpy_rect
+          type(c_ptr), value :: dst, src
+          integer(c_size_t), value :: element_size
+          integer(c_int), value :: num_dims
+          integer(c_int), value :: dst_device_num, src_device_num
+          integer(c_size_t), intent(in) :: volume(*), dst_offsets(*)
+          integer(c_size_t), intent(in) :: src_offsets(*)
+          integer(c_size_t), intent(in) :: dst_dimensions(*)
+          integer(c_size_t), intent(in) :: src_dimensions(*)
+        end function omp_target_memcpy_rect
+      end interface
+
+      interface
+        function omp_target_associate_ptr (host_ptr, device_ptr, size,     &
+     &                                     device_offset, device_num)      &
+     &      bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+          integer(c_int) :: omp_target_associate_ptr
+          type(c_ptr), value :: host_ptr, device_ptr
+          integer(c_size_t), value :: size, device_offset
+          integer(c_int), value :: device_num
+        end function omp_target_associate_ptr
+      end interface
+
+      interface
+        function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+          use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+          integer(c_int) :: omp_target_disassociate_ptr
+          type(c_ptr), value :: ptr
+          integer(c_int), value :: device_num
+        end function omp_target_disassociate_ptr
+      end interface
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-1.F90 b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
index 178ce771d45..e6365831984 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-1.F90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
@@ -36,22 +36,6 @@ 
 
         type (omp_alloctrait), allocatable :: traits(:), traits5(:)
 
-        interface
-          ! omp_alloc + omp_free part of OpenMP for C/C++
-          ! but not (yet) in the OpenMP spec for Fortran
-          type(c_ptr) function omp_alloc (size, handle) bind(C)
-            import
-            integer (c_size_t), value :: size
-            integer (omp_allocator_handle_kind), value :: handle
-          end function
-
-          subroutine omp_free (ptr, handle) bind(C)
-            import
-            type (c_ptr), value :: ptr
-            integer (omp_allocator_handle_kind), value :: handle
-          end subroutine
-        end interface
-
         type(c_ptr), volatile :: cp, cq, cr
         integer :: i
         integer(c_intptr_t) :: intptr
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
index ce353b55eb0..87b6adda645 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-4.f90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
@@ -3,22 +3,6 @@  program main
   use ISO_C_Binding
   implicit none (external, type)
 
-  interface
-    ! omp_alloc + omp_free part of OpenMP for C/C++
-    ! but not (yet) in the OpenMP spec for Fortran
-    type(c_ptr) function omp_alloc (size, handle) bind(C)
-      import
-      integer (c_size_t), value :: size
-      integer (omp_allocator_handle_kind), value :: handle
-    end function
-
-    subroutine omp_free (ptr, handle) bind(C)
-      import
-      type (c_ptr), value :: ptr
-      integer (omp_allocator_handle_kind), value :: handle
-    end subroutine
-  end interface
-
   type (omp_alloctrait) :: traits(3)
   integer (omp_allocator_handle_kind) :: a
 
diff --git a/libgomp/testsuite/libgomp.fortran/refcount-1.f90 b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
new file mode 100644
index 00000000000..e3b9d04af81
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
@@ -0,0 +1,61 @@ 
+program main
+  use omp_lib
+  use iso_c_binding
+  implicit none (type, external)
+
+  integer :: d, id
+  integer(kind=1), target :: a(4)
+  integer(kind=1), pointer :: p, q
+
+  d = omp_get_default_device ()
+  id = omp_get_initial_device ()
+
+  if (d < 0 .or. d >= omp_get_num_devices ()) &
+    d = id
+
+  a = transfer (int(z'cdcdcdcd'), mold=a)
+
+  !$omp target enter data map (to:a)
+
+  a = transfer (int(z'abababab'), mold=a)
+  p => a(1)
+  q => a(3)
+
+  !$omp target enter data map (alloc:p, q)
+
+  if (d /= id) then
+    if (omp_target_is_present (c_loc(a), d) == 0) &
+      stop 1
+    if (omp_target_is_present (c_loc(p), d) == 0) &
+      stop 2
+    if (omp_target_is_present (c_loc(q), d) == 0) &
+      stop 3
+  end if
+
+  !$omp target exit data map (release:a)
+
+    if (d /= id) then
+      if (omp_target_is_present (c_loc(a), d) == 0) &
+        stop 4
+      if (omp_target_is_present (c_loc(p), d) == 0) &
+        stop 5
+      if (omp_target_is_present (c_loc(q), d) == 0) &
+        stop 6
+    end if
+
+  !$omp target exit data map (from:q)
+
+    if (d /= id) then
+      if (omp_target_is_present (c_loc(a), d) /= 0) &
+        stop 7
+      if (omp_target_is_present (c_loc(p), d) /= 0) &
+        stop 8
+      if (omp_target_is_present (c_loc(q), d) /= 0) &
+        stop 9
+
+      if (q /= int(z'cd', kind=1)) &
+        stop 10
+      if (p /= int(z'ab', kind=1)) &
+        stop 11
+    end if
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/target-12.f90 b/libgomp/testsuite/libgomp.fortran/target-12.f90
new file mode 100644
index 00000000000..17c78f18f9b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-12.f90
@@ -0,0 +1,147 @@ 
+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