This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: Implementing OpenACC's Fortran module
- From: James Norris <jnorris at codesourcery dot com>
- To: Tobias Burnus <burnus at net-b dot de>
- Cc: Thomas Schwinge <thomas at codesourcery dot com>, <fortran at gcc dot gnu dot org>, <jakub at redhat dot com>
- Date: Fri, 15 Aug 2014 14:07:53 -0500
- Subject: Re: Implementing OpenACC's Fortran module
- Authentication-results: sourceware.org; auth=none
- References: <87lhs5rwzo dot fsf at schwinge dot name> <53C544C3 dot 1010604 at mentor dot com> <20140722133959 dot GA11110 at physik dot fu-berlin dot de> <874my9s45m dot fsf at schwinge dot name> <53D3F650 dot 6080601 at net-b dot de>
Tobias,
Attached are my latest versions of the OpenACC header files. The testing
I've
done with the headers are using a version of the fortran compiler with your
patches applied. So far, no issues with the patches!
Regards,
Jim
! Copyright (C) 2014 Free Software Foundation, Inc.
! Contributed by Tobias Burnus <burnus@net-b.de>
! This file is part of the GNU OpenMP Library (libgomp).
! Libgomp is free software; you can redistribute it and/or modify it
! under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3, or (at your option)
! any later version.
! Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for
! more details.
! Under Section 7 of GPL version 3, you are granted additional
! permissions described in the GCC Runtime Library Exception, version
! 3.1, as published by the Free Software Foundation.
! You should have received a copy of the GNU General Public License and
! a copy of the GCC Runtime Library Exception along with this program;
! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
! <http://www.gnu.org/licenses/>.
module openacc_kinds
use iso_fortran_env, only: int32
implicit none
private :: int32
public :: acc_device_kind
integer, parameter :: acc_device_kind = int32
public :: acc_device_none, acc_device_default, acc_device_host
public :: acc_device_not_host, acc_device_nvidia
integer (acc_device_kind), parameter :: acc_device_none = 0
integer (acc_device_kind), parameter :: acc_device_default = 1
integer (acc_device_kind), parameter :: acc_device_host = 2
integer (acc_device_kind), parameter :: acc_device_not_host = 3
integer (acc_device_kind), parameter :: acc_device_nvidia = 4
public :: acc_handle_kind
integer, parameter :: acc_handle_kind = int32
public :: acc_async_noval, acc_async_sync
integer (acc_handle_kind), parameter :: acc_async_noval = -1
integer (acc_handle_kind), parameter :: acc_async_sync = -2
end module
module openacc
use openacc_kinds
implicit none
private
public :: openacc_version
public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
public :: acc_set_device_num, acc_get_device_num, acc_async_test
public :: acc_async_test_all, acc_wait, acc_wait_async, acc_wait_all
public :: acc_wait_all_async, acc_init, acc_shutdown, acc_on_device
public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
public :: acc_update_device, acc_update_self, acc_is_present
public :: acc_get_num_devices_l, acc_set_device_type_l, acc_get_device_type_l
public :: acc_set_device_num_l, acc_get_device_num_l, acc_async_test_l
public :: acc_async_test_all_l, acc_wait_l, acc_wait_async_l, acc_wait_all_l
public :: acc_wait_all_async_l, acc_init_l, acc_shutdown_l, acc_on_device_l
public :: acc_copyin_l, acc_present_or_copyin_l, acc_create_l
public :: acc_present_or_create_l, acc_copyout_l, acc_delete_l
public :: acc_update_device_l, acc_update_self_l, acc_is_present_l
integer, parameter :: openacc_version = 201306
! TODO:
! - Add acc_async_noval and acc_async_sync
! - Add integer parameters to describe types of accelerators
! - Check whether the library calls are fine.
interface acc_get_num_devices
procedure :: acc_get_num_devices
end interface
interface acc_set_device_type
procedure :: acc_set_device_type
end interface
interface acc_get_device_type
procedure :: acc_get_device_type
end interface
interface acc_set_device_num
procedure :: acc_set_device_num
end interface
interface acc_get_device_num
procedure :: acc_get_device_num
end interface
interface acc_async_test
procedure :: acc_async_test
end interface
interface acc_async_test_all
procedure :: acc_async_test_all
end interface
interface acc_wait
procedure :: acc_wait
end interface
interface acc_wait_async
procedure :: acc_wait_async
end interface
interface acc_wait_all
procedure :: acc_wait_all
end interface
interface acc_wait_all_async
procedure :: acc_wait_all_async
end interface
interface acc_init
procedure :: acc_init
end interface
interface acc_shutdown
procedure :: acc_shutdown
end interface
interface acc_on_device
procedure :: acc_on_device
end interface
! acc_malloc: Only available in C/C++
! acc_free: Only available in C/C++
! As vendor extension, the following code supports both 32bit and 64bit
! arguments for "size"; the OpenACC standard only permits default-kind
! integers, which are of kind 4 (i.e. 32 bits).
! Additionally, the two-argument version also takes arrays as argument.
! and the one argument version also scalars. Note that the code assumes
! that the arrays are contiguous.
interface acc_copyin
procedure :: acc_copyin_32
procedure :: acc_copyin_64
procedure :: acc_copyin_array
end interface
interface acc_present_or_copyin
procedure :: acc_present_or_copyin_32
procedure :: acc_present_or_copyin_64
procedure :: acc_present_or_copyin_array
end interface
interface acc_pcopyin
procedure :: acc_present_or_copyin_32
procedure :: acc_present_or_copyin_64
procedure :: acc_present_or_copyin_array
end interface
interface acc_create
procedure :: acc_create_32
procedure :: acc_create_64
procedure :: acc_create_array
end interface
interface acc_present_or_create
procedure :: acc_present_or_create_32
procedure :: acc_present_or_create_64
procedure :: acc_present_or_create_array
end interface
interface acc_pcreate
procedure :: acc_present_or_create_32
procedure :: acc_present_or_create_64
procedure :: acc_present_or_create_array
end interface
interface acc_copyout
procedure :: acc_copyout_32
procedure :: acc_copyout_64
procedure :: acc_copyout_array
end interface
interface acc_delete
procedure :: acc_delete_32
procedure :: acc_delete_64
procedure :: acc_delete_array
end interface
interface acc_update_device
procedure :: acc_update_device_32
procedure :: acc_update_device_64
procedure :: acc_update_device_array
end interface
interface acc_update_self
procedure :: acc_update_self_32
procedure :: acc_update_self_64
procedure :: acc_update_self_array
end interface
! acc_map_data: Only available in C/C++
! acc_unmap_data: Only available in C/C++
! acc_deviceptr: Only available in C/C++
! acc_hostptr: Only available in C/C++
interface acc_is_present
procedure :: acc_is_present_32
procedure :: acc_is_present_64
procedure :: acc_is_present_array
end interface
! acc_memcpy_to_device: Only available in C/C++
! acc_memcpy_from_device: Only available in C/C++
! The actual library implementations, matching the C version
interface
function acc_get_num_devices_l (d) &
bind (C, name="acc_get_num_devices")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_num_devices_l
integer (c_int), value :: d
end function
subroutine acc_set_device_type_l (d) &
bind (C, name="acc_set_device_type")
use iso_c_binding, only: c_int
integer (c_int), value :: d
end subroutine
function acc_get_device_type_l () &
bind (C, name="acc_get_device_type")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_device_type_l
end function
subroutine acc_set_device_num_l (n, d) &
bind (C, name="acc_set_device_num")
use iso_c_binding, only: c_int
integer (c_int), value :: n, d
end subroutine
function acc_get_device_num_l (d) &
bind (C, name="acc_get_device_num")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_device_num_l
integer (c_int), value :: d
end function
function acc_async_test_l (a) &
bind (C, name="acc_async_test")
use iso_c_binding, only: c_int
integer (c_int) :: acc_async_test_l
integer (c_int), value :: a
end function
function acc_async_test_all_l () &
bind (C, name="acc_async_test_all")
use iso_c_binding, only: c_int
integer (c_int) :: acc_async_test_all_l
end function
subroutine acc_wait_l (a) &
bind (C, name="acc_wait")
use iso_c_binding, only: c_int
integer (c_int), value :: a
end subroutine
subroutine acc_wait_async_l (a1, a2) &
bind (C, name="acc_wait_async")
use iso_c_binding, only: c_int
integer (c_int), value :: a1, a2
end subroutine
subroutine acc_wait_all_l () &
bind (C, name="acc_wait_all")
use iso_c_binding, only: c_int
end subroutine
subroutine acc_wait_all_async_l (a) &
bind (C, name="acc_wait_all_async")
use iso_c_binding, only: c_int
integer (c_int), value :: a
end subroutine
subroutine acc_init_l (d) &
bind(C, name="acc_init")
use iso_c_binding, only: c_int
integer (c_int), value :: d
end subroutine
subroutine acc_shutdown_l (d) &
bind(C, name="acc_shutdown")
use iso_c_binding, only: c_int
integer (c_int), value :: d
end subroutine
function acc_on_device_l (d) &
bind (C, name="gomp_ialias_acc_on_device")
use iso_c_binding, only: c_int
integer (c_int) :: acc_on_device_l
integer (c_int), value :: d
end function
subroutine acc_copyin_l (a, len) &
bind(C, name="acc_copyin")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_present_or_copyin_l (a, len) &
bind(C, name="acc_present_or_copyin")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_create_l (a, len) &
bind(C, name="acc_create")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_present_or_create_l (a, len) &
bind(C, name="acc_present_or_create")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_copyout_l (a, len) &
bind(C, name="acc_copyout")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_delete_l (a, len) &
bind(C, name="acc_delete")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_update_device_l (a, len) &
bind(C, name="acc_update_device")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
subroutine acc_update_self_l (a, len) &
bind(C, name="acc_update_self")
use iso_c_binding, only: c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end subroutine
function acc_is_present_l (a, len) &
bind(C, name="acc_is_present")
use iso_c_binding, only: c_size_t, c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
integer (c_int32_t) :: acc_is_present_l
type(*), dimension(*) :: a
integer(c_size_t), value :: len
end function
end interface
contains ! Implement the wrapper procedures
function acc_get_num_devices (d)
use openacc_kinds
integer :: acc_get_num_devices
integer (acc_device_kind), value :: d
acc_get_num_devices = acc_get_num_devices_l (d)
end function
subroutine acc_set_device_type (d)
use iso_c_binding, only: c_int
use openacc_kinds
integer (acc_device_kind), value :: d
call acc_set_device_type_l (int(d, kind=c_int))
end subroutine
function acc_get_device_type ()
use openacc_kinds
integer (acc_device_kind) :: acc_get_device_type
acc_get_device_type = acc_get_device_type_l ()
end function
subroutine acc_set_device_num (n, d)
use iso_c_binding, only: c_int
use openacc_kinds
integer, value :: n
integer (acc_device_kind), value :: d
call acc_set_device_num_l (int(n, kind=c_int), int(d, kind=c_int))
end subroutine
function acc_get_device_num (d)
use iso_c_binding, only: c_int
use openacc_kinds
integer :: acc_get_device_num
integer (acc_device_kind), value :: d
acc_get_device_num = acc_get_device_num_l (int(d, kind=c_int))
end function
function acc_async_test (a)
use iso_c_binding, only: c_int
logical :: acc_async_test
integer, value :: a
if (acc_async_test_l (int(a, kind=c_int)) .eq. 1) then
acc_async_test = .TRUE.
else
acc_async_test = .FALSE.
end if
end function
function acc_async_test_all ()
logical :: acc_async_test_all
if (acc_async_test_all_l () .eq. 1) then
acc_async_test_all = .TRUE.
else
acc_async_test_all = .FALSE.
end if
end function
subroutine acc_wait (a)
use iso_c_binding, only: c_int
integer, value :: a
call acc_wait_l (int(a, kind=c_int))
end subroutine
subroutine acc_wait_all ()
call acc_wait_all_l ()
end subroutine
subroutine acc_wait_async (a1, a2)
use iso_c_binding, only: c_int
integer, value :: a1, a2
call acc_wait_async_l (int(a1, kind=c_int), int(a2, kind=c_int))
end subroutine
subroutine acc_wait_all_async (a)
use iso_c_binding, only: c_int
integer, value :: a
call acc_wait_all_async_l (a)
end subroutine
subroutine acc_init (d)
use openacc_kinds
use iso_c_binding, only: c_int
integer(acc_device_kind) :: d
call acc_init_l (int (d, kind=c_int))
end subroutine
subroutine acc_shutdown (d)
use openacc_kinds
use iso_c_binding, only: c_int
integer(acc_device_kind), value :: d
call acc_shutdown_l (int (d, kind=c_int))
end subroutine
function acc_on_device (d)
use iso_c_binding, only: c_int
use openacc_kinds
integer (acc_device_kind), value :: d
logical :: acc_on_device
if (acc_on_device_l (int(d, kind=c_int)) .eq. 1) then
acc_on_device = .TRUE.
else
acc_on_device = .FALSE.
end if
end function
subroutine acc_copyin_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyin_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyin_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_copyin_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_present_or_copyin_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_present_or_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_copyin_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) :: len
call acc_present_or_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_copyin_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_present_or_copyin_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_create_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_create_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_create_array(a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_create_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_present_or_create_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_present_or_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_create_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_present_or_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_create_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_present_or_create_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_copyout_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_copyout_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyout_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_copyout_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyout_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_copyout_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_delete_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_delete_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_delete_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_delete_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_delete_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_delete_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_update_device_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_update_device_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_device_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_update_device_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_device_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_update_device_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
subroutine acc_update_self_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_update_self_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_self_64 (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_update_self_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_self_array (a)
use iso_c_binding, only: c_size_t
type(*), dimension(..) :: a
call acc_update_self_l (a, int (sizeof (a), kind=c_size_t))
end subroutine
function acc_is_present_32 (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
logical acc_is_present_32
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
if (acc_is_present_l (a, int (len, kind=c_size_t)) .eq. 1) then
acc_is_present_32 = .TRUE.
else
acc_is_present_32 = .FALSE.
end if
end function
function acc_is_present_64 (a, len)
use iso_c_binding, only: c_size_t, c_int64_t
logical acc_is_present_64
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
if (acc_is_present_l (a, int (len, kind=c_size_t)) .eq. 1) then
acc_is_present_64 = .TRUE.
else
acc_is_present_64 = .FALSE.
end if
end function
function acc_is_present_array (a)
use iso_c_binding, only: c_size_t
logical acc_is_present_array
type(*), dimension(..) :: a
if (acc_is_present_l (a, int (sizeof (a), kind=c_size_t)) .eq. 1) then
acc_is_present_array = .TRUE.
else
acc_is_present_array = .FALSE.
end if
end function
end module
! The following interfaces are used via 'openacc_l.h'
function acc_get_num_devices_h (d)
use openacc, only: acc_get_num_devices_l
use openacc_kinds
integer acc_get_num_devices_h
integer (acc_device_kind) d
acc_get_num_devices_h = acc_get_num_devices_l (d)
end function
subroutine acc_set_device_type_h (d)
use openacc, only: acc_set_device_type_l
use openacc_kinds
integer (acc_device_kind) d
call acc_set_device_type_l (d)
end subroutine
function acc_get_device_type_h ()
use openacc, only: acc_get_device_type_l
use openacc_kinds
integer (acc_device_kind) acc_get_device_type_h
acc_get_device_type_h = acc_get_device_type_l ()
end function
subroutine acc_set_device_num_h (n, d)
use openacc, only: acc_set_device_num_l
use openacc_kinds
integer n
integer (acc_device_kind) d
call acc_set_device_num_l (n, d)
end subroutine
function acc_get_device_num_h (d)
use openacc, only: acc_get_device_num_l
use openacc_kinds
integer acc_get_device_num_h
integer (acc_device_kind) d
acc_get_device_num_h = acc_get_device_num_l (d)
end function
function acc_async_test_h (a)
use openacc, only: acc_async_test_l
logical acc_async_test_h
integer a
if (acc_async_test_l (a) .eq. 1) then
acc_async_test_h = .TRUE.
else
acc_async_test_h = .FALSE.
end if
end function
function acc_async_test_all_h ()
use openacc, only: acc_async_test_all_l
logical acc_async_test_all_h
if (acc_async_test_all_l () .eq. 1) then
acc_async_test_all_h = .TRUE.
else
acc_async_test_all_h = .FALSE.
end if
end function
subroutine acc_wait_h (a)
use openacc, only: acc_wait_l
integer a
call acc_wait_l (a)
end subroutine
subroutine acc_wait_all_h ()
use openacc, only: acc_wait_all_l
call acc_wait_all_l ()
end subroutine
subroutine acc_wait_async_h (a1, a2)
use openacc, only: acc_wait_async_l
integer a1, a2
call acc_wait_async_l (a1, a2)
end subroutine
subroutine acc_wait_all_async_h (a)
use openacc, only: acc_wait_all_async
integer a
call acc_wait_all_async (a)
end subroutine
subroutine acc_init_h (d)
use openacc, only: acc_init_l
use openacc_kinds
integer(acc_device_kind) d
call acc_init_l (d)
end subroutine
subroutine acc_shutdown_h (d)
use openacc, only: acc_shutdown_l
use openacc_kinds
integer(acc_device_kind) d
call acc_shutdown_l (d)
end subroutine
function acc_on_device_h (d)
use openacc, only: acc_on_device_l
use openacc_kinds
integer (acc_device_kind) d
logical acc_on_device_h
if (acc_on_device_l (d) .eq. 1) then
acc_on_device_h = .TRUE.
else
acc_on_device_h = .FALSE.
end if
end function
subroutine acc_copyin_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_copyin_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyin_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_copyin_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyin_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_copyin
type(*), dimension(..) :: a
call acc_copyin (a, sizeof (a))
end subroutine
subroutine acc_present_or_copyin_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_present_or_copyin_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_present_or_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_copyin_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_present_or_copyin_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_present_or_copyin_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_copyin_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_present_or_copyin
type(*), dimension(..) :: a
call acc_present_or_copyin (a, len)
end subroutine
subroutine acc_create_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_create_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_create_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_create_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_create_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_create
type(*), dimension(..) :: a
call acc_create (a, sizeof (a))
end subroutine
subroutine acc_present_or_create_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_present_or_create_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_present_or_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_create_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_present_or_create_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_present_or_create_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_present_or_create_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_present_or_create
type(*), dimension(..) :: a
call acc_present_or_create (a, sizeof (a))
end subroutine
subroutine acc_copyout_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_copyout_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_copyout_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyout_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_copyout_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_copyout_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_copyout_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_copyout
type(*), dimension(..) :: a
call acc_copyout (a, sizeof (a))
end subroutine
subroutine acc_delete_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_delete_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_delete_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_delete_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_delete_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_delete_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_delete_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_delete
type(*), dimension(..) :: a
call acc_delete (a, sizeof (a))
end subroutine
subroutine acc_update_device_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_update_device_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_update_device_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_device_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_update_device_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_update_device_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_device_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_update_device
type(*), dimension(..) :: a
call acc_update_device (a, sizeof (a))
end subroutine
subroutine acc_update_self_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_update_self_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
call acc_update_self_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_self_64_h (a, len)
use iso_c_binding, only: c_int64_t, c_size_t
use openacc, only: acc_update_self_l
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
call acc_update_self_l (a, int (len, kind=c_size_t))
end subroutine
subroutine acc_update_self_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_update_self
type(*), dimension(..) :: a
call acc_update_self (a, sizeof (a))
end subroutine
function acc_is_present_32_h (a, len)
use iso_c_binding, only: c_int32_t, c_size_t
use openacc, only: acc_is_present_l
logical acc_is_present_32_h
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
if (acc_is_present_l (a, int (len, kind=c_size_t)) .eq. 1) then
acc_is_present_32_h = .TRUE.
else
acc_is_present_32_h = .FALSE.
end if
end function
function acc_is_present_64_h (a, len)
use iso_c_binding, only: c_size_t, c_int64_t
use openacc, only: acc_is_present_l
logical acc_is_present_64_h
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
if (acc_is_present_l (a, int (len, kind=c_size_t)) .eq. 1) then
acc_is_present_64_h = .TRUE.
else
acc_is_present_64_h = .FALSE.
end if
end function
function acc_is_present_array_h (a)
use iso_c_binding, only: c_size_t
use openacc, only: acc_is_present
logical acc_is_present_array_h
type(*), dimension(..) :: a
acc_is_present_array_h = acc_is_present (a, sizeof (a))
end function
! Copyright (C) 2014 Free Software Foundation, Inc.
! Contributed by Tobias Burnus <burnus@net-b.de>
! This file is part of the GNU OpenMP Library (libgomp).
! Libgomp is free software; you can redistribute it and/or modify it
! under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 3, or (at your option)
! any later version.
! Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU General Public License for
! more details.
! Under Section 7 of GPL version 3, you are granted additional
! permissions described in the GCC Runtime Library Exception, version
! 3.1, as published by the Free Software Foundation.
! You should have received a copy of the GNU General Public License and
! a copy of the GCC Runtime Library Exception along with this program;
! see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
! <http://www.gnu.org/licenses/>.
! NOTE: Due to the use of dimension(..), the code only works when compiled
! with -std=f2008ts/gnu/legacy but not with other standard settings.
! Alternatively, the user can use the module version, which permits
! compilation with -std=f95.
integer, parameter :: acc_device_kind = 4
integer (acc_device_kind), parameter :: acc_device_none = 0
integer (acc_device_kind), parameter :: acc_device_default = 1
integer (acc_device_kind), parameter :: acc_device_host = 2
integer (acc_device_kind), parameter :: acc_device_not_host = 3
integer (acc_device_kind), parameter :: acc_device_nvidia = 4
integer, parameter :: openacc_version = 201306
integer, parameter :: acc_handle_kind = 4
integer (acc_handle_kind), parameter :: acc_async_noval = -1
integer (acc_handle_kind), parameter :: acc_async_sync = -2
! TODO:
! - Add acc_async_noval and acc_async_sync
! - Add integer parameters to describe types of accelerators
interface acc_get_num_devices
function acc_get_num_devices_h (d)
import acc_device_kind
integer acc_get_num_devices_h
integer (acc_device_kind) d
end function
end interface
interface acc_set_device_type
subroutine acc_set_device_type_h (d)
import acc_device_kind
integer (acc_device_kind) d
end subroutine
end interface
interface acc_get_device_type
function acc_get_device_type_h ()
import acc_device_kind
integer (acc_device_kind) acc_get_device_type_h
end function
end interface
interface acc_set_device_num
subroutine acc_set_device_num_h (n, d)
import acc_device_kind
integer n
integer (acc_device_kind) d
end subroutine
end interface
interface acc_get_device_num
function acc_get_device_num_h (d)
import acc_device_kind
integer acc_get_device_num_h
integer (acc_device_kind) d
end function
end interface
interface acc_async_test
function acc_async_test_h (a)
logical acc_async_test_h
integer a
end function
end interface
interface acc_async_test_all
function acc_async_test_all_h ()
logical acc_async_test_all_h
end function
end interface
interface acc_wait
subroutine acc_wait_h (a)
integer a
end subroutine
end interface
interface acc_wait_async
subroutine acc_wait_async_h (a1, a2)
integer a1, a2
end subroutine
end interface
interface acc_wait_all
subroutine acc_wait_all_h ()
end subroutine
end interface
interface acc_wait_all_async
subroutine acc_wait_all_async_h (a)
integer a
end subroutine
end interface
interface acc_init
subroutine acc_init_h (devicetype)
import acc_device_kind
integer(acc_device_kind) devicetype
end subroutine
end interface
interface acc_shutdown
subroutine acc_shutdown_h (devicetype)
import acc_device_kind
integer(acc_device_kind) devicetype
end subroutine
end interface
interface acc_on_device
function acc_on_device_h (devicetype)
import acc_device_kind
logical acc_on_device_h
integer(acc_device_kind) devicetype
end function
end interface
! acc_malloc: Only available in C/C++
! acc_free: Only available in C/C++
interface acc_copyin
subroutine acc_copyin_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_copyin_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_copyin_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_present_or_copyin
subroutine acc_present_or_copyin_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_present_or_copyin_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_present_or_copyin_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_pcopyin
subroutine acc_pcopyin_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_pcopyin_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_pcopyin_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_create
subroutine acc_create_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_create_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_create_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_present_or_create
subroutine acc_present_or_create_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_present_or_create_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_present_or_create_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_pcreate
subroutine acc_pcreate_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_pcreate_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_pcreate_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_copyout
subroutine acc_copyout_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_copyout_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_copyout_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_delete
subroutine acc_delete_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_delete_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_delete_array_h (a)
class(*), dimension(..) :: a
end subroutine
end interface
interface acc_update_device
subroutine acc_update_device_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_update_device_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_update_device_array_h (a)
type(*), dimension(..) :: a
end subroutine
end interface
interface acc_update_self
subroutine acc_update_self_32_h (a, len)
use iso_c_binding, only: c_int32_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end subroutine
subroutine acc_update_self_64_h (a, len)
use iso_c_binding, only: c_int64_t
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end subroutine
subroutine acc_update_self_array_h (a)
type(*), dimension(..) :: a
end subroutine
end interface
! acc_map_data: Only available in C/C++
! acc_unmap_data: Only available in C/C++
! acc_deviceptr: Only available in C/C++
! acc_hostptr: Only available in C/C++
interface acc_is_present
function acc_is_present_32_h (a, len)
use iso_c_binding, only: c_int32_t
logical acc_is_present_32_h
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t) len
end function
function acc_is_present_64_h (a, len)
use iso_c_binding, only: c_int64_t
logical acc_is_present_64_h
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t) len
end function
function acc_is_present_array_h (a)
logical acc_is_present_array_h
type(*), dimension(..) :: a
end function
end interface
! acc_memcpy_to_device: Only available in C/C++
! acc_memcpy_from_device: Only available in C/C++