diff --git a/Makefile b/Makefile new file mode 100644 index 00000000..15ac6f4f --- /dev/null +++ b/Makefile @@ -0,0 +1,41 @@ +.PHONY: clean_all gpufort_headers gpufort_sources lib/$(LIBGPUFORT) lib/$(LIBGPUFORT_ACC) + +SUFFIX = $(if $(HIP_PLATFORM),$(HIP_PLATFORM),amd) +LIBGPUFORT = libgpufort_$(SUFFIX).a +LIBGPUFORT_ACC = libgpufort_acc_$(SUFFIX).a + +GPUFORT_DIR = $(shell gpufort --path) +GPUFORT_ACC_DIR = $(GPUFORT_DIR)/runtime/gpufort_acc_runtime + +all: | gpufort_headers lib/$(LIBGPUFORT) lib/$(LIBGPUFORT_ACC) make_directories + +gpufort_headers: + make -C $(GPUFORT_DIR)/include all + +gpufort_sources: + make -C $(GPUFORT_DIR)/src gpufort_sources + +lib/$(LIBGPUFORT): | gpufort_headers gpufort_sources make_directories + make -C $(GPUFORT_DIR)/src $(LIBGPUFORT) + mv $(GPUFORT_DIR)/src/$(LIBGPUFORT) $(GPUFORT_DIR)/lib + mv $(GPUFORT_DIR)/src/*.mod $(GPUFORT_DIR)/include/$(SUFFIX)/ + make -C $(GPUFORT_DIR)/src clean + +lib/$(LIBGPUFORT_ACC): make_directories + make -C $(GPUFORT_ACC_DIR)/ lib/$(LIBGPUFORT_ACC) + mv $(GPUFORT_ACC_DIR)/lib/$(LIBGPUFORT_ACC)\ + $(GPUFORT_DIR)/lib/ + mv $(GPUFORT_ACC_DIR)/include/*.mod\ + $(GPUFORT_DIR)/include/$(SUFFIX)/ + #-mv $(GPUFORT_ACC_DIR)/include/*.h\ + # $(GPUFORT_DIR)/include/$(SUFFIX) + make -C $(GPUFORT_ACC_DIR)/ clean + +make_directories: + mkdir -p $(GPUFORT_DIR)/lib + mkdir -p $(GPUFORT_DIR)/include/$(SUFFIX) + +clean_all: + make -C $(GPUFORT_DIR)/include clean_all + make -C $(GPUFORT_DIR)/src clean_all + rm -f lib/$(LIBGPUFORT) lib/$(LIBGPUFORT_ACC) diff --git a/README.md b/README.md index 13b4a055..f7aa7115 100644 --- a/README.md +++ b/README.md @@ -25,6 +25,22 @@ by GPUFORT will in most cases require manual reviewing and fixing. Please take a look at the (slightly outdated) [user guide](https://rocmsoftwareplatform.github.io/gpufort/). +### Quick start for generating and compiling HIP code form Fortran + +Before you can run HIP code generated by GPUFORT, you need to +build the GPUFORT static libraries and/or +offloading runtime for AMD and/or NVIDIA devices. +Assuming HIPFORT is installed, you can compile them via: + +```bash +HIP_PLATFORM=amd FC=hipfc make all # use HIP_PLATFORM=nvidia for NVIDIA devices +``` + +If the compilation is successful, take a look at the +CUDA Fortran and OpenACC examples in the `examples/` subdirectory, +which all come with a Makefile for generating code and building +the examples. + ## Implementation details [This presentation](https://github.com/ROCmSoftwarePlatform/gpufort/blob/main/gpufort_slides.pdf) diff --git a/examples/gpufort_array/vector-add-hipmalloc/Makefile b/examples/gpufort_array/vector-add-hipmalloc/Makefile new file mode 100644 index 00000000..2045fdad --- /dev/null +++ b/examples/gpufort_array/vector-add-hipmalloc/Makefile @@ -0,0 +1,8 @@ +CFLAGS = -g -ggdb + +vector-add: + hipcc $(shell gpufort --cpp_config) $(CFLAGS) -c main-kernels.hip.cpp -o main-kernels.hip.o + hipfc $(shell gpufort --gfortran_config) main-kernels.hip.o vector-add.f90 -o vector-add $(shell gpufort --ldflags) + +clean: + rm -f *.mod *.o vector-add diff --git a/examples/gpufort_array/vector-add-hipmalloc/main-kernels.hip.cpp b/examples/gpufort_array/vector-add-hipmalloc/main-kernels.hip.cpp new file mode 100644 index 00000000..0fa83b0f --- /dev/null +++ b/examples/gpufort_array/vector-add-hipmalloc/main-kernels.hip.cpp @@ -0,0 +1,45 @@ +// This file was generated by gpufort +#ifndef __KERNELS_HIP_CPP__ +#define __KERNELS_HIP_CPP__ +#include "hip/hip_runtime.h" +#include "hip/hip_complex.h" +#include "gpufort.h" +#include "gpufort_array.h" + + +// BEGIN main_26_e28c45 +/* + HIP C++ implementation of the function/loop body of: + + !$cuf kernel do(1) <<>> + do i=1,size(y_d,1) + y_d(i) = y_d(i) + a*x_d(i) + end do + +*/ + +__global__ void vecadd_kernel( + gpufort::array1 y_d, + const float a, + const gpufort::array1 x_d +) { + int i = 1 + (1)*(threadIdx.x + blockIdx.x * blockDim.x); + if (loop_cond(i,y_d.size(1),1)) { + y_d(i)= y_d(i) + a*x_d(i); + } +} + +extern "C" void launch_vecadd_kernel_( + const dim3& grid, + const dim3& block, + const int& sharedmem, + hipStream_t& stream, + gpufort::array1& y_d, + const float& a, + const gpufort::array1& x_d +) { + // launch kernel + hipLaunchKernelGGL((vecadd_kernel), grid, block, sharedmem, stream, y_d, a, x_d); +} +// END vecadd_kernel +#endif // __KERNELS_HIP_CPP__ \ No newline at end of file diff --git a/examples/gpufort_array/vector-add-hipmalloc/vector-add.f90 b/examples/gpufort_array/vector-add-hipmalloc/vector-add.f90 new file mode 100644 index 00000000..67e0a968 --- /dev/null +++ b/examples/gpufort_array/vector-add-hipmalloc/vector-add.f90 @@ -0,0 +1,30 @@ +program main + use hipfort + use hipfort_check + use gpufort_array + implicit none + integer, parameter :: N = 40000 + real :: x(N), y(N), a + real,pointer :: x_d(:), y_d(:) + type(dim3) :: grid, tBlock + type(c_ptr) :: stream = c_null_ptr + ! + tBlock = dim3(256,1,1) + grid = dim3(ceiling(real(N)/tBlock%x),1,1) + + x = 1.0; y = 2.0; a = 2.0 + + call hipCheck(hipMalloc(x_d,source=x)) + call hipCheck(hipMalloc(y_d,source=y)) + + call launch_vecadd_kernel(grid,tBlock,0,stream,& + gpufort_array_wrap_device_ptr(y_d,lbound(y)),a,& + gpufort_array_wrap_device_ptr(x_d)) + call hipCheck(hipStreamSynchronize(stream)) + + call hipCheck(hipMemcpy(y,y_d,hipMemcpyDeviceToHost)) + call hipCheck(hipFree(x_d)) + call hipCheck(hipFree(y_d)) + + write(*,*) 'Max error: ', maxval(abs(y-4.0)) +end program main diff --git a/examples/gpufort_array/vector-add-interoperable-types/Makefile b/examples/gpufort_array/vector-add-interoperable-types/Makefile new file mode 100644 index 00000000..2045fdad --- /dev/null +++ b/examples/gpufort_array/vector-add-interoperable-types/Makefile @@ -0,0 +1,8 @@ +CFLAGS = -g -ggdb + +vector-add: + hipcc $(shell gpufort --cpp_config) $(CFLAGS) -c main-kernels.hip.cpp -o main-kernels.hip.o + hipfc $(shell gpufort --gfortran_config) main-kernels.hip.o vector-add.f90 -o vector-add $(shell gpufort --ldflags) + +clean: + rm -f *.mod *.o vector-add diff --git a/examples/gpufort_array/vector-add-interoperable-types/main-kernels.hip.cpp b/examples/gpufort_array/vector-add-interoperable-types/main-kernels.hip.cpp new file mode 100644 index 00000000..be9b798b --- /dev/null +++ b/examples/gpufort_array/vector-add-interoperable-types/main-kernels.hip.cpp @@ -0,0 +1,51 @@ +// This file was generated by gpufort +#ifndef __KERNELS_HIP_CPP__ +#define __KERNELS_HIP_CPP__ +#include "hip/hip_runtime.h" +#include "hip/hip_complex.h" +#include "gpufort.h" +#include "gpufort_array.h" + +// C++ structs with same layout as Fortran interop types +struct node_t { + float val; +}; + +struct mesh_t { + float a; + gpufort::array1 x; + gpufort::array1 y; +}; + +/* + HIP C++ implementation of the function/loop body of: + + !$cuf kernel do(1) <<>> + do i=1,size(mesh%y,1) + mesh%y(i) = mesh%y(i) + mesh%a*mesh%x(i)%val + end do +*/ + +__global__ void vecadd_kernel(mesh_t mesh) { + int i = 1 + (1)*(threadIdx.x + blockIdx.x * blockDim.x); + if (loop_cond(i,mesh.y.size(1),1)) { + mesh.y(i)= mesh.y(i) + mesh.a*mesh.x(i).val; + } +} + +extern "C" void launch_vecadd_kernel_auto_( + const int& sharedmem, + hipStream_t& stream, + mesh_t& mesh +) { + const int vecadd_kernel_blockX = 128; + dim3 block(vecadd_kernel_blockX); + const int vecadd_kernel_NX = (1 + ((mesh.y.size(1)) - (1))); + const int vecadd_kernel_gridX = divideAndRoundUp( vecadd_kernel_NX, vecadd_kernel_blockX ); + dim3 grid(vecadd_kernel_gridX); + + // launch kernel + hipLaunchKernelGGL((vecadd_kernel), grid, block, sharedmem, stream, mesh); + //mesh.y.print_device_data(std::cout,"prefix",gpufort::PrintMode::PrintCValues); +} +#endif // __KERNELS_HIP_CPP__ diff --git a/examples/gpufort_array/vector-add-interoperable-types/vector-add.f90 b/examples/gpufort_array/vector-add-interoperable-types/vector-add.f90 new file mode 100644 index 00000000..7468981b --- /dev/null +++ b/examples/gpufort_array/vector-add-interoperable-types/vector-add.f90 @@ -0,0 +1,81 @@ +module types + use iso_c_binding + use gpufort_array + + ! interoperable types + type,bind(c) :: node_t + real(c_float) :: val + end type + + type,bind(c) :: mesh_t + real(c_float) :: a + type(gpufort_array1) :: x ! array of type `node_t` + type(gpufort_array1) :: y ! array of type `real(c_float)` + end type +end module + +program main + use types + use hipfort + use hipfort_check + implicit none + integer, parameter :: N = 40000 + ! + type(mesh_t) :: mesh + real(c_float),pointer :: mesh_t_y(:) + ! + call init_mesh() + call gpufort_array_hostptr(mesh%y,mesh_t_y) + + call launch_vecadd_kernel_auto(0,c_null_ptr,mesh) + call hipCheck(gpufort_array_copy_to_host(mesh%y)) + + write(*,*) 'Max error: ', maxval(abs(mesh_t_y-4.0)) + + call destroy_mesh() +contains + subroutine init_mesh() + use gpufort_array + use iso_c_binding + implicit none + integer i + type(node_t) :: node_t_dummy + type(node_t),pointer :: mesh_t_x(:) + real(c_float),pointer :: mesh_t_y(:) + + ! Init scalar + mesh%a = 2.0 + + ! Init basic datatype array member + call hipCheck(gpufort_array_init(mesh%y,& + c_float,sizes=[N],lbounds=[1],& + alloc_mode=gpufort_array_alloc_pinned_host_alloc_device)) + call gpufort_array_hostptr(mesh%y,mesh_t_y) ! Get Fortran pointer to host data (overloaded routine exists for basic datatypes. + ! + mesh_t_y(:) = 2.0 ! Also sets lower bounds. + call hipCheck(gpufort_array_copy_to_device(mesh%y)) + + ! Init struct member. + call hipCheck(gpufort_array_init(mesh%x,& + int(c_sizeof(node_t_dummy),c_int),& + sizes=[N],lbounds=[1],& + alloc_mode=gpufort_array_alloc_pinned_host_alloc_device)) + ! + ! Get Fortran pointer to host data. No overloaded routine exists (must be type-specific). + ! In this case, you must/can set lower bounds manually if they are different from 1 and + ! the initial data is depending on the index. + call c_f_pointer(mesh%x%data%data_host,mesh_t_x,shape=[N]) + !mesh_t_x(1:) => mesh_t_x ! Set lower bounds + mesh_t_x(:)%val = 1 + call hipCheck(gpufort_array_copy_to_device(mesh%x)) + end subroutine + + ! (will be) autogenerated by GPUFORT + subroutine destroy_mesh() + use gpufort_array + use iso_c_binding + implicit none + call hipCheck(gpufort_array_destroy(mesh%x)) + call hipCheck(gpufort_array_destroy(mesh%y)) + end subroutine +end program main diff --git a/examples/gpufort_array/vector-add-non-interoperable-types/Makefile b/examples/gpufort_array/vector-add-non-interoperable-types/Makefile new file mode 100644 index 00000000..2045fdad --- /dev/null +++ b/examples/gpufort_array/vector-add-non-interoperable-types/Makefile @@ -0,0 +1,8 @@ +CFLAGS = -g -ggdb + +vector-add: + hipcc $(shell gpufort --cpp_config) $(CFLAGS) -c main-kernels.hip.cpp -o main-kernels.hip.o + hipfc $(shell gpufort --gfortran_config) main-kernels.hip.o vector-add.f90 -o vector-add $(shell gpufort --ldflags) + +clean: + rm -f *.mod *.o vector-add diff --git a/examples/gpufort_array/vector-add-non-interoperable-types/main-kernels.hip.cpp b/examples/gpufort_array/vector-add-non-interoperable-types/main-kernels.hip.cpp new file mode 100644 index 00000000..b2954d9d --- /dev/null +++ b/examples/gpufort_array/vector-add-non-interoperable-types/main-kernels.hip.cpp @@ -0,0 +1,50 @@ +// This file was generated by gpufort +#ifndef __KERNELS_HIP_CPP__ +#define __KERNELS_HIP_CPP__ +#include "hip/hip_runtime.h" +#include "hip/hip_complex.h" +#include "gpufort.h" +#include "gpufort_array.h" + +// C++ structs with same layout as Fortran interop types +struct node_t { + float val; +}; + +struct mesh_t { + float a; + gpufort::array1 x; + gpufort::array1 y; +}; + +/* + HIP C++ implementation of the function/loop body of: + + !$cuf kernel do(1) <<>> + do i=1,size(mesh%y,1) + mesh%y(i) = mesh%y(i) + mesh%a*mesh%x(i)%val + end do +*/ + +__global__ void vecadd_kernel(mesh_t mesh) { + int i = 1 + (1)*(threadIdx.x + blockIdx.x * blockDim.x); + if (loop_cond(i,mesh.y.size(1),1)) { + mesh.y(i)= mesh.y(i) + mesh.a*mesh.x(i).val; + } +} + +extern "C" void launch_vecadd_kernel_auto_( + const int& sharedmem, + hipStream_t& stream, + mesh_t& mesh +) { + const int vecadd_kernel_blockX = 128; + dim3 block(vecadd_kernel_blockX); + const int vecadd_kernel_NX = (1 + ((mesh.y.size(1)) - (1))); + const int vecadd_kernel_gridX = divideAndRoundUp( vecadd_kernel_NX, vecadd_kernel_blockX ); + dim3 grid(vecadd_kernel_gridX); + + // launch kernel + hipLaunchKernelGGL((vecadd_kernel), grid, block, sharedmem, stream, mesh); +} +#endif // __KERNELS_HIP_CPP__ diff --git a/examples/gpufort_array/vector-add-non-interoperable-types/vector-add.f90 b/examples/gpufort_array/vector-add-non-interoperable-types/vector-add.f90 new file mode 100644 index 00000000..a9f3e873 --- /dev/null +++ b/examples/gpufort_array/vector-add-non-interoperable-types/vector-add.f90 @@ -0,0 +1,97 @@ +module types + use iso_c_binding + use gpufort_array + + ! original non-interoperable types + type :: node_t + real :: val + end type + + type :: mesh_t + real :: a + type(node_t),allocatable :: x(:) + real,pointer,dimension(:) :: y + end type + + ! interoperable types; (will be) autogenerated by GPUFORT + type,bind(c) :: node_t_interop + real(c_float) :: val + end type + + type,bind(c) :: mesh_t_interop + real(c_float) :: a + type(gpufort_array1) :: x + type(gpufort_array1) :: y + end type +end module + +program main + use types + use hipfort_check + implicit none + integer, parameter :: N = 40000 + ! + type(mesh_t) :: mesh_orig + type(mesh_t_interop) :: mesh_interop + ! + call init_orig_type() + + call init_interop_type() + + call launch_vecadd_kernel_auto(0,c_null_ptr,mesh_interop) + + call destroy_interop_type() + + write(*,*) 'Max error: ', maxval(abs(mesh_orig%y-4.0)) +contains + subroutine init_orig_type() + implicit none + integer i + allocate(mesh_orig%x(N)) + allocate(mesh_orig%y(N)) + mesh_orig%x(:)%val = 1.0; + mesh_orig%y(:) = 2.0; mesh_orig%a = 2.0 + end subroutine + + ! (will be) autogenerated by gpufort + subroutine init_interop_type() + use gpufort_array + use iso_c_binding + implicit none + integer i + type(node_t_interop) :: node_t_interop_dummy + type(node_t_interop),pointer :: mesh_t_interop_x(:) + ! Allocate interoperable struct array + ! Generate type specific init routine? + ! REQ: Need to know shape and bounds, not mesh_orig + ! NOTE: size can be supplied from the CPP side, too. + ! NOTE: alloc_mode will remain as is. + call hipCheck(gpufort_array_init(mesh_interop%x,& + int(c_sizeof(node_t_interop_dummy),c_int),& + shape(mesh_orig%x),& + lbounds=lbound(mesh_orig%x),& + alloc_mode=gpufort_array_alloc_pinned_host_alloc_device)) + + ! Copy to device; from non-interop type to interop type + ! REQ: Need to know mesh_orig for value assignment + call c_f_pointer(mesh_interop%x%data%data_host,& + mesh_t_interop_x,shape=shape(mesh_orig%x)) + mesh_t_interop_x(:)%val = mesh_orig%x(:)%val ! depends on members & rank + call hipCheck(gpufort_array_copy_to_device(mesh_interop%x)) + + ! Init basic datatype array + call hipCheck(gpufort_array_init(mesh_interop%y,mesh_orig%y,& + alloc_mode=gpufort_array_wrap_host_alloc_device,& + sync_mode=gpufort_array_sync_copy)) + mesh_interop%a = mesh_orig%a + end subroutine + + ! (will be) autogenerated by GPUFORT + subroutine destroy_interop_type() + use gpufort_array + use iso_c_binding + implicit none + call hipCheck(gpufort_array_destroy(mesh_interop%x)) + call hipCheck(gpufort_array_destroy(mesh_interop%y)) + end subroutine +end program main diff --git a/examples/gpufort_array/vector-add/Makefile b/examples/gpufort_array/vector-add/Makefile new file mode 100644 index 00000000..2045fdad --- /dev/null +++ b/examples/gpufort_array/vector-add/Makefile @@ -0,0 +1,8 @@ +CFLAGS = -g -ggdb + +vector-add: + hipcc $(shell gpufort --cpp_config) $(CFLAGS) -c main-kernels.hip.cpp -o main-kernels.hip.o + hipfc $(shell gpufort --gfortran_config) main-kernels.hip.o vector-add.f90 -o vector-add $(shell gpufort --ldflags) + +clean: + rm -f *.mod *.o vector-add diff --git a/examples/gpufort_array/vector-add/main-kernels.hip.cpp b/examples/gpufort_array/vector-add/main-kernels.hip.cpp new file mode 100644 index 00000000..2d1073d5 --- /dev/null +++ b/examples/gpufort_array/vector-add/main-kernels.hip.cpp @@ -0,0 +1,47 @@ +// This file was generated by gpufort +#ifndef __KERNELS_HIP_CPP__ +#define __KERNELS_HIP_CPP__ +#include "hip/hip_runtime.h" +#include "hip/hip_complex.h" +#include "gpufort.h" +#include "gpufort_array.h" + + +// BEGIN main_26_e28c45 +/* + HIP C++ implementation of the function/loop body of: + + !$cuf kernel do(1) <<>> + do i=1,size(y_d,1) + y_d(i) = y_d(i) + a*x_d(i) + end do + +*/ + +__global__ void vecadd_kernel( + gpufort::array1 y_d, + const float a, + const gpufort::array1 x_d +) { + int i = 1 + (1)*(threadIdx.x + blockIdx.x * blockDim.x); + if (loop_cond(i,y_d.size(1),1)) { + y_d(i)= y_d(i) + a*x_d(i); + } +} + +extern "C" void launch_vecadd_kernel_( + const dim3& grid, + const dim3& block, + const int& sharedmem, + hipStream_t& stream, + gpufort::array1& y_d, + const float& a, + const gpufort::array1& x_d +) { + // launch kernel + hipLaunchKernelGGL((vecadd_kernel), grid, block, sharedmem, stream, y_d, a, x_d); + //y_d.print_host_data(std::cout,"launch_vecadd_kernel:y_d:host",gpufort::PrintMode::PrintCValues,12); + //y_d.print_device_data(std::cout,"launch_vecadd_kernel:y_d:device",gpufort::PrintMode::PrintValuesAndNorms,12); +} +// END vecadd_kernel +#endif // __KERNELS_HIP_CPP__ diff --git a/examples/gpufort_array/vector-add/vector-add.f90 b/examples/gpufort_array/vector-add/vector-add.f90 new file mode 100644 index 00000000..dbe6c10b --- /dev/null +++ b/examples/gpufort_array/vector-add/vector-add.f90 @@ -0,0 +1,31 @@ +program main + use hipfort + use hipfort_check + use gpufort_array + implicit none + integer, parameter :: N = 40000 + real :: x(N), y(N), a + type(gpufort_array1) :: x_d, y_d + type(dim3) :: grid, tBlock + type(c_ptr) :: stream = c_null_ptr + ! + tBlock = dim3(256,1,1) + grid = dim3(ceiling(real(N)/tBlock%x),1,1) + + call hipCheck(gpufort_array_init(x_d,x)) + call hipCheck(gpufort_array_init(y_d,y)) + + x = 1.0; y = 2.0; a = 2.0 + call hipCheck(gpufort_array_copy_to_device(x_d)) + call hipCheck(gpufort_array_copy_to_device(y_d)) + + call launch_vecadd_kernel(grid,tBlock,0,stream,y_d,a,x_d) + call hipCheck(hipStreamSynchronize(stream)) + + call hipCheck(gpufort_array_copy_to_host(y_d)) + + call hipCheck(gpufort_array_destroy(x_d)) + call hipCheck(gpufort_array_destroy(y_d)) + + write(*,*) 'Max error: ', maxval(abs(y-4.0)) +end program main diff --git a/examples/openacc/rules.mk b/examples/openacc/rules.mk index 5b5ae252..9bd2b483 100644 --- a/examples/openacc/rules.mk +++ b/examples/openacc/rules.mk @@ -15,9 +15,5 @@ HIPFC ?= hipfc OMPFC ?= /opt/rocm/llvm/bin/flang OMPFC_CFLAGS ?= $(CFLAGS) -fopenmp -fopenmp-targets=amdgcn-amd-amdhsa -Xopenmp-target=amdgcn-amd-amdhsa -march=gfx908 -GPUFORT_ACC_DIR ?= $(shell gpufort --path)/runtime/gpufort_acc_runtime -ACC_INC = -I/$(GPUFORT_ACC_DIR)/include -ACC_LIB = -L/$(GPUFORT_ACC_DIR)/lib -lgpufort_acc - -CFLAGS += $(ACC_INC) $(ACC_LIB) -lgfortran +CFLAGS += $(shell gpufort --ldflags-gpufort-rt) -lgfortran diff --git a/examples/openacc/vector-add-declare/Makefile b/examples/openacc/vector-add-declare/Makefile new file mode 100644 index 00000000..8bf86219 --- /dev/null +++ b/examples/openacc/vector-add-declare/Makefile @@ -0,0 +1,16 @@ +include ../rules.mk + +TEST_SRC = vector-add.f90 vector-add-procedures.f90 vector-add-module-vars.f90 +TEST_NAME = $(TEST_SRC:.f90=) +TEST_CONV_SRC = $(TEST_SRC:.f90=.f90-gpufort.f08) + +.PHONY: clean + +$(TEST_NAME): %: %.f90-gpufort.f08 + $(HIPCC) $(HIPCC_CFLAGS) -c $@.f90-fort2hip.hip.cpp + $(HIPFC) $^ -o $@ $@.f90-fort2hip.hip.o $(CFLAGS) + +$(TEST_CONV_SRC): %-gpufort.f08: % + gpufort -w $^ -E hip-gpufort-rt +clean: + rm -rf *-gpufort.* *-fort2hip.* *.o *.mod gpufort*.h $(TEST_NAME) *.gpufort_mod *-linemaps-*.json log/ diff --git a/examples/openacc/vector-add-declare/vector-add-module-vars.f90 b/examples/openacc/vector-add-declare/vector-add-module-vars.f90 new file mode 100644 index 00000000..1f64376d --- /dev/null +++ b/examples/openacc/vector-add-declare/vector-add-module-vars.f90 @@ -0,0 +1,44 @@ +module datatypes + integer, parameter :: N = 1000 + integer,allocatable,dimension(:) :: x1 + integer,pointer,dimension(:) :: x2 + integer :: y(N) + !$acc declare create(x1,x2,y) +end module + +program main + ! begin of program + + use datatypes + implicit none + integer :: i + integer(4) :: y_exact(N) + + allocate(x1(N),x2(N)) + + y_exact = 4 + + !$acc parallel loop + do i = 1, N + x1(i) = 1 + x2(i) = 1 + y(i) = 2 + end do + + !$acc parallel loop + do i = 1, N + y(i) = x1(i) + x2(i) + y(i) + end do + + !$acc update host(y) + + do i = 1, N + if ( y_exact(i) .ne.& + y(i) ) ERROR STOP "GPU and CPU result do not match" + end do + + print *, "PASSED" + + deallocate(x1,x2) + +end program diff --git a/examples/openacc/vector-add-declare/vector-add-procedures.f90 b/examples/openacc/vector-add-declare/vector-add-procedures.f90 new file mode 100644 index 00000000..76d6b54a --- /dev/null +++ b/examples/openacc/vector-add-declare/vector-add-procedures.f90 @@ -0,0 +1,42 @@ +program main + ! begin of program + + implicit none + integer, parameter :: N = 1000 + integer :: i,j + integer(4) :: x(N,N), y(N,N), y_exact(N) + + y_exact = 3 + + x = 1 + y = 2 + + call vector_add_gpu(x(1:,3),y(1:,3),.FALSE.) + call vector_add_gpu(x(1:,3),y(1:,3),.TRUE.) ! return prematurely; do not perform addition + + do i = 1, N + if ( y_exact(i) .ne.& + y(i,3) ) ERROR STOP "GPU and CPU result do not match" + end do + + print *, "PASSED" + +contains + +subroutine vector_add_gpu(x,y,return_prematurely) + integer(4) :: x(:), y(:) + logical :: return_prematurely + !$acc declare copyin(x,y) + + ! extra return statement + if ( return_prematurely ) return + + !$acc parallel loop + do i = 1, N + y(i) = x(i) + y(i) + end do + + !$acc update host(y) +end subroutine + +end program diff --git a/examples/openacc/vector-add-declare/vector-add.f90 b/examples/openacc/vector-add-declare/vector-add.f90 new file mode 100644 index 00000000..397c7b39 --- /dev/null +++ b/examples/openacc/vector-add-declare/vector-add.f90 @@ -0,0 +1,32 @@ +program main + ! begin of program + + implicit none + integer, parameter :: N = 1000 + integer :: i + integer(4) :: x(N), y(N), y_exact(N) + !$acc declare create(x,y) + + y_exact = 3 + + !$acc parallel loop + do i = 1, N + x(i) = 1 + y(i) = 2 + end do + + !$acc parallel loop + do i = 1, N + y(i) = x(i) + y(i) + end do + + !$acc update host(y) + + do i = 1, N + if ( y_exact(i) .ne.& + y(i) ) ERROR STOP "GPU and CPU result do not match" + end do + + print *, "PASSED" + +end program diff --git a/examples/openacc/vector-add/vector-add.f90 b/examples/openacc/vector-add/vector-add.f90 index 4940ab47..8b551e57 100644 --- a/examples/openacc/vector-add/vector-add.f90 +++ b/examples/openacc/vector-add/vector-add.f90 @@ -12,7 +12,7 @@ program main !$acc data copy(x(1:N),y(1:N)) - !$acc parallel loop + !$acc parallel loop present(x,y) do i = 1, N x(i) = 1 y(i) = 2 diff --git a/gpufort_slides.pdf b/gpufort_slides.pdf index a71a43ba..7afa721d 100644 Binary files a/gpufort_slides.pdf and b/gpufort_slides.pdf differ diff --git a/include/Makefile b/include/Makefile index 8724d2e5..dbdeb7ca 100644 --- a/include/Makefile +++ b/include/Makefile @@ -1,12 +1,15 @@ -.PHONY: all headers modules +.PHONY: all headers modules clean_all + +SUFFIX = $(if $(HIP_PLATFORM),$(HIP_PLATFORM),amd) all: headers modules headers: gpufort --create-gpufort-headers + touch cudafor-fort2hip.hip.cpp modules: - gpufort -K cudafor.f90 + gpufort -c cudafor.f90 -make clean: - rm -rf *.gpufort_mod *-fort2hip.* *-gpufort.* *.h +clean_all: + for expr in "*.json" "*.mod" "*.gpufort_mod" "*-fort2hip.*" "*-gpufort.*" "*.h"; do find . -name "$$expr" -delete; done diff --git a/include/cudafor-fort2hip.hip.cpp b/include/cudafor-fort2hip.hip.cpp deleted file mode 100644 index e69de29b..00000000 diff --git a/include/cudafor.f90 b/include/cudafor.f90 index 50dc24da..b6ee2dde 100644 --- a/include/cudafor.f90 +++ b/include/cudafor.f90 @@ -1,6 +1,7 @@ module cudafor type,bind(c) :: dim3 integer(c_int) :: x,y,z - integer :: d end type dim3 + + type(dim3) :: blockdim, griddim, threadidx, blockidx end module cudafor diff --git a/include/cudafor.f90-fort2hip.hip.cpp b/include/cudafor.f90-fort2hip.hip.cpp deleted file mode 100644 index d23a1d4a..00000000 --- a/include/cudafor.f90-fort2hip.hip.cpp +++ /dev/null @@ -1 +0,0 @@ -#include "cudafor-fort2hip.hip.cpp" \ No newline at end of file diff --git a/include/cudafor.gpufort_mod b/include/cudafor.gpufort_mod deleted file mode 100644 index 046500fe..00000000 --- a/include/cudafor.gpufort_mod +++ /dev/null @@ -1 +0,0 @@ -{"kind":"module","name":"cudafor","variables":[],"types":[{"name":"dim3","kind":"type","variables":[{"name":"x","f_type":"integer","kind":"c_int","bytes_per_element":"4","c_type":"int","f_interface_type":"integer","f_interface_qualifiers":["value"],"qualifiers":[],"declare_on_target":false,"rank":0,"value":null},{"name":"y","f_type":"integer","kind":"c_int","bytes_per_element":"4","c_type":"int","f_interface_type":"integer","f_interface_qualifiers":["value"],"qualifiers":[],"declare_on_target":false,"rank":0,"value":null},{"name":"z","f_type":"integer","kind":"c_int","bytes_per_element":"4","c_type":"int","f_interface_type":"integer","f_interface_qualifiers":["value"],"qualifiers":[],"declare_on_target":false,"rank":0,"value":null},{"name":"d","f_type":"integer","kind":"","bytes_per_element":"4","c_type":"int","f_interface_type":"integer","f_interface_qualifiers":["value"],"qualifiers":[],"declare_on_target":false,"rank":0,"value":null}],"types":[]}],"subprograms":[],"used_modules":[]} \ No newline at end of file diff --git a/include/gpufort.h b/include/gpufort.h deleted file mode 100644 index 60be7da6..00000000 --- a/include/gpufort.h +++ /dev/null @@ -1,445 +0,0 @@ -#ifndef _GPUFORT_H_ -#define _GPUFORT_H_ -#include "hip/hip_complex.h" -#include "hip/math_functions.h" -#include -#include -#include -#include -#include -#include -#include -#define HIP_CHECK(condition) \ - { \ - hipError_t error = condition; \ - if(error != hipSuccess){ \ - std::cout << "HIP error: " << error << " line: " << __LINE__ << std::endl; \ - exit(error); \ - } \ - } - -// global thread indices for various dimensions -#define __gidx(idx) (threadIdx.idx + blockIdx.idx * blockDim.idx) -#define __gidx1 __gidx(x) -#define __gidx2 (__gidx(x) + gridDim.x*blockDim.x*__gidx(y)) -#define __gidx3 (__gidx(x) + gridDim.x*blockDim.x*__gidx(y) + gridDim.x*blockDim.x*gridDim.y*blockDim.y*__gidx(z)) -#define __total_threads(grid,block) ( (grid).x*(grid).y*(grid).z * (block).x*(block).y*(block).z ) -#define divideAndRoundUp(x, y) ((x) / (y) + ((x) % (y) != 0)) - -#define GPUFORT_PRINT_ARGS(...) gpufort_show_args(std::cout, #__VA_ARGS__, __VA_ARGS__) -namespace { - template std::ostream& gpufort_show_args(std::ostream& out, const char* label, H1&& value) { - return out << label << "=" << std::forward

(value) << '\n'; - } - - template std::ostream& gpufort_show_args(std::ostream& out, const char* label, H1&& value, T&&... rest) { - const char* pcomma = strchr(label, ','); - return gpufort_show_args(out.write(label, pcomma - label) << "=" << std::forward

(value) << ',', - pcomma + 1, - std::forward(rest)...); - } -} -#define GPUFORT_PRINT_ARRAY1(prefix,print_values,print_norms,A,n1,lb1) gpufort_print_array1(std::cout, prefix, print_values, print_norms, #A, A, n1,lb1) -#define GPUFORT_PRINT_ARRAY2(prefix,print_values,print_norms,A,n1,n2,lb1,lb2) gpufort_print_array2(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,lb1,lb2) -#define GPUFORT_PRINT_ARRAY3(prefix,print_values,print_norms,A,n1,n2,n3,lb1,lb2,lb3) gpufort_print_array3(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,n3,lb1,lb2,lb3) -#define GPUFORT_PRINT_ARRAY4(prefix,print_values,print_norms,A,n1,n2,n3,n4,lb1,lb2,lb3,lb4) gpufort_print_array4(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,n3,n4,lb1,lb2,lb3,lb4) -#define GPUFORT_PRINT_ARRAY5(prefix,print_values,print_norms,A,n1,n2,n3,n4,n5,lb1,lb2,lb3,lb4,lb5) gpufort_print_array5(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,n3,n4,n5,lb1,lb2,lb3,lb4,lb5) -#define GPUFORT_PRINT_ARRAY6(prefix,print_values,print_norms,A,n1,n2,n3,n4,n5,n6,lb1,lb2,lb3,lb4,lb5,lb6) gpufort_print_array6(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,n3,n4,n5,n6,lb1,lb2,lb3,lb4,lb5,lb6) -#define GPUFORT_PRINT_ARRAY7(prefix,print_values,print_norms,A,n1,n2,n3,n4,n5,n6,n7,lb1,lb2,lb3,lb4,lb5,lb6,lb7) gpufort_print_array7(std::cout, prefix, print_values, print_norms, #A, A, n1,n2,n3,n4,n5,n6,n7,lb1,lb2,lb3,lb4,lb5,lb6,lb7) -namespace { - template - void gpufort_print_array1(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int lb1) { - int n =n1; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << ") = " << std::setprecision(6) << value << "\n"; - } - } // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array2(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int lb1,int lb2) { - int n =n1*n2; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << ") = " << std::setprecision(6) << value << "\n"; - } - }} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array3(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int n3,int lb1,int lb2,int lb3) { - int n =n1*n2*n3; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i3 = 0; i3 < n3; i3++ ) { - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*n2*i3+n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << "," << (lb3+i3) << ") = " << std::setprecision(6) << value << "\n"; - } - }}} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array4(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int n3,int n4,int lb1,int lb2,int lb3,int lb4) { - int n =n1*n2*n3*n4; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i4 = 0; i4 < n4; i4++ ) { - for ( int i3 = 0; i3 < n3; i3++ ) { - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*n2*n3*i4+n1*n2*i3+n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << "," << (lb3+i3) << "," << (lb4+i4) << ") = " << std::setprecision(6) << value << "\n"; - } - }}}} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array5(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int n3,int n4,int n5,int lb1,int lb2,int lb3,int lb4,int lb5) { - int n =n1*n2*n3*n4*n5; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i5 = 0; i5 < n5; i5++ ) { - for ( int i4 = 0; i4 < n4; i4++ ) { - for ( int i3 = 0; i3 < n3; i3++ ) { - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*n2*n3*n4*i5+n1*n2*n3*i4+n1*n2*i3+n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << "," << (lb3+i3) << "," << (lb4+i4) << "," << (lb5+i5) << ") = " << std::setprecision(6) << value << "\n"; - } - }}}}} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array6(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int n3,int n4,int n5,int n6,int lb1,int lb2,int lb3,int lb4,int lb5,int lb6) { - int n =n1*n2*n3*n4*n5*n6; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i6 = 0; i6 < n6; i6++ ) { - for ( int i5 = 0; i5 < n5; i5++ ) { - for ( int i4 = 0; i4 < n4; i4++ ) { - for ( int i3 = 0; i3 < n3; i3++ ) { - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*n2*n3*n4*n5*i6+n1*n2*n3*n4*i5+n1*n2*n3*i4+n1*n2*i3+n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << "," << (lb3+i3) << "," << (lb4+i4) << "," << (lb5+i5) << "," << (lb6+i6) << ") = " << std::setprecision(6) << value << "\n"; - } - }}}}}} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - template - void gpufort_print_array7(std::ostream& out, const char* prefix, const bool print_values, const bool print_norms, const char* label, T A[], int n1,int n2,int n3,int n4,int n5,int n6,int n7,int lb1,int lb2,int lb3,int lb4,int lb5,int lb6,int lb7) { - int n =n1*n2*n3*n4*n5*n6*n7; - std::vector A_h(n); - out << prefix << label << ":" << "\n"; - HIP_CHECK(hipMemcpy(A_h.data(), A, n*sizeof(T), hipMemcpyDeviceToHost)); - T min = +std::numeric_limits::max(); - T max = -std::numeric_limits::max(); - T sum = 0; - T l1 = 0; - T l2 = 0; - for ( int i7 = 0; i7 < n7; i7++ ) { - for ( int i6 = 0; i6 < n6; i6++ ) { - for ( int i5 = 0; i5 < n5; i5++ ) { - for ( int i4 = 0; i4 < n4; i4++ ) { - for ( int i3 = 0; i3 < n3; i3++ ) { - for ( int i2 = 0; i2 < n2; i2++ ) { - for ( int i1 = 0; i1 < n1; i1++ ) { - T value = A_h[n1*n2*n3*n4*n5*n6*i7+n1*n2*n3*n4*n5*i6+n1*n2*n3*n4*i5+n1*n2*n3*i4+n1*n2*i3+n1*i2+i1]; - if ( print_norms ) { - min = std::min(value,min); - max = std::max(value,max); - sum += value; - l1 += std::abs(value); - l2 += value*value; - } - if ( print_values ) { - out << prefix << label << "(" << (lb1+i1) << "," << (lb2+i2) << "," << (lb3+i3) << "," << (lb4+i4) << "," << (lb5+i5) << "," << (lb6+i6) << "," << (lb7+i7) << ") = " << std::setprecision(6) << value << "\n"; - } - }}}}}}} // for loops - if ( print_norms ) { - out << prefix << label << ":" << "min=" << min << "\n"; - out << prefix << label << ":" << "max=" << max << "\n"; - out << prefix << label << ":" << "sum=" << sum << "\n"; - out << prefix << label << ":" << "l1=" << l1 << "\n"; - out << prefix << label << ":" << "l2=" << std::sqrt(l2) << "\n"; - } - } - // loop condition - template __device__ __forceinline__ bool loop_cond(I idx,E end,S stride) { - return (stride>0) ? ( idx <= end ) : ( -idx <= -end ); - } - - // type conversions - // make float - __device__ __forceinline__ float make_float(const short int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const unsigned short int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const unsigned int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const long int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const unsigned long int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const long long int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const unsigned long long int a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const signed char a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const unsigned char a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const float a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const double a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const long double a) { - return static_cast(a); - } - __device__ __forceinline__ float make_float(const hipFloatComplex a) { - return static_cast(a.x); - } - __device__ __forceinline__ float make_float(const hipDoubleComplex a) { - return static_cast(a.x); - } // make double - __device__ __forceinline__ double make_double(const short int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const unsigned short int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const unsigned int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const long int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const unsigned long int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const long long int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const unsigned long long int a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const signed char a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const unsigned char a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const float a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const double a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const long double a) { - return static_cast(a); - } - __device__ __forceinline__ double make_double(const hipFloatComplex a) { - return static_cast(a.x); - } - __device__ __forceinline__ double make_double(const hipDoubleComplex a) { - return static_cast(a.x); - } - // math functions - __device__ __forceinline__ hipFloatComplex conj(const hipFloatComplex& c) { - return hipConjf(c); - } - __device__ __forceinline__ hipDoubleComplex conj(const hipDoubleComplex& z) { - return hipConj(z); - } - __device__ __forceinline__ int nint(const float a) { - return (a>0.f) ? static_cast(a+0.5f) : static_cast(a-0.5f); - } - __device__ __forceinline__ int nint(const double a) { - return (a>0.) ? static_cast(a+0.5) : static_cast(a-0.5); - } - __device__ __forceinline__ float dim(const float a, const float b) { - const float diff = a-b; - return (diff>0.f) ? diff : 0.f; - } - __device__ __forceinline__ double dim(const double a, const double b) { - const double diff = a-b; - return (diff>0.) ? diff : 0.; - } -} - -#define sign(a,b) copysign(a,b) - -#define min2(a,b) min(a,b) -#define min3(aa,ab,ba) min(min(aa,ab),ba) -#define min4(aa,ab,ba,bb) min(min(aa,ab),min(ba,bb)) -#define min5(aaa,aab,aba,ba,bb) min(min(min(aaa,aab),aba),min(ba,bb)) -#define min6(aaa,aab,aba,baa,bab,bba) min(min(min(aaa,aab),aba),min(min(baa,bab),bba)) -#define min7(aaa,aab,aba,abb,baa,bab,bba) min(min(min(aaa,aab),min(aba,abb)),min(min(baa,bab),bba)) -#define min8(aaa,aab,aba,abb,baa,bab,bba,bbb) min(min(min(aaa,aab),min(aba,abb)),min(min(baa,bab),min(bba,bbb))) -#define min9(aaaa,aaab,aaba,aba,abb,baa,bab,bba,bbb) min(min(min(min(aaaa,aaab),aaba),min(aba,abb)),min(min(baa,bab),min(bba,bbb))) -#define min10(aaaa,aaab,aaba,aba,abb,baaa,baab,baba,bba,bbb) min(min(min(min(aaaa,aaab),aaba),min(aba,abb)),min(min(min(baaa,baab),baba),min(bba,bbb))) -#define min11(aaaa,aaab,aaba,abaa,abab,abba,baaa,baab,baba,bba,bbb) min(min(min(min(aaaa,aaab),aaba),min(min(abaa,abab),abba)),min(min(min(baaa,baab),baba),min(bba,bbb))) -#define min12(aaaa,aaab,aaba,abaa,abab,abba,baaa,baab,baba,bbaa,bbab,bbba) min(min(min(min(aaaa,aaab),aaba),min(min(abaa,abab),abba)),min(min(min(baaa,baab),baba),min(min(bbaa,bbab),bbba))) -#define min13(aaaa,aaab,aaba,aabb,abaa,abab,abba,baaa,baab,baba,bbaa,bbab,bbba) min(min(min(min(aaaa,aaab),min(aaba,aabb)),min(min(abaa,abab),abba)),min(min(min(baaa,baab),baba),min(min(bbaa,bbab),bbba))) -#define min14(aaaa,aaab,aaba,aabb,abaa,abab,abba,baaa,baab,baba,babb,bbaa,bbab,bbba) min(min(min(min(aaaa,aaab),min(aaba,aabb)),min(min(abaa,abab),abba)),min(min(min(baaa,baab),min(baba,babb)),min(min(bbaa,bbab),bbba))) -#define min15(aaaa,aaab,aaba,aabb,abaa,abab,abba,abbb,baaa,baab,baba,babb,bbaa,bbab,bbba) min(min(min(min(aaaa,aaab),min(aaba,aabb)),min(min(abaa,abab),min(abba,abbb))),min(min(min(baaa,baab),min(baba,babb)),min(min(bbaa,bbab),bbba))) -#define max2(a,b) max(a,b) -#define max3(aa,ab,ba) max(max(aa,ab),ba) -#define max4(aa,ab,ba,bb) max(max(aa,ab),max(ba,bb)) -#define max5(aaa,aab,aba,ba,bb) max(max(max(aaa,aab),aba),max(ba,bb)) -#define max6(aaa,aab,aba,baa,bab,bba) max(max(max(aaa,aab),aba),max(max(baa,bab),bba)) -#define max7(aaa,aab,aba,abb,baa,bab,bba) max(max(max(aaa,aab),max(aba,abb)),max(max(baa,bab),bba)) -#define max8(aaa,aab,aba,abb,baa,bab,bba,bbb) max(max(max(aaa,aab),max(aba,abb)),max(max(baa,bab),max(bba,bbb))) -#define max9(aaaa,aaab,aaba,aba,abb,baa,bab,bba,bbb) max(max(max(max(aaaa,aaab),aaba),max(aba,abb)),max(max(baa,bab),max(bba,bbb))) -#define max10(aaaa,aaab,aaba,aba,abb,baaa,baab,baba,bba,bbb) max(max(max(max(aaaa,aaab),aaba),max(aba,abb)),max(max(max(baaa,baab),baba),max(bba,bbb))) -#define max11(aaaa,aaab,aaba,abaa,abab,abba,baaa,baab,baba,bba,bbb) max(max(max(max(aaaa,aaab),aaba),max(max(abaa,abab),abba)),max(max(max(baaa,baab),baba),max(bba,bbb))) -#define max12(aaaa,aaab,aaba,abaa,abab,abba,baaa,baab,baba,bbaa,bbab,bbba) max(max(max(max(aaaa,aaab),aaba),max(max(abaa,abab),abba)),max(max(max(baaa,baab),baba),max(max(bbaa,bbab),bbba))) -#define max13(aaaa,aaab,aaba,aabb,abaa,abab,abba,baaa,baab,baba,bbaa,bbab,bbba) max(max(max(max(aaaa,aaab),max(aaba,aabb)),max(max(abaa,abab),abba)),max(max(max(baaa,baab),baba),max(max(bbaa,bbab),bbba))) -#define max14(aaaa,aaab,aaba,aabb,abaa,abab,abba,baaa,baab,baba,babb,bbaa,bbab,bbba) max(max(max(max(aaaa,aaab),max(aaba,aabb)),max(max(abaa,abab),abba)),max(max(max(baaa,baab),max(baba,babb)),max(max(bbaa,bbab),bbba))) -#define max15(aaaa,aaab,aaba,aabb,abaa,abab,abba,abbb,baaa,baab,baba,babb,bbaa,bbab,bbba) max(max(max(max(aaaa,aaab),max(aaba,aabb)),max(max(abaa,abab),max(abba,abbb))),max(max(max(baaa,baab),max(baba,babb)),max(max(bbaa,bbab),bbba))) -#endif // _GPUFORT_H_ diff --git a/include/gpufort_reductions.h b/include/gpufort_reductions.h deleted file mode 100644 index 7ea12c71..00000000 --- a/include/gpufort_reductions.h +++ /dev/null @@ -1,79 +0,0 @@ -#ifndef _GPUFORT_REDUCTIONS_H_ -#define _GPUFORT_REDUCTIONS_H_ -// requires that gpufort.h is included beforehand -#include "hip/hip_runtime_api.h" -#include "hip/hip_runtime.h" -#include "hipcub/hipcub.hpp" -#include -// reductions -namespace { - struct reduce_op_mult { - template - static __host__ __device__ __forceinline__ T ival() { return (T)1; } - template - static __host__ __device__ __forceinline__ void init(T &a) { a = ival(); } - template - __device__ __forceinline__ T operator()(const T &a, const T &b) const { - return a * b; - } - }; - - struct reduce_op_add { - template - static __host__ __device__ __forceinline__ T ival() { return (T)0; } - template - static __host__ __device__ __forceinline__ void init(T &a) { a = ival(); } - template - __device__ __forceinline__ T operator()(const T &a, const T &b) const { - return a + b; - } - }; - - struct reduce_op_max { - template - static __host__ __device__ __forceinline__ T ival() { - return -std::numeric_limits::max(); // has negative sign - } - template - static __host__ __device__ __forceinline__ void init(T &a) { a = ival(); } - template - __device__ __forceinline__ T operator()(const T &a, const T &b) const { - return std::max(a, b); - } - }; - - struct reduce_op_min { - template - static __host__ __device__ __forceinline__ T ival() { - return std::numeric_limits::max(); - } - template - static __host__ __device__ __forceinline__ void init(T &a) { a = ival(); } - template - __device__ __forceinline__ T operator()(const T &a, const T &b) const { - return std::min(a, b); - } - }; - - template - void reduce(const T *const d_in, const int &NX, const T *h_out) { - T *d_out = nullptr; - HIP_CHECK(hipMalloc((void **)&d_out, sizeof(T))); - // Determine temporary device storage requirements - void *temp_storage = nullptr; - size_t temp_storage_bytes = 0; - ReduceOpT reduceOp; - hipcub::DeviceReduce::Reduce(temp_storage, temp_storage_bytes, d_in, d_out, NX, - ReduceOpT(), ReduceOpT::template ival()); - // Allocate temporary storage - HIP_CHECK(hipMalloc(&temp_storage, temp_storage_bytes)); - // Run reduction - hipcub::DeviceReduce::Reduce(temp_storage, temp_storage_bytes, d_in, d_out, NX, - ReduceOpT(), ReduceOpT::template ival()); - HIP_CHECK(hipMemcpy((void *)h_out, d_out, sizeof(T), hipMemcpyDeviceToHost)); - // Clean up - HIP_CHECK(hipFree(d_out)); - HIP_CHECK(hipFree(temp_storage)); - } -} -#endif // _GPUFORT_REDUCTIONS_H_ \ No newline at end of file diff --git a/notes/todos.md b/notes/todos.md deleted file mode 100755 index 8d80350d..00000000 --- a/notes/todos.md +++ /dev/null @@ -1,62 +0,0 @@ -# ToDos - -* [ ] Implement kernel subroutine parser - * [ ] Remove input parameters from declarations in body; - * can be deduced from arglist - * return type is always void - * [x] Make grid,dim,sharedMem (int) and stream (type(c_ptr)) - arguments to kernel. Do not deduce them - -* [ ] Handle struct / derived type arguments to cuf kernels / kernel subroutines - * ~~Proposed solution: Flatten out the expression, use "TODO ..." as default type~~ - * ~~Eventually need a way to parse derived types ...~~ - * [x] Parse types and demangle all members. Create dummy variables with name "a%b%c" -* [x] Compress linear index mappings -* [x] Identify local variables in cuf kernels ... -* [x] and remove them from arg list, - * Scan for scalar lvalues - * Problem: need also to check if they have been used in function before assignment - * Proposed solution: - * Find all assignments and arithmeticLogicExpression in order - * Find rvalues and lvalues per expression, i.e have list [ { "lvalue" : [] , "rvalues": [] } ] - * Check if lvalue was used as rvalue before. If so, do not include in result list - * Problem: (Minor) When we do adaptive parsing, some lines are commented out, i.e. result might contain errors. - * Proposed solution: Do ignore result of procedure in this case -* [ ] detect reduced variables - * Criterion: scalar variable that is assigned but not read anymore - * [ ] compute partial sum per variable - * [ ] -* [ ] Add option to specify search dir as individual files, this allows to filter out some files - and be more specific what to include in scan and what not. -* [x] More type conversions and conjugate functions (dcmplx, dconjg, ...) -* [ ] Detect "/= 0" expressions and replace with "c_associated(...)" if type is stream or cufft plan (interger) type. - -* To replace expression in array evaluations, I need to know the index str / macro from the corresponding declaration. - * Problem is that I do not know the lower bound. Save lbound as well? - * Decision: Ignore for now! - -# Code snippets: - - -Search and replace expression: - -```python -for tokens,start,end in expr.scanString(string): - print(string.replace(string[start:end],"EDIT")) -``` - -for tokens,start,end in expr.scanString(string): - tokens[0].configure(extra="50") - print(string.replace(string[start:end],tokens[0].__str__())) - - -# Revision - - WHICH information do I need to introduce to the tree? - - allocate, copy intrinsices - if variable is on the device | (CUF,ACC)->HIP, CUF->OMP - - place holders if device pointers need to be introduced - if we need a variable | (CUF,ACC)->HIP - - device variables/subroutines if we need to declare them on the device | CUF -> OMP - What is needed only for ACC -> OMP? - - for some directives, only source2source - - OpenACC implicitly assumes that scalars are private -> need to know what is a scalar - diff --git a/python/Makefile b/python/Makefile index 0cb34c8d..638ca480 100644 --- a/python/Makefile +++ b/python/Makefile @@ -1,5 +1,5 @@ GRAMMAR_TRANSLATOR_TEST_COLLECTIONS_PREFIXES := test.grammar_translator.openacc test.grammar_translator.cudafortran \ - test.grammar_translator.linemapper + test.grammar_translator.linemapper test.grammar_translator GRAMMAR_TEST_COLLECTIONS := $(addsuffix .grammar,$(GRAMMAR_TRANSLATOR_TEST_COLLECTIONS_PREFIXES)) TRANSLATOR_TEST_COLLECTIONS := $(addsuffix .translator,$(GRAMMAR_TRANSLATOR_TEST_COLLECTIONS_PREFIXES)) diff --git a/python/fort2hip/fort2hip.py b/python/fort2hip/fort2hip.py index 1dba5296..6e4d92ea 100644 --- a/python/fort2hip/fort2hip.py +++ b/python/fort2hip/fort2hip.py @@ -288,11 +288,9 @@ def _intrnl_update_context_from_loop_kernels(loop_kernels,index,hip_context,f_co hip_context["have_reductions"] = False for stkernel in loop_kernels: - parent_tag = stkernel._parent.tag() - scope = scoper.create_scope(index,parent_tag) - - # translate and analyze kernels - parse_result = translator.parse_loop_kernel(stkernel.code,scope) + parse_result = stkernel.parse_result + parent_tag = stkernel.parent.tag() + scope = scoper.create_scope(index,parent_tag) kernel_args, c_kernel_local_vars, macros, input_arrays, local_cpu_routine_args =\ _intrnl_derive_kernel_arguments(scope,\ @@ -304,7 +302,7 @@ def _intrnl_update_context_from_loop_kernels(loop_kernels,index,hip_context,f_co utils.logging.log_debug3(LOG_PREFIX,"_intrnl_update_context_from_loop_kernels","parse result:\n```"+parse_result.c_str().rstrip()+"\n```") # general - kernel_name = stkernel.kernel_name() + kernel_name = stkernel.kernel_name() kernel_launcher_name = stkernel.kernel_launcher_name() # treat reduction_vars vars / acc default(present) vars @@ -482,26 +480,14 @@ def _intrnl_update_context_from_device_procedures(device_procedures,index,hip_co utils.logging.log_enter_function(LOG_PREFIX,"_intrnl_update_context_from_device_procedures") for stprocedure in device_procedures: - scope = scoper.create_scope(index,stprocedure.tag()) iprocedure = stprocedure.index_record - is_function = iprocedure["kind"] == "function" + is_function = stprocedure.is_function() + scope = scoper.create_scope(index,stprocedure.tag()) hip_context["includes"] += _intrnl_create_includes_from_used_modules(iprocedure,index) fBody = "\n".join(stprocedure.code) - if is_function: - result_name = iprocedure["result_name"] - ivar_result = next([var for var in iprocedure["variables"] if var["name"] == iprocedure["result_name"]],None) - if ivar_result != None: - result_type = ivar_result["c_type"] - parse_result = translator.parse_procedure_body(stprocedure.code,scope,ivar_result["name"]) - else: - msg = "could not identify return value for function ''" - utils.logging.log_error(msg) - sys.exit(INDEXER_ERROR_CODE) - else: - result_type = "void" - parse_result = translator.parse_procedure_body(stprocedure.code,scope) + parse_result = stprocedure.parse_result utils.logging.log_debug3(LOG_PREFIX,"_intrnl_update_context_from_device_procedures","parse result:\n```"+parse_result.c_str().rstrip()+"\n```") # TODO: look up functions and subroutines called internally and supply to parse_result before calling c_str() @@ -535,7 +521,7 @@ def _intrnl_update_context_from_device_procedures(device_procedures,index,hip_co hip_kernel_dict["generate_launcher"] = generate_launcher hip_kernel_dict["generate_cpu_launcher"] = False hip_kernel_dict["modifier"] = "__global__" if stprocedure.is_kernel_subroutine() else "__device__" - hip_kernel_dict["return_type"] = result_type + hip_kernel_dict["return_type"] = stprocedure.c_result_type hip_kernel_dict["is_loop_kernel"] = False hip_kernel_dict["kernel_name"] = kernel_name hip_kernel_dict["macros"] = macros @@ -606,21 +592,62 @@ def _intrnl_create_includes_from_used_modules(index_record,index): def generate_gpufort_headers(output_dir): """Create the header files that all GPUFORT HIP kernels rely on.""" - utils.logging.log_enter_function(LOG_PREFIX,"_intrnl_render_templates",\ + global LOG_PREFIX + global GPUFORT_HEADERS_MAX_DIM + + utils.logging.log_enter_function(LOG_PREFIX,"generate_gpufort_headers",\ {"output_dir": output_dir}) - gpufort_header_file_path = output_dir + "/gpufort.h" + gpufort_header_file_path = os.path.join(output_dir,"gpufort.h") model.GpufortHeaderModel().generate_file(gpufort_header_file_path) msg = "created gpufort main header: ".ljust(40) + gpufort_header_file_path - utils.logging.log_info(LOG_PREFIX,"_intrnl_render_templates",msg) + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_headers",msg) - gpufort_reductions_header_file_path = output_dir + "/gpufort_reductions.h" - model.GpufortReductionsHeaderModel().generate_file(gpufort_reductions_header_file_path) - msg = "created gpufort reductions header file: ".ljust(40) + gpufort_reductions_header_file_path - utils.logging.log_info(LOG_PREFIX,"_intrnl_render_templates",msg) + gpufort_reduction_header_file_path = os.path.join(output_dir, "gpufort_reduction.h") + model.GpufortReductionHeaderModel().generate_file(gpufort_reduction_header_file_path) + msg = "created gpufort reductions header file: ".ljust(40) + gpufort_reduction_header_file_path + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_headers",msg) + + # gpufort arrays + gpufort_array_context={ + "max_rank":GPUFORT_HEADERS_MAX_DIM, + "datatypes":GPUFORT_HEADERS_DATATYPES + } + gpufort_array_header_file_path = os.path.join(output_dir,"gpufort_array.h") + model.GpufortArrayHeaderModel().generate_file(gpufort_array_header_file_path,\ + context=gpufort_array_context) + msg = "created gpufort arrays header file: ".ljust(40) + gpufort_array_header_file_path + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_headers",msg) + + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_headers",msg) + +def generate_gpufort_sources(output_dir): + """Create the source files that all GPUFORT HIP kernels rely on.""" + global LOG_PREFIX + global GPUFORT_HEADERS_MAX_DIM - utils.logging.log_leave_function(LOG_PREFIX,"generate_gpufort_headers") + utils.logging.log_enter_function(LOG_PREFIX,"generate_gpufort_sources",\ + {"output_dir": output_dir}) + + # gpufort arrays + gpufort_array_context={ + "max_rank":GPUFORT_HEADERS_MAX_DIM, + "datatypes":GPUFORT_HEADERS_DATATYPES + } + gpufort_array_source_file_path = os.path.join(output_dir,"gpufort_array.hip.cpp") + model.GpufortArraySourceModel().generate_file(gpufort_array_source_file_path,\ + context=gpufort_array_context) + msg = "created gpufort arrays C++ source file: ".ljust(40) + gpufort_array_source_file_path + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_sources",msg) + + gpufort_array_fortran_interfaces_module_path = os.path.join(output_dir,"gpufort_array.f03") + model.GpufortArrayFortranInterfacesModel().generate_file(gpufort_array_fortran_interfaces_module_path,\ + context=gpufort_array_context) + msg = "created gpufort arrays Fortran interface module: ".ljust(40) + gpufort_array_fortran_interfaces_module_path + utils.logging.log_info(LOG_PREFIX,"generate_gpufort_sources",msg) + utils.logging.log_leave_function(LOG_PREFIX,"generate_gpufort_sources") + utils.logging.log_leave_function(LOG_PREFIX,"generate_gpufort_sources") def generate_hip_files(stree,index,kernels_to_convert_to_hip,translation_source_path,generate_code): """ @@ -647,7 +674,7 @@ def select_(kernel): if not len(kernels_to_convert_to_hip): return False else: - condition1 = not kernel._ignore_in_s2s_translation + condition1 = not kernel.ignore_in_s2s_translation condition2 = \ kernels_to_convert_to_hip[0] == "*" or\ kernel.min_lineno() in kernels_to_convert_to_hip or\ diff --git a/python/fort2hip/fort2hip_options.py.in b/python/fort2hip/fort2hip_options.py.in index d1890c62..ecb32d2e 100644 --- a/python/fort2hip/fort2hip_options.py.in +++ b/python/fort2hip/fort2hip_options.py.in @@ -40,4 +40,20 @@ PRETTIFY_EMITTED_FORTRAN_CODE = False PRETTIFY_EMITTED_C_CODE = False # Prettify the emitted HIP C++ code with clang-format. CLANG_FORMAT_STYLE="\"{BasedOnStyle: llvm, ColumnLimit: 140, BinPackArguments: false, BinPackParameters: false, AllowAllArgumentsOnNextLine: false, AllowAllParametersOfDeclarationOnNextLine: false}\"" - # Format style that is passed to clang-format \ No newline at end of file + # Format style that is passed to clang-format + +GPUFORT_HEADERS_MAX_DIM = 7 + # Generate rank-dependent classes and expressions up to + # this dimension. +GPUFORT_HEADERS_DATATYPES = [ + {"c_type":"bool" ,"f_kind":"c_bool" ,"bytes":"c_bool" ,"f_type":"logical(c_bool)" }, + {"c_type":"short" ,"f_kind":"c_short" ,"bytes":"c_short" ,"f_type":"integer(c_short)"}, + {"c_type":"int" ,"f_kind":"c_int" ,"bytes":"c_int" ,"f_type":"integer(c_int)" }, + {"c_type":"long" ,"f_kind":"c_long" ,"bytes":"c_long" ,"f_type":"integer(c_long)" }, + {"c_type":"float" ,"f_kind":"c_float" ,"bytes":"c_float" ,"f_type":"real(c_float)" }, + {"c_type":"double" ,"f_kind":"c_double" ,"bytes":"c_double" ,"f_type":"real(c_double)"}, + {"c_type":"hipFloatComplex" ,"f_kind":"c_float_complex" ,"bytes":"2*c_float_complex" ,"f_type":"complex(c_float_complex)"}, + {"c_type":"hipDoubleComplex","f_kind":"c_double_complex","bytes":"2*c_double_complex","f_type":"complex(c_double_complex)"} + ] + # Generate rank-dependent classes and expressions for these + # datatypes. diff --git a/python/fort2hip/model.py b/python/fort2hip/model.py index b4fd2ad5..6ce77ac1 100644 --- a/python/fort2hip/model.py +++ b/python/fort2hip/model.py @@ -27,25 +27,41 @@ def generate_file(self,output_file_path,context={}): class HipImplementationModel(BaseModel): def __init__(self): - BaseModel.__init__(self,"templates/HipImplementation.template.cpp") + BaseModel.__init__(self,"templates/hip_implementation.template.cpp") class InterfaceModuleModel(BaseModel): def __init__(self): - BaseModel.__init__(self,"templates/InterfaceModule.template.f03") + BaseModel.__init__(self,"templates/interface_module.template.f03") class InterfaceModuleTestModel(BaseModel): def __init__(self): - BaseModel.__init__(self,"templates/InterfaceModuleTest.template.f03") + BaseModel.__init__(self,"templates/interface_module_test.template.f03") class GpufortHeaderModel(BaseModel): def __init__(self): - BaseModel.__init__(self,"templates/Gpufort.template.h") + BaseModel.__init__(self,"templates/gpufort.template.h") -class GpufortReductionsHeaderModel(BaseModel): +class GpufortReductionHeaderModel(BaseModel): def __init__(self): - BaseModel.__init__(self,"templates/GpufortReductions.template.h") + BaseModel.__init__(self,"templates/gpufort_reduction.template.h") + +class GpufortArrayHeaderModel(BaseModel): + def __init__(self): + BaseModel.__init__(self,"templates/gpufort_array.template.h") + +class GpufortArraySourceModel(BaseModel): + def __init__(self): + BaseModel.__init__(self,"templates/gpufort_array.template.hip.cpp") + +class GpufortArrayFortranInterfacesModel(BaseModel): + def __init__(self): + BaseModel.__init__(self,"templates/gpufort_array.template.f03") #model = GpufortHeaderModel() #model.generate_file("gpufort.h") -#model = GpufortReductionsHeaderModel() -#model.generate_file("gpufort_reductions.h") \ No newline at end of file +#model = GpufortReductionHeaderModel() +#model.generate_file("gpufort_reduction.h") + +#model_c = GpufortArrayModel().generate_file("gpufort_array.h", +# context={"max_rank":7}) +#model_f = GpufortArrayFortranInterfaceModel().generate_file("gpufort_array.f90") \ No newline at end of file diff --git a/python/fort2hip/templates/gpufort.macros.h b/python/fort2hip/templates/gpufort.macros.h new file mode 100644 index 00000000..580a0fc6 --- /dev/null +++ b/python/fort2hip/templates/gpufort.macros.h @@ -0,0 +1,20 @@ +{%- macro separated_list_single_line(prefix,sep,rank) -%} +{% for d in range(1,rank+1) -%} +{{prefix}}{{d}}{{ sep if not loop.last }}{%- endfor %} +{%- endmacro -%} +{%- macro separated_list(prefix,sep,rank) -%} +{% for d in range(1,rank+1) -%} +{{prefix}}{{d}}{{ sep+"\n" if not loop.last }} +{%- endfor %} +{%- endmacro -%} +{%- macro arglist(prefix,rank) -%} +{{ separated_list(prefix,",",rank) }} +{%- endmacro -%} +{%- macro bound_args(prefix,rank) -%} +{{ arglist(prefix+"n",rank) }}, +{{ arglist(prefix+"lb",rank) }} +{%- endmacro -%} +{%- macro bound_args_single_line(prefix,rank) -%} +{{ separated_list_single_line(prefix+"n",",",rank) }}, +{{ separated_list_single_line(prefix+"lb",",",rank) }} +{%- endmacro -%} diff --git a/python/fort2hip/templates/Gpufort.template.h b/python/fort2hip/templates/gpufort.template.h similarity index 98% rename from python/fort2hip/templates/Gpufort.template.h rename to python/fort2hip/templates/gpufort.template.h index 7b7574ca..c1d24676 100644 --- a/python/fort2hip/templates/Gpufort.template.h +++ b/python/fort2hip/templates/gpufort.template.h @@ -42,6 +42,7 @@ i{{rank}} {%- endfor %} {%- endmacro -%} {# template body #} +// This file was generated from a template via gpufort --gpufort-create-headers #ifndef _GPUFORT_H_ #define _GPUFORT_H_ #include "hip/hip_complex.h" diff --git a/python/fort2hip/templates/gpufort_array.macros.f03 b/python/fort2hip/templates/gpufort_array.macros.f03 new file mode 100644 index 00000000..86de0dcd --- /dev/null +++ b/python/fort2hip/templates/gpufort_array.macros.f03 @@ -0,0 +1,455 @@ +{# SPDX-License-Identifier: MIT #} +{# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +{# Fortran side #} +{% import "templates/gpufort.macros.h" as gm %} +{# #} +{# #} +{# #} +{%- macro gpufort_array_fortran_data_access_interfaces(datatypes,max_rank) -%} +{% set prefix = "gpufort_array" %} +{% set max_rank_ub = max_rank+1 %} +{% for loc in ["host","dev"] %} +{% set routine = (loc+"ptr") | replace("dev","device") %} +{% set iface = prefix+"_"+routine %} +!> +!> Writes {{ loc | replace("dev","device") }} address of the array data +!> and this arrays bounds to \p data_{{loc}}. +!> +interface {{iface}} + module procedure :: & +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% for tuple in datatypes %} + {{binding}}_{{tuple.f_kind}}{{",&\n" if not loop.last}}{% endfor %}{{",&" if not loop.last}} +{% endfor %} +end interface +{% endfor %} +{%- endmacro -%} +{# #} +{# #} +{# #} +{%- macro gpufort_array_fortran_data_access_routines(datatypes,max_rank) -%} +{% set prefix = "gpufort_array" %} +{% set max_rank_ub = max_rank+1 %} +{% for loc in ["host","dev"] %} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set routine = (loc+"ptr") | replace("dev","device") %} +{% set binding = f_array+"_"+routine %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% for tuple in datatypes %} +subroutine {{binding}}_{{tuple.f_kind}}(& + mapped_array,& + data_{{loc}}) + use iso_c_binding + use hipfort_enums + implicit none + type({{f_array}}),intent(in) :: mapped_array + {{tuple.f_type}},intent(inout),pointer,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: data_{{loc}} + ! + integer(c_int) :: offset_remainder + integer(c_int) :: {{ gm.separated_list_single_line("n",",",rank) }},& + {{ gm.separated_list_single_line("lb",",",rank) }} + ! + {{tuple.f_type}},pointer,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: tmp + ! + {{ gm.separated_list_single_line("n"," = 1; ",rank) }} = 1 + {{ gm.separated_list_single_line("lb"," = 1; ",rank) }} = 1 + ! + n{{rank}} = int(mapped_array%data%num_elements / int(mapped_array%data%stride{{rank}},& + c_size_t),c_int) +{% for i in range(rank-1,0,-1) %} + n{{i}} = mapped_array%data%stride{{i+1}} / mapped_array%data%stride{{ i }} +{% endfor %} + ! + call c_f_pointer(mapped_array%data%data_{{loc}},tmp,SHAPE=[{{ gm.separated_list_single_line("n",",",rank) }}]) + ! + offset_remainder = mapped_array%data%index_offset +{% for i in range(rank,0,-1) %} + lb{{i}} = -offset_remainder / mapped_array%data%stride{{i}} + offset_remainder = offset_remainder + lb{{i}}*mapped_array%data%stride{{i}} +{% endfor %} + ! + data_{{loc}}({{ gm.separated_list_single_line("lb",":,",rank) }}:) => tmp +end subroutine +{% endfor %} +{% endfor %} +{% endfor %} +{%- endmacro -%} +{# #} +{# #} +{# #} +{%- macro gpufort_array_fortran_init_routines(datatypes,max_rank) -%} +{% set prefix = "gpufort_array" %} +{% set max_rank_ub = max_rank+1 %} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set routine = "init" %} +{% set binding = f_array+"_"+routine %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} +function {{binding}}{{async_suffix}}_host(& + mapped_array,& + bytes_per_element,& + sizes,lbounds,& + {{"stream," if is_async}}alloc_mode,sync_mode) result(ierr) + use iso_c_binding + use hipfort_enums + implicit none + type({{f_array}}),intent(inout) :: mapped_array + integer(c_int){{size_dims}},intent(in) :: sizes + integer(c_int){{size_dims}},intent(in),optional :: lbounds{{" + type(c_ptr),intent(in) :: stream" if is_async}} + integer(c_int),intent(in) :: bytes_per_element + integer(kind(gpufort_array_wrap_host_wrap_device)),intent(in),optional :: alloc_mode + integer(kind(gpufort_array_sync_none)),intent(in),optional :: sync_mode + ! + integer(kind(hipSuccess)) :: ierr + ! + integer(c_int),dimension({{rank}}) :: opt_lbounds + integer(kind(gpufort_array_wrap_host_wrap_device)) :: opt_alloc_mode + integer(kind(gpufort_array_sync_none)) :: opt_sync_mode + ! + opt_lbounds = 1 + opt_alloc_mode = gpufort_array_alloc_host_alloc_device ! allocate both by default + opt_sync_mode = gpufort_array_sync_none + if ( present(lbounds) ) opt_lbounds = lbounds + if ( present(alloc_mode) ) opt_alloc_mode = alloc_mode + if ( present(sync_mode) ) opt_sync_mode = sync_mode + ierr = {{binding}}{{async_suffix}}(& + mapped_array,& + bytes_per_element,& + c_null_ptr,c_null_ptr, & + sizes, opt_lbounds,& + {{"stream," if is_async}}opt_alloc_mode, opt_sync_mode ) +end function +{% for tuple in datatypes %} +function {{binding}}{{async_suffix}}_{{tuple.f_kind}}(& + mapped_array,& + data_host,lbounds,& + {{"stream," if is_async}}data_dev,alloc_mode,sync_mode) result(ierr) + use iso_c_binding + use hipfort_enums + implicit none + type({{f_array}}),intent(inout) :: mapped_array + {{tuple.f_type}},intent(in),target,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: data_host + integer(c_int){{size_dims}},intent(in),optional :: lbounds{{" + type(c_ptr),intent(in) :: stream" if is_async}} + type(c_ptr),intent(in),optional :: data_dev + integer(kind(gpufort_array_wrap_host_wrap_device)),intent(in),optional :: alloc_mode + integer(kind(gpufort_array_sync_none)),intent(in),optional :: sync_mode + ! + integer(kind(hipSuccess)) :: ierr + ! + integer(c_int),dimension({{rank}}) :: opt_lbounds + type(c_ptr) :: opt_data_dev + integer(kind(gpufort_array_wrap_host_wrap_device)) :: opt_alloc_mode + integer(kind(gpufort_array_sync_none)) :: opt_sync_mode + ! + opt_lbounds = 1 + opt_data_dev = c_null_ptr + opt_alloc_mode = gpufort_array_wrap_host_alloc_device + opt_sync_mode = gpufort_array_sync_none + if ( present(lbounds) ) opt_lbounds = lbounds + if ( present(data_dev) ) opt_data_dev = data_dev + if ( present(alloc_mode) ) opt_alloc_mode = alloc_mode + if ( present(sync_mode) ) opt_sync_mode = sync_mode + ierr = {{binding}}{{async_suffix}}(& + mapped_array,& + int({{tuple.bytes}}, c_int),& + c_loc(data_host),opt_data_dev,& + shape(data_host), opt_lbounds,& + {{"stream," if is_async}}opt_alloc_mode, opt_sync_mode) +end function +{% endfor %}{# datatypes #} +{% endfor %}{# async_suffix #} +{% endfor %}{# rank #} +{%- endmacro -%} +{# #} +{# #} +{# #} +{%- macro gpufort_array_fortran_wrap_routines(datatypes,max_rank) -%} +{% set prefix = "gpufort_array" %} +{% set max_rank_ub = max_rank+1 %} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set routine = "init" %} +{% set binding = f_array+"_"+routine %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% for tuple in datatypes %} +{% for dev in ["","_cptr"] %} +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} +function {{f_array}}_wrap{{async_suffix}}_{{tuple.f_kind}}{{dev}}(& + data_host,data_dev,lbounds,& + {{"stream," if is_async}}sync_mode,ierr) result(mapped_array) + use iso_c_binding + use hipfort_enums + implicit none + {{tuple.f_type}},intent(in),target,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: data_host +{% if dev == "_cptr" %} + type(c_ptr),intent(in) :: data_dev +{% else %} + {{tuple.f_type}},intent(in),target,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: data_dev +{% endif %} + integer(c_int){{size_dims}},intent(in),optional :: lbounds{{" + type(c_ptr),intent(in) :: stream" if is_async}} + integer(kind(gpufort_array_sync_none)),intent(in),optional :: sync_mode + integer(kind(hipSuccess)),intent(inout),optional :: ierr + ! + type({{f_array}}) :: mapped_array + ! + integer(c_int),dimension({{rank}}) :: opt_lbounds + integer(kind(gpufort_array_sync_none)) :: opt_sync_mode + integer(kind(hipSuccess)) :: opt_ierr + ! + opt_lbounds = 1 + opt_sync_mode = gpufort_array_sync_none + if ( present(lbounds) ) opt_lbounds = lbounds + if ( present(sync_mode) ) opt_sync_mode = sync_mode +{% if dev == "_cptr" %} +{% set data_dev_arg = "data_dev" %} +{% else %} +{% set data_dev_arg = "c_loc(data_dev)" %} +{% endif %} + opt_ierr = {{binding}}{{async_suffix}}(& + mapped_array,& + int({{tuple.bytes}}, c_int),& + c_loc(data_host),{{data_dev_arg}},& + shape(data_host), opt_lbounds {{",stream" if is_async}},& + gpufort_array_wrap_host_wrap_device,& + opt_sync_mode) + if ( present(ierr) ) ierr = opt_ierr +end function +{% endfor %}{# async #} +{% endfor %} +{% endfor %} +{% set routine = "init" %} +{% set binding = f_array+"_"+routine %} +{% set size_dims = ",dimension("+rank|string+")" %} +{# function {{f_array}}_wrap_device_ptr_cptr(& #} +{# data_dev,& #} +{# sizes,lbounds,& #} +{# bytes_per_element,ierr) result(mapped_array) #} +{# use iso_c_binding #} +{# use hipfort_enums #} +{# implicit none #} +{# type(c_ptr),intent(in) :: data_dev #} +{# integer(c_int){{size_dims}},intent(in) :: sizes #} +{# integer(c_int){{size_dims}},intent(in),optional :: lbounds #} +{# integer(c_int),intent(in),optional :: bytes_per_element #} +{# integer(kind(hipSuccess)),intent(inout),optional :: ierr #} +{# ! #} +{# type({{f_array}}) :: mapped_array #} +{# ! #} +{# integer(c_int),dimension({{rank}}) :: opt_lbounds #} +{# integer(c_int) :: opt_bytes_per_element #} +{# integer(kind(hipSuccess)) :: opt_ierr #} +{# ! #} +{# opt_lbounds = 1 #} +{# opt_bytes_per_element = -1 #} +{# if ( present(lbounds) ) opt_lbounds = lbounds #} +{# if ( present(bytes_per_element) ) opt_bytes_per_element = bytes_per_element #} +{# opt_ierr = {{binding}}(& #} +{# mapped_array,& #} +{# opt_bytes_per_element,& #} +{# c_null_ptr,data_dev,& #} +{# sizes, opt_lbounds,& #} +{# gpufort_array_wrap_host_wrap_device,& #} +{# gpufort_array_sync_none,c_null_ptr) #} +{# if ( present(ierr) ) ierr = opt_ierr #} +{# end function #} +{% for tuple in datatypes %} +function {{f_array}}_wrap_device_ptr_{{tuple.f_kind}}(& + data_dev,lbounds,ierr) result(mapped_array) + use iso_c_binding + use hipfort_enums + implicit none + {{tuple.f_type}},intent(in),pointer,dimension(:{% for i in range(1,rank) %},:{% endfor %}) :: data_dev + integer(c_int){{size_dims}},intent(in),optional :: lbounds + integer(kind(hipSuccess)),intent(inout),optional :: ierr + ! + type({{f_array}}) :: mapped_array + ! + integer(c_int),dimension({{rank}}) :: opt_lbounds + integer(kind(hipSuccess)) :: opt_ierr + ! + opt_lbounds = 1 + if ( present(lbounds) ) opt_lbounds = lbounds + opt_ierr = {{binding}}(& + mapped_array,& + int({{tuple.bytes}}, c_int),& + c_null_ptr,c_loc(data_dev),& + shape(data_dev), opt_lbounds,& + gpufort_array_wrap_host_wrap_device,& + gpufort_array_sync_none) + if ( present(ierr) ) ierr = opt_ierr +end function +{% endfor %} +{% endfor %} +{# #} +{# #} +{# #} +{%- endmacro -%} +{%- macro gpufort_array_fortran_interfaces(datatypes,max_rank) -%} +{% set max_rank_ub = max_rank+1 %} +{% set prefix = "gpufort_array" %} +{% set routine = "init" %} +{% set iface = prefix+"_"+routine %} +!> Initialize a gpufort_array of a rank that matches that of the input data. +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} +interface {{iface}}{{async_suffix}} +{% for rank in range(1,max_rank_ub) %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} + function {{binding}}{{async_suffix}} (& + mapped_array,& + bytes_per_element,& + data_host,data_dev,& + sizes, lbounds,& + {{"stream," if is_async}}alloc_mode,sync_mode) & + bind(c,name="{{binding}}") & + result(ierr) + use iso_c_binding + use hipfort_enums + import {{f_array}} + import gpufort_array_wrap_host_wrap_device + import gpufort_array_sync_none + implicit none + type({{f_array}}),intent(inout) :: mapped_array + integer(c_int),intent(in),value :: bytes_per_element + type(c_ptr),intent(in),value :: data_host, data_dev + integer(c_int){{size_dims}},intent(in) :: sizes, lbounds + integer(kind(gpufort_array_wrap_host_wrap_device)),intent(in),value :: alloc_mode + integer(kind(gpufort_array_sync_none)),intent(in),value :: sync_mode{{" + type(c_ptr),intent(in),value :: stream" if is_async}} + ! + integer(kind(hipSuccess)) :: ierr + end function +{% endfor %} + module procedure :: & +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} + {{binding}}{{async_suffix}}_host,& +{% for tuple in datatypes %} + {{binding}}{{async_suffix}}_{{tuple.f_kind}}{{",&\n" if not loop.last}}{% endfor %}{{",&" if not loop.last}} +{% endfor %} +end interface +{% endfor %}{# async_suffix #} + +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} +{% set routine = "wrap" %} +{% set iface = prefix+"_"+routine %} +!> Wrap a Fortran or type(c_ptr) pointer pair that points to host and device data. +!> Only wrap, allocate nothing, +!> and do not synchronize at initialization or destruction time. +!> \return gpufort_array of a rank that matches that of the input data. +interface {{iface}}{{async_suffix}} + module procedure :: &{{"\n"}} +{%- for rank in range(1,max_rank_ub) -%} +{%- set size_dims = ",dimension("+rank|string+")" -%} +{%- set f_array = prefix+rank|string -%} +{%- set binding = f_array+"_"+routine -%} +{%- for tuple in datatypes -%} +{%- for dev in ["","_cptr"] -%} +{{binding | indent(6,True)}}{{async_suffix}}_{{tuple.f_kind}}{{dev}}{{",&\n" if not loop.last}} +{%- endfor -%}{{",&\n" if not loop.last}} +{%- endfor -%}{{",&\n" if not loop.last}} +{%- endfor %}{{""}} +end interface +{% endfor %}{# async_suffix #} + +{% set routine = "wrap_device_ptr" %} +{% set iface = prefix+"_"+routine %} +!> Wrap a Fortran pointer or type(c_ptr) that points to device data. +!> Set the host pointer to null. Only wrap, allocate nothing, +!> and do not synchronize at initialization or destruction time. +!> \note Calling gpufort_array_copy_to_host or gpufort_array_copy_to_device +!> will result in HIP errors as the host pointer is set to null. +!> \return gpufort_array of a rank that matches that of the input data. +interface {{iface}} + module procedure :: & +{% for rank in range(1,max_rank_ub) %} +{% set size_dims = ",dimension("+rank|string+")" %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} +{# {{binding}}_cptr,& #} +{% for tuple in datatypes %} + {{binding}}_{{tuple.f_kind}}{{",&\n" if not loop.last}}{% endfor %}{{",&" if not loop.last}} +{% endfor %} +end interface + +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} +{% for routine in ["destroy","copy_to_host","copy_to_device"] %} +{% set iface = prefix+"_"+routine %} +interface {{iface}}{{async_suffix}} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} + function {{binding}}{{async_suffix}} (mapped_array{{",stream" if is_async}}) & + bind(c,name="{{binding}}") & + result(ierr) + use iso_c_binding + use hipfort_enums + import {{f_array}} + implicit none + type({{f_array}}),intent(inout) :: mapped_array{{" + type(c_ptr),value,intent(in) :: stream" if is_async}} + integer(kind(hipSuccess)) :: ierr + end function +{% endfor %} +end interface +{% endfor %} + +{% set routine = "dec_num_refs" %} +{% set iface = prefix+"_"+routine %} +interface {{iface}}{{async_suffix}} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} + function {{binding}}{{async_suffix}}(& + mapped_array,destroy_if_zero_refs{{",& + stream" if is_async}}) & + bind(c,name="{{binding}}") & + result(ierr) + use iso_c_binding + use hipfort_enums + import {{f_array}} + implicit none + type({{f_array}}),intent(inout) :: mapped_array{{" + type(c_ptr),value,intent(in) :: stream" if is_async}} + logical(c_bool),intent(in),value :: destroy_if_zero_refs + integer(kind(hipSuccess)) :: ierr + end function +{% endfor %} +end interface +{% endfor %}{# async_suffix #} + +{% set routine = "inc_num_refs" %} +{% set iface = prefix+"_"+routine %} +interface {{iface}} +{% for rank in range(1,max_rank_ub) %} +{% set f_array = prefix+rank|string %} +{% set binding = f_array+"_"+routine %} + function {{binding}} (mapped_array) & + bind(c,name="{{binding}}") & + result(ierr) + use iso_c_binding + use hipfort_enums + import {{f_array}} + implicit none + type({{f_array}}),intent(inout) :: mapped_array + integer(kind(hipSuccess)) :: ierr + end function +{% endfor %} +end interface + +{%- endmacro -%} diff --git a/python/fort2hip/templates/gpufort_array.macros.h b/python/fort2hip/templates/gpufort_array.macros.h new file mode 100644 index 00000000..8da758ee --- /dev/null +++ b/python/fort2hip/templates/gpufort_array.macros.h @@ -0,0 +1,74 @@ +{# SPDX-License-Identifier: MIT #} +{# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +{# requires that the bound_args and bound_args_single_line macros exist #} +{% import "templates/gpufort.macros.h" as gm %} +{%- macro gpufort_array_c_bindings(datatypes,max_rank) -%} +{# C side #} +extern "C" { +{% for rank in range(1,max_rank+1) %} +{% set c_type = "char" %} +{% set c_prefix = "gpufort_array"+rank|string %} +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} + __host__ hipError_t {{c_prefix}}_init{{async_suffix}} ( + gpufort::array{{rank}}<{{c_type}}>* array, + int bytes_per_element, + {{c_type}}* data_host, + {{c_type}}* data_dev, + int* sizes, + int* lower_bounds,{{" + hipStream_t stream," if is_async}} + gpufort::AllocMode alloc_mode, + gpufort::SyncMode sync_mode + ) { + return array->init{{async_suffix}}( + bytes_per_element, + data_host, data_dev, + sizes, lower_bounds, + {{"stream," if is_async}}alloc_mode, sync_mode + ); + } + + __host__ hipError_t {{c_prefix}}_destroy{{async_suffix}}( + gpufort::array{{rank}}<{{c_type}}>* array{{", + hipStream_t stream" if is_async}} + ) { + return array->destroy{{async_suffix}}({{"stream" if is_async}}); + } + + __host__ hipError_t {{c_prefix}}_copy_to_host{{async_suffix}} ( + gpufort::array{{rank}}<{{c_type}}>* array{{", + hipStream_t stream" if is_async}} + ) { + return array->copy_to_host{{async_suffix}}({{"stream" if is_async}}); + } + + __host__ hipError_t {{c_prefix}}_copy_to_device{{async_suffix}} ( + gpufort::array{{rank}}<{{c_type}}>* array{{", + hipStream_t stream" if is_async}} + ) { + return array->copy_to_device{{async_suffix}}({{"stream" if is_async}}); + } + + __host__ hipError_t {{c_prefix}}_dec_num_refs{{async_suffix}}( + gpufort::array{{rank}}<{{c_type}}>* array, + bool destroy_if_zero_refs{{", + hipStream_t stream" if is_async}} + ) { + array->num_refs -= 1; + if ( destroy_if_zero_refs && array->num_refs == 0 ) { + return array->destroy{{async_suffix}}({{"stream" if is_async}}); + } { + return hipSuccess; + } + } +{% endfor %} + + __host__ void {{c_prefix}}_inc_num_refs( + gpufort::array{{rank}}<{{c_type}}>* array + ) { + array->num_refs += 1; + } +{% endfor %} +} // extern "C" +{%- endmacro -%} diff --git a/python/fort2hip/templates/gpufort_array.template.f03 b/python/fort2hip/templates/gpufort_array.template.f03 new file mode 100644 index 00000000..5e61f8db --- /dev/null +++ b/python/fort2hip/templates/gpufort_array.template.f03 @@ -0,0 +1,62 @@ +{# SPDX-License-Identifier: MIT #} +{# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +{% import "templates/gpufort_array.macros.f03" as gam %} +module gpufort_array + use iso_c_binding + implicit none + + enum, bind(c) + enumerator :: gpufort_array_sync_none = 0 !> No copies between host and device data after initialization and before destruction. + enumerator :: gpufort_array_sync_copy = 1 !> Copy to device after initialization and back to host before destruction. + enumerator :: gpufort_array_sync_copyin = 2 !> Copy to device after initialization. + enumerator :: gpufort_array_sync_copyout = 3 !> Copy back to host before destruction. + enumerator :: gpufort_array_sync_inverted_copy = 4 !> 'Copy' in opposite direction: Copy from device to host after initialization and back to device before destruction. + enumerator :: gpufort_array_sync_inverted_copyin = 5 !> 'Copyin' in opposite direction: Copy from device to host after initialization. + enumerator :: gpufort_array_sync_inverted_copyout = 6 !> 'Copyout'in opposite direction: Copy from host to device before destruction. + end enum + + enum, bind(c) + enumerator :: gpufort_array_wrap_host_wrap_device = 0 !> Wrap host and device pointers. + enumerator :: gpufort_array_wrap_host_alloc_device = 1 !> Wrap host pointer and allocate a new device array. + enumerator :: gpufort_array_alloc_host_wrap_device = 2 !> Allocate new host array and wrap device pointer. + enumerator :: gpufort_array_alloc_host_alloc_device = 3 !> Allocate new host and device arrays. + enumerator :: gpufort_array_alloc_pinned_host_wrap_device = 4 !> Allocate new pinned host array and wrap device pointer. + enumerator :: gpufort_array_alloc_pinned_host_alloc_device = 5 !> Allocate new pinned host array and wrap device pointer. + end enum + + ! NOTE: the below types must have exactly the + ! same data layout as the corresponding + ! gpufort C/C++ structs. +{% for rank in range(1,max_rank+1) %} +{% set rank_ub = rank+1 %} + ! {{rank}}-dimensional array + type, bind(c) :: gpufort_array_descr{{rank}} + type(c_ptr) :: data_host = c_null_ptr + type(c_ptr) :: data_dev = c_null_ptr + integer(c_size_t) :: num_elements = 0 !> Number of represented by this array. + integer(c_int) :: index_offset = -1 !> Offset for index calculation; scalar product of negative lower bounds and strides. +{% for d in range(1,rank_ub) %} + integer(c_int) :: stride{{d}} = -1 !> Stride for dimension {{d}} +{% endfor %} + end type + type, bind(c) :: gpufort_array{{rank}} + type(gpufort_array_descr{{rank}}) :: data + integer(kind(gpufort_array_wrap_host_wrap_device)) :: alloc_mode = gpufort_array_wrap_host_alloc_device !> Data allocation strategy. Default: + !> wrap the host and allocate device data + integer(kind(gpufort_array_sync_none)) :: sync_mode = gpufort_array_sync_none !> How data should be synchronized + !> during the initialization and destruction of this GPUFORT array. + integer(c_int) :: num_refs = 0 !> Number of references. + integer(c_int) :: bytes_per_element = -1 !> Bytes per data element. + end type{{"\n" if not loop.last}} +{% endfor %} + + ! interfaces +{{ gam.gpufort_array_fortran_interfaces(datatypes,max_rank) | indent(2,True) }} +{{ gam.gpufort_array_fortran_data_access_interfaces(datatypes,max_rank) | indent(2,True) }} + + ! subroutines +contains +{{ gam.gpufort_array_fortran_init_routines(datatypes,max_rank) | indent(2,True) }} +{{ gam.gpufort_array_fortran_wrap_routines(datatypes,max_rank) | indent(2,True) }} +{{ gam.gpufort_array_fortran_data_access_routines(datatypes,max_rank) | indent(2,True) }} +end module gpufort_array \ No newline at end of file diff --git a/python/fort2hip/templates/gpufort_array.template.h b/python/fort2hip/templates/gpufort_array.template.h new file mode 100644 index 00000000..1ac07b91 --- /dev/null +++ b/python/fort2hip/templates/gpufort_array.template.h @@ -0,0 +1,660 @@ +{# SPDX-License-Identifier: MIT #} +{# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +{% import "templates/gpufort.macros.h" as gm %} +{% import "templates/gpufort_array.macros.h" as gam %} +// This file was generated from a template via gpufort --gpufort-create-headers +#ifndef _GPUFORT_ARRAYS_H_ +# define _GPUFORT_ARRAYS_H_ +# include +# ifndef _GPUFORT_H_ +# include +# include +# include +# include +# define HIP_CHECK(condition) \ + { \ + hipError_t error = condition; \ + if(error != hipSuccess){ \ + std::cout << "HIP error: " << error << " line: " << __LINE__ << std::endl; \ + exit(error); \ + } \ + } +# endif +#ifndef __HIP_DEVICE_COMPILE__ +# include +#endif +#ifndef GPUFORT_ARRAY_PRINT_PREC +# define GPUFORT_ARRAY_PRINT_PREC 6 +#endif + +namespace gpufort { + enum class SyncMode { + None = 0, //> No copies between host and device data after initialization and before destruction. + Copy = 1, //> Copy to device after initialization and back to host before destruction. + Copyin = 2, //> Copy to device after initialization. + Copyout = 3, //> Copy from device to host before destruction. + InvertedCopy = 4, //> 'Copy' in opposite direction: Copy from device to host after initialization and back to device before destruction. + InvertedCopyin = 5, //> 'Copyin' in opposite direction: Copy from device to host after initialization. + InvertedCopyout = 6 //> 'Copyout'in opposite direction: Copy from host to device before destruction. + }; + + enum class AllocMode { + WrapHostWrapDevice = 0, //> Wrap host and device pointers. + WrapHostAllocDevice = 1, //> Wrap host pointer and allocate a new device array. + AllocHostWrapDevice = 2, //> Allocate new host array and wrap device pointer. + AllocHostAllocDevice = 3, //> Allocate new host and device arrays. + AllocPinnedHostWrapDevice = 4, //> Allocate new pinned host array and wrap device pointer. + AllocPinnedHostAllocDevice = 5 //> Allocate new pinned host array and wrap device pointer. + }; + + enum class PrintMode { + PrintNorms = 0, //> Print norms and metrics. + PrintValues = 1, //> Print array values; write index in Fortran (i,j,k,...) style. + PrintValuesAndNorms = 2, //> Print array values and norms and metrics; write index in Fortran (i,j,k,...) style. + PrintCValues = 3, //> Print array values; write index in C/C++ [i] style. + PrintCValuesAndNorms = 4 //> Print array values and norms and metrics; write index in C/C++ [i] style. + }; + +{% for rank in range(1,max_rank+1) %} +{% set rank_ub = rank+1 %} + /** + * Intended to be passed as kernel launch parameter. + * \note Operator `T& operator()` requires parametrization with type T. + * \note Size of this struct independent of template type T. + */ + template + struct array_descr{{rank}} { + T* data_host = nullptr; + T* data_dev = nullptr; + size_t num_elements = 0; //> Number of represented by this array. + int index_offset = -1; //> Offset for index calculation; scalar product of negative lower bounds and strides. +{% for d in range(1,rank_ub) %} + int stride{{d}} = -1; //> Stride {{d}} for linearizing {{rank}}-dimensional index. +{% endfor %} + + /** + * Wrap a host-device pointer pair and store the associated + * array meta data. + * + * \param[in] data_host host data pointer. + * \param[in] data_dev device data pointer. + * \param[in] n1,n2,... element counts per dimension of the multi-dim. array + * \param[in] lb1,lb2,... lower bounds, i.e. the index of the first element per dimension of the multi-dim. array + */ + __host__ __device__ void wrap( + T* data_host, + T* data_dev, +{{ gm.bound_args("const int ",rank) | indent(8,True) }} + ) { + this->data_host = data_host; + this->data_dev = data_dev; + // column-major access + this->stride1 = 1; +{% for d in range(2,rank_ub) %} + this->stride{{d}} = this->stride{{d-1}}*n{{d-1}}; +{% endfor %} + this->num_elements = this->stride{{rank}}*n{{rank}}; + this->index_offset = +{% for d in range(1,rank_ub) %} + -lb{{d}}*this->stride{{d}}{{";" if loop.last}} +{% endfor %} + } + + /** + * Linearize multi-dimensional index. + * + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ int linearized_index ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) const { + return this->index_offset +{% for d in range(1,rank_ub) %} + + i{{d}}*this->stride{{d}}{{";" if loop.last}} +{% endfor %} + } + + /** + * \return Element at given index. + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ T& operator() ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) { + const int index = linearized_index( +{{ gm.separated_list_single_line("i",",",rank) | indent(8,"True") }} + ); + #ifdef __HIP_DEVICE_COMPILE__ + return this->data_dev[index]; + #else +{% for r in range(1,rank_ub) %} + assert(i{{r}} >= lbound({{r}})); + assert(i{{r}} <= ubound({{r}})); +{% endfor %} + return this->data_host[index]; + #endif + } + + /** + * \return Element at given index. + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ const T& operator() ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) const { + const int index = linearized_index( +{{ gm.separated_list_single_line("i",",",rank) | indent(8,"True") }} + ); + #ifdef __HIP_DEVICE_COMPILE__ + return this->data_dev[index]; + #else +{% for r in range(1,rank_ub) %} + assert(i{{r}} >= lbound({{r}})); + assert(i{{r}} <= ubound({{r}})); +{% endfor %} + return this->data_host[index]; + #endif + } + + /** + * \return Size of the array in dimension 'dim'. + * \param[in] dim selected dimension: 1,...,{{rank}} + */ + __host__ __device__ __forceinline__ int size(int dim) const { + #ifndef __HIP_DEVICE_COMPILE__ + assert(dim >= 1); + assert(dim <= {{rank}}); + #endif + switch(dim) { + case {{rank}}: + return this->num_elements / this->stride{{rank}}; +{% for r in range(rank-1,0,-1) %} + case {{r}}: + return this->stride{{r+1}} / this->stride{{r}}; +{% endfor %} + default: + #ifndef __HIP_DEVICE_COMPILE__ + std::cerr << "‘dim’ argument of ‘gpufort::array{{rank}}::size’ is not a valid dimension index ('dim': "<= 1); + assert(dim <= {{rank}}); + #endif + int offset_remainder = this->index_offset; +{% for r in range(rank,0,-1) %} + {{"int " if r == rank}}lb = -offset_remainder / this->stride{{r}}; +{% if r == 1 %} + #ifndef __HIP_DEVICE_COMPILE__ + offset_remainder = offset_remainder + lb*this->stride{{r}}; + assert(offset_remainder == 0); + #endif + return lb; +{% else %} + if ( dim == {{r}} ) return lb; + offset_remainder = offset_remainder + lb*this->stride{{r}}; +{% endif %} +{% endfor %} + } + + /** + * \return Upper bound (inclusive) of the array in dimension 'dim'. + * \param[in] dim selected dimension: 1,...,{{rank}} + */ + __host__ __device__ __forceinline__ int ubound(int dim) const { + return this->lbound(dim) + this->size(dim) - 1; + } + }; + + template + struct array{{rank}}{ + array_descr{{rank}} data; + AllocMode alloc_mode = AllocMode::WrapHostAllocDevice; //> Data allocation strategy. Default: + //> wrap the host and allocate device data + SyncMode sync_mode = SyncMode::None; //> How data should be synchronized + //> during the initialization and destruction of this GPUFORT array. + int num_refs = 0; //> Number of references. + int bytes_per_element = -1; //> Bytes per element; stored to make num_data_bytes routine independent of T + + array{{rank}}() { + // do nothing + } + + ~array{{rank}}() { + // do nothing + } + +{% for async_suffix in ["_async",""] %} +{% set is_async = async_suffix == "_async" %} + /** + * Initialize. + * \param[in] data_host host data pointer (may be nullptr; see the note). + * \param[in] pinned the host array is pinned or should be pinned. + * \param[in] copyout_at_destruction copy data out from the + * device to the host when this instance gets destroyed. + * \note Allocates a new host_data pointer if the + * passed pointer is a nullptr. If the pinned argument is true, + * the new hostpotr is allocated via hipHostMalloc. + * Otherwise, it is allocated via classic malloc. + */ + __host__ hipError_t init{{async_suffix}}( + int bytes_per_element, + T* data_host, + T* data_dev, +{{ gm.bound_args_single_line("int ",rank) | indent(8,True) }},{{" + hipStream_t stream," if is_async}} + AllocMode alloc_mode = AllocMode::WrapHostAllocDevice, + SyncMode sync_mode = SyncMode::None + ) { + this->data.wrap( + data_host, + data_dev, +{{ gm.bound_args_single_line("",rank) | indent(10,True) }} + ); + this->bytes_per_element = bytes_per_element; + this->num_refs = 1; + this->alloc_mode = alloc_mode; + this->sync_mode = sync_mode; + + // host array allocation + hipError_t ierr = hipSuccess; + switch (this->alloc_mode) { +#ifdef GPUFORT_ARRAYS_ALWAYS_PIN_HOST_DATA + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocHostAllocDevice: +#endif + case AllocMode::AllocPinnedHostWrapDevice: + case AllocMode::AllocPinnedHostAllocDevice: + ierr = hipHostMalloc((void**) &this->data.data_host,this->num_data_bytes(),0); + break; +#ifndef GPUFORT_ARRAYS_ALWAYS_PIN_HOST_DATA + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocHostAllocDevice: + this->data.data_host = (T*) malloc(this->num_data_bytes()); + break; +#endif + case AllocMode::WrapHostWrapDevice: + case AllocMode::WrapHostAllocDevice: + // do nothing as already set by data.wrap call + break; + default: + std::cerr << "ERROR: gpufort::Array{{rank}}::init{{async_suffix}}(...): Unexpected value for 'this->alloc_mode': " + << static_cast(this->alloc_mode) << std::endl; + std::terminate(); + break; + } + // device array allocation + if ( ierr == hipSuccess ) { + switch (this->alloc_mode) { + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocPinnedHostWrapDevice: + case AllocMode::WrapHostWrapDevice: + // do nothing as already set by data.wrap call + break; + case AllocMode::WrapHostAllocDevice: + case AllocMode::AllocHostAllocDevice: + case AllocMode::AllocPinnedHostAllocDevice: + ierr = hipMalloc((void**) &this->data.data_dev, this->num_data_bytes()); + break; + default: + break; + } + } + if ( ierr == hipSuccess ) { + // synchronize host/device + switch (this->sync_mode) { + case SyncMode::None: + case SyncMode::Copyout: + case SyncMode::InvertedCopyout: + // do nothing + break; + case SyncMode::Copy: + case SyncMode::Copyin: + ierr = this->copy_to_device{{async_suffix}}({{"stream" if is_async}}); + break; + case SyncMode::InvertedCopy: + case SyncMode::InvertedCopyin: + ierr = this->copy_to_host{{async_suffix}}({{"stream" if is_async}}); + break; + default: + std::cerr << "ERROR: gpufort::Array{{rank}}::init{{async_suffix}}(...): Unexpected value for 'sync_mode': " + << static_cast(sync_mode) << std::endl; + std::terminate(); + break; + } + } + return ierr; + } + + __host__ hipError_t init{{async_suffix}}( + int bytes_per_element, + T* data_host, + T* data_dev, + int* sizes, + int* lower_bounds,{{" + hipStream_t stream," if is_async}} + AllocMode alloc_mode = AllocMode::WrapHostAllocDevice, + SyncMode sync_mode = SyncMode::None + ) { + return this->init{{async_suffix}}( + bytes_per_element, + data_host, + data_dev, + sizes[0],{% for d in range(1,rank) %}sizes[{{d}}],{% endfor %}{{""}} + lower_bounds[0],{% for d in range(1,rank) %}lower_bounds[{{d}}],{% endfor %}{{""}}{{" + stream," if is_async}}alloc_mode,sync_mode); + } + + /** + * Destroy associated host and device data + * if this is not a wrapper. Depending + * on the pinned attribue, hipHostFree + * is used instead of free to deallocate + * the host data. + */ + __host__ hipError_t destroy{{async_suffix}}({{"hipStream_t stream" if is_async}}) { + hipError_t ierr = hipSuccess; + if ( bytes_per_element > 0 ) { + // synchronize host/device + switch (this->sync_mode) { + case SyncMode::Copy: + case SyncMode::Copyout: + ierr = this->copy_to_host{{async_suffix}}({{"stream"if is_async}}); + break; + case SyncMode::InvertedCopy: + case SyncMode::InvertedCopyout: + ierr = this->copy_to_device{{async_suffix}}({{"stream"if is_async}}); + break; + case SyncMode::None: + case SyncMode::Copyin: + case SyncMode::InvertedCopyin: + // do nothing + break; + default: + std::cerr << "ERROR: gpufort::Array{{rank}}::destroy{{async_suffix}}(...): Unexpected value for 'sync_mode': " + << static_cast(sync_mode) << std::endl; + std::terminate(); + break; + } + // host array allocation + if ( ierr == hipSuccess ) { + switch (this->alloc_mode) { +#ifdef GPUFORT_ARRAYS_ALWAYS_PIN_HOST_DATA + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocHostAllocDevice: +#endif + case AllocMode::AllocPinnedHostWrapDevice: + case AllocMode::AllocPinnedHostAllocDevice: + ierr = hipHostFree(this->data.data_host); + break; +#ifndef GPUFORT_ARRAYS_ALWAYS_PIN_HOST_DATA + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocHostAllocDevice: + free(this->data.data_host); + break; +#endif + case AllocMode::WrapHostWrapDevice: + case AllocMode::WrapHostAllocDevice: + break; + default: + std::cerr << "ERROR: gpufort::Array{{rank}}::destroy{{async_suffix}}(...): Unexpected value for 'alloc_mode': " + << static_cast(alloc_mode) << std::endl; + std::terminate(); + break; + } + } + // device array allocation + if ( ierr == hipSuccess ) { + switch (this->alloc_mode) { + case AllocMode::AllocHostWrapDevice: + case AllocMode::AllocPinnedHostWrapDevice: + case AllocMode::WrapHostWrapDevice: + // do nothing as already set by data.wrap call + break; + case AllocMode::WrapHostAllocDevice: + case AllocMode::AllocHostAllocDevice: + case AllocMode::AllocPinnedHostAllocDevice: + ierr = hipFree(this->data.data_dev); + break; + default: + break; + } + } + if ( ierr == hipSuccess ) { + this->data.data_host = nullptr; + this->data.data_dev = nullptr; + this->bytes_per_element = -1; + } + } + return ierr; + } + + /** + * Copy host data to the device. + * \return Array code returned by the underlying hipMemcpy operation. + */ + __host__ hipError_t copy_to_host{{async_suffix}}({{"hipStream_t stream" if is_async}}) { + #ifndef __HIP_DEVICE_COMPILE__ + assert(this->data.data_host!=nullptr); + assert(this->data.data_dev!=nullptr); + #endif + return hipMemcpy{{"Async" if is_async}}( + (void*) this->data.data_host, + (void*) this->data.data_dev, + this->num_data_bytes(), + hipMemcpyDeviceToHost{{", stream" if is_async}}); + } + + /** + * Copy device data to the host. + * \return Array code returned by the underlying hipMemcpy operation. + */ + __host__ hipError_t copy_to_device{{async_suffix}}({{"hipStream_t stream" if is_async}}) { + #ifndef __HIP_DEVICE_COMPILE__ + assert(this->data.data_host!=nullptr); + assert(this->data.data_dev!=nullptr); + #endif + return hipMemcpy{{"Async" if is_async}}( + (void*) this->data.data_dev, + (void*) this->data.data_host, + this->num_data_bytes(), + hipMemcpyHostToDevice{{", stream" if is_async}}); + } + + /** + * Copies the struct to the device into an pre-allocated + * device memory block but does not touch the data associated with + * data_dev & data_host (shallow copy). + * \param[in] device_struct device memory address to copy to + */ + __host__ hipError_t copy_self_to_device{{async_suffix}}( + gpufort::array{{rank}}* device_struct{{", + hipStream_t stream" if is_async}} + ) { + const size_t size = sizeof(array{{rank}}); // sizeof(T*) = sizeof(char*) + return hipMemcpy{{"Async" if is_async}}( + (void*) device_struct, + (void*) this, + size, + hipMemcpyHostToDevice{{", stream" if is_async}}); + } + + /** + * Copies the struct to the device but + * does not touch the data associated with + * data_dev & data_host (shallow copy). + * \param[inout] device_copy pointer to device copy pointer + */ + __host__ hipError_t create_device_copy{{async_suffix}}( + gpufort::array{{rank}}** device_copy{{", + hipStream_t stream" if is_async}} + ) { + const size_t size = sizeof(array{{rank}}); // sizeof(T*) = sizeof(char*) + hipError_t ierr = hipMalloc((void**)device_copy,size); + if ( ierr == hipSuccess ) { + return this->copy_self_to_device{{async_suffix}}(*device_copy{{",stream" if is_async}}); + } else { + return ierr; + } + } +{% endfor %} + + __host__ size_t num_data_bytes() { + return this->data.num_elements * this->bytes_per_element; + } + + + /** + * Linearize multi-dimensional index. + * + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ int linearized_index ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) const { + return this->data.linearized_index( +{{ gm.separated_list_single_line("i",",",rank) | indent(8,"True") }} + ); + } + + /** + * \return Element at given index. + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ T& operator() ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) { + return this->data( +{{ gm.separated_list_single_line("i",",",rank) | indent(8,"True") }} + ); + } + + /** + * \return Element at given index. + * \param[in] i1,i2,... multi-dimensional array index. + */ + __host__ __device__ __forceinline__ const T& operator() ( +{{ gm.arglist("const int i",rank) | indent(6,"True") }} + ) const { + return this->data( +{{ gm.separated_list_single_line("i",",",rank) | indent(8,"True") }} + ); + } + + /** + * \return Size of the array in dimension 'dim'. + * \param[in] dim selected dimension: 1,...,{{rank}} + */ + __host__ __device__ __forceinline__ int size(int dim) const { + return this->data.size(dim); + } + + /** + * \return Lower bound (inclusive) of the array in dimension 'dim'. + * \param[in] dim selected dimension: 1,...,{{rank}} + */ + __host__ __device__ __forceinline__ int lbound(int dim) const { + return this->data.lbound(dim); + } + + /** + * \return Upper bound (inclusive) of the array in dimension 'dim'. + * \param[in] dim selected dimension: 1,...,{{rank}} + */ + __host__ __device__ __forceinline__ int ubound(int dim) const { + return this->data.ubound(dim); + } + +{% for source in ["host","device"] %} + /** + * Write {{source}} data values and their corresponding index + * to an output stream. + * \param[inout] out output stream + * \param[in] prefix prefix to put before each output line + * \param[in] print_prec precision to use when printing floating point numbers + * [default=GPUFORT_ARRAY_PRINT_PREC[default=6]] + * \note This method only makes sense for numeric data types and + * may result in compilation, runtime errors or undefined output if the + * underlying data is not numeric. + */ + __host__ void print_{{source}}_data( + std::ostream& out, const char* prefix, PrintMode print_mode, + const int print_prec=GPUFORT_ARRAY_PRINT_PREC) const { + const bool print_norms = + print_mode==PrintMode::PrintNorms || + print_mode==PrintMode::PrintValuesAndNorms || + print_mode==PrintMode::PrintCValuesAndNorms; + const bool print_values = + print_mode==PrintMode::PrintValues || + print_mode==PrintMode::PrintValuesAndNorms; + const bool print_values_c_style = + print_mode==PrintMode::PrintCValues || + print_mode==PrintMode::PrintCValuesAndNorms; + if ( !print_norms && !print_values && !print_values_c_style ) { + std::cerr << "ERROR: gpufort::Array{{rank}}::print_{{source}}_data(...): Unexpected value for 'print_mode': " + << static_cast(this->alloc_mode) << std::endl; + std::terminate(); + } +{% for col in range(1,rank_ub) %} + const int n{{col}} = this->size({{col}}); + const int lb{{col}} = this->lbound({{col}}); +{% endfor %} + const int n = this->data.num_elements; +{% if source == "device" %} + std::vector host_array(n); + T* A_h = host_array.data(); + T* A = this->data.data_dev; + HIP_CHECK(hipMemcpy(A_h, A, n*sizeof(T), hipMemcpyDeviceToHost)); +{% else %} + T* A_h = this->data.data_host; +{% endif %} + T min = +std::numeric_limits::max(); + T max = -std::numeric_limits::max(); + T sum = 0; + T l1 = 0; + T l2 = 0; + out << prefix << ":\n"; +{% for col in range(1,rank_ub) %} + for ( int i{{rank_ub-col}} = 0; i{{rank_ub-col}} < n{{rank_ub-col}}; i{{rank_ub-col}}++ ) { +{% endfor %} + const int idx = this->linearized_index({% for col in range(1,rank_ub) -%}i{{col}}{{ "," if not loop.last }}{% endfor -%}); + T value = A_h[idx]; + if ( print_norms ) { + min = std::min(value,min); + max = std::max(value,max); + sum += value; + l1 += std::abs(value); + l2 += value*value; + } + if ( print_values ) { + out << prefix << "(" << {% for col in range(1,rank_ub) -%}(lb{{col}}+i{{col}}) << {{ "\",\" <<" |safe if not loop.last }} {% endfor -%} ") = " << std::setprecision(print_prec) << value << "\n"; + } else if ( print_values_c_style ) { + out << prefix << "[" << idx << "] = " << std::setprecision(print_prec) << value << "\n"; + } + {%+ for col in range(1,rank_ub) -%}}{%- endfor %} // for loops + if ( print_norms ) { + out << prefix << ":min=" << std::setprecision(print_prec) << min << "\n"; + out << prefix << ":max=" << std::setprecision(print_prec) << max << "\n"; + out << prefix << ":sum=" << std::setprecision(print_prec) << sum << "\n"; + out << prefix << ":l1=" << std::setprecision(print_prec) << l1 << "\n"; + out << prefix << ":l2=" << std::setprecision(print_prec) << std::sqrt(l2) << "\n"; + out << prefix << "num_elements=" << std::setprecision(print_prec) << n << "\n"; + } + } +{% endfor %} + + }; +{{ "" if not loop.last }} +{% endfor -%} +} +#endif // _GPUFORT_ARRAYS_H_ diff --git a/python/fort2hip/templates/gpufort_array.template.hip.cpp b/python/fort2hip/templates/gpufort_array.template.hip.cpp new file mode 100644 index 00000000..69d4202e --- /dev/null +++ b/python/fort2hip/templates/gpufort_array.template.hip.cpp @@ -0,0 +1,8 @@ +{# SPDX-License-Identifier: MIT #} +{# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +{% import "templates/gpufort_array.macros.h" as gam %} +// This file was generated from a template via gpufort --gpufort-create-headers +// C bindings +#include "gpufort_array.h" + +{{ gam.gpufort_array_c_bindings(datatypes,max_rank) }} \ No newline at end of file diff --git a/python/fort2hip/templates/GpufortReductions.template.h b/python/fort2hip/templates/gpufort_reduction.template.h similarity index 96% rename from python/fort2hip/templates/GpufortReductions.template.h rename to python/fort2hip/templates/gpufort_reduction.template.h index 9ef65552..791560f6 100644 --- a/python/fort2hip/templates/GpufortReductions.template.h +++ b/python/fort2hip/templates/gpufort_reduction.template.h @@ -1,5 +1,6 @@ {# SPDX-License-Identifier: MIT #} {# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. #} +// This file was generated from a template via gpufort --gpufort-create-headers #ifndef _GPUFORT_REDUCTIONS_H_ #define _GPUFORT_REDUCTIONS_H_ // requires that gpufort.h is included beforehand @@ -78,4 +79,4 @@ namespace { HIP_CHECK(hipFree(temp_storage)); } } -#endif // _GPUFORT_REDUCTIONS_H_ \ No newline at end of file +#endif // _GPUFORT_REDUCTIONS_H_ diff --git a/python/fort2hip/templates/HipImplementation.template.cpp b/python/fort2hip/templates/hip_implementation.template.cpp similarity index 99% rename from python/fort2hip/templates/HipImplementation.template.cpp rename to python/fort2hip/templates/hip_implementation.template.cpp index 2fc95c77..54fb3519 100644 --- a/python/fort2hip/templates/HipImplementation.template.cpp +++ b/python/fort2hip/templates/hip_implementation.template.cpp @@ -18,7 +18,7 @@ {% endfor %} #include "gpufort.h" {% if have_reductions -%} -#include "gpufort_reductions.h" +#include "gpufort_reduction.h" {%- endif -%} {%- macro make_block(kernel) -%} {% set krnl_prefix = kernel.kernel_name %} @@ -224,4 +224,4 @@ extern "C" void {{iface_prefix}}_cpu( {% endif +%} // END {{krnl_prefix}} {% endfor %}{# kernels #} -#endif // {{ guard }} +#endif // {{ guard }} \ No newline at end of file diff --git a/python/fort2hip/templates/InterfaceModule.template.f03 b/python/fort2hip/templates/interface_module.template.f03 similarity index 100% rename from python/fort2hip/templates/InterfaceModule.template.f03 rename to python/fort2hip/templates/interface_module.template.f03 diff --git a/python/fort2hip/templates/InterfaceModuleTest.template.f03 b/python/fort2hip/templates/interface_module_test.template.f03 similarity index 100% rename from python/fort2hip/templates/InterfaceModuleTest.template.f03 rename to python/fort2hip/templates/interface_module_test.template.f03 diff --git a/python/gpufort.py b/python/gpufort.py index e6cc0741..55f3d7f6 100644 --- a/python/gpufort.py +++ b/python/gpufort.py @@ -60,7 +60,7 @@ def _intrnl_translate_source(infilepath,stree,linemaps,index,preamble): # transform statements; to 'linemaps' def transform_(stnode): stnode.transform_statements(index) - for child in stnode._children: + for child in stnode.children: transform_(child) transform_(stree) @@ -83,11 +83,11 @@ def parse_raw_command_line_arguments(): the argparse switches and help information. Further transform some arguments. """ - config_filepath = None + config_filepath = None working_dir_path = os.getcwd() - include_dirs = [] - defines = [] - options = sys.argv[1:] + include_dirs = [] + defines = [] + options = sys.argv[1:] for i,opt in enumerate(list(options)): if opt == "--working-dir": if i+1 < len(options): @@ -142,7 +142,7 @@ def parse_config(config_filepath): utils.logging.log_error(LOG_PREFIX,"parse_config",msg) sys.exit(1) -def parse_command_line_arguments(): +def parse_cl_args(): """ Parse command line arguments after all changes and argument transformations by the config file have been applied. """ @@ -159,6 +159,8 @@ def parse_command_line_arguments(): global POST_CLI_ACTIONS global PRETTIFY_MODIFIED_TRANSLATION_SOURCE global INCLUDE_DIRS + global DUMP_LINEMAPS + global DUMP_LINEMAPS # parse command line arguments parser = argparse.ArgumentParser(description="S2S translation tool for CUDA Fortran and Fortran+X") @@ -172,8 +174,10 @@ def parse_command_line_arguments(): parser.add_argument("-d","--search-dirs", dest="search_dirs", help="Module search dir. Alternative -I can be used (multiple times).", nargs="*", required=False, default=[], type=str) parser.add_argument("-w","--wrap-in-ifdef",dest="wrap_in_ifdef",action="store_true",help="Wrap converted lines into ifdef in host code.") parser.add_argument("-E","--dest-dialect",dest="destination_dialect",default=None,type=str,help="One of: {}".format(", ".join(scanner.SUPPORTED_DESTINATION_DIALECTS))) - parser.add_argument("--gfortran_config",dest="print_gfortran_config",action="store_true",help="Print include and compile flags.") - parser.add_argument("--cpp_config",dest="print_cpp_config",action="store_true",help="Print include and compile flags.") + parser.add_argument("--gfortran_config",dest="print_gfortran_config",action="store_true",help="Print include and compile flags; output is influenced by HIP_PLATFORM environment variable.") + parser.add_argument("--cpp_config",dest="print_cpp_config",action="store_true",help="Print include and compile flags; output is influenced by HIP_PLATFORM environment variable.") + parser.add_argument("--ldflags",dest="print_ldflags",action="store_true",help="Print linker flags; output is influenced by HIP_PLATFORM environment variable.") + parser.add_argument("--ldflags-gpufort-rt",dest="print_ldflags_gpufort_rt",action="store_true",help="Print GPUFORT OpenACC runtime linker flags; output is influenced by HIP_PLATFORM environment variable.") parser.add_argument("--path",dest="print_path",action="store_true",help="Print path to the GPUFORT root directory.") # config options: shadow arguments that are actually taken care of by raw argument parsing group_config = parser.add_argument_group('Config file') @@ -199,15 +203,19 @@ def parse_command_line_arguments(): group_developer.add_argument("--log-level",dest="log_level",required=False,type=str,default="",help="Set log level. Overrides config value.") group_developer.add_argument("--log-filter",dest="log_filter",required=False,type=str,default=None,help="Filter the log output according to a regular expression.") group_developer.add_argument("--log-traceback",dest="log_traceback",required=False,action="store_true",help="Append gpufort traceback information to the log when encountering warning/error.") + group_developer.add_argument("--dump-linemaps",dest="dump_linemaps",required=False,action="store_true",help="Write the lines-to-statements mappings to disk pre & post applying code transformations.") group_developer.add_argument("--prof",dest="profiling_enable",required=False,action="store_true",help="Profile gpufort.") group_developer.add_argument("--prof-num-functions",dest="profiling_num_functions",required=False,type=int,default=50,help="The number of python functions to include into the summary [default=50].") group_developer.add_argument("--create-gpufort-headers",dest="create_gpufort_headers",action="store_true",help="Generate the GPUFORT header files.") + group_developer.add_argument("--create-gpufort-sources",dest="create_gpufort_sources",action="store_true",help="Generate the GPUFORT source files.") - parser.set_defaults(print_config_defaults=False,dump_index=False,\ - wrap_in_ifdef=False,cublasV2=False, + parser.set_defaults(print_config_defaults=False, + dump_linemaps=False,wrap_in_ifdef=False,cublasV2=False, only_emit_kernels_and_launchers=False,only_emit_kernels=False,only_modify_translation_source=False,\ emit_cpu_implementation=False,emit_debug_code=False,\ - create_gpufort_headers=False,print_gfortran_config=False,print_cpp_config=False,\ + create_gpufort_headers=False,create_gpufort_sources=False,\ + print_gfortran_config=False,print_cpp_config=False,\ + print_ldflags=False,print_ldflags_gpufort_rt=False, only_create_gpufort_module_files=False,skip_create_gpufort_module_files=False,verbose=False,\ log_traceback=False,profiling_enable=False) args, unknown_args = parser.parse_known_args() @@ -216,19 +224,37 @@ def parse_command_line_arguments(): if args.print_path: print(__GPUFORT_ROOT_DIR,file=sys.stdout) sys.exit() + hip_platform=os.environ.get("HIP_PLATFORM","amd") if args.print_cpp_config: cpp_config = "-D"+linemapper.LINE_GROUPING_IFDEF_MACRO - cpp_config += " -I"+__GPUFORT_ROOT_DIR+"/include" + cpp_config += " -I"+os.path.join(__GPUFORT_ROOT_DIR,"include") + cpp_config += " -I"+os.path.join(__GPUFORT_ROOT_DIR,"include",hip_platform) print(cpp_config,file=sys.stdout) sys.exit() if args.print_gfortran_config: fortran_config = " -cpp -std=f2008 -ffree-line-length-none" fortran_config += " -D"+linemapper.LINE_GROUPING_IFDEF_MACRO - fortran_config += " -I"+__GPUFORT_ROOT_DIR+"/include" + fortran_config += " -I"+os.path.join(__GPUFORT_ROOT_DIR,"include") + fortran_config += " -I"+os.path.join(__GPUFORT_ROOT_DIR,"include",hip_platform) print(fortran_config,file=sys.stdout) sys.exit() + if args.print_ldflags: + ldflags = " -L"+os.path.join(__GPUFORT_ROOT_DIR,"lib") + " -lgpufort_"+hip_platform + print(ldflags,file=sys.stdout) + sys.exit() + if args.print_ldflags_gpufort_rt: + ldflags = " -L"+os.path.join(__GPUFORT_ROOT_DIR,"lib") + " -lgpufort_acc_"+hip_platform + ldflags += " -lgpufort_"+hip_platform + print(ldflags,file=sys.stdout) + sys.exit() + call_exit = False if args.create_gpufort_headers: fort2hip.generate_gpufort_headers(os.getcwd()) + call_exit = True + if args.create_gpufort_sources: + fort2hip.generate_gpufort_sources(os.getcwd()) + call_exit = True + if call_exit: sys.exit() if args.print_config_defaults: gpufort_python_dir=os.path.dirname(os.path.realpath(__file__)) @@ -325,6 +351,9 @@ def parse_command_line_arguments(): if args.profiling_enable: PROFILING_ENABLE = True PROFILING_OUTPUT_NUM_FUNCTIONS = args.profiling_num_functions + # developer: other + if args.dump_linemaps: + DUMP_LINEMAPS = True # CUDA Fortran if args.cublasV2: scanner.CUBLAS_VERSION = 2 @@ -352,7 +381,7 @@ def init_logging(input_filepath): config_filepath, include_dirs, defines = parse_raw_command_line_arguments() if config_filepath != None: parse_config(config_filepath) - args, unknown_args = parse_command_line_arguments() + args, unknown_args = parse_cl_args() if len(POST_CLI_ACTIONS): msg = "run registered actions" utils.logging.log_info(msg,verbose=False) @@ -385,6 +414,11 @@ def init_logging(input_filepath): profiler.enable() # linemaps = linemapper.read_file(input_filepath,defines) + + if DUMP_LINEMAPS: + utils.logging.log_info(LOG_PREFIX,"__main__","dump linemaps (before translation)") + linemapper.dump_linemaps(linemaps,input_filepath+"-linemaps-pre.json") + index = create_index(INCLUDE_DIRS,defines,input_filepath,linemaps) if not ONLY_CREATE_GPUFORT_MODULE_FILES: # configure fort2hip @@ -423,6 +457,10 @@ def init_logging(input_filepath): stats.print_stats(PROFILING_OUTPUT_NUM_FUNCTIONS) print(s.getvalue()) + if DUMP_LINEMAPS: + utils.logging.log_info(LOG_PREFIX,"__main__","dump linemaps (after translation)") + linemapper.dump_linemaps(linemaps,input_filepath+"-linemaps-post.json") + # shutdown logging msg = "log file: {0} (log level: {1}) ".format(log_filepath,LOG_LEVEL) utils.logging.log_info(LOG_PREFIX,"__main__",msg) diff --git a/python/gpufort_options.py.in b/python/gpufort_options.py.in index dc3f8455..dc901768 100644 --- a/python/gpufort_options.py.in +++ b/python/gpufort_options.py.in @@ -40,3 +40,7 @@ PROFILING_ENABLE = False # Enable profiling of GPUFORT PROFILING_OUTPUT_NUM_FUNCTIONS = 50 # Number of functions to output when profiling GPUFORT + +DUMP_LINEMAPS = False + # Write the lines-to-statements mappings to disk before & after + # applying code transformations; suffix="-linemaps-(pre|post).json" diff --git a/python/grammar/grammar_acc.py.in b/python/grammar/grammar_acc.py.in index 229fb4f5..cf9ae5c1 100644 --- a/python/grammar/grammar_acc.py.in +++ b/python/grammar/grammar_acc.py.in @@ -97,4 +97,4 @@ acc_simple_directive = acc_host_data | acc_data | acc_enter_data | acc_exit_data acc_host_directive = acc_kernels_loop | acc_parallel_loop | acc_kernels | acc_parallel | acc_simple_directive | ACC_END_DATA | ACC_END_HOST_DATA -#acc_kernel_body_directive = acc_loop | acc_serial_region | acc_atomic_region | acc_cache \ No newline at end of file +#acc_kernel_body_directive = acc_loop | acc_serial_region | acc_atomic_region | acc_cache diff --git a/python/grammar/grammar_f03.py.in b/python/grammar/grammar_f03.py.in index 60bc9cd2..8c339435 100644 --- a/python/grammar/grammar_f03.py.in +++ b/python/grammar/grammar_f03.py.in @@ -62,10 +62,10 @@ power_value2 = LPAR + arithmetic_expression + RPAR power_value = power_value2 | power_value1 power = power_value + Suppress("**") + power_value -lvalue = derived_type_elem | func_call | identifier -lvalueList = Group(delimitedList(lvalue)) +lvalue = derived_type_elem | func_call | identifier +lvalueList = Group(delimitedList(lvalue)) assignment_begin = lvalue + EQ -assignment = lvalue + EQ + arithmetic_expression # ! emits 2 tokens: *,* +assignment = lvalue + EQ + arithmetic_logical_expression # ! emits 2 tokens: *,* MATLPAR = Regex(r"\(\/|\[").suppress() MATRPAR = Regex(r"\/\)|\]").suppress() @@ -206,7 +206,7 @@ dimension_qualifier = Group(DIMENSION + bounds) # emits [*] intent_qualifier = Group(INTENT + LPAR + (INOUT|IN|OUT) + RPAR) # emits * qualifier = intent_qualifier | dimension_qualifier | simple_attribute qualifier_list = Group(delimitedList(qualifier)) -declared_variable = Group( identifier + Optional(bounds,default=None) + Optional(( EQ | PEQ ) + ( matrix_arithmetic_expression | complex_arithmetic_expression | arithmetic_expression ), default=None)) # ! emits [*,[*],*] +declared_variable = Group( identifier + Optional(bounds,default=None) + Optional(( PEQ | EQ ) + ( matrix_arithmetic_expression | complex_arithmetic_expression | arithmetic_logical_expression ), default=None)) # ! emits [*,[*],*] declaration_lhs = datatype + Optional(COMMA + qualifier_list,default=[]) + COLONS fortran_declaration = declaration_lhs + Group(delimitedList(declared_variable)) # ! emits *,[*],[*] #precisiondeclared_variable = identifier + EQ + CASELESS_LITERAL("selected_kind").suppress() + LPAR + integer + COMMA + integer + RPAR # ! emits [*,[*],*] @@ -287,4 +287,4 @@ type_attribute_list = Group(delimitedList(extends_type_attribute | simple_typ type_start = TYPE.suppress() + Optional(COMMA + type_attribute_list,default=[]) + Optional(COLONS) + identifier # ! emits 2 tokens: [[*], *] type_end = Regex(r"\bend\s*type\b",re.IGNORECASE).suppress() + Optional(identifier).suppress() -structure_end = END + ~(NONSTRUCTURE) + Optional(FUNCTION|SUBROUTINE|MODULE).suppress() + Optional(identifier).suppress() \ No newline at end of file +structure_end = END + ~(NONSTRUCTURE) + Optional(FUNCTION|SUBROUTINE|MODULE).suppress() + Optional(identifier).suppress() diff --git a/python/indexer/indexer.py b/python/indexer/indexer.py index f6b21ed0..3e1c9ecc 100644 --- a/python/indexer/indexer.py +++ b/python/indexer/indexer.py @@ -83,7 +83,7 @@ def consider_statement(stripped_statement): for linemap in linemaps: if linemap["is_active"]: for stmt in linemap["statements"]: - stripped_statement = stmt.lower().strip(" \t\n") + stripped_statement = stmt["body"].lower().strip(" \t\n") if consider_statement(stripped_statement): utils.logging.log_debug3(LOG_PREFIX,"_intrnl_collect_statements","select statement '{}'".format(stripped_statement)) filtered_statements.append(stripped_statement) @@ -581,4 +581,4 @@ def load_gpufort_module_files(input_dirs,index): mod_index = _intrnl_read_json_file(os.path.join(input_dir, child)) index.append(mod_index) - utils.logging.log_leave_function(LOG_PREFIX,"load_gpufort_module_files") \ No newline at end of file + utils.logging.log_leave_function(LOG_PREFIX,"load_gpufort_module_files") diff --git a/python/indexer/scoper.py b/python/indexer/scoper.py index d4d26ea4..a0c67078 100644 --- a/python/indexer/scoper.py +++ b/python/indexer/scoper.py @@ -60,7 +60,7 @@ __SCOPE_ENTRY_TYPES = ["subprograms","variables","types"] -def _intrnl_resolve_dependencies(scope,index_record,index): +def _intrnl_resolve_dependencies(scope,index_record,index,error_handling=None): """ Include variable, type, and subprogram records from modules used by the current record (module,program or subprogram). @@ -109,37 +109,39 @@ def handle_use_statements_(scope,imodule): copied_entry = copy.deepcopy(entry) copied_entry["name"] = mapping["renamed"] scope[entry_type].append(copied_entry) - if not used_module_found: + if not used_module_found: msg = "no index record for module '{}' could be found".format(used_module["name"]) if ERROR_HANDLING == "strict": utils.logging.log_error(LOG_PREFIX,"_intrnl_resolve_dependencies",msg) sys.exit(ERR_INDEXER_RESOLVE_DEPENDENCIES_FAILED) - else: + elif ERROR_HANDLING == "warn": utils.logging.log_warning(LOG_PREFIX,"_intrnl_resolve_dependencies",msg) handle_use_statements_(scope,index_record) utils.logging.log_leave_function(LOG_PREFIX,"_intrnl_resolve_dependencies") -def _intrnl_search_scope_for_type_or_subprogram(scope,entry_name,entry_type,empty_record): +def _intrnl_search_scope_for_type_or_subprogram(scope,entry_name,entry_type,empty_record,error_handling=None): """ :param str entry_type: either 'types' or 'subprograms' """ global LOG_PREFIX utils.logging.log_enter_function(LOG_PREFIX,"_intrnl_search_scope_for_type_or_subprogram",\ {"entry_name":entry_name,"entry_type":entry_type}) - + # reverse access such that entries from the inner-most scope come first scope_entities = reversed(scope[entry_type]) entry_name_lower = entry_name.lower() result = next((entry for entry in scope_entities if entry["name"] == entry_name_lower),None) if result is None: + if error_handling == None: + error_handling = ERROR_HANDLING msg = "no entry found for {} '{}'.".format(entry_type[:-1],entry_name) if ERROR_HANDLING == "strict": utils.logging.log_error(LOG_PREFIX,"_intrnl_search_scope_for_type_or_subprogram",msg) sys.exit(ERR_SCOPER_LOOKUP_FAILED) - else: + elif ERROR_HANDLING == "warn": utils.logging.log_warning(LOG_PREFIX,"_intrnl_search_scope_for_type_or_subprogram",msg) return empty_record, False else: @@ -215,7 +217,7 @@ def create_scope(index,tag): global REMOVE_OUTDATED_SCOPES global MODULE_IGNORE_LIST global LOG_PREFIX - utils.logging.log_enter_function(LOG_PREFIX,"create_scope",{"tag":tag,"ERROR_HANDLING":ERROR_HANDLING}) + utils.logging.log_enter_function(LOG_PREFIX,"create_scope",{"tag":tag}) # check if already a scope exists for the tag or if # it can be derived from a higher-level scope @@ -287,11 +289,12 @@ def create_scope(index,tag): utils.logging.log_leave_function(LOG_PREFIX,"create_scope") return new_scope -def search_scope_for_variable(scope,variable_expression,resolve=False): +def search_scope_for_variable(scope,variable_expression,error_handling=None,resolve=False): """ %param str variable_tag% a simple identifier such as 'a' or 'A_d' or a more complicated tag representing a derived-type member, e.g. 'a%b%c' or 'a%b(i,j)%c(a%i5)'. """ global LOG_PREFIX + global ERROR_HANDLING utils.logging.log_enter_function(LOG_PREFIX,"search_scope_for_variable",\ {"variable_expression":variable_expression}) @@ -302,9 +305,7 @@ def search_scope_for_variable(scope,variable_expression,resolve=False): variable_tag = create_index_search_tag_for_variable(variable_expression) list_of_var_names = variable_tag.split("%") def lookup_from_left_to_right_(scope_variables,pos=0): - """ - :note: recursive - """ + """:note: recursive""" nonlocal scope_types nonlocal list_of_var_names @@ -326,11 +327,13 @@ def lookup_from_left_to_right_(scope_variables,pos=0): result = lookup_from_left_to_right_(reversed(scope["variables"])) if result is None: - msg = "no entry found for variable '{}'.".format(variable_tag) - if ERROR_HANDLING == "strict": + if error_handling == None: + error_handling = ERROR_HANDLING + msg = "no entry found for variable '{}'.".format(variable_tag) + if error_handling == "strict": utils.logging.log_error(LOG_PREFIX,"search_scope_for_variable",msg) sys.exit(ERR_SCOPER_LOOKUP_FAILED) - else: + elif error_handling == "warn": utils.logging.log_warning(LOG_PREFIX,"search_scope_for_variable",msg) return EMPTY_VARIABLE, False else: @@ -382,7 +385,7 @@ def search_scope_for_subprogram(scope,subprogram_name): utils.logging.log_leave_function(LOG_PREFIX,"search_scope_for_subprogram") return result -def search_index_for_variable(index,parent_tag,variable_expression,resolve=False): +def search_index_for_variable(index,parent_tag,variable_expression,error_handling=None,resolve=False): """ :param str parent_tag: tag created of colon-separated identifiers, e.g. "mymodule" or "mymodule:mysubroutine". %param str variable_expression% a simple identifier such as 'a' or 'A_d' or a more complicated tag representing a derived-type member, e.g. 'a%b%c'. Note that all array indexing expressions must be stripped away. @@ -392,7 +395,7 @@ def search_index_for_variable(index,parent_tag,variable_expression,resolve=False {"parent_tag":parent_tag,"variable_expression":variable_expression}) scope = create_scope(index,parent_tag) - return search_scope_for_variable(scope,variable_expression,resolve=False) + return search_scope_for_variable(scope,variable_expression,error_handling,resolve) def search_index_for_type(index,parent_tag,type_name): """ @@ -415,7 +418,3 @@ def search_index_for_subprogram(index,parent_tag,subprogram_name): result = _intrnl_search_index_for_type_or_subprogram(index,parent_tag,subprogram_name,"subprograms",EMPTY_SUBPROGRAM) utils.logging.log_leave_function(LOG_PREFIX,"search_index_for_subprogram") return result - -def index_variable_is_on_device(ivar): - return "device" in ivar["qualifiers"] or\ - ivar["declare_on_target"] in ["alloc","to","from","tofrom"] diff --git a/python/linemapper/linemapper.py b/python/linemapper/linemapper.py index b204ade0..a9c39f69 100644 --- a/python/linemapper/linemapper.py +++ b/python/linemapper/linemapper.py @@ -1,10 +1,12 @@ import os,sys import re -import addtoplevelpath +import orjson import pyparsing as pyp +import addtoplevelpath import utils.logging +import utils.parsingutils ERR_LINEMAPPER_MACRO_DEFINITION_NOT_FOUND = 11001 @@ -49,6 +51,14 @@ def _intrnl_expand_macros(input_string,macro_stack): iterate = True break return result + +def _intrnl_linearize_statements(linemap): + result = [] + for stmt in linemap["statements"]: + result += stmt["prolog"] + result.append(stmt["body"]) + result += stmt["epilog"] + return result def evaluate_condition(input_string,macro_stack): """ @@ -183,7 +193,7 @@ def _intrnl_convert_lines_to_statements(lines): """ global PATTERN_LINE_CONTINUATION - pContinuation = re.compile(PATTERN_LINE_CONTINUATION) + p_continuation = re.compile(r"\&\s*([!c\*]\$\w+)?|([!c\*]\$\w+\&)",re.IGNORECASE) # we look for a sequence ") " were word != "then". p_single_line_if = re.compile(r"^(?P[\s\t]*)(?Pif\s*\(.+\))\s*\b(?!then)(?P\w.+)",re.IGNORECASE) @@ -200,7 +210,24 @@ def _intrnl_convert_lines_to_statements(lines): indent_offset = num_indent_chars * indent_char # replace line continuation by whitespace, split at ";" - single_line_statements = pContinuation.sub(" "," ".join(lines)).split(";") + statement_parts = [] + comment_parts = [] + for line in lines: + indent,stmt_or_dir_part,comment,_ = \ + utils.parsingutils.split_fortran_line(line) + if len(stmt_or_dir_part): + statement_parts.append(stmt_or_dir_part) + if len(comment): + comment_parts.append(comment) + single_line_statements = [] + if len(statement_parts): + combined_statements = "".join(statement_parts) + single_line_statements +=\ + p_continuation.sub(" ",combined_statements).split(";") + if len(comment_parts): + if len(single_line_statements): + single_line_statements[-1] = single_line_statements[-1].rstrip("\n") + "\n" + single_line_statements += comment_parts # unroll single-line if unrolled_statements = [] for stmt in single_line_statements: @@ -221,107 +248,30 @@ def _intrnl_convert_lines_to_statements(lines): def _intrnl_detect_line_starts(lines): """Fortran statements can be broken into multiple lines - via the '&'. This routine linemaps in which line a statement + via the '&' characters. This routine detects in which line a statement (or multiple statements per line) begins. The difference between the line numbers of consecutive entries is the number of lines the first statement occupies. """ - p_directive_continuation = re.compile(r"\n[!c\*]\$\w+\&") + p_directive_continuation = re.compile(r"[!c\*]\$\w+\&") # 1. save multi-line statements (&) in buffer buffering = False line_starts = [] for lineno,line in enumerate(lines,start=0): # Continue buffering if multiline CUF/ACC/OMP statement - buffering |= p_directive_continuation.match(line) != None + _,stmt_or_dir,comment,_ = \ + utils.parsingutils.split_fortran_line(line) + buffering |= p_directive_continuation.match(stmt_or_dir) != None if not buffering: line_starts.append(lineno) - stripped_line = line.rstrip(" \t\n") - if len(stripped_line) and stripped_line[-1] in ['&','\\']: + if len(stmt_or_dir) and stmt_or_dir[-1] in ['&','\\']: buffering = True else: buffering = False line_starts.append(len(lines)) return line_starts -def preprocess_and_normalize(fortran_file_lines,fortran_filepath,macro_stack,region_stack1,region_stack2): - """:param list file_lines: Lines of a file, terminated with line break characters ('\n'). - :returns: a list of dicts with keys 'lineno', 'original_lines', 'statements'. - """ - global LOG_PREFIX - global ERROR_HANDLING - - global INDENT_WIDTH_WHITESPACE - global INDENT_WIDTH_TABS - - global DEFAULT_INDENT_CHAR - global ONLY_APPLY_USER_DEFINED_MACROS - - utils.logging.log_enter_function(LOG_PREFIX,"preprocess_and_normalize",{ - "fortran_filepath":fortran_filepath - }) - - assert DEFAULT_INDENT_CHAR in [' ','\t'], "Indent char must be whitespace ' ' or tab '\\t'" - - # 1. detect line starts - line_starts = _intrnl_detect_line_starts(fortran_file_lines) - - # 2. go through the blocks of buffered lines - linemaps = [] - for i,_ in enumerate(line_starts[:-1]): - line_start = line_starts[i] - next_line_start = line_starts[i+1] - lines = fortran_file_lines[line_start:next_line_start] - - included_linemaps = [] - is_preprocessor_directive = lines[0].startswith("#") - if is_preprocessor_directive and not ONLY_APPLY_USER_DEFINED_MACROS: - try: - included_linemaps = _intrnl_handle_preprocessor_directive(lines,fortran_filepath,macro_stack,region_stack1,region_stack2) - statements1 = [] - statements3 = [] - except Exception as e: - raise e - elif region_stack1[-1]: # in_active_region - # Convert line to statememts - statements1 = _intrnl_convert_lines_to_statements(lines) - # 2. Apply macros to statements - statements2 = [] - for stmt1 in statements1: - statements2.append(_intrnl_expand_macros(stmt1,macro_stack)) - # 3. Above processing might introduce multiple statements per line againa. - # Hence, convert each element of statements2 to single statements again - statements3 = [] - for stmt2 in statements2: - for stmt3 in _intrnl_convert_lines_to_statements([stmt2]): - statements3.append(stmt3) - # TODO(Dominic): In case, we really need to assume that people write Fortran code - # such as `module mymod; integer :: myint; end module` and we therefore might - # require epilog/prolog per line, this will be the place where replace - # the string stmt3 by a dictionary. - # (If we would do this, we can actually also linemap positional information in a next step.) - - #if len(included_linemaps) or (not is_preprocessor_directive and region_stack1[-1]): - linemap = { - "file": fortran_filepath, - "lineno": line_start+1, # key - "lines": lines, - "raw_statements": statements1, - "included_linemaps": included_linemaps, - "is_preprocessor_directive": is_preprocessor_directive, - "is_active": region_stack1[-1], - # inout - "statements": statements3, - "modified": False, - # out - "prolog": [], - "epilog": [] - } - linemaps.append(linemap) - - utils.logging.log_leave_function(LOG_PREFIX,"preprocess_and_normalize") - return linemaps - def _intrnl_preprocess_and_normalize_fortran_file(fortran_filepath,macro_stack,region_stack1,region_stack2): """ :throws: IOError if the specified file cannot be found/accessed. @@ -400,7 +350,7 @@ def collect_subst_(linemap): for linemap in linemap["included_linemaps"]: subst += collect_subst_(linemap) elif linemap["modified"]: - subst += linemap["statements"] + subst += _intrnl_linearize_statements(linemap) else: # for included linemaps subst += linemap["lines"] if len(linemap["epilog"]): @@ -525,28 +475,28 @@ def preprocess_and_normalize(fortran_file_lines,fortran_filepath,macro_stack=[], statements3 = [] for stmt2 in statements2: for stmt3 in _intrnl_convert_lines_to_statements([stmt2]): - statements3.append(stmt3) - # TODO(Dominic): In case, we really need to assume that people write Fortran code - # such as `module mymod; integer :: myint; end module` and we therefore might - # require epilog/prolog per line, this will be the place where replace - # the string stmt3 by a dictionary. - # (If we would do this, we can actually also linemap positional information in a next step.) + statement = { + "epilog": [], + "prolog": [], + "body": stmt3 + } + statements3.append(statement) #if len(included_linemaps) or (not is_preprocessor_directive and region_stack1[-1]): linemap = { - "file": fortran_filepath, - "lineno": line_start+1, # key - "lines": lines, - "raw_statements": statements1, + "file": fortran_filepath, + "lineno": line_start+1, # key + "lines": lines, + "raw_statements": statements1, "included_linemaps": included_linemaps, "is_preprocessor_directive": is_preprocessor_directive, - "is_active": region_stack1[-1], + "is_active": region_stack1[-1], # inout - "statements": statements3, - "modified": False, + "statements": statements3, + "modified": False, # out - "prolog": [], - "epilog": [] + "prolog": [], + "epilog": [] } linemaps.append(linemap) @@ -663,6 +613,8 @@ def render_file_(linemaps): if condition1 and condition2: if len(linemap["included_linemaps"]): result += render_file_(linemap["included_linemaps"]) + elif stage=="statements": + result += "".join(_intrnl_linearize_statements(linemap)) else: result += "".join(linemap[stage]) return result @@ -670,3 +622,16 @@ def render_file_(linemaps): utils.logging.log_leave_function(LOG_PREFIX,"render_file") return render_file_(linemaps).strip("\n") + +def dump_linemaps(linemaps,filepath): + global PRETTY_PRINT_LINEMAPS_DUMP + global LOG_PREFIX + utils.logging.log_enter_function(LOG_PREFIX,"dump_linemaps",{"filepath":filepath}) + + with open(filepath,"wb") as outfile: + if PRETTY_PRINT_LINEMAPS_DUMP: + outfile.write(orjson.dumps(linemaps,option=orjson.OPT_INDENT_2)) + else: + outfile.write(orjson.dumps(linemaps)) + + utils.logging.log_leave_function(LOG_PREFIX,"dump_linemaps") diff --git a/python/linemapper/linemapper_options.py.in b/python/linemapper/linemapper_options.py.in index 600d5aeb..ec481d65 100644 --- a/python/linemapper/linemapper_options.py.in +++ b/python/linemapper/linemapper_options.py.in @@ -1,18 +1,29 @@ LOG_PREFIX="linemapper.linemapper" # prefix for logging +PRETTY_PRINT_LINEMAPS_DUMP = False + # Prettify linemaps JSON files. +#PATTERN_LINE_CONTINUATION=r"(\&\s*\n\s*([!c\*]\$\w+)?)|(^\s*[!c\*]\$\w+\&\s*)" +PATTERN_LINE_CONTINUATION=r"\&([!c\*]\$\w+)?|([!c\*]\$\w+\&)" + # line continuation pattern. The linemapper's preprocessor removes them. -PATTERN_LINE_CONTINUATION=r"([\&]\s*\n)|(\n[!c\*]\$\w+\&)" # line continuation pattern. The linemapper's preprocessor removes them. +ERROR_HANDLING="strict" + # 'strict': program terminates with error. Otherwise, a warning is printed. -ERROR_HANDLING="strict" # 'strict': program terminates with error. Otherwise, a warning is printed. +USER_DEFINED_MACROS = [] + # manually add macro definitions: dicts with entries 'name' (str), 'args' (list of str), and 'subst' (str) -USER_DEFINED_MACROS = [] # manually add macro definitions: dicts with entries 'name' (str), 'args' (list of str), and 'subst' (str) +ONLY_APPLY_USER_DEFINED_MACROS = False + # Only apply user defined macros (incl. compiler options) and turn off other preprocessing (-> all code is active) -ONLY_APPLY_USER_DEFINED_MACROS = False # Only apply user defined macros (incl. compiler options) and turn off other preprocessing (-> all code is active) +INDENT_WIDTH_WHITESPACE=2 + # number of indent chars if indentation uses whitespaces +INDENT_WIDTH_TABS=1 + # number of indent chars if indentation uses tabs -INDENT_WIDTH_WHITESPACE=2 # number of indent chars if indentation uses whitespaces -INDENT_WIDTH_TABS=1 # number of indent chars if indentation uses tabs - -DEFAULT_INDENT_CHAR=' ' # The default index char to use if no other char was detected (' ' or '\t'). +DEFAULT_INDENT_CHAR=' ' + # The default index char to use if no other char was detected (' ' or '\t'). LINE_GROUPING_INCLUDE_BLANK_LINES = True -LINE_GROUPING_WRAP_IN_IFDEF = False # Introduce ifdef-else-endif preprocessor block around modified lines and keep the original in the else branch. -LINE_GROUPING_IFDEF_MACRO = "__GPUFORT" # Macro to use in the ifdef directive. +LINE_GROUPING_WRAP_IN_IFDEF = False + # Introduce ifdef-else-endif preprocessor block around modified lines and keep the original in the else branch. +LINE_GROUPING_IFDEF_MACRO = "__GPUFORT" + # Macro to use in the ifdef directive. diff --git a/python/scanner/cudafortran/scanner_tree_cuf.py.in b/python/scanner/cudafortran/scanner_tree_cuf.py.in index 6bb82379..d1e4adfb 100644 --- a/python/scanner/cudafortran/scanner_tree_cuf.py.in +++ b/python/scanner/cudafortran/scanner_tree_cuf.py.in @@ -26,17 +26,17 @@ class STCufDirective(STDirective): https://www.openacc.org/sites/default/files/inline-files/OpenCUF.2.7.pdf) """ - def __init__(self,parent,lineno,lines,directive_no): - STDirective.__init__(self,parent,lineno,lines,directive_no,sentinel="!$cuf") + def __init__(self,lineno,lines,directive_no): + STDirective.__init__(self,lineno,lines,directive_no,sentinel="!$cuf") self._default_present_vars = [] - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): assert False, "Currently, there are only CUF parallel directives" class STCufLoopKernel(STCufDirective,STLoopKernel): - def __init__(self,parent,lineno,lines,directive_no): - STCufDirective.__init__(self,parent,lineno,lines,directive_no) - STLoopKernel.__init__(self,parent,lineno,lines) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[],destination_dialect=""): + def __init__(self,lineno,lines,directive_no): + STCufDirective.__init__(self,lineno,lines,directive_no) + STLoopKernel.__init__(self,lineno,lines) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[],destination_dialect=""): """ :param destination_dialect: allows to override default if this kernel should be translated via another backend. @@ -44,4 +44,63 @@ class STCufLoopKernel(STCufDirective,STLoopKernel): checked_dialect = check_destination_dialect(\ DESTINATION_DIALECT if not len(destination_dialect) else destination_dialect) return CUF_LOOP_KERNEL_BACKENDS[checked_dialect](self).transform(\ - joined_lines,joined_statements,statements_fully_cover_lines,index_hints) \ No newline at end of file + joined_lines,joined_statements,statements_fully_cover_lines,index) + +def handle_allocate_cuf(stallocate,joined_statements,index): + indent = stallocate.first_line_indent() + # CUF + transformed = False + bytes_per_element = [] + array_qualifiers = [] + for array_name in stallocate.parse_result.variable_names(): + ivar,_ = scoper.search_index_for_variable(index,stallocate.parent.tag(),\ + array_name) + bytes_per_element.append(ivar["bytes_per_element"]) + qualifier, transformation_required = pinned_or_on_device(ivar) + transformed |= transformation_required + array_qualifiers.append(qualifier) + subst = stallocate.parse_result.hip_f_str(bytes_per_element,array_qualifiers,indent=indent).lstrip(" ") + return (subst, transformed) + +def handle_deallocate_cuf(stdeallocate,joined_statements,index): + indent = stdeallocate.first_line_indent() + transformed = False + array_qualifiers = [] + for array_name in stdeallocate.parse_result.variable_names(): + ivar,_ = scoper.search_index_for_variable(index,stdeallocate.parent.tag(),\ + array_name) + on_device = index_variable_is_on_device(ivar) + qualifier, transformed1 = pinned_or_on_device(ivar) + transformed |= transformed1 + array_qualifiers.append(qualifier) + subst = stdeallocate.parse_result.hip_f_str(array_qualifiers,indent=indent).lstrip(" ") + return (subst, transformed) + +def postprocess_tree_cuf(stree,index,destination_dialect=""): + """ + Add use statements as well as handles plus their creation and destruction for certain + math libraries. + """ + global LOG_PREFIX + global CUBLAS_VERSION + utils.logging.log_enter_function(LOG_PREFIX,"postprocess_cuf") + + # cublas_v1 detection + if CUBLAS_VERSION == 1: + def has_cublas_call_(child): + return type(child) is STCudaLibCall and child.has_cublas() + cuf_cublas_calls = stree.find_all(filter=has_cublas_call_, recursively=True) + for call in cuf_cublas_calls: + last_decl_list_node = call.parent.last_entry_in_decl_list() + indent = self.first_line_indent() + last_decl_list_node.add_to_epilog("{0}type(c_ptr) :: hipblasHandle = c_null_ptr\n".format(indent)) + + local_cublas_calls = call.parent.find_all(filter=has_cublas_call, recursively=False) + first = local_cublas_calls[0] + indent = self.first_line_indent() + first.add_to_prolog("{0}hipblasCreate(hipblasHandle)\n".format(indent)) + last = local_cublas_calls[-1] + indent = self.first_line_indent() + last.add_to_epilog("{0}hipblasDestroy(hipblasHandle)\n".format(indent)) + + utils.logging.log_leave_function(LOG_PREFIX,"postprocess_cuf") diff --git a/python/scanner/cudafortran/scanner_tree_cuf2hip.py.in b/python/scanner/cudafortran/scanner_tree_cuf2hip.py.in index 8ad80bca..d4bf50da 100644 --- a/python/scanner/cudafortran/scanner_tree_cuf2hip.py.in +++ b/python/scanner/cudafortran/scanner_tree_cuf2hip.py.in @@ -2,7 +2,7 @@ # Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. class CufLoopKernel2Hip(CufBackendBase): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): - return STLoopKernel.transform(self._stnode,joined_lines,joined_statements,statements_fully_cover_lines,index_hints) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): + return STLoopKernel.transform(self._stnode,joined_lines,joined_statements,statements_fully_cover_lines,index) -register_cuf_backend("hip",CufLoopKernel2Hip,None) \ No newline at end of file +register_cuf_backend("hip",CufLoopKernel2Hip,None) diff --git a/python/scanner/cudafortran/scanner_tree_cuf2omp.py.in b/python/scanner/cudafortran/scanner_tree_cuf2omp.py.in index 9e72181a..2d80f661 100644 --- a/python/scanner/cudafortran/scanner_tree_cuf2omp.py.in +++ b/python/scanner/cudafortran/scanner_tree_cuf2omp.py.in @@ -2,15 +2,15 @@ # Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. class CufLoopKernel2Omp(CufBackendBase): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): """ Analyze based on statements but modify original lines if these are fully covered by the statements. """ global LOG_PREFIX try: - parent_tag = self._stnode._parent.tag() - scope = scoper.create_scope(index_hints,parent_tag) + parent_tag = self._stnode.parent.tag() + scope = scoper.create_scope(index,parent_tag) parse_result = translator.parse_loop_kernel(joined_statements.split("\n"),scope) f_snippet = joined_lines if statements_fully_cover_lines else joined_statements return parse_result.omp_f_str(f_snippet), True diff --git a/python/scanner/openacc/scanner_tree_acc.py.in b/python/scanner/openacc/scanner_tree_acc.py.in index c288f6e7..c7a730a8 100644 --- a/python/scanner/openacc/scanner_tree_acc.py.in +++ b/python/scanner/openacc/scanner_tree_acc.py.in @@ -3,38 +3,57 @@ class AccBackendBase: def __init__(self,stnode): self._stnode = stnode + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): + assert False, "not implemented" + +class AccPostprocessBackendBase: + def run(self,stree,index): + """:param stree: the full scanner tree""" + """:param staccdirectives: All acc directive tree nodes.""" + #assert False, "not implemented" + pass ACC_BACKENDS = {} ACC_LOOP_KERNEL_BACKENDS = {} +ACC_POSTPROCESS_BACKENDS = {} +ACC_ALLOCATE_BACKENDS = {} +ACC_DEALLOCATE_BACKENDS = {} -def register_acc_backend(name,directive_generator_class,loop_kernel_generator_class,runtime_module_name): +def register_acc_backend(name,\ + directive_generator_class,\ + loop_kernel_generator_class,\ + postprocess_class,\ + allocate_func,\ + deallocate_func,\ + runtime_module_name): global SUPPORTED_DESTINATION_DIALECTS global RUNTIME_MODULE_NAMES - global ACC_BACKENDS + global ACC_BACKENDS global ACC_LOOP_KERNEL_BACKENDS + global ACC_POSTPROCESS_BACKENDS + global ACC_ALLOCATE_BACKENDS + global ACC_DEALLOCATE_BACKENDS if not name in SUPPORTED_DESTINATION_DIALECTS: SUPPORTED_DESTINATION_DIALECTS.append(name) RUNTIME_MODULE_NAMES[name] = runtime_module_name ACC_BACKENDS[name] = directive_generator_class ACC_LOOP_KERNEL_BACKENDS[name] = loop_kernel_generator_class + ACC_POSTPROCESS_BACKENDS[name] = postprocess_class + ACC_ALLOCATE_BACKENDS[name] = allocate_func + ACC_DEALLOCATE_BACKENDS[name] = deallocate_func exec(open("{0}/openacc/scanner_tree_acc2omp.py.in".format(scanner_dir)).read()) exec(open("{0}/openacc/scanner_tree_acc2hipgpufortrt.py.in".format(scanner_dir)).read()) exec(open("{0}/openacc/scanner_tree_acc2hipgccrt.py.in".format(scanner_dir)).read()) class STAccDirective(STDirective): - """ - This class has the functionality of a kernel if the stored lines - contain a parallel or kernels directive. - - https://www.openacc.org/sites/default/files/inline-files/OpenACC.2.7.pdf) - """ - def __init__(self,parent,first_linemap,first_linemap_first_statement,directive_no): - STDirective.__init__(self,parent,first_linemap,first_linemap_first_statement,directive_no,sentinel="!$acc") + """Class for handling ACC directives.""" + def __init__(self,first_linemap,first_linemap_first_statement,directive_no): + STDirective.__init__(self,first_linemap,first_linemap_first_statement,directive_no,sentinel="!$acc") self._default_present_vars = [] def find_substring(self,token): - return token in self.single_line_statement() + return token in self.first_statement() def find_any_substring(self,tokens): result = False for token in tokens: @@ -49,14 +68,16 @@ class STAccDirective(STDirective): return self.find_substring("acc end") def is_data_directive(self): return self.find_substring("acc data") - def is_enter_directive(self): + def is_enter_data_directive(self): return self.find_substring("acc enter") - def is_exit_directive(self): + def is_exit_data_directive(self): return self.find_substring("acc exit") def is_init_directive(self): return self.find_substring("acc init") def is_shutdown_directive(self): return self.find_substring("acc shutdown") + def is_update_directive(self): + return self.find_substring("acc update") def is_wait_directive(self): return self.find_substring("acc wait") def is_loop_directive(self): @@ -73,26 +94,31 @@ class STAccDirective(STDirective): return self.find_substring("acc parallel loop") def is_kernels_loop_directive(self): return self.find_substring("acc kernels loop") + def is_declare_directive(self): + return self.find_substring("acc declare") + def is_purely_declarative(self): + return self.is_declare_directive() or\ + self.find_substring("acc routine") def __str__(self): return """ {{ single_line_statement={single_line_statement}, is_init_directive={is_init_directive}, is_shutdown_directive={is_shutdown_directive}, is_end_directive={is_end_directive}, - is_enter_directive={is_enter_directive}, - is_exit_directive={is_exit_directive}, + is_enter_data_directive={is_enter_data_directive}, + is_exit_data_directive={is_exit_data_directive}, is_wait_directive={is_wait_directive}, is_loop_directive={is_loop_directive}, is_parallel_directive={is_parallel_directive}, is_kernels_directive={is_kernels_directive}, is_parallel_loop_directive={is_parallel_loop_directive} }} """.format( - single_line_statement=self.single_line_statement(), + single_line_statement=self.first_statement(), is_init_directive=self.is_init_directive(), is_shutdown_directive=self.is_shutdown_directive(), is_end_directive=self.is_end_directive(), - is_enter_directive=self.is_enter_directive(), - is_exit_directive=self.is_exit_directive(), + is_enter_data_directive=self.is_enter_data_directive(), + is_exit_data_directive=self.is_exit_data_directive(), is_wait_directive=self.is_wait_directive(), is_loop_directive=self.is_loop_directive(), is_parallel_directive=self.is_parallel_directive(), @@ -100,15 +126,18 @@ class STAccDirective(STDirective): is_parallel_loop_directive=self.is_parallel_loop_directive() ).strip().replace("\n","") __repr__ = __str__ - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): - checked_dialect = check_destination_dialect(DESTINATION_DIALECT) - return ACC_BACKENDS[checked_dialect](self).transform(\ - joined_lines,joined_statements,statements_fully_cover_lines,index_hints) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): + if self.is_purely_declarative(): + return STNode.transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index) + else: + checked_dialect = check_destination_dialect(DESTINATION_DIALECT) + return ACC_BACKENDS[checked_dialect](self).transform(\ + joined_lines,joined_statements,statements_fully_cover_lines,index) class STAccLoopKernel(STAccDirective,STLoopKernel): - def __init__(self,parent,first_linemap,first_linemap_first_statement,directive_no): - STAccDirective.__init__(self,parent,first_linemap,first_linemap_first_statement,directive_no) - STLoopKernel.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[],destination_dialect=""): + def __init__(self,first_linemap,first_linemap_first_statement,directive_no): + STAccDirective.__init__(self,first_linemap,first_linemap_first_statement,directive_no) + STLoopKernel.__init__(self,first_linemap,first_linemap_first_statement) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[],destination_dialect=""): """ :param destination_dialect: allows to override default if this kernel should be translated via another backend. @@ -116,4 +145,56 @@ class STAccLoopKernel(STAccDirective,STLoopKernel): checked_dialect = check_destination_dialect(\ DESTINATION_DIALECT if not len(destination_dialect) else destination_dialect) return ACC_LOOP_KERNEL_BACKENDS[checked_dialect](self).transform(\ - joined_lines,joined_statements,statements_fully_cover_lines,index_hints) \ No newline at end of file + joined_lines,joined_statements,statements_fully_cover_lines,index) + +def handle_allocate_acc(stallocate,joined_statements,index,destination_dialect=""): + indent = stallocate.first_line_indent() + checked_dialect = check_destination_dialect(\ + DESTINATION_DIALECT if not len(destination_dialect) else destination_dialect) + if checked_dialect in ACC_ALLOCATE_BACKENDS: + epilog = ACC_ALLOCATE_BACKENDS[checked_dialect](stallocate,index) + for line in epilog: + stallocate.add_to_epilog(line) + return joined_statements, False + +def handle_deallocate_acc(stdeallocate,joined_statements,index,destination_dialect=""): + indent = stdeallocate.first_line_indent() + checked_dialect = check_destination_dialect(\ + DESTINATION_DIALECT if not len(destination_dialect) else destination_dialect) + if checked_dialect in ACC_DEALLOCATE_BACKENDS: + prolog = ACC_DEALLOCATE_BACKENDS[checked_dialect](stdeallocate,index) + for line in prolog: + stdeallocate.add_to_prolog(line) + return joined_statements, False + +def postprocess_tree_acc(stree,index,destination_dialect=""): + """ + Add use statements as well as handles plus their creation and destruction for certain + math libraries. + """ + global LOG_PREFIX + global DESTINATION_DIALECT + global RUNTIME_MODULE_NAMES + + utils.logging.log_enter_function(LOG_PREFIX,"postprocess_tree_acc") + + checked_dialect = check_destination_dialect(\ + DESTINATION_DIALECT if not len(destination_dialect) else destination_dialect) + if checked_dialect in ACC_POSTPROCESS_BACKENDS: + def directive_filter(node): + return isinstance(node,STAccDirective) and\ + not node.ignore_in_s2s_translation + directives = stree.find_all(filter=directive_filter, recursively=True) + for directive in directives: + stnode = directive.parent.first_entry_in_decl_list() + # add acc use statements + if not stnode is None: + indent = stnode.first_line_indent() + acc_runtime_module_name = RUNTIME_MODULE_NAMES[checked_dialect] + if acc_runtime_module_name != None and len(acc_runtime_module_name): + stnode.add_to_prolog("{0}use {1}\n{0}use iso_c_binding\n".format(indent,acc_runtime_module_name)) + #if type(directive.parent + # call backend + ACC_POSTPROCESS_BACKENDS[checked_dialect]().run(stree,index) + + utils.logging.log_leave_function(LOG_PREFIX,"postprocess_tree_acc") diff --git a/python/scanner/openacc/scanner_tree_acc2hipgccrt.py.in b/python/scanner/openacc/scanner_tree_acc2hipgccrt.py.in index 1ca5615f..eca75c4e 100644 --- a/python/scanner/openacc/scanner_tree_acc2hipgccrt.py.in +++ b/python/scanner/openacc/scanner_tree_acc2hipgccrt.py.in @@ -52,19 +52,19 @@ class Acc2HipGccRT(AccBackendBase): def _create_mappings(self,parse_result,prefix=",mappings="): mappings=[] for clause in translator.find_all(parse_result,translator.TTAccMappingClause): - if clause.kind() == "present": + if clause.kind == "present": mappings += [HIP_GCC_RT_MAP_PRESENT.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "create": + elif clause.kind == "create": mappings += [HIP_GCC_RT_MAP_CREATE.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "no_create": + elif clause.kind == "no_create": mappings += [HIP_GCC_RT_MAP_NO_CREATE.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "delete": + elif clause.kind == "delete": mappings += [HIP_GCC_RT_MAP_DELETE.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "copy": + elif clause.kind == "copy": mappings += [HIP_GCC_RT_MAP_COPY.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "copyin": + elif clause.kind == "copyin": mappings += [HIP_GCC_RT_MAP_COPYIN.format(var=expr) for expr in clause.var_expressions()] - elif clause.kind() == "copyout": + elif clause.kind == "copyout": mappings += [HIP_GCC_RT_MAP_COPYOUT.format(var=expr) for expr in clause.var_expressions()] if len(mappings): return prefix+"["+",".join(mappings)+"]" @@ -104,7 +104,7 @@ class Acc2HipGccRT(AccBackendBase): return clause.condition() else: return "" - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[],handle_if=False): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[],handle_if=False): f_snippet = joined_statements result = "" try: @@ -150,14 +150,14 @@ class Acc2HipGccRT(AccBackendBase): return f_snippet, False class AccLoopKernel2HipGccRT(Acc2HipGccRT): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): stnode = self._stnode indent = stnode.first_line_indent() result = "" if stnode.is_parallel_loop_directive() or stnode.is_kernels_loop_directive(): - partial_result, _ = Acc2HipGccRT.transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints,handle_if=False) + partial_result, _ = Acc2HipGccRT.transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index,handle_if=False) result = partial_result - partial_result, _ = STLoopKernel.transform(stnode,joined_lines,joined_statements,statements_fully_cover_lines,index_hints) + partial_result, _ = STLoopKernel.transform(stnode,joined_lines,joined_statements,statements_fully_cover_lines,index) result += partial_result # add wait call if necessary arg = self._handle_async(None,"") @@ -175,4 +175,16 @@ class AccLoopKernel2HipGccRT(Acc2HipGccRT): condition=condition,result=result.rstrip("\n"),original="".join(stnode._lines).rstrip("\n")) return result, len(result) -register_acc_backend("hip-gcc-rt",Acc2HipGccRT,AccLoopKernel2HipGccRT,"openacc_gomp") \ No newline at end of file +def AllocateHipGccRT(stallocate,index): + return "" + +def DeallocateHipGccRT(stdeallocate,index): + return "" + +register_acc_backend("hip-gcc-rt",\ + Acc2HipGccRT,\ + AccLoopKernel2HipGccRT,\ + AccPostprocessBackendBase,\ + AllocateHipGccRT,\ + DeallocateHipGccRT,\ + "openacc_gomp") diff --git a/python/scanner/openacc/scanner_tree_acc2hipgpufortrt.py.in b/python/scanner/openacc/scanner_tree_acc2hipgpufortrt.py.in index 670a25eb..d9437af7 100644 --- a/python/scanner/openacc/scanner_tree_acc2hipgpufortrt.py.in +++ b/python/scanner/openacc/scanner_tree_acc2hipgpufortrt.py.in @@ -4,26 +4,24 @@ HIP_GPUFORT_RT_ACC_INIT = "{indent}call gpufort_acc_init()\n" HIP_GPUFORT_RT_ACC_SHUTDOWN = "{indent}call gpufort_acc_shutdown()\n" # regions -HIP_GPUFORT_RT_ACC_ENTER_REGION = "{indent}call gpufort_acc_enter_region()\n" -HIP_GPUFORT_RT_ACC_EXIT_REGION = "{indent}call gpufort_acc_exit_region()\n" +HIP_GPUFORT_RT_ACC_ENTER_REGION = "{indent}call gpufort_acc_enter_region({region_kind})\n" +HIP_GPUFORT_RT_ACC_EXIT_REGION = "{indent}call gpufort_acc_exit_region({region_kind})\n" # create HIP_GPUFORT_RT_ACC_CREATE = "{indent}{dev_var} = gpufort_acc_create({var})\n" # no_create HIP_GPUFORT_RT_ACC_NO_CREATE = "{indent}{dev_var} = gpufort_acc_no_create({var})\n" # delete -HIP_GPUFORT_RT_ACC_DELETE = "{indent}call gpufort_acc_delete({var}{finalize})\n" +HIP_GPUFORT_RT_ACC_DELETE = "{indent}call gpufort_acc_delete({var}{alloc}{finalize})\n" # copyin HIP_GPUFORT_RT_ACC_COPYIN = "{indent}{dev_var} = gpufort_acc_copyin({var}{asyncr})\n" # copy HIP_GPUFORT_RT_ACC_COPY = "{indent}{dev_var} = gpufort_acc_copy({var}{asyncr})\n" # copyout HIP_GPUFORT_RT_ACC_COPYOUT = "{indent}{dev_var} = gpufort_acc_copyout({var}{asyncr})\n" -# update host -HIP_GPUFORT_RT_ACC_UPDATE_HOST = "{indent}call gpufort_acc_update_host({var}{asyncr})\n" -# update device -HIP_GPUFORT_RT_ACC_UPDATE_DEVICE = "{indent}call gpufort_acc_update_device({var}{asyncr})\n" +# update +HIP_GPUFORT_RT_ACC_UPDATE = "{indent}call gpufort_acc_update_{kind}({var}{asyncr})\n" # present -HIP_GPUFORT_RT_ACC_PRESENT = "{indent}{dev_var} = gpufort_acc_present({var})\n" +HIP_GPUFORT_RT_ACC_PRESENT = "{indent}{dev_var} = gpufort_acc_present({var}{asyncr}{alloc})\n" # wait HIP_GPUFORT_RT_ACC_WAIT = "{indent}call gpufort_acc_wait({queue}{asyncr})\n" @@ -37,6 +35,8 @@ MAPPING_CLAUSE_2_TEMPLATE_MAP = { "present": HIP_GPUFORT_RT_ACC_PRESENT } +HIP_GPUFORT_RT_CLAUSES_OMP2ACC={"alloc":"create","to":"copyin","tofrom":"copy"} + def dev_var_name(var): #tokens = var.split("%") #tokens[-1] = ACC_DEV_PREFIX+tokens[-1]+ACC_DEV_SUFFIX @@ -49,6 +49,15 @@ def dev_var_name(var): result = result.replace("$","_") return ACC_DEV_PREFIX + result + ACC_DEV_SUFFIX +def add_implicit_region(stcontainer): + last_decl_list_node = stcontainer.last_entry_in_decl_list() + indent = last_decl_list_node.first_line_indent() + last_decl_list_node.add_to_epilog(HIP_GPUFORT_RT_ACC_ENTER_REGION.format(\ + indent=indent,region_kind="implicit_region=.true.")) + for stendorreturn in stcontainer.return_or_end_statements(): + stendorreturn.add_to_prolog(HIP_GPUFORT_RT_ACC_EXIT_REGION.format(\ + indent=indent,region_kind="implicit_region=.true.")) + class Acc2HipGpufortRT(AccBackendBase): # clauses def _handle_async(self,queue=None,prefix=",asyncr="): @@ -70,7 +79,7 @@ class Acc2HipGpufortRT(AccBackendBase): :return: If a finalize clause is present :rtype: bool """ - return len(translator.acc_clause_finalize.searchString(self.single_line_statement(),1)) + return len(translator.acc_clause_finalize.searchString(self.first_statement(),1)) def _handle_mapping_clauses(self): """ """ @@ -78,60 +87,33 @@ class Acc2HipGpufortRT(AccBackendBase): temp_vars = set() indent = self._stnode.first_line_indent() # - for parse_result in translator.acc_mapping_clause.scanString(self._stnode.single_line_statement()): + for parse_result in translator.acc_mapping_clause.scanString(self._stnode.first_statement()): clause = parse_result[0][0] - if clause.kind() in MAPPING_CLAUSE_2_TEMPLATE_MAP: + if clause.kind in MAPPING_CLAUSE_2_TEMPLATE_MAP: var_names = clause.var_names() var_expressions = clause.var_expressions() for i,var_expr in enumerate(var_expressions): deviceptr = dev_var_name(var_names[i]) - template = MAPPING_CLAUSE_2_TEMPLATE_MAP[clause.kind()] - result += template.format(indent=indent,var=var_expr,dev_var=deviceptr,asyncr=self._handle_async()) - temp_vars.add(deviceptr) - return result, len(result), temp_vars - def _handle_default(self): - """ - Emits a acc_clause_present command for every variable in the list - """ - result = "" - temp_vars = set() - template = HIP_GPUFORT_RT_ACC_PRESENT - indent = self._stnode.first_line_indent() - for parse_result in translator.acc_clause_default.scanString(self._stnode.single_line_statement(),1): - value = str(parse_result[0][0]).lower() - #print(value) - if value == "present": - for var_expr in self._default_present_vars: - deviceptr = dev_var_name(var_expr) + template = MAPPING_CLAUSE_2_TEMPLATE_MAP[clause.kind] + result += template.format(indent=indent,var=var_expr,dev_var=deviceptr,\ + asyncr=self._handle_async(),alloc="",finalize="") temp_vars.add(deviceptr) - result += template.format(indent=indent,var=var_expr,dev_var=deviceptr) return result, len(result), temp_vars def _handle_update(self): """ - Emits a acc_clause_copy command for every variable in the list + Emits a acc_clause_update command for every variable in the list """ result = "" - temp_vars = set() indent = self._stnode.first_line_indent() # update host - #for parse_result in translator.acc_clause_update.scanString(self.single_line_statement()): - # #print(parse_result[0][0]) - # #print(parse_result[0][1]) - # asyncr=self._handle_async(parse_result[0][1]) - # #print(asyncr) - # for dest in parse_result[0][0]: - # #print(dest) - # template = HIP_GPUFORT_RT_ACC_UPDATE_HOST - # if dest[0]: # -> device - # template = HIP_GPUFORT_RT_ACC_UPDATE_DEVICE - # #print(dest[0]) - # #print(dest[1]) - # for rvalue in dest[1]: - # #print(rvalue) - # var_expr = rvalue.f_str() - # deviceptr = dev_var_name(var_expr) - # result += template.format(indent=indent,var=var_expr,dev_var=deviceptr,asyncr=asyncr) - return result, len(result), temp_vars + for parse_result in translator.acc_mapping_clause.scanString(self._stnode.first_statement()): + clause = parse_result[0][0] + if clause.kind in ["self","host","device"]: + clause_kind = "host" if clause.kind=="self" else clause.kind + var_expressions = clause.var_expressions() + for i,var_expr in enumerate(var_expressions): + result += HIP_GPUFORT_RT_ACC_UPDATE.format(indent=indent,var=var_expr,asyncr=self._handle_async(),kind=clause_kind) + return result, len(result) def _handle_wait(self): """ Emits a acc_clause_wait command for every variable in the list @@ -141,7 +123,7 @@ class Acc2HipGpufortRT(AccBackendBase): # wait indent = self._stnode.first_line_indent() template = HIP_GPUFORT_RT_ACC_WAIT - for parse_result in translator.acc_clause_wait.scanString(self._stnode.single_line_statement()): + for parse_result in translator.acc_clause_wait.scanString(self._stnode.first_statement()): queue_list=[] asyncr_list=[] for rvalue in parse_result[0][0]: # queue ids @@ -162,10 +144,10 @@ class Acc2HipGpufortRT(AccBackendBase): :rtype: str """ condition = "" - for parse_result in translator.acc_clause_if.searchString(self._stnode.single_line_statement(),1): + for parse_result in translator.acc_clause_if.searchString(self._stnode.first_statement(),1): condition = parse_result[0].condition() return condition - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[],handle_if=True): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[],handle_if=True): """ :param line: An excerpt from a Fortran file, possibly multiple lines :type line: str @@ -180,43 +162,49 @@ class Acc2HipGpufortRT(AccBackendBase): indent = stnode.first_line_indent() if stnode.is_init_directive(): result += HIP_GPUFORT_RT_ACC_INIT.format(indent=indent) - - ## Enter region commands must come first - emit_enter_region = stnode.is_enter_directive() - emit_enter_region = emit_enter_region or stnode.is_data_directive() - #emit_enter_region = emit_enter_region or stnode.is_parallel_directive() - #emit_enter_region = emit_enter_region or stnode.is_parallel_loop_directive() - emit_enter_region = emit_enter_region or stnode.is_kernels_directive() - if emit_enter_region: - result += HIP_GPUFORT_RT_ACC_ENTER_REGION.format(indent=indent) - - ## Other directives/clauses - # create - partial_result, transformed, temp_vars = self._handle_mapping_clauses() - if transformed: - result += partial_result - all_temp_vars.update(temp_vars) - - # update directive - partial_result, transformed, temp_vars = self._handle_update() - if transformed: - result += partial_result - all_temp_vars.update(temp_vars) - - ## wait - partial_result, transformed, _ = self._handle_wait() - if transformed: - result += partial_result - - ## Exit region commands must come last - emit_exit_region = stnode.is_exit_directive() - emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("kernels") and not stnode.find_substring("loop")) - #emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("parallel") and not stnode.find_substring("loop")) - emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("data")) - if emit_exit_region: - result += HIP_GPUFORT_RT_ACC_EXIT_REGION.format(indent=indent) - if stnode.is_shutdown_directive(): + elif stnode.is_update_directive(): + partial_result, transformed = self._handle_update() + if transformed: + result += partial_result + elif stnode.is_shutdown_directive(): result += HIP_GPUFORT_RT_ACC_SHUTDOWN.format(indent=indent) + else: + ## Enter region commands must come first + emit_enter_region = stnode.is_enter_data_directive() + if emit_enter_region: + region_kind="unstructured=.true." + else: + region_kind="" + emit_enter_region = emit_enter_region or stnode.is_data_directive() + emit_enter_region = emit_enter_region or stnode.is_parallel_directive() + emit_enter_region = emit_enter_region or stnode.is_parallel_loop_directive() + emit_enter_region = emit_enter_region or stnode.is_kernels_directive() + emit_enter_region = emit_enter_region or stnode.is_kernels_loop_directive() + if emit_enter_region: + result += HIP_GPUFORT_RT_ACC_ENTER_REGION.format(indent=indent,region_kind=region_kind) + + ## Other directives/clauses + partial_result, transformed, temp_vars = self._handle_mapping_clauses() + if transformed: + result += partial_result + all_temp_vars.update(temp_vars) + + ## wait + partial_result, transformed, _ = self._handle_wait() + if transformed: + result += partial_result + + ## Exit region commands must come last + emit_exit_region = stnode.is_exit_data_directive() + if emit_exit_region: + region_kind="unstructured=.true." + else: + region_kind="" + emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("kernels") and not stnode.find_substring("loop")) + emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("parallel") and not stnode.find_substring("loop")) + emit_exit_region = emit_exit_region or (stnode.is_end_directive() and stnode.find_substring("data")) + if emit_exit_region: + result += HIP_GPUFORT_RT_ACC_EXIT_REGION.format(indent=indent,region_kind=region_kind) # _handle if condition = self._handle_if() @@ -225,42 +213,190 @@ class Acc2HipGpufortRT(AccBackendBase): condition=condition, result=result.rstrip("\n")) # introduce the new variables - if len(all_temp_vars): - begin = stnode._parent.find_last(filter=lambda child : not child._ignore_in_s2s_translation and type(child) in [STUseStatement,STDeclaration,STPlaceHolder]) - indent = stnode.first_line_indent() - if begin is not None: - for var in all_temp_vars: - begin.add_to_epilog("{indent}type(c_ptr) :: {name}\n".format(indent=indent,name=var)) - else: - stnode.add_to_prolog("! TODO(gpufort): move declarations and use statement to appropriate place\n") - for var in all_temp_vars: - stnode.add_to_prolog("{indent}type(c_ptr) :: {name}\n".format(indent=indent,name=var)) + stnode.parent.append_vars_to_decl_list(all_temp_vars) return result, len(result) class AccLoopKernel2HipGpufortRT(Acc2HipGpufortRT): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def _handle_default(self): + """ + Emits a acc_clause_present command for every variable in the list + """ + stloopkernel = self._stnode + ttloopkernel = stloopkernel.parse_result + unmapped_arrays = ttloopkernel.all_unmapped_arrays() + + result = "" + temp_vars = [] + "{indent}{dev_var} = gpufort_acc_present({var}{asyncr}{alloc})\n" + template = HIP_GPUFORT_RT_ACC_PRESENT + indent = stloopkernel.first_line_indent() + default_clauses = translator.acc_clause_default.searchString(stloopkernel.first_statement(),1) + if len(default_clauses): + value = str(default_clauses[0][0][0]).lower() + #print(value) + if value == "present": + for var_expr in unmapped_arrays: + deviceptr = dev_var_name(var_expr) + temp_vars.append(deviceptr) + result += template.format(indent=indent,var=var_expr,asyncr="",alloc="",dev_var=deviceptr) + elif value == "none" and len(unmapped_arrays): + utils.logging.log_warning(LOG_PREFIX,"AccLoopKernel2HipGpufortRT._handle_default","'default(none)' specified but no map for the following variables found: ".format(", ".join(unmapped_arrays))) + else: # default strategy: present_or_copy + for var_expr in unmapped_arrays: + deviceptr = dev_var_name(var_expr) + if not deviceptr in temp_vars: + temp_vars.append(deviceptr) + result += template.format(indent=indent,var=var_expr,asyncr="",alloc=",or=gpufort_acc_event_copy",dev_var=deviceptr) + + return result, len(result), temp_vars + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): result = "" - stnode = self._stnode - indent = stnode.first_line_indent() - if stnode.is_parallel_loop_directive() or stnode.is_kernels_loop_directive(): - partial_result, _ = Acc2HipGpufortRT.transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints,handle_if=False) - result = partial_result - partial_result, _ = STLoopKernel.transform(stnode,joined_lines,joined_statements,statements_fully_cover_lines,index_hints) - result += partial_result + stloopkernel = self._stnode + ttloopkernel = stloopkernel.parse_result + arrays_in_body = ttloopkernel.arrays_in_body() + indent = stloopkernel.first_line_indent() + if stloopkernel.is_parallel_loop_directive() or stloopkernel.is_kernels_loop_directive(): + result, _ = Acc2HipGpufortRT.transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index,handle_if=False) + partial_result, transformed, temp_vars = self._handle_default() + if transformed: + stloopkernel.parent.append_vars_to_decl_list(temp_vars) + result = "\n".join([result.rstrip("\n"), partial_result]) + partial_result, _ = STLoopKernel.transform(stloopkernel,joined_lines,joined_statements,statements_fully_cover_lines,index) + result = "\n".join([result.rstrip("\n"), partial_result]) + + # handle default + self._handle_default() # add wait call if necessary queue = self._handle_async(None,"") if not len(queue): - result += "\n" + HIP_GPUFORT_RT_ACC_WAIT.format(indent=indent,queue=queue,asyncr="") - #if stnode.is_parallel_loop_directive() or stnode.is_kernels_loop_directive(): - if stnode.is_kernels_loop_directive(): - result += "\n"+HIP_GPUFORT_RT_ACC_EXIT_REGION.format(indent=indent) - + result = result.rstrip("\n") + "\n" + HIP_GPUFORT_RT_ACC_WAIT.format(indent=indent,queue=queue,asyncr="") + #if stloopkernel.is_parallel_loop_directive() or stloopkernel.is_kernels_loop_directive(): + if stloopkernel.is_kernels_loop_directive() or stloopkernel.is_parallel_loop_directive(): + result = result.rstrip("\n") + "\n" + HIP_GPUFORT_RT_ACC_EXIT_REGION.format(indent=indent,region_kind="") # wrap in ifdef if necessary condition = self._handle_if() if len(condition): result = "if ( {condition} ) then\n{result}\nelse\n {original}\n endif".format(\ - condition=condition, result=result.rstrip("\n"), original="".join(stnode._lines).rstrip("\n")) + condition=condition, result=result.rstrip("\n"), original="".join(stloopkernel._lines).rstrip("\n")) return result, len(result) -register_acc_backend("hip-gpufort-rt",Acc2HipGpufortRT,AccLoopKernel2HipGpufortRT,"gpufort_acc_runtime") \ No newline at end of file +class Acc2HipGpufortRTPostprocess(AccPostprocessBackendBase): + def run(self,stree,index): + """:param stree: the full scanner tree + :param staccdirectives: All acc directive tree nodes.""" + utils.logging.log_enter_function(LOG_PREFIX,"Acc2HipGpufortRTPostprocess.run") + + # TODO check if there is any acc used in the + # construct at all + # TODO handle directly via directives; only variables occuring + # in directives need to be available on device + containers = stree.find_all(\ + lambda node: type(node) in [STProgram,STProcedure], + recursively=True) + for stcontainer in containers: + last_decl_list_node = stcontainer.last_entry_in_decl_list() + indent = last_decl_list_node.first_line_indent() + scope = scoper.create_scope(index,stcontainer.tag()) + scope_vars = scope["variables"] + local_var_names, dummy_arg_names = stcontainer.local_and_dummy_variable_names(index) + # TODO also process type members + acc_present_calls = "" + temp_vars = [] + implicit_region = False + for ivar in scope_vars: + host_var = ivar["name"] + dev_var = dev_var_name(host_var) + is_local_var = host_var in local_var_names + is_arg = host_var in dummy_arg_names + is_used_module_var = not is_local_var and not is_arg + is_allocatable = "allocatable" in ivar["qualifiers"] + is_pointer = "pointer" in ivar["qualifiers"] + if not is_allocatable: + if not is_used_module_var: implicit_region = True + module_var = ",module_var=.true." if is_used_module_var else "" + if is_pointer: + cond = "{indent}if (associated({var})) " + acc_present_template = (cond+HIP_GPUFORT_RT_ACC_PRESENT.replace("{indent}","")) + else: + acc_present_template = HIP_GPUFORT_RT_ACC_PRESENT + # find return and end, emit 1 new implicit region for all + if ivar["declare_on_target"] in HIP_GPUFORT_RT_CLAUSES_OMP2ACC.keys(): + map_kind=HIP_GPUFORT_RT_CLAUSES_OMP2ACC[ivar["declare_on_target"]] + acc_present_calls += acc_present_template.format(\ + indent=indent,var=host_var,asyncr="",\ + alloc=module_var+",or=gpufort_acc_event_"+map_kind,dev_var=dev_var) + temp_vars.append(dev_var) + if len(acc_present_calls): + stcontainer.append_vars_to_decl_list(temp_vars) + if implicit_region: add_implicit_region(stcontainer) + last_decl_list_node.add_to_epilog(acc_present_calls) + + utils.logging.log_leave_function(LOG_PREFIX,"Acc2HipGpufortRTPostprocess.run") + +def AllocateHipGpufortRT(stallocate,index): + stcontainer = stallocate.parent + parent_tag = stcontainer.tag() + scope = scoper.create_scope(index,parent_tag) + scope_vars = scope["variables"] + indent = stallocate.first_line_indent() + local_var_names, dummy_arg_names = stcontainer.local_and_dummy_variable_names(index) + acc_present_calls = [] + temp_vars = [] + implicit_region = False + for var in stallocate.variable_names: + ivar,_ = scoper.search_index_for_variable(index,parent_tag,var) + host_var = ivar["name"] + dev_var = dev_var_name(host_var) + is_local_var = host_var in local_var_names + is_arg = host_var in dummy_arg_names + is_used_module_var = not is_local_var and not is_arg + is_allocatable_or_pointer = "allocatable" in ivar["qualifiers"] or\ + "pointer" in ivar["qualifiers"] + assert is_allocatable_or_pointer + module_var = ",module_var=.true." if is_used_module_var else "" + if not is_used_module_var: implicit_region = True + if ivar["declare_on_target"] in HIP_GPUFORT_RT_CLAUSES_OMP2ACC.keys(): + map_kind=HIP_GPUFORT_RT_CLAUSES_OMP2ACC[ivar["declare_on_target"]] + acc_present_calls.append(HIP_GPUFORT_RT_ACC_PRESENT.format(\ + indent=indent,var=host_var,asyncr="",\ + alloc=module_var+",or=gpufort_acc_event_"+map_kind,dev_var=dev_var)) + temp_vars.append(dev_var) + + if len(acc_present_calls): + stcontainer.append_vars_to_decl_list(temp_vars) + if implicit_region: add_implicit_region(stcontainer) + return acc_present_calls + +def DeallocateHipGpufortRT(stdeallocate,index): + stcontainer = stdeallocate.parent + parent_tag = stcontainer.tag() + scope = scoper.create_scope(index,parent_tag) + scope_vars = scope["variables"] + indent = stdeallocate.first_line_indent() + local_var_names, dummy_arg_names = stcontainer.local_and_dummy_variable_names(index) + acc_delete_calls = [] + for var in stdeallocate.variable_names: + ivar,_ = scoper.search_index_for_variable(index,parent_tag,var) + host_var = ivar["name"] + dev_var = dev_var_name(host_var) + is_local_var = host_var in local_var_names + is_arg = host_var in dummy_arg_names + is_used_module_var = not is_local_var and not is_arg + is_allocatable_or_pointer = "allocatable" in ivar["qualifiers"] or\ + "pointer" in ivar["qualifiers"] + assert is_allocatable_or_pointer + module_var = ",module_var=.true." if is_used_module_var else "" + if ivar["declare_on_target"] in ["alloc","to","tofrom"]: + acc_delete_calls.append(HIP_GPUFORT_RT_ACC_DELETE.format(\ + indent=indent,var=host_var,asyncr="",finalize="",\ + alloc=module_var,dev_var=dev_var)) + return acc_delete_calls + +register_acc_backend("hip-gpufort-rt",\ + Acc2HipGpufortRT,\ + AccLoopKernel2HipGpufortRT,\ + Acc2HipGpufortRTPostprocess,\ + AllocateHipGpufortRT,\ + DeallocateHipGpufortRT,\ + "gpufort_acc_runtime") \ No newline at end of file diff --git a/python/scanner/openacc/scanner_tree_acc2omp.py.in b/python/scanner/openacc/scanner_tree_acc2omp.py.in index 7cbf808d..843a2f3e 100644 --- a/python/scanner/openacc/scanner_tree_acc2omp.py.in +++ b/python/scanner/openacc/scanner_tree_acc2omp.py.in @@ -1,7 +1,7 @@ # SPDX-License-Identifier: MIT # Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. class Acc2Omp(AccBackendBase): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): global LOG_PREFIX snippet = joined_statements @@ -16,7 +16,7 @@ class Acc2Omp(AccBackendBase): utils.logging.log_exception(LOG_PREFIX,"Acc2Omp.transform","failed parse directive "+str(snippet)) class AccLoopKernel2Omp(AccBackendBase): - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): global LOG_PREFIX if statements_fully_cover_lines: @@ -24,12 +24,24 @@ class AccLoopKernel2Omp(AccBackendBase): else: snippet = joined_statements try: - parent_tag = self._stnode._parent.tag() - scope = scoper.create_scope(index_hints,parent_tag) + parent_tag = self._stnode.parent.tag() + scope = scoper.create_scope(index,parent_tag) parse_result = translator.parse_loop_kernel(snippet.split("\n"),scope) return parse_result.omp_f_str(snippet), True except Exception as e: utils.logging.log_exception(LOG_PREFIX,"AccLoopKernel2Omp.transform","failed to convert kernel "+str(snippet)) sys.exit(2) -register_acc_backend("omp",Acc2Omp,AccLoopKernel2Omp,None) \ No newline at end of file +def AllocateOmp(stallocate,index): + return "" + +def DeallocateOmp(stdeallocate,index): + return "" + +register_acc_backend("omp",\ + Acc2Omp,\ + AccLoopKernel2Omp,\ + AccPostprocessBackendBase,\ + AllocateOmp,\ + DeallocateOmp,\ + None) \ No newline at end of file diff --git a/python/scanner/scanner.py b/python/scanner/scanner.py index 4d05df5a..9016c9be 100644 --- a/python/scanner/scanner.py +++ b/python/scanner/scanner.py @@ -45,58 +45,6 @@ def check_destination_dialect(destination_dialect): utils.logging.log_error(LOG_PREFIX,"check_destination_dialect",msg) sys.exit(SCANNER_ERROR_CODE) -def _intrnl_postprocess_acc(stree): - """ - Add use statements as well as handles plus their creation and destruction for certain - math libraries. - """ - global LOG_PREFIX - global DESTINATION_DIALECT - global RUNTIME_MODULE_NAMES - - utils.logging.log_enter_function(LOG_PREFIX,"_intrnl_postprocess_acc") - - directives = stree.find_all(filter=lambda node: isinstance(node,STAccDirective), recursively=True) - for directive in directives: - stnode = directive._parent.find_first(filter=lambda child : not child._ignore_in_s2s_translation and type(child) in [STUseStatement,STDeclaration,STPlaceHolder]) - # add acc use statements - if not stnode is None: - indent = stnode.first_line_indent() - acc_runtime_module_name = RUNTIME_MODULE_NAMES[DESTINATION_DIALECT] - if acc_runtime_module_name != None and len(acc_runtime_module_name): - stnode.add_to_prolog("{0}use {1}\n{0}use iso_c_binding\n".format(indent,acc_runtime_module_name)) - #if type(directive._parent - utils.logging.log_leave_function(LOG_PREFIX,"_intrnl_postprocess_acc") - -def _intrnl_postprocess_cuf(stree): - """ - Add use statements as well as handles plus their creation and destruction for certain - math libraries. - """ - global LOG_PREFIX - global CUBLAS_VERSION - utils.logging.log_enter_function(LOG_PREFIX,"_intrnl_postprocess_cuf") - # cublas_v1 detection - if CUBLAS_VERSION == 1: - def has_cublas_call_(child): - return type(child) is STCudaLibCall and child.has_cublas() - cuf_cublas_calls = stree.find_all(filter=has_cublas_call_, recursively=True) - #print(cuf_cublas_calls) - for call in cuf_cublas_calls: - begin = call._parent.find_last(filter=lambda child : type(child) in [STUseStatement,STDeclaration]) - indent = self.first_line_indent() - begin.add_to_epilog("{0}type(c_ptr) :: hipblasHandle = c_null_ptr\n".format(indent)) - #print(begin._linemaps) - - local_cublas_calls = call._parent.find_all(filter=has_cublas_call, recursively=False) - first = local_cublas_calls[0] - indent = self.first_line_indent() - first.add_to_prolog("{0}hipblasCreate(hipblasHandle)\n".format(indent)) - last = local_cublas_calls[-1] - indent = self.first_line_indent() - last.add_to_epilog("{0}hipblasDestroy(hipblasHandle)\n".format(indent)) - utils.logging.log_leave_function(LOG_PREFIX,"_intrnl_postprocess_cuf") - # API # Pyparsing actions that create scanner tree (ST) @@ -126,20 +74,24 @@ def append_if_not_recording_(new): nonlocal current_node nonlocal keep_recording if not keep_recording: + new.parent=current_node current_node.append(new) def descend_(new): nonlocal current_node nonlocal current_linemap nonlocal current_statement_no + parent_node_id = current_node.kind + parent_node_name = current_node.name + + new.parent=current_node current_node.append(new) current_node=new current_node_id = current_node.kind if current_node.name != None: current_node_id += " '"+current_node.name+"'" - parent_node_id = current_node._parent.kind - if current_node._parent.name != None: - parent_node_id += ":"+current_node._parent.name + if parent_node_name != None: + parent_node_id += ":"+parent_node_name utils.logging.log_debug(LOG_PREFIX,"parse_file","[current-node={0}] enter {1} in line {2}: '{3}'".format(\ parent_node_id,current_node_id,current_linemap["lineno"],current_linemap["lines"][0].rstrip("\n"))) @@ -148,18 +100,17 @@ def ascend_(): nonlocal current_file nonlocal current_linemap nonlocal current_statement_no - assert not current_node._parent is None, "In file {}: parent of {} is none".format(current_file,type(current_node)) - + assert not current_node.parent is None, "In file {}: parent of {} is none".format(current_file,type(current_node)) current_node_id = current_node.kind if current_node.name != None: current_node_id += " '"+current_node.name+"'" - parent_node_id = current_node._parent.kind - if current_node._parent.name != None: - parent_node_id += ":"+current_node._parent.name + parent_node_id = current_node.parent.kind + if current_node.parent.name != None: + parent_node_id += ":"+current_node.parent.name utils.logging.log_debug(LOG_PREFIX,"parse_file","[current-node={0}] leave {1} in line {2}: '{3}'".format(\ parent_node_id,current_node_id,current_linemap["lineno"],current_linemap["lines"][0].rstrip("\n"))) - current_node = current_node._parent + current_node = current_node.parent # parse actions def Module_visit(tokens): @@ -168,8 +119,8 @@ def Module_visit(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("module") - new = STModule(tokens[0],current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STModule(tokens[0],current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled descend_(new) def Program_visit(tokens): nonlocal translation_enabled @@ -177,8 +128,8 @@ def Program_visit(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("program") - new = STProgram(tokens[0],current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STProgram(tokens[0],current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled descend_(new) def Function_visit(tokens): nonlocal translation_enabled @@ -187,9 +138,9 @@ def Function_visit(tokens): nonlocal keep_recording nonlocal index log_detection_("function") - new = STProcedure(tokens[1],"function",\ - current_node,current_linemap,current_statement_no,index) - new._ignore_in_s2s_translation = not translation_enabled + new = STProcedure(tokens[1],current_node.tag(),"function",\ + current_linemap,current_statement_no,index) + new.ignore_in_s2s_translation = not translation_enabled keep_recording = new.keep_recording() descend_(new) def Subroutine_visit(tokens): @@ -199,24 +150,25 @@ def Subroutine_visit(tokens): nonlocal keep_recording nonlocal index log_detection_("subroutine") - new = STProcedure(tokens[1],"subroutine",\ - current_node,current_linemap,current_statement_no,index) - new._ignore_in_s2s_translation = not translation_enabled + new = STProcedure(tokens[1],current_node.tag(),"subroutine",\ + current_linemap,current_statement_no,index) + new.ignore_in_s2s_translation = not translation_enabled keep_recording = new.keep_recording() descend_(new) def End(): nonlocal current_node nonlocal current_linemap nonlocal keep_recording + nonlocal index log_detection_("end of module/program/function/subroutine") assert type(current_node) in [STModule,STProgram,STProcedure], "In file {}: line {}: type is {}".format(current_file, current_statement_no, type(current_node)) if type(current_node) is STProcedure and current_node.must_be_available_on_device(): current_node.add_linemap(current_linemap) current_node._last_statement_index = current_statement_no - current_node.complete_init() + current_node.complete_init(index) keep_recording = False if not keep_recording and type(current_node) in [STProcedure,STProgram]: - new = STEndOrReturn(current_node,current_linemap,current_statement_no) + new = STEndOrReturn(current_linemap,current_statement_no) append_if_not_recording_(new) ascend_() def Return(): @@ -225,9 +177,8 @@ def Return(): nonlocal keep_recording log_detection_("return statement") if not keep_recording and type(current_node) in [STProcedure,STProgram]: - new = STEndOrReturn(current_node,current_linemap,current_statement_no) + new = STEndOrReturn(current_linemap,current_statement_no) append_if_not_recording_(new) - ascend_() def in_kernels_acc_region_and_not_recording(): nonlocal current_node nonlocal keep_recording @@ -242,8 +193,8 @@ def DoLoop_visit(): nonlocal keep_recording log_detection_("do loop") if in_kernels_acc_region_and_not_recording(): - new = STAccLoopKernel(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAccLoopKernel(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled new._do_loop_ctr_memorised=do_loop_ctr descend_(new) keep_recording = True @@ -254,13 +205,14 @@ def DoLoop_leave(): nonlocal current_statement_no nonlocal do_loop_ctr nonlocal keep_recording + nonlocal index log_detection_("end of do loop") do_loop_ctr -= 1 if isinstance(current_node, STLoopKernel): if keep_recording and current_node._do_loop_ctr_memorised == do_loop_ctr: current_node.add_linemap(current_linemap) current_node._last_statement_index = current_statement_no - current_node.complete_init() + current_node.complete_init(index) ascend_() keep_recording = False def Declaration(): @@ -269,8 +221,8 @@ def Declaration(): nonlocal current_linemap nonlocal current_statement_no log_detection_("declaration") - new = STDeclaration(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STDeclaration(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def Attributes(tokens): nonlocal translation_enabled @@ -278,16 +230,16 @@ def Attributes(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("attributes statement") - new = STAttributes(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAttributes(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled current_node.append(new) def UseStatement(tokens): nonlocal current_node nonlocal current_linemap nonlocal current_statement_no log_detection_("use statement") - new = STUseStatement(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STUseStatement(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled new.name = translator.make_f_str(tokens[1]) # just get the name, ignore specific includes append_if_not_recording_(new) def PlaceHolder(): @@ -296,8 +248,8 @@ def PlaceHolder(): nonlocal current_linemap nonlocal current_statement_no log_detection_("placeholder") - new = STPlaceHolder(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STPlaceHolder(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def NonZeroCheck(tokens): nonlocal translation_enabled @@ -305,8 +257,8 @@ def NonZeroCheck(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("non-zero check") - new = STNonZeroCheck(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STNonZeroCheck(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def Allocated(tokens): nonlocal current_node @@ -314,8 +266,8 @@ def Allocated(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("allocated statement") - new = STAllocated(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAllocated(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def Allocate(tokens): nonlocal translation_enabled @@ -323,8 +275,8 @@ def Allocate(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("allocate statement") - new = STAllocate(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAllocate(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def Deallocate(tokens): nonlocal translation_enabled @@ -333,8 +285,8 @@ def Deallocate(tokens): nonlocal current_statement_no log_detection_("deallocate statement") # TODO filter variable, replace with hipFree - new = STDeallocate(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STDeallocate(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def Memcpy(tokens): nonlocal translation_enabled @@ -342,8 +294,8 @@ def Memcpy(tokens): nonlocal current_linemap nonlocal current_statement_no log_detection_("memcpy") - new = STMemcpy(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STMemcpy(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def CudaLibCall(tokens): #TODO scan for cudaMemcpy calls @@ -355,11 +307,11 @@ def CudaLibCall(tokens): log_detection_("CUDA API call") cudaApi, args = tokens if not type(current_node) in [STCudaLibCall,STCudaKernelCall]: - new = STCudaLibCall(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STCudaLibCall(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled new.cudaApi = cudaApi #print("finishes_on_first_line={}".format(finishes_on_first_line)) - assert type(new._parent) in [STModule,STProcedure,STProgram], type(new._parent) + assert type(new.parent) in [STModule,STProcedure,STProgram], type(new.parent) append_if_not_recording_(new) def CudaKernelCall(tokens): nonlocal translation_enabled @@ -370,8 +322,8 @@ def CudaKernelCall(tokens): log_detection_("CUDA kernel call") kernel_name, kernel_launch_args, args = tokens assert type(current_node) in [STModule,STProcedure,STProgram], "type is: "+str(type(current_node)) - new = STCudaKernelCall(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STCudaKernelCall(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def AccDirective(): nonlocal translation_enabled @@ -382,20 +334,19 @@ def AccDirective(): nonlocal do_loop_ctr nonlocal directive_no log_detection_("OpenACC directive") - new = STAccDirective(current_node,current_linemap,current_statement_no,directive_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAccDirective(current_linemap,current_statement_no,directive_no) + new.ignore_in_s2s_translation = not translation_enabled directive_no += 1 # if end directive ascend - if new.is_end_directive() and\ - type(current_node) is STAccDirective and current_node.is_kernels_directive(): - ascend_() - current_node.append(new) + if new.is_end_directive() and type(current_node) is STAccDirective and\ + current_node.is_kernels_directive(): + ascend_() # descend in constructs or new node elif new.is_parallel_loop_directive() or new.is_kernels_loop_directive() or\ (not new.is_end_directive() and new.is_parallel_directive()): - new = STAccLoopKernel(current_node,current_linemap,current_statement_no,directive_no) - new.kind = "acc-compute-construct" - new._ignore_in_s2s_translation = not translation_enabled + new = STAccLoopKernel(current_linemap,current_statement_no,directive_no) + new.kind = "acc-compute-construct" + new.ignore_in_s2s_translation = not translation_enabled new._do_loop_ctr_memorised=do_loop_ctr descend_(new) # descend also appends keep_recording = True @@ -414,9 +365,9 @@ def CufLoopKernel(): nonlocal keep_recording nonlocal directive_no log_detection_("CUDA Fortran loop kernel directive") - new = STCufLoopKernel(current_node,current_linemap,current_statement_no,directive_no) + new = STCufLoopKernel(current_linemap,current_statement_no,directive_no) new.kind = "cuf-kernel-do" - new._ignore_in_s2s_translation = not translation_enabled + new.ignore_in_s2s_translation = not translation_enabled new._do_loop_ctr_memorised=do_loop_ctr directive_no += 1 descend_(new) @@ -429,19 +380,19 @@ def Assignment(tokens): nonlocal current_statement log_detection_("assignment") if in_kernels_acc_region_and_not_recording(): - parse_result = translator.assignment_begin.parseString(current_statement) + parse_result = translator.assignment_begin.parseString(current_statement["body"]) lvalue = translator.find_first(parse_result,translator.TTLValue) if not lvalue is None and lvalue.has_matrix_range_args(): - new = STAccLoopKernel(current_node,current_linemap,current_statement_no) - new._ignore_in_s2s_translation = not translation_enabled + new = STAccLoopKernel(current_linemap,current_statement_no) + new.ignore_in_s2s_translation = not translation_enabled append_if_not_recording_(new) def GpufortControl(): nonlocal current_statement nonlocal translation_enabled log_detection_("gpufortran control statement") - if "on" in current_statement: + if "on" in current_statement["body"]: translation_enabled = True - elif "off" in current_statement: + elif "off" in current_statement["body"]: translation_enabled = False # TODO completely remove / comment out !$acc end kernels @@ -475,7 +426,7 @@ def GpufortControl(): gpufort_control.setParseAction(GpufortControl) current_file = str(fortran_filepath) - current_node._children.clear() + current_node.children.clear() def scan_string(expression_name,expression): """ @@ -485,7 +436,7 @@ def scan_string(expression_name,expression): nonlocal current_statement_no nonlocal current_statement - matched = len(expression.searchString(current_statement,1)) + matched = len(expression.searchString(current_statement["body"],1)) if matched: utils.logging.log_debug3(LOG_PREFIX,"parse_file.scanString","found expression '{}' in line {}: '{}'".format(expression_name,current_linemap["lineno"],current_linemap["lines"][0].rstrip())) else: @@ -524,10 +475,10 @@ def is_end_statement_(tokens,kind): condition2 = len(current_linemap["included_linemaps"]) or not current_linemap["is_preprocessor_directive"] if condition1 and condition2: for current_statement_no,current_statement in enumerate(current_linemap["statements"]): - utils.logging.log_debug4(LOG_PREFIX,"parse_file","parsing statement '{}' associated with lines [{},{}]".format(current_statement.rstrip(),\ + utils.logging.log_debug4(LOG_PREFIX,"parse_file","parsing statement '{}' associated with lines [{},{}]".format(current_statement["body"].rstrip(),\ current_linemap["lineno"],current_linemap["lineno"]+len(current_linemap["lines"])-1)) - current_tokens = utils.parsingutils.tokenize(current_statement.lower(),padded_size=6) + current_tokens = utils.parsingutils.tokenize(current_statement["body"].lower(),padded_size=6) current_statement_stripped = " ".join(current_tokens) current_statement_stripped_no_comments = current_statement_stripped.split("!")[0] if len(current_tokens): @@ -605,12 +556,6 @@ def postprocess(stree,index,hip_module_suffix): """ utils.logging.log_enter_function(LOG_PREFIX,"postprocess") if "hip" in DESTINATION_DIALECT or len(KERNELS_TO_CONVERT_TO_HIP): - # todo: - # for mod/prog in stree: - # mod_name <- mod/prog.name - # for kernels in body: - # - # insert use statements at appropriate point def is_accelerated(child): return isinstance(child,STLoopKernel) or\ @@ -623,13 +568,13 @@ def is_accelerated(child): if "hip" in DESTINATION_DIALECT or\ kernel.min_lineno() in kernels_to_convert_to_hip or\ kernel.kernel_name() in kernels_to_convert_to_hip: - stnode = kernel._parent.find_first(filter=lambda child: type(child) in [STUseStatement,STDeclaration,STPlaceHolder]) + stnode = kernel.parent.find_first(filter=lambda child: type(child) in [STUseStatement,STDeclaration,STPlaceHolder]) assert not stnode is None indent = stnode.first_line_indent() stnode.add_to_prolog("{}use {}{}\n".format(indent,module_name,hip_module_suffix)) if "cuf" in SOURCE_DIALECTS: - _intrnl_postprocess_cuf(stree) + postprocess_tree_cuf(stree,index) if "acc" in SOURCE_DIALECTS: - _intrnl_postprocess_acc(stree) - utils.logging.log_leave_function(LOG_PREFIX,"postprocess") \ No newline at end of file + postprocess_tree_acc(stree,index) + utils.logging.log_leave_function(LOG_PREFIX,"postprocess") diff --git a/python/scanner/scanner_tree.py.in b/python/scanner/scanner_tree.py.in index 09398869..12e0b191 100644 --- a/python/scanner/scanner_tree.py.in +++ b/python/scanner/scanner_tree.py.in @@ -17,42 +17,32 @@ def flatten_list(items): else: yield x -# Object representation - -# We create an object tree because we want to preserve scope. - -class Tagged: - def tag(self): - """ - Construct a tag that can be used to search the index. - """ - result = self.name.lower() - def recursive_parent_lookup(curr): - nonlocal result - if type(curr) != STRoot: - result = curr.name.lower() + ":" + result - recursive_parent_lookup(curr._parent) - recursive_parent_lookup(self._parent) - return result - +# scanner tree class STNode: - def __init__(self,parent,first_linemap,first_statement_index=0): - self.name = None - self.kind = None - self._linemaps = [] + def __init__(self,first_linemap,first_statement_index=0): + self.name = None + self.kind = None + self._linemaps = [] if first_linemap != None: self._linemaps.append(first_linemap) - self._first_statement_index = first_statement_index - self._last_statement_index = first_statement_index # inclusive - self._children = [] - self._parent = parent - self._ignore_in_s2s_translation = False + self._first_statement_index = first_statement_index + self._last_statement_index = first_statement_index # inclusive + self._prolog = [] + self._epilog = [] + # metadata + self.parent = None + self.children = [] + self.ignore_in_s2s_translation = False def __get_linemap_content(self,key,first_linemap_first_elem=0,last_linemap_last_elem=-1): - """Collects entries for the given key from all linemaps associated - with this node.""" + """Collects entries for the given key from the node's linemaps.""" result = [] for i,linemap in enumerate(self._linemaps): - if i == 0: + if len(self._linemaps)==1: + if last_linemap_last_elem == -1: + result += linemap[key][first_linemap_first_elem:] + else: + result += linemap[key][first_linemap_first_elem:last_linemap_last_elem+1] + elif i == 0: result += linemap[key][first_linemap_first_elem:] elif i == len(self._linemaps)-1: if last_linemap_last_elem == -1: @@ -66,7 +56,7 @@ class STNode: """Adds a linemap if it differs from the last linemap.""" if not len(self._linemaps) or self._linemaps[-1]["lineno"] < linemap["lineno"]: self._linemaps.append(linemap) - def complete_init(self): + def complete_init(self,index=[]): """Complete the initialization This routine is called after all associated linemaps have @@ -87,17 +77,24 @@ class STNode: for i,line in enumerate(lines): lines[i] = line.replace(" ","").replace("\t","").replace("\n","").replace("&","") def lines(self): - return self.__get_linemap_content("lines") + original_lines = self.__get_linemap_content("lines") + return utils.parsingutils.relocate_inline_comments(original_lines) def statements(self,include_none_entries=False): """ Extract the statements associated with this node from the linemaps associated with this node. :param bool include_none_entries: Also include entries that are None [default=False]. :note: None entries might have been introduced by other nodes transforming the same linemap(s). """ - result = self.__get_linemap_content("statements",\ + statements_of_node = self.__get_linemap_content("statements",\ self._first_statement_index,self._last_statement_index) - if not include_none_entries: - return [stmt.rstrip("\n\t ;") for stmt in result if stmt != None] + result = [] + if len(statements_of_node): + for stmt in statements_of_node: + if stmt["body"] != None: + result.append(stmt["body"].rstrip("\n\t ;")) + elif include_none_entries: + result.append(None) + return result def min_lineno(self): """ :return: Inclusive first line number belonging to this object. @@ -121,11 +118,11 @@ class STNode: return first_line[0:num_indent_chars] def first_statement(self): """ - :return: First line in first linemap. + :return: First statement in first linemap that belongs to this node. """ - return self._linemaps[0]["statements"][0] + return self._linemaps[0]["statements"][self._first_statement_index]["body"] def append(self,child): - self._children.append(child) + self.children.append(child) def list_of_parents(self): """ Returns a list that contains all @@ -135,27 +132,28 @@ class STNode: def recursive_parent_lookup(curr): if curr != None: result.append(curr) - recursive_parent_lookup(curr._parent) + recursive_parent_lookup(curr.parent) recursive_parent_lookup(self) return result def find_all(self,filter=lambda child : True,recursively=False): result = [] - def descend(curr): - for child in curr._children: + def descend_(curr): + nonlocal result + for child in curr.children: if filter(child): result.append(child) - elif recursively: - descend(child) - descend(self) + if recursively: + descend_(child) + descend_(self) return result def find_first(self,filter=lambda child: True): - for child in self._children: + for child in self.children: if filter(child): return child return None def find_last(self,filter=lambda child: True): - for child in reversed(self._children): + for child in reversed(self.children): if filter(child): return child return None @@ -177,15 +175,35 @@ class STNode: for tokens,start,end in expression.scanString(text): result.append(text[start:end]) return result - def add_to_prolog(self,line): + def add_to_prolog(self,line,prepend=False): """Add some prolog lines to the first linemap.""" - if not line in self._linemaps[0]["prolog"]: - self._linemaps[0]["prolog"].append(line) - def add_to_epilog(self,line): + line_preproc = line.rstrip() + prolog = self._linemaps[0]["statements"][self._first_statement_index]["prolog"] + if self._first_statement_index == 0: + prolog = self._linemaps[0]["prolog"] + else: + self._linemaps[0]["modified"] = True + if not line_preproc.lower() in map(str.lower, prolog): + if prepend: + prolog.insert(0,line_preproc) + else: + prolog.append(line_preproc) + def add_to_epilog(self,line,prepend=False): """Add some epilog lines to the first linemap.""" - if not line in self._linemaps[-1]["epilog"]: - self._linemaps[-1]["epilog"].append(line) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + line_preproc = line.rstrip() + epilog = self._linemaps[-1]["statements"][self._last_statement_index]["epilog"] + have_last_in_last_linemap = self._last_statement_index == -1 or\ + self._last_statement_index == len(self._linemaps[-1]["statements"])-1 + if have_last_in_last_linemap: + epilog = self._linemaps[0]["epilog"] + else: + self._linemaps[0]["modified"] = True + if not line_preproc.lower() in map(str.lower, epilog): + if prepend: + epilog.insert(0,line_preproc) + else: + epilog.append(line_preproc) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): """Transforms statements associated with underlying linemaps (hook) :param line: An excerpt from a Fortran file, possibly multiple lines :type line: str @@ -196,7 +214,7 @@ class STNode: return joined_lines, False else: return joined_statements, False - def __modify_linemaps(self,substitution): + def _modify_linemaps(self,substitution): """ Replaces first statement associated with node in first associated linemap by 'subst' argument. Replaces all other other statements in first and all other linemaps associated @@ -212,8 +230,8 @@ class STNode: first_linemap_first_elem = self._first_statement_index last_linemap_last_elem = self._last_statement_index # write subst into first linemap first statement - self._linemaps[0]["modified"] = True - self._linemaps[0]["statements"][first_linemap_first_elem] = substitution + self._linemaps[0]["modified"] = True + self._linemaps[0]["statements"][first_linemap_first_elem]["body"] = substitution assert len(self._linemaps), "self._linemaps should not be empty" last_linemap_ubound = last_linemap_last_elem if last_linemap_ubound != -1: @@ -222,7 +240,7 @@ class STNode: if ubound == -1: ubound = len(statements) for i in range(lbound,ubound): - statements[i] = None + statements[i]["body"] = None if len(self._linemaps) == 1: assign_none_(self._linemaps[0]["statements"],first_linemap_first_elem+1,last_linemap_ubound) else: @@ -232,57 +250,139 @@ class STNode: for linemap in self._linemaps[1:-1]: # upper bound exclusive linemap["modified"] = True assign_none_(linemap["statements"]) - def transform_statements(self,index_hints=[]): + def transform_statements(self,index=[]): """ Replaces original statements by generated code. Modifies the 'statements' - entries of the associated linemaps. - :param list index_hints: TBA + epilog and prolog entries of the associated linemaps. + :param list index: Index dictionary containing indexer modules/programs/top-level procedures + as entries. :note: When multiple linemaps contain the expression associated with this note, the transformed code is written into the first associated statement in the first linemap and the remaining associated statements in the first and all other linemaps are replaced by None. - :note: When prepending a preamble, it is assumed that the modified statement is the - first in the linemap/line and that this statement is only modified once. - :note: When appending an epilog, it is assumed that the modified statement is the - last in the linemap/line and that this statement is only modified once. - """ - if not self._ignore_in_s2s_translation: - have_first_in_first_linemap = self._first_statement_index == 0 - have_last_in_last_linemap = self._last_statement_index == -1 or\ - self._last_statement_index == len(self._linemaps[-1]["statements"])-1 - statements_fully_cover_lines = have_first_in_first_linemap and have_last_in_last_linemap - - joined_lines = "".join(self.lines()) - joined_statements = "\n".join(self.statements()) - transformed_code, modified = self.transform(joined_lines,joined_statements,statements_fully_cover_lines,index_hints) - if modified: - self.__modify_linemaps(transformed_code) + :note: If the node's first statement in a linemap, the node's prolog + lines are appended to the linemaps prolog field. Analogously, + the epilog is appended to the linemaps epilog field if + the node's last statement is the last statement in + the last line map. Otherwise, epilog / prolog are appended/prepended + directly to the statement. + """ + if not self.ignore_in_s2s_translation: + have_first_in_first_linemap = self._first_statement_index == 0 + have_last_in_last_linemap = self._last_statement_index == -1 or\ + self._last_statement_index == len(self._linemaps[-1]["statements"])-1 + joined_statements = "\n".join(self.statements()) + joined_lines = "".join(self.lines()) + statements_fully_cover_lines = have_first_in_first_linemap and have_last_in_last_linemap + transformed_code, transformed = \ + self.transform(joined_lines,joined_statements,statements_fully_cover_lines,index) + if transformed: + self._modify_linemaps(transformed_code) + +def decl_list_entry_filter(stnode): + """:return: If the scanner tree node is member of the declaration list.""" + return type(stnode) in [STUseStatement,STDeclaration,STPlaceHolder] + +class STContainerBase(STNode): + def first_entry_in_decl_list(self): + result = self.find_first(filter=decl_list_entry_filter) + if result == None: + return self + return result + def last_entry_in_decl_list(self): + result = self.find_last(filter=decl_list_entry_filter) + if result == None: + return self + return result + def return_or_end_statements(self): + return self.find_all(filter=lambda stnode: type(stnode) == STEndOrReturn) + def append_to_decl_list(self,lines,prepend=False): + """ + Append lines to the last statement in the declaration list. + :param list lines: The lines to append. + :param bool prepend: Prepend new lines to previously append lines. + """ + last_decl_list_node = self.last_entry_in_decl_list() + indent = last_decl_list_node.first_line_indent() + if last_decl_list_node is None: + last_decl_list_node = self + for line in lines: + last_decl_list_node.add_to_epilog("".join([indent,line]),prepend) + def append_vars_to_decl_list(self,varnames,vartype="type(c_ptr)"): + """Create and add declaration expression from `varnames` and `vartype` to declaration list + if they are not part of the declartion list yet.""" + if len(varnames): + self.append_to_decl_list(\ + [" :: ".join([vartype,name]) for name in varnames],prepend=True) + def prepend_to_return_or_end_statements(self,lines): + """ + Prepend lines to the last statement in the declaration list. + :param list lines: The lines to append. + :param bool prepend: Prepend new lines to previously append lines. + """ + indent = last_decl_list_node.first_line_indent() + for return_or_end_node in self.return_or_end_statements(): + for line in lines: + return_or_end_node.add_to_prolog(indent+line) + def tag(self): + """Construct a tag that can be used to search the index.""" + result = self.name.lower() + def recursive_parent_lookup(curr): + nonlocal result + if type(curr) != STRoot: + result = curr.name.lower() + ":" + result + recursive_parent_lookup(curr.parent) + recursive_parent_lookup(self.parent) + return result + def local_and_dummy_variable_names(self,index): + """:return: names of local variables (1st retval) and dummy variables (2nd retval).""" + # TODO can also be realised by subclass + scope = scoper.create_scope(index,self.tag()) + scope_vars = scope["variables"] + if type(self) == STProgram: + irecord = next((ientry for ientry in index if ientry["name"]==self.name),None) + dummy_arg_names = [] + else: + parent_tag = self.parent.tag() + irecord, _ = scoper.search_index_for_subprogram(index,parent_tag,self.name) + dummy_arg_names = irecord["dummy_args"] + local_var_names = [ivar["name"] for ivar in irecord["variables"] if ivar["name"] not in dummy_arg_names] + return local_var_names, dummy_arg_names class STEndOrReturn(STNode): - pass + def transform_statements(self,index=[]): + prolog = self._linemaps[0]["prolog"] + if len(prolog): + joined_statements = "\n".join(self.statements()) + indent = joined_statements[0:len(joined_statements)-len(joined_statements.lstrip())] + joined_prolog = "\n".join([indent+l.lstrip() for l in prolog]).rstrip() + transformed_code = joined_prolog + "\n" + joined_statements + self._modify_linemaps(transformed_code) + self._linemaps[0]["prolog"].clear() + -class STRoot(STNode,Tagged): +class STRoot(STContainerBase): def __init__(self): - STNode.__init__(self,None,None,-1) + STNode.__init__(self,None,-1) def tag(self): return None -class STModule(STNode,Tagged): - def __init__(self,name,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) +class STModule(STContainerBase): + def __init__(self,name,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self.name = name.lower() self.kind = "module" -class STProgram(STNode,Tagged): - def __init__(self,name,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) +class STProgram(STContainerBase): + def __init__(self,name,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self.name = name.lower() self.kind = "program" class STUseStatement(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO clean indent = self.first_line_indent() snippet = joined_statements @@ -298,26 +398,47 @@ class STUseStatement(STNode): return snippet, use_cuda class STPlaceHolder(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self.name = None -class STProcedure(STNode,Tagged): - def __init__(self,name,kind,parent,first_linemap,first_linemap_first_statement,index): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) +class STProcedure(STContainerBase): + def __init__(self,name,parent_tag,kind,first_linemap,first_linemap_first_statement,index): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self.name = name self.kind = kind self.code = [] # check attributes - self.index_record, _ = scoper.search_index_for_subprogram(index,self._parent.tag(),name) + self.index_record, _ = scoper.search_index_for_subprogram(index,parent_tag,name) + self.c_result_type = "void" + self.parse_result = None def __must_be_available_on_host(self): return not len(self.index_record["attributes"]) or\ "host" in self.index_record["attributes"] def __attributes_present(self): return len(self.index_record["attributes"]) - def complete_init(self): + def complete_init(self,index): # exclude begin/end statement of procedure - self.code = self.statements()[1:-1] # implies copy + self.code = self.statements()[1:-1] # implies copy + scope = scoper.create_scope(index,self.tag()) + iprocedure = self.index_record + + if self.is_function(): + result_name = iprocedure["result_name"] + ivar_result = next([var for var in iprocedure["variables"] if var["name"] == iprocedure["result_name"]],None) + if ivar_result != None: + self.c_result_type = ivar_result["c_type"] + self.parse_result = translator.parse_procedure_body(self.code,scope,ivar_result["name"]) + else: + msg = "could not identify return value for function ''" + utils.logging.log_error(msg) + sys.exit(2) + else: + self.c_result_type = "void" + self.parse_result = translator.parse_procedure_body(self.code,scope) + def is_function(self): + """:return: If the procedure is a function. Otherwise, it is a subroutine.""" + return self.index_record["kind"] == "function" def has_attribute(self,attribute): return attribute in self.index_record["attributes"] def is_kernel_subroutine(self): @@ -354,26 +475,21 @@ class STProcedure(STNode,Tagged): return original, False class STDirective(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement,directive_no,sentinel="!$cuf"): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - self._sentinel = sentinel + def __init__(self,first_linemap,first_linemap_first_statement,directive_no,sentinel="!$cuf"): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + self._sentinel = sentinel self._directive_no = directive_no - self._first_directive = self._linemaps[0]["statements"][0] - def single_line_statement(self): - """ - Express the statement as lower case single-line statement - """ - return self._first_directive class STLoopKernel(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self.grid_f_str = None self.block_f_str = None self.sharedmem_f_str = "0" # set from extraction routine self.stream_f_str = "c_null_ptr" # set from extraction routine self.kernel_arg_names = [] # set from extraction routine self.code = [] + self.parse_result = None self._do_loop_ctr_memorised = -1 def __hash(self): """Compute hash code for this kernel. Must be done before any transformations are performed.""" @@ -382,14 +498,17 @@ class STLoopKernel(STNode): self.remove_whitespaces(statements) snippet = "".join(statements) return hashlib.md5(snippet.encode()).hexdigest()[0:6] - def complete_init(self): - self.code = self.statements() + def complete_init(self,index=[]): + self.code = self.statements() + parent_tag = self.parent.tag() + scope = scoper.create_scope(index,parent_tag) + self.parse_result = translator.parse_loop_kernel(self.code,scope) def kernel_name(self): """Derive a name for the kernel""" - return LOOP_KERNEL_NAME_TEMPLATE.format(parent=self._parent.name.lower(),lineno=self.min_lineno(),hash=self.__hash()) + return LOOP_KERNEL_NAME_TEMPLATE.format(parent=self.parent.name.lower(),lineno=self.min_lineno(),hash=self.__hash()) def kernel_launcher_name(self): return "launch_{}".format(self.kernel_name()) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): indent = self.first_line_indent() try: stream_as_int = int(self.stream_f_str) @@ -413,13 +532,13 @@ class STDeclaration(STNode): Complex(DP), allocatable, device :: dev_array(:,:) ``` """ - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self._ttdeclaration = translator.parse_declaration(self.first_statement()) self._vars = [name.lower() for name in self._ttdeclaration.variable_names()] def create_codegen_context(self): return translator.create_index_records_from_declaration(self._ttdeclaration) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): """ if device and allocatable, remove device, add pointer if device and fixed size array, remove device, add pointer, replace fixed bounds by other bounds @@ -430,8 +549,8 @@ class STDeclaration(STNode): find first code line and add allocation to preamble if no dummy argument -> double pass if integer with stream kind, """ - if len(index_hints): - index = index_hints + if len(index): + index = index else: index = copy.copy(scoper.EMPTY) index["variables"] = self.create_codegen_context() @@ -443,14 +562,14 @@ class STDeclaration(STNode): indent = self.first_line_indent() # argument names if declared in procedure - if isinstance(self._parent, STProcedure): - argnames = list(self._parent.index_record["dummy_args"]) + if isinstance(self.parent, STProcedure): + argnames = list(self.parent.index_record["dummy_args"]) else: argnames = [] result = "" for var_name in self._vars: ivar,discovered = scoper.search_index_for_variable(\ - index,self._parent.tag(),\ + index,self.parent.tag(),\ var_name) rank = ivar["rank"] has_device = "device" in ivar["qualifiers"] @@ -488,23 +607,35 @@ class STAttributes(STNode): CUDA Fortran specific intrinsic that needs to be removed/commented out in any case. """ - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO return "", True +def index_variable_is_on_device(ivar): + return "device" in ivar["qualifiers"] + +def pinned_or_on_device(ivar): + """:return: Qualifier and if special treatment is necessary.""" + if "device" in ivar["qualifiers"]: + return "device", True + elif "pinned" in ivar["qualifiers"] : + return "pinned", True + else: + return None, False + class STNonZeroCheck(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO result = snippet transformed = False for tokens,start,end in translator.non_zero_check.scanString(result): parse_result = tokens[0] lhs_name = parse_result.lhs_f_str() - ivar,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ + ivar,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ lhs_name) - on_device = scoper.index_variable_is_on_device(ivar) + on_device = index_variable_is_on_device(ivar) transformed |= on_device if on_device: subst = parse_result.f_str() # TODO backend specific @@ -512,99 +643,71 @@ class STNonZeroCheck(STNode): return result, transformed class STAllocated(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO def repl(parse_result): var_name = parse_result.var_name() - ivar,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ + ivar,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ var_name) - on_device = scoper.index_variable_is_on_device(ivar) + on_device = index_variable_is_on_device(ivar) return (parse_result.f_str(), on_device) # TODO backend specific - result, transformed = utils.pyparsingutils.replace_all(snippet,translator.allocated,repl) + result, transformed = utils.pyparsingutils.replace_all(joined_statements,translator.allocated,repl) assert result != None return result, transformed class STAllocate(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + self.parse_result = translator.allocate.parseString(self.statements()[0])[0] + self.variable_names = self.parse_result.variable_names() + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO indent = self.first_line_indent() - def repl(parse_result): - nonlocal indent - transformed = False - bytes_per_element = [] - array_qualifiers = [] - for array_name in parse_result.variable_names(): - ivar,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ - array_name) - bytes_per_element.append(ivar["bytes_per_element"]) - on_device = scoper.index_variable_is_on_device(ivar) - pinned = ["pinned"] in ivar["qualifiers"] - if on_device: - array_qualifiers.append("device") - elif pinned: - array_qualifiers.append("pinned") - else: - array_qualifiers.append(None) - transformed |= on_device | pinned - subst = parse_result.hip_f_str(bytes_per_element,array_qualifiers,indent=indent).lstrip(" ") - return (subst, transformed) - return utils.pyparsingutils.replace_all(joined_statements,translator.allocate,repl) + result1, transformed1 = handle_allocate_cuf(self,joined_statements,index) + result2, transformed2 = handle_allocate_acc(self,result1,index) + return result2, (transformed1 or transformed2) class STDeallocate(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + self.parse_result = translator.deallocate.parseString(self.statements()[0])[0] + self.variable_names = self.parse_result.variable_names() + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO """ :note: `wrap_in_if_def` can be deactivated if a higher level function embeds the outcome already in an `ifdef`. """ - indent = self.first_line_indent() - def repl(parse_result): - nonlocal indent - transformed = False - array_qualifiers = [] - for array_name in parse_result.variable_names(): - ivar,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ - array_name) - on_device = scoper.index_variable_is_on_device(ivar) - pinned = ["pinned"] in ivar["qualifiers"] - if on_device: - array_qualifiers.append("device") - elif pinned: - array_qualifiers.append("pinned") - else: - array_qualifiers.append(None) - transformed |= on_device | pinned - subst = parse_result.hip_f_str(array_qualifiers,indent=indent).lstrip(" ") - return (subst, transformed) - return utils.pyparsingutils.replace_all(joined_statements,translator.deallocate,repl) + result1, transformed1 = handle_deallocate_cuf(self,joined_statements,index) + result2, transformed2 = handle_deallocate_acc(self,result1,index) + return result2, (transformed1 or transformed2) + class STMemcpy(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): # TODO - def repl_memcpy(parse_result): + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) + self._parse_result = translator.memcpy.parseString(self.statements()[0])[0] + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): # TODO + def repl_memcpy_(parse_result): dest_name = parse_result.dest_name_f_str() src_name = parse_result.src_name_f_str() - dest_indexed_var,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ - dest_name) - src_indexed_var,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ - src_name) - dest_on_device = scoper.index_variable_is_on_device(dest_indexed_var) - src_on_device = scoper.index_variable_is_on_device(src_indexed_var) + dest_indexed_var,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ + dest_name,error_handling="off") + src_indexed_var,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ + src_name,error_handling="off") + dest_on_device = index_variable_is_on_device(dest_indexed_var) + src_on_device = index_variable_is_on_device(src_indexed_var) bytes_per_element = dest_indexed_var["bytes_per_element"] if dest_on_device or src_on_device: subst = parse_result.hip_f_str(dest_on_device,src_on_device) return (subst,True) else: return ("",False) # no transformation; will not be considered - return utils.pyparsingutils.replace_all(joined_statements,translator.memcpy,repl_memcpy) + return repl_memcpy_(self._parse_result) + #return utils.pyparsingutils.replace_all(joined_statements,translator.memcpy,repl_memcpy) class STCudaLibCall(STNode): - def __init__(self,parent,first_linemap,first_linemap_first_statement): - STNode.__init__(self,parent,first_linemap,first_linemap_first_statement) + def __init__(self,first_linemap,first_linemap_first_statement): + STNode.__init__(self,first_linemap,first_linemap_first_statement) self._cuda_api = "" self._has_cublas = False def has_cublas(self): @@ -613,7 +716,7 @@ class STCudaLibCall(STNode): :rtype: bool """ return self._has_cublas - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): global CUBLAS_VERSION global KEEP_CUDA_LIB_NAMES snippet = joined_statements @@ -624,12 +727,12 @@ class STCudaLibCall(STNode): def repl_memcpy(parse_result): dest_name = parse_result.dest_name_f_str() src_name = parse_result.src_name_f_str() - dest_indexed_var,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ + dest_indexed_var,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ dest_name) - src_indexed_var ,_ = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ + src_indexed_var ,_ = scoper.search_index_for_variable(index,self.parent.tag(),\ src_name) - dest_on_device = scoper.index_variable_is_on_device(dest_indexed_var) - src_on_device = scoper.index_variable_is_on_device(src_indexed_var) + dest_on_device = index_variable_is_on_device(dest_indexed_var) + src_on_device = index_variable_is_on_device(src_indexed_var) subst = parse_result.hip_f_str(dest_on_device,src_on_device) return (subst, True) snippet,_ = utils.pyparsingutils.replace_all(snippet,translator.cuf_cudamemcpy_variant,repl_memcpy) @@ -651,10 +754,9 @@ class STCudaLibCall(STNode): return snippet, transformed class STCudaKernelCall(STNode): - """TODO(gpufort): Fix - Translates a CUDA kernel call to a call to a subroutine interface. + """Convers CUDA kernel calls to calls to subroutine interfaces. """ - def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index_hints=[]): + def transform(self,joined_lines,joined_statements,statements_fully_cover_lines,index=[]): snippet = joined_statements for tokens,start,end in translator.cuf_kernel_call.scanString(snippet): parse_result = tokens[0] @@ -664,7 +766,7 @@ class STCudaKernelCall(STNode): max_rank = 0 for rvalue in translator.find_all(ttexpr,translator.TTRValue): # TODO lookup the subprogram first - ivar, discovered = scoper.search_index_for_variable(index_hints,self._parent.tag(),\ + ivar, discovered = scoper.search_index_for_variable(index,self.parent.tag(),\ rvalue.name()) if discovered: max_rank = max(max_rank,ivar["rank"]) diff --git a/python/test/Makefile.in b/python/test/Makefile.in index adde049e..2b9498e9 100644 --- a/python/test/Makefile.in +++ b/python/test/Makefile.in @@ -2,24 +2,22 @@ GRAMMAR_TESTS = $(shell find . -maxdepth 1 -name "test.grammar.*.py" -execd TRANSLATOR_TESTS = $(shell find . -maxdepth 1 -name "test.translator.*.py" -execdir basename {} ';') INDEXER_TESTS = $(shell find . -maxdepth 1 -name "test.indexer.*.py" -execdir basename {} ';') LINEMAPPER_TESTS = $(shell find . -maxdepth 1 -name "test.linemapper.*.py" -execdir basename {} ';') +UTILS_TESTS = $(shell find . -maxdepth 1 -name "test.utils.*.py" -execdir basename {} ';') CUSTOM_TESTS = $(shell find . -maxdepth 1 -name "test.custom.*.py" -execdir basename {} ';') -.PHONY: $(GRAMMAR_TESTS) $(TRANSLATOR_TESTS) $(INDEXER_TESTS) $(LINEMAPPER_TESTS) $(CUSTOM_TESTS)\ - test.grammar test.translator test.indexer test.linemapper test.custom +TEST_COLLECTION_TARGETS = test.grammar test.translator test.indexer test.linemapper test.utils test.custom +TESTS = $(GRAMMAR_TESTS) $(TRANSLATOR_TESTS) $(INDEXER_TESTS) $(LINEMAPPER_TESTS) $(UTILS_TESTS) $(CUSTOM_TESTS) -all: test.grammar test.translator test.indexer test.linemapper test.custom +all: $(TEST_COLLECTION_TARGETS) -TESTS = $(GRAMMAR_TESTS) $(TRANSLATOR_TESTS) $(INDEXER_TESTS) $(LINEMAPPER_TESTS) $(CUSTOM_TESTS) +.PHONY: $(TESTS) $(TEST_COLLECTION_TARGETS) $(TESTS): %: python3 $@ -test.grammar: $(GRAMMAR_TESTS) - +test.grammar: $(GRAMMAR_TESTS) test.translator: $(TRANSLATOR_TESTS) - -test.indexer: $(INDEXER_TESTS) - +test.indexer: $(INDEXER_TESTS) test.linemapper: $(LINEMAPPER_TESTS) - -test.custom: $(CUSTOM_TESTS) +test.utils: $(UTILS_TESTS) +test.custom: $(CUSTOM_TESTS) diff --git a/python/test/grammar_translator/test.translator.declaration.py b/python/test/grammar_translator/test.translator.declaration.py new file mode 100644 index 00000000..bd507947 --- /dev/null +++ b/python/test/grammar_translator/test.translator.declaration.py @@ -0,0 +1,89 @@ +#!/usr/bin/env python3 +# SPDX-License-Identifier: MIT +# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. +import addtoplevelpath +import os,sys +import time +import unittest +import translator.translator as translator +import utils.logging + +print("Running test '{}'".format(os.path.basename(__file__)),end="",file=sys.stderr) + +log_format = "[%(levelname)s]\tgpufort:%(message)s" +log_level = "debug2" +utils.logging.VERBOSE = False +utils.logging.TRACEBACK = False +utils.logging.init_logging("log.log",log_format,log_level) + +testdata1_types = """ +real +real(c_float) +real(8) +real*8 +integer +logical +""" + +testdata1_pass = """ +{type} test +{type} test(:) +{type} test(:,:,:) +{type} test(5) +{type} test(5,6) +{type} test(n) +{type} test(n,k,c) +{type} :: test +{type},parameter :: test +{type},intent(in) :: test +{type},dimension(:) :: test +{type} :: test(:) +{type},dimension(:,:,:) :: test +{type} :: test(:,:,:) +{type},pointer :: test => null() +{type},pointer :: test(:) => null() +{type},pointer :: test(:,:,:) => null() +""" +testdata1_fail = """ +{type},parameter test +{type},intent(in) test +""" + +testdata2_pass = """ +logical test = .false. +logical :: test = .false. +logical,parameter :: test = .true. +logical,save,parameter :: test = .false. +""" + +class TestDeclaration(unittest.TestCase): + def setUp(self): + global index + self._started_at = time.time() + def tearDown(self): + elapsed = time.time() - self._started_at + print('{} ({}s)'.format(self.id(), round(elapsed, 9))) + def prepare(self,testdata): + return testdata.strip().split("\n") + def test1_pass(self): + testdata = self.prepare(testdata1_pass) + types = self.prepare(testdata1_types) + for statement in testdata: + for typ in types: + translator.parse_declaration(statement.format(type=typ)) + def test1_fail(self): + testdata = self.prepare(testdata1_pass) + types = self.prepare(testdata1_types) + for statement in testdata: + for typ in types: + try: + translator.parse_declaration(statement.format(type=typ)) + self.assertTrue(False) + except Exception as e: + return e + def test2_logicals_pass(self): + testdata = self.prepare(testdata2_pass) + for statement in testdata: + translator.parse_declaration(statement) +if __name__ == '__main__': + unittest.main() diff --git a/python/test/linemapper/test.linemapper.linemapper.py b/python/test/linemapper/test.linemapper.linemapper.py index 7662a07f..e2326c8c 100644 --- a/python/test/linemapper/test.linemapper.linemapper.py +++ b/python/test/linemapper/test.linemapper.linemapper.py @@ -16,7 +16,9 @@ index = [] -class TestIndexer(unittest.TestCase): +class TestLinemapper(unittest.TestCase): + def __clean(self,text): + return text.replace(" ","").replace("\t","").replace("\n","").replace("\r","") def setUp(self): global PROFILING_ENABLE if PROFILING_ENABLE: @@ -38,7 +40,7 @@ def test_0_donothing(self): pass def test_1_full_test(self): options = "-DCUDA -DCUDA2" - linemaps = linemapper.read_file("test1.f90",options) + linemaps = linemapper.read_file("test1.f90",options) result_lines = linemapper.render_file(linemaps,stage="lines") result_raw_statements = linemapper.render_file(linemaps,stage="raw_statements") result_statements = linemapper.render_file(linemaps,stage="statements") @@ -80,15 +82,49 @@ def test_1_full_test(self): end program main """ #print(result_lines) + #print(result_raw_statements) #print(result_statements) - #print(result_expanded_statements) - def clean_(text): - return text.replace(" ","").replace("\t","").replace("\n","").replace("\r","") - - self.assertEqual(clean_(result_lines),clean_(testdata_lines)) - self.assertEqual(clean_(result_raw_statements),clean_(testdata_raw_statements)) - self.assertEqual(clean_(result_statements),clean_(testdata_statements)) + self.assertEqual(self.__clean(result_lines),self.__clean(testdata_lines)) + self.assertEqual(self.__clean(result_raw_statements),self.__clean(testdata_raw_statements)) + self.assertEqual(self.__clean(result_statements),self.__clean(testdata_statements)) + def test_2_expand_single_line_if(self): + options = "" + linemaps = linemapper.read_file("test2.f90",options) + result_statements = linemapper.render_file(linemaps,stage="statements") + testdata_statements =\ +""" +program main +if( tha(i,j,k).gt. 1.0 ) then + thrad = -1.0/(12.0*3600.0) +endif +end program +""" + self.assertEqual(self.__clean(result_statements),self.__clean(testdata_statements)) + def test_3_collapse_multiline_acc_directive(self): + options = "" + linemaps = linemapper.read_file("test3.f90",options) + result_statements = linemapper.render_file(linemaps,stage="statements") + testdata_statements =\ +""" +program main +!$acc data copyin(a,b) copyout(c_gpu) +!$acc parallel loop collapse(2) reduction(+:tmp) +do j=1,colsB +do i=1,rowsA +tmp = 0.0 +!$acc loop vector reduction(+:tmp) +do k=1,rowsB +tmp = tmp + a(i,k) * b(k,j) +enddo +c_gpu(i,j) = tmp +enddo +enddo +!$acc end parallel +!$acc end data +end program +""" + self.assertEqual(self.__clean(result_statements),self.__clean(testdata_statements)) if __name__ == '__main__': - unittest.main() \ No newline at end of file + unittest.main() diff --git a/python/test/linemapper/test2.f90 b/python/test/linemapper/test2.f90 new file mode 100644 index 00000000..d725e3f0 --- /dev/null +++ b/python/test/linemapper/test2.f90 @@ -0,0 +1,3 @@ +program main + if( tha(i,j,k).gt. 1.0 ) thrad = -1.0/(12.0*3600.0) +end program diff --git a/python/test/linemapper/test3.f90 b/python/test/linemapper/test3.f90 new file mode 100644 index 00000000..34cd29a9 --- /dev/null +++ b/python/test/linemapper/test3.f90 @@ -0,0 +1,18 @@ +program main +!$acc data copyin(a,b) copyout(c_gpu) +!$acc parallel loop collapse(2) & +!$acc reduction(+:tmp) +do j=1,colsB +do i=1,rowsA +tmp = 0.0 +!$acc loop vector reduction(+:tmp) +do k=1,rowsB +tmp = tmp & ++ a(i,k) * b(k,j) +enddo +c_gpu(i,j) = tmp +enddo +enddo +!$acc end parallel +!$acc end data +end program diff --git a/python/test/utils/Makefile b/python/test/utils/Makefile new file mode 100644 index 00000000..170a88d2 --- /dev/null +++ b/python/test/utils/Makefile @@ -0,0 +1,6 @@ +include ../Makefile.in + +.PHONY: clean + +clean: + rm -rf *.gpufort_mod *.log __pycache__ diff --git a/python/test/utils/addtoplevelpath.py b/python/test/utils/addtoplevelpath.py new file mode 100644 index 00000000..781b0f55 --- /dev/null +++ b/python/test/utils/addtoplevelpath.py @@ -0,0 +1,4 @@ +# SPDX-License-Identifier: MIT +# Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. +import os,sys +sys.path.insert(1, os.path.join(os.path.dirname(os.path.abspath(__file__)), "../"*2)) \ No newline at end of file diff --git a/python/test/utils/test.utils.parsingutils.py b/python/test/utils/test.utils.parsingutils.py new file mode 100644 index 00000000..2b878fdd --- /dev/null +++ b/python/test/utils/test.utils.parsingutils.py @@ -0,0 +1,96 @@ +#!/usr/bin/env python3 +import time +import unittest +import cProfile,pstats,io +import json + +import addtoplevelpath +import utils.logging +import utils.parsingutils + +LOG_FORMAT = "[%(levelname)s]\tgpufort:%(message)s" +utils.logging.VERBOSE = False +utils.logging.init_logging("log.log",LOG_FORMAT,"warning") + +PROFILING_ENABLE = False + +index = [] + +testdata1 = \ +""" +! comment + ! comment +stmt_or_dir ! comment +!$acc stmt_or_dir +*$acc stmt_or_dir +c$acc stmt_or_dir +C$acc stmt_or_dir +!$ acc stmt_or_dir +! $acc comment + !a$acc comment +""" + +# whitespace at begin is important to +# as [cC] in first column indicates a comment +# line in Fortran 77. +testdata2 = \ +""" call myroutine( & ! comment 1 + arg1,& + ! comment 2 + + + arg2) ! comment 3 +""" + +testdata2_result = \ +""" call myroutine( & + arg1,& + + + arg2) + ! comment 1 + ! comment 2 + ! comment 3 +""" + +class TestParsingUtils(unittest.TestCase): + def prepare(self,text): + return text.strip().split("\n") + def clean(self,text): + return text.replace(" ","").replace("\t","").replace("\n","").replace("\r","") + def setUp(self): + global PROFILING_ENABLE + if PROFILING_ENABLE: + self._profiler = cProfile.Profile() + self._profiler.enable() + self._started_at = time.time() + def tearDown(self): + global PROFILING_ENABLE + if PROFILING_ENABLE: + self._profiler.disable() + s = io.StringIO() + sortby = 'cumulative' + stats = pstats.Stats(self._profiler, stream=s).sort_stats(sortby) + stats.print_stats(10) + print(s.getvalue()) + elapsed = time.time() - self._started_at + print('{} ({}s)'.format(self.id(), round(elapsed, 6))) + def test_1_split_fortran_line(self): + for line in self.prepare(testdata1): + indent,stmt_or_dir,comment,trailing_ws =\ + utils.parsingutils.split_fortran_line(line) + if "stmt_or_dir" in line: + self.assertTrue(len(stmt_or_dir)) + else: + self.assertFalse(len(stmt_or_dir)) + if "comment" in line: + self.assertTrue(len(comment)) + else: + self.assertFalse(len(comment)) + # + def test_2_relocate_inline_comments(self): + result = utils.parsingutils.relocate_inline_comments(\ + testdata2.split("\n")) + self.assertEqual(self.clean("\n".join(result)),self.clean(testdata2_result)) +if __name__ == '__main__': + unittest.main() diff --git a/python/translator/translator_acc.py.in b/python/translator/translator_acc.py.in index c83a7adb..82cf1194 100644 --- a/python/translator/translator_acc.py.in +++ b/python/translator/translator_acc.py.in @@ -41,10 +41,8 @@ class TTAccClauseSelf(TTNode): return make_f_str(self._condition) class TTAccMappingClause(TTNode): def _assign_fields(self,tokens): - self._kind = tokens[0] + self.kind = tokens[0] self._var_list = tokens[1].asList() - def kind(self): - return self._kind def var_names(self,converter=make_f_str): return [ var.var_name(converter) for var in self._var_list ] def var_expressions(self,converter=make_f_str): @@ -102,7 +100,7 @@ class TTAccDirectiveBase(TTNode): result = [] for clause in self._clauses: if type(clause) == TTAccMappingClause and\ - clause.kind() in clause_kinds: + clause.kind in clause_kinds: result += clause.var_expressions() return result def _format(self,f_snippet): @@ -554,4 +552,4 @@ acc_parallel.setParseAction(TTAccParallel) acc_parallel_loop.setParseAction(TTAccParallelLoop) acc_kernels_loop.setParseAction(TTAccKernelsLoop) -ACC_END_DATA.setParseAction(TTAccEndData) \ No newline at end of file +ACC_END_DATA.setParseAction(TTAccEndData) diff --git a/python/translator/translator_api.py.in b/python/translator/translator_api.py.in index cdf0ba4d..f8741fb2 100644 --- a/python/translator/translator_api.py.in +++ b/python/translator/translator_api.py.in @@ -195,7 +195,7 @@ def parse_attributes(ttattributes): # TODO parsing and translation is similar but analysis differs between the different kernel # types. For example for CUF, the reduction vars must be detected by the parser (lhs scalars) # while they are specified with ACC,OMP. -def parse_loop_kernel(fortran_statements,scope=[]): +def parse_loop_kernel(fortran_statements,scope=None): """ Return a csnippet equivalent to the original Fortran code. """ @@ -206,7 +206,7 @@ def parse_loop_kernel(fortran_statements,scope=[]): ttloopkernel.scope = scope return ttloopkernel -def parse_procedure_body(fortran_statements,scope=[],result_name=""): +def parse_procedure_body(fortran_statements,scope=None,result_name=""): """ Parse a function/subroutine body. """ @@ -218,4 +218,4 @@ def parse_procedure_body(fortran_statements,scope=[],result_name=""): ttprocedurebody.scope = scope ttprocedurebody.result_name = result_name - return ttprocedurebody \ No newline at end of file + return ttprocedurebody diff --git a/python/translator/translator_directives.py.in b/python/translator/translator_directives.py.in index 221fffdf..ab30ace3 100644 --- a/python/translator/translator_directives.py.in +++ b/python/translator/translator_directives.py.in @@ -33,25 +33,25 @@ def _intrnl_search_values_in_subtree(ttnode,search_filter,scope,min_rank=-1): tags.append(tag) return tags -def _intrnl_variables_in_subtree(ttnode,scope=[]): +def _intrnl_variables_in_subtree(ttnode,scope): """:return: all identifiers of LValue and RValues in the body.""" def search_filter(node): return isinstance(node, IValue) and\ type(node._value) in [TTDerivedTypeMember,TTIdentifier,TTFunctionCallOrTensorAccess] result = _intrnl_search_values_in_subtree(ttnode,search_filter,scope) return result -def _intrnl_arrays_in_subtree(ttnode,scope=[]): +def _intrnl_arrays_in_subtree(ttnode,scope): def search_filter(node): return isinstance(node,IValue) and\ type(node._value) is TTFunctionCallOrTensorAccess return _intrnl_search_values_in_subtree(ttnode,search_filter,scope,1) -def _intrnl_inout_arrays_in_subtree(ttnode,scope=[]): +def _intrnl_inout_arrays_in_subtree(ttnode,scope): def search_filter(node): return type(node) is TTLValue and\ type(node._value) is TTFunctionCallOrTensorAccess return _intrnl_search_values_in_subtree(ttnode,search_filter,scope,1) -def _intrnl_flag_tensors(ttcontainer,scope=[]): +def _intrnl_flag_tensors(ttcontainer,scope): """Clarify types of function calls / tensor access that are not members of a struct.""" for value in find_all(ttcontainer.body,IValue): if type(value._value) is TTFunctionCallOrTensorAccess: @@ -173,15 +173,15 @@ class IComputeConstruct(): def gang_team_reductions(self,converter=make_f_str): """ CUF,ACC: all scalars are private by default """ return {} - def variables_in_body(self,scope=[]): + def variables_in_body(self): return [] - def arrays_in_body(self,scope=[]): + def arrays_in_body(self): return [] - def inout_arrays_in_body(self,scope=[]): + def inout_arrays_in_body(self): return [] def local_scalars(self): return [] - def reduction_candidates(self,scope=[]): + def reduction_candidates(self): return [] def loop_vars(self): return [] @@ -208,7 +208,7 @@ class IComputeConstruct(): def self_condition(self): """ OMP,ACC: run on current CPU / device (and do not offload) """ return "" - def deviceptrs(self,scope=[]): + def deviceptrs(self,scope): return [] def create_alloc_vars(self): return [] @@ -232,6 +232,25 @@ class IComputeConstruct(): def detach_vars(self): """ only ACC """ return [] + def all_mapped_arrays(self): + """:return: Name of all mapped variables. """ + result = [] + result += self.deviceptrs() + result += self.create_alloc_vars() + result += self.no_create_vars() + result += self.present_vars() + result += self.delete_release_vars() + result += self.copy_map_to_from_vars() + result += self.copyin_map_to_vars() + result += self.copyout_map_from_vars() + result += self.attach_vars() + result += self.detach_vars() + return result + def all_unmapped_arrays(self): + """:return: Name of all unmapped array variables""" + mapped_vars = self.all_mapped_arrays() + arrays_in_body = self.arrays_in_body() + return [ var for var in arrays_in_body if not var in mapped_vars ] def present_by_default(self): """ only ACC parallel """ return True @@ -261,17 +280,11 @@ class TTLoopKernel(TTContainer,IComputeConstruct): return identifier_names[0:num_outer_loops_to_map] else: return identifier_names - def variables_in_body(self,scope=[]): - if len(scope): - self.scope = scope + def variables_in_body(self): return _intrnl_variables_in_subtree(self,self.scope) - def arrays_in_body(self,scope=[]): - if len(scope): - self.scope = scope + def arrays_in_body(self): return _intrnl_arrays_in_subtree(self,self.scope) - def inout_arrays_in_body(self,scope=[]): - if len(scope): - self.scope = scope + def inout_arrays_in_body(self): return _intrnl_inout_arrays_in_subtree(self,self.scope) def __local_scalars_and_reduction_candidates(self,scope): """ @@ -316,14 +329,10 @@ class TTLoopKernel(TTContainer,IComputeConstruct): if var.lower() in loop_vars: local_scalars.remove(var) return local_scalars, reduction_candidates - def local_scalars(self,scope=[]): - if len(scope): - self.scope = scope + def local_scalars(self): local_scalars,_ = self.__local_scalars_and_reduction_candidates(self.scope) return local_scalars - def reduction_candidates(self,scope=[]): - if len(scope): - self.scope = scope + def reduction_candidates(self): _,reduction_candidates = self.__local_scalars_and_reduction_candidates(self.scope) return reduction_candidates def problem_size(self): @@ -358,9 +367,9 @@ class TTLoopKernel(TTContainer,IComputeConstruct): return self.__parent_directive().if_condition() def self_condition(self): return self.__parent_directive().self_condition - def deviceptrs(self,scope=[]): + def deviceptrs(self): if self.__parent_directive().all_arrays_are_on_device(): - return self.arrays_in_body(scope) + return self.arrays_in_body() else: return self.__parent_directive().deviceptrs() def create_alloc_vars(self): @@ -542,20 +551,14 @@ class TTProcedureBody(TTContainer): self.body = tokens self.scope = [] self.result_name = "" - def variables_in_body(self,scope=[]): + def variables_in_body(self): """ :return: all identifiers of LValue and RValues in the body. """ - if len(scope): - self.scope = scope return _intrnl_variables_in_subtree(self,self.scope) - def arrays_in_body(self,scope=[]): - if len(scope): - self.scope = scope + def arrays_in_body(self): return _intrnl_arrays_in_subtree(self,self.scope) - def inout_arrays_in_body(self,scope=[]): - if len(scope): - self.scope = scope + def inout_arrays_in_body(self): return _intrnl_inout_arrays_in_subtree(self,self.scope) def c_str(self): """ diff --git a/python/translator/translator_f03.py.in b/python/translator/translator_f03.py.in index 697e8e15..e6dfd2ef 100644 --- a/python/translator/translator_f03.py.in +++ b/python/translator/translator_f03.py.in @@ -469,7 +469,7 @@ class TTPower(TTNode): self._base, self._exp = tokens def children(self): return [ self._base, self._exp ] - def gpufort_f_str(self,scope=[]): + def gpufort_f_str(self,scope=None): sign = "" base = self._base if type(self._base) is TTRValue: diff --git a/python/translator/translator_parser.py.in b/python/translator/translator_parser.py.in index b133251f..027d4aa7 100644 --- a/python/translator/translator_parser.py.in +++ b/python/translator/translator_parser.py.in @@ -8,7 +8,7 @@ def _intrnl_preprocess_fortran_statement(statement): result = power.transformString(result) return result -def _intrnl_parse_fortran_code(statements,scope=[]): +def _intrnl_parse_fortran_code(statements,scope=None): """ :param list for diff --git a/python/utils/parsingutils.py b/python/utils/parsingutils.py index 56a9927b..f6c84435 100644 --- a/python/utils/parsingutils.py +++ b/python/utils/parsingutils.py @@ -1,5 +1,80 @@ import re +COMMENT_CHARS="!cCdD*" + +def split_fortran_line(line): + global COMMENT_CHARS + + """Decomposes a Fortran line into preceding whitespace, + statement part, comment part, and trailing whitespace (including newline char). + """ + len_line = len(line) + len_preceding_ws = len_line-len(line.lstrip(" \n\t")) + len_trailing_ws = len_line-len(line.rstrip(" \n\t")) + content = line[len_preceding_ws:len_line-len_trailing_ws] + + statement = "" + comment = "" + if len(content): + if len_preceding_ws == 0 and content[0] in COMMENT_CHARS or\ + content[0] == "!": + if len(content) > 1 and content[1] == "$": + statement = content + else: + comment = content + else: + content_parts = content.split("!",maxsplit=1) + if len(content_parts) > 0: + statement = content_parts[0] + if len(content_parts) == 2: + comment = "!"+content_parts[1] + preceding_ws = line[0:len_preceding_ws] + trailing_ws = line[len_line-len_trailing_ws:] + return preceding_ws, statement.rstrip(" \t"), comment, trailing_ws + +def relocate_inline_comments(lines): + """Move comments that follow after a line continuation char ('&') + before the + Example. Input: + + ``` + call myroutine( & ! comment 1 + arg1,& + ! comment 2 + + + arg2) ! comment 3 + ``` + Output: + ``` + call myroutine( & + arg1,& + arg2) + ! comment 1 + ! comment 2 + ! comment 3 + ``` + """ + result = [] + comment_buffer = [] + in_multiline_statement = False + for line in lines: + indent,stmt_or_dir,comment,trailing_ws = \ + split_fortran_line(line) + if len(stmt_or_dir) and stmt_or_dir[-1] == "&": + in_multiline_statement = True + if in_multiline_statement and len(comment): + if len(stmt_or_dir): + result.append("".join([indent,stmt_or_dir,trailing_ws])) + comment_buffer.append("".join([indent,comment,trailing_ws])) + else: + result.append(line) + if len(stmt_or_dir) and stmt_or_dir[-1] != "&": + result += comment_buffer + comment_buffer.clear() + in_multiline_statement = False + return result + def tokenize(statement,padded_size=0): """Splits string at whitespaces and substrings such as 'end', '$', '!', '(', ')', '=>', '=', ',' and "::". @@ -9,7 +84,9 @@ def tokenize(statement,padded_size=0): Disable padding by specifying value <= 0. """ TOKENS_REMOVE = r"\s+|\t+" - TOKENS_KEEP = r"(end|else|!\$?|(c|\*)\$|[(),]|::?|=>?|<<<|>>>|(<|>)=?|(/|=)=|\+|-|\*|/|(\.\w+\.))" + TOKENS_KEEP = r"(end|else|!\$?|[c\*]\$|[(),]|::?|=>?|<<<|>>>|[<>]=?|[/=]=|\+|-|\*|/|\.\w+\.)" + # IMPORTANT: Use non-capturing groups (?:) to ensure that an inner group in TOKENS_KEEP + # is not captured. tokens1 = re.split(TOKENS_REMOVE,statement) tokens = [] diff --git a/runtime/README.md b/runtime/README.md index 3702a1db..6516495a 100644 --- a/runtime/README.md +++ b/runtime/README.md @@ -19,14 +19,15 @@ `hipfort` API calls or `GPUFORT` kernel launch routines. * Examples are likely outdated -* This directory further contains `gpufort_acc_runtime`, a minimal non-standard-compliant runtime written completely - in Fortran, which can be used for teaching/training or prototyping. - +* This directory further contains `gpufort_acc_runtime`, a minimal non-standard-compliant runtime written + mostly in Fortran, which we use for prototyping and characterizing application runtime behavior. + Long term, we plan to rewrite this runtime in C++ or abandon it for a better alternative. + Features: * `hipStream` instances can be obtained from the runtime. Limitations: - * Not thread-safe - * No standard-compliant runtime API (might change in the future) + * No thread-safe access (unless all required arrays are present) + * No standard-compliant runtime API (might change long term) ## Runtime subfolders diff --git a/runtime/examples/gpufort_acc_runtime/Makefile b/runtime/examples/gpufort_acc_runtime/Makefile deleted file mode 100644 index 791355f9..00000000 --- a/runtime/examples/gpufort_acc_runtime/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -FOPTS ?= -std=f2008 -ffree-line-length-none - -GPUFORT_ACC_DIR = $(shell gpufort --path)/runtime/gpufort_acc_runtime -ACC_INC = -I$(GPUFORT_ACC_DIR)/include -ACC_LIB = -L$(GPUFORT_ACC_DIR)/lib -lgpufort_acc - -.PHONY: nested-scope multi-module-test clean all - -all: nested-scope multi-module-test - -nested-scope: clean - cd $@ && hipfc test_acc.f90 -o test_acc $(FOPTS) $(ACC_INC) $(ACC_LIB) - cd $@ && HIP_TRACE_API=1 ./test_acc - -multi-module-test: clean - cd $@ && hipfc test_acc.f90 -o test_acc $(FOPTS) $(ACC_INC) $(ACC_LIB) - cd $@ && ./test_acc - -clean: - cd nested-scope && rm -f *.o *.mod test_acc - cd multi-module-test && rm -f *.o *.mod test_acc diff --git a/runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc b/runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc deleted file mode 100755 index 72f8c951..00000000 Binary files a/runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc and /dev/null differ diff --git a/runtime/examples/gpufort_acc_runtime/nested-scope/test_acc b/runtime/examples/gpufort_acc_runtime/nested-scope/test_acc deleted file mode 100755 index 611ec01e..00000000 Binary files a/runtime/examples/gpufort_acc_runtime/nested-scope/test_acc and /dev/null differ diff --git a/runtime/gpufort_acc_runtime/Makefile b/runtime/gpufort_acc_runtime/Makefile index 1ee9227a..60d76cf6 100644 --- a/runtime/gpufort_acc_runtime/Makefile +++ b/runtime/gpufort_acc_runtime/Makefile @@ -1,21 +1,20 @@ include rules.mk -.PHONY: build codegen all clean +.PHONY: build codegen lib/$(LIBGPUFORT_ACC) clean + +lib/$(LIBGPUFORT_ACC): | codegen build + +codegen: + python3 codegen.py src/gpufort_acc_runtime.template.f90 -d 7 build: mkdir -p lib/ mkdir -p include/ - make -C src/ libgpufort_acc.a + make -C src/ $(LIBGPUFORT_ACC) mv src/*.mod include/ - mv src/libgpufort_acc.a lib/ + mv src/$(LIBGPUFORT_ACC) lib/ make -C src/ clean -codegen: - cd codegen && python3 ./model.py - cp codegen/gpufort_acc_runtime.f90 src/gpufort_acc_runtime.f90 - -all: | codegen build - clean: make -C src/ clean rm -rf include/ lib/ diff --git a/runtime/gpufort_acc_runtime/codegen/model.py b/runtime/gpufort_acc_runtime/codegen.py similarity index 64% rename from runtime/gpufort_acc_runtime/codegen/model.py rename to runtime/gpufort_acc_runtime/codegen.py index a86728cf..e30cb519 100644 --- a/runtime/gpufort_acc_runtime/codegen/model.py +++ b/runtime/gpufort_acc_runtime/codegen.py @@ -1,10 +1,11 @@ #!/usr/bin/env python3 import os import pprint +import argparse import jinja2 -class BaseModel(): +class Model(): def __init__(self,template): self._template = template def generate_code(self,context={}): @@ -21,12 +22,18 @@ def generate_file(self,output_file_path,context={}): with open(output_file_path, "w") as output: output.write(self.generate_code(context)) -class GpufortAccRuntimeModuleModel(BaseModel): - def __init__(self): - BaseModel.__init__(self,"templates/gpufort_acc_runtime.template.f") +def parse_cl_args(): + parser = argparse.ArgumentParser(description="Codegenerator") + parser.add_argument("input",type=str,help="Path to template file. (in format: .template.") + parser.add_argument("-d","--max-dims",type=int,dest="max_dims",help="Maximum number of array dimensions to support.") + return parser.parse_args() if __name__ == "__main__": - maxDims = 7 + args = parse_cl_args() + + max_dims = args.max_dims + template_path = args.input + outfile_path = template_path.replace(".template","") datatypes = [\ ["l","1","logical"], \ @@ -34,8 +41,8 @@ def __init__(self): ["r4","4","real(4)"], ["r8","8","real(8)"], \ ["c4","2*4","complex(4)"],["c8","2*8","complex(8)"] \ ] - dimensions = range(0,maxDims+1) + dimensions = range(0,max_dims+1) context = { "datatypes" : datatypes, "dimensions" : dimensions } - - GpufortAccRuntimeModuleModel().\ - generate_file("gpufort_acc_runtime.f90",context) + + Model(template_path).\ + generate_file(outfile_path,context) diff --git a/runtime/gpufort_acc_runtime/codegen/gpufort_acc_runtime.f90 b/runtime/gpufort_acc_runtime/codegen/gpufort_acc_runtime.f90 deleted file mode 100644 index f40692d0..00000000 --- a/runtime/gpufort_acc_runtime/codegen/gpufort_acc_runtime.f90 +++ /dev/null @@ -1,5957 +0,0 @@ -! SPDX-License-Identifier: MIT -! Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. - -! TODO not thread-safe, make use of OMP_LIB module if this becomes a problem - -! TODO will be slow for large pointer storages -! If this becomes an issue, use faster data structures or bind the public interfaces to -! a faster C runtime - -module gpufort_acc_runtime - use gpufort_acc_runtime_base - - !> copyin( list ) parallel, kernels, serial, data, enter data, - !> declare - !> When entering the region or at an enter data directive, - !> if the data in list is already present on the current device, the - !> appropriate reference count is incremented and that copy is - !> used. Otherwise, it allocates device memory and copies the - !> values from the encountering thread and sets the appropriate - !> reference count to one. When exiting the region the structured - !> reference count is decremented. If both reference counts are - !> zero, the device memory is deallocated. - interface gpufort_acc_copyin - module procedure gpufort_acc_copyin_b,gpufort_acc_copyin_l_0,gpufort_acc_copyin_l_1,gpufort_acc_copyin_l_2,gpufort_acc_copyin_l_3,gpufort_acc_copyin_l_4,gpufort_acc_copyin_l_5,gpufort_acc_copyin_l_6,gpufort_acc_copyin_l_7,gpufort_acc_copyin_i4_0,gpufort_acc_copyin_i4_1,gpufort_acc_copyin_i4_2,gpufort_acc_copyin_i4_3,gpufort_acc_copyin_i4_4,gpufort_acc_copyin_i4_5,gpufort_acc_copyin_i4_6,gpufort_acc_copyin_i4_7,gpufort_acc_copyin_i8_0,gpufort_acc_copyin_i8_1,gpufort_acc_copyin_i8_2,gpufort_acc_copyin_i8_3,gpufort_acc_copyin_i8_4,gpufort_acc_copyin_i8_5,gpufort_acc_copyin_i8_6,gpufort_acc_copyin_i8_7,gpufort_acc_copyin_r4_0,gpufort_acc_copyin_r4_1,gpufort_acc_copyin_r4_2,gpufort_acc_copyin_r4_3,gpufort_acc_copyin_r4_4,gpufort_acc_copyin_r4_5,gpufort_acc_copyin_r4_6,gpufort_acc_copyin_r4_7,gpufort_acc_copyin_r8_0,gpufort_acc_copyin_r8_1,gpufort_acc_copyin_r8_2,gpufort_acc_copyin_r8_3,gpufort_acc_copyin_r8_4,gpufort_acc_copyin_r8_5,gpufort_acc_copyin_r8_6,gpufort_acc_copyin_r8_7,gpufort_acc_copyin_c4_0,gpufort_acc_copyin_c4_1,gpufort_acc_copyin_c4_2,gpufort_acc_copyin_c4_3,gpufort_acc_copyin_c4_4,gpufort_acc_copyin_c4_5,gpufort_acc_copyin_c4_6,gpufort_acc_copyin_c4_7,gpufort_acc_copyin_c8_0,gpufort_acc_copyin_c8_1,gpufort_acc_copyin_c8_2,gpufort_acc_copyin_c8_3,gpufort_acc_copyin_c8_4,gpufort_acc_copyin_c8_5,gpufort_acc_copyin_c8_6,gpufort_acc_copyin_c8_7 - end interface - - !> copyout( list ) parallel, kernels, serial, data, exit data, - !> declare - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, it allocates device memory and - !> sets the structured reference count to one. At an exit data - !> directive with no finalize clause or when exiting the region, - !> the appropriate reference count is decremented. At an exit - !> data directive with a finalize clause, the dynamic reference - !> count is set to zero. In any case, if both reference counts are zero, - !> the data is copied from device memory to the encountering - !> thread and the device memory is deallocated. - interface gpufort_acc_copyout - module procedure gpufort_acc_copyout_b,gpufort_acc_copyout_l_0,gpufort_acc_copyout_l_1,gpufort_acc_copyout_l_2,gpufort_acc_copyout_l_3,gpufort_acc_copyout_l_4,gpufort_acc_copyout_l_5,gpufort_acc_copyout_l_6,gpufort_acc_copyout_l_7,gpufort_acc_copyout_i4_0,gpufort_acc_copyout_i4_1,gpufort_acc_copyout_i4_2,gpufort_acc_copyout_i4_3,gpufort_acc_copyout_i4_4,gpufort_acc_copyout_i4_5,gpufort_acc_copyout_i4_6,gpufort_acc_copyout_i4_7,gpufort_acc_copyout_i8_0,gpufort_acc_copyout_i8_1,gpufort_acc_copyout_i8_2,gpufort_acc_copyout_i8_3,gpufort_acc_copyout_i8_4,gpufort_acc_copyout_i8_5,gpufort_acc_copyout_i8_6,gpufort_acc_copyout_i8_7,gpufort_acc_copyout_r4_0,gpufort_acc_copyout_r4_1,gpufort_acc_copyout_r4_2,gpufort_acc_copyout_r4_3,gpufort_acc_copyout_r4_4,gpufort_acc_copyout_r4_5,gpufort_acc_copyout_r4_6,gpufort_acc_copyout_r4_7,gpufort_acc_copyout_r8_0,gpufort_acc_copyout_r8_1,gpufort_acc_copyout_r8_2,gpufort_acc_copyout_r8_3,gpufort_acc_copyout_r8_4,gpufort_acc_copyout_r8_5,gpufort_acc_copyout_r8_6,gpufort_acc_copyout_r8_7,gpufort_acc_copyout_c4_0,gpufort_acc_copyout_c4_1,gpufort_acc_copyout_c4_2,gpufort_acc_copyout_c4_3,gpufort_acc_copyout_c4_4,gpufort_acc_copyout_c4_5,gpufort_acc_copyout_c4_6,gpufort_acc_copyout_c4_7,gpufort_acc_copyout_c8_0,gpufort_acc_copyout_c8_1,gpufort_acc_copyout_c8_2,gpufort_acc_copyout_c8_3,gpufort_acc_copyout_c8_4,gpufort_acc_copyout_c8_5,gpufort_acc_copyout_c8_6,gpufort_acc_copyout_c8_7 - end interface - - !> copy( list ) parallel, kernels, serial, data, declare - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, it allocates device memory - !> and copies the values from the encountering thread and sets - !> the structured reference count to one. When exiting the region, - !> the structured reference count is decremented. If both reference - !> counts are zero, the data is copied from device memory to the - !> encountering thread and the device memory is deallocated. - interface gpufort_acc_copy - module procedure gpufort_acc_copy_b,gpufort_acc_copy_l_0,gpufort_acc_copy_l_1,gpufort_acc_copy_l_2,gpufort_acc_copy_l_3,gpufort_acc_copy_l_4,gpufort_acc_copy_l_5,gpufort_acc_copy_l_6,gpufort_acc_copy_l_7,gpufort_acc_copy_i4_0,gpufort_acc_copy_i4_1,gpufort_acc_copy_i4_2,gpufort_acc_copy_i4_3,gpufort_acc_copy_i4_4,gpufort_acc_copy_i4_5,gpufort_acc_copy_i4_6,gpufort_acc_copy_i4_7,gpufort_acc_copy_i8_0,gpufort_acc_copy_i8_1,gpufort_acc_copy_i8_2,gpufort_acc_copy_i8_3,gpufort_acc_copy_i8_4,gpufort_acc_copy_i8_5,gpufort_acc_copy_i8_6,gpufort_acc_copy_i8_7,gpufort_acc_copy_r4_0,gpufort_acc_copy_r4_1,gpufort_acc_copy_r4_2,gpufort_acc_copy_r4_3,gpufort_acc_copy_r4_4,gpufort_acc_copy_r4_5,gpufort_acc_copy_r4_6,gpufort_acc_copy_r4_7,gpufort_acc_copy_r8_0,gpufort_acc_copy_r8_1,gpufort_acc_copy_r8_2,gpufort_acc_copy_r8_3,gpufort_acc_copy_r8_4,gpufort_acc_copy_r8_5,gpufort_acc_copy_r8_6,gpufort_acc_copy_r8_7,gpufort_acc_copy_c4_0,gpufort_acc_copy_c4_1,gpufort_acc_copy_c4_2,gpufort_acc_copy_c4_3,gpufort_acc_copy_c4_4,gpufort_acc_copy_c4_5,gpufort_acc_copy_c4_6,gpufort_acc_copy_c4_7,gpufort_acc_copy_c8_0,gpufort_acc_copy_c8_1,gpufort_acc_copy_c8_2,gpufort_acc_copy_c8_3,gpufort_acc_copy_c8_4,gpufort_acc_copy_c8_5,gpufort_acc_copy_c8_6,gpufort_acc_copy_c8_7 - end interface - - !> create( list ) parallel, kernels, serial, data, enter data, - !> declare - !> When entering the region or at an enter data directive, - !> if the data in list is already present on the current device, the - !> appropriate reference count is incremented and that copy - !> is used. Otherwise, it allocates device memory and sets the - !> appropriate reference count to one. When exiting the region, - !> the structured reference count is decremented. If both reference - !> counts are zero, the device memory is deallocated. - interface gpufort_acc_create - module procedure gpufort_acc_create_b,gpufort_acc_create_l_0,gpufort_acc_create_l_1,gpufort_acc_create_l_2,gpufort_acc_create_l_3,gpufort_acc_create_l_4,gpufort_acc_create_l_5,gpufort_acc_create_l_6,gpufort_acc_create_l_7,gpufort_acc_create_i4_0,gpufort_acc_create_i4_1,gpufort_acc_create_i4_2,gpufort_acc_create_i4_3,gpufort_acc_create_i4_4,gpufort_acc_create_i4_5,gpufort_acc_create_i4_6,gpufort_acc_create_i4_7,gpufort_acc_create_i8_0,gpufort_acc_create_i8_1,gpufort_acc_create_i8_2,gpufort_acc_create_i8_3,gpufort_acc_create_i8_4,gpufort_acc_create_i8_5,gpufort_acc_create_i8_6,gpufort_acc_create_i8_7,gpufort_acc_create_r4_0,gpufort_acc_create_r4_1,gpufort_acc_create_r4_2,gpufort_acc_create_r4_3,gpufort_acc_create_r4_4,gpufort_acc_create_r4_5,gpufort_acc_create_r4_6,gpufort_acc_create_r4_7,gpufort_acc_create_r8_0,gpufort_acc_create_r8_1,gpufort_acc_create_r8_2,gpufort_acc_create_r8_3,gpufort_acc_create_r8_4,gpufort_acc_create_r8_5,gpufort_acc_create_r8_6,gpufort_acc_create_r8_7,gpufort_acc_create_c4_0,gpufort_acc_create_c4_1,gpufort_acc_create_c4_2,gpufort_acc_create_c4_3,gpufort_acc_create_c4_4,gpufort_acc_create_c4_5,gpufort_acc_create_c4_6,gpufort_acc_create_c4_7,gpufort_acc_create_c8_0,gpufort_acc_create_c8_1,gpufort_acc_create_c8_2,gpufort_acc_create_c8_3,gpufort_acc_create_c8_4,gpufort_acc_create_c8_5,gpufort_acc_create_c8_6,gpufort_acc_create_c8_7 - end interface - - !> no_create( list ) parallel, kernels, serial, data - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, no action is performed and any - !> device code in the construct will use the local memory address - !> for that data. - interface gpufort_acc_no_create - module procedure gpufort_acc_no_create_b,gpufort_acc_no_create_l_0,gpufort_acc_no_create_l_1,gpufort_acc_no_create_l_2,gpufort_acc_no_create_l_3,gpufort_acc_no_create_l_4,gpufort_acc_no_create_l_5,gpufort_acc_no_create_l_6,gpufort_acc_no_create_l_7,gpufort_acc_no_create_i4_0,gpufort_acc_no_create_i4_1,gpufort_acc_no_create_i4_2,gpufort_acc_no_create_i4_3,gpufort_acc_no_create_i4_4,gpufort_acc_no_create_i4_5,gpufort_acc_no_create_i4_6,gpufort_acc_no_create_i4_7,gpufort_acc_no_create_i8_0,gpufort_acc_no_create_i8_1,gpufort_acc_no_create_i8_2,gpufort_acc_no_create_i8_3,gpufort_acc_no_create_i8_4,gpufort_acc_no_create_i8_5,gpufort_acc_no_create_i8_6,gpufort_acc_no_create_i8_7,gpufort_acc_no_create_r4_0,gpufort_acc_no_create_r4_1,gpufort_acc_no_create_r4_2,gpufort_acc_no_create_r4_3,gpufort_acc_no_create_r4_4,gpufort_acc_no_create_r4_5,gpufort_acc_no_create_r4_6,gpufort_acc_no_create_r4_7,gpufort_acc_no_create_r8_0,gpufort_acc_no_create_r8_1,gpufort_acc_no_create_r8_2,gpufort_acc_no_create_r8_3,gpufort_acc_no_create_r8_4,gpufort_acc_no_create_r8_5,gpufort_acc_no_create_r8_6,gpufort_acc_no_create_r8_7,gpufort_acc_no_create_c4_0,gpufort_acc_no_create_c4_1,gpufort_acc_no_create_c4_2,gpufort_acc_no_create_c4_3,gpufort_acc_no_create_c4_4,gpufort_acc_no_create_c4_5,gpufort_acc_no_create_c4_6,gpufort_acc_no_create_c4_7,gpufort_acc_no_create_c8_0,gpufort_acc_no_create_c8_1,gpufort_acc_no_create_c8_2,gpufort_acc_no_create_c8_3,gpufort_acc_no_create_c8_4,gpufort_acc_no_create_c8_5,gpufort_acc_no_create_c8_6,gpufort_acc_no_create_c8_7 - end interface - - !> The delete clause may appear on exit data directives. - !> - !> For each var in varlist, if var is in shared memory, no action is taken; if var is not in shared memory, - !> the delete clause behaves as follows: - !> If var is not present in the current device memory, a runtime error is issued. - !> Otherwise, the dynamic reference counter is updated: - !> On an exit data directive with a finalize clause, the dynamic reference counter - !> is set to zero. - !> Otherwise, a present decrement action with the dynamic reference counter is performed. - !> If var is a pointer reference, a detach action is performed. If both structured and dynamic - !> reference counters are zero, a delete action is performed. - !> An exit data directive with a delete clause and with or without a finalize clause is - !> functionally equivalent to a call to - !> the acc_delete_finalize or acc_delete API routine, respectively, as described in Section 3.2.23. - !> - !> \note use - interface gpufort_acc_delete - module procedure gpufort_acc_delete_b,gpufort_acc_delete_l_0,gpufort_acc_delete_l_1,gpufort_acc_delete_l_2,gpufort_acc_delete_l_3,gpufort_acc_delete_l_4,gpufort_acc_delete_l_5,gpufort_acc_delete_l_6,gpufort_acc_delete_l_7,gpufort_acc_delete_i4_0,gpufort_acc_delete_i4_1,gpufort_acc_delete_i4_2,gpufort_acc_delete_i4_3,gpufort_acc_delete_i4_4,gpufort_acc_delete_i4_5,gpufort_acc_delete_i4_6,gpufort_acc_delete_i4_7,gpufort_acc_delete_i8_0,gpufort_acc_delete_i8_1,gpufort_acc_delete_i8_2,gpufort_acc_delete_i8_3,gpufort_acc_delete_i8_4,gpufort_acc_delete_i8_5,gpufort_acc_delete_i8_6,gpufort_acc_delete_i8_7,gpufort_acc_delete_r4_0,gpufort_acc_delete_r4_1,gpufort_acc_delete_r4_2,gpufort_acc_delete_r4_3,gpufort_acc_delete_r4_4,gpufort_acc_delete_r4_5,gpufort_acc_delete_r4_6,gpufort_acc_delete_r4_7,gpufort_acc_delete_r8_0,gpufort_acc_delete_r8_1,gpufort_acc_delete_r8_2,gpufort_acc_delete_r8_3,gpufort_acc_delete_r8_4,gpufort_acc_delete_r8_5,gpufort_acc_delete_r8_6,gpufort_acc_delete_r8_7,gpufort_acc_delete_c4_0,gpufort_acc_delete_c4_1,gpufort_acc_delete_c4_2,gpufort_acc_delete_c4_3,gpufort_acc_delete_c4_4,gpufort_acc_delete_c4_5,gpufort_acc_delete_c4_6,gpufort_acc_delete_c4_7,gpufort_acc_delete_c8_0,gpufort_acc_delete_c8_1,gpufort_acc_delete_c8_2,gpufort_acc_delete_c8_3,gpufort_acc_delete_c8_4,gpufort_acc_delete_c8_5,gpufort_acc_delete_c8_6,gpufort_acc_delete_c8_7 - end interface - - !> present( list ) parallel, kernels, serial, data, declare - !> When entering the region, the data must be present in device - !> memory, and the structured reference count is incremented. - !> When exiting the region, the structured reference count is - !> decremented. - interface gpufort_acc_present - module procedure gpufort_acc_present_b,gpufort_acc_present_l_0,gpufort_acc_present_l_1,gpufort_acc_present_l_2,gpufort_acc_present_l_3,gpufort_acc_present_l_4,gpufort_acc_present_l_5,gpufort_acc_present_l_6,gpufort_acc_present_l_7,gpufort_acc_present_i4_0,gpufort_acc_present_i4_1,gpufort_acc_present_i4_2,gpufort_acc_present_i4_3,gpufort_acc_present_i4_4,gpufort_acc_present_i4_5,gpufort_acc_present_i4_6,gpufort_acc_present_i4_7,gpufort_acc_present_i8_0,gpufort_acc_present_i8_1,gpufort_acc_present_i8_2,gpufort_acc_present_i8_3,gpufort_acc_present_i8_4,gpufort_acc_present_i8_5,gpufort_acc_present_i8_6,gpufort_acc_present_i8_7,gpufort_acc_present_r4_0,gpufort_acc_present_r4_1,gpufort_acc_present_r4_2,gpufort_acc_present_r4_3,gpufort_acc_present_r4_4,gpufort_acc_present_r4_5,gpufort_acc_present_r4_6,gpufort_acc_present_r4_7,gpufort_acc_present_r8_0,gpufort_acc_present_r8_1,gpufort_acc_present_r8_2,gpufort_acc_present_r8_3,gpufort_acc_present_r8_4,gpufort_acc_present_r8_5,gpufort_acc_present_r8_6,gpufort_acc_present_r8_7,gpufort_acc_present_c4_0,gpufort_acc_present_c4_1,gpufort_acc_present_c4_2,gpufort_acc_present_c4_3,gpufort_acc_present_c4_4,gpufort_acc_present_c4_5,gpufort_acc_present_c4_6,gpufort_acc_present_c4_7,gpufort_acc_present_c8_0,gpufort_acc_present_c8_1,gpufort_acc_present_c8_2,gpufort_acc_present_c8_3,gpufort_acc_present_c8_4,gpufort_acc_present_c8_5,gpufort_acc_present_c8_6,gpufort_acc_present_c8_7 - end interface - - !> Update Directive - !> - !> The update directive copies data between the memory for the - !> encountering thread and the device. An update directive may - !> appear in any data region, including an implicit data region. - !> - !> FORTRAN - !> - !> !$acc update [clause [[,] clause]…] - !> - !> CLAUSES - !> - !> self( list ) or host( list ) - !> Copies the data in list from the device to the encountering - !> thread. - !> device( list ) - !> Copies the data in list from the encountering thread to the - !> device. - !> if( condition ) - !> When the condition is zero or .FALSE., no data will be moved to - !> or from the device. - !> if_present - !> Issue no error when the data is not present on the device. - !> async [( expression )] - !> The data movement will execute asynchronously with the - !> encountering thread on the corresponding async queue. - !> wait [( expression-list )] - !> The data movement will not begin execution until all actions on - !> the corresponding async queue(s) are complete. - interface gpufort_acc_update_host - module procedure gpufort_acc_update_host_b,gpufort_acc_update_host_l_0,gpufort_acc_update_host_l_1,gpufort_acc_update_host_l_2,gpufort_acc_update_host_l_3,gpufort_acc_update_host_l_4,gpufort_acc_update_host_l_5,gpufort_acc_update_host_l_6,gpufort_acc_update_host_l_7,gpufort_acc_update_host_i4_0,gpufort_acc_update_host_i4_1,gpufort_acc_update_host_i4_2,gpufort_acc_update_host_i4_3,gpufort_acc_update_host_i4_4,gpufort_acc_update_host_i4_5,gpufort_acc_update_host_i4_6,gpufort_acc_update_host_i4_7,gpufort_acc_update_host_i8_0,gpufort_acc_update_host_i8_1,gpufort_acc_update_host_i8_2,gpufort_acc_update_host_i8_3,gpufort_acc_update_host_i8_4,gpufort_acc_update_host_i8_5,gpufort_acc_update_host_i8_6,gpufort_acc_update_host_i8_7,gpufort_acc_update_host_r4_0,gpufort_acc_update_host_r4_1,gpufort_acc_update_host_r4_2,gpufort_acc_update_host_r4_3,gpufort_acc_update_host_r4_4,gpufort_acc_update_host_r4_5,gpufort_acc_update_host_r4_6,gpufort_acc_update_host_r4_7,gpufort_acc_update_host_r8_0,gpufort_acc_update_host_r8_1,gpufort_acc_update_host_r8_2,gpufort_acc_update_host_r8_3,gpufort_acc_update_host_r8_4,gpufort_acc_update_host_r8_5,gpufort_acc_update_host_r8_6,gpufort_acc_update_host_r8_7,gpufort_acc_update_host_c4_0,gpufort_acc_update_host_c4_1,gpufort_acc_update_host_c4_2,gpufort_acc_update_host_c4_3,gpufort_acc_update_host_c4_4,gpufort_acc_update_host_c4_5,gpufort_acc_update_host_c4_6,gpufort_acc_update_host_c4_7,gpufort_acc_update_host_c8_0,gpufort_acc_update_host_c8_1,gpufort_acc_update_host_c8_2,gpufort_acc_update_host_c8_3,gpufort_acc_update_host_c8_4,gpufort_acc_update_host_c8_5,gpufort_acc_update_host_c8_6,gpufort_acc_update_host_c8_7 - end interface - - !> Update Directive - !> - !> The update directive copies data between the memory for the - !> encountering thread and the device. An update directive may - !> appear in any data region, including an implicit data region. - !> - !> FORTRAN - !> - !> !$acc update [clause [[,] clause]…] - !> - !> CLAUSES - !> - !> self( list ) or host( list ) - !> Copies the data in list from the device to the encountering - !> thread. - !> device( list ) - !> Copies the data in list from the encountering thread to the - !> device. - !> if( condition ) - !> When the condition is zero or .FALSE., no data will be moved to - !> or from the device. - !> if_present - !> Issue no error when the data is not present on the device. - !> async [( expression )] - !> The data movement will execute asynchronously with the - !> encountering thread on the corresponding async queue. - !> wait [( expression-list )] - !> The data movement will not begin execution until all actions on - !> the corresponding async queue(s) are complete. - interface gpufort_acc_update_device - module procedure gpufort_acc_update_device_b,gpufort_acc_update_device_l_0,gpufort_acc_update_device_l_1,gpufort_acc_update_device_l_2,gpufort_acc_update_device_l_3,gpufort_acc_update_device_l_4,gpufort_acc_update_device_l_5,gpufort_acc_update_device_l_6,gpufort_acc_update_device_l_7,gpufort_acc_update_device_i4_0,gpufort_acc_update_device_i4_1,gpufort_acc_update_device_i4_2,gpufort_acc_update_device_i4_3,gpufort_acc_update_device_i4_4,gpufort_acc_update_device_i4_5,gpufort_acc_update_device_i4_6,gpufort_acc_update_device_i4_7,gpufort_acc_update_device_i8_0,gpufort_acc_update_device_i8_1,gpufort_acc_update_device_i8_2,gpufort_acc_update_device_i8_3,gpufort_acc_update_device_i8_4,gpufort_acc_update_device_i8_5,gpufort_acc_update_device_i8_6,gpufort_acc_update_device_i8_7,gpufort_acc_update_device_r4_0,gpufort_acc_update_device_r4_1,gpufort_acc_update_device_r4_2,gpufort_acc_update_device_r4_3,gpufort_acc_update_device_r4_4,gpufort_acc_update_device_r4_5,gpufort_acc_update_device_r4_6,gpufort_acc_update_device_r4_7,gpufort_acc_update_device_r8_0,gpufort_acc_update_device_r8_1,gpufort_acc_update_device_r8_2,gpufort_acc_update_device_r8_3,gpufort_acc_update_device_r8_4,gpufort_acc_update_device_r8_5,gpufort_acc_update_device_r8_6,gpufort_acc_update_device_r8_7,gpufort_acc_update_device_c4_0,gpufort_acc_update_device_c4_1,gpufort_acc_update_device_c4_2,gpufort_acc_update_device_c4_3,gpufort_acc_update_device_c4_4,gpufort_acc_update_device_c4_5,gpufort_acc_update_device_c4_6,gpufort_acc_update_device_c4_7,gpufort_acc_update_device_c8_0,gpufort_acc_update_device_c8_1,gpufort_acc_update_device_c8_2,gpufort_acc_update_device_c8_3,gpufort_acc_update_device_c8_4,gpufort_acc_update_device_c8_5,gpufort_acc_update_device_c8_6,gpufort_acc_update_device_c8_7 - end interface - - contains - - ! - ! autogenerated routines for different inputs - ! - - - function gpufort_acc_present_l_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),1_8) - end function - - function gpufort_acc_no_create_l_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),1_8,async) - end function - - function gpufort_acc_copyout_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),1_8,async) - end function - - function gpufort_acc_copy_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),1_8,async) - end function - - subroutine gpufort_acc_update_host_l_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_i4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),4_8) - end function - - function gpufort_acc_no_create_i4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copyout_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copy_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_i8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),8_8) - end function - - function gpufort_acc_no_create_i8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copyout_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copy_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_r4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),4_8) - end function - - function gpufort_acc_no_create_r4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copyout_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copy_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_r8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),8_8) - end function - - function gpufort_acc_no_create_r8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copyout_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copy_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_c4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),2*4_8) - end function - - function gpufort_acc_no_create_c4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),2*4_8,async) - end function - - function gpufort_acc_copyout_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),2*4_8,async) - end function - - function gpufort_acc_copy_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_c8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),2*8_8) - end function - - function gpufort_acc_no_create_c8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),2*8_8,async) - end function - - function gpufort_acc_copyout_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),2*8_8,async) - end function - - function gpufort_acc_copy_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - -end module \ No newline at end of file diff --git a/runtime/gpufort_acc_runtime/examples/Makefile b/runtime/gpufort_acc_runtime/examples/Makefile new file mode 100644 index 00000000..fd912f37 --- /dev/null +++ b/runtime/gpufort_acc_runtime/examples/Makefile @@ -0,0 +1,23 @@ +FC = hipfc +FCFLAGS ?= -std=f2008 -ffree-line-length-none +FCFLAGS += -g -ggdb + +GPUFORT_ACC_DIR = $(shell gpufort --path)/runtime/gpufort_acc_runtime +ACC_INC = -I$(GPUFORT_ACC_DIR)/include +ACC_LIB = -L$(GPUFORT_ACC_DIR)/lib -lgpufort_acc + +TEST_SRC = $(shell find . -name "test-*.f90") +TEST_APP = $(TEST_SRC:.f90=.x) +#TEST_ENV = AMD_LOG_LEVEL=3 +TEST_ENV = GPUFORT_LOG_LEVEL=3 + +.PHONY: $(TEST_APP) + +all: $(TEST_APP) + +$(TEST_APP): %.x: %.f90 + hipfc $^ -o $@ $(FCFLAGS) $(ACC_INC) $(ACC_LIB) + $(TEST_ENV) ./$@ + +clean: + rm -rf *.o *.mod $(TEST_APP) diff --git a/runtime/examples/gpufort_acc_runtime/nested-scope/test_acc.f90 b/runtime/gpufort_acc_runtime/examples/test-nested-regions.f90 similarity index 53% rename from runtime/examples/gpufort_acc_runtime/nested-scope/test_acc.f90 rename to runtime/gpufort_acc_runtime/examples/test-nested-regions.f90 index 1ff3d4e1..c794a862 100644 --- a/runtime/examples/gpufort_acc_runtime/nested-scope/test_acc.f90 +++ b/runtime/gpufort_acc_runtime/examples/test-nested-regions.f90 @@ -18,28 +18,28 @@ program test_acc !$acc init call gpufort_acc_init() - do i = 1, 100 + do i = 1, 4 print *, "entering region" call gpufort_acc_enter_region() - a_d = gpufort_acc_copyin(a(:,:)) - d_d = gpufort_acc_copy(d(:)) - e_d = gpufort_acc_copyout(e(:)) - call gpufort_acc_runtime_print_summary() + a_d = gpufort_acc_copyin(a(:,:)) + d_d = gpufort_acc_copy(d(:)) + e_d = gpufort_acc_copyout(e(:)) + !call gpufort_acc_runtime_print_summary() - if ( mod(i,2) .eq. 0 ) then - print *, "entering subregion" - call gpufort_acc_enter_region() - a_d = gpufort_acc_present(a(:,5)) - b_d = gpufort_acc_copyin(b(:,:)) - c_d = gpufort_acc_create(c(:)) - call gpufort_acc_runtime_print_summary() - call gpufort_acc_update_host(b) - call gpufort_acc_update_device(b) - call gpufort_acc_exit_region() - print *, "exiting subregion" - endif - call gpufort_acc_update_host(a) - call gpufort_acc_update_device(a) + if ( mod(i,2) .eq. 0 ) then + print *, "entering subregion" + call gpufort_acc_enter_region() + a_d = gpufort_acc_present(a(:,5)) + b_d = gpufort_acc_copyin(b(:,:)) + c_d = gpufort_acc_create(c(:)) + !call gpufort_acc_runtime_print_summary() + call gpufort_acc_update_host(b) + call gpufort_acc_update_device(b) + call gpufort_acc_exit_region() + print *, "exiting subregion" + endif + call gpufort_acc_update_host(a) + call gpufort_acc_update_device(a) call gpufort_acc_exit_region() print *, "exiting region" end do @@ -52,4 +52,4 @@ program test_acc !$acc shutdown call gpufort_acc_shutdown() -end program \ No newline at end of file +end program diff --git a/runtime/gpufort_acc_runtime/examples/test-reusing.f90 b/runtime/gpufort_acc_runtime/examples/test-reusing.f90 new file mode 100644 index 00000000..b66529b8 --- /dev/null +++ b/runtime/gpufort_acc_runtime/examples/test-reusing.f90 @@ -0,0 +1,36 @@ +! SPDX-License-Identifier: MIT +! Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. +program test_acc + use iso_c_binding + use gpufort_acc_runtime + ! + real(8),allocatable,target :: a(:,:), b(:,:) + type(c_ptr) :: a_d, b_d + integer :: i + ! + allocate(a(10,10)) + allocate(b(10,9)) + + print *, "initializing" + !$acc init + call gpufort_acc_init() + + print *, "entering region" + call gpufort_acc_enter_region() + a_d = gpufort_acc_copyin(a(:,:)) + call gpufort_acc_exit_region() + print *, "exiting region" + + print *, "entering region" + call gpufort_acc_enter_region() + b_d = gpufort_acc_copyin(b(:,:)) + call gpufort_acc_exit_region() + print *, "exiting region" + + call gpufort_acc_runtime_print_summary() + + print *, "shutting down" + !$acc shutdown + call gpufort_acc_shutdown() + +end program diff --git a/runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc.f90 b/runtime/gpufort_acc_runtime/examples/test-unstructured-data.f90 similarity index 73% rename from runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc.f90 rename to runtime/gpufort_acc_runtime/examples/test-unstructured-data.f90 index be8af009..33bdccd7 100644 --- a/runtime/examples/gpufort_acc_runtime/multi-module-test/test_acc.f90 +++ b/runtime/gpufort_acc_runtime/examples/test-unstructured-data.f90 @@ -29,13 +29,13 @@ subroutine my_subroutine(a,b) print *, "entering subregion" !$acc kernels present(a) copyin(b(:,:)) call gpufort_acc_enter_region() - a_d = gpufort_acc_present(a) - b_d = gpufort_acc_copyin(b(:,:)) - call gpufort_acc_runtime_print_summary() - !$acc update host(b) - call gpufort_acc_update_host(b) - !$acc update device(b) - call gpufort_acc_update_device(b) + a_d = gpufort_acc_present(a) + b_d = gpufort_acc_copyin(b(:,:)) + call gpufort_acc_runtime_print_summary() + !$acc update host(b) + call gpufort_acc_update_host(b) + !$acc update device(b) + call gpufort_acc_update_device(b) !$acc end kernels call gpufort_acc_exit_region() print *, "exiting subregion" @@ -61,16 +61,16 @@ program test_acc !$acc enter data copyin(a(:,:)) call gpufort_acc_enter_region() - a_d = gpufort_acc_copyin(a(:,:)) - call gpufort_acc_runtime_print_summary() + a_d = gpufort_acc_copyin(a(:,:)) + call gpufort_acc_runtime_print_summary() - if ( i .eq. 2 ) then - call my_subroutine(a,b) - endif - !$acc update host(a(:,:)) - call gpufort_acc_update_host(a(:,:)) - !$acc update device(a) - call gpufort_acc_update_device(a) + if ( i .eq. 2 ) then + call my_subroutine(a,b) + endif + !$acc update host(a(:,:)) + call gpufort_acc_update_host(a(:,:)) + !$acc update device(a) + call gpufort_acc_update_device(a) !$acc exit data call gpufort_acc_exit_region() @@ -85,4 +85,4 @@ program test_acc call shutdown() -end program \ No newline at end of file +end program diff --git a/runtime/gpufort_acc_runtime/rules.mk b/runtime/gpufort_acc_runtime/rules.mk index 44903bad..70d075c3 100644 --- a/runtime/gpufort_acc_runtime/rules.mk +++ b/runtime/gpufort_acc_runtime/rules.mk @@ -1,4 +1,4 @@ -FC ?= gfortran +FC ?= hipfc HIPFORT_PATH ?= /opt/rocm/hipfort FCFLAGS ?= -std=f2008 -ffree-line-length-none -cpp @@ -8,10 +8,13 @@ else FCFLAGS += -I/$(HIPFORT_PATH)/include/amdgcn endif +SUFFIX ?= $(if $(HIP_PLATFORM),$(HIP_PLATFORM),amd) +LIBGPUFORT_ACC = libgpufort_acc_$(SUFFIX).a + FCFLAGS += -DNULLPTR_MEANS_NOOP -DDELETE_NORECORD_MEANS_NOOP #FCFLAGS += -DBLOCKING_COPIES #FCFLAGS += -DEXIT_REGION_SYNCHRONIZE_STREAMS -#FCFLAGS += -g -ggdb -O0 -fbacktrace -fmax-errors=5 -DDEBUG=3 +#FCFLAGS += -g -ggdb -O0 -fbacktrace -fmax-errors=5 # -DDEBUG=3 CXX ?= g++ -CXXFLAGS ?= \ No newline at end of file +CXXFLAGS ?= diff --git a/runtime/gpufort_acc_runtime/src/Makefile b/runtime/gpufort_acc_runtime/src/Makefile index 67fddda1..8143d10d 100644 --- a/runtime/gpufort_acc_runtime/src/Makefile +++ b/runtime/gpufort_acc_runtime/src/Makefile @@ -3,9 +3,9 @@ include ../rules.mk .PHONY: clean CXX_OBJ = gpufort_acc_runtime_c_impl.o -F_OBJ = gpufort_acc_runtime_c_bindings.o gpufort_acc_runtime_base.o gpufort_acc_runtime.o +F_OBJ = gpufort_acc_runtime_c_bindings.o gpufort_acc_runtime_base.o gpufort_acc_runtime.o -libgpufort_acc.a: $(CXX_OBJ) $(F_OBJ) +$(LIBGPUFORT_ACC): $(CXX_OBJ) $(F_OBJ) ar -crs $@ $^ $(CXX_OBJ): %.o: %.cpp @@ -15,4 +15,4 @@ $(F_OBJ): %.o: %.f90 $(FC) -c $< $(FCFLAGS) clean: - rm -f *.o *.mod *.a \ No newline at end of file + rm -f *.o *.mod *.a diff --git a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.def b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.def new file mode 100644 index 00000000..2a7cb8b9 --- /dev/null +++ b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.def @@ -0,0 +1,4 @@ +#define __PRESENT_OPTIONALS_DUMMY_ARGS async,module_var,create,copy,copyin,copyout +#define __PRESENT_OPTIONALS_DECLARATIONS integer,intent(in),optional :: async\ + logical,intent(in),optional :: module_var\ + logical,intent(in),optional :: copy, copyin, copyout, create diff --git a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.f90 b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.f90 deleted file mode 100644 index f40692d0..00000000 --- a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.f90 +++ /dev/null @@ -1,5957 +0,0 @@ -! SPDX-License-Identifier: MIT -! Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. - -! TODO not thread-safe, make use of OMP_LIB module if this becomes a problem - -! TODO will be slow for large pointer storages -! If this becomes an issue, use faster data structures or bind the public interfaces to -! a faster C runtime - -module gpufort_acc_runtime - use gpufort_acc_runtime_base - - !> copyin( list ) parallel, kernels, serial, data, enter data, - !> declare - !> When entering the region or at an enter data directive, - !> if the data in list is already present on the current device, the - !> appropriate reference count is incremented and that copy is - !> used. Otherwise, it allocates device memory and copies the - !> values from the encountering thread and sets the appropriate - !> reference count to one. When exiting the region the structured - !> reference count is decremented. If both reference counts are - !> zero, the device memory is deallocated. - interface gpufort_acc_copyin - module procedure gpufort_acc_copyin_b,gpufort_acc_copyin_l_0,gpufort_acc_copyin_l_1,gpufort_acc_copyin_l_2,gpufort_acc_copyin_l_3,gpufort_acc_copyin_l_4,gpufort_acc_copyin_l_5,gpufort_acc_copyin_l_6,gpufort_acc_copyin_l_7,gpufort_acc_copyin_i4_0,gpufort_acc_copyin_i4_1,gpufort_acc_copyin_i4_2,gpufort_acc_copyin_i4_3,gpufort_acc_copyin_i4_4,gpufort_acc_copyin_i4_5,gpufort_acc_copyin_i4_6,gpufort_acc_copyin_i4_7,gpufort_acc_copyin_i8_0,gpufort_acc_copyin_i8_1,gpufort_acc_copyin_i8_2,gpufort_acc_copyin_i8_3,gpufort_acc_copyin_i8_4,gpufort_acc_copyin_i8_5,gpufort_acc_copyin_i8_6,gpufort_acc_copyin_i8_7,gpufort_acc_copyin_r4_0,gpufort_acc_copyin_r4_1,gpufort_acc_copyin_r4_2,gpufort_acc_copyin_r4_3,gpufort_acc_copyin_r4_4,gpufort_acc_copyin_r4_5,gpufort_acc_copyin_r4_6,gpufort_acc_copyin_r4_7,gpufort_acc_copyin_r8_0,gpufort_acc_copyin_r8_1,gpufort_acc_copyin_r8_2,gpufort_acc_copyin_r8_3,gpufort_acc_copyin_r8_4,gpufort_acc_copyin_r8_5,gpufort_acc_copyin_r8_6,gpufort_acc_copyin_r8_7,gpufort_acc_copyin_c4_0,gpufort_acc_copyin_c4_1,gpufort_acc_copyin_c4_2,gpufort_acc_copyin_c4_3,gpufort_acc_copyin_c4_4,gpufort_acc_copyin_c4_5,gpufort_acc_copyin_c4_6,gpufort_acc_copyin_c4_7,gpufort_acc_copyin_c8_0,gpufort_acc_copyin_c8_1,gpufort_acc_copyin_c8_2,gpufort_acc_copyin_c8_3,gpufort_acc_copyin_c8_4,gpufort_acc_copyin_c8_5,gpufort_acc_copyin_c8_6,gpufort_acc_copyin_c8_7 - end interface - - !> copyout( list ) parallel, kernels, serial, data, exit data, - !> declare - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, it allocates device memory and - !> sets the structured reference count to one. At an exit data - !> directive with no finalize clause or when exiting the region, - !> the appropriate reference count is decremented. At an exit - !> data directive with a finalize clause, the dynamic reference - !> count is set to zero. In any case, if both reference counts are zero, - !> the data is copied from device memory to the encountering - !> thread and the device memory is deallocated. - interface gpufort_acc_copyout - module procedure gpufort_acc_copyout_b,gpufort_acc_copyout_l_0,gpufort_acc_copyout_l_1,gpufort_acc_copyout_l_2,gpufort_acc_copyout_l_3,gpufort_acc_copyout_l_4,gpufort_acc_copyout_l_5,gpufort_acc_copyout_l_6,gpufort_acc_copyout_l_7,gpufort_acc_copyout_i4_0,gpufort_acc_copyout_i4_1,gpufort_acc_copyout_i4_2,gpufort_acc_copyout_i4_3,gpufort_acc_copyout_i4_4,gpufort_acc_copyout_i4_5,gpufort_acc_copyout_i4_6,gpufort_acc_copyout_i4_7,gpufort_acc_copyout_i8_0,gpufort_acc_copyout_i8_1,gpufort_acc_copyout_i8_2,gpufort_acc_copyout_i8_3,gpufort_acc_copyout_i8_4,gpufort_acc_copyout_i8_5,gpufort_acc_copyout_i8_6,gpufort_acc_copyout_i8_7,gpufort_acc_copyout_r4_0,gpufort_acc_copyout_r4_1,gpufort_acc_copyout_r4_2,gpufort_acc_copyout_r4_3,gpufort_acc_copyout_r4_4,gpufort_acc_copyout_r4_5,gpufort_acc_copyout_r4_6,gpufort_acc_copyout_r4_7,gpufort_acc_copyout_r8_0,gpufort_acc_copyout_r8_1,gpufort_acc_copyout_r8_2,gpufort_acc_copyout_r8_3,gpufort_acc_copyout_r8_4,gpufort_acc_copyout_r8_5,gpufort_acc_copyout_r8_6,gpufort_acc_copyout_r8_7,gpufort_acc_copyout_c4_0,gpufort_acc_copyout_c4_1,gpufort_acc_copyout_c4_2,gpufort_acc_copyout_c4_3,gpufort_acc_copyout_c4_4,gpufort_acc_copyout_c4_5,gpufort_acc_copyout_c4_6,gpufort_acc_copyout_c4_7,gpufort_acc_copyout_c8_0,gpufort_acc_copyout_c8_1,gpufort_acc_copyout_c8_2,gpufort_acc_copyout_c8_3,gpufort_acc_copyout_c8_4,gpufort_acc_copyout_c8_5,gpufort_acc_copyout_c8_6,gpufort_acc_copyout_c8_7 - end interface - - !> copy( list ) parallel, kernels, serial, data, declare - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, it allocates device memory - !> and copies the values from the encountering thread and sets - !> the structured reference count to one. When exiting the region, - !> the structured reference count is decremented. If both reference - !> counts are zero, the data is copied from device memory to the - !> encountering thread and the device memory is deallocated. - interface gpufort_acc_copy - module procedure gpufort_acc_copy_b,gpufort_acc_copy_l_0,gpufort_acc_copy_l_1,gpufort_acc_copy_l_2,gpufort_acc_copy_l_3,gpufort_acc_copy_l_4,gpufort_acc_copy_l_5,gpufort_acc_copy_l_6,gpufort_acc_copy_l_7,gpufort_acc_copy_i4_0,gpufort_acc_copy_i4_1,gpufort_acc_copy_i4_2,gpufort_acc_copy_i4_3,gpufort_acc_copy_i4_4,gpufort_acc_copy_i4_5,gpufort_acc_copy_i4_6,gpufort_acc_copy_i4_7,gpufort_acc_copy_i8_0,gpufort_acc_copy_i8_1,gpufort_acc_copy_i8_2,gpufort_acc_copy_i8_3,gpufort_acc_copy_i8_4,gpufort_acc_copy_i8_5,gpufort_acc_copy_i8_6,gpufort_acc_copy_i8_7,gpufort_acc_copy_r4_0,gpufort_acc_copy_r4_1,gpufort_acc_copy_r4_2,gpufort_acc_copy_r4_3,gpufort_acc_copy_r4_4,gpufort_acc_copy_r4_5,gpufort_acc_copy_r4_6,gpufort_acc_copy_r4_7,gpufort_acc_copy_r8_0,gpufort_acc_copy_r8_1,gpufort_acc_copy_r8_2,gpufort_acc_copy_r8_3,gpufort_acc_copy_r8_4,gpufort_acc_copy_r8_5,gpufort_acc_copy_r8_6,gpufort_acc_copy_r8_7,gpufort_acc_copy_c4_0,gpufort_acc_copy_c4_1,gpufort_acc_copy_c4_2,gpufort_acc_copy_c4_3,gpufort_acc_copy_c4_4,gpufort_acc_copy_c4_5,gpufort_acc_copy_c4_6,gpufort_acc_copy_c4_7,gpufort_acc_copy_c8_0,gpufort_acc_copy_c8_1,gpufort_acc_copy_c8_2,gpufort_acc_copy_c8_3,gpufort_acc_copy_c8_4,gpufort_acc_copy_c8_5,gpufort_acc_copy_c8_6,gpufort_acc_copy_c8_7 - end interface - - !> create( list ) parallel, kernels, serial, data, enter data, - !> declare - !> When entering the region or at an enter data directive, - !> if the data in list is already present on the current device, the - !> appropriate reference count is incremented and that copy - !> is used. Otherwise, it allocates device memory and sets the - !> appropriate reference count to one. When exiting the region, - !> the structured reference count is decremented. If both reference - !> counts are zero, the device memory is deallocated. - interface gpufort_acc_create - module procedure gpufort_acc_create_b,gpufort_acc_create_l_0,gpufort_acc_create_l_1,gpufort_acc_create_l_2,gpufort_acc_create_l_3,gpufort_acc_create_l_4,gpufort_acc_create_l_5,gpufort_acc_create_l_6,gpufort_acc_create_l_7,gpufort_acc_create_i4_0,gpufort_acc_create_i4_1,gpufort_acc_create_i4_2,gpufort_acc_create_i4_3,gpufort_acc_create_i4_4,gpufort_acc_create_i4_5,gpufort_acc_create_i4_6,gpufort_acc_create_i4_7,gpufort_acc_create_i8_0,gpufort_acc_create_i8_1,gpufort_acc_create_i8_2,gpufort_acc_create_i8_3,gpufort_acc_create_i8_4,gpufort_acc_create_i8_5,gpufort_acc_create_i8_6,gpufort_acc_create_i8_7,gpufort_acc_create_r4_0,gpufort_acc_create_r4_1,gpufort_acc_create_r4_2,gpufort_acc_create_r4_3,gpufort_acc_create_r4_4,gpufort_acc_create_r4_5,gpufort_acc_create_r4_6,gpufort_acc_create_r4_7,gpufort_acc_create_r8_0,gpufort_acc_create_r8_1,gpufort_acc_create_r8_2,gpufort_acc_create_r8_3,gpufort_acc_create_r8_4,gpufort_acc_create_r8_5,gpufort_acc_create_r8_6,gpufort_acc_create_r8_7,gpufort_acc_create_c4_0,gpufort_acc_create_c4_1,gpufort_acc_create_c4_2,gpufort_acc_create_c4_3,gpufort_acc_create_c4_4,gpufort_acc_create_c4_5,gpufort_acc_create_c4_6,gpufort_acc_create_c4_7,gpufort_acc_create_c8_0,gpufort_acc_create_c8_1,gpufort_acc_create_c8_2,gpufort_acc_create_c8_3,gpufort_acc_create_c8_4,gpufort_acc_create_c8_5,gpufort_acc_create_c8_6,gpufort_acc_create_c8_7 - end interface - - !> no_create( list ) parallel, kernels, serial, data - !> When entering the region, if the data in list is already present on - !> the current device, the structured reference count is incremented - !> and that copy is used. Otherwise, no action is performed and any - !> device code in the construct will use the local memory address - !> for that data. - interface gpufort_acc_no_create - module procedure gpufort_acc_no_create_b,gpufort_acc_no_create_l_0,gpufort_acc_no_create_l_1,gpufort_acc_no_create_l_2,gpufort_acc_no_create_l_3,gpufort_acc_no_create_l_4,gpufort_acc_no_create_l_5,gpufort_acc_no_create_l_6,gpufort_acc_no_create_l_7,gpufort_acc_no_create_i4_0,gpufort_acc_no_create_i4_1,gpufort_acc_no_create_i4_2,gpufort_acc_no_create_i4_3,gpufort_acc_no_create_i4_4,gpufort_acc_no_create_i4_5,gpufort_acc_no_create_i4_6,gpufort_acc_no_create_i4_7,gpufort_acc_no_create_i8_0,gpufort_acc_no_create_i8_1,gpufort_acc_no_create_i8_2,gpufort_acc_no_create_i8_3,gpufort_acc_no_create_i8_4,gpufort_acc_no_create_i8_5,gpufort_acc_no_create_i8_6,gpufort_acc_no_create_i8_7,gpufort_acc_no_create_r4_0,gpufort_acc_no_create_r4_1,gpufort_acc_no_create_r4_2,gpufort_acc_no_create_r4_3,gpufort_acc_no_create_r4_4,gpufort_acc_no_create_r4_5,gpufort_acc_no_create_r4_6,gpufort_acc_no_create_r4_7,gpufort_acc_no_create_r8_0,gpufort_acc_no_create_r8_1,gpufort_acc_no_create_r8_2,gpufort_acc_no_create_r8_3,gpufort_acc_no_create_r8_4,gpufort_acc_no_create_r8_5,gpufort_acc_no_create_r8_6,gpufort_acc_no_create_r8_7,gpufort_acc_no_create_c4_0,gpufort_acc_no_create_c4_1,gpufort_acc_no_create_c4_2,gpufort_acc_no_create_c4_3,gpufort_acc_no_create_c4_4,gpufort_acc_no_create_c4_5,gpufort_acc_no_create_c4_6,gpufort_acc_no_create_c4_7,gpufort_acc_no_create_c8_0,gpufort_acc_no_create_c8_1,gpufort_acc_no_create_c8_2,gpufort_acc_no_create_c8_3,gpufort_acc_no_create_c8_4,gpufort_acc_no_create_c8_5,gpufort_acc_no_create_c8_6,gpufort_acc_no_create_c8_7 - end interface - - !> The delete clause may appear on exit data directives. - !> - !> For each var in varlist, if var is in shared memory, no action is taken; if var is not in shared memory, - !> the delete clause behaves as follows: - !> If var is not present in the current device memory, a runtime error is issued. - !> Otherwise, the dynamic reference counter is updated: - !> On an exit data directive with a finalize clause, the dynamic reference counter - !> is set to zero. - !> Otherwise, a present decrement action with the dynamic reference counter is performed. - !> If var is a pointer reference, a detach action is performed. If both structured and dynamic - !> reference counters are zero, a delete action is performed. - !> An exit data directive with a delete clause and with or without a finalize clause is - !> functionally equivalent to a call to - !> the acc_delete_finalize or acc_delete API routine, respectively, as described in Section 3.2.23. - !> - !> \note use - interface gpufort_acc_delete - module procedure gpufort_acc_delete_b,gpufort_acc_delete_l_0,gpufort_acc_delete_l_1,gpufort_acc_delete_l_2,gpufort_acc_delete_l_3,gpufort_acc_delete_l_4,gpufort_acc_delete_l_5,gpufort_acc_delete_l_6,gpufort_acc_delete_l_7,gpufort_acc_delete_i4_0,gpufort_acc_delete_i4_1,gpufort_acc_delete_i4_2,gpufort_acc_delete_i4_3,gpufort_acc_delete_i4_4,gpufort_acc_delete_i4_5,gpufort_acc_delete_i4_6,gpufort_acc_delete_i4_7,gpufort_acc_delete_i8_0,gpufort_acc_delete_i8_1,gpufort_acc_delete_i8_2,gpufort_acc_delete_i8_3,gpufort_acc_delete_i8_4,gpufort_acc_delete_i8_5,gpufort_acc_delete_i8_6,gpufort_acc_delete_i8_7,gpufort_acc_delete_r4_0,gpufort_acc_delete_r4_1,gpufort_acc_delete_r4_2,gpufort_acc_delete_r4_3,gpufort_acc_delete_r4_4,gpufort_acc_delete_r4_5,gpufort_acc_delete_r4_6,gpufort_acc_delete_r4_7,gpufort_acc_delete_r8_0,gpufort_acc_delete_r8_1,gpufort_acc_delete_r8_2,gpufort_acc_delete_r8_3,gpufort_acc_delete_r8_4,gpufort_acc_delete_r8_5,gpufort_acc_delete_r8_6,gpufort_acc_delete_r8_7,gpufort_acc_delete_c4_0,gpufort_acc_delete_c4_1,gpufort_acc_delete_c4_2,gpufort_acc_delete_c4_3,gpufort_acc_delete_c4_4,gpufort_acc_delete_c4_5,gpufort_acc_delete_c4_6,gpufort_acc_delete_c4_7,gpufort_acc_delete_c8_0,gpufort_acc_delete_c8_1,gpufort_acc_delete_c8_2,gpufort_acc_delete_c8_3,gpufort_acc_delete_c8_4,gpufort_acc_delete_c8_5,gpufort_acc_delete_c8_6,gpufort_acc_delete_c8_7 - end interface - - !> present( list ) parallel, kernels, serial, data, declare - !> When entering the region, the data must be present in device - !> memory, and the structured reference count is incremented. - !> When exiting the region, the structured reference count is - !> decremented. - interface gpufort_acc_present - module procedure gpufort_acc_present_b,gpufort_acc_present_l_0,gpufort_acc_present_l_1,gpufort_acc_present_l_2,gpufort_acc_present_l_3,gpufort_acc_present_l_4,gpufort_acc_present_l_5,gpufort_acc_present_l_6,gpufort_acc_present_l_7,gpufort_acc_present_i4_0,gpufort_acc_present_i4_1,gpufort_acc_present_i4_2,gpufort_acc_present_i4_3,gpufort_acc_present_i4_4,gpufort_acc_present_i4_5,gpufort_acc_present_i4_6,gpufort_acc_present_i4_7,gpufort_acc_present_i8_0,gpufort_acc_present_i8_1,gpufort_acc_present_i8_2,gpufort_acc_present_i8_3,gpufort_acc_present_i8_4,gpufort_acc_present_i8_5,gpufort_acc_present_i8_6,gpufort_acc_present_i8_7,gpufort_acc_present_r4_0,gpufort_acc_present_r4_1,gpufort_acc_present_r4_2,gpufort_acc_present_r4_3,gpufort_acc_present_r4_4,gpufort_acc_present_r4_5,gpufort_acc_present_r4_6,gpufort_acc_present_r4_7,gpufort_acc_present_r8_0,gpufort_acc_present_r8_1,gpufort_acc_present_r8_2,gpufort_acc_present_r8_3,gpufort_acc_present_r8_4,gpufort_acc_present_r8_5,gpufort_acc_present_r8_6,gpufort_acc_present_r8_7,gpufort_acc_present_c4_0,gpufort_acc_present_c4_1,gpufort_acc_present_c4_2,gpufort_acc_present_c4_3,gpufort_acc_present_c4_4,gpufort_acc_present_c4_5,gpufort_acc_present_c4_6,gpufort_acc_present_c4_7,gpufort_acc_present_c8_0,gpufort_acc_present_c8_1,gpufort_acc_present_c8_2,gpufort_acc_present_c8_3,gpufort_acc_present_c8_4,gpufort_acc_present_c8_5,gpufort_acc_present_c8_6,gpufort_acc_present_c8_7 - end interface - - !> Update Directive - !> - !> The update directive copies data between the memory for the - !> encountering thread and the device. An update directive may - !> appear in any data region, including an implicit data region. - !> - !> FORTRAN - !> - !> !$acc update [clause [[,] clause]…] - !> - !> CLAUSES - !> - !> self( list ) or host( list ) - !> Copies the data in list from the device to the encountering - !> thread. - !> device( list ) - !> Copies the data in list from the encountering thread to the - !> device. - !> if( condition ) - !> When the condition is zero or .FALSE., no data will be moved to - !> or from the device. - !> if_present - !> Issue no error when the data is not present on the device. - !> async [( expression )] - !> The data movement will execute asynchronously with the - !> encountering thread on the corresponding async queue. - !> wait [( expression-list )] - !> The data movement will not begin execution until all actions on - !> the corresponding async queue(s) are complete. - interface gpufort_acc_update_host - module procedure gpufort_acc_update_host_b,gpufort_acc_update_host_l_0,gpufort_acc_update_host_l_1,gpufort_acc_update_host_l_2,gpufort_acc_update_host_l_3,gpufort_acc_update_host_l_4,gpufort_acc_update_host_l_5,gpufort_acc_update_host_l_6,gpufort_acc_update_host_l_7,gpufort_acc_update_host_i4_0,gpufort_acc_update_host_i4_1,gpufort_acc_update_host_i4_2,gpufort_acc_update_host_i4_3,gpufort_acc_update_host_i4_4,gpufort_acc_update_host_i4_5,gpufort_acc_update_host_i4_6,gpufort_acc_update_host_i4_7,gpufort_acc_update_host_i8_0,gpufort_acc_update_host_i8_1,gpufort_acc_update_host_i8_2,gpufort_acc_update_host_i8_3,gpufort_acc_update_host_i8_4,gpufort_acc_update_host_i8_5,gpufort_acc_update_host_i8_6,gpufort_acc_update_host_i8_7,gpufort_acc_update_host_r4_0,gpufort_acc_update_host_r4_1,gpufort_acc_update_host_r4_2,gpufort_acc_update_host_r4_3,gpufort_acc_update_host_r4_4,gpufort_acc_update_host_r4_5,gpufort_acc_update_host_r4_6,gpufort_acc_update_host_r4_7,gpufort_acc_update_host_r8_0,gpufort_acc_update_host_r8_1,gpufort_acc_update_host_r8_2,gpufort_acc_update_host_r8_3,gpufort_acc_update_host_r8_4,gpufort_acc_update_host_r8_5,gpufort_acc_update_host_r8_6,gpufort_acc_update_host_r8_7,gpufort_acc_update_host_c4_0,gpufort_acc_update_host_c4_1,gpufort_acc_update_host_c4_2,gpufort_acc_update_host_c4_3,gpufort_acc_update_host_c4_4,gpufort_acc_update_host_c4_5,gpufort_acc_update_host_c4_6,gpufort_acc_update_host_c4_7,gpufort_acc_update_host_c8_0,gpufort_acc_update_host_c8_1,gpufort_acc_update_host_c8_2,gpufort_acc_update_host_c8_3,gpufort_acc_update_host_c8_4,gpufort_acc_update_host_c8_5,gpufort_acc_update_host_c8_6,gpufort_acc_update_host_c8_7 - end interface - - !> Update Directive - !> - !> The update directive copies data between the memory for the - !> encountering thread and the device. An update directive may - !> appear in any data region, including an implicit data region. - !> - !> FORTRAN - !> - !> !$acc update [clause [[,] clause]…] - !> - !> CLAUSES - !> - !> self( list ) or host( list ) - !> Copies the data in list from the device to the encountering - !> thread. - !> device( list ) - !> Copies the data in list from the encountering thread to the - !> device. - !> if( condition ) - !> When the condition is zero or .FALSE., no data will be moved to - !> or from the device. - !> if_present - !> Issue no error when the data is not present on the device. - !> async [( expression )] - !> The data movement will execute asynchronously with the - !> encountering thread on the corresponding async queue. - !> wait [( expression-list )] - !> The data movement will not begin execution until all actions on - !> the corresponding async queue(s) are complete. - interface gpufort_acc_update_device - module procedure gpufort_acc_update_device_b,gpufort_acc_update_device_l_0,gpufort_acc_update_device_l_1,gpufort_acc_update_device_l_2,gpufort_acc_update_device_l_3,gpufort_acc_update_device_l_4,gpufort_acc_update_device_l_5,gpufort_acc_update_device_l_6,gpufort_acc_update_device_l_7,gpufort_acc_update_device_i4_0,gpufort_acc_update_device_i4_1,gpufort_acc_update_device_i4_2,gpufort_acc_update_device_i4_3,gpufort_acc_update_device_i4_4,gpufort_acc_update_device_i4_5,gpufort_acc_update_device_i4_6,gpufort_acc_update_device_i4_7,gpufort_acc_update_device_i8_0,gpufort_acc_update_device_i8_1,gpufort_acc_update_device_i8_2,gpufort_acc_update_device_i8_3,gpufort_acc_update_device_i8_4,gpufort_acc_update_device_i8_5,gpufort_acc_update_device_i8_6,gpufort_acc_update_device_i8_7,gpufort_acc_update_device_r4_0,gpufort_acc_update_device_r4_1,gpufort_acc_update_device_r4_2,gpufort_acc_update_device_r4_3,gpufort_acc_update_device_r4_4,gpufort_acc_update_device_r4_5,gpufort_acc_update_device_r4_6,gpufort_acc_update_device_r4_7,gpufort_acc_update_device_r8_0,gpufort_acc_update_device_r8_1,gpufort_acc_update_device_r8_2,gpufort_acc_update_device_r8_3,gpufort_acc_update_device_r8_4,gpufort_acc_update_device_r8_5,gpufort_acc_update_device_r8_6,gpufort_acc_update_device_r8_7,gpufort_acc_update_device_c4_0,gpufort_acc_update_device_c4_1,gpufort_acc_update_device_c4_2,gpufort_acc_update_device_c4_3,gpufort_acc_update_device_c4_4,gpufort_acc_update_device_c4_5,gpufort_acc_update_device_c4_6,gpufort_acc_update_device_c4_7,gpufort_acc_update_device_c8_0,gpufort_acc_update_device_c8_1,gpufort_acc_update_device_c8_2,gpufort_acc_update_device_c8_3,gpufort_acc_update_device_c8_4,gpufort_acc_update_device_c8_5,gpufort_acc_update_device_c8_6,gpufort_acc_update_device_c8_7 - end interface - - contains - - ! - ! autogenerated routines for different inputs - ! - - - function gpufort_acc_present_l_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),1_8) - end function - - function gpufort_acc_no_create_l_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),1_8,async) - end function - - function gpufort_acc_copyout_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),1_8,async) - end function - - function gpufort_acc_copy_l_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),1_8,async) - end function - - subroutine gpufort_acc_update_host_l_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_l_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*1_8,async,copy,copyin) - end function - - function gpufort_acc_create_l_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*1_8) - end function - - function gpufort_acc_no_create_l_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_l_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copyout_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - function gpufort_acc_copy_l_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*1_8,async) - end function - - subroutine gpufort_acc_update_host_l_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_l_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - logical,target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_i4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),4_8) - end function - - function gpufort_acc_no_create_i4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copyout_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copy_i4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_i4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_i4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_i4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_i4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_i8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),8_8) - end function - - function gpufort_acc_no_create_i8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copyout_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copy_i8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_i8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_i8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_i8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_i8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_i8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_i8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_i8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - integer(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_r4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),4_8) - end function - - function gpufort_acc_no_create_r4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copyout_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),4_8,async) - end function - - function gpufort_acc_copy_r4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_r4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*4_8) - end function - - function gpufort_acc_no_create_r4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copyout_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - function gpufort_acc_copy_r4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*4_8,async) - end function - - subroutine gpufort_acc_update_host_r4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_r8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),8_8) - end function - - function gpufort_acc_no_create_r8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copyout_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),8_8,async) - end function - - function gpufort_acc_copy_r8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_r8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_r8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*8_8) - end function - - function gpufort_acc_no_create_r8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_r8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copyout_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - function gpufort_acc_copy_r8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*8_8,async) - end function - - subroutine gpufort_acc_update_host_r8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_r8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - real(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_c4_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),2*4_8) - end function - - function gpufort_acc_no_create_c4_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),2*4_8,async) - end function - - function gpufort_acc_copyout_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),2*4_8,async) - end function - - function gpufort_acc_copy_c4_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c4_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*4_8,async,copy,copyin) - end function - - function gpufort_acc_create_c4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*4_8) - end function - - function gpufort_acc_no_create_c4_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c4_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copyout_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - function gpufort_acc_copy_c4_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*4_8,async) - end function - - subroutine gpufort_acc_update_host_c4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c4_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(4),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - function gpufort_acc_present_c8_0(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),2*8_8) - end function - - function gpufort_acc_no_create_c8_0(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_0(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),2*8_8,async) - end function - - function gpufort_acc_copyout_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),2*8_8,async) - end function - - function gpufort_acc_copy_c8_0(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_0(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_1(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_1(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_1(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_1(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_1(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_2(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_2(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_2(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_2(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_2(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_3(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_3(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_3(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_3(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_3(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_4(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_4(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_4(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_4(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_4(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_5(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_5(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_5(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_5(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_5(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_6(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_6(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_6(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_6(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_6(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - function gpufort_acc_present_c8_7(hostptr,async,copy,copyin) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),size(hostptr)*2*8_8,async,copy,copyin) - end function - - function gpufort_acc_create_c8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_create_b(c_loc(hostptr),size(hostptr)*2*8_8) - end function - - function gpufort_acc_no_create_c8_7(hostptr) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) - end function - - subroutine gpufort_acc_delete_c8_7(hostptr,finalize) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_delete_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: finalize - ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) - end subroutine - - function gpufort_acc_copyin_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copyout_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - function gpufort_acc_copy_c8_7(hostptr,async) result(deviceptr) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_copy_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - integer,intent(in),optional :: async - ! - type(c_ptr) :: deviceptr - ! - deviceptr = gpufort_acc_copy_b(c_loc(hostptr),size(hostptr)*2*8_8,async) - end function - - subroutine gpufort_acc_update_host_c8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - subroutine gpufort_acc_update_device_c8_7(hostptr,condition,if_present,async) - use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b - implicit none - complex(8),target,dimension(:,:,:,:,:,:,:),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present - integer,intent(in),optional :: async - ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) - end subroutine - - - - -end module \ No newline at end of file diff --git a/runtime/gpufort_acc_runtime/codegen/templates/gpufort_acc_runtime.template.f b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.template.f90 similarity index 88% rename from runtime/gpufort_acc_runtime/codegen/templates/gpufort_acc_runtime.template.f rename to runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.template.f90 index 9711a07c..32556317 100644 --- a/runtime/gpufort_acc_runtime/codegen/templates/gpufort_acc_runtime.template.f +++ b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime.template.f90 @@ -9,6 +9,8 @@ ! If this becomes an issue, use faster data structures or bind the public interfaces to ! a faster C runtime +#include "gpufort_acc_runtime.def" + module gpufort_acc_runtime use gpufort_acc_runtime_base @@ -243,109 +245,117 @@ module gpufort_acc_runtime {% set rank = '' %} {% endif %} {% set suffix = tuple[0] + "_" + dims|string %} - function gpufort_acc_present_{{suffix}}(hostptr,async,copy,copyin) result(deviceptr) + function gpufort_acc_present_{{suffix}}(hostptr,module_var,or,async) result(deviceptr) use iso_c_binding - use gpufort_acc_runtime_base, only: gpufort_acc_present_b + use gpufort_acc_runtime_base, only: gpufort_acc_present_b, gpufort_acc_event_undefined implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr - integer,intent(in),optional :: async - logical,intent(in),optional :: copy - logical,intent(in),optional :: copyin + logical,intent(in),optional :: module_var + integer(kind(gpufort_acc_event_undefined)),& + intent(in),optional :: or + integer,intent(in),optional :: async ! type(c_ptr) :: deviceptr ! - deviceptr = gpufort_acc_present_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async,copy,copyin) + deviceptr = gpufort_acc_present_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,module_var,or,async) end function - function gpufort_acc_create_{{suffix}}(hostptr) result(deviceptr) + function gpufort_acc_create_{{suffix}}(hostptr,module_var) result(deviceptr) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_create_b implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr + logical,intent(in),optional :: module_var + ! type(c_ptr) :: deviceptr ! deviceptr = gpufort_acc_create_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8) end function - function gpufort_acc_no_create_{{suffix}}(hostptr) result(deviceptr) + function gpufort_acc_no_create_{{suffix}}(hostptr,module_var) result(deviceptr) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_no_create_b implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr + logical,intent(in),optional :: module_var + ! type(c_ptr) :: deviceptr ! deviceptr = gpufort_acc_no_create_b(c_loc(hostptr)) end function - subroutine gpufort_acc_delete_{{suffix}}(hostptr,finalize) + subroutine gpufort_acc_delete_{{suffix}}(hostptr,finalize,module_var) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_delete_b implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr - logical,intent(in),optional :: finalize + logical,intent(in),optional :: finalize, module_var ! - call gpufort_acc_delete_b(c_loc(hostptr),finalize) + call gpufort_acc_delete_b(c_loc(hostptr),finalize,module_var) end subroutine - function gpufort_acc_copyin_{{suffix}}(hostptr,async) result(deviceptr) + function gpufort_acc_copyin_{{suffix}}(hostptr,async,module_var) result(deviceptr) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_copyin_b implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! - deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async) + deviceptr = gpufort_acc_copyin_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async,module_var) end function - function gpufort_acc_copyout_{{suffix}}(hostptr,async) result(deviceptr) + function gpufort_acc_copyout_{{suffix}}(hostptr,async,module_var) result(deviceptr) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_copyout_b implicit none {{tuple[2]}},target{{ rank }},intent(inout) :: hostptr integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! - deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async) + deviceptr = gpufort_acc_copyout_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async,module_var) end function - function gpufort_acc_copy_{{suffix}}(hostptr,async) result(deviceptr) + function gpufort_acc_copy_{{suffix}}(hostptr,async,module_var) result(deviceptr) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_copy_b implicit none {{tuple[2]}},target{{ rank }},intent(inout) :: hostptr integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! deviceptr = gpufort_acc_copy_b(c_loc(hostptr),{{size}}{{tuple[1]}}_8,async) end function - subroutine gpufort_acc_update_host_{{suffix}}(hostptr,condition,if_present,async) + subroutine gpufort_acc_update_host_{{suffix}}(hostptr,condition,if_present,async,module_var) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_update_host_b implicit none {{tuple[2]}},target{{ rank }},intent(inout) :: hostptr - logical,intent(in),optional :: condition, if_present + logical,intent(in),optional :: condition, if_present, module_var integer,intent(in),optional :: async ! - call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async) + call gpufort_acc_update_host_b(c_loc(hostptr),condition,if_present,async,module_var) end subroutine - subroutine gpufort_acc_update_device_{{suffix}}(hostptr,condition,if_present,async) + subroutine gpufort_acc_update_device_{{suffix}}(hostptr,condition,if_present,async,module_var) use iso_c_binding use gpufort_acc_runtime_base, only: gpufort_acc_update_device_b implicit none {{tuple[2]}},target{{ rank }},intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present + logical,intent(in),optional :: condition, if_present, module_var integer,intent(in),optional :: async ! - call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async) + call gpufort_acc_update_device_b(c_loc(hostptr),condition,if_present,async,module_var) end subroutine {% endfor %} {% endfor %} -end module \ No newline at end of file +end module diff --git a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_base.f90 b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_base.f90 index b91c0298..91a06322 100644 --- a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_base.f90 +++ b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_base.f90 @@ -1,10 +1,6 @@ ! SPDX-License-Identifier: MIT ! Copyright (c) 2021 Advanced Micro Devices, Inc. All rights reserved. -! TODO not thread-safe, make use of OMP_LIB module if this becomes a problem - -! TODO will be slow for large pointer storages -! If this becomes an issue, use faster data structures or bind the public interfaces to -! a faster C runtime +#include "gpufort_acc_runtime.def" #define blocked_size(num_bytes) ((((num_bytes)+BLOCK_SIZE-1)/BLOCK_SIZE) * BLOCK_SIZE) @@ -23,85 +19,149 @@ module gpufort_acc_runtime_base public :: gpufort_acc_runtime_print_summary public :: gpufort_acc_runtime_record_exists, gpufort_acc_runtime_get_record_id + + public :: gpufort_acc_event_undefined,& + gpufort_acc_event_create,& + gpufort_acc_event_copyin,& + gpufort_acc_event_copyout,& + gpufort_acc_event_copy - PRIVATE ! Everything else is private - - ! - ! parameters - ! - - integer, parameter :: MAX_QUEUES = 64 - integer, parameter :: INITIAL_RECORDS_CAPACITY = 4096 - integer, parameter :: BLOCK_SIZE = 32 + PRIVATE ! Everything below and not listed above as public is private ! ! members ! - integer :: record_creation_counter_ = 1 + integer, save :: LOG_LEVEL = 0 + integer, save :: MAX_QUEUES = 64 + integer, save :: INITIAL_RECORDS_CAPACITY = 4096 + ! reuse/fragmentation controls + integer, save :: BLOCK_SIZE = 32 + real, save :: REUSE_THRESHOLD = 0.9 ! only reuse record if mem_new>=factor*mem_old + integer, save :: NUM_REFS_TO_DEALLOCATE = -5 ! dealloc device mem only if num_refs takes this value - logical, save :: initialized_ = .FALSE. - - integer, save :: last_record_index_ = 0 + integer, save :: record_creation_counter_ = 0 + logical, save :: initialized_ = .false. integer, save :: last_queue_index_ = 0 - - integer, save :: current_region_ = 0 - integer(c_size_t), save :: total_memory_b_ = 0 - + !> Creational events for a record - enum, bind(c) + enum, bind(c) enumerator :: gpufort_acc_event_undefined = 0 enumerator :: gpufort_acc_event_create = 1 enumerator :: gpufort_acc_event_copyin = 2 enumerator :: gpufort_acc_event_copyout = 3 enumerator :: gpufort_acc_event_copy = 4 - end enum + end enum !> Data structure that maps a host to a device pointer. type :: t_record - integer :: id = 1 - type(c_ptr) :: hostptr = c_null_ptr - type(c_ptr) :: deviceptr = c_null_ptr - integer(c_size_t) :: num_bytes = 0 - integer :: num_refs = 0 - integer :: region = 0 + integer :: id = -1 + type(c_ptr) :: hostptr = c_null_ptr + type(c_ptr) :: deviceptr = c_null_ptr + integer :: region = -1 + integer(c_size_t) :: num_bytes = 0 + integer(c_size_t) :: num_bytes_used = 0 + integer :: num_refs = 0 integer(kind(gpufort_acc_event_create)) :: creational_event = gpufort_acc_event_undefined contains - procedure :: print => t_record_print_ - procedure :: is_initialized => t_record_is_initialized_ - procedure :: is_subarray => t_record_is_subarray_ - procedure :: initialize => t_record_initialize_ - procedure :: destroy => t_record_destroy_ - procedure :: copy_to_device => t_record_copy_to_device_ - procedure :: copy_to_host => t_record_copy_to_host_ + procedure :: print => t_record_print_ + procedure :: is_initialized => t_record_is_initialized_ + procedure :: is_used => t_record_is_used_ + procedure :: is_released => t_record_is_released_ + procedure :: is_subarray => t_record_is_subarray_ + procedure :: setup => t_record_setup_ + procedure :: release => t_record_release_ + procedure :: destroy => t_record_destroy_ + procedure :: copy_to_device => t_record_copy_to_device_ + procedure :: copy_to_host => t_record_copy_to_host_ procedure :: decrement_num_refs => t_record_decrement_num_refs_ procedure :: increment_num_refs => t_record_increment_num_refs_ end type + !> Data structure managing records and storing associated metadata. + type :: t_record_list + type(t_record), allocatable :: records(:) + integer :: last_record_index = 0 + integer :: current_region = 0 + integer(c_size_t) :: total_memory_bytes = 0 + + contains + procedure :: is_initialized => t_record_list_is_initialized_ + procedure :: initialize => t_record_list_initialize_ + procedure :: grow => t_record_list_grow_ + procedure :: destroy => t_record_list_destroy_ + procedure :: find_record => t_record_list_find_record_ + procedure :: find_available_record => t_record_list_find_available_record_ + procedure :: use_increment_record => t_record_list_use_increment_record_ + procedure :: decrement_release_record => t_record_list_decrement_release_record_ + end type + !> Data structure to map integer numbers to queues. type :: t_queue type(c_ptr) :: queueptr = c_null_ptr - integer :: num_refs = 0 + integer :: num_refs = 0 contains - procedure :: is_initialized => t_queue_is_initialized_ - procedure :: initialize => t_queue_initialize_ - procedure :: destroy => t_queue_destroy_ + procedure :: is_initialized => t_queue_is_initialized_ + procedure :: initialize => t_queue_initialize_ + procedure :: destroy => t_queue_destroy_ procedure :: decrement_num_refs => t_queue_decrement_num_refs_ procedure :: increment_num_refs => t_queue_increment_num_refs_ end type - type(t_record), save, allocatable, private :: records_(:) - type(t_queue), save, private :: queues_(MAX_QUEUES) + type(t_record_list),save :: record_list_ + type(t_queue),allocatable,save :: queues_(:) + + !> evaluate optional values + interface eval_optval_ + module procedure :: eval_optval_1_, eval_optval_2_ + end interface contains + + function eval_optval_1_(optval,fallback) result(retval) + implicit none + logical,optional,intent(in) :: optval + logical,intent(in) :: fallback + logical :: retval + if ( present(optval) ) then + retval = optval + else + retval = fallback + endif + end function + + function eval_optval_2_(optval,fallback) result(retval) + implicit none + integer,optional,intent(in) :: optval + integer,intent(in) :: fallback + integer :: retval + if ( present(optval) ) then + retval = optval + else + retval = fallback + endif + end function + + !function eval_optval_3_(optval,fallback) result(retval) + ! implicit none + ! integer(kind(gpufort_acc_event_undefined)),optional,intent(in) :: optval + ! integer(kind(gpufort_acc_event_undefined)),intent(in) :: fallback + ! integer(kind(gpufort_acc_event_undefined)) :: retval + ! if ( present(optval) ) then + ! retval = optval + ! else + ! retval = fallback + ! endif + !end function ! ! debugging/analysis ! function gpufort_acc_runtime_record_exists(hostptr,id,print_record) result(success) + use iso_fortran_env use iso_c_binding implicit none type(c_ptr),intent(in),optional :: hostptr @@ -110,19 +170,29 @@ function gpufort_acc_runtime_record_exists(hostptr,id,print_record) result(succe ! logical :: success ! - integer :: i - logical :: opt_print_record + integer :: i + logical :: opt_print_record + type(c_ptr) :: opt_hostptr + integer :: opt_id ! - opt_print_record = .FALSE. + opt_print_record = .false. + opt_hostptr = c_null_ptr + opt_id = -1 ! if ( present(print_record) ) opt_print_record = print_record - ! - success = .FALSE. - do i = 1, last_record_index_ - if ( ( present(hostptr) .and. records_(i)%is_subarray(hostptr,0_8) ) .or. & - ( present(id) .and. records_(i)%id .eq. id ) ) then - success = .TRUE. - if ( opt_print_record ) CALL records_(i)%print() + if ( present(hostptr) ) opt_hostptr = hostptr + if ( present(id) ) opt_id = id + ! + success = .false. + do i = 1, record_list_%last_record_index + + if ( ( record_list_%records(i)%is_subarray(opt_hostptr,0_8) ) .or. & + ( record_list_%records(i)%id .eq. opt_id ) ) then + success = .true. + if ( opt_print_record ) then + CALL record_list_%records(i)%print() + flush(output_unit) + endif exit ! loop endif end do @@ -138,43 +208,49 @@ function gpufort_acc_runtime_get_record_id(hostptr) result(id) ! integer :: i ! - do i = 1, last_record_index_ - if ( records_(i)%is_subarray(hostptr,0_8) ) then - id = records_(i)%id + do i = 1, record_list_%last_record_index + if ( record_list_%records(i)%is_subarray(hostptr,0_8) ) then + id = record_list_%records(i)%id exit ! loop endif end do end function subroutine gpufort_acc_runtime_print_summary(print_records) + use iso_fortran_env use iso_c_binding use hipfort use hipfort_check implicit none - logical,optional,intent(in) :: print_records + logical,intent(in),optional :: print_records ! - integer :: i + integer :: i, j integer(c_size_t) :: free_memory, total_memory + logical :: opt_print_records + ! + opt_print_records = .false. + ! + if ( present(print_records) ) opt_print_records = print_records ! CALL hipCheck(hipMemGetInfo(free_memory,total_memory)) ! print *, "SUMMARY" print *, "" - print *, "globals:" - print *, "- current region = ", current_region_ - print *, "- last record index = ", last_record_index_ - print *, "- last queue index = ", last_queue_index_ - print *, "- total records created = ", record_creation_counter_ - print *, "- total memory allocated (B) = ", total_memory_b_ - print *, "- HIP used memory (B) = ", (total_memory - free_memory), "/", total_memory + print *, "stats:" + print *, "- total records created = ", record_creation_counter_ + print *, "- total memory allocated (B) = ", total_memory + print *, "- HIP used memory (B) = ", (total_memory - free_memory), "/", total_memory + print *, "- current region = ", record_list_%current_region + print *, "- last record index = ", record_list_%last_record_index + print *, "- device memory allocated (B) = ", record_list_%total_memory_bytes print *, "" - if ( present(print_records) .and. print_records ) then - print *, "records:" - do i = 1, last_record_index_ + if ( opt_print_records ) then + do i = 1, record_list_%last_record_index print *, "- record ", i, ":" - CALL records_(i)%print() + CALL record_list_%records(i)%print() + flush(output_unit) end do - end if + endif end subroutine ! @@ -249,7 +325,7 @@ subroutine create_increment_queue_(id) end subroutine !> \note Not thread safe - subroutine decrement_delete_queue_(id) + subroutine decrement_release_queue_(id) implicit none integer, intent(in) :: id ! @@ -263,7 +339,7 @@ subroutine decrement_delete_queue_(id) last_queue_index_ = last_queue_index_ - 1 endif else if ( id .gt. MAX_QUEUES ) then - ERROR STOP "gpufort_acc_runtime: decrement_delete_queue_: queue id greater than parameter MAX_QUEUES" + ERROR STOP "gpufort_acc_runtime: decrement_release_queue_: queue id greater than parameter MAX_QUEUES" endif end subroutine @@ -294,30 +370,50 @@ function t_record_is_initialized_(record) result(ret) class(t_record),intent(in) :: record logical(c_bool) :: ret ! - ret = c_associated( record%hostptr ) + ret = c_associated(record%deviceptr) + end function + + function t_record_is_used_(record) result(ret) + use iso_c_binding + implicit none + class(t_record),intent(in) :: record + logical(c_bool) :: ret + ! + ret = record%is_initialized() .and. & + record%num_refs > 0 + end function + + function t_record_is_released_(record) result(ret) + use iso_c_binding + implicit none + class(t_record),intent(in) :: record + logical(c_bool) :: ret + ! + ret = record%is_initialized() .and. & + record%num_refs <= 0 end function - subroutine t_record_copy_to_device_(record,async) + subroutine t_record_copy_to_device_(record,async) use iso_c_binding use hipfort_check use hipfort_hipmemcpy implicit none class(t_record),intent(in) :: record - integer,optional,intent(in) :: async + integer,intent(in),optional :: async ! #ifndef BLOCKING_COPIES if ( present(async) ) then if ( async .ge. 0 ) then call create_increment_queue_(async) call hipCheck(hipMemcpyAsync(record%deviceptr,record%hostptr,& - record%num_bytes,hipMemcpyHostToDevice,queues_(async)%queueptr)) + record%num_bytes_used,hipMemcpyHostToDevice,queues_(async)%queueptr)) else call hipCheck(hipMemcpyAsync(record%deviceptr,record%hostptr,& - record%num_bytes,hipMemcpyHostToDevice,c_null_ptr)) + record%num_bytes_used,hipMemcpyHostToDevice,c_null_ptr)) endif else #endif - call hipCheck(hipMemcpy(record%deviceptr,record%hostptr,record%num_bytes,hipMemcpyHostToDevice)) + call hipCheck(hipMemcpy(record%deviceptr,record%hostptr,record%num_bytes_used,hipMemcpyHostToDevice)) #ifndef BLOCKING_COPIES endif #endif @@ -329,27 +425,27 @@ subroutine t_record_copy_to_host_(record,async) use hipfort_hipmemcpy implicit none class(t_record),intent(in) :: record - integer,optional,intent(in) :: async + integer,intent(in),optional :: async ! #ifndef BLOCKING_COPIES if ( present(async) ) then if ( async .ge. 0 ) then call create_increment_queue_(async) call hipCheck(hipMemcpyAsync(record%hostptr,record%deviceptr,& - record%num_bytes,hipMemcpyDeviceToHost,queues_(async)%queueptr)) + record%num_bytes_used,hipMemcpyDeviceToHost,queues_(async)%queueptr)) else call hipCheck(hipMemcpyAsync(record%hostptr,record%deviceptr,& - record%num_bytes,hipMemcpyDeviceToHost,c_null_ptr)) + record%num_bytes_used,hipMemcpyDeviceToHost,c_null_ptr)) endif else #endif - call hipCheck(hipMemcpy(record%hostptr,record%deviceptr,record%num_bytes,hipMemcpyDeviceToHost)) + call hipCheck(hipMemcpy(record%hostptr,record%deviceptr,record%num_bytes_used,hipMemcpyDeviceToHost)) #ifndef BLOCKING_COPIES endif #endif end subroutine - function t_record_is_subarray_(record,hostptr,num_bytes) result(rval) + function t_record_is_subarray_(record,hostptr,num_bytes,offset_bytes) result(rval) use iso_c_binding use gpufort_acc_runtime_c_bindings implicit none @@ -358,12 +454,33 @@ function t_record_is_subarray_(record,hostptr,num_bytes) result(rval) integer(c_size_t), intent(in) :: num_bytes ! logical :: rval - integer(c_size_t) :: offset_bytes + integer(c_size_t),intent(inout),optional :: offset_bytes + ! + integer(c_size_t) :: opt_offset_bytes ! - rval = is_subarray(record%hostptr,record%num_bytes, hostptr, num_bytes, offset_bytes) + rval = is_subarray(record%hostptr,record%num_bytes_used, hostptr, num_bytes, opt_offset_bytes) + if ( present(offset_bytes) ) offset_bytes = opt_offset_bytes end function + + !> Release the record for reuse/deallocation. + subroutine t_record_release_(record) + use iso_fortran_env + implicit none + class(t_record),intent(inout) :: record + ! + if ( LOG_LEVEL > 1 ) then + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][2] release record: " + flush(output_unit) + call record%print() + flush(output_unit) + endif + record%hostptr = c_null_ptr + record%num_refs = 0 + record%region = -1 + end subroutine - subroutine t_record_initialize_(record,hostptr,num_bytes,creational_event,current_region) + !> Setup newly created/reused record according to new hostptr. + subroutine t_record_setup_(record,hostptr,num_bytes,creational_event,region,reuse_existing) use iso_c_binding use hipfort_check use hipfort_hipmalloc @@ -372,34 +489,44 @@ subroutine t_record_initialize_(record,hostptr,num_bytes,creational_event,curren type(c_ptr), intent(in) :: hostptr integer(c_size_t), intent(in) :: num_bytes integer(kind(gpufort_acc_event_create)), intent(in) :: creational_event - integer, intent(in) :: current_region - ! - record%hostptr = hostptr - record%num_refs = 1 - record%num_bytes = num_bytes - record%region = current_region - record%creational_event = creational_event - call hipCheck(hipMalloc(record%deviceptr,blocked_size(num_bytes))) + integer, intent(in) :: region + logical, intent(in) :: reuse_existing + ! + record%hostptr = hostptr + record%num_refs = 1 + record%region = region + record%creational_event = creational_event + record%num_bytes_used = num_bytes + if ( .not. reuse_existing ) then + record_creation_counter_ = record_creation_counter_ + 1 + record%id = record_creation_counter_ + record%num_bytes = blocked_size(num_bytes) + call hipCheck(hipMalloc(record%deviceptr,record%num_bytes)) + endif if ( creational_event .eq. gpufort_acc_event_copyin .or. & creational_event .eq. gpufort_acc_event_copy ) & call record%copy_to_device() - - record%id = record_creation_counter_ - record_creation_counter_ = record_creation_counter_ + 1 end subroutine subroutine t_record_destroy_(record) use iso_c_binding + use iso_fortran_env use hipfort_check use hipfort_hipmalloc implicit none class(t_record),intent(inout) :: record ! + if ( LOG_LEVEL > 1 ) then + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][2] destroy record: " + flush(output_unit) + call record%print() + flush(output_unit) + endif call hipCheck(hipFree(record%deviceptr)) record%deviceptr = c_null_ptr - record%hostptr = c_null_ptr - record%num_refs = 0 - record%region = -1 + record%hostptr = c_null_ptr + record%num_refs = 0 + record%region = -1 end subroutine subroutine t_record_increment_num_refs_(record) @@ -409,80 +536,145 @@ subroutine t_record_increment_num_refs_(record) record%num_refs = record%num_refs + 1 end subroutine - function t_record_decrement_num_refs_(record) result(ret) + function t_record_decrement_num_refs_(record,threshold) result(ret) implicit none class(t_record),intent(inout) :: record + integer,intent(in),optional :: threshold ! logical :: ret ! record%num_refs = record%num_refs - 1 - ret = record%num_refs .eq. 0 + ret = record%num_refs <= eval_optval_(threshold,0) end function ! ! records_ ! - subroutine grow_records_() + function t_record_list_is_initialized_(record_list) result(ret) implicit none - integer :: old_size - type(t_record), save, allocatable :: new_records(:) + class(t_record_list),intent(inout) :: record_list + logical :: ret ! - old_size = SIZE(records_) + ret = allocated(record_list%records) + end function + + subroutine t_record_list_initialize_(record_list) + implicit none + class(t_record_list),intent(inout) :: record_list + ! + type(t_record), allocatable :: new_records(:) + integer :: old_size + ! + allocate(record_list%records(INITIAL_RECORDS_CAPACITY)) + end subroutine + + subroutine t_record_list_grow_(record_list) + implicit none + class(t_record_list),intent(inout) :: record_list + ! + type(t_record), allocatable :: new_records(:) + integer :: old_size + ! + old_size = size(record_list%records) allocate(new_records(old_size*2)) - new_records(1:old_size) = records_(1:old_size) - deallocate(records_) - call move_alloc(new_records,records_) + new_records(1:old_size) = record_list%records(1:old_size) + deallocate(record_list%records) + call move_alloc(new_records,record_list%records) + end subroutine + + subroutine t_record_list_destroy_(record_list) + implicit none + class(t_record_list),intent(inout) :: record_list + ! + integer :: i + ! + do i = 1, record_list%last_record_index + if ( record_list%records(i)%is_initialized() ) then + call record_list%records(i)%destroy() + endif + end do + deallocate(record_list%records) end subroutine !> Finds a record for a given host ptr and returns the location. !> !> \note Not thread safe - function find_record_(hostptr,success) result(loc) + function t_record_list_find_record_(record_list,hostptr,success) result(loc) use iso_fortran_env use iso_c_binding use gpufort_acc_runtime_c_bindings implicit none - type(c_ptr), intent(in) :: hostptr - logical, intent(inout) :: success + class(t_record_list),intent(inout) :: record_list + type(c_ptr), intent(in) :: hostptr + logical, intent(inout) :: success ! integer :: i, loc ! - if ( .not. c_associated(hostptr) ) ERROR STOP "gpufort_acc_runtime: find_record_: hostptr not c_associated" - loc = -1 - success = .FALSE. - do i = 1, last_record_index_ - !if ( c_associated(records_(i)%hostptr, hostptr) ) then - if ( records_(i)%is_subarray(hostptr, 0_8) ) then - loc = i - success = .TRUE. - exit ! loop - endif - end do -#if DEBUG > 2 - write(output_unit,fmt="(a)",advance="no") "[3]lookup record: " - flush(output_unit) - if ( success ) then - call records_(loc)%print() - else - write(output_unit,fmt="(a)",advance="yes") "NOT FOUND" + if ( .not. c_associated(hostptr) ) ERROR STOP "gpufort_acc_runtime: t_record_list_find_record_: hostptr not c_associated" + loc = -1 + success = .false. + if ( record_list%last_record_index > 0 ) then + do i = record_list%last_record_index, 1, -1 + if ( record_list%records(i)%is_subarray(hostptr, 0_8) ) then + loc = i + success = .true. + exit ! loop + endif + end do + if ( LOG_LEVEL > 2 ) then + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][3] lookup record: " + flush(output_unit) + if ( success ) then + call record_list%records(loc)%print() + flush(output_unit) + else + write(output_unit,fmt="(a)",advance="yes") "NOT FOUND" + flush(output_unit) + endif + endif endif -#endif end function - !> Searches first empty record from the begin of the record search space. - !> If it does not find an empty record in the current search space, + !> Searches first available record from the begin of the record search space. + !> If it does not find an available record in the current search space, !> it takes the record right after the end of the search space !> and grows the search space by 1. !> + !> Tries to reuse existing records that have been released. + !> Checks how many times a record has been considered (unsuccessfully) for reusing and deallocates + !> associated device data if that has happend NUM_REFS_TO_DEALLOCATE times (or more). + !> !> \note Not thread safe. - function find_first_empty_record_() result(loc) + function t_record_list_find_available_record_(record_list,num_bytes,reuse_existing) result(loc) implicit none + class(t_record_list),intent(inout) :: record_list + integer(c_size_t),intent(in) :: num_bytes + logical,intent(inout) :: reuse_existing + ! integer :: i, loc ! - do i = 1, last_record_index_ + 1 - if ( .not. records_(i)%is_initialized() ) then - loc = i + reuse_existing = .false. + loc = record_list%last_record_index+1 + do i = 1, record_list%last_record_index + if ( .not. record_list%records(i)%is_initialized() ) then ! 1. buffer is empty + loc = i + reuse_existing = .false. + exit ! exit loop + else if ( record_list%records(i)%is_released() ) then ! 2 found a released array + loc = i + if ( record_list%records(i)%num_bytes < num_bytes .or. & + num_bytes < record_list%records(i)%num_bytes * REUSE_THRESHOLD ) then ! 2.1 buffer too small/big + ! deallocate routinely unused memory blocks + if ( record_list%records(i)%decrement_num_refs(NUM_REFS_TO_DEALLOCATE) ) then ! side effect + record_list%total_memory_bytes = record_list%total_memory_bytes & + - record_list%records(loc)%num_bytes + call record_list%records(i)%destroy() + endif + reuse_existing = .false. + else ! 2. buffer size is fine + reuse_existing = .true. + endif exit ! exit loop endif end do @@ -492,87 +684,77 @@ function find_first_empty_record_() result(loc) !> reference counter. !> !> \note Not thread safe. - function insert_increment_record_(hostptr,num_bytes,creational_event,async) result(loc) + function t_record_list_use_increment_record_(record_list,hostptr,num_bytes,creational_event,async,module_var) result(loc) use iso_c_binding use iso_fortran_env use hipfort use hipfort_check implicit none + class(t_record_list),intent(inout) :: record_list type(c_ptr), intent(in) :: hostptr integer(c_size_t), intent(in) :: num_bytes integer(kind(gpufort_acc_event_create)), intent(in) :: creational_event - integer,optional,intent(in) :: async + integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! integer :: loc - logical :: success + logical :: success, reuse_existing ! - loc = find_record_(hostptr,success) + loc = record_list%find_record(hostptr,success) if ( success ) then - call records_(loc)%increment_num_refs() + call record_list%records(loc)%increment_num_refs() else - loc = find_first_empty_record_() - if (loc .ge. size(records_)) CALL grow_records_() + loc = record_list%find_available_record(num_bytes,reuse_existing) + if (loc .ge. size(record_list%records)) CALL record_list%grow() ! - call records_(loc)%initialize(hostptr,& - num_bytes,creational_event,current_region_) + call record_list%records(loc)%setup(hostptr,& + num_bytes,creational_event,record_list%current_region,reuse_existing) + if ( eval_optval_(module_var,.false.) ) record_list%records(loc)%region = 0 if ( creational_event .eq. gpufort_acc_event_copyin .or. & creational_event .eq. gpufort_acc_event_copy ) & - call records_(loc)%copy_to_device(async) + call record_list%records(loc)%copy_to_device(async) !print *, loc - last_record_index_ = max(loc, last_record_index_) - total_memory_b_ = total_memory_b_ + blocked_size(num_bytes) -#if DEBUG > 1 - write(output_unit,fmt="(a)",advance="no") "[2]created record: " - flush(output_unit) - call records_(loc)%print() - flush(output_unit) -#endif + record_list%last_record_index = max(loc, record_list%last_record_index) + record_list%total_memory_bytes = record_list%total_memory_bytes + record_list%records(loc)%num_bytes + if ( LOG_LEVEL > 1 ) then + if ( reuse_existing ) then + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][2] reuse record: " + else + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][2] create record: " + endif + flush(output_unit) + call record_list%records(loc)%print() + flush(output_unit) + endif endif end function - subroutine destroy_record_(record) - use iso_fortran_env - implicit none - class(t_record),intent(inout) :: record - ! - total_memory_b_ = total_memory_b_ - blocked_size(record%num_bytes) - -#if DEBUG > 1 - write(output_unit,fmt="(a)",advance="no") "[2]destroy record: " - flush(output_unit) - call record%print() - flush(output_unit) -#endif - - call record%destroy() - end subroutine - !> Deletes a record's reference counter and destroys the record if !> the reference counter is zero. Copies the data to the host beforehand !> if specified. !> !> \note Not thread safe. - subroutine decrement_delete_record_(hostptr,copy_to_host) + subroutine t_record_list_decrement_release_record_(record_list,hostptr,copy_to_host) use iso_c_binding use hipfort use hipfort_check implicit none - type(c_ptr),intent(in) :: hostptr + class(t_record_list),intent(inout) :: record_list + type(c_ptr),intent(in) :: hostptr ! logical :: copy_to_host ! integer :: loc logical :: success ! - loc = find_record_(hostptr,success) + loc = record_list%find_record(hostptr,success) if ( success ) then - if ( records_(loc)%decrement_num_refs() ) then - if ( copy_to_host ) call records_(loc)%copy_to_host() - call destroy_record_(records_(loc)) + if ( record_list%records(loc)%decrement_num_refs() ) then + if ( copy_to_host ) call record_list%records(loc)%copy_to_host() endif else #ifndef DELETE_NORECORD_MEANS_NOOP - ERROR STOP "gpufort_acc_runtime: decrement_delete_record: could not find matching record for hostptr" + ERROR STOP "gpufort_acc_runtime: t_record_list_decrement_release_record_: could not find matching record for hostptr" #endif return endif @@ -584,23 +766,49 @@ subroutine decrement_delete_record_(hostptr,copy_to_host) ! subroutine gpufort_acc_init() implicit none - allocate(records_(INITIAL_RECORDS_CAPACITY)) - initialized_ = .TRUE. + integer :: j + character(len=255) :: tmp + ! + if ( initialized_ ) then + ERROR STOP "gpufort_acc_init: runtime already initialized" + else + call get_environment_variable("GPUFORT_LOG_LEVEL", tmp) + if (len_trim(tmp) > 0) read(tmp,*) LOG_LEVEL + ! + call get_environment_variable("GPUFORT_MAX_QUEUES", tmp) + if (len_trim(tmp) > 0) read(tmp,*) MAX_QUEUES + call get_environment_variable("GPUFORT_INITIAL_RECORDS_CAPACITY", tmp) + if (len_trim(tmp) > 0) read(tmp,*) INITIAL_RECORDS_CAPACITY + ! + call get_environment_variable("GPUFORT_BLOCK_SIZE", tmp) + if (len_trim(tmp) > 0) read(tmp,*) BLOCK_SIZE + call get_environment_variable("GPUFORT_REUSE_THRESHOLD", tmp) + if (len_trim(tmp) > 0) read(tmp,*) REUSE_THRESHOLD + call get_environment_variable("GPUFORT_NUM_REFS_TO_DEALLOCATE", tmp) + if (len_trim(tmp) > 0) read(tmp,*) NUM_REFS_TO_DEALLOCATE + if ( LOG_LEVEL > 0 ) then + write(*,*) "GPUFORT_LOG_LEVEL=",LOG_LEVEL + write(*,*) "GPUFORT_MAX_QUEUES=",MAX_QUEUES + write(*,*) "GPUFORT_INITIAL_RECORDS_CAPACITY=",INITIAL_RECORDS_CAPACITY + write(*,*) "GPUFORT_BLOCK_SIZE=",BLOCK_SIZE + write(*,*) "GPUFORT_REUSE_THRESHOLD=",REUSE_THRESHOLD + write(*,*) "GPUFORT_NUM_REFS_TO_DEALLOCATE=",NUM_REFS_TO_DEALLOCATE + endif + ! + call record_list_%initialize() + allocate(queues_(MAX_QUEUES)) + initialized_ = .true. + endif end subroutine !> Deallocate all host data and the records_ and !> queue data structures.. subroutine gpufort_acc_shutdown() implicit none - integer :: i + integer :: i, j if ( .not. initialized_ ) ERROR STOP "gpufort_acc_shutdown: runtime not initialized" ! deallocate records_ - do i = 1, last_record_index_ - if ( records_(i)%is_initialized() ) then - call records_(i)%destroy() - endif - end do - deallocate(records_) + call record_list_%destroy() ! deallocate queues_ elements do i = 1, last_queue_index_ if ( queues_(i)%is_initialized() ) then @@ -651,22 +859,22 @@ subroutine gpufort_acc_wait(arg,async) use hipfort_check implicit none ! - integer,optional,intent(in),dimension(:) :: arg,async + integer,intent(in),optional,dimension(:) :: arg,async ! - integer :: i + integer :: i, j logical :: no_opt_present ! if ( .not. initialized_ ) ERROR STOP "gpufort_acc_wait: runtime not initialized" - no_opt_present = .TRUE. + no_opt_present = .true. if ( present(arg) ) then - no_opt_present = .FALSE. + no_opt_present = .false. do i=1,size(arg) call hipCheck(hipStreamSynchronize(queues_(arg(i))%queueptr)) end do endif ! if ( present(async) ) then - no_opt_present = .FALSE. + no_opt_present = .false. do i=1,size(async) ! acc_wait_async This function enqueues a wait operation on the queue async for any and all asynchronous operations that have been previously enqueued on any queue. !queues_(async(i))%enqueue_wait_event() @@ -686,22 +894,24 @@ subroutine gpufort_acc_wait(arg,async) !> \note We can use this also for a "normal" data section !> \note We can use this also for any other region that uses device data - subroutine gpufort_acc_enter_region(unstructured) + subroutine gpufort_acc_enter_region(unstructured,implicit_region) implicit none - logical,optional,intent(in) :: unstructured + logical,intent(in),optional :: unstructured + logical,intent(in),optional :: implicit_region if ( .not. initialized_ ) call gpufort_acc_init() - current_region_ = current_region_ + 1 + record_list_%current_region = record_list_%current_region + 1 end subroutine !> \note We can use this also for a "normal" end data section !> \note We can use this also for any other region exit that uses device data - subroutine gpufort_acc_exit_region(unstructured) + subroutine gpufort_acc_exit_region(unstructured,implicit_region) #ifdef EXIT_REGION_SYNCHRONIZE_DEVICE use hipfort use hipfort_check #endif implicit none - logical,optional,intent(in) :: unstructured + logical,intent(in),optional :: unstructured + logical,intent(in),optional :: implicit_region ! integer :: i, new_last_record_index ! @@ -712,25 +922,24 @@ subroutine gpufort_acc_exit_region(unstructured) call gpufort_acc_wait() #endif new_last_record_index = 0 - do i = 1, last_record_index_ - if ( records_(i)%is_initialized() ) then - if ( records_(i)%region .eq. current_region_ ) then - if ( records_(i)%creational_event .eq. gpufort_acc_event_create .or.& - records_(i)%creational_event .eq. gpufort_acc_event_copyin ) then - call destroy_record_(records_(i)) - else if ( records_(i)%creational_event .eq. gpufort_acc_event_copyout .or. & - records_(i)%creational_event .eq. gpufort_acc_event_copy ) then - call records_(i)%copy_to_host() ! synchronous - call destroy_record_(records_(i)) + do i = 1, record_list_%last_record_index + if ( record_list_%records(i)%is_initialized() ) then + if ( record_list_%records(i)%region .eq. record_list_%current_region ) then + if ( record_list_%records(i)%creational_event .eq. gpufort_acc_event_create .or.& + record_list_%records(i)%creational_event .eq. gpufort_acc_event_copyin ) then + call record_list_%records(i)%release() + else if ( record_list_%records(i)%creational_event .eq. gpufort_acc_event_copyout .or. & + record_list_%records(i)%creational_event .eq. gpufort_acc_event_copy ) then + call record_list_%records(i)%copy_to_host() ! synchronous + call record_list_%records(i)%release() endif - else - new_last_record_index = i endif + new_last_record_index = i endif end do - last_record_index_ = new_last_record_index + record_list_%last_record_index = new_last_record_index ! - current_region_ = current_region_ -1 + record_list_%current_region = record_list_%current_region -1 ! end subroutine @@ -747,70 +956,76 @@ subroutine gpufort_acc_exit_region(unstructured) !> decremented. !> !> \note We just return the device pointer here and do not modify the counters. - function gpufort_acc_present_b(hostptr,num_bytes,async,copy,copyin) result(deviceptr) + function gpufort_acc_present_b(hostptr,num_bytes,module_var,or,async) result(deviceptr) use iso_fortran_env use iso_c_binding use gpufort_acc_runtime_c_bindings implicit none type(c_ptr),intent(in) :: hostptr integer(c_size_t),intent(in) :: num_bytes - !logical,optional,intent(in) :: exiting - integer,optional,intent(in) :: async - logical,optional,intent(in) :: copy - logical,optional,intent(in) :: copyin + !logical,intent(in),optional :: exiting + logical,intent(in),optional :: module_var + integer(kind(gpufort_acc_event_undefined)),& + intent(in),optional :: or + integer,intent(in),optional :: async ! type(c_ptr) :: deviceptr ! - logical :: success,fits - integer :: loc integer(c_size_t) :: offset_bytes - logical :: opt_copyin - logical :: opt_copy + logical :: success, fits + integer(kind(gpufort_acc_event_undefined)) & + :: opt_or + integer :: loc, num_lists_to_check ! + if ( .not. initialized_ .and. eval_optval_(module_var,.false.) ) call gpufort_acc_init() if ( .not. initialized_ ) ERROR STOP "gpufort_acc_present_b: runtime not initialized" if ( .not. c_associated(hostptr) ) then ERROR STOP "gpufort_acc_present_b: hostptr not c_associated" - deviceptr = c_null_ptr else - loc = find_record_(hostptr,success) - if ( .not. success ) then - opt_copyin = .FALSE. - opt_copy = .FALSE. - if ( present(copy) ) opt_copy = copy - if ( present(copyin) ) opt_copyin = copyin - if ( opt_copy ) then - deviceptr = gpufort_acc_copy_b(hostptr,num_bytes,async) - else if ( opt_copyin ) then - deviceptr = gpufort_acc_copyin_b(hostptr,num_bytes,async) - else - print *, "ERROR: did not find record for hostptr:" - CALL print_cptr(hostptr) - ERROR STOP "gpufort_acc_present_b: no record found for hostptr" - end if + loc = record_list_%find_record(hostptr,success) ! TODO already detect a suitable candidate here on-the-fly + if ( success ) then + fits = record_list_%records(loc)%is_subarray(hostptr,num_bytes,offset_bytes) + deviceptr = inc_cptr(record_list_%records(loc)%deviceptr,offset_bytes) + else + offset_bytes = -1 + success = .true. + opt_or = eval_optval_(or,gpufort_acc_event_undefined) + select case (opt_or) + case (gpufort_acc_event_copy) + deviceptr = gpufort_acc_copy_b(hostptr,num_bytes,async,module_var) + case (gpufort_acc_event_create) + deviceptr = gpufort_acc_create_b(hostptr,num_bytes,async,module_var) + case (gpufort_acc_event_copyin) + deviceptr = gpufort_acc_copyin_b(hostptr,num_bytes,async,module_var) + case (gpufort_acc_event_copyout) + deviceptr = gpufort_acc_copyout_b(hostptr,num_bytes,async,module_var) + case default + success = .false. + print *, "ERROR: did not find record for hostptr:" + CALL print_cptr(hostptr) + ERROR STOP "gpufort_acc_present_b: no record found for hostptr" + end select + endif + if ( LOG_LEVEL > 0 .and. success ) then + write(output_unit,fmt="(a)",advance="no") "[gpufort-rt][1] gpufort_acc_present_b: retrieved deviceptr=" + flush(output_unit) + CALL print_cptr(deviceptr) + flush(output_unit) + write(output_unit,fmt="(a,i0.0,a)",advance="no") "(offset_bytes=",offset_bytes,",base deviceptr=" + flush(output_unit) + CALL print_cptr(record_list_%records(loc)%deviceptr) + flush(output_unit) + write(output_unit,fmt="(a,i0.0)",advance="no") ",base num_bytes=", record_list_%records(loc)%num_bytes + write(output_unit,fmt="(a)",advance="no") ") for hostptr=" + flush(output_unit) + CALL print_cptr(hostptr) + flush(output_unit) + print *, "" endif - ! TODO replace 0 by size of searched hostptr - fits = is_subarray(records_(loc)%hostptr,records_(loc)%num_bytes,hostptr,0_8,offset_bytes) - deviceptr = inc_cptr(records_(loc)%deviceptr,offset_bytes) -#if DEBUG > 0 - write(output_unit,fmt="(a)",advance="no") "[1]gpufort_acc_present_b: retrieved deviceptr=" - flush(output_unit) - CALL print_cptr(deviceptr) - flush(output_unit) - write(output_unit,fmt="(a,i0.0,a)",advance="no") "(offset_bytes=",offset_bytes,",base deviceptr=" - flush(output_unit) - CALL print_cptr(records_(loc)%deviceptr) - flush(output_unit) - write(output_unit,fmt="(a,i0.0)",advance="no") ",base num_bytes=", records_(loc)%num_bytes - write(output_unit,fmt="(a)",advance="no") ") for hostptr=" - flush(output_unit) - CALL print_cptr(hostptr) - flush(output_unit) - print *, "" -#endif !if (exiting) then - ! records_(loc)%decrement_num_refs() + ! record_list_%records(loc)%decrement_num_refs() !else - ! records_(loc)%increment_num_refs() + ! record_list_%records(loc)%increment_num_refs() !endif endif end function @@ -826,22 +1041,25 @@ function gpufort_acc_present_b(hostptr,num_bytes,async,copy,copyin) result(devic !> counts are zero, the device memory is deallocated. !> !> \note Only use this when entering not when exiting - function gpufort_acc_create_b(hostptr,num_bytes) result(deviceptr) + function gpufort_acc_create_b(hostptr,num_bytes,async,module_var) result(deviceptr) use iso_c_binding implicit none type(c_ptr),intent(in) :: hostptr integer(c_size_t),intent(in) :: num_bytes + integer,intent(in),optional :: async ! ignored for now + logical,intent(in),optional :: module_var type(c_ptr) :: deviceptr ! integer :: loc ! - if ( .not. initialized_ ) ERROR STOP "gpufort_acc_create_b: runtime not initialized" + if ( .not. initialized_ .and. eval_optval_(module_var,.false.) ) call gpufort_acc_init() + if ( .not. initialized_ ) ERROR STOP "gpufort_acc_create_b: runtime not initalized" if ( .not. c_associated(hostptr) ) then ERROR STOP "gpufort_acc_create_b: hostptr not c_associated" - deviceptr = c_null_ptr else - loc = insert_increment_record_(hostptr,num_bytes,gpufort_acc_event_create) - deviceptr = records_(loc)%deviceptr + loc = record_list_%use_increment_record(hostptr,num_bytes,& + gpufort_acc_event_create,async,module_var) + deviceptr = record_list_%records(loc)%deviceptr endif end function @@ -853,23 +1071,23 @@ function gpufort_acc_create_b(hostptr,num_bytes) result(deviceptr) !> for that data. !> !> \note We just return the device pointer here (or c_null_ptr) and do not modify the counters. - function gpufort_acc_no_create_b(hostptr) result(deviceptr) + function gpufort_acc_no_create_b(hostptr,module_var) result(deviceptr) use iso_c_binding implicit none - type(c_ptr), intent(in) :: hostptr + type(c_ptr), intent(in) :: hostptr + logical,intent(in),optional :: module_var type(c_ptr) :: deviceptr ! - integer :: loc logical :: success + integer :: loc ! - if ( .not. initialized_ ) ERROR STOP "gpufort_acc_no_create_b: runtime not initialized" + if ( .not. initialized_ ) ERROR STOP "gpufort_acc_create_b: runtime not initalized" if ( .not. c_associated(hostptr) ) then ERROR STOP "gpufort_acc_no_create_b: hostptr not c_associated" - deviceptr = c_null_ptr else - loc = find_record_(hostptr,success) + loc = record_list_%find_record(hostptr,success) deviceptr = c_null_ptr - if ( success ) deviceptr = records_(loc)%deviceptr + if ( success ) deviceptr = record_list_%records(loc)%deviceptr endif end function @@ -889,14 +1107,14 @@ function gpufort_acc_no_create_b(hostptr) result(deviceptr) !> the acc_delete_finalize or acc_delete API routine, respectively, as described in Section 3.2.23. !> !> \note use - subroutine gpufort_acc_delete_b(hostptr,finalize) + subroutine gpufort_acc_delete_b(hostptr,finalize,module_var) use iso_c_binding implicit none type(c_ptr), intent(in) :: hostptr - logical,intent(in),optional :: finalize + logical,intent(in),optional :: finalize, module_var ! - integer :: loc logical :: success, opt_finalize + integer :: loc ! if ( .not. initialized_ ) ERROR STOP "gpufort_acc_delete_b: runtime not initialized" if ( .not. c_associated(hostptr) ) then @@ -905,14 +1123,14 @@ subroutine gpufort_acc_delete_b(hostptr,finalize) #endif return else - opt_finalize = .FALSE. + opt_finalize = .false. if ( present(finalize) ) opt_finalize = finalize if ( opt_finalize ) then - loc = find_record_(hostptr,success) + loc = record_list_%find_record(hostptr,success) if ( .not. success ) ERROR STOP "gpufort_acc_delete: no record found for hostptr" - call records_(loc)%destroy() + call record_list_%records(loc)%release() else - call decrement_delete_record_(hostptr,copy_to_host=.FALSE.) + call record_list_%decrement_release_record(hostptr,copy_to_host=.false.) endif endif end subroutine @@ -932,17 +1150,19 @@ subroutine gpufort_acc_delete_b(hostptr,finalize) !> zero, the device memory is deallocated. !> !> \note Exiting case handled in gpufort_acc_exit_region - function gpufort_acc_copyin_b(hostptr,num_bytes,async) result(deviceptr) + function gpufort_acc_copyin_b(hostptr,num_bytes,async,module_var) result(deviceptr) use iso_c_binding implicit none type(c_ptr), intent(in) :: hostptr integer(c_size_t),intent(in) :: num_bytes - integer,optional,intent(in) :: async + integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! integer :: loc ! + if ( .not. initialized_ .and. eval_optval_(module_var,.false.) ) call gpufort_acc_init() if ( .not. initialized_ ) ERROR STOP "gpufort_acc_copyin_b: runtime not initialized" if ( .not. c_associated(hostptr) ) then #ifndef NULLPTR_MEANS_NOOP @@ -950,8 +1170,8 @@ function gpufort_acc_copyin_b(hostptr,num_bytes,async) result(deviceptr) #endif deviceptr = c_null_ptr else - loc = insert_increment_record_(hostptr,num_bytes,gpufort_acc_event_copyin,async) - deviceptr = records_(loc)%deviceptr + loc = record_list_%use_increment_record(hostptr,num_bytes,gpufort_acc_event_copyin,async,module_var) + deviceptr = record_list_%records(loc)%deviceptr endif end function @@ -971,18 +1191,20 @@ function gpufort_acc_copyin_b(hostptr,num_bytes,async) result(deviceptr) !> thread and the device memory is deallocated. !> !> \note Exiting case handled in gpufort_acc_exit_region - function gpufort_acc_copyout_b(hostptr,num_bytes,async) result(deviceptr) + function gpufort_acc_copyout_b(hostptr,num_bytes,async,module_var) result(deviceptr) use iso_c_binding implicit none ! Return type(c_ptr) type(c_ptr), intent(in) :: hostptr integer(c_size_t),intent(in) :: num_bytes - integer,optional,intent(in) :: async + integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! integer :: loc ! + if ( .not. initialized_ .and. eval_optval_(module_var,.false.) ) call gpufort_acc_init() if ( .not. initialized_ ) ERROR STOP "gpufort_acc_copyout_b: runtime not initialized" if ( .not. c_associated(hostptr) ) then #ifndef NULLPTR_MEANS_NOOP @@ -990,8 +1212,8 @@ function gpufort_acc_copyout_b(hostptr,num_bytes,async) result(deviceptr) #endif deviceptr = c_null_ptr else - loc = insert_increment_record_(hostptr,num_bytes,gpufort_acc_event_copyout,async) - deviceptr = records_(loc)%deviceptr + loc = record_list_%use_increment_record(hostptr,num_bytes,gpufort_acc_event_copyout,async,module_var) + deviceptr = record_list_%records(loc)%deviceptr endif end function @@ -1006,18 +1228,20 @@ function gpufort_acc_copyout_b(hostptr,num_bytes,async) result(deviceptr) !> encountering thread and the device memory is deallocated. !> !> \note Exiting case handled in gpufort_acc_exit_region - function gpufort_acc_copy_b(hostptr,num_bytes,async) result(deviceptr) + function gpufort_acc_copy_b(hostptr,num_bytes,async,module_var) result(deviceptr) use iso_c_binding implicit none ! Return type(c_ptr) type(c_ptr), intent(in) :: hostptr integer(c_size_t),intent(in) :: num_bytes - integer,optional,intent(in) :: async + integer,intent(in),optional :: async + logical,intent(in),optional :: module_var ! type(c_ptr) :: deviceptr ! integer :: loc ! + if ( .not. initialized_ .and. eval_optval_(module_var,.false.) ) call gpufort_acc_init() if ( .not. initialized_ ) ERROR STOP "gpufort_acc_copy_b: runtime not initialized" if ( .not. c_associated(hostptr) ) then #ifndef NULLPTR_MEANS_NOOP @@ -1025,8 +1249,9 @@ function gpufort_acc_copy_b(hostptr,num_bytes,async) result(deviceptr) #endif deviceptr = c_null_ptr else - loc = insert_increment_record_(hostptr,num_bytes,gpufort_acc_event_copy,async) - deviceptr = records_(loc)%deviceptr + loc = record_list_%use_increment_record(hostptr,num_bytes,& + gpufort_acc_event_copy,async,module_var) + deviceptr = record_list_%records(loc)%deviceptr endif end function @@ -1048,14 +1273,15 @@ function gpufort_acc_copy_b(hostptr,num_bytes,async) result(deviceptr) !> device( list ) !> Copies the data in list from the encountering thread to the !> device. - subroutine gpufort_acc_update_host_b(hostptr,condition,if_present,async) + subroutine gpufort_acc_update_host_b(hostptr,condition,if_present,async,module_var) use iso_c_binding implicit none type(c_ptr),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present + logical,intent(in),optional :: condition, if_present, module_var integer,intent(in),optional :: async ! integer :: loc + ! logical :: success, opt_condition, opt_if_present ! if ( .not. initialized_ ) ERROR STOP "gpufort_acc_update_host_b: runtime not initialized" @@ -1065,20 +1291,20 @@ subroutine gpufort_acc_update_host_b(hostptr,condition,if_present,async) #endif return endif - opt_condition = .True. - opt_if_present = .False. + opt_condition = .true. + opt_if_present = .false. if ( present(condition) ) opt_condition = condition if ( present(if_present) ) opt_if_present = if_present ! if ( opt_condition ) then - loc = find_record_(hostptr,success) + loc = record_list_%find_record(hostptr,success) ! if ( .not. success .and. .not. opt_if_present ) ERROR STOP "gpufort_acc_update_host_b: no deviceptr found for hostptr" ! if ( success .and. present(async) ) then - call records_(loc)%copy_to_host(async) + call record_list_%records(loc)%copy_to_host(async) else if ( success ) then - call records_(loc)%copy_to_host() + call record_list_%records(loc)%copy_to_host() endif endif end subroutine @@ -1102,7 +1328,7 @@ subroutine gpufort_acc_update_host_b(hostptr,condition,if_present,async) !> Copies the data in list from the encountering thread to the !> device. !> if( condition ) - !> When the condition is zero or .FALSE., no data will be moved to + !> When the condition is zero or .false., no data will be moved to !> or from the device. !> if_present !> Issue no error when the data is not present on the device. @@ -1112,11 +1338,11 @@ subroutine gpufort_acc_update_host_b(hostptr,condition,if_present,async) !> wait [( expression-list )] - TODO not implemented !> The data movement will not begin execution until all actions on !> the corresponding async queue(s) are complete. - subroutine gpufort_acc_update_device_b(hostptr,condition,if_present,async) + subroutine gpufort_acc_update_device_b(hostptr,condition,if_present,async,module_var) use iso_c_binding implicit none type(c_ptr),intent(in) :: hostptr - logical,intent(in),optional :: condition, if_present + logical,intent(in),optional :: condition, if_present, module_var integer,intent(in),optional :: async ! integer :: loc @@ -1129,20 +1355,20 @@ subroutine gpufort_acc_update_device_b(hostptr,condition,if_present,async) #endif return endif - opt_condition = .True. - opt_if_present = .False. + opt_condition = .true. + opt_if_present = .false. if ( present(condition) ) opt_condition = condition if ( present(if_present) ) opt_if_present = if_present ! if ( opt_condition ) then - loc = find_record_(hostptr,success) + loc = record_list_%find_record(hostptr,success) ! if ( .not. success .and. .not. opt_if_present ) ERROR STOP "gpufort_acc_update_device_b: no deviceptr found for hostptr" ! if ( success .and. present(async) ) then - call records_(loc)%copy_to_device(async) + call record_list_%records(loc)%copy_to_device(async) else if ( success ) then - call records_(loc)%copy_to_device() + call record_list_%records(loc)%copy_to_device() endif endif end subroutine diff --git a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_c_impl.h b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_c_impl.h index 6f85a10d..42fcff29 100644 --- a/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_c_impl.h +++ b/runtime/gpufort_acc_runtime/src/gpufort_acc_runtime_c_impl.h @@ -16,6 +16,7 @@ std::ostream& operator<<(std::ostream& os, record_creational_event ce) case record_creational_event::gpufort_acc_event_create : os << "create"; break; case record_creational_event::gpufort_acc_event_copyin : os << "copyin"; break; case record_creational_event::gpufort_acc_event_copyout : os << "copyout"; break; + case record_creational_event::gpufort_acc_event_copy : os << "copy"; break; default: os.setstate(std::ios_base::failbit); } return os; diff --git a/runtime/gpufort_acc_runtime/test/Makefile b/runtime/gpufort_acc_runtime/test/Makefile index 1f5c1245..1c5880c2 100644 --- a/runtime/gpufort_acc_runtime/test/Makefile +++ b/runtime/gpufort_acc_runtime/test/Makefile @@ -12,4 +12,4 @@ $(TEST): %: %.f90 $(FC) $< $(FCFLAGS) $(LD_FLAGS) -o $@ clean: - rm -f $(TEST) \ No newline at end of file + rm -f $(TEST) diff --git a/runtime/gpufort_acc_runtime/test/test.f90 b/runtime/gpufort_acc_runtime/test/test_c_ptr_association.f90 similarity index 100% rename from runtime/gpufort_acc_runtime/test/test.f90 rename to runtime/gpufort_acc_runtime/test/test_c_ptr_association.f90 diff --git a/runtime/gpufort_acc_runtime/test/test_optional_values.f90 b/runtime/gpufort_acc_runtime/test/test_optional_values.f90 new file mode 100644 index 00000000..44f5ba6c --- /dev/null +++ b/runtime/gpufort_acc_runtime/test/test_optional_values.f90 @@ -0,0 +1,29 @@ +program test_optvals + implicit none + + print *, caller() + print *, caller(optval=.false.) + print *, caller(optval=.true.) + +contains + + function caller(optval) result(retval) + implicit none + logical,optional,intent(in) :: optval + logical :: retval + retval = eval_opt_logical_(optval,.false.) + end function + + function eval_opt_logical_(optval,fallback) result(retval) + implicit none + logical,optional,intent(in) :: optval + logical,intent(in) :: fallback + logical :: retval + if ( present(optval) ) then + retval = optval + else + retval = fallback + endif + end function + +end program test_optvals diff --git a/runtime/examples/openacc_gomp/Makefile b/runtime/openacc_gomp/examples/Makefile similarity index 100% rename from runtime/examples/openacc_gomp/Makefile rename to runtime/openacc_gomp/examples/Makefile diff --git a/runtime/examples/openacc_gomp/hipblasSaxpy.f90 b/runtime/openacc_gomp/examples/hipblasSaxpy.f90 similarity index 100% rename from runtime/examples/openacc_gomp/hipblasSaxpy.f90 rename to runtime/openacc_gomp/examples/hipblasSaxpy.f90 diff --git a/runtime/examples/openacc_gomp/structured_data_region.f90 b/runtime/openacc_gomp/examples/structured_data_region.f90 similarity index 100% rename from runtime/examples/openacc_gomp/structured_data_region.f90 rename to runtime/openacc_gomp/examples/structured_data_region.f90 diff --git a/runtime/examples/openacc_gomp/unstructured_data_region.f90 b/runtime/openacc_gomp/examples/unstructured_data_region.f90 similarity index 100% rename from runtime/examples/openacc_gomp/unstructured_data_region.f90 rename to runtime/openacc_gomp/examples/unstructured_data_region.f90 diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 00000000..444b05bc --- /dev/null +++ b/src/Makefile @@ -0,0 +1,41 @@ +# compiler options +FC ?= hipfc +HIPCC ?= hipcc + +GPUFORT_INC = -I$(shell gpufort --path)/include + +FC_CFLAGS ?= -std=f2008 -ffree-line-length-none -cpp -fmax-errors=5 +HIPCC_CFLAGS ?= -fPIC -DGPUFORT_ARRAYS_ALWAYS_PIN_HOST_DATA +#HIPCC_CFLAGS += -g -ggdb +SUFFIX ?= $(if $(HIP_PLATFORM),$(HIP_PLATFORM),amd) +LIBGPUFORT = libgpufort_$(SUFFIX).a + +# files +HIP_SRC = $(shell find . -name "*.hip.cpp") +FORT_SRC = $(shell find . -name "*.f03") + +HIP_OBJ = $(HIP_SRC:%.hip.cpp=%.hip.o) +FORT_OBJ = $(FORT_SRC:%.f03=%.o) + +# targets +.PHONY: all clean clean_all gpufort_sources $(LIBGPUFORT) + +all: gpufort_sources $(LIBGPUFORT) + +gpufort_sources: + gpufort --create-gpufort-sources + +$(HIP_OBJ): %.hip.o: %.hip.cpp + $(HIPCC) $(GPUFORT_INC) $(HIPCC_CFLAGS) -c $^ -o $@ + +$(FORT_OBJ): %.o: %.f03 + $(FC) $(FC_CFLAGS) -c $^ -o $@ + +$(LIBGPUFORT): $(FORT_OBJ) $(HIP_OBJ) + ar -crs $@ $^ + +clean: + rm -f $(FORT_OBJ) $(HIP_OBJ) *.mod $(LIBGPUFORT) + +clean_all: clean + rm -f $(FORT_SRC) $(HIP_SRC) diff --git a/studies/gfortran/interoperability/Makefile b/studies/gfortran/interoperability/Makefile index 4591254d..7604d3ae 100644 --- a/studies/gfortran/interoperability/Makefile +++ b/studies/gfortran/interoperability/Makefile @@ -1,4 +1,4 @@ -TEST ?= nested-types +TEST ?= nested-types callbacks DEPS ?= nested-types.cpp SOURCES ?= $(TEST).f90 $(DEPS) DEPS_OBJ = $(DEPS:.cpp=.o) diff --git a/studies/gfortran/interoperability/callbacks.f90 b/studies/gfortran/interoperability/callbacks.f90 new file mode 100644 index 00000000..65d14478 --- /dev/null +++ b/studies/gfortran/interoperability/callbacks.f90 @@ -0,0 +1,56 @@ +program callbacks + use iso_c_binding + implicit none + ! + type custom_type_t + integer, allocatable :: buffer(:) + end type + ! + type record_t + type(c_ptr) :: ptr = c_null_ptr + type(c_funptr) :: destructor = c_null_funptr + end type + ! + type(custom_type_t),target :: custom_type + type(record_t) :: record + ! + allocate(custom_type%buffer(10)) + record%ptr=c_loc(custom_type) + record%destructor=c_funloc(destructor) + call call_destructor(record) + + record%destructor = c_null_funptr + call call_destructor(record) +contains + +subroutine destructor(cptr) + use iso_c_binding + implicit none + type(c_ptr),intent(in) :: cptr + type(custom_type_t),pointer :: custom_type + call c_f_pointer(cptr,custom_type) + print *, "destructor of `custom_type_t`" + print *, "deallocate buffer of len ",size(custom_type%buffer) + deallocate(custom_type%buffer) +end subroutine + +subroutine call_destructor(record) + implicit none + type(record_t),intent(inout) :: record + interface + subroutine destroy(cptr) + use iso_c_binding + implicit none + type(c_ptr),intent(in) :: cptr + end subroutine + end interface + procedure(destroy),pointer :: callback + if ( c_associated(record%destructor) ) then + call c_f_procpointer(record%destructor,callback) + call callback(record%ptr) + else + print *, "destructor pointer not c_associated" + endif +end subroutine + +end program diff --git a/test/gpufort_array/Makefile b/test/gpufort_array/Makefile new file mode 100644 index 00000000..3880b0aa --- /dev/null +++ b/test/gpufort_array/Makefile @@ -0,0 +1,28 @@ +HIP_TEST_SRC = test_compile_headers.hip.cpp test_gpufort_array.hip.cpp +HIP_TEST_APP = $(HIP_TEST_SRC:.hip.cpp=.x) + +FORT_TEST_SRC = test_gpufort_array_interop.f03 +FORT_TEST_APP = $(FORT_TEST_SRC:.f03=.x) +FORT_TEST_DEPS = test_gpufort_array_kernels.hip.o + +HIPCC_CFLAGS ?= $(shell gpufort --cpp_config) -g -ggdb +FC_CFLAGS ?= $(shell gpufort --gfortran_config) -g -ggdb + +LDFLAGS ?= $(shell gpufort --ldflags) + +.PHONY: clean $(HIP_TEST_APP) $(FORT_TEST_APP) generate_headers + +$(HIP_TEST_APP): %.x: %.hip.cpp + hipcc $(HIPCC_CFLAGS) $^ -o $@ + +$(FORT_TEST_APP): %.x: %.f03 $(FORT_TEST_DEPS) + hipfc $(FC_CFLAGS) $^ -o $@ $(LDFLAGS) + +generate_headers: + make -C ../../ gpufort_headers + +%.hip.o: %.hip.cpp + hipcc -c $(HIPCC_CFLAGS) $^ -o $@ + +clean: + rm -f $(HIP_TEST_APP) $(FORT_TEST_APP) *.o *.mod \ No newline at end of file diff --git a/test/gpufort_array/test_compile_headers.hip.cpp b/test/gpufort_array/test_compile_headers.hip.cpp new file mode 100644 index 00000000..d4804826 --- /dev/null +++ b/test/gpufort_array/test_compile_headers.hip.cpp @@ -0,0 +1,7 @@ +#include "gpufort.h" +#include "gpufort_array.h" +#include "gpufort_reduction.h" + +int main(int argc,char** argv) { + return 0; +} diff --git a/test/gpufort_array/test_gpufort_array.hip.cpp b/test/gpufort_array/test_gpufort_array.hip.cpp new file mode 100644 index 00000000..06341d21 --- /dev/null +++ b/test/gpufort_array/test_gpufort_array.hip.cpp @@ -0,0 +1,79 @@ +#include "gpufort.h" +#include "gpufort_array.h" + +#include + +#include "test_gpufort_array_kernels.hip.cpp" + +void test1() { + gpufort::array1 int_array1; + gpufort::array2 int_array2; + gpufort::array3 int_array3; + + HIP_CHECK(int_array1.init(sizeof(int),nullptr,nullptr, 10, -1, + gpufort::AllocMode::AllocPinnedHostAllocDevice)); // hostptr,devptr, count, lower bound, alloc_mode + HIP_CHECK(int_array2.init(sizeof(int),nullptr,nullptr, 10,10, -1,-2, + gpufort::AllocMode::AllocHostAllocDevice)); + HIP_CHECK(int_array3.init(sizeof(int),nullptr,nullptr, 10,10,10, -1,-2,-3, + gpufort::AllocMode::AllocPinnedHostAllocDevice)); + + assert( 10==int_array1.data.num_elements); + assert( 100==int_array2.data.num_elements); + assert(1000==int_array3.data.num_elements); + + assert( 1==int_array1.data.index_offset); + assert( 21==int_array2.data.index_offset); + assert(321==int_array3.data.index_offset); + + assert(0==int_array1.linearized_index(-1)); + assert(0==int_array2.linearized_index(-1,-2)); + assert(0==int_array3.linearized_index(-1,-2,-3)); + + assert( 9==int_array1.linearized_index(-1+10-1)); // upper bound + assert( 99==int_array2.linearized_index(-1+10-1,-2+10-1)); + assert(999==int_array3.linearized_index(-1+10-1,-2+10-1,-3+10-1)); + + launch_fill_int_array_1(int_array1); + launch_fill_int_array_2(int_array2); + launch_fill_int_array_3(int_array3); + + HIP_CHECK(int_array1.copy_to_host()); + HIP_CHECK(int_array2.copy_to_host()); + HIP_CHECK(int_array3.copy_to_host()); + + HIP_CHECK(hipDeviceSynchronize()); + + for (int n = 0; n < int_array1.data.num_elements; n++ ) { + //std::cout << int_array1.data.data_host[n] << std::endl; + assert(int_array1.data.data_host[n] == n); + } + for (int n = 0; n < int_array2.data.num_elements; n++ ) { + assert(int_array2.data.data_host[n] == n); + } + for (int n = 0; n < int_array3.data.num_elements; n++ ) { + assert(int_array3.data.data_host[n] == n); + } +} + +void test2() { + gpufort::array3 bool_array; + gpufort::array3 short_array; + gpufort::array3 char_array; + gpufort::array3 int_array; + gpufort::array3 long_array; + gpufort::array3 float_array; + gpufort::array3 double_array; + assert(sizeof(bool_array)==sizeof(short_array)); + assert(sizeof(char_array)==sizeof(short_array)); + assert(sizeof(char_array)==sizeof(int_array)); + assert(sizeof(long_array)==sizeof(int_array)); + assert(sizeof(long_array)==sizeof(float_array)); + assert(sizeof(double_array)==sizeof(float_array)); +} + +int main(int argc,char** argv) { + test1(); + test2(); + std::cout << "PASSED" << std::endl; + return 0; +} diff --git a/test/gpufort_array/test_gpufort_array_interop.f03 b/test/gpufort_array/test_gpufort_array_interop.f03 new file mode 100644 index 00000000..60e09455 --- /dev/null +++ b/test/gpufort_array/test_gpufort_array_interop.f03 @@ -0,0 +1,194 @@ +program test_gpufort_array_interop + call test_array_initialization() + call test_hip_interfacing() + print *, "PASSED" +contains + + subroutine assert(condition) + logical,intent(in) :: condition + ! + if ( .not. condition ) ERROR STOP "assertion failed" + end subroutine + + subroutine test_array_initialization() + use gpufort_array + use hipfort_check + use hipfort + implicit none + ! + type(gpufort_array3) :: gpufort_arr3 + type(gpufort_array4) :: gpufort_arr4 + type(gpufort_array5) :: gpufort_arr5 + ! + real(c_float),target :: host_array_3(-1:8,-2:7,-3:6) + real(c_double_complex),target :: host_array_4(-1:8,-2:7,-3:6,-4:5) + integer(c_int),pointer,dimension(:,:,:,:,:) :: host_array_5, device_array_5 + ! + integer :: i,j,k,n + + ! + ! PART 1: Creating mapped arrays + ! + + ! direct access; set from existing pointer + ! mapped_array,& + ! bytes_per_element,& + ! data_host,data_dev,& + ! sizes, lbounds,& + ! alloc_mode,sync_mode) & + call hipCheck(gpufort_array_init(gpufort_arr3,& + c_float,c_loc(host_array_3),c_null_ptr,& + shape(host_array_3),lbound(host_array_3),& + gpufort_array_wrap_host_alloc_device,& + gpufort_array_sync_none)) + + call assert(gpufort_arr3%data%stride1==1) + call assert(gpufort_arr3%data%stride2==10) + call assert(gpufort_arr3%data%stride3==100) + call assert(gpufort_arr3%data%index_offset==321) + call assert(gpufort_arr3%data%num_elements==1000) + + ! overloaded access; set from existing pointer + call hipCheck(gpufort_array_init(gpufort_arr4,& + host_array_4, lbounds=lbound(host_array_4))) + + call assert(gpufort_arr4%data%stride1==1) + call assert(gpufort_arr4%data%stride2==10) + call assert(gpufort_arr4%data%stride3==100) + call assert(gpufort_arr4%data%stride4==1000) + call assert(gpufort_arr4%data%index_offset==4321) + call assert(gpufort_arr4%data%num_elements==10000) + + ! allocate device AND (pinned) host array + call hipCheck(gpufort_array_init(gpufort_arr5,& + c_int,[4,4,4,4,4],lbounds=[-1,-1,-1,-1,-1],& + alloc_mode=gpufort_array_alloc_pinned_host_alloc_device)) + call assert(gpufort_arr5%data%stride1==1) + call assert(gpufort_arr5%data%stride2==4) + call assert(gpufort_arr5%data%stride3==16) + call assert(gpufort_arr5%data%stride4==64) + call assert(gpufort_arr5%data%stride5==256) + call assert(gpufort_arr5%data%index_offset==1+4+16+64+256) + call assert(gpufort_arr5%data%num_elements==1024) + + ! obtain host data as Fortran pointer + call gpufort_array_hostptr(gpufort_arr5,host_array_5) + do n = 1,5 + call assert(size(host_array_5,n) == 4) + call assert(lbound(host_array_5,n) == -1) + end do + !call assert(c_loc(host_array_5) == gpufort_arr5%data%data_host) + + ! obtain device data as Fortran pointer + call gpufort_array_deviceptr(gpufort_arr5,device_array_5) + do n = 1,5 + call assert(size(device_array_5,n) == 4) + call assert(lbound(device_array_5,n) == -1) + end do + !call assert(c_loc(device_array_5) == gpufort_arr5%data%data_dev) + + ! destroy + call hipCheck(gpufort_array_destroy(gpufort_arr3)) + call hipCheck(gpufort_array_destroy(gpufort_arr4)) + call hipCheck(gpufort_array_destroy(gpufort_arr5)) + end subroutine + + subroutine test_hip_interfacing() + use gpufort_array + use hipfort_check + use hipfort + implicit none + ! + interface + subroutine launch_fill_int_array_1(arr) & + bind(c,name="launch_fill_int_array_1") + use gpufort_array + type(gpufort_array1),intent(inout) :: arr + end subroutine + subroutine launch_fill_int_array_2(arr) & + bind(c,name="launch_fill_int_array_2") + use gpufort_array + type(gpufort_array2),intent(inout) :: arr + end subroutine + subroutine launch_fill_int_array_3(arr) & + bind(c,name="launch_fill_int_array_3") + use gpufort_array + type(gpufort_array3),intent(inout) :: arr + end subroutine + end interface + ! + type(gpufort_array1) :: gpufort_int_arr1 + type(gpufort_array2) :: gpufort_int_arr2 + type(gpufort_array3) :: gpufort_int_arr3 + ! + integer(c_int),target :: int_array_1(-1:8) + integer(c_int),target :: int_array_2(-1:8,-2:7) + integer(c_int),target :: int_array_3(-1:8,-2:7,-3:6) + ! + integer(c_int) :: int_buffer_3(-1:8,-2:7,-3:6) + ! + integer :: i,j,k,n + + ! + ! PART 2: Interfacing + ! + call hipCheck(gpufort_array_init(gpufort_int_arr1,& + int_array_1, lbounds=lbound(int_array_1))) + call hipCheck(gpufort_array_init(gpufort_int_arr2,& + int_array_2, lbounds=lbound(int_array_2))) + call hipCheck(gpufort_array_init(gpufort_int_arr3,& + int_array_3, lbounds=lbound(int_array_3))) + + ! call C code + call launch_fill_int_array_1(gpufort_int_arr1) + call launch_fill_int_array_2(gpufort_int_arr2) + call launch_fill_int_array_3(gpufort_int_arr3) + + ! check + call hipCheck(hipStreamSynchronize(c_null_ptr)) + + ! copy data to host + call hipCheck(gpufort_array_copy_to_host(gpufort_int_arr1)) + call hipCheck(gpufort_array_copy_to_host(gpufort_int_arr2)) + call hipCheck(gpufort_array_copy_to_host(gpufort_int_arr3)) + + n=0 + do i = -1,8 + call assert(int_array_1(i) == n) + n = n +1 + end do + n=0 + do j = -2,7 + do i = -1,8 + call assert(int_array_2(i,j) == n) + n = n +1 + end do + end do + n=0 + do k = -3,6 + do j = -2,7 + do i = -1,8 + call assert(int_array_3(i,j,k) == n) + n = n +1 + end do + end do + end do + + ! copy to a different buffer that is not managed by the gpufort array + call hipCheck(gpufort_array_copy_to_buffer(gpufort_int_arr3,int_buffer_3,hipMemcpyDeviceToHost)) + n=0 + do k = -3,6 + do j = -2,7 + do i = -1,8 + call assert(int_buffer_3(i,j,k) == n) + n = n +1 + end do + end do + end do + + ! destroy + call hipCheck(gpufort_array_destroy(gpufort_int_arr1)) + call hipCheck(gpufort_array_destroy(gpufort_int_arr2)) + call hipCheck(gpufort_array_destroy(gpufort_int_arr3)) + end subroutine +end program diff --git a/test/gpufort_array/test_gpufort_array_kernels.hip.cpp b/test/gpufort_array/test_gpufort_array_kernels.hip.cpp new file mode 100644 index 00000000..d12df72e --- /dev/null +++ b/test/gpufort_array/test_gpufort_array_kernels.hip.cpp @@ -0,0 +1,47 @@ +#include "hip/hip_runtime.h" +#include "hip/hip_runtime_api.h" + +#include "gpufort_array.h" + +__global__ void fill_int_array_1( + gpufort::array1 arr +) { + int i = -1+threadIdx.x + blockDim.x*blockIdx.x; + if ( (i+1) < 10 ) { + arr(i) = arr.linearized_index(i); + //printf("%d\n",arr(i)); + } +} + +__global__ void fill_int_array_2( + gpufort::array2 arr +) { + int i = -1+threadIdx.x + blockDim.x*blockIdx.x; + int j = -2+threadIdx.y + blockDim.y*blockIdx.y; + if ( (i+1) < 10 && (j+2) < 10 ) { + arr(i,j) = arr.linearized_index(i,j); + } +} + +__global__ void fill_int_array_3( + gpufort::array3 arr +) { + int i = -1+threadIdx.x + blockDim.x*blockIdx.x; + int j = -2+threadIdx.y + blockDim.y*blockIdx.y; + int k = -3+threadIdx.z + blockDim.z*blockIdx.z; + if ( (i+1) < 10 && (j+2) < 10 && (k+3) < 10 ) { + arr(i,j,k) = arr.linearized_index(i,j,k); + } +} + +extern "C" { + void launch_fill_int_array_1(gpufort::array1 arr) { + hipLaunchKernelGGL(fill_int_array_1,dim3(1),dim3(10,1,1),0,nullptr,arr); + } + void launch_fill_int_array_2(gpufort::array2 arr) { + hipLaunchKernelGGL(fill_int_array_2,dim3(1),dim3(10,10,1),0,nullptr,arr); + } + void launch_fill_int_array_3(gpufort::array3 arr) { + hipLaunchKernelGGL(fill_int_array_3,dim3(1),dim3(10,10,10),0,nullptr,arr); + } +} \ No newline at end of file diff --git a/test/stability/Makefile b/test/stability/Makefile new file mode 100644 index 00000000..94e1ccb9 --- /dev/null +++ b/test/stability/Makefile @@ -0,0 +1,17 @@ +CONV = gpufort +CONV_FLAGS ?= -w -E hip-gpufort-rt + +SOURCES = $(shell find . -name "test*.f90") +TESTS=$(SOURCES:.f90=.f90-gpufort.f08) + +.PHONY: clean all + +all: $(TESTS) + +$(TESTS): %.f90-gpufort.f08 : %.f90 + $(CONV) $(CONV_FLAGS) $^ + +clean: + rm -rf *.f90-* *.gpufort_mod *-fort2hip.hip.cpp + + diff --git a/test/stability/README.md b/test/stability/README.md new file mode 100644 index 00000000..e522b6c4 --- /dev/null +++ b/test/stability/README.md @@ -0,0 +1,9 @@ +GPUFORT STABILITY TESTS +----------------------- + +In this test suite, we monitor only that GPUFORT does not crash when +converting Fortran code. +We do not care about correct output of the code generator (at this time). + +The snippets in this collection caused GPUFORT to +crash in the past. diff --git a/test/stability/test1.f90 b/test/stability/test1.f90 new file mode 100644 index 00000000..07c68bbc --- /dev/null +++ b/test/stability/test1.f90 @@ -0,0 +1,12 @@ +subroutine external_acc_routine(view) + + implicit none + real(4), intent(inout) :: view(:,:) + + !$acc data present(view) + !$acc kernels + view(1,1) = 4. + !$acc end kernels + !$acc end data + +end subroutine external_acc_routine diff --git a/test/stability/test2.f90 b/test/stability/test2.f90 new file mode 100644 index 00000000..20ae17fd --- /dev/null +++ b/test/stability/test2.f90 @@ -0,0 +1,24 @@ +module allocate_unified_module + +interface + + subroutine allocate_unified_impl( a, N ) bind(C,name="allocate_unified_impl") + use, intrinsic :: iso_c_binding + type(c_ptr) :: a + integer(c_int), value :: N + end subroutine + +end interface + +contains + + subroutine allocate_unified( a, N ) + use, intrinsic :: iso_c_binding + real(c_double), pointer :: a(:) + integer(c_int) :: N + type(c_ptr) :: value_cptr + call allocate_unified_impl(value_cptr, N) + call c_f_pointer(value_cptr,a,(/N/)) + end subroutine + +end module diff --git a/test/stability/test3.f90 b/test/stability/test3.f90 new file mode 100644 index 00000000..03b38cbf --- /dev/null +++ b/test/stability/test3.f90 @@ -0,0 +1,5 @@ +program test1 + integer, parameter :: ims = 12,ime=16,jms=1,jme=10 + REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: & ! Does not like a comment here + HEAT2D ! What about here +end program test1 diff --git a/test/stability/test4.f90 b/test/stability/test4.f90 new file mode 100644 index 00000000..830e8d56 --- /dev/null +++ b/test/stability/test4.f90 @@ -0,0 +1,5 @@ +program test1 + ! logical, parameter :: dosfcflx = .true. ! not working + ! logical :: dosfcflx = .true. ! not working + logical,parameter :: dosfcflx ! works! +end program test1 diff --git a/test/stability/test5.f90 b/test/stability/test5.f90 new file mode 100644 index 00000000..bed83f04 --- /dev/null +++ b/test/stability/test5.f90 @@ -0,0 +1,3 @@ +program test1 + real, dimension(:,:,:,:), pointer :: tauaer_sw=>null() +end program test1