===================================================================
@@ -215,10 +215,24 @@ enum gomp_map_kind
#define GOMP_DEVICE_NVIDIA_PTX 5
#define GOMP_DEVICE_INTEL_MIC 6
#define GOMP_DEVICE_HSA 7
+#define GOMP_DEVICE_CURRENT 8
#define GOMP_DEVICE_ICV -1
#define GOMP_DEVICE_HOST_FALLBACK -2
+/* Device property codes. Keep in sync with
+ libgomp/{openacc.h,openacc.f90,openacc_lib.h}:acc_device_property_t
+ as well as libgomp/libgomp-plugin.h. */
+/* Start from 1 to catch uninitialized use. */
+#define GOMP_DEVICE_PROPERTY_MEMORY 1
+#define GOMP_DEVICE_PROPERTY_FREE_MEMORY 2
+#define GOMP_DEVICE_PROPERTY_NAME 0x10001
+#define GOMP_DEVICE_PROPERTY_VENDOR 0x10002
+#define GOMP_DEVICE_PROPERTY_DRIVER 0x10003
+
+/* Internal property mask to tell numeric and string values apart. */
+#define GOMP_DEVICE_PROPERTY_STRING_MASK 0x10000
+
/* GOMP_task/GOMP_taskloop* flags argument. */
#define GOMP_TASK_FLAG_UNTIED (1 << 0)
#define GOMP_TASK_FLAG_FINAL (1 << 1)
===================================================================
@@ -55,6 +55,13 @@ enum offload_target_type
OFFLOAD_TARGET_TYPE_HSA = 7
};
+/* Container type for passing device properties. */
+union gomp_device_property_value
+{
+ void *ptr;
+ uintmax_t val;
+};
+
/* Opaque type to represent plugin-dependent implementation of an
OpenACC asynchronous queue. */
struct goacc_asyncqueue;
@@ -99,6 +106,7 @@ extern const char *GOMP_OFFLOAD_get_name
extern unsigned int GOMP_OFFLOAD_get_caps (void);
extern int GOMP_OFFLOAD_get_type (void);
extern int GOMP_OFFLOAD_get_num_devices (void);
+extern union gomp_device_property_value GOMP_OFFLOAD_get_property (int, int);
extern bool GOMP_OFFLOAD_init_device (int);
extern bool GOMP_OFFLOAD_fini_device (int);
extern unsigned GOMP_OFFLOAD_version (void);
===================================================================
@@ -988,6 +988,7 @@ struct gomp_device_descr
__typeof (GOMP_OFFLOAD_get_caps) *get_caps_func;
__typeof (GOMP_OFFLOAD_get_type) *get_type_func;
__typeof (GOMP_OFFLOAD_get_num_devices) *get_num_devices_func;
+ __typeof (GOMP_OFFLOAD_get_property) *get_property_func;
__typeof (GOMP_OFFLOAD_init_device) *init_device_func;
__typeof (GOMP_OFFLOAD_fini_device) *fini_device_func;
__typeof (GOMP_OFFLOAD_version) *version_func;
===================================================================
@@ -442,6 +442,10 @@ OACC_2.5 {
OACC_2.6 {
global:
+ acc_get_property;
+ acc_get_property_h_;
+ acc_get_property_string;
+ acc_get_property_string_h_;
acc_attach;
acc_attach_async;
acc_detach;
===================================================================
@@ -1867,6 +1867,7 @@ version 2.5.
* acc_get_device_type:: Get type of device accelerator to be used.
* acc_set_device_num:: Set device number to use.
* acc_get_device_num:: Get device number to be used.
+* acc_get_property:: Get device property.
* acc_async_test:: Tests for completion of a specific asynchronous
operation.
* acc_async_test_all:: Tests for completion of all asychronous
@@ -2049,6 +2050,44 @@ region.
+@node acc_get_property
+@section @code{acc_get_property} -- Get device property.
+@cindex acc_get_property
+@cindex acc_get_property_string
+@table @asis
+@item @emph{Description}
+These routines return the value of the specified @var{property} for the
+device being queried according to @var{devicenum} and @var{devicetype}.
+Integer-valued and string-valued properties are returned by
+@code{acc_get_property} and @code{acc_get_property_string} respectively.
+The Fortran @code{acc_get_property_string} subroutine returns the string
+retrieved in its fourth argument while the remaining entry points are
+functions, which pass the return value as their result.
+
+@item @emph{C/C++}:
+@multitable @columnfractions .20 .80
+@item @emph{Prototype}: @tab @code{size_t acc_get_property(int devicenum, acc_device_t devicetype, acc_device_property_t property);}
+@item @emph{Prototype}: @tab @code{const char *acc_get_property_string(int devicenum, acc_device_t devicetype, acc_device_property_t property);}
+@end multitable
+
+@item @emph{Fortran}:
+@multitable @columnfractions .20 .80
+@item @emph{Interface}: @tab @code{function acc_get_property(devicenum, devicetype, property)}
+@item @emph{Interface}: @tab @code{subroutine acc_get_property_string(devicenum, devicetype, property, string)}
+@item @tab @code{integer devicenum}
+@item @tab @code{integer(kind=acc_device_kind) devicetype}
+@item @tab @code{integer(kind=acc_device_property) property}
+@item @tab @code{integer(kind=acc_device_property) acc_get_property}
+@item @tab @code{character(*) string}
+@end multitable
+
+@item @emph{Reference}:
+@uref{https://www.openacc.org, OpenACC specification v2.6}, section
+3.2.6.
+@end table
+
+
+
@node acc_async_test
@section @code{acc_async_test} -- Test for completion of a specific asynchronous operation.
@table @asis
===================================================================
@@ -60,6 +60,27 @@ host_get_num_devices (void)
return 1;
}
+static union gomp_device_property_value
+host_get_property (int n, int prop)
+{
+ union gomp_device_property_value nullval = { .val = 0 };
+
+ if (n >= host_get_num_devices ())
+ return nullval;
+
+ switch (prop)
+ {
+ case GOMP_DEVICE_PROPERTY_NAME:
+ return (union gomp_device_property_value) { .ptr = "GOMP" };
+ case GOMP_DEVICE_PROPERTY_VENDOR:
+ return (union gomp_device_property_value) { .ptr = "GNU" };
+ case GOMP_DEVICE_PROPERTY_DRIVER:
+ return (union gomp_device_property_value) { .ptr = VERSION };
+ default:
+ return nullval;
+ }
+}
+
static bool
host_init_device (int n __attribute__ ((unused)))
{
@@ -270,6 +291,7 @@ static struct gomp_device_descr host_dis
.get_caps_func = host_get_caps,
.get_type_func = host_get_type,
.get_num_devices_func = host_get_num_devices,
+ .get_property_func = host_get_property,
.init_device_func = host_init_device,
.fini_device_func = host_fini_device,
.version_func = host_version,
===================================================================
@@ -717,7 +717,8 @@ acc_get_device_type (void)
}
assert (res != acc_device_default
- && res != acc_device_not_host);
+ && res != acc_device_not_host
+ && res != acc_device_current);
return res;
}
@@ -826,6 +827,102 @@ acc_set_device_num (int ord, acc_device_
ialias (acc_set_device_num)
+static union gomp_device_property_value
+get_property_any (int ord, acc_device_t d, acc_device_property_t prop)
+{
+ union gomp_device_property_value propval;
+ struct gomp_device_descr *dev;
+ struct goacc_thread *thr;
+
+ if (d == acc_device_none)
+ return (union gomp_device_property_value) { .val = 0 };
+
+ goacc_lazy_initialize ();
+ thr = goacc_thread ();
+
+ if (d == acc_device_current && (!thr || !thr->dev))
+ return (union gomp_device_property_value) { .val = 0 };
+
+ acc_prof_info prof_info;
+ acc_api_info api_info;
+ bool profiling_setup_p
+ = __builtin_expect (goacc_profiling_setup_p (thr, &prof_info, &api_info),
+ false);
+
+ if (d == acc_device_current)
+ {
+ if (profiling_setup_p)
+ {
+ prof_info.device_type = acc_device_type (thr->dev->type);
+ prof_info.device_number = thr->dev->target_id;
+ }
+
+ dev = thr->dev;
+ }
+ else
+ {
+ int num_devices;
+
+ if (profiling_setup_p)
+ {
+ prof_info.device_type = d;
+ prof_info.device_number = ord;
+ }
+
+ gomp_mutex_lock (&acc_device_lock);
+
+ dev = resolve_device (d, false);
+
+ num_devices = dev->get_num_devices_func ();
+
+ if (num_devices <= 0 || ord >= num_devices)
+ acc_dev_num_out_of_range (d, ord, num_devices);
+
+ dev += ord;
+
+ gomp_mutex_lock (&dev->lock);
+ if (dev->state == GOMP_DEVICE_UNINITIALIZED)
+ gomp_init_device (dev);
+ gomp_mutex_unlock (&dev->lock);
+
+ gomp_mutex_unlock (&acc_device_lock);
+ }
+
+ assert (dev);
+
+ propval = dev->get_property_func (dev->target_id, prop);
+
+ if (profiling_setup_p)
+ {
+ thr->prof_info = NULL;
+ thr->api_info = NULL;
+ }
+
+ return propval;
+}
+
+size_t
+acc_get_property (int ord, acc_device_t d, acc_device_property_t prop)
+{
+ if (prop & GOMP_DEVICE_PROPERTY_STRING_MASK)
+ return 0;
+ else
+ return get_property_any (ord, d, prop).val;
+}
+
+ialias (acc_get_property)
+
+const char *
+acc_get_property_string (int ord, acc_device_t d, acc_device_property_t prop)
+{
+ if (prop & GOMP_DEVICE_PROPERTY_STRING_MASK)
+ return get_property_any (ord, d, prop).ptr;
+ else
+ return NULL;
+}
+
+ialias (acc_get_property_string)
+
/* For -O and higher, the compiler always attempts to expand acc_on_device, but
if the user disables the builtin, or calls it via a pointer, we'll need this
version.
===================================================================
@@ -28,7 +28,7 @@
! <http://www.gnu.org/licenses/>.
module openacc_kinds
- use iso_fortran_env, only: int32
+ use iso_fortran_env, only: int32, int64
implicit none
private :: int32
@@ -46,6 +46,21 @@ module openacc_kinds
! integer (acc_device_kind), parameter :: acc_device_host_nonshm = 3 removed.
integer (acc_device_kind), parameter :: acc_device_not_host = 4
integer (acc_device_kind), parameter :: acc_device_nvidia = 5
+ integer (acc_device_kind), parameter :: acc_device_current = 8
+
+ public :: acc_device_property
+
+ integer, parameter :: acc_device_property = int64
+
+ public :: acc_property_memory, acc_property_free_memory
+ public :: acc_property_name, acc_property_vendor, acc_property_driver
+
+ ! Keep in sync with include/gomp-constants.h.
+ integer (acc_device_property), parameter :: acc_property_memory = 1
+ integer (acc_device_property), parameter :: acc_property_free_memory = 2
+ integer (acc_device_property), parameter :: acc_property_name = Z'10001'
+ integer (acc_device_property), parameter :: acc_property_vendor = Z'10002'
+ integer (acc_device_property), parameter :: acc_property_driver = Z'10003'
public :: acc_handle_kind
@@ -93,6 +108,22 @@ module openacc_internal
integer (acc_device_kind) d
end function
+ function acc_get_property_h (n, d, p)
+ import
+ integer (acc_device_property) :: acc_get_property_h
+ integer, value :: n
+ integer (acc_device_kind), value :: d
+ integer (acc_device_property), value :: p
+ end function
+
+ subroutine acc_get_property_string_h (n, d, p, s)
+ import
+ integer, value :: n
+ integer (acc_device_kind), value :: d
+ integer (acc_device_property), value :: p
+ character (*) :: s
+ end subroutine
+
subroutine acc_set_default_async_h (a)
import
integer a
@@ -570,6 +601,24 @@ module openacc_internal
integer (c_int), value :: d
end function
+ function acc_get_property_l (n, d, p) &
+ bind (C, name = "acc_get_property")
+ use iso_c_binding, only: c_int, c_size_t
+ integer (c_size_t) :: acc_get_property_l
+ integer (c_int), value :: n
+ integer (c_int), value :: d
+ integer (c_int), value :: p
+ end function
+
+ function acc_get_property_string_l (n, d, p) &
+ bind (C, name = "acc_get_property_string")
+ use iso_c_binding, only: c_int, c_ptr
+ type (c_ptr) :: acc_get_property_string_l
+ integer (c_int), value :: n
+ integer (c_int), value :: d
+ integer (c_int), value :: p
+ end function
+
function acc_async_test_l (a) &
bind (C, name = "acc_async_test")
use iso_c_binding, only: c_int
@@ -830,6 +879,14 @@ module openacc
procedure :: acc_get_device_num_h
end interface
+ interface acc_get_property
+ procedure :: acc_get_property_h
+ end interface
+
+ interface acc_get_property_string
+ procedure :: acc_get_property_string_h
+ end interface
+
interface acc_set_default_async
procedure :: acc_set_default_async_h
end interface
@@ -1030,6 +1087,19 @@ module openacc
end module
+module openacc_c_string
+ implicit none
+
+ interface
+ function strlen (s) bind (C, name = "strlen")
+ use iso_c_binding, only: c_ptr, c_size_t
+ type (c_ptr), intent(in), value :: s
+ integer (c_size_t) :: strlen
+ end function
+ end interface
+
+end module
+
function acc_get_num_devices_h (d)
use openacc_internal, only: acc_get_num_devices_l
use openacc_kinds
@@ -1068,6 +1138,50 @@ function acc_get_device_num_h (d)
acc_get_device_num_h = acc_get_device_num_l (d)
end function
+function acc_get_property_h (n, d, p)
+ use iso_c_binding, only: c_int
+ use openacc_internal, only: acc_get_property_l
+ use openacc_kinds
+ integer (acc_device_property) :: acc_get_property_h
+ integer, value :: n
+ integer (acc_device_kind), value :: d
+ integer (acc_device_property), value :: p
+
+ integer (c_int) :: pint
+
+ pint = int (p, c_int)
+ acc_get_property_h = acc_get_property_l (n, d, pint)
+end function
+
+subroutine acc_get_property_string_h (n, d, p, s)
+ use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer
+ use openacc_internal, only: acc_get_property_string_l
+ use openacc_c_string, only: strlen
+ use openacc_kinds
+ integer, value :: n
+ integer (acc_device_kind), value :: d
+ integer (acc_device_property), value :: p
+ character (*) :: s
+
+ integer (c_int) :: pint
+ type (c_ptr) :: cptr
+ integer :: clen
+ character (kind=c_char, len=1), pointer :: sptr (:)
+ integer :: slen
+ integer :: i
+
+ pint = int (p, c_int)
+ cptr = acc_get_property_string_l (n, d, pint)
+ clen = int (strlen (cptr))
+ call c_f_pointer (cptr, sptr, [clen])
+
+ s = ""
+ slen = min (clen, len (s))
+ do i = 1, slen
+ s (i:i) = sptr (i)
+ end do
+end subroutine
+
function acc_async_test_h (a)
use openacc_internal, only: acc_async_test_l
logical acc_async_test_h
===================================================================
@@ -57,12 +57,23 @@ typedef enum acc_device_t {
acc_device_nvidia = 5,
/* not supported */ _acc_device_intel_mic = 6,
/* not supported */ _acc_device_hsa = 7,
+ acc_device_current = 8,
_ACC_device_hwm,
/* Ensure enumeration is layout compatible with int. */
_ACC_highest = __INT_MAX__,
_ACC_neg = -1
} acc_device_t;
+typedef enum acc_device_property_t {
+ /* Keep in sync with include/gomp-constants.h. */
+ /* Start from 1 to catch uninitialized use. */
+ acc_property_memory = 1,
+ acc_property_free_memory = 2,
+ acc_property_name = 0x10001,
+ acc_property_vendor = 0x10002,
+ acc_property_driver = 0x10003
+} acc_device_property_t;
+
typedef enum acc_async_t {
/* Keep in sync with include/gomp-constants.h. */
acc_async_default = 0,
@@ -75,6 +86,10 @@ void acc_set_device_type (acc_device_t)
acc_device_t acc_get_device_type (void) __GOACC_NOTHROW;
void acc_set_device_num (int, acc_device_t) __GOACC_NOTHROW;
int acc_get_device_num (acc_device_t) __GOACC_NOTHROW;
+size_t acc_get_property
+ (int, acc_device_t, acc_device_property_t) __GOACC_NOTHROW;
+const char *acc_get_property_string
+ (int, acc_device_t, acc_device_property_t) __GOACC_NOTHROW;
void acc_set_default_async (int) __GOACC_NOTHROW;
int acc_get_default_async (void) __GOACC_NOTHROW;
int acc_async_test (int) __GOACC_NOTHROW;
===================================================================
@@ -689,6 +689,32 @@ GOMP_OFFLOAD_get_num_devices (void)
return hsa_context.agent_count;
}
+/* Part of the libgomp plugin interface. Return the value of property
+ PROP of agent number N. */
+
+union gomp_device_property_value
+GOMP_OFFLOAD_get_property (int n, int prop)
+{
+ union gomp_device_property_value nullval = { .val = 0 };
+
+ if (!init_hsa_context ())
+ return nullval;
+ if (n >= hsa_context.agent_count)
+ {
+ GOMP_PLUGIN_error
+ ("Request for a property of a non-existing HSA device %i", n);
+ return nullval;
+ }
+
+ switch (prop)
+ {
+ case GOMP_DEVICE_PROPERTY_VENDOR:
+ return (union gomp_device_property_value) { .ptr = "AMD" };
+ default:
+ return nullval;
+ }
+}
+
/* Part of the libgomp plugin interface. Initialize agent number N so that it
can be used for computation. Return TRUE on success. */
===================================================================
@@ -63,6 +63,9 @@ CUDA_ONE_CALL (cuCtxSynchronize) \
CUDA_ONE_CALL (cuDeviceGet) \
CUDA_ONE_CALL (cuDeviceGetAttribute) \
CUDA_ONE_CALL (cuDeviceGetCount) \
+CUDA_ONE_CALL (cuDeviceGetName) \
+CUDA_ONE_CALL (cuDeviceTotalMem) \
+CUDA_ONE_CALL (cuDriverGetVersion) \
CUDA_ONE_CALL (cuEventCreate) \
CUDA_ONE_CALL (cuEventDestroy) \
CUDA_ONE_CALL (cuEventElapsedTime) \
@@ -88,6 +91,7 @@ CUDA_ONE_CALL (cuMemcpyHtoDAsync) \
CUDA_ONE_CALL (cuMemFree) \
CUDA_ONE_CALL (cuMemFreeHost) \
CUDA_ONE_CALL (cuMemGetAddressRange) \
+CUDA_ONE_CALL (cuMemGetInfo) \
CUDA_ONE_CALL (cuMemHostGetDevicePointer)\
CUDA_ONE_CALL (cuModuleGetFunction) \
CUDA_ONE_CALL (cuModuleGetGlobal) \
@@ -1014,6 +1018,93 @@ GOMP_OFFLOAD_get_num_devices (void)
return nvptx_get_num_devices ();
}
+union gomp_device_property_value
+GOMP_OFFLOAD_get_property (int n, int prop)
+{
+ union gomp_device_property_value propval = { .val = 0 };
+
+ pthread_mutex_lock (&ptx_dev_lock);
+
+ if (!nvptx_init () || n >= nvptx_get_num_devices ())
+ {
+ pthread_mutex_unlock (&ptx_dev_lock);
+ return propval;
+ }
+
+ switch (prop)
+ {
+ case GOMP_DEVICE_PROPERTY_MEMORY:
+ {
+ size_t total_mem;
+ CUdevice dev;
+
+ CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+ CUDA_CALL_ERET (propval, cuDeviceTotalMem, &total_mem, dev);
+ propval.val = total_mem;
+ }
+ break;
+ case GOMP_DEVICE_PROPERTY_FREE_MEMORY:
+ {
+ size_t total_mem;
+ size_t free_mem;
+ CUdevice ctxdev;
+ CUdevice dev;
+
+ CUDA_CALL_ERET (propval, cuCtxGetDevice, &ctxdev);
+ CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+ if (dev == ctxdev)
+ CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+ else if (ptx_devices[n])
+ {
+ CUcontext old_ctx;
+
+ CUDA_CALL_ERET (propval, cuCtxPushCurrent, ptx_devices[n]->ctx);
+ CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+ CUDA_CALL_ASSERT (cuCtxPopCurrent, &old_ctx);
+ }
+ else
+ {
+ CUcontext new_ctx;
+
+ CUDA_CALL_ERET (propval, cuCtxCreate, &new_ctx, CU_CTX_SCHED_AUTO,
+ dev);
+ CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+ CUDA_CALL_ASSERT (cuCtxDestroy, new_ctx);
+ }
+ propval.val = free_mem;
+ }
+ break;
+ case GOMP_DEVICE_PROPERTY_NAME:
+ {
+ static char name[256];
+ CUdevice dev;
+
+ CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+ CUDA_CALL_ERET (propval, cuDeviceGetName, name, sizeof (name), dev);
+ propval.ptr = name;
+ }
+ break;
+ case GOMP_DEVICE_PROPERTY_VENDOR:
+ propval.ptr = "Nvidia";
+ break;
+ case GOMP_DEVICE_PROPERTY_DRIVER:
+ {
+ static char ver[11];
+ int v;
+
+ CUDA_CALL_ERET (propval, cuDriverGetVersion, &v);
+ snprintf (ver, sizeof (ver) - 1, "%u.%u", v / 1000, v % 1000 / 10);
+ propval.ptr = ver;
+ }
+ break;
+ default:
+ break;
+ }
+
+ pthread_mutex_unlock (&ptx_dev_lock);
+ return propval;
+}
+
bool
GOMP_OFFLOAD_init_device (int n)
{
===================================================================
@@ -3477,6 +3477,7 @@ gomp_load_plugin_for_device (struct gomp
DLSYM (get_caps);
DLSYM (get_type);
DLSYM (get_num_devices);
+ DLSYM (get_property);
DLSYM (init_device);
DLSYM (fini_device);
DLSYM (load_image);
===================================================================
@@ -0,0 +1,37 @@
+/* Test the `acc_get_property' and '`acc_get_property_string' library
+ functions. */
+/* { dg-do run } */
+
+#include <openacc.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+
+int main ()
+{
+ const char *s;
+ size_t v;
+ int r;
+
+ /* Verify that the vendor is a proper non-empty string. */
+ s = acc_get_property_string (0, acc_device_default, acc_property_vendor);
+ r = !s || !strlen (s);
+ if (s)
+ printf ("OpenACC vendor: %s\n", s);
+
+ /* For the rest just check that they do not crash. */
+ v = acc_get_property (0, acc_device_default, acc_property_memory);
+ if (v)
+ printf ("OpenACC total memory: %zd\n", v);
+ v = acc_get_property (0, acc_device_default, acc_property_free_memory);
+ if (v)
+ printf ("OpenACC free memory: %zd\n", v);
+ s = acc_get_property_string (0, acc_device_default, acc_property_name);
+ if (s)
+ printf ("OpenACC name: %s\n", s);
+ s = acc_get_property_string (0, acc_device_default, acc_property_driver);
+ if (s)
+ printf ("OpenACC driver: %s\n", s);
+
+ return r;
+}
===================================================================
@@ -0,0 +1,33 @@
+! Test the `acc_get_property' and '`acc_get_property_string' library
+! functions.
+! { dg-do run }
+
+ USE OPENACC
+ IMPLICIT NONE
+
+ INTEGER(ACC_DEVICE_PROPERTY) V
+ CHARACTER*256 S
+ LOGICAL R
+
+ ! Verify that the vendor is a non-empty string.
+ CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+ + ACC_PROPERTY_VENDOR, S)
+ R = S /= ""
+ IF (S /= "") PRINT "(A, A)", "OpenACC vendor: ", TRIM (S)
+
+ ! For the rest just check that they do not crash.
+ V = ACC_GET_PROPERTY (0, ACC_DEVICE_DEFAULT,
+ + ACC_PROPERTY_MEMORY)
+ IF (V /= 0) PRINT "(A, I0)", "OpenACC total memory: ", V
+ V = ACC_GET_PROPERTY (0, ACC_DEVICE_DEFAULT,
+ + ACC_PROPERTY_FREE_MEMORY)
+ IF (V /= 0) PRINT "(A, I0)", "OpenACC free memory: ", V
+ CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+ + ACC_PROPERTY_NAME, S)
+ IF (S /= "") PRINT "(A, A)", "OpenACC name: ", TRIM (S)
+ CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+ + ACC_PROPERTY_DRIVER, S)
+ IF (S /= "") PRINT "(A, A)", "OpenACC driver: ", TRIM (S)
+
+ IF (.NOT. R) STOP 1
+ END