Implementing OpenACC's Fortran module
James Norris
jnorris@codesourcery.com
Tue Jul 29 13:28:00 GMT 2014
Tobias,
On 07/26/2014 01:41 PM, Tobias Burnus wrote:
> Hi Thomas, dear all,
>
> attached is a draft version of openacc_lib.h and openacc.f90. See TODO
> for the missing bits. Note that the "openacc.f90" code produces both a
> module file (.mod) and object code, which has to be linked into the
> library. Those stub functions should call the C version of the
> function.Those files require my trunk patch r213079 of today.
>
> Please review - it is simple to make copy'n'paste mistakes. Otherwise,
> how does it look like?
>
> Tobias
Attached is my working version of openacc.f90. It is based on the
version you distributed
with some changes pertaining to the C binding of variables. I've also
done a couple of things
on your 'TODO' list. Some preliminary testing of the code has been
performed, however,
there is still more testing to be done.
With regard to the file openacc_lib.h, I felt the intention of this file
was to provide interfaces
for legacy / 'dusty deck' Fortran, i.e., Fortran 77. Since the 'use'
statement was made available
in Fortran 90, the file openacc.f90 would be the preferred file / method
for accessing the
OpenACC interfaces. However, a means was still needed for Fortran
versions prior to Fortran
90. Therefore, openacc_lib.h would provide those interfaces, albeit a
subset of the entire set
of the available interfaces given the limitations of Fortran 77.
Make sense?
Jim
-------------- next part --------------
! 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
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
integer, parameter :: acc_handle_kind = int32
integer (acc_handle_kind), parameter :: acc_async_noval = -1
integer (acc_handle_kind), parameter :: acc_async_sync = -2
end module
module openacc
use iso_c_binding, only: c_size_t, c_int32_t, c_int64_t
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
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
subroutine acc_wait_all () &
bind (C, name="acc_wait_all")
end subroutine
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 acc_copyin
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 acc_present_or_copyin
interface acc_pcopyin
procedure :: acc_present_or_copyin_32
procedure :: acc_present_or_copyin_64
procedure :: acc_present_or_copyin_array
end interface acc_pcopyin
interface acc_create
procedure :: acc_create_32
procedure :: acc_create_64
procedure :: acc_create_array
end interface acc_create
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 acc_present_or_create
interface acc_pcreate
procedure :: acc_present_or_create_32
procedure :: acc_present_or_create_64
procedure :: acc_present_or_create_array
end interface acc_pcreate
interface acc_copyout
procedure :: acc_copyout_32
procedure :: acc_copyout_64
procedure :: acc_copyout_array
end interface acc_copyout
interface acc_delete
procedure :: acc_delete_32
procedure :: acc_delete_64
procedure :: acc_delete_array
end interface acc_delete
interface acc_update_device
procedure :: acc_update_device_32
procedure :: acc_update_device_64
procedure :: acc_update_device_array
end interface acc_update_device
interface acc_update_self
procedure :: acc_update_self_32
procedure :: acc_update_self_64
procedure :: acc_update_self_array
end interface acc_update_self
! 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_is_present
! 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
subroutine acc_copyin_lib (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 acc_copyin_lib
subroutine acc_present_or_copyin_lib (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 acc_present_or_copyin_lib
subroutine acc_create_lib (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 acc_create_lib
subroutine acc_present_or_create_lib (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 acc_present_or_create_lib
subroutine acc_copyout_lib (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 acc_copyout_lib
subroutine acc_delete_lib (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 acc_delete_lib
subroutine acc_update_device_lib (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 acc_update_device_lib
subroutine acc_update_self_lib (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 acc_update_self_lib
subroutine acc_is_present_lib (a, len) &
bind(C, name="acc_is_present")
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 acc_is_present_lib
function acc_get_num_devices_lib (d) &
bind (C, name="acc_get_num_devices")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_num_devices_lib
integer (c_int), value :: d
end function
subroutine acc_set_device_type_lib (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_lib () &
bind (C, name="acc_get_device_type")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_device_type_lib
end function
subroutine acc_set_device_num_lib (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_lib (d) &
bind (C, name="acc_get_device_num")
use iso_c_binding, only: c_int
integer (c_int) :: acc_get_device_num_lib
integer (c_int), value :: d
end function
function acc_async_test_lib (a) &
bind (C, name="acc_async_test")
use iso_c_binding, only: c_int
integer (c_int) :: acc_async_test_lib
integer (c_int), value :: a
end function
function acc_async_test_all_lib () &
bind (C, name="acc_async_test_all")
use iso_c_binding, only: c_int
integer (c_int) :: acc_async_test_all_lib
end function
subroutine acc_wait_lib (a) &
bind (C, name="acc_wait")
use iso_c_binding, only: c_int
integer (c_int), value :: a
end subroutine
subroutine acc_wait_async_lib (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_async_lib (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_lib (d) &
bind(C, name="acc_init")
use iso_c_binding, only: c_int
integer (c_int), value :: d
end subroutine
subroutine acc_shutdown_lib (d) &
bind(C, name="acc_shutdown")
use iso_c_binding, only: c_int
integer (c_int), value :: d
end subroutine
function acc_on_device_lib (d) &
bind (C, name="acc_on_device")
use iso_c_binding, only: c_int
integer (c_int) :: acc_on_device_lib
integer (c_int), value :: d
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_lib (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_lib (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_lib ()
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_lib (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_lib (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_lib (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_lib () .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_lib (int(a, kind=c_int))
end subroutine
subroutine acc_wait_async (a1, a2)
use iso_c_binding, only: c_int
integer, value :: a1, a2
call acc_wait_async_lib (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_lib (a)
end subroutine
subroutine acc_init (devicetype)
use openacc_kinds
use iso_c_binding, only: c_int
integer(acc_device_kind) :: devicetype
call acc_init_lib (int (devicetype, kind=c_int))
end subroutine
subroutine acc_shutdown (devicetype)
use openacc_kinds
use iso_c_binding, only: c_int
integer(acc_device_kind) :: devicetype
call acc_shutdown_lib (int (devicetype, 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_lib (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)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_copyin_lib (a, int (len, kind=c_size_t))
end subroutine acc_copyin_32
subroutine acc_copyin_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_copyin_lib (a, int (len, kind=c_size_t))
end subroutine acc_copyin_64
subroutine acc_copyin_array (a)
use iso_c_binding, only: c_size_t
class(*), dimension(..), target :: a
call acc_copyin_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_copyin_array
subroutine acc_present_or_copyin_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_present_or_copyin_lib (a, int (len, kind=c_size_t))
end subroutine acc_present_or_copyin_32
subroutine acc_present_or_copyin_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_present_or_copyin_lib (a, int (len, kind=c_size_t))
end subroutine acc_present_or_copyin_64
subroutine acc_present_or_copyin_array (a)
type(*), dimension(..) :: a
call acc_present_or_copyin_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_present_or_copyin_array
subroutine acc_create_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_create_lib (a, int (len, kind=c_size_t))
end subroutine acc_create_32
subroutine acc_create_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_create_lib (a, int (len, kind=c_size_t))
end subroutine acc_create_64
subroutine acc_create_array(a)
type(*), dimension(..) :: a
call acc_create_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_create_array
subroutine acc_present_or_create_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_present_or_create_lib (a, int (len, kind=c_size_t))
end subroutine acc_present_or_create_32
subroutine acc_present_or_create_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_present_or_create_lib (a, int (len, kind=c_size_t))
end subroutine acc_present_or_create_64
subroutine acc_present_or_create_array (a)
type(*), dimension(..) :: a
call acc_present_or_create_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_present_or_create_array
subroutine acc_copyout_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_copyout_lib (a, int (len, kind=c_size_t))
end subroutine acc_copyout_32
subroutine acc_copyout_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_copyout_lib (a, int (len, kind=c_size_t))
end subroutine acc_copyout_64
subroutine acc_copyout_array (a)
use iso_c_binding, only: c_size_t
class(*), dimension(..) :: a
integer (c_size_t) s
call acc_copyout_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_copyout_array
subroutine acc_delete_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_delete_lib (a, int (len, kind=c_size_t))
end subroutine acc_delete_32
subroutine acc_delete_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_delete_lib (a, int (len, kind=c_size_t))
end subroutine acc_delete_64
subroutine acc_delete_array (a)
type(*), dimension(..) :: a
call acc_delete_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_delete_array
subroutine acc_update_device_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_update_device_lib (a, int (len, kind=c_size_t))
end subroutine acc_update_device_32
subroutine acc_update_device_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_update_device_lib (a, int (len, kind=c_size_t))
end subroutine acc_update_device_64
subroutine acc_update_device_array (a)
type(*), dimension(..) :: a
call acc_update_device_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_update_device_array
subroutine acc_update_self_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_update_self_lib (a, int (len, kind=c_size_t))
end subroutine acc_update_self_32
subroutine acc_update_self_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_update_self_lib (a, int (len, kind=c_size_t))
end subroutine acc_update_self_64
subroutine acc_update_self_array (a)
type(*), dimension(..) :: a
call acc_update_self_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_update_self_array
subroutine acc_is_present_32 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int32_t), value :: len
call acc_is_present_lib (a, int (len, kind=c_size_t))
end subroutine acc_is_present_32
subroutine acc_is_present_64 (a, len)
!GCC$ ATTRIBUTES NO_ARG_CHECK :: a
type(*), dimension(*) :: a
integer(c_int64_t), value :: len
call acc_is_present_lib (a, int (len, kind=c_size_t))
end subroutine acc_is_present_64
subroutine acc_is_present_array (a)
type(*), dimension(..) :: a
call acc_is_present_lib (a, int (sizeof (a), kind=c_size_t))
end subroutine acc_is_present_array
end module openacc
More information about the Fortran
mailing list