diff --git a/.gitignore b/.gitignore index 303adac..cb86d63 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,6 @@ # vscode configuration .vscode/* + +# output files +*.out diff --git a/build/Makefile b/build/Makefile index ac59d58..f09f96a 100644 --- a/build/Makefile +++ b/build/Makefile @@ -64,14 +64,20 @@ endif all: libflcl.a -flcl-cxx.o: $(SRCDIR)/flcl-cxx.cc +flcl-cxx.o: $(SRCDIR)/flcl-cxx.cc $(SRCDIR)/flcl-cxx.hpp $(CXX) $(DEBUG) -I$(SRCDIR)/ $(KOKKOS_INC) -c $(SRCDIR)/flcl-cxx.cc flcl-f.o: $(SRCDIR)/flcl-f.f90 $(FC) $(FSTD) $(DEBUG) -I$(SRCDIR)/ -c $(SRCDIR)/flcl-f.f90 -libflcl.a: flcl-f.o flcl-cxx.o - ar rcs libflcl.a flcl-f.o flcl-cxx.o +flcl-util-cxx.o: $(SRCDIR)/flcl-util-cxx.cc $(SRCDIR)/flcl-util-cxx.h + $(CXX) $(DEBUG) -I$(SRCDIR)/ $(KOKKOS_INC) -c $(SRCDIR)/flcl-util-cxx.cc + +flcl-util-f.o: $(SRCDIR)/flcl-util-f.f90 $(SRCDIR)/flcl-f.f90 + $(FC) $(FSTD) $(DEBUG) -I$(SRCDIR)/ -c $(SRCDIR)/flcl-util-f.f90 + +libflcl.a: flcl-f.o flcl-cxx.o flcl-util-f.o flcl-util-cxx.o + ar rcs libflcl.a flcl-f.o flcl-cxx.o flcl-util-f.o flcl-util-cxx.o test-flcl-cxx.o: $(TESTSRCDIR)/test-flcl-cxx.cc $(CXX) $(DEBUG) -I$(SRCDIR) -I$(TESTSRCDIR)/ $(KOKKOS_INC) -c $(TESTSRCDIR)/test-flcl-cxx.cc @@ -79,11 +85,11 @@ test-flcl-cxx.o: $(TESTSRCDIR)/test-flcl-cxx.cc test-flcl-f.o: flcl-f.o $(TESTSRCDIR)/test-flcl-f.f90 $(FC) $(FSTD) $(DEBUG) -I$(TESTSRCDIR)/ -c $(TESTSRCDIR)/test-flcl-f.f90 -test-flcl-main.o: flcl-f.o test-flcl-f.o $(TESTSRCDIR)/test-flcl-f.f90 +test-flcl-main.o: flcl-f.o test-flcl-f.o $(TESTSRCDIR)/test-flcl-f.f90 flcl-util-f.o $(FC) $(FSTD) $(DEBUG) -I$(TESTSRCDIR)/ -c $(TESTSRCDIR)/test-flcl-main.f90 test-flcl.x: test-flcl-cxx.o test-flcl-f.o test-flcl-main.o libflcl.a $(FC) $(FSTD) $(DEBUG) -I$(TESTSRCDIR)/ test-flcl-cxx.o test-flcl-f.o test-flcl-main.o -L. -lflcl $(KOKKOS_LIB) -lstdc++ -o test-flcl.x clean: - rm -f ./*.o ./*.x ./*.mod ./libflcl.a + rm -f ./*.o ./*.x ./*.mod ./*.out ./libflcl.a diff --git a/ci/flcl-ci-darwin.sh b/ci/flcl-ci-darwin.sh deleted file mode 100755 index 9ac8100..0000000 --- a/ci/flcl-ci-darwin.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash -module purge -module load intel -export KOKKOS_ROOT=$HOME/kt/2.9-intel-serial -cd $HOME/kokkos-fortran-interop/build -make clean -make libflcl.a -make test-flcl.x -$HOME/kokkos-fortran-interop/build/test-flcl.x -module purge -module load intel -export KOKKOS_ROOT=$HOME/kt/2.9-intel-openmp -cd $HOME/kokkos-fortran-interop/build -make clean -make libflcl.a -make test-flcl.x -$HOME/kokkos-fortran-interop/build/test-flcl.x -module purge -module load gcc -module load cuda -export KOKKOS_ROOT=$HOME/kt/2.9-gnu-cuda -cd $HOME/kokkos-fortran-interop/build -make clean -make libflcl.a -make test-flcl.x -$HOME/kokkos-fortran-interop/build/test-flcl.x -make clean diff --git a/ci/flcl-run-ci-darwin-ppc.sh b/ci/flcl-run-ci-darwin-ppc.sh new file mode 100755 index 0000000..5327370 --- /dev/null +++ b/ci/flcl-run-ci-darwin-ppc.sh @@ -0,0 +1,27 @@ +#!/bin/tcsh +module purge +module load gcc +setenv KOKKOS_ROOT $HOME/kt/2.9-ppc-gnu-serial +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load gcc +setenv KOKKOS_ROOT $HOME/kt/2.9-ppc-gnu-openmp +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load gcc +module load cuda/10.1 +setenv KOKKOS_ROOT $HOME/kt/2.9-ppc-gnu-cuda-7.0 +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +make clean diff --git a/ci/flcl-run-ci-darwin-x86.sh b/ci/flcl-run-ci-darwin-x86.sh new file mode 100755 index 0000000..c176bc4 --- /dev/null +++ b/ci/flcl-run-ci-darwin-x86.sh @@ -0,0 +1,45 @@ +#!/bin/tcsh +module purge +module load gcc +setenv KOKKOS_ROOT $HOME/kt/2.9-x86-gnu-serial +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load gcc +setenv KOKKOS_ROOT $HOME/kt/2.9-x86-gnu-openmp +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load gcc +module load cuda/10.1 +setenv KOKKOS_ROOT $HOME/kt/2.9-x86-gnu-cuda-3.5 +setenv CUDA_LAUNCH_BLOCKING 1 +setenv CUDA_MANAGED_FORCE_DEVICE_ALLOC 1 +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load intel +setenv KOKKOS_ROOT $HOME/kt/2.9-x86-intel-serial +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +module purge +module load intel +setenv KOKKOS_ROOT $HOME/kt/2.9-x86-intel-openmp +cd $HOME/kokkos-fortran-interop/build +make clean +make libflcl.a +make test-flcl.x +time $HOME/kokkos-fortran-interop/build/test-flcl.x +make clean \ No newline at end of file diff --git a/ci/flcl-setup-ci-darwin-ppc.sh b/ci/flcl-setup-ci-darwin-ppc.sh new file mode 100644 index 0000000..126af85 --- /dev/null +++ b/ci/flcl-setup-ci-darwin-ppc.sh @@ -0,0 +1,21 @@ +#!/bin/tcsh +# salloc -n 1 -p power9-asc -A asc-priority +# cd ~/kt +# mkdir -p ~/kt/2.9-ppc-gnu-serial +# mkdir -p ~/kt/2.9-ppc-gnu-openmp +# mkdir -p ~/kt/2.9-ppc-gnu-cuda-3.5 +# module load gcc +# cd ~/kt/2.9-ppc-gnu-serial +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which g++` --with-serial +# make -j test +# make install +# cd ~/kt/2.9-ppc-gnu-openmp +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which g++` --with-openmp +# make -j test +# make install +# module load cuda/10.1 +# cd ~/kt/2.9-ppc-gnu-cuda-7.0 +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --with-cuda=$CUDADIR --arch=Volta70 --with-cuda-options=enable_lambda,force_uvm +# make -j test +# make install +# module purge diff --git a/ci/flcl-setup-ci-darwin-x86.sh b/ci/flcl-setup-ci-darwin-x86.sh new file mode 100644 index 0000000..7c126c2 --- /dev/null +++ b/ci/flcl-setup-ci-darwin-x86.sh @@ -0,0 +1,35 @@ +#!/bin/tcsh +# salloc -n 1 --constraint=gpu_vendor:nvidia,cpu_vendor:Intel +# cd ~/kt +# mkdir -p ~/kt/2.9-x86-gnu-serial +# mkdir -p ~/kt/2.9-x86-gnu-openmp +# mkdir -p ~/kt/2.9-x86-gnu-cuda-3.5 +# mkdir -p ~/kt/2.9-x86-intel-serial +# mkdir -p ~/kt/2.9-x86-intel-openmp +# module load gcc +# cd ~/kt/2.9-x86-gnu-serial +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which g++` --with-serial +# make -j test +# make install +# cd ~/kt/2.9-x86-gnu-openmp +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which g++` --with-openmp +# make -j test +# make install +# module load cuda/10.1 +# cd ~/kt/2.9-x86-gnu-cuda-3.5 +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --with-cuda=$CUDADIR --arch=Kepler35 --with-cuda-options=enable_lambda,force_uvm +# setenv CUDA_LAUNCH_BLOCKING 1 +# setenv CUDA_MANAGED_FORCE_DEVICE_ALLOC 1 +# make -j test +# make install +# module purge +# module load intel +# cd ~/kt/2.9-x86-intel-serial +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which icpc` --with-serial +# make -j test +# make install +# cd ~/kt/2.9-x86-intel-openmp +# ../../kokkos/kokkos-2.9.00/generate_makefile.bash --prefix=`pwd` --compiler=`which icpc` --with-openmp +# make -j test +# make install +# module purge \ No newline at end of file diff --git a/src/flcl-f.f90 b/src/flcl-f.f90 index 6d7bebb..b591eb2 100644 --- a/src/flcl-f.f90 +++ b/src/flcl-f.f90 @@ -49,7 +49,7 @@ module flcl_mod public kokkos_allocate_dualview public kokkos_deallocate_view public kokkos_deallocate_dualview - + public char_add_null integer, parameter :: ND_ARRAY_MAX_RANK = 8 type, bind(C) :: nd_array_t @@ -89,6 +89,27 @@ module flcl_mod module procedure to_nd_array_i64_4d module procedure to_nd_array_r32_4d module procedure to_nd_array_r64_4d + + ! 5D specializations + module procedure to_nd_array_l_5d + module procedure to_nd_array_i32_5d + module procedure to_nd_array_i64_5d + module procedure to_nd_array_r32_5d + module procedure to_nd_array_r64_5d + + ! 6D specializations + module procedure to_nd_array_l_6d + module procedure to_nd_array_i32_6d + module procedure to_nd_array_i64_6d + module procedure to_nd_array_r32_6d + module procedure to_nd_array_r64_6d + + ! 7D specializations + module procedure to_nd_array_l_7d + module procedure to_nd_array_i32_7d + module procedure to_nd_array_i64_7d + module procedure to_nd_array_r32_7d + module procedure to_nd_array_r64_7d end interface !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! kokkos_allocate_view interface @@ -1802,7 +1823,11 @@ function to_nd_array_l_1d(array) result(ndarray) end if ndarray%rank = 1 - ndarray%data = c_loc(array(1)) + if (size(array, 1) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1)) + end if end function to_nd_array_l_1d function to_nd_array_i32_1d(array) result(ndarray) @@ -1820,7 +1845,11 @@ function to_nd_array_i32_1d(array) result(ndarray) end if ndarray%rank = 1 - ndarray%data = c_loc(array(1)) + if (size(array, 1) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1)) + end if end function to_nd_array_i32_1d function to_nd_array_i64_1d(array) result(ndarray) @@ -1838,7 +1867,11 @@ function to_nd_array_i64_1d(array) result(ndarray) end if ndarray%rank = 1 - ndarray%data = c_loc(array(1)) + if (size(array, 1) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1)) + end if end function to_nd_array_i64_1d function to_nd_array_r32_1d(array) result(ndarray) @@ -1856,7 +1889,11 @@ function to_nd_array_r32_1d(array) result(ndarray) end if ndarray%rank = 1 - ndarray%data = c_loc(array(1)) + if (size(array, 1) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1)) + end if end function to_nd_array_r32_1d function to_nd_array_r64_1d(array) result(ndarray) @@ -1874,7 +1911,11 @@ function to_nd_array_r64_1d(array) result(ndarray) end if ndarray%rank = 1 - ndarray%data = c_loc(array(1)) + if (size(array, 1) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1)) + end if end function to_nd_array_r64_1d !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! to_nd_array 2D implementations @@ -1904,7 +1945,11 @@ function to_nd_array_l_2d(array) result(ndarray) end if ndarray%rank = 2 - ndarray%data = c_loc(array(1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1)) + end if end function to_nd_array_l_2d function to_nd_array_i32_2d(array) result(ndarray) @@ -1932,7 +1977,11 @@ function to_nd_array_i32_2d(array) result(ndarray) end if ndarray%rank = 2 - ndarray%data = c_loc(array(1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1)) + end if end function to_nd_array_i32_2d function to_nd_array_i64_2d(array) result(ndarray) @@ -1960,7 +2009,11 @@ function to_nd_array_i64_2d(array) result(ndarray) end if ndarray%rank = 2 - ndarray%data = c_loc(array(1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1)) + end if end function to_nd_array_i64_2d function to_nd_array_r32_2d(array) result(ndarray) @@ -1988,7 +2041,11 @@ function to_nd_array_r32_2d(array) result(ndarray) end if ndarray%rank = 2 - ndarray%data = c_loc(array(1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1)) + end if end function to_nd_array_r32_2d function to_nd_array_r64_2d(array) result(ndarray) @@ -2016,7 +2073,11 @@ function to_nd_array_r64_2d(array) result(ndarray) end if ndarray%rank = 2 - ndarray%data = c_loc(array(1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1)) + end if end function to_nd_array_r64_2d !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! to_nd_array 3D implementations @@ -2055,7 +2116,12 @@ function to_nd_array_l_3d(array) result(ndarray) end if ndarray%rank = 3 - ndarray%data = c_loc(array(1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1)) + end if end function to_nd_array_l_3d function to_nd_array_i32_3d(array) result(ndarray) @@ -2092,7 +2158,12 @@ function to_nd_array_i32_3d(array) result(ndarray) end if ndarray%rank = 3 - ndarray%data = c_loc(array(1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1)) + end if end function to_nd_array_i32_3d function to_nd_array_i64_3d(array) result(ndarray) @@ -2129,7 +2200,12 @@ function to_nd_array_i64_3d(array) result(ndarray) end if ndarray%rank = 3 - ndarray%data = c_loc(array(1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1)) + end if end function to_nd_array_i64_3d function to_nd_array_r32_3d(array) result(ndarray) @@ -2166,7 +2242,12 @@ function to_nd_array_r32_3d(array) result(ndarray) end if ndarray%rank = 3 - ndarray%data = c_loc(array(1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1)) + end if end function to_nd_array_r32_3d function to_nd_array_r64_3d(array) result(ndarray) @@ -2203,7 +2284,12 @@ function to_nd_array_r64_3d(array) result(ndarray) end if ndarray%rank = 3 - ndarray%data = c_loc(array(1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1)) + end if end function to_nd_array_r64_3d !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! to_nd_array 4D implementations @@ -2251,7 +2337,12 @@ function to_nd_array_l_4d(array) result(ndarray) end if ndarray%rank = 4 - ndarray%data = c_loc(array(1,1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1)) + end if end function to_nd_array_l_4d function to_nd_array_i32_4d(array) result(ndarray) @@ -2297,7 +2388,12 @@ function to_nd_array_i32_4d(array) result(ndarray) end if ndarray%rank = 4 - ndarray%data = c_loc(array(1,1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1)) + end if end function to_nd_array_i32_4d function to_nd_array_i64_4d(array) result(ndarray) @@ -2343,7 +2439,12 @@ function to_nd_array_i64_4d(array) result(ndarray) end if ndarray%rank = 4 - ndarray%data = c_loc(array(1,1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1)) + end if end function to_nd_array_i64_4d function to_nd_array_r32_4d(array) result(ndarray) @@ -2389,7 +2490,12 @@ function to_nd_array_r32_4d(array) result(ndarray) end if ndarray%rank = 4 - ndarray%data = c_loc(array(1,1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1)) + end if end function to_nd_array_r32_4d function to_nd_array_r64_4d(array) result(ndarray) @@ -2435,9 +2541,1070 @@ function to_nd_array_r64_4d(array) result(ndarray) end if ndarray%rank = 4 - ndarray%data = c_loc(array(1,1,1,1)) + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1)) + end if end function to_nd_array_r64_4d !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! to_nd_array 5D implementations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + function to_nd_array_l_5d(array) result(ndarray) + logical(c_bool), target, intent(in) :: array(:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + ndarray%rank = 5 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1)) + end if + end function to_nd_array_l_5d + + function to_nd_array_i32_5d(array) result(ndarray) + integer(INT32), target, intent(in) :: array(:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + ndarray%rank = 5 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1)) + end if + end function to_nd_array_i32_5d + + function to_nd_array_i64_5d(array) result(ndarray) + integer(INT64), target, intent(in) :: array(:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + ndarray%rank = 5 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1)) + end if + end function to_nd_array_i64_5d + + function to_nd_array_r32_5d(array) result(ndarray) + real(REAL32), target, intent(in) :: array(:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + ndarray%rank = 5 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1)) + end if + end function to_nd_array_r32_5d + + function to_nd_array_r64_5d(array) result(ndarray) + real(REAL64), target, intent(in) :: array(:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + ndarray%rank = 5 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1)) + end if + end function to_nd_array_r64_5d +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! to_nd_array 6D implementations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + function to_nd_array_l_6d(array) result(ndarray) + logical(c_bool), target, intent(in) :: array(:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + ndarray%rank = 6 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1)) + end if + end function to_nd_array_l_6d + + function to_nd_array_i32_6d(array) result(ndarray) + integer(INT32), target, intent(in) :: array(:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + ndarray%rank = 6 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1)) + end if + end function to_nd_array_i32_6d + + function to_nd_array_i64_6d(array) result(ndarray) + integer(INT64), target, intent(in) :: array(:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + ndarray%rank = 6 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1)) + end if + end function to_nd_array_i64_6d + + function to_nd_array_r32_6d(array) result(ndarray) + real(REAL32), target, intent(in) :: array(:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + ndarray%rank = 6 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1)) + end if + end function to_nd_array_r32_6d + + function to_nd_array_r64_6d(array) result(ndarray) + real(REAL64), target, intent(in) :: array(:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + ndarray%rank = 6 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1)) + end if + end function to_nd_array_r64_6d +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! to_nd_array 7D implementations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + function to_nd_array_l_7d(array) result(ndarray) + logical(c_bool), target, intent(in) :: array(:,:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + ndarray%dims(7) = size(array, 7, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + if (size(array, 7) .ge. 2) then + ndarray%strides(7) = & + (transfer(c_loc(array(1,1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(7) = size(array, 6, c_size_t) * ndarray%strides(6) + end if + + ndarray%rank = 7 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0 .or. size(array, 7) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1,1)) + end if + end function to_nd_array_l_7d + + function to_nd_array_i32_7d(array) result(ndarray) + integer(INT32), target, intent(in) :: array(:,:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + ndarray%dims(7) = size(array, 7, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + if (size(array, 7) .ge. 2) then + ndarray%strides(7) = & + (transfer(c_loc(array(1,1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(7) = size(array, 6, c_size_t) * ndarray%strides(6) + end if + + ndarray%rank = 7 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0 .or. size(array, 7) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1,1)) + end if + end function to_nd_array_i32_7d + + function to_nd_array_i64_7d(array) result(ndarray) + integer(INT64), target, intent(in) :: array(:,:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + ndarray%dims(7) = size(array, 7, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + if (size(array, 7) .ge. 2) then + ndarray%strides(7) = & + (transfer(c_loc(array(1,1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(7) = size(array, 6, c_size_t) * ndarray%strides(6) + end if + + ndarray%rank = 7 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0 .or. size(array, 7) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1,1)) + end if + end function to_nd_array_i64_7d + + function to_nd_array_r32_7d(array) result(ndarray) + real(REAL32), target, intent(in) :: array(:,:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + ndarray%dims(7) = size(array, 7, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + if (size(array, 7) .ge. 2) then + ndarray%strides(7) = & + (transfer(c_loc(array(1,1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(7) = size(array, 6, c_size_t) * ndarray%strides(6) + end if + + ndarray%rank = 7 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0 .or. size(array, 7) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1,1)) + end if + end function to_nd_array_r32_7d + + function to_nd_array_r64_7d(array) result(ndarray) + real(REAL64), target, intent(in) :: array(:,:,:,:,:,:,:) + + type(nd_array_t) :: ndarray + + ndarray%dims(1) = size(array, 1, c_size_t) + ndarray%dims(2) = size(array, 2, c_size_t) + ndarray%dims(3) = size(array, 3, c_size_t) + ndarray%dims(4) = size(array, 4, c_size_t) + ndarray%dims(5) = size(array, 5, c_size_t) + ndarray%dims(6) = size(array, 6, c_size_t) + ndarray%dims(7) = size(array, 7, c_size_t) + + if (size(array, 1) .ge. 2) then + ndarray%strides(1) = & + (transfer(c_loc(array(2,1,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(1) = 1 + end if + + if (size(array, 2) .ge. 2) then + ndarray%strides(2) = & + (transfer(c_loc(array(1,2,1,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(2) = size(array, 1, c_size_t) * ndarray%strides(1) + end if + + if (size(array, 3) .ge. 2) then + ndarray%strides(3) = & + (transfer(c_loc(array(1,1,2,1,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(3) = size(array, 2, c_size_t) * ndarray%strides(2) + end if + + if (size(array, 4) .ge. 2) then + ndarray%strides(4) = & + (transfer(c_loc(array(1,1,1,2,1,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(4) = size(array, 3, c_size_t) * ndarray%strides(3) + end if + + if (size(array, 5) .ge. 2) then + ndarray%strides(5) = & + (transfer(c_loc(array(1,1,1,1,2,1,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(5) = size(array, 4, c_size_t) * ndarray%strides(4) + end if + + if (size(array, 6) .ge. 2) then + ndarray%strides(6) = & + (transfer(c_loc(array(1,1,1,1,1,2,1)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(6) = size(array, 5, c_size_t) * ndarray%strides(5) + end if + + if (size(array, 7) .ge. 2) then + ndarray%strides(7) = & + (transfer(c_loc(array(1,1,1,1,1,1,2)), 1_c_size_t) - & + transfer(c_loc(array(1,1,1,1,1,1,1)), 1_c_size_t)) / c_sizeof(array(1,1,1,1,1,1,1)) + else + ndarray%strides(7) = size(array, 6, c_size_t) * ndarray%strides(6) + end if + + ndarray%rank = 7 + if (size(array, 1) .eq. 0 .or. size(array, 2) .eq. 0 .or. & + & size(array, 3) .eq. 0 .or. size(array, 4) .eq. 0 .or. & + & size(array, 5) .eq. 0 .or. size(array, 6) .eq. 0 .or. size(array, 7) .eq. 0) then + ndarray%data = c_null_ptr + else + ndarray%data = c_loc(array(1,1,1,1,1,1,1)) + end if + end function to_nd_array_r64_7d +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! fin !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module flcl_mod \ No newline at end of file diff --git a/src/flcl-util-cxx.cc b/src/flcl-util-cxx.cc new file mode 100644 index 0000000..8099579 --- /dev/null +++ b/src/flcl-util-cxx.cc @@ -0,0 +1,80 @@ +// Copyright (c) 2019. Triad National Security, LLC. All rights reserved. +// +// This program was produced under U.S. Government contract 89233218CNA000001 for +// Los Alamos National Laboratory (LANL), which is operated by Triad National +// Security, LLC for the U.S. Department of Energy/National Nuclear Security +// Administration. All rights in the program are reserved by Triad National +// Security, LLC, and the U.S. Department of Energy/National Nuclear Security +// Administration. The Government is granted for itself and others acting on +// its behalf a nonexclusive, paid-up, irrevocable worldwide license in this +// material to reproduce, prepare derivative works, distribute copies to the +// public, perform publicly and display publicly, and to permit others to do so. +// +// This program is open source under the BSD-3 License. +// +// Redistribution and use in source and binary forms, with or without modification, +// are permitted provided that the following conditions are met: +// +// 1. Redistributions of source code must retain the above copyright +// notice, this list of conditions and the following disclaimer. +// 2. Redistributions in binary form must reproduce the above copyright +// notice, this list of conditions and the following disclaimer in the +// documentation and/or other materials provided with the distribution. +// 3. Neither the name of the copyright holder nor the +// names of its contributors may be used to endorse or promote products +// derived from this software without specific prior written permission. +// +// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +// ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +// DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY +// DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +// (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +// LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +// ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +#include +#include +#include +#include +#include +#include "flcl-util-cxx.h" + +extern "C" { + + void c_kokkos_initialize(int *argc, char **argv) { + Kokkos::initialize(*argc, argv); + } + + void c_kokkos_initialize_without_args() { + Kokkos::initialize(); + } + + void c_kokkos_finalize() { + Kokkos::finalize(); + } + + void c_kokkos_print_configuration(const char** prepend_name_in, const char** file_name_in) { + + std::string prepend_name( *prepend_name_in ); + std::string file_name( *file_name_in ); + std::string output_filename = prepend_name + file_name; + std::ofstream kokkos_output_file ( output_filename ); + if ( kokkos_output_file.is_open()) { + Kokkos::print_configuration( kokkos_output_file, true ); + kokkos_output_file.close(); + } else { + std::cout << "Could not open filename " << output_filename; + std::cout << " to dump Kokkos::print_configuration to." << std::endl; + } + + } + + bool c_kokkos_is_initialized() { + return Kokkos::is_initialized(); + } + + + +} // extern "C" \ No newline at end of file diff --git a/src/flcl-util-cxx.h b/src/flcl-util-cxx.h new file mode 100644 index 0000000..4713b6e --- /dev/null +++ b/src/flcl-util-cxx.h @@ -0,0 +1,61 @@ +// Copyright (c) 2019. Triad National Security, LLC. All rights reserved. +// +// This program was produced under U.S. Government contract 89233218CNA000001 for +// Los Alamos National Laboratory (LANL), which is operated by Triad National +// Security, LLC for the U.S. Department of Energy/National Nuclear Security +// Administration. All rights in the program are reserved by Triad National +// Security, LLC, and the U.S. Department of Energy/National Nuclear Security +// Administration. The Government is granted for itself and others acting on +// its behalf a nonexclusive, paid-up, irrevocable worldwide license in this +// material to reproduce, prepare derivative works, distribute copies to the +// public, perform publicly and display publicly, and to permit others to do so. +// +// This program is open source under the BSD-3 License. +// +// Redistribution and use in source and binary forms, with or without modification, +// are permitted provided that the following conditions are met: +// +// 1. Redistributions of source code must retain the above copyright +// notice, this list of conditions and the following disclaimer. +// 2. Redistributions in binary form must reproduce the above copyright +// notice, this list of conditions and the following disclaimer in the +// documentation and/or other materials provided with the distribution. +// 3. Neither the name of the copyright holder nor the +// names of its contributors may be used to endorse or promote products +// derived from this software without specific prior written permission. +// +// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +// ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +// DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY +// DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +// (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +// LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +// ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +// SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +#ifndef FLCL_UTIL_CXX_H +#define FLCL_UTIL_CXX_H + +#ifdef __cplusplus +extern "C" +{ +#endif + +void c_kokkos_initialize(int *argc, char **argv); +void c_kokkos_initialize_without_args(void); +void c_kokkos_finalize(void); +void c_kokkos_print_configuration(const char** prepend_name_in, const char** file_name_in); + +#ifdef __cplusplus +bool c_kokkos_is_initialized(void); +#else +_Bool c_kokkos_is_initialized(void); +#endif + +#ifdef __cplusplus +} // extern "C" +#endif + +#endif // FLCL_UTIL_CXX_H \ No newline at end of file diff --git a/src/flcl-util-f.f90 b/src/flcl-util-f.f90 new file mode 100644 index 0000000..306de2a --- /dev/null +++ b/src/flcl-util-f.f90 @@ -0,0 +1,177 @@ +! Copyright (c) 2019. Triad National Security, LLC. All rights reserved. +! +! This program was produced under U.S. Government contract 89233218CNA000001 for +! Los Alamos National Laboratory (LANL), which is operated by Triad National +! Security, LLC for the U.S. Department of Energy/National Nuclear Security +! Administration. All rights in the program are reserved by Triad National +! Security, LLC, and the U.S. Department of Energy/National Nuclear Security +! Administration. The Government is granted for itself and others acting on +! its behalf a nonexclusive, paid-up, irrevocable worldwide license in this +! material to reproduce, prepare derivative works, distribute copies to the +! public, perform publicly and display publicly, and to permit others to do so. +! +! This program is open source under the BSD-3 License. +! +! Redistribution and use in source and binary forms, with or without modification, +! are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. Neither the name of the copyright holder nor the +! names of its contributors may be used to endorse or promote products +! derived from this software without specific prior written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +! ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +! WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY +! DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +! (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +! ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +module flcl_util_mod + use, intrinsic :: iso_c_binding + use, intrinsic :: iso_fortran_env + + implicit none + private + + public :: & + & kokkos_initialize, & + & kokkos_initialize_without_args, & + & kokkos_finalize, & + & kokkos_print_configuration, & + & kokkos_is_initialized + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library initialization interfaces +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + interface + subroutine f_kokkos_initialize(argc, argv) & + & bind(c, name="c_kokkos_initialize") + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + integer(c_int), intent(inout) :: argc + type(c_ptr), value :: argv + end subroutine f_kokkos_initialize + end interface + + interface + subroutine f_kokkos_initialize_without_args() & + bind(c, name='c_kokkos_initialize_without_args') + use, intrinsic :: iso_c_binding + implicit none + end subroutine f_kokkos_initialize_without_args + end interface +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library finalization interface +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + interface + subroutine f_kokkos_finalize() & + & bind(c, name="c_kokkos_finalize") + end subroutine f_kokkos_finalize + end interface + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library helper routine interfaces +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + interface + subroutine f_kokkos_print_configuration( prepend_name_in, file_name_in ) & + & bind(c, name='c_kokkos_print_configuration') + use, intrinsic :: iso_c_binding + implicit none + type (c_ptr), intent(in) :: prepend_name_in + type (c_ptr), intent(in) :: file_name_in + end subroutine f_kokkos_print_configuration + end interface + + interface + function f_kokkos_is_initialized() result(is_init) & + & bind(c, name='c_kokkos_is_initialized') + use, intrinsic :: iso_c_binding + implicit none + logical(c_bool) :: is_init + end function f_kokkos_is_initialized + end interface +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + contains +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library initialization implementations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine kokkos_initialize() + use, intrinsic :: iso_c_binding + implicit none + integer :: arg_count, max_length = 0, str_length, n, cli_count + character(kind=c_char, len=:), allocatable, target :: strs(:) + type(c_ptr), allocatable, target :: c_strs(:) + + arg_count = command_argument_count() + ! include command name + do n = 0, arg_count + call get_command_argument(n, length=str_length) + max_length = max(max_length, str_length) + end do + + allocate(character(max_length + 1) :: strs(0:arg_count)) + allocate(c_strs(0:arg_count)) + + do n = 0, arg_count + call get_command_argument(n, length=str_length) + call get_command_argument(n, value=strs(n), length=str_length) + strs(n)(str_length + 1:str_length + 1) = c_null_char + c_strs(n) = c_loc(strs(n)) + end do + + cli_count = arg_count + 1 + call f_kokkos_initialize(cli_count, c_loc(c_strs(0))) + end subroutine kokkos_initialize +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine kokkos_initialize_without_args() + use, intrinsic :: iso_c_binding + implicit none + call f_kokkos_initialize_without_args() + end subroutine kokkos_initialize_without_args +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library finalization implementation +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine kokkos_finalize() + use, intrinsic :: iso_c_binding + implicit none + call f_kokkos_finalize + end subroutine kokkos_finalize +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! kokkos library helper routine implementations +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine kokkos_print_configuration( prepend_name_in, file_name_in ) + use, intrinsic :: iso_c_binding + use flcl_mod, only: char_add_null + implicit none + + character(len=*), intent(in) :: prepend_name_in + character(len=*), intent(in) :: file_name_in + character(len=:, kind=c_char), allocatable, target :: prepend_name_out + character(len=:, kind=c_char), allocatable, target :: file_name_out + + call char_add_null( prepend_name_in, prepend_name_out ) + call char_add_null( file_name_in, file_name_out ) + + call f_kokkos_print_configuration( & + & c_loc(prepend_name_out), c_loc(file_name_out) ) + + end subroutine kokkos_print_configuration +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + function kokkos_is_initialized() result(is_init) + use, intrinsic :: iso_c_binding + implicit none + logical :: is_init + logical(c_bool) :: c_is_init + c_is_init = f_kokkos_is_initialized() + is_init = logical(c_is_init) + end function kokkos_is_initialized +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +end module flcl_util_mod \ No newline at end of file diff --git a/test/test-flcl-cxx.cc b/test/test-flcl-cxx.cc index 322add9..e09f23d 100644 --- a/test/test-flcl-cxx.cc +++ b/test/test-flcl-cxx.cc @@ -39,14 +39,6 @@ extern "C" { - void c_kokkos_initialize() { - Kokkos::initialize(); - } - - void c_kokkos_finalize( void ) { - Kokkos::finalize(); - } - size_t c_test_ndarray_l_1d( flcl_ndarray_t *nd_array_l_1d, size_t *f_sum ) { using flcl::view_from_ndarray; @@ -402,5 +394,759 @@ extern "C" { } + size_t c_test_ndarray_l_4d( flcl_ndarray_t *nd_array_l_4d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_l_4d = view_from_ndarray(*nd_array_l_4d); + for (size_t ii = 0; ii < array_l_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_4d.extent(3); ll++) { + if ( array_l_4d(ii,jj,kk,ll) ) c_sum++; + } + } + } + } + if (c_sum != *f_sum) { + std::cout << "FAILED ndarray_l_4d" << std::endl; + exit(EXIT_FAILURE); + } + for (size_t ii = 0; ii < array_l_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_4d.extent(3); ll++) { + array_l_4d(ii,jj,kk,ll) = logical_post; + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i32_4d( flcl_ndarray_t *nd_array_i32_4d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i32_4d = view_from_ndarray(*nd_array_i32_4d); + for (size_t ii = 0; ii < array_i32_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_4d.extent(3); ll++) { + c_sum += array_i32_4d(ii,jj,kk,ll); + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i32_4d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i32_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_4d.extent(3); ll++) { + array_i32_4d(ii,jj,kk,ll) = ii*jj*kk*ll; + c_sum += array_i32_4d(ii,jj,kk,ll); + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i64_4d( flcl_ndarray_t *nd_array_i64_4d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i64_4d = view_from_ndarray(*nd_array_i64_4d); + for (size_t ii = 0; ii < array_i64_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_4d.extent(3); ll++) { + c_sum += array_i64_4d(ii,jj,kk,ll); + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i64_4d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i64_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_4d.extent(3); ll++) { + array_i64_4d(ii,jj,kk,ll) = ii*jj*kk*ll; + c_sum += array_i64_4d(ii,jj,kk,ll); + } + } + } + } + return c_sum; + } + + float c_test_ndarray_r32_4d( flcl_ndarray_t *nd_array_r32_4d, float *f_sum ) { + using flcl::view_from_ndarray; + + float c_sum = 0; + auto array_r32_4d = view_from_ndarray(*nd_array_r32_4d); + for (size_t ii = 0; ii < array_r32_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_4d.extent(3); ll++) { + c_sum += array_r32_4d(ii,jj,kk,ll); + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-7 ) { + std::cout << "FAILED ndarray_r32_4d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r32_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_4d.extent(3); ll++) { + array_r32_4d(ii,jj,kk,ll) = ii*jj*kk*ll; + c_sum += array_r32_4d(ii,jj,kk,ll); + } + } + } + } + return c_sum; + } + + double c_test_ndarray_r64_4d( flcl_ndarray_t *nd_array_r64_4d, double *f_sum ) { + using flcl::view_from_ndarray; + + double c_sum = 0; + auto array_r64_4d = view_from_ndarray(*nd_array_r64_4d); + for (size_t ii = 0; ii < array_r64_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_4d.extent(3); ll++) { + c_sum += array_r64_4d(ii,jj,kk,ll); + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-14 ) { + std::cout << "FAILED ndarray_r64_4d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r64_4d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_4d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_4d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_4d.extent(3); ll++) { + array_r64_4d(ii,jj,kk,ll) = ii*jj*kk*ll; + c_sum += array_r64_4d(ii,jj,kk,ll); + } + } + } + } + return c_sum; + + } + + size_t c_test_ndarray_l_5d( flcl_ndarray_t *nd_array_l_5d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_l_5d = view_from_ndarray(*nd_array_l_5d); + for (size_t ii = 0; ii < array_l_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_5d.extent(4); mm++) { + if ( array_l_5d(ii,jj,kk,ll,mm) ) c_sum++; + } + } + } + } + } + if (c_sum != *f_sum) { + std::cout << "FAILED ndarray_l_5d" << std::endl; + exit(EXIT_FAILURE); + } + for (size_t ii = 0; ii < array_l_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_5d.extent(4); mm++) { + array_l_5d(ii,jj,kk,ll,mm) = logical_post; + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i32_5d( flcl_ndarray_t *nd_array_i32_5d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i32_5d = view_from_ndarray(*nd_array_i32_5d); + for (size_t ii = 0; ii < array_i32_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_5d.extent(4); mm++) { + c_sum += array_i32_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i32_5d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i32_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_5d.extent(4); mm++) { + array_i32_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm; + c_sum += array_i32_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i64_5d( flcl_ndarray_t *nd_array_i64_5d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i64_5d = view_from_ndarray(*nd_array_i64_5d); + for (size_t ii = 0; ii < array_i64_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_5d.extent(4); mm++) { + c_sum += array_i64_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i64_5d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i64_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_5d.extent(4); mm++) { + array_i64_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm; + c_sum += array_i64_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + return c_sum; + } + + float c_test_ndarray_r32_5d( flcl_ndarray_t *nd_array_r32_5d, float *f_sum ) { + using flcl::view_from_ndarray; + + float c_sum = 0; + auto array_r32_5d = view_from_ndarray(*nd_array_r32_5d); + for (size_t ii = 0; ii < array_r32_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_5d.extent(4); mm++) { + c_sum += array_r32_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-7 ) { + std::cout << "FAILED ndarray_r32_5d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r32_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_5d.extent(4); mm++) { + array_r32_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm; + c_sum += array_r32_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + return c_sum; + } + + double c_test_ndarray_r64_5d( flcl_ndarray_t *nd_array_r64_5d, double *f_sum ) { + using flcl::view_from_ndarray; + + double c_sum = 0; + auto array_r64_5d = view_from_ndarray(*nd_array_r64_5d); + for (size_t ii = 0; ii < array_r64_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_5d.extent(4); mm++) { + c_sum += array_r64_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-14 ) { + std::cout << "FAILED ndarray_r64_5d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r64_5d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_5d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_5d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_5d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_5d.extent(4); mm++) { + array_r64_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm; + c_sum += array_r64_5d(ii,jj,kk,ll,mm); + } + } + } + } + } + return c_sum; + + } + + size_t c_test_ndarray_l_6d( flcl_ndarray_t *nd_array_l_6d, size_t *f_sum ) { + using flcl::view_from_ndarray; + size_t c_sum = 0; + auto array_l_6d = view_from_ndarray(*nd_array_l_6d); + for (size_t ii = 0; ii < array_l_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_l_6d.extent(5); nn++) { + if ( array_l_6d(ii,jj,kk,ll,mm,nn) ) c_sum++; + } + } + } + } + } + } + if (c_sum != *f_sum) { + std::cout << "FAILED ndarray_l_6d" << std::endl; + exit(EXIT_FAILURE); + } + for (size_t ii = 0; ii < array_l_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_l_6d.extent(5); nn++) { + array_l_6d(ii,jj,kk,ll,mm,nn) = logical_post; + } + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i32_6d( flcl_ndarray_t *nd_array_i32_6d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i32_6d = view_from_ndarray(*nd_array_i32_6d); + for (size_t ii = 0; ii < array_i32_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i32_6d.extent(5); nn++) { + c_sum += array_i32_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i32_6d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i32_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i32_6d.extent(5); nn++) { + array_i32_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn; + c_sum += array_i32_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i64_6d( flcl_ndarray_t *nd_array_i64_6d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i64_6d = view_from_ndarray(*nd_array_i64_6d); + for (size_t ii = 0; ii < array_i64_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i64_6d.extent(5); nn++) { + c_sum += array_i64_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i64_6d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i64_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i64_6d.extent(5); nn++) { + array_i64_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn; + c_sum += array_i64_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + return c_sum; + } + + float c_test_ndarray_r32_6d( flcl_ndarray_t *nd_array_r32_6d, float *f_sum ) { + using flcl::view_from_ndarray; + + float c_sum = 0; + auto array_r32_6d = view_from_ndarray(*nd_array_r32_6d); + for (size_t ii = 0; ii < array_r32_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r32_6d.extent(5); nn++) { + c_sum += array_r32_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-7 ) { + std::cout << "FAILED ndarray_r32_6d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r32_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r32_6d.extent(5); nn++) { + array_r32_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn; + c_sum += array_r32_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + return c_sum; + } + + double c_test_ndarray_r64_6d( flcl_ndarray_t *nd_array_r64_6d, double *f_sum ) { + using flcl::view_from_ndarray; + + double c_sum = 0; + auto array_r64_6d = view_from_ndarray(*nd_array_r64_6d); + for (size_t ii = 0; ii < array_r64_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r64_6d.extent(5); nn++) { + c_sum += array_r64_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-14 ) { + std::cout << "FAILED ndarray_r64_6d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r64_6d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_6d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_6d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_6d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_6d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r64_6d.extent(5); nn++) { + array_r64_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn; + c_sum += array_r64_6d(ii,jj,kk,ll,mm,nn); + } + } + } + } + } + } + return c_sum; + + } + + size_t c_test_ndarray_l_7d( flcl_ndarray_t *nd_array_l_7d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_l_7d = view_from_ndarray(*nd_array_l_7d); + for (size_t ii = 0; ii < array_l_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_l_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_l_7d.extent(6); oo++) { + if ( array_l_7d(ii,jj,kk,ll,mm,nn,oo) ) c_sum++; + } + } + } + } + } + } + } + if (c_sum != *f_sum) { + std::cout << "FAILED ndarray_l_7d" << std::endl; + exit(EXIT_FAILURE); + } + for (size_t ii = 0; ii < array_l_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_l_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_l_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_l_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_l_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_l_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_l_7d.extent(6); oo++) { + array_l_7d(ii,jj,kk,ll,mm,nn,oo) = logical_post; + } + } + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i32_7d( flcl_ndarray_t *nd_array_i32_7d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i32_7d = view_from_ndarray(*nd_array_i32_7d); + for (size_t ii = 0; ii < array_i32_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i32_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_i32_7d.extent(6); oo++) { + c_sum += array_i32_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i32_7d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i32_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i32_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i32_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i32_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i32_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i32_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_i32_7d.extent(6); oo++) { + array_i32_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo; + c_sum += array_i32_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + return c_sum; + } + + size_t c_test_ndarray_i64_7d( flcl_ndarray_t *nd_array_i64_7d, size_t *f_sum ) { + using flcl::view_from_ndarray; + + size_t c_sum = 0; + auto array_i64_7d = view_from_ndarray(*nd_array_i64_7d); + for (size_t ii = 0; ii < array_i64_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i64_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_i64_7d.extent(6); oo++) { + c_sum += array_i64_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + if ( c_sum != *f_sum ) { + std::cout << "FAILED ndarray_i64_7d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_i64_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_i64_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_i64_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_i64_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_i64_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_i64_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_i64_7d.extent(6); oo++) { + array_i64_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo; + c_sum += array_i64_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + return c_sum; + } + + float c_test_ndarray_r32_7d( flcl_ndarray_t *nd_array_r32_7d, float *f_sum ) { + using flcl::view_from_ndarray; + + float c_sum = 0; + auto array_r32_7d = view_from_ndarray(*nd_array_r32_7d); + for (size_t ii = 0; ii < array_r32_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r32_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_r32_7d.extent(6); oo++) { + c_sum += array_r32_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-7 ) { + std::cout << "FAILED ndarray_r32_7d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r32_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r32_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r32_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r32_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r32_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r32_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_r32_7d.extent(6); oo++) { + array_r32_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo; + c_sum += array_r32_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + return c_sum; + } + + double c_test_ndarray_r64_7d( flcl_ndarray_t *nd_array_r64_7d, double *f_sum ) { + using flcl::view_from_ndarray; + + double c_sum = 0; + auto array_r64_7d = view_from_ndarray(*nd_array_r64_7d); + for (size_t ii = 0; ii < array_r64_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r64_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_r64_7d.extent(6); oo++) { + c_sum += array_r64_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + if ( std::fabs(c_sum - *f_sum) > 1.0e-14 ) { + std::cout << "FAILED ndarray_r64_7d" << std::endl; + exit(EXIT_FAILURE); + } + c_sum = 0; + for (size_t ii = 0; ii < array_r64_7d.extent(0); ii++) { + for (size_t jj = 0; jj < array_r64_7d.extent(1); jj++) { + for (size_t kk = 0; kk < array_r64_7d.extent(2); kk++) { + for (size_t ll = 0; ll < array_r64_7d.extent(3); ll++) { + for (size_t mm = 0; mm < array_r64_7d.extent(4); mm++) { + for (size_t nn = 0; nn < array_r64_7d.extent(5); nn++) { + for (size_t oo = 0; oo < array_r64_7d.extent(6); oo++) { + array_r64_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo; + c_sum += array_r64_7d(ii,jj,kk,ll,mm,nn,oo); + } + } + } + } + } + } + } + return c_sum; + + } } \ No newline at end of file diff --git a/test/test-flcl-cxx.h b/test/test-flcl-cxx.h index 4e7d0f5..f0b769a 100644 --- a/test/test-flcl-cxx.h +++ b/test/test-flcl-cxx.h @@ -46,6 +46,12 @@ size_t e0_length = 10; size_t e1_length = 11; +size_t e2_length = 12; +size_t e3_length = 13; +size_t e4_length = 14; +size_t e5_length = 15; +size_t e6_length = 16; + bool logical_pre = true; bool logical_post = false; diff --git a/test/test-flcl-f.f90 b/test/test-flcl-f.f90 index bf55f22..e32135b 100644 --- a/test/test-flcl-f.f90 +++ b/test/test-flcl-f.f90 @@ -46,6 +46,10 @@ module test_flcl_f_mod integer(c_size_t), parameter :: e0_length = 10 integer(c_size_t), parameter :: e1_length = 11 integer(c_size_t), parameter :: e2_length = 12 + integer(c_size_t), parameter :: e3_length = 13 + integer(c_size_t), parameter :: e4_length = 14 + integer(c_size_t), parameter :: e5_length = 15 + integer(c_size_t), parameter :: e6_length = 16 logical(c_bool), parameter :: logical_pre = .true. logical(c_bool), parameter :: logical_post = .false. @@ -56,22 +60,6 @@ module test_flcl_f_mod public - interface - subroutine f_kokkos_initialize() & - bind(c, name='c_kokkos_initialize') - use, intrinsic :: iso_c_binding - implicit none - end subroutine f_kokkos_initialize - end interface - - interface - subroutine f_kokkos_finalize() & - bind(c, name='c_kokkos_finalize') - use, intrinsic :: iso_c_binding - implicit none - end subroutine f_kokkos_finalize - end interface - interface integer(c_size_t) & & function f_test_ndarray_l_1d( nd_array_l_1d, f_sum ) & @@ -182,7 +170,6 @@ & function f_test_ndarray_r64_2d( nd_array_r64_2d, f_sum ) & end function f_test_ndarray_r64_2d end interface - interface integer(c_size_t) & & function f_test_ndarray_l_3d( nd_array_l_3d, f_sum ) & @@ -238,19 +225,227 @@ & function f_test_ndarray_r64_3d( nd_array_r64_3d, f_sum ) & end function f_test_ndarray_r64_3d end interface - contains + interface + integer(c_size_t) & + & function f_test_ndarray_l_4d( nd_array_l_4d, f_sum ) & + & bind(c, name='c_test_ndarray_l_4d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_l_4d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_l_4d + end interface - subroutine kokkos_initialize() + interface + integer(c_size_t) & + & function f_test_ndarray_i32_4d( nd_array_i32_4d, f_sum ) & + & bind(c, name='c_test_ndarray_i32_4d') use, intrinsic :: iso_c_binding - implicit none - call f_kokkos_initialize() - end subroutine kokkos_initialize - - subroutine kokkos_finalize() + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i32_4d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i32_4d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i64_4d( nd_array_i64_4d, f_sum ) & + & bind(c, name='c_test_ndarray_i64_4d') use, intrinsic :: iso_c_binding - implicit none - call f_kokkos_finalize() - end subroutine kokkos_finalize + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i64_4d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i64_4d + end interface + + interface + real(c_float) & + & function f_test_ndarray_r32_4d( nd_array_r32_4d, f_sum ) & + & bind(c, name='c_test_ndarray_r32_4d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r32_4d + real(c_float), intent(inout) :: f_sum + end function f_test_ndarray_r32_4d + end interface + + interface + real(c_double) & + & function f_test_ndarray_r64_4d( nd_array_r64_4d, f_sum ) & + & bind(c, name='c_test_ndarray_r64_4d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r64_4d + real(c_double), intent(inout) :: f_sum + end function f_test_ndarray_r64_4d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_l_5d( nd_array_l_5d, f_sum ) & + & bind(c, name='c_test_ndarray_l_5d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_l_5d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_l_5d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i32_5d( nd_array_i32_5d, f_sum ) & + & bind(c, name='c_test_ndarray_i32_5d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i32_5d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i32_5d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i64_5d( nd_array_i64_5d, f_sum ) & + & bind(c, name='c_test_ndarray_i64_5d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i64_5d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i64_5d + end interface + + interface + real(c_float) & + & function f_test_ndarray_r32_5d( nd_array_r32_5d, f_sum ) & + & bind(c, name='c_test_ndarray_r32_5d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r32_5d + real(c_float), intent(inout) :: f_sum + end function f_test_ndarray_r32_5d + end interface + + interface + real(c_double) & + & function f_test_ndarray_r64_5d( nd_array_r64_5d, f_sum ) & + & bind(c, name='c_test_ndarray_r64_5d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r64_5d + real(c_double), intent(inout) :: f_sum + end function f_test_ndarray_r64_5d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_l_6d( nd_array_l_6d, f_sum ) & + & bind(c, name='c_test_ndarray_l_6d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_l_6d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_l_6d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i32_6d( nd_array_i32_6d, f_sum ) & + & bind(c, name='c_test_ndarray_i32_6d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i32_6d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i32_6d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i64_6d( nd_array_i64_6d, f_sum ) & + & bind(c, name='c_test_ndarray_i64_6d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i64_6d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i64_6d + end interface + + interface + real(c_float) & + & function f_test_ndarray_r32_6d( nd_array_r32_6d, f_sum ) & + & bind(c, name='c_test_ndarray_r32_6d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r32_6d + real(c_float), intent(inout) :: f_sum + end function f_test_ndarray_r32_6d + end interface + + interface + real(c_double) & + & function f_test_ndarray_r64_6d( nd_array_r64_6d, f_sum ) & + & bind(c, name='c_test_ndarray_r64_6d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r64_6d + real(c_double), intent(inout) :: f_sum + end function f_test_ndarray_r64_6d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_l_7d( nd_array_l_7d, f_sum ) & + & bind(c, name='c_test_ndarray_l_7d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_l_7d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_l_7d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i32_7d( nd_array_i32_7d, f_sum ) & + & bind(c, name='c_test_ndarray_i32_7d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i32_7d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i32_7d + end interface + + interface + integer(c_size_t) & + & function f_test_ndarray_i64_7d( nd_array_i64_7d, f_sum ) & + & bind(c, name='c_test_ndarray_i64_7d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_i64_7d + integer(c_size_t), intent(inout) :: f_sum + end function f_test_ndarray_i64_7d + end interface + + interface + real(c_float) & + & function f_test_ndarray_r32_7d( nd_array_r32_7d, f_sum ) & + & bind(c, name='c_test_ndarray_r32_7d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r32_7d + real(c_float), intent(inout) :: f_sum + end function f_test_ndarray_r32_7d + end interface + + interface + real(c_double) & + & function f_test_ndarray_r64_7d( nd_array_r64_7d, f_sum ) & + & bind(c, name='c_test_ndarray_r64_7d') + use, intrinsic :: iso_c_binding + use :: flcl_mod + type(nd_array_t), intent(in) :: nd_array_r64_7d + real(c_double), intent(inout) :: f_sum + end function f_test_ndarray_r64_7d + end interface + + contains integer(c_size_t) & & function test_ndarray_l_1d() & @@ -590,7 +785,7 @@ & function test_ndarray_r64_2d() & end if end function test_ndarray_r64_2d - integer(c_size_t) & + integer(c_size_t) & & function test_ndarray_l_3d() & & result(ierr) use, intrinsic :: iso_c_binding @@ -789,4 +984,1000 @@ & function test_ndarray_r64_3d() & end if end function test_ndarray_r64_3d + integer(c_size_t) & + & function test_ndarray_l_4d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + logical(c_bool), dimension(:,:,:,:), allocatable :: array_l_4d + integer :: ii, jj, kk, ll + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_l_4d(e0_length, e1_length, e2_length, e3_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + array_l_4d(ii,jj,kk,ll) = logical_pre + if (array_l_4d(ii,jj,kk,ll) .eqv. logical_pre) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + c_sum = f_test_ndarray_l_4d( to_nd_array(array_l_4d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + if (array_l_4d(ii,jj,kk,ll) .eqv. logical_post) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + if (f_sum == c_sum) then + write(*,*)'PASSED ndarray_l_4d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarry_l_4d' + ierr = flcl_test_fail + end if + end function test_ndarray_l_4d + + integer(c_size_t) & + & function test_ndarray_i32_4d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int32_t), dimension(:,:,:,:), allocatable :: array_i32_4d + integer :: ii, jj, kk, ll + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i32_4d(e0_length, e1_length, e2_length, e3_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + array_i32_4d(ii,jj,kk,ll) = ii*jj*kk*ll + f_sum = f_sum + array_i32_4d(ii,jj,kk,ll) + end do + end do + end do + end do + c_sum = f_test_ndarray_i32_4d( to_nd_array(array_i32_4d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + f_sum = f_sum + array_i32_4d(ii,jj,kk,ll) + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i32_4d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i32_4d' + ierr = flcl_test_fail + end if + end function test_ndarray_i32_4d + + integer(c_size_t) & + & function test_ndarray_i64_4d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int64_t), dimension(:,:,:,:), allocatable :: array_i64_4d + integer :: ii, jj, kk, ll + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i64_4d(e0_length, e1_length, e2_length, e3_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + array_i64_4d(ii,jj,kk,ll) = ii*jj*kk*ll + f_sum = f_sum + array_i64_4d(ii,jj,kk,ll) + end do + end do + end do + end do + c_sum = f_test_ndarray_i64_4d( to_nd_array(array_i64_4d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + f_sum = f_sum + array_i64_4d(ii,jj,kk,ll) + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i64_4d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i64_4d' + ierr = flcl_test_fail + end if + end function test_ndarray_i64_4d + + integer(c_size_t) & + & function test_ndarray_r32_4d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_float), dimension(:,:,:,:), allocatable :: array_r32_4d + integer :: ii, jj, kk, ll + real(c_float) :: f_sum = 0 + real(c_float) :: c_sum = 0 + + allocate( array_r32_4d(e0_length, e1_length, e2_length, e3_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + array_r32_4d(ii,jj,kk,ll) = ii*jj*kk*ll + f_sum = f_sum + array_r32_4d(ii,jj,kk,ll) + end do + end do + end do + end do + c_sum = f_test_ndarray_r32_4d( to_nd_array(array_r32_4d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + f_sum = f_sum + array_r32_4d(ii,jj,kk,ll) + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-7 ) then + write(*,*)'PASSED ndarray_r32_4d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r32_4d' + ierr = flcl_test_fail + end if + end function test_ndarray_r32_4d + + integer(c_size_t) & + & function test_ndarray_r64_4d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_double), dimension(:,:,:,:), allocatable :: array_r64_4d + integer :: ii, jj, kk, ll + real(c_double) :: f_sum = 0 + real(c_double) :: c_sum = 0 + + allocate( array_r64_4d(e0_length, e1_length, e2_length, e3_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + array_r64_4d(ii,jj,kk,ll) = ii*jj*kk*ll + f_sum = f_sum + array_r64_4d(ii,jj,kk,ll) + end do + end do + end do + end do + c_sum = f_test_ndarray_r64_4d( to_nd_array(array_r64_4d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + f_sum = f_sum + array_r64_4d(ii,jj,kk,ll) + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-14 ) then + write(*,*)'PASSED ndarray_r64_4d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r64_4d' + ierr = flcl_test_fail + end if + end function test_ndarray_r64_4d + + integer(c_size_t) & + & function test_ndarray_l_5d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + logical(c_bool), dimension(:,:,:,:,:), allocatable :: array_l_5d + integer :: ii, jj, kk, ll, mm + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_l_5d(e0_length, e1_length, e2_length, e3_length, e4_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + array_l_5d(ii,jj,kk,ll,mm) = logical_pre + if (array_l_5d(ii,jj,kk,ll,mm) .eqv. logical_pre) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_l_5d( to_nd_array(array_l_5d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + if (array_l_5d(ii,jj,kk,ll,mm) .eqv. logical_post) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + if (f_sum == c_sum) then + write(*,*)'PASSED ndarray_l_5d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarry_l_5d' + ierr = flcl_test_fail + end if + end function test_ndarray_l_5d + + integer(c_size_t) & + & function test_ndarray_i32_5d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int32_t), dimension(:,:,:,:,:), allocatable :: array_i32_5d + integer :: ii, jj, kk, ll, mm + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i32_5d(e0_length, e1_length, e2_length, e3_length, e4_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + array_i32_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm + f_sum = f_sum + array_i32_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i32_5d( to_nd_array(array_i32_5d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + f_sum = f_sum + array_i32_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i32_5d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i32_5d' + ierr = flcl_test_fail + end if + end function test_ndarray_i32_5d + + integer(c_size_t) & + & function test_ndarray_i64_5d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int64_t), dimension(:,:,:,:,:), allocatable :: array_i64_5d + integer :: ii, jj, kk, ll, mm + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i64_5d(e0_length, e1_length, e2_length, e3_length, e4_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + array_i64_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm + f_sum = f_sum + array_i64_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i64_5d( to_nd_array(array_i64_5d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + f_sum = f_sum + array_i64_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i64_5d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i64_5d' + ierr = flcl_test_fail + end if + end function test_ndarray_i64_5d + + integer(c_size_t) & + & function test_ndarray_r32_5d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_float), dimension(:,:,:,:,:), allocatable :: array_r32_5d + integer :: ii, jj, kk, ll, mm + real(c_float) :: f_sum = 0 + real(c_float) :: c_sum = 0 + + allocate( array_r32_5d(e0_length, e1_length, e2_length, e3_length, e4_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + array_r32_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm + f_sum = f_sum + array_r32_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r32_5d( to_nd_array(array_r32_5d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + f_sum = f_sum + array_r32_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-7 ) then + write(*,*)'PASSED ndarray_r32_5d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r32_5d' + ierr = flcl_test_fail + end if + end function test_ndarray_r32_5d + + integer(c_size_t) & + & function test_ndarray_r64_5d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_double), dimension(:,:,:,:,:), allocatable :: array_r64_5d + integer :: ii, jj, kk, ll, mm + real(c_double) :: f_sum = 0 + real(c_double) :: c_sum = 0 + + allocate( array_r64_5d(e0_length, e1_length, e2_length, e3_length, e4_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + array_r64_5d(ii,jj,kk,ll,mm) = ii*jj*kk*ll*mm + f_sum = f_sum + array_r64_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r64_5d( to_nd_array(array_r64_5d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + f_sum = f_sum + array_r64_5d(ii,jj,kk,ll,mm) + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-14 ) then + write(*,*)'PASSED ndarray_r64_5d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r64_5d' + ierr = flcl_test_fail + end if + end function test_ndarray_r64_5d + + integer(c_size_t) & + & function test_ndarray_l_6d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + logical(c_bool), dimension(:,:,:,:,:,:), allocatable :: array_l_6d + integer :: ii, jj, kk, ll, mm, nn + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_l_6d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + array_l_6d(ii,jj,kk,ll,mm,nn) = logical_pre + if (array_l_6d(ii,jj,kk,ll,mm,nn) .eqv. logical_pre) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_l_6d( to_nd_array(array_l_6d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + if (array_l_6d(ii,jj,kk,ll,mm,nn) .eqv. logical_post) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + end do + if (f_sum == c_sum) then + write(*,*)'PASSED ndarray_l_6d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarry_l_6d' + ierr = flcl_test_fail + end if + end function test_ndarray_l_6d + + integer(c_size_t) & + & function test_ndarray_i32_6d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int32_t), dimension(:,:,:,:,:,:), allocatable :: array_i32_6d + integer :: ii, jj, kk, ll, mm, nn + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i32_6d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + array_i32_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn + f_sum = f_sum + array_i32_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i32_6d( to_nd_array(array_i32_6d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + f_sum = f_sum + array_i32_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i32_6d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i32_6d' + ierr = flcl_test_fail + end if + end function test_ndarray_i32_6d + + integer(c_size_t) & + & function test_ndarray_i64_6d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int64_t), dimension(:,:,:,:,:,:), allocatable :: array_i64_6d + integer :: ii, jj, kk, ll, mm, nn + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i64_6d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + array_i64_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn + f_sum = f_sum + array_i64_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i64_6d( to_nd_array(array_i64_6d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + f_sum = f_sum + array_i64_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i64_6d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i64_6d' + ierr = flcl_test_fail + end if + end function test_ndarray_i64_6d + + integer(c_size_t) & + & function test_ndarray_r32_6d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_float), dimension(:,:,:,:,:,:), allocatable :: array_r32_6d + integer :: ii, jj, kk, ll, mm, nn + real(c_float) :: f_sum = 0 + real(c_float) :: c_sum = 0 + + allocate( array_r32_6d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + array_r32_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn + f_sum = f_sum + array_r32_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r32_6d( to_nd_array(array_r32_6d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + f_sum = f_sum + array_r32_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-7 ) then + write(*,*)'PASSED ndarray_r32_6d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r32_6d' + ierr = flcl_test_fail + end if + end function test_ndarray_r32_6d + + integer(c_size_t) & + & function test_ndarray_r64_6d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_double), dimension(:,:,:,:,:,:), allocatable :: array_r64_6d + integer :: ii, jj, kk, ll, mm, nn + real(c_double) :: f_sum = 0 + real(c_double) :: c_sum = 0 + + allocate( array_r64_6d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + array_r64_6d(ii,jj,kk,ll,mm,nn) = ii*jj*kk*ll*mm*nn + f_sum = f_sum + array_r64_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r64_6d( to_nd_array(array_r64_6d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + f_sum = f_sum + array_r64_6d(ii,jj,kk,ll,mm,nn) + end do + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-14 ) then + write(*,*)'PASSED ndarray_r64_6d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r64_6d' + ierr = flcl_test_fail + end if + end function test_ndarray_r64_6d + + integer(c_size_t) & + & function test_ndarray_l_7d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + logical(c_bool), dimension(:,:,:,:,:,:,:), allocatable :: array_l_7d + integer :: ii, jj, kk, ll, mm, nn, oo + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_l_7d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length, e6_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + array_l_7d(ii,jj,kk,ll,mm,nn,oo) = logical_pre + if (array_l_7d(ii,jj,kk,ll,mm,nn,oo) .eqv. logical_pre) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_l_7d( to_nd_array(array_l_7d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + if (array_l_7d(ii,jj,kk,ll,mm,nn,oo) .eqv. logical_post) then + f_sum = f_sum + 1 + end if + end do + end do + end do + end do + end do + end do + end do + if (f_sum == c_sum) then + write(*,*)'PASSED ndarray_l_7d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarry_l_7d' + ierr = flcl_test_fail + end if + end function test_ndarray_l_7d + + integer(c_size_t) & + & function test_ndarray_i32_7d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int32_t), dimension(:,:,:,:,:,:,:), allocatable :: array_i32_7d + integer :: ii, jj, kk, ll, mm, nn, oo + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i32_7d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length, e6_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + array_i32_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo + f_sum = f_sum + array_i32_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i32_7d( to_nd_array(array_i32_7d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + f_sum = f_sum + array_i32_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i32_7d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i32_7d' + ierr = flcl_test_fail + end if + end function test_ndarray_i32_7d + + integer(c_size_t) & + & function test_ndarray_i64_7d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + integer(c_int64_t), dimension(:,:,:,:,:,:,:), allocatable :: array_i64_7d + integer :: ii, jj, kk, ll, mm, nn,oo + integer(c_size_t) :: f_sum = 0 + integer(c_size_t) :: c_sum = 0 + + allocate( array_i64_7d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length, e6_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + array_i64_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo + f_sum = f_sum + array_i64_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_i64_7d( to_nd_array(array_i64_7d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + f_sum = f_sum + array_i64_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + if ( f_sum .eq. c_sum ) then + write(*,*)'PASSED ndarray_i64_7d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_i64_7d' + ierr = flcl_test_fail + end if + end function test_ndarray_i64_7d + + integer(c_size_t) & + & function test_ndarray_r32_7d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_float), dimension(:,:,:,:,:,:,:), allocatable :: array_r32_7d + integer :: ii, jj, kk, ll, mm, nn, oo + real(c_float) :: f_sum = 0 + real(c_float) :: c_sum = 0 + + allocate( array_r32_7d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length, e6_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + array_r32_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo + f_sum = f_sum + array_r32_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r32_7d( to_nd_array(array_r32_7d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + f_sum = f_sum + array_r32_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-7 ) then + write(*,*)'PASSED ndarray_r32_7d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r32_7d' + ierr = flcl_test_fail + end if + end function test_ndarray_r32_7d + + integer(c_size_t) & + & function test_ndarray_r64_7d() & + & result(ierr) + use, intrinsic :: iso_c_binding + use :: flcl_mod + implicit none + + real(c_double), dimension(:,:,:,:,:,:,:), allocatable :: array_r64_7d + integer :: ii, jj, kk, ll, mm, nn, oo + real(c_double) :: f_sum = 0 + real(c_double) :: c_sum = 0 + + allocate( array_r64_7d(e0_length, e1_length, e2_length, e3_length, e4_length, e5_length, e6_length) ) + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + array_r64_7d(ii,jj,kk,ll,mm,nn,oo) = ii*jj*kk*ll*mm*nn*oo + f_sum = f_sum + array_r64_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + c_sum = f_test_ndarray_r64_7d( to_nd_array(array_r64_7d), f_sum ) + f_sum = 0 + do ii = 1, e0_length + do jj = 1, e1_length + do kk = 1, e2_length + do ll = 1, e3_length + do mm = 1, e4_length + do nn = 1, e5_length + do oo = 1, e6_length + f_sum = f_sum + array_r64_7d(ii,jj,kk,ll,mm,nn,oo) + end do + end do + end do + end do + end do + end do + end do + if ( abs(f_sum - c_sum ) < 1.0e-14 ) then + write(*,*)'PASSED ndarray_r64_7d' + ierr = flcl_test_pass + else + write(*,*)'FAILED ndarray_r64_7d' + ierr = flcl_test_fail + end if + end function test_ndarray_r64_7d + end module test_flcl_f_mod \ No newline at end of file diff --git a/test/test-flcl-main.f90 b/test/test-flcl-main.f90 index 0c2850d..2cf58f1 100644 --- a/test/test-flcl-main.f90 +++ b/test/test-flcl-main.f90 @@ -40,6 +40,7 @@ program test_flcl_main use, intrinsic :: iso_fortran_env use :: flcl_mod + use :: flcl_util_mod use :: test_flcl_f_mod implicit none @@ -48,55 +49,124 @@ program test_flcl_main call kokkos_initialize() - ierr = test_ndarray_l_1d() - write(*,*)'ierr ',ierr + if ( kokkos_is_initialized() ) then + + call kokkos_print_configuration('flcl-test-', 'kokkos.out') - ierr = test_ndarray_i32_1d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_i64_1d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r32_1d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r64_1d() - write(*,*)'ierr ',ierr - + ! test ndarray 1d specializations + ierr = test_ndarray_l_1d() + write(*,*)'ierr ',ierr - ierr = test_ndarray_l_2d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_i32_2d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_i64_2d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r32_2d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r64_2d() - write(*,*)'ierr ',ierr - + ierr = test_ndarray_i32_1d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_1d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_1d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_1d() + write(*,*)'ierr ',ierr + + ! test ndarray 2d specializations + ierr = test_ndarray_l_2d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_2d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_2d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_2d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_2d() + write(*,*)'ierr ',ierr + + ! test ndarray 3d specializations + ierr = test_ndarray_l_3d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_3d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_3d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_3d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_3d() + write(*,*)'ierr ',ierr + + ! test ndarray 4d specializations + ierr = test_ndarray_l_4d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_4d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_4d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_4d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_4d() + write(*,*)'ierr ',ierr - ierr = test_ndarray_l_3d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_i32_3d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_i64_3d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r32_3d() - write(*,*)'ierr ',ierr - - ierr = test_ndarray_r64_3d() - write(*,*)'ierr ',ierr - + ! test ndarray 5d specializations + ierr = test_ndarray_l_5d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_5d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_5d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_5d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_5d() + write(*,*)'ierr ',ierr - call kokkos_finalize() + ! test ndarray 6d specializations + ierr = test_ndarray_l_6d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_6d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_6d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_6d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_6d() + write(*,*)'ierr ',ierr + ! test ndarray 7d specializations + ierr = test_ndarray_l_7d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i32_7d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_i64_7d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r32_7d() + write(*,*)'ierr ',ierr + + ierr = test_ndarray_r64_7d() + write(*,*)'ierr ',ierr + call kokkos_finalize() + + end if + end program test_flcl_main \ No newline at end of file