From patchwork Wed Aug 18 09:00:47 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1517960 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4GqMMt2R0zz9sWd for ; Wed, 18 Aug 2021 19:01:45 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E64C43985813 for ; Wed, 18 Aug 2021 09:01:41 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 382C63858022; Wed, 18 Aug 2021 09:00:56 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 382C63858022 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: MSQ9kVqQMA0aKqB91OmYURwwIRROMVknJfHfoG+JIKPqG054fbDFm0F1l205ZYPIfU7a9jrAyX 0hx5bdbHduCACfEuQpqkJlmzd7EsnM9v048evs2+YzhpfnflAqwf8BbWH5lqpwUXECr5H6JmnG kqWdV0pE7n0CywclH9zR3/LsW1Qld7+JRJz2Ltd2QcaYocetWvIN/UY2bAHhAhESWtMyQ1s2se TzMKoC4EStoTsh/zPoQpCJwAw10nEELWaHcRM8QjRcsdvFCXacWy/M1IOy+QMP7SDUaRuf32un lH5UmM33wzlRWZcw19yZfyEZ X-IronPort-AV: E=Sophos;i="5.84,330,1620720000"; d="diff'?scan'208";a="67320800" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 18 Aug 2021 01:00:56 -0800 IronPort-SDR: 1cwyBzP1xl1jSSEPn/cYacHhm7gEvqMa//eVVj2zMmmN1D8i6Mt17Df8BDnLID5obWOgMPTLiD YChwDuRqqSmzRINn8G0vrIulKyK3AEbiVJF4C7QkVIjB/S4Fts+hPysYvu53zJ6vgE5pAU3zLK gUrLswAYT49XvlBVldaYcmYHiLM9lfaThFVK1KO3HIB9d8LhihOS3PA23pWnnrnJW+Y3I1t5ck w4wDUiFuJaffDrNAhPzLTLqc/eiC9AqXXYoznzJtdN05n/JDpgLKWx0vty8wTVpy5PccEnS95M guU= To: Jakub Jelinek , gcc-patches , fortran From: Tobias Burnus Subject: [Patch] Fortran/OpenMP: Add memory routines existing for C/C++ Message-ID: <2683f60a-9971-ce70-16af-7dc700039f8e@codesourcery.com> Date: Wed, 18 Aug 2021 11:00:47 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.13.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-05.mgc.mentorg.com (139.181.222.5) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" 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 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