diff --git a/Make.inc.in b/Make.inc.in index 1fa3179c0..e28e9bee8 100755 --- a/Make.inc.in +++ b/Make.inc.in @@ -67,6 +67,28 @@ UTILMODNAME=@UTILMODNAME@ CBINDLIBNAME=libpsb_cbind.a +GPUD=@GPUD@ +GPULD=@GPULD@ + +SPGPUDIR=@SPGPU_DIR@ +SPGPU_INCDIR=@SPGPU_INCDIR@ +SPGPU_LIBS=@SPGPU_LIBS@ +SPGPU_DEFINES=@SPGPU_DEFINES@ +SPGPU_INCLUDES=@SPGPU_INCLUDES@ + +CUDA_DIR=@CUDA_DIR@ +CUDA_DEFINES=@CUDA_DEFINES@ +CUDA_INCLUDES=@CUDA_INCLUDES@ +CUDA_LIBS=@CUDA_LIBS@ +CUDA_VERSION=@CUDA_VERSION@ +CUDA_SHORT_VERSION=@CUDA_SHORT_VERSION@ +NVCC=@CUDA_NVCC@ +CUDEFINES=@CUDEFINES@ + +.SUFFIXES: .cu +.cu.o: + $(NVCC) $(CINCLUDES) $(CDEFINES) $(CUDEFINES) -c $< + @PSBLASRULES@ diff --git a/Makefile b/Makefile index 4a79afce9..498792703 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ include Make.inc -all: dirs based precd kryld utild cbindd extd libd +all: dirs based precd kryld utild cbindd extd $(GPUD) libd @echo "=====================================" @echo "PSBLAS libraries Compilation Successful." @@ -12,17 +12,20 @@ dirs: precd: based utild: based kryld: precd -extd: based - +extd: based +gpud: extd cbindd: based precd kryld utild -libd: based precd kryld utild cbindd extd +libd: based precd kryld utild cbindd extd $(GPULD) $(MAKE) -C base lib $(MAKE) -C prec lib $(MAKE) -C krylov lib $(MAKE) -C util lib $(MAKE) -C cbind lib $(MAKE) -C ext lib +gpuld: gpud + $(MAKE) -C gpu lib + based: $(MAKE) -C base objs @@ -34,8 +37,10 @@ utild: $(MAKE) -C util objs cbindd: $(MAKE) -C cbind objs -extd: +extd: based $(MAKE) -C ext objs +gpud: based extd + $(MAKE) -C gpu objs install: all @@ -61,6 +66,7 @@ clean: $(MAKE) -C util clean $(MAKE) -C cbind clean $(MAKE) -C ext clean + $(MAKE) -C gpu clean check: all make check -C test/serial @@ -77,6 +83,7 @@ veryclean: cleanlib cd util && $(MAKE) veryclean cd cbind && $(MAKE) veryclean cd ext && $(MAKE) veryclean + cd gpu && $(MAKE) veryclean cd test/fileread && $(MAKE) clean cd test/pargen && $(MAKE) clean cd test/util && $(MAKE) clean diff --git a/config/pac.m4 b/config/pac.m4 index 69d2f8634..7a9ee07e1 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -2018,3 +2018,252 @@ CPPFLAGS="$SAVE_CPPFLAGS"; ])dnl +dnl @synopsis PAC_CHECK_SPGPU +dnl +dnl Will try to find the spgpu library and headers. +dnl +dnl Will use $CC +dnl +dnl If the test passes, will execute ACTION-IF-FOUND. Otherwise, ACTION-IF-NOT-FOUND. +dnl Note : This file will be likely to induce the compiler to create a module file +dnl (for a module called conftest). +dnl Depending on the compiler flags, this could cause a conftest.mod file to appear +dnl in the present directory, or in another, or with another name. So be warned! +dnl +dnl @author Salvatore Filippone +dnl +AC_DEFUN(PAC_CHECK_SPGPU, + [SAVE_LIBS="$LIBS" + SAVE_CPPFLAGS="$CPPFLAGS" + if test "x$pac_cv_have_cuda" == "x"; then + PAC_CHECK_CUDA() + fi +dnl AC_MSG_NOTICE([From CUDA: $pac_cv_have_cuda ]) + if test "x$pac_cv_have_cuda" == "xyes"; then + AC_ARG_WITH(spgpu, AC_HELP_STRING([--with-spgpu=DIR], [Specify the directory for SPGPU library and includes.]), + [pac_cv_spgpudir=$withval], + [pac_cv_spgpudir='']) + + AC_LANG([C]) + if test "x$pac_cv_spgpudir" != "x"; then + LIBS="-L$pac_cv_spgpudir/lib $LIBS" + GPU_INCLUDES="-I$pac_cv_spgpudir/include" + CPPFLAGS="$GPU_INCLUDES $CUDA_INCLUDES $CPPFLAGS" + GPU_LIBDIR="-L$pac_cv_spgpudir/lib" + fi + AC_MSG_CHECKING([spgpu dir $pac_cv_spgpudir]) + AC_CHECK_HEADER([core.h], + [pac_gpu_header_ok=yes], + [pac_gpu_header_ok=no; GPU_INCLUDES=""]) + + if test "x$pac_gpu_header_ok" == "xyes" ; then + GPU_LIBS="-lspgpu $GPU_LIBDIR" + LIBS="$GPU_LIBS $CUDA_LIBS -lm $LIBS"; + AC_MSG_CHECKING([for spgpuCreate in $GPU_LIBS]) + AC_TRY_LINK_FUNC(spgpuCreate, + [pac_cv_have_spgpu=yes;pac_gpu_lib_ok=yes; ], + [pac_cv_have_spgpu=no;pac_gpu_lib_ok=no; GPU_LIBS=""]) + AC_MSG_RESULT($pac_gpu_lib_ok) + if test "x$pac_cv_have_spgpu" == "xyes" ; then + AC_MSG_NOTICE([Have found SPGPU]) + SPGPULIBNAME="libpsbgpu.a"; + SPGPU_DIR="$pac_cv_spgpudir"; + SPGPU_DEFINES="-DHAVE_SPGPU"; + SPGPU_INCDIR="$SPGPU_DIR/include"; + SPGPU_INCLUDES="-I$SPGPU_INCDIR"; + SPGPU_LIBS="-lspgpu -L$SPGPU_DIR/lib"; + LGPU=-lpsb_gpu + CUDA_DIR="$pac_cv_cuda_dir"; + CUDA_DEFINES="-DHAVE_CUDA"; + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + FDEFINES="$psblas_cv_define_prepend-DHAVE_GPU $psblas_cv_define_prepend-DHAVE_SPGPU $psblas_cv_define_prepend-DHAVE_CUDA $FDEFINES"; + CDEFINES="-DHAVE_SPGPU -DHAVE_CUDA $CDEFINES" ; + fi + fi +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" +])dnl + + + + +dnl @synopsis PAC_CHECK_CUDA +dnl +dnl Will try to find the cuda library and headers. +dnl +dnl Will use $CC +dnl +dnl If the test passes, will execute ACTION-IF-FOUND. Otherwise, ACTION-IF-NOT-FOUND. +dnl Note : This file will be likely to induce the compiler to create a module file +dnl (for a module called conftest). +dnl Depending on the compiler flags, this could cause a conftest.mod file to appear +dnl in the present directory, or in another, or with another name. So be warned! +dnl +dnl @author Salvatore Filippone +dnl +AC_DEFUN(PAC_CHECK_CUDA, +[AC_ARG_WITH(cuda, AC_HELP_STRING([--with-cuda=DIR], [Specify the directory for CUDA library and includes.]), + [pac_cv_cuda_dir=$withval], + [pac_cv_cuda_dir='']) + +AC_LANG([C]) +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_cuda_dir" != "x"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + if test -f "$pac_cv_cuda_dir/bin/nvcc"; then + CUDA_NVCC="$pac_cv_cuda_dir/bin/nvcc" + else + CUDA_NVCC="nvcc" + fi +fi +AC_MSG_CHECKING([cuda dir $pac_cv_cuda_dir]) +AC_CHECK_HEADER([cuda_runtime.h], + [pac_cuda_header_ok=yes], + [pac_cuda_header_ok=no; CUDA_INCLUDES=""]) + +if test "x$pac_cuda_header_ok" == "xyes" ; then + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + AC_MSG_CHECKING([for cudaMemcpy in $CUDA_LIBS]) + AC_TRY_LINK_FUNC(cudaMemcpy, + [pac_cv_have_cuda=yes;pac_cuda_lib_ok=yes; ], + [pac_cv_have_cuda=no;pac_cuda_lib_ok=no; CUDA_LIBS=""]) + AC_MSG_RESULT($pac_cuda_lib_ok) + +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" +])dnl + +dnl @synopsis PAC_ARG_WITH_CUDACC +dnl +dnl Test for --with-cudacc="set_of_cc". +dnl +dnl Defines the CC to compile for +dnl +dnl +dnl Example use: +dnl +dnl PAC_ARG_WITH_CUDACC +dnl +dnl @author Salvatore Filippone +dnl +AC_DEFUN([PAC_ARG_WITH_CUDACC], +[ +AC_ARG_WITH(cudacc, +AC_HELP_STRING([--with-cudacc], [A comma-separated list of CCs to compile to, for example, + --with-cudacc=30,35,37,50,60]), +[pac_cv_cudacc=$withval], +[pac_cv_cudacc='']) +]) + +AC_DEFUN(PAC_ARG_WITH_LIBRSB, + [SAVE_LIBS="$LIBS" + SAVE_CPPFLAGS="$CPPFLAGS" + + AC_ARG_WITH(librsb, + AC_HELP_STRING([--with-librsb], [The directory for LIBRSB, for example, + --with-librsb=/opt/packages/librsb]), + [pac_cv_librsb_dir=$withval], + [pac_cv_librsb_dir='']) + + if test "x$pac_cv_librsb_dir" != "x"; then + LIBS="-L$pac_cv_librsb_dir $LIBS" + RSB_INCLUDES="-I$pac_cv_librsb_dir" + # CPPFLAGS="$GPU_INCLUDES $CUDA_INCLUDES $CPPFLAGS" + RSB_LIBDIR="-L$pac_cv_librsb_dir" + fi + #AC_MSG_CHECKING([librsb dir $pac_cv_librsb_dir]) + AC_CHECK_HEADER([$pac_cv_librsb_dir/rsb.h], + [pac_rsb_header_ok=yes], + [pac_rsb_header_ok=no; RSB_INCLUDES=""]) + + if test "x$pac_rsb_header_ok" == "xyes" ; then + RSB_LIBS="-lrsb $RSB_LIBDIR" + # LIBS="$GPU_LIBS $CUDA_LIBS -lm $LIBS"; + # AC_MSG_CHECKING([for spgpuCreate in $GPU_LIBS]) + # AC_TRY_LINK_FUNC(spgpuCreate, + # [pac_cv_have_spgpu=yes;pac_gpu_lib_ok=yes; ], + # [pac_cv_have_spgpu=no;pac_gpu_lib_ok=no; GPU_LIBS=""]) + # AC_MSG_RESULT($pac_gpu_lib_ok) + # if test "x$pac_cv_have_spgpu" == "xyes" ; then + # AC_MSG_NOTICE([Have found SPGPU]) + RSBLIBNAME="librsb.a"; + LIBRSB_DIR="$pac_cv_librsb_dir"; + # SPGPU_DEFINES="-DHAVE_SPGPU"; + LIBRSB_INCDIR="$LIBRSB_DIR"; + LIBRSB_INCLUDES="-I$LIBRSB_INCDIR"; + LIBRSB_LIBS="-lrsb -L$LIBRSB_DIR"; + # CUDA_DIR="$pac_cv_cuda_dir"; + LIBRSB_DEFINES="-DHAVE_RSB"; + LRSB=-lpsb_rsb + # CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + # CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + FDEFINES="$LIBRSB_DEFINES $psblas_cv_define_prepend $FDEFINES"; + CDEFINES="$LIBRSB_DEFINES $CDEFINES";#CDEFINES="-DHAVE_SPGPU -DHAVE_CUDA $CDEFINES"; + fi +# fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" +]) +dnl + +dnl @synopsis PAC_CHECK_CUDA_VERSION +dnl +dnl Will try to find the cuda version +dnl +dnl Will use $CC +dnl +dnl If the test passes, will execute ACTION-IF-FOUND. Otherwise, ACTION-IF-NOT-FOUND. +dnl Note : This file will be likely to induce the compiler to create a module file +dnl (for a module called conftest). +dnl Depending on the compiler flags, this could cause a conftest.mod file to appear +dnl in the present directory, or in another, or with another name. So be warned! +dnl +dnl @author Salvatore Filippone +dnl +AC_DEFUN(PAC_CHECK_CUDA_VERSION, +[AC_LANG_PUSH([C]) +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_have_cuda" == "x"; then + PAC_CHECK_CUDA() +fi +if test "x$pac_cv_have_cuda" == "xyes"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + AC_MSG_CHECKING([for CUDA version]) + AC_LINK_IFELSE([AC_LANG_SOURCE([ +#include +#include + +int main(int argc, char *argv[]) +{ + printf("%d",CUDA_VERSION); + return(0); +} ])], + [pac_cv_cuda_version=`./conftest${ac_exeext} | sed 's/^ *//'`;], + [pac_cv_cuda_version="unknown";]) + + AC_MSG_RESULT($pac_cv_cuda_version) + fi +AC_LANG_POP([C]) +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" +])dnl + + diff --git a/configure b/configure index 752fe192f..5c3444b34 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for PSBLAS 3.7.0. +# Generated by GNU Autoconf 2.71 for PSBLAS 3.8.1. # # Report bugs to . # @@ -611,8 +611,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='PSBLAS' PACKAGE_TARNAME='psblas' -PACKAGE_VERSION='3.7.0' -PACKAGE_STRING='PSBLAS 3.7.0' +PACKAGE_VERSION='3.8.1' +PACKAGE_STRING='PSBLAS 3.8.1' PACKAGE_BUGREPORT='https://github.com/sfilippone/psblas3/issues' PACKAGE_URL='' @@ -653,6 +653,23 @@ ac_subst_vars='am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS LIBOBJS +GPULD +GPUD +CUDEFINES +CUDA_NVCC +CUDA_SHORT_VERSION +CUDA_VERSION +CUDA_LIBS +CUDA_INCLUDES +CUDA_DEFINES +CUDA_DIR +EXTRALDLIBS +SPGPU_INCDIR +SPGPU_INCLUDES +SPGPU_DEFINES +SPGPU_DIR +SPGPU_LIBS +SPGPU_FLAGS METISINCFILE UTILLIBNAME METHDLIBNAME @@ -825,6 +842,9 @@ with_amd with_amddir with_amdincdir with_amdlibdir +with_cuda +with_spgpu +with_cudacc ' ac_precious_vars='build_alias host_alias @@ -1390,7 +1410,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures PSBLAS 3.7.0 to adapt to many kinds of systems. +\`configure' configures PSBLAS 3.8.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1457,7 +1477,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of PSBLAS 3.7.0:";; + short | recursive ) echo "Configuration of PSBLAS 3.8.1:";; esac cat <<\_ACEOF @@ -1523,6 +1543,11 @@ Optional Packages: --with-amddir=DIR Specify the directory for AMD library and includes. --with-amdincdir=DIR Specify the directory for AMD includes. --with-amdlibdir=DIR Specify the directory for AMD library. + --with-cuda=DIR Specify the directory for CUDA library and includes. + --with-spgpu=DIR Specify the directory for SPGPU library and + includes. + --with-cudacc A comma-separated list of CCs to compile to, for + example, --with-cudacc=30,35,37,50,60 Some influential environment variables: FC Fortran compiler command @@ -1607,7 +1632,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -PSBLAS configure 3.7.0 +PSBLAS configure 3.8.1 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -2291,7 +2316,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by PSBLAS $as_me 3.7.0, which was +It was created by PSBLAS $as_me 3.8.1, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3265,7 +3290,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # VERSION is the file containing the PSBLAS version code # FIXME -psblas_cv_version="3.7.0" +psblas_cv_version="3.8.1" # A sample source file @@ -3280,7 +3305,8 @@ psblas_cv_version="3.7.0" documentation, you can make your own by hand for your needs. Be sure to specify the library paths of your interest. Examples: - ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + --with-spgpu=/path/to/spgpu FC=mpif90 CC=mpicc ./configure <- will force FC,CC See ./configure --help=short fore more info. @@ -3294,7 +3320,8 @@ printf "%s\n" "$as_me: documentation, you can make your own by hand for your needs. Be sure to specify the library paths of your interest. Examples: - ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + --with-spgpu=/path/to/spgpu FC=mpif90 CC=mpicc ./configure <- will force FC,CC See ./configure --help=short fore more info. @@ -6393,7 +6420,7 @@ fi # Define the identity of the package. PACKAGE='psblas' - VERSION='3.7.0' + VERSION='3.8.1' printf "%s\n" "#define PACKAGE \"$PACKAGE\"" >>confdefs.h @@ -10610,6 +10637,434 @@ fi + +# Check whether --with-cuda was given. +if test ${with_cuda+y} +then : + withval=$with_cuda; pac_cv_cuda_dir=$withval +else $as_nop + pac_cv_cuda_dir='' +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_cuda_dir" != "x"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + if test -f "$pac_cv_cuda_dir/bin/nvcc"; then + CUDA_NVCC="$pac_cv_cuda_dir/bin/nvcc" + else + CUDA_NVCC="nvcc" + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking cuda dir $pac_cv_cuda_dir" >&5 +printf %s "checking cuda dir $pac_cv_cuda_dir... " >&6; } +ac_fn_c_check_header_compile "$LINENO" "cuda_runtime.h" "ac_cv_header_cuda_runtime_h" "$ac_includes_default" +if test "x$ac_cv_header_cuda_runtime_h" = xyes +then : + pac_cuda_header_ok=yes +else $as_nop + pac_cuda_header_ok=no; CUDA_INCLUDES="" +fi + + +if test "x$pac_cuda_header_ok" == "xyes" ; then + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cudaMemcpy in $CUDA_LIBS" >&5 +printf %s "checking for cudaMemcpy in $CUDA_LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char cudaMemcpy (); +int +main (void) +{ +return cudaMemcpy (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + pac_cv_have_cuda=yes;pac_cuda_lib_ok=yes; +else $as_nop + pac_cv_have_cuda=no;pac_cuda_lib_ok=no; CUDA_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $pac_cuda_lib_ok" >&5 +printf "%s\n" "$pac_cuda_lib_ok" >&6; } + +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" + + +if test "x$pac_cv_have_cuda" == "xyes"; then + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_have_cuda" == "x"; then + +# Check whether --with-cuda was given. +if test ${with_cuda+y} +then : + withval=$with_cuda; pac_cv_cuda_dir=$withval +else $as_nop + pac_cv_cuda_dir='' +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_cuda_dir" != "x"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + if test -f "$pac_cv_cuda_dir/bin/nvcc"; then + CUDA_NVCC="$pac_cv_cuda_dir/bin/nvcc" + else + CUDA_NVCC="nvcc" + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking cuda dir $pac_cv_cuda_dir" >&5 +printf %s "checking cuda dir $pac_cv_cuda_dir... " >&6; } +ac_fn_c_check_header_compile "$LINENO" "cuda_runtime.h" "ac_cv_header_cuda_runtime_h" "$ac_includes_default" +if test "x$ac_cv_header_cuda_runtime_h" = xyes +then : + pac_cuda_header_ok=yes +else $as_nop + pac_cuda_header_ok=no; CUDA_INCLUDES="" +fi + + +if test "x$pac_cuda_header_ok" == "xyes" ; then + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cudaMemcpy in $CUDA_LIBS" >&5 +printf %s "checking for cudaMemcpy in $CUDA_LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char cudaMemcpy (); +int +main (void) +{ +return cudaMemcpy (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + pac_cv_have_cuda=yes;pac_cuda_lib_ok=yes; +else $as_nop + pac_cv_have_cuda=no;pac_cuda_lib_ok=no; CUDA_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $pac_cuda_lib_ok" >&5 +printf "%s\n" "$pac_cuda_lib_ok" >&6; } + +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" + +fi +if test "x$pac_cv_have_cuda" == "xyes"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for CUDA version" >&5 +printf %s "checking for CUDA version... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include +#include + +int main(int argc, char *argv) +{ + printf("%d",CUDA_VERSION); + return(0); +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + pac_cv_cuda_version=`./conftest${ac_exeext} | sed 's/^ *//'`; +else $as_nop + pac_cv_cuda_version="unknown"; +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $pac_cv_cuda_version" >&5 +printf "%s\n" "$pac_cv_cuda_version" >&6; } + fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" + +CUDA_VERSION="$pac_cv_cuda_version"; +CUDA_SHORT_VERSION=$(expr $pac_cv_cuda_version / 1000); +SAVE_LIBS="$LIBS" + SAVE_CPPFLAGS="$CPPFLAGS" + if test "x$pac_cv_have_cuda" == "x"; then + +# Check whether --with-cuda was given. +if test ${with_cuda+y} +then : + withval=$with_cuda; pac_cv_cuda_dir=$withval +else $as_nop + pac_cv_cuda_dir='' +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +SAVE_LIBS="$LIBS" +SAVE_CPPFLAGS="$CPPFLAGS" +if test "x$pac_cv_cuda_dir" != "x"; then + CUDA_DIR="$pac_cv_cuda_dir" + LIBS="-L$pac_cv_cuda_dir/lib $LIBS" + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_DEFINES="-DHAVE_CUDA" + CPPFLAGS="$CUDA_INCLUDES $CPPFLAGS" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + if test -f "$pac_cv_cuda_dir/bin/nvcc"; then + CUDA_NVCC="$pac_cv_cuda_dir/bin/nvcc" + else + CUDA_NVCC="nvcc" + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking cuda dir $pac_cv_cuda_dir" >&5 +printf %s "checking cuda dir $pac_cv_cuda_dir... " >&6; } +ac_fn_c_check_header_compile "$LINENO" "cuda_runtime.h" "ac_cv_header_cuda_runtime_h" "$ac_includes_default" +if test "x$ac_cv_header_cuda_runtime_h" = xyes +then : + pac_cuda_header_ok=yes +else $as_nop + pac_cuda_header_ok=no; CUDA_INCLUDES="" +fi + + +if test "x$pac_cuda_header_ok" == "xyes" ; then + CUDA_LIBS="-lcusparse -lcublas -lcudart $CUDA_LIBDIR" + LIBS="$CUDA_LIBS -lm $LIBS"; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for cudaMemcpy in $CUDA_LIBS" >&5 +printf %s "checking for cudaMemcpy in $CUDA_LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char cudaMemcpy (); +int +main (void) +{ +return cudaMemcpy (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + pac_cv_have_cuda=yes;pac_cuda_lib_ok=yes; +else $as_nop + pac_cv_have_cuda=no;pac_cuda_lib_ok=no; CUDA_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $pac_cuda_lib_ok" >&5 +printf "%s\n" "$pac_cuda_lib_ok" >&6; } + +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" + + fi + if test "x$pac_cv_have_cuda" == "xyes"; then + +# Check whether --with-spgpu was given. +if test ${with_spgpu+y} +then : + withval=$with_spgpu; pac_cv_spgpudir=$withval +else $as_nop + pac_cv_spgpudir='' +fi + + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test "x$pac_cv_spgpudir" != "x"; then + LIBS="-L$pac_cv_spgpudir/lib $LIBS" + GPU_INCLUDES="-I$pac_cv_spgpudir/include" + CPPFLAGS="$GPU_INCLUDES $CUDA_INCLUDES $CPPFLAGS" + GPU_LIBDIR="-L$pac_cv_spgpudir/lib" + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking spgpu dir $pac_cv_spgpudir" >&5 +printf %s "checking spgpu dir $pac_cv_spgpudir... " >&6; } + ac_fn_c_check_header_compile "$LINENO" "core.h" "ac_cv_header_core_h" "$ac_includes_default" +if test "x$ac_cv_header_core_h" = xyes +then : + pac_gpu_header_ok=yes +else $as_nop + pac_gpu_header_ok=no; GPU_INCLUDES="" +fi + + + if test "x$pac_gpu_header_ok" == "xyes" ; then + GPU_LIBS="-lspgpu $GPU_LIBDIR" + LIBS="$GPU_LIBS $CUDA_LIBS -lm $LIBS"; + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for spgpuCreate in $GPU_LIBS" >&5 +printf %s "checking for spgpuCreate in $GPU_LIBS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char spgpuCreate (); +int +main (void) +{ +return spgpuCreate (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + pac_cv_have_spgpu=yes;pac_gpu_lib_ok=yes; +else $as_nop + pac_cv_have_spgpu=no;pac_gpu_lib_ok=no; GPU_LIBS="" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $pac_gpu_lib_ok" >&5 +printf "%s\n" "$pac_gpu_lib_ok" >&6; } + if test "x$pac_cv_have_spgpu" == "xyes" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Have found SPGPU" >&5 +printf "%s\n" "$as_me: Have found SPGPU" >&6;} + SPGPULIBNAME="libpsbgpu.a"; + SPGPU_DIR="$pac_cv_spgpudir"; + SPGPU_DEFINES="-DHAVE_SPGPU"; + SPGPU_INCDIR="$SPGPU_DIR/include"; + SPGPU_INCLUDES="-I$SPGPU_INCDIR"; + SPGPU_LIBS="-lspgpu -L$SPGPU_DIR/lib"; + LGPU=-lpsb_gpu + CUDA_DIR="$pac_cv_cuda_dir"; + CUDA_DEFINES="-DHAVE_CUDA"; + CUDA_INCLUDES="-I$pac_cv_cuda_dir/include" + CUDA_LIBDIR="-L$pac_cv_cuda_dir/lib64 -L$pac_cv_cuda_dir/lib" + FDEFINES="$psblas_cv_define_prepend-DHAVE_GPU $psblas_cv_define_prepend-DHAVE_SPGPU $psblas_cv_define_prepend-DHAVE_CUDA $FDEFINES"; + CDEFINES="-DHAVE_SPGPU -DHAVE_CUDA $CDEFINES" ; + fi + fi +fi +LIBS="$SAVE_LIBS" +CPPFLAGS="$SAVE_CPPFLAGS" + +if test "x$pac_cv_have_spgpu" == "xyes" ; then + GPUD=gpud; + GPULD=gpuld; + EXTRALDLIBS="-lstdc++"; +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: At this point GPUTARGET is $GPUD $GPULD" >&5 +printf "%s\n" "$as_me: At this point GPUTARGET is $GPUD $GPULD" >&6;} + + + +# Check whether --with-cudacc was given. +if test ${with_cudacc+y} +then : + withval=$with_cudacc; pac_cv_cudacc=$withval +else $as_nop + pac_cv_cudacc='' +fi + + +if test "x$pac_cv_cudacc" == "x"; then + pac_cv_cudacc="30,35,37,50,60"; +fi +CUDEFINES=""; +for cc in `echo $pac_cv_cudacc|sed 's/,/ /gi'` +do + CUDEFINES="$CUDEFINES -gencode arch=compute_$cc,code=sm_$cc"; +done +if test "x$pac_cv_cuda_version" != "xunknown"; then + CUDEFINES="$CUDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" + FDEFINES="$FDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" + CDEFINES="$CDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" +fi + +fi + +if test "x$pac_cv_ipk_size" != "x4"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: For CUDA I need psb_ipk_ to be 4 bytes but it is $pac_cv_ipk_size, disabling CUDA/SPGPU" >&5 +printf "%s\n" "$as_me: For CUDA I need psb_ipk_ to be 4 bytes but it is $pac_cv_ipk_size, disabling CUDA/SPGPU" >&6;} + GPUD=""; + GPULD=""; + CUDEFINES=""; + CUDA_INCLUDES=""; + CUDA_LIBS=""; +fi + + + + ############################################################################### # Library target directory and archive files. ############################################################################### @@ -10687,6 +11142,22 @@ FDEFINES=$(PSBFDEFINES) + + + + + + + + + + + + + + + + @@ -11262,7 +11733,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by PSBLAS $as_me 3.7.0, which was +This file was extended by PSBLAS $as_me 3.8.1, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -11321,7 +11792,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -PSBLAS config.status 3.7.0 +PSBLAS config.status 3.8.1 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index d8a02a50b..4b7f82e1f 100755 --- a/configure.ac +++ b/configure.ac @@ -36,11 +36,11 @@ dnl NOTE : There is no cross compilation support. ############################################################################### # NOTE: the literal for version (the second argument to AC_INIT should be a literal!) -AC_INIT([PSBLAS],3.7.0, [https://github.com/sfilippone/psblas3/issues]) +AC_INIT([PSBLAS],3.8.1, [https://github.com/sfilippone/psblas3/issues]) # VERSION is the file containing the PSBLAS version code # FIXME -psblas_cv_version="3.7.0" +psblas_cv_version="3.8.1" # A sample source file AC_CONFIG_SRCDIR([base/modules/psb_base_mod.f90]) @@ -56,7 +56,8 @@ AC_MSG_NOTICE([ documentation, you can make your own by hand for your needs. Be sure to specify the library paths of your interest. Examples: - ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + ./configure --with-libs=-L/some/directory/LIB <- will append to LIBS + [ --with-spgpu=/path/to/spgpu] FC=mpif90 CC=mpicc ./configure <- will force FC,CC See ./configure --help=short fore more info. @@ -790,6 +791,50 @@ fi +PAC_CHECK_CUDA() + +if test "x$pac_cv_have_cuda" == "xyes"; then + +PAC_CHECK_CUDA_VERSION() +CUDA_VERSION="$pac_cv_cuda_version"; +CUDA_SHORT_VERSION=$(expr $pac_cv_cuda_version / 1000); +PAC_CHECK_SPGPU() +if test "x$pac_cv_have_spgpu" == "xyes" ; then + GPUD=gpud; + GPULD=gpuld; + EXTRALDLIBS="-lstdc++"; +fi +AC_MSG_NOTICE([At this point GPUTARGET is $GPUD $GPULD]) + +PAC_ARG_WITH_CUDACC() +if test "x$pac_cv_cudacc" == "x"; then + pac_cv_cudacc="30,35,37,50,60"; +fi +CUDEFINES=""; +for cc in `echo $pac_cv_cudacc|sed 's/,/ /gi'` +do + CUDEFINES="$CUDEFINES -gencode arch=compute_$cc,code=sm_$cc"; +done +if test "x$pac_cv_cuda_version" != "xunknown"; then + CUDEFINES="$CUDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" + FDEFINES="$FDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" + CDEFINES="$CDEFINES -DCUDA_SHORT_VERSION=${CUDA_SHORT_VERSION} -DCUDA_VERSION=${CUDA_VERSION}" +fi + +fi + +if test "x$pac_cv_ipk_size" != "x4"; then + AC_MSG_NOTICE([For CUDA I need psb_ipk_ to be 4 bytes but it is $pac_cv_ipk_size, disabling CUDA/SPGPU]) + GPUD=""; + GPULD=""; + CUDEFINES=""; + CUDA_INCLUDES=""; + CUDA_LIBS=""; +fi + + + + ############################################################################### # Library target directory and archive files. ############################################################################### @@ -871,7 +916,23 @@ AC_SUBST(PRECLIBNAME) AC_SUBST(METHDLIBNAME) AC_SUBST(UTILLIBNAME) AC_SUBST(METISINCFILE) - +AC_SUBST(SPGPU_FLAGS) +AC_SUBST(SPGPU_LIBS) +AC_SUBST(SPGPU_DIR) +AC_SUBST(SPGPU_DEFINES) +AC_SUBST(SPGPU_INCLUDES) +AC_SUBST(SPGPU_INCDIR) +AC_SUBST(EXTRALDLIBS) +AC_SUBST(CUDA_DIR) +AC_SUBST(CUDA_DEFINES) +AC_SUBST(CUDA_INCLUDES) +AC_SUBST(CUDA_LIBS) +AC_SUBST(CUDA_VERSION) +AC_SUBST(CUDA_SHORT_VERSION) +AC_SUBST(CUDA_NVCC) +AC_SUBST(CUDEFINES) +AC_SUBST(GPUD) +AC_SUBST(GPULD) ############################################################################### # the following files will be created by Automake diff --git a/gpu/CUDA/Makefile b/gpu/CUDA/Makefile new file mode 100644 index 000000000..a1f9d48b2 --- /dev/null +++ b/gpu/CUDA/Makefile @@ -0,0 +1,38 @@ +TOPDIR=../.. +include $(TOPDIR)/Make.inc +# +# Libraries used +# +PSBLIBDIR=$(PSBLASDIR)/lib/ +PSBINCDIR=$(PSBLASDIR)/include +LIBDIR=$(TOPDIR)/lib +INCDIR=$(TOPDIR)/include +PSBLAS_LIB= -L$(PSBLIBDIR) -lpsb_util -lpsb_base +#-lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base +LDLIBS=$(PSBLDLIBS) +# +# Compilers and such +# +#CCOPT= -g +FINCLUDES=$(FMFLAG). $(FMFLAG)$(INCDIR) $(FMFLAG)$(PSBINCDIR) $(FIFLAG). +CINCLUDES=$(SPGPU_INCLUDES) $(CUDA_INCLUDES) -I.. +LIBNAME=libpsb_gpu.a + + + +CUDAOBJS=psi_cuda_c_CopyCooToElg.o psi_cuda_c_CopyCooToHlg.o \ +psi_cuda_d_CopyCooToElg.o psi_cuda_d_CopyCooToHlg.o \ +psi_cuda_s_CopyCooToElg.o psi_cuda_s_CopyCooToHlg.o \ +psi_cuda_z_CopyCooToElg.o psi_cuda_z_CopyCooToHlg.o + + + +objs: $(CUDAOBJS) + +lib: objs + ar cur ../$(LIBNAME) $(CUDAOBJS) + +$(CUDAOBJS): psi_cuda_common.cuh psi_cuda_CopyCooToElg.cuh psi_cuda_CopyCooToHlg.cuh + +clean: + /bin/rm -f $(CUDAOBJS) diff --git a/gpu/CUDA/psi_cuda_CopyCooToElg.cuh b/gpu/CUDA/psi_cuda_CopyCooToElg.cuh new file mode 100644 index 000000000..10a81a367 --- /dev/null +++ b/gpu/CUDA/psi_cuda_CopyCooToElg.cuh @@ -0,0 +1,104 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" +#include "psi_cuda_common.cuh" + + +#undef GEN_PSI_FUNC_NAME +#define GEN_PSI_FUNC_NAME(x) CONCAT(CONCAT(psi_cuda_,x),_CopyCooToElg) + +#define THREAD_BLOCK 256 + +#ifdef __cplusplus +extern "C" { +#endif + + + void GEN_PSI_FUNC_NAME(TYPE_SYMBOL)(spgpuHandle_t handle, int nr, int nc, int nza, + int baseIdx, int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM); + + +#ifdef __cplusplus +} +#endif + + + + + +__global__ void CONCAT(GEN_PSI_FUNC_NAME(TYPE_SYMBOL),_krn)(int ii, int nrws, int nr, int nza, + int baseIdx, int hacksz, int ldv, int nzm, + int *rS, int *devIdisp, int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM) +{ + int ir, k, ipnt, rsz,jc; + int ki = threadIdx.x + blockIdx.x * (THREAD_BLOCK); + int i=ii+ki; + int idval=0; + + if (ki >= nrws) return; + if (i >= nr) return; + + ipnt=devIdisp[i]; + rsz=rS[i]; + ir = i; + for (k=0; kcurrentStream >>>(i,nrws, nr, nza, baseIdx, hacksz, ldv, nzm, + rS,devIdisp,devJa,devVal,idiag, rP,cM); + +} + + + + +void +GEN_PSI_FUNC_NAME(TYPE_SYMBOL) + (spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM) +{ int i,j,k, nrws; + //int maxNForACall = THREAD_BLOCK*handle->maxGridSizeX; + int maxNForACall = max(handle->maxGridSizeX, THREAD_BLOCK*handle->maxGridSizeX); + + + //fprintf(stderr,"Loop on j: %d\n",j); + for (i=0; i +#include + +#include "cintrf.h" +#include "vectordev.h" +#include "psi_cuda_common.cuh" + + +#undef GEN_PSI_FUNC_NAME +#define GEN_PSI_FUNC_NAME(x) CONCAT(CONCAT(psi_cuda_,x),_CopyCooToHlg) + +#define THREAD_BLOCK 256 + +#ifdef __cplusplus +extern "C" { +#endif + +void GEN_PSI_FUNC_NAME(TYPE_SYMBOL)(spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, int hacksz, + int noffs, int isz, int *rS, int *hackOffs, int *devIdisp, + int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM); + + + +#ifdef __cplusplus +} +#endif + + +__global__ void CONCAT(GEN_PSI_FUNC_NAME(TYPE_SYMBOL),_krn)(int ii, int nrws, int nr, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *rS, int *hackOffs, int *devIdisp, + int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM) +{ + int ir, k, ipnt, rsz,jc; + int ki = threadIdx.x + blockIdx.x * (THREAD_BLOCK); + int i=ii+ki; + + if (ki >= nrws) return; + + + if (icurrentStream >>>(i,nrws,nr, nza, baseIdx, hacksz, noffs, isz, + rS,hackOffs,devIdisp,devJa,devVal,idiag,rP,cM); + +} + + +void GEN_PSI_FUNC_NAME(TYPE_SYMBOL)(spgpuHandle_t handle, int nr, int nc, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *rS, int *hackOffs, int *devIdisp, + int *devJa, VALUE_TYPE *devVal, + int *idiag, int *rP, VALUE_TYPE *cM) +{ int i, nrws; + //int maxNForACall = THREAD_BLOCK*handle->maxGridSizeX; + int maxNForACall = max(handle->maxGridSizeX, THREAD_BLOCK*handle->maxGridSizeX); + + //fprintf(stderr,"Loop on j: %d\n",j); + for (i=0; i +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE cuFloatComplex +#define TYPE_SYMBOL c +#include "psi_cuda_CopyCooToElg.cuh" diff --git a/gpu/CUDA/psi_cuda_c_CopyCooToHlg.cu b/gpu/CUDA/psi_cuda_c_CopyCooToHlg.cu new file mode 100644 index 000000000..f2b5c86d1 --- /dev/null +++ b/gpu/CUDA/psi_cuda_c_CopyCooToHlg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE cuFloatComplex +#define TYPE_SYMBOL c +#include "psi_cuda_CopyCooToHlg.cuh" diff --git a/gpu/CUDA/psi_cuda_common.cuh b/gpu/CUDA/psi_cuda_common.cuh new file mode 100644 index 000000000..12d81f030 --- /dev/null +++ b/gpu/CUDA/psi_cuda_common.cuh @@ -0,0 +1,16 @@ +#pragma once + +#define PRE_CONCAT(A, B) A ## B +#define CONCAT(A, B) PRE_CONCAT(A, B) +#define MIN(A,B) ( (A)<(B) ? (A) : (B) ) +#define SQUARE(x) ((x)*(x)) +#define GET_ADDR(a,ix,iy,nc) a[(nc)*(ix)+(iy)] +#define GET_VAL(a,ix,iy,nc) (GET_ADDR(a,ix,iy,nc)) + +__device__ __host__ static float zero_float() { return 0.0f; } +__device__ __host__ static cuFloatComplex zero_cuFloatComplex() { return make_cuFloatComplex(0.0, 0.0); } + +#if (__CUDA_ARCH__ >= 130) || (!__CUDA_ARCH__) +__device__ __host__ static double zero_double() { return 0.0; } +__device__ __host__ static cuDoubleComplex zero_cuDoubleComplex() { return make_cuDoubleComplex(0.0, 0.0); } +#endif diff --git a/gpu/CUDA/psi_cuda_d_CopyCooToElg.cu b/gpu/CUDA/psi_cuda_d_CopyCooToElg.cu new file mode 100644 index 000000000..f306ffe19 --- /dev/null +++ b/gpu/CUDA/psi_cuda_d_CopyCooToElg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE double +#define TYPE_SYMBOL d +#include "psi_cuda_CopyCooToElg.cuh" diff --git a/gpu/CUDA/psi_cuda_d_CopyCooToHlg.cu b/gpu/CUDA/psi_cuda_d_CopyCooToHlg.cu new file mode 100644 index 000000000..9c0e371ed --- /dev/null +++ b/gpu/CUDA/psi_cuda_d_CopyCooToHlg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE double +#define TYPE_SYMBOL d +#include "psi_cuda_CopyCooToHlg.cuh" diff --git a/gpu/CUDA/psi_cuda_s_CopyCooToElg.cu b/gpu/CUDA/psi_cuda_s_CopyCooToElg.cu new file mode 100644 index 000000000..76e10de1b --- /dev/null +++ b/gpu/CUDA/psi_cuda_s_CopyCooToElg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE float +#define TYPE_SYMBOL s +#include "psi_cuda_CopyCooToElg.cuh" diff --git a/gpu/CUDA/psi_cuda_s_CopyCooToHlg.cu b/gpu/CUDA/psi_cuda_s_CopyCooToHlg.cu new file mode 100644 index 000000000..c2d76c0a3 --- /dev/null +++ b/gpu/CUDA/psi_cuda_s_CopyCooToHlg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE float +#define TYPE_SYMBOL s +#include "psi_cuda_CopyCooToHlg.cuh" diff --git a/gpu/CUDA/psi_cuda_z_CopyCooToElg.cu b/gpu/CUDA/psi_cuda_z_CopyCooToElg.cu new file mode 100644 index 000000000..a57ad6370 --- /dev/null +++ b/gpu/CUDA/psi_cuda_z_CopyCooToElg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE cuDoubleComplex +#define TYPE_SYMBOL z +#include "psi_cuda_CopyCooToElg.cuh" diff --git a/gpu/CUDA/psi_cuda_z_CopyCooToHlg.cu b/gpu/CUDA/psi_cuda_z_CopyCooToHlg.cu new file mode 100644 index 000000000..2ff9b8696 --- /dev/null +++ b/gpu/CUDA/psi_cuda_z_CopyCooToHlg.cu @@ -0,0 +1,10 @@ +#include +#include + +#include "cintrf.h" +#include "vectordev.h" + + +#define VALUE_TYPE cuDoubleComplex +#define TYPE_SYMBOL z +#include "psi_cuda_CopyCooToHlg.cuh" diff --git a/gpu/Makefile b/gpu/Makefile new file mode 100755 index 000000000..16e9c0840 --- /dev/null +++ b/gpu/Makefile @@ -0,0 +1,134 @@ +include ../Make.inc +# +# Libraries used +# +LIBDIR=../lib +INCDIR=../include +MODDIR=../modules +PSBLAS_LIB= -lpsb_util -lpsb_base +#-lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base +LDLIBS=$(PSBLDLIBS) +# +# Compilers and such +# +#CCOPT= -g +FINCLUDES=$(FMFLAG). $(FMFLAG)$(INCDIR) $(FMFLAG)$(MODDIR) $(FIFLAG). +CINCLUDES=$(SPGPU_INCLUDES) $(CUDA_INCLUDES) +LIBNAME=libpsb_gpu.a + + +FOBJS=cusparse_mod.o base_cusparse_mod.o \ + s_cusparse_mod.o d_cusparse_mod.o c_cusparse_mod.o z_cusparse_mod.o \ + psb_vectordev_mod.o core_mod.o \ + psb_s_vectordev_mod.o psb_d_vectordev_mod.o psb_i_vectordev_mod.o\ + psb_c_vectordev_mod.o psb_z_vectordev_mod.o psb_base_vectordev_mod.o \ + elldev_mod.o hlldev_mod.o diagdev_mod.o hdiagdev_mod.o \ + psb_i_gpu_vect_mod.o \ + psb_d_gpu_vect_mod.o psb_s_gpu_vect_mod.o\ + psb_z_gpu_vect_mod.o psb_c_gpu_vect_mod.o\ + psb_d_elg_mat_mod.o psb_d_hlg_mat_mod.o \ + psb_d_hybg_mat_mod.o psb_d_csrg_mat_mod.o\ + psb_s_elg_mat_mod.o psb_s_hlg_mat_mod.o \ + psb_s_hybg_mat_mod.o psb_s_csrg_mat_mod.o\ + psb_c_elg_mat_mod.o psb_c_hlg_mat_mod.o \ + psb_c_hybg_mat_mod.o psb_c_csrg_mat_mod.o\ + psb_z_elg_mat_mod.o psb_z_hlg_mat_mod.o \ + psb_z_hybg_mat_mod.o psb_z_csrg_mat_mod.o\ + psb_gpu_env_mod.o psb_gpu_mod.o \ + psb_d_diag_mat_mod.o\ + psb_d_hdiag_mat_mod.o psb_s_hdiag_mat_mod.o\ + psb_s_dnsg_mat_mod.o psb_d_dnsg_mat_mod.o \ + psb_c_dnsg_mat_mod.o psb_z_dnsg_mat_mod.o \ + dnsdev_mod.o + +COBJS= elldev.o hlldev.o diagdev.o hdiagdev.o vectordev.o ivectordev.o dnsdev.o\ + svectordev.o dvectordev.o cvectordev.o zvectordev.o cuda_util.o \ + fcusparse.o scusparse.o dcusparse.o ccusparse.o zcusparse.o + +OBJS=$(COBJS) $(FOBJS) + +lib: objs + +objs: $(OBJS) iobjs cudaobjs + /bin/cp -p *$(.mod) $(MODDIR) + /bin/cp -p *.h $(INCDIR) + +lib: ilib cudalib + ar cur $(LIBNAME) $(OBJS) + /bin/cp -p $(LIBNAME) $(LIBDIR) + +dnsdev_mod.o hlldev_mod.o elldev_mod.o psb_base_vectordev_mod.o: core_mod.o +psb_d_gpu_vect_mod.o psb_s_gpu_vect_mod.o psb_z_gpu_vect_mod.o psb_c_gpu_vect_mod.o: psb_i_gpu_vect_mod.o +psb_i_gpu_vect_mod.o : psb_vectordev_mod.o psb_gpu_env_mod.o +cusparse_mod.o: s_cusparse_mod.o d_cusparse_mod.o c_cusparse_mod.o z_cusparse_mod.o +s_cusparse_mod.o d_cusparse_mod.o c_cusparse_mod.o z_cusparse_mod.o : base_cusparse_mod.o +psb_d_hlg_mat_mod.o: hlldev_mod.o psb_d_gpu_vect_mod.o psb_gpu_env_mod.o +psb_d_elg_mat_mod.o: elldev_mod.o psb_d_gpu_vect_mod.o +psb_d_diag_mat_mod.o: diagdev_mod.o psb_d_gpu_vect_mod.o +psb_d_hdiag_mat_mod.o: hdiagdev_mod.o psb_d_gpu_vect_mod.o +psb_s_dnsg_mat_mod.o: dnsdev_mod.o psb_s_gpu_vect_mod.o +psb_d_dnsg_mat_mod.o: dnsdev_mod.o psb_d_gpu_vect_mod.o +psb_c_dnsg_mat_mod.o: dnsdev_mod.o psb_c_gpu_vect_mod.o +psb_z_dnsg_mat_mod.o: dnsdev_mod.o psb_z_gpu_vect_mod.o +psb_s_hlg_mat_mod.o: hlldev_mod.o psb_s_gpu_vect_mod.o psb_gpu_env_mod.o +psb_s_elg_mat_mod.o: elldev_mod.o psb_s_gpu_vect_mod.o +psb_s_diag_mat_mod.o: diagdev_mod.o psb_s_gpu_vect_mod.o +psb_s_hdiag_mat_mod.o: hdiagdev_mod.o psb_s_gpu_vect_mod.o +psb_s_csrg_mat_mod.o psb_s_hybg_mat_mod.o: cusparse_mod.o psb_vectordev_mod.o +psb_d_csrg_mat_mod.o psb_d_hybg_mat_mod.o: cusparse_mod.o psb_vectordev_mod.o +psb_z_hlg_mat_mod.o: hlldev_mod.o psb_z_gpu_vect_mod.o psb_gpu_env_mod.o +psb_z_elg_mat_mod.o: elldev_mod.o psb_z_gpu_vect_mod.o +psb_c_hlg_mat_mod.o: hlldev_mod.o psb_c_gpu_vect_mod.o psb_gpu_env_mod.o +psb_c_elg_mat_mod.o: elldev_mod.o psb_c_gpu_vect_mod.o +psb_c_csrg_mat_mod.o psb_c_hybg_mat_mod.o: cusparse_mod.o psb_vectordev_mod.o +psb_z_csrg_mat_mod.o psb_z_hybg_mat_mod.o: cusparse_mod.o psb_vectordev_mod.o +psb_vectordev_mod.o: psb_s_vectordev_mod.o psb_d_vectordev_mod.o psb_c_vectordev_mod.o psb_z_vectordev_mod.o psb_i_vectordev_mod.o +psb_i_vectordev_mod.o psb_s_vectordev_mod.o psb_d_vectordev_mod.o psb_c_vectordev_mod.o psb_z_vectordev_mod.o: psb_base_vectordev_mod.o +vectordev.o: cuda_util.o vectordev.h +elldev.o: elldev.c +dnsdev.o: dnsdev.c +fcusparse.h elldev.c: elldev.h vectordev.h +fcusparse.o scusparse.o dcusparse.o ccusparse.o zcusparse.o : fcusparse.h +fcusparse.o scusparse.o dcusparse.o ccusparse.o zcusparse.o : fcusparse_fct.h +svectordev.o: svectordev.h vectordev.h +dvectordev.o: dvectordev.h vectordev.h +cvectordev.o: cvectordev.h vectordev.h +zvectordev.o: zvectordev.h vectordev.h +psb_gpu_env_mod.o: base_cusparse_mod.o +psb_gpu_mod.o: psb_gpu_env_mod.o psb_i_gpu_vect_mod.o\ + psb_d_gpu_vect_mod.o psb_s_gpu_vect_mod.o\ + psb_z_gpu_vect_mod.o psb_c_gpu_vect_mod.o\ + psb_d_elg_mat_mod.o psb_d_hlg_mat_mod.o \ + psb_d_hybg_mat_mod.o psb_d_csrg_mat_mod.o\ + psb_s_elg_mat_mod.o psb_s_hlg_mat_mod.o \ + psb_s_hybg_mat_mod.o psb_s_csrg_mat_mod.o\ + psb_c_elg_mat_mod.o psb_c_hlg_mat_mod.o \ + psb_c_hybg_mat_mod.o psb_c_csrg_mat_mod.o\ + psb_z_elg_mat_mod.o psb_z_hlg_mat_mod.o \ + psb_z_hybg_mat_mod.o psb_z_csrg_mat_mod.o\ + psb_d_diag_mat_mod.o \ + psb_d_hdiag_mat_mod.o psb_s_hdiag_mat_mod.o\ + psb_s_dnsg_mat_mod.o psb_d_dnsg_mat_mod.o \ + psb_c_dnsg_mat_mod.o psb_z_dnsg_mat_mod.o + +iobjs: $(FOBJS) + $(MAKE) -C impl objs +cudaobjs: $(FOBJS) + $(MAKE) -C CUDA objs + +ilib: objs + $(MAKE) -C impl lib LIBNAME=$(LIBNAME) +cudalib: objs + $(MAKE) -C CUDA lib LIBNAME=$(LIBNAME) + +clean: cclean iclean cudaclean + /bin/rm -f $(FOBJS) *$(.mod) *.a + +cclean: + /bin/rm -f $(COBJS) +iclean: + $(MAKE) -C impl clean +cudaclean: + $(MAKE) -C CUDA clean + +veryclean: clean diff --git a/gpu/base_cusparse_mod.F90 b/gpu/base_cusparse_mod.F90 new file mode 100644 index 000000000..9f5628be8 --- /dev/null +++ b/gpu/base_cusparse_mod.F90 @@ -0,0 +1,117 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 base_cusparse_mod + use iso_c_binding + ! Interface to CUSPARSE. + + enum, bind(c) + enumerator cusparse_status_success + enumerator cusparse_status_not_initialized + enumerator cusparse_status_alloc_failed + enumerator cusparse_status_invalid_value + enumerator cusparse_status_arch_mismatch + enumerator cusparse_status_mapping_error + enumerator cusparse_status_execution_failed + enumerator cusparse_status_internal_error + enumerator cusparse_status_matrix_type_not_supported + end enum + + enum, bind(c) + enumerator cusparse_matrix_type_general + enumerator cusparse_matrix_type_symmetric + enumerator cusparse_matrix_type_hermitian + enumerator cusparse_matrix_type_triangular + end enum + + enum, bind(c) + enumerator cusparse_fill_mode_lower + enumerator cusparse_fill_mode_upper + end enum + + enum, bind(c) + enumerator cusparse_diag_type_non_unit + enumerator cusparse_diag_type_unit + end enum + + enum, bind(c) + enumerator cusparse_index_base_zero + enumerator cusparse_index_base_one + end enum + + enum, bind(c) + enumerator cusparse_operation_non_transpose + enumerator cusparse_operation_transpose + enumerator cusparse_operation_conjugate_transpose + end enum + + enum, bind(c) + enumerator cusparse_direction_row + enumerator cusparse_direction_column + end enum + + +#if defined(HAVE_CUDA) && defined(HAVE_SPGPU) + + interface + function FcusparseCreate() & + & bind(c,name="FcusparseCreate") result(res) + use iso_c_binding + integer(c_int) :: res + end function FcusparseCreate + end interface + + interface + function FcusparseDestroy() & + & bind(c,name="FcusparseDestroy") result(res) + use iso_c_binding + integer(c_int) :: res + end function FcusparseDestroy + end interface + +contains + + function initFcusparse() result(res) + implicit none + integer(c_int) :: res + + res = FcusparseCreate() + end function initFcusparse + + function closeFcusparse() result(res) + implicit none + integer(c_int) :: res + res = FcusparseDestroy() + end function closeFcusparse + +#endif +end module base_cusparse_mod diff --git a/gpu/c_cusparse_mod.F90 b/gpu/c_cusparse_mod.F90 new file mode 100644 index 000000000..e7d37173b --- /dev/null +++ b/gpu/c_cusparse_mod.F90 @@ -0,0 +1,305 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 c_cusparse_mod + use base_cusparse_mod + + type, bind(c) :: c_Cmat + type(c_ptr) :: Mat = c_null_ptr + end type c_Cmat + +#if CUDA_SHORT_VERSION <= 10 + type, bind(c) :: c_Hmat + type(c_ptr) :: Mat = c_null_ptr + end type c_Hmat +#endif + + +#if defined(HAVE_CUDA) && defined(HAVE_SPGPU) + + interface CSRGDeviceFree + function c_CSRGDeviceFree(Mat) & + & bind(c,name="c_CSRGDeviceFree") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int) :: res + end function c_CSRGDeviceFree + end interface + + interface CSRGDeviceSetMatType + function c_CSRGDeviceSetMatType(Mat,type) & + & bind(c,name="c_CSRGDeviceSetMatType") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_CSRGDeviceSetMatType + end interface + + interface CSRGDeviceSetMatFillMode + function c_CSRGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="c_CSRGDeviceSetMatFillMode") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_CSRGDeviceSetMatFillMode + end interface + + interface CSRGDeviceSetMatDiagType + function c_CSRGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="c_CSRGDeviceSetMatDiagType") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_CSRGDeviceSetMatDiagType + end interface + + interface CSRGDeviceSetMatIndexBase + function c_CSRGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="c_CSRGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_CSRGDeviceSetMatIndexBase + end interface + + interface CSRGDeviceCsrsmAnalysis + function c_CSRGDeviceCsrsmAnalysis(Mat) & + & bind(c,name="c_CSRGDeviceCsrsmAnalysis") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int) :: res + end function c_CSRGDeviceCsrsmAnalysis + end interface + + interface CSRGDeviceAlloc + function c_CSRGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="c_CSRGDeviceAlloc") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function c_CSRGDeviceAlloc + end interface + + interface CSRGDeviceGetParms + function c_CSRGDeviceGetParms(Mat,nr,nc,nz) & + & bind(c,name="c_CSRGDeviceGetParms") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int) :: nr, nc, nz + integer(c_int) :: res + end function c_CSRGDeviceGetParms + end interface + + interface spsvCSRGDevice + function c_spsvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="c_spsvCSRGDevice") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_float_complex), value :: alpha,beta + integer(c_int) :: res + end function c_spsvCSRGDevice + end interface + + interface spmvCSRGDevice + function c_spmvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="c_spmvCSRGDevice") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_float_complex), value :: alpha,beta + integer(c_int) :: res + end function c_spmvCSRGDevice + end interface + + interface CSRGHost2Device + function c_CSRGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="c_CSRGHost2Device") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_float_complex) :: val(*) + integer(c_int) :: res + end function c_CSRGHost2Device + end interface + + interface CSRGDevice2Host + function c_CSRGDevice2Host(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="c_CSRGDevice2Host") result(res) + use iso_c_binding + import c_Cmat + type(c_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_float_complex) :: val(*) + integer(c_int) :: res + end function c_CSRGDevice2Host + end interface + +#if CUDA_SHORT_VERSION <=10 + interface HYBGDeviceAlloc + function c_HYBGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="c_HYBGDeviceAlloc") result(res) + use iso_c_binding + import c_hmat + type(c_Hmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function c_HYBGDeviceAlloc + end interface + + interface HYBGDeviceFree + function c_HYBGDeviceFree(Mat) & + & bind(c,name="c_HYBGDeviceFree") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int) :: res + end function c_HYBGDeviceFree + end interface + + interface HYBGDeviceSetMatType + function c_HYBGDeviceSetMatType(Mat,type) & + & bind(c,name="c_HYBGDeviceSetMatType") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_HYBGDeviceSetMatType + end interface + + interface HYBGDeviceSetMatFillMode + function c_HYBGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="c_HYBGDeviceSetMatFillMode") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_HYBGDeviceSetMatFillMode + end interface + + interface HYBGDeviceSetMatDiagType + function c_HYBGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="c_HYBGDeviceSetMatDiagType") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_HYBGDeviceSetMatDiagType + end interface + + interface HYBGDeviceSetMatIndexBase + function c_HYBGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="c_HYBGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function c_HYBGDeviceSetMatIndexBase + end interface + + interface HYBGDeviceHybsmAnalysis + function c_HYBGDeviceHybsmAnalysis(Mat) & + & bind(c,name="c_HYBGDeviceHybsmAnalysis") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int) :: res + end function c_HYBGDeviceHybsmAnalysis + end interface + + interface spsvHYBGDevice + function c_spsvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="c_spsvHYBGDevice") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_float_complex), value :: alpha,beta + integer(c_int) :: res + end function c_spsvHYBGDevice + end interface + + interface spmvHYBGDevice + function c_spmvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="c_spmvHYBGDevice") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_float_complex), value :: alpha,beta + integer(c_int) :: res + end function c_spmvHYBGDevice + end interface + + interface HYBGHost2Device + function c_HYBGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="c_HYBGHost2Device") result(res) + use iso_c_binding + import c_Hmat + type(c_Hmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_float_complex) :: val(*) + integer(c_int) :: res + end function c_HYBGHost2Device + end interface +#endif + +#endif + +end module c_cusparse_mod diff --git a/gpu/ccusparse.c b/gpu/ccusparse.c new file mode 100644 index 000000000..6f1cfdb3f --- /dev/null +++ b/gpu/ccusparse.c @@ -0,0 +1,97 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 + +#ifdef HAVE_SPGPU +#include +#include +#include "cintrf.h" +#include "fcusparse.h" + +/* Single precision complex */ +#define TYPE float complex +#define CUSPARSE_BASE_TYPE CUDA_C_32F +#define T_CSRGDeviceMat c_CSRGDeviceMat +#define T_Cmat c_Cmat +#define T_spmvCSRGDevice c_spmvCSRGDevice +#define T_spsvCSRGDevice c_spsvCSRGDevice +#define T_CSRGDeviceAlloc c_CSRGDeviceAlloc +#define T_CSRGDeviceFree c_CSRGDeviceFree +#define T_CSRGHost2Device c_CSRGHost2Device +#define T_CSRGDevice2Host c_CSRGDevice2Host +#define T_CSRGDeviceSetMatFillMode c_CSRGDeviceSetMatFillMode +#define T_CSRGDeviceSetMatDiagType c_CSRGDeviceSetMatDiagType +#define T_CSRGDeviceGetParms c_CSRGDeviceGetParms + +#if CUDA_SHORT_VERSION <= 10 + +#define T_CSRGDeviceSetMatType c_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase c_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsmAnalysis c_CSRGDeviceCsrsmAnalysis +#define cusparseTcsrmv cusparseCcsrmv +#define cusparseTcsrsv_solve cusparseCcsrsv_solve +#define cusparseTcsrsv_analysis cusparseCcsrsv_analysis + +#elif CUDA_VERSION < 11030 + +#define T_CSRGDeviceSetMatType c_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase c_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsv2Analysis c_CSRGDeviceCsrsv2Analysis +#define cusparseTcsrsv2_bufferSize cusparseCcsrsv2_bufferSize +#define cusparseTcsrsv2_analysis cusparseCcsrsv2_analysis +#define cusparseTcsrsv2_solve cusparseCcsrsv2_solve + +#else + +#define T_HYBGDeviceMat c_HYBGDeviceMat +#define T_Hmat c_Hmat +#define T_HYBGDeviceFree c_HYBGDeviceFree +#define T_spmvHYBGDevice c_spmvHYBGDevice +#define T_HYBGDeviceAlloc c_HYBGDeviceAlloc +#define T_HYBGDeviceSetMatDiagType c_HYBGDeviceSetMatDiagType +#define T_HYBGDeviceSetMatIndexBase c_HYBGDeviceSetMatIndexBase +#define T_HYBGDeviceSetMatType c_HYBGDeviceSetMatType +#define T_HYBGDeviceSetMatFillMode c_HYBGDeviceSetMatFillMode +#define T_HYBGDeviceHybsmAnalysis c_HYBGDeviceHybsmAnalysis +#define T_spsvHYBGDevice c_spsvHYBGDevice +#define T_HYBGHost2Device c_HYBGHost2Device +#define cusparseThybmv cusparseChybmv +#define cusparseThybsv_solve cusparseChybsv_solve +#define cusparseThybsv_analysis cusparseChybsv_analysis +#define cusparseTcsr2hyb cusparseCcsr2hyb +#endif + +#include "fcusparse_fct.h" + +#endif diff --git a/gpu/cintrf.h b/gpu/cintrf.h new file mode 100644 index 000000000..1a3528aae --- /dev/null +++ b/gpu/cintrf.h @@ -0,0 +1,51 @@ + /* Parallel Sparse BLAS SPGPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _CINTRF_H_ +#define _CINTRF_H_ + +#include +#include + +#if defined(HAVE_SPGPU) && defined(HAVE_CUDA) +#include "core.h" +#include "cuda_util.h" +#include "vector.h" +#include "vectordev.h" + +#define ELL_PITCH_ALIGN_S 32 +#define ELL_PITCH_ALIGN_D 16 + + +#endif + +#endif diff --git a/gpu/core_mod.f90 b/gpu/core_mod.f90 new file mode 100644 index 000000000..d30f8a996 --- /dev/null +++ b/gpu/core_mod.f90 @@ -0,0 +1,53 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 core_mod + use iso_c_binding + + integer(c_int), parameter :: spgpu_type_int = 0 + integer(c_int), parameter :: spgpu_type_float = 1 + integer(c_int), parameter :: spgpu_type_double = 2 + integer(c_int), parameter :: spgpu_type_complex_float = 3 + integer(c_int), parameter :: spgpu_type_complex_double = 4 + integer(c_int), parameter :: spgpu_success = 0 + integer(c_int), parameter :: spgpu_unsupported = 1 + integer(c_int), parameter :: spgpu_unspecified = 2 + integer(c_int), parameter :: spgpu_outofmem = 3 + + interface + subroutine psb_cudaSync() & + & bind(c,name='cudaSync') + use iso_c_binding + end subroutine psb_cudaSync + end interface + +end module core_mod diff --git a/gpu/cuda_util.c b/gpu/cuda_util.c new file mode 100644 index 000000000..63c38b533 --- /dev/null +++ b/gpu/cuda_util.c @@ -0,0 +1,808 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "cuda_util.h" + +#if defined(HAVE_CUDA) + + +static int hasUVA=-1; +static struct cudaDeviceProp *prop=NULL; +static spgpuHandle_t psb_gpu_handle = NULL; +static cublasHandle_t psb_cublas_handle = NULL; + + +int allocRemoteBuffer(void** buffer, int count) +{ + cudaError_t err = cudaMalloc(buffer, count); + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA allocRemoteBuffer for %d bytes Error: %s \n", + count, cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int hostRegisterMapped(void *pointer, long size) +{ + cudaError_t err = cudaHostRegister(pointer, size, cudaHostRegisterMapped); + + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA hostRegisterMapped Error: %s\n", cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int getDevicePointer(void **d_p, void * h_p) +{ + cudaError_t err = cudaHostGetDevicePointer(d_p,h_p,0); + + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA getDevicePointer Error: %s\n", cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int registerMappedMemory(void *buffer, void **dp, int size) +{ + //cudaError_t err = cudaHostAlloc(buffer,size,cudaHostAllocMapped); + cudaError_t err = cudaHostRegister(buffer, size, cudaHostRegisterMapped); + if (err == cudaSuccess) err = cudaHostGetDevicePointer(dp,buffer,0); + + if (err == cudaSuccess) + { + err = cudaHostGetDevicePointer(dp,buffer,0); + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA registerMappedMemory Error: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } + } + else + { + fprintf(stderr,"CUDA registerMappedMemory Error: %s\n", cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int allocMappedMemory(void **buffer, void **dp, int size) +{ + cudaError_t err = cudaHostAlloc(buffer,size,cudaHostAllocMapped); + if (err == 0) err = cudaHostGetDevicePointer(dp,*buffer,0); + + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA allocMappedMemory Error: %s\n", cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int unregisterMappedMemory(void *buffer) +{ + //cudaError_t err = cudaHostAlloc(buffer,size,cudaHostAllocMapped); + cudaError_t err = cudaHostUnregister(buffer); + + if (err == cudaSuccess) + { + return SPGPU_SUCCESS; + } + else + { + fprintf(stderr,"CUDA unregisterMappedMemory Error: %s\n", cudaGetErrorString(err)); + if(err == cudaErrorMemoryAllocation) + return SPGPU_OUTOFMEMORY; + else + return SPGPU_UNSPECIFIED; + } +} + +int writeRemoteBuffer(void* hostSrc, void* buffer, int count) +{ + cudaError_t err = cudaMemcpy(buffer, hostSrc, count, cudaMemcpyHostToDevice); + + if (err == cudaSuccess) + return SPGPU_SUCCESS; + else { + fprintf(stderr,"CUDA Error writeRemoteBuffer: %s %p %p %d\n", + cudaGetErrorString(err),buffer, hostSrc, count); + return SPGPU_UNSPECIFIED; + } +} + +int readRemoteBuffer(void* hostDest, void* buffer, int count) +{ + + + cudaError_t err1; + cudaError_t err; +#if 0 + { + err1 =cudaGetLastError(); + fprintf(stderr,"CUDA Error prior to readRemoteBuffer: %s %d\n", + cudaGetErrorString(err1),err1); + } + +#endif + err = cudaMemcpy(hostDest, buffer, count, cudaMemcpyDeviceToHost); + + if (err == cudaSuccess) + return SPGPU_SUCCESS; + else { + fprintf(stderr,"CUDA Error readRemoteBuffer: %s %p %p %d %d\n", + cudaGetErrorString(err),hostDest,buffer,count,err); + return SPGPU_UNSPECIFIED; + } +} + +int freeRemoteBuffer(void* buffer) +{ + cudaError_t err = cudaFree(buffer); + if (err == cudaSuccess) + return SPGPU_SUCCESS; + else { + fprintf(stderr,"CUDA Error freeRemoteBuffer: %s %p\n", cudaGetErrorString(err),buffer); + return SPGPU_UNSPECIFIED; + } +} + +int gpuInit(int dev) +{ + + int count,err; + + if ((err=cudaSetDeviceFlags(cudaDeviceMapHost))!=cudaSuccess) + fprintf(stderr,"Error On SetDeviceFlags: %d '%s'\n",err,cudaGetErrorString(err)); + if ((prop=(struct cudaDeviceProp *) malloc(sizeof(struct cudaDeviceProp)))==NULL) { + fprintf(stderr,"CUDA Error gpuInit3: not malloced prop\n"); + return SPGPU_UNSPECIFIED; + } + err = setDevice(dev); + if (err != cudaSuccess) { + fprintf(stderr,"CUDA Error gpuInit2: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } + if (!psb_cublas_handle) + psb_gpuCreateCublasHandle(); + hasUVA=getDeviceHasUVA(); + + return err; + +} + +void gpuClose() +{ + cudaStream_t st1, st2; + if (! psb_gpu_handle) + st1=spgpuGetStream(psb_gpu_handle); + if (! psb_cublas_handle) + cublasGetStream(psb_cublas_handle,&st2); + + psb_gpuDestroyHandle(); + if (st1 != st2) + psb_gpuDestroyCublasHandle(); + free(prop); + prop=NULL; + hasUVA=-1; +} + + +int setDevice(int dev) +{ + int count,err,idev; + + err = cudaGetDeviceCount(&count); + if (err != cudaSuccess) { + fprintf(stderr,"CUDA Error setDevice: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } + + if ((0<=dev)&&(devunifiedAddressing; + return(count); +} + +int getGPUMultiProcessors() +{ int count=0; + if (prop!=NULL) + count = prop->multiProcessorCount; + return(count); +} + + +int getGPUMemoryBusWidth() +{ int count=0; +#if CUDART_VERSION >= 5000 + if (prop!=NULL) + count = prop->memoryBusWidth; +#endif + return(count); +} +int getGPUMemoryClockRate() +{ int count=0; +#if CUDART_VERSION >= 5000 + if (prop!=NULL) + count = prop->memoryClockRate; +#endif + return(count); +} +int getGPUWarpSize() +{ int count=0; + if (prop!=NULL) + count = prop->warpSize; + return(count); +} +int getGPUMaxThreadsPerBlock() +{ int count=0; + if (prop!=NULL) + count = prop->maxThreadsPerBlock; + return(count); +} +int getGPUMaxThreadsPerMP() +{ int count=0; + if (prop!=NULL) + count = prop->maxThreadsPerMultiProcessor; + return(count); +} +int getGPUMaxRegistersPerBlock() +{ int count=0; + if (prop!=NULL) + count = prop->regsPerBlock; + return(count); +} + +void cpyGPUNameString(char *cstring) +{ + *cstring='\0'; + if (prop!=NULL) + strcpy(cstring,prop->name); + +} + +int DeviceHasUVA() +{ + return(hasUVA == 1); +} + + +int getDeviceCount() +{ int count; + cudaError_t err; + err = cudaGetDeviceCount(&count); + if (err != cudaSuccess) { + fprintf(stderr,"CUDA Error getDeviceCount: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } + return(count); +} + +void cudaSync() +{ + cudaError_t err; + err = cudaDeviceSynchronize(); + if (err == cudaSuccess) + return SPGPU_SUCCESS; + else { + fprintf(stderr,"CUDA Error cudaSync: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } +} + +void cudaReset() +{ + cudaError_t err; + err = cudaDeviceReset(); + if (err != cudaSuccess) { + fprintf(stderr,"CUDA Error Reset: %s\n", cudaGetErrorString(err)); + return SPGPU_UNSPECIFIED; + } +} + + +spgpuHandle_t psb_gpuGetHandle() +{ + return psb_gpu_handle; +} + +void psb_gpuCreateHandle() +{ + if (!psb_gpu_handle) + spgpuCreate(&psb_gpu_handle, getDevice()); + +} + +void psb_gpuDestroyHandle() +{ + if (!psb_gpu_handle) + spgpuDestroy(psb_gpu_handle); + psb_gpu_handle = NULL; +} + +cudaStream_t psb_gpuGetStream() +{ + return spgpuGetStream(psb_gpu_handle); +} + +void psb_gpuSetStream(cudaStream_t stream) +{ + spgpuSetStream(psb_gpu_handle, stream); + return ; +} + + + +cublasHandle_t psb_gpuGetCublasHandle() +{ + if (!psb_cublas_handle) + psb_gpuCreateCublasHandle(); + return psb_cublas_handle; +} +void psb_gpuCreateCublasHandle() +{ if (!psb_cublas_handle) + cublasCreate(&psb_cublas_handle); +} +void psb_gpuDestroyCublasHandle() +{ + if (!psb_cublas_handle) + cublasDestroy(psb_cublas_handle); + psb_cublas_handle=NULL; +} + + + + + +/* Simple memory tools */ + +int allocateInt(void **d_int, int n) +{ + return allocRemoteBuffer((void **)(d_int), n*sizeof(int)); +} + +int writeInt(void *d_int, int* h_int, int n) +{ + int i,j; + int *di; + i = writeRemoteBuffer((void*)h_int, (void*)d_int, n*sizeof(int)); + return i; +} + +int readInt(void* d_int, int* h_int, int n) +{ int i; + i = readRemoteBuffer((void *) h_int, (void *) d_int, n*sizeof(int)); + //cudaSync(); + return(i); +} + +int writeIntFirst(int first, void *d_int, int* h_int, int n, int IndexBase) +{ + int i,j; + int *di=(int *) d_int; + di = &(di[first-IndexBase]); + i = writeRemoteBuffer((void*)h_int, (void*)di, n*sizeof(int)); + return i; +} + +int readIntFirst(int first,void* d_int, int* h_int, int n, int IndexBase) +{ int i; + int *di=(int *) d_int; + di = &(di[first-IndexBase]); + i = readRemoteBuffer((void *) h_int, (void *) di, n*sizeof(int)); + //cudaSync(); + return(i); +} + +int allocateMultiInt(void **d_int, int m, int n) +{ + return allocRemoteBuffer((void **)(d_int), m*n*sizeof(int)); +} + +int writeMultiInt(void *d_int, int* h_int, int m, int n) +{ + int i,j; + int *di; + i = writeRemoteBuffer((void*)h_int, (void*)d_int, m*n*sizeof(int)); + return i; +} + +int readMultiInt(void* d_int, int* h_int, int m, int n) +{ int i; + i = readRemoteBuffer((void *) h_int, (void *) d_int, m*n*sizeof(int)); + //cudaSync(); + return(i); +} + +void freeInt(void *d_int) +{ + //printf("Before freeInt\n"); + freeRemoteBuffer(d_int); +} + + + + +int allocateFloat(void **d_float, int n) +{ + return allocRemoteBuffer((void **)(d_float), n*sizeof(float)); +} + +int writeFloat(void *d_float, float* h_float, int n) +{ + int i; + + i = writeRemoteBuffer((void*)h_float, (void*)d_float, n*sizeof(float)); + + return i; +} + +int readFloat(void* d_float, float* h_float, int n) +{ int i; + i = readRemoteBuffer((void *) h_float, (void *) d_float, n*sizeof(float)); + + return(i); +} + +int writeFloatFirst(int df, void *d_float, float* h_float, int n, int IndexBase) +{ + int i; + + float *dv=(float *) d_float; + dv = &dv[df-IndexBase]; + i = writeRemoteBuffer((void*)h_float, (void*)dv, n*sizeof(float)); + + return i; +} + +int readFloatFirst(int df, void* d_float, float* h_float, int n, int IndexBase) +{ int i; + float *dv=(float *) d_float; + dv = &dv[df-IndexBase]; + //fprintf(stderr,"readFloatFirst: %d %p %p %p %d \n",df,d_float,dv,h_float,n); + i = readRemoteBuffer((void *) h_float, (void *) dv, n*sizeof(float)); + + return(i); +} + + +int allocateMultiFloat(void **d_float, int m, int n) +{ + return allocRemoteBuffer((void **)(d_float), m*n*sizeof(float)); +} + +int writeMultiFloat(void *d_float, float* h_float, int m, int n) +{ + int i,j; + i = writeRemoteBuffer((void*)h_float, (void*)d_float, m*n*sizeof(float)); + return i; +} + +int readMultiFloat(void* d_float, float* h_float, int m, int n) +{ int i; + i = readRemoteBuffer((void *) h_float, (void *) d_float, m*n*sizeof(float)); + //cudaSync(); + return(i); +} + +void freeFloat(void *d_float) +{ + freeRemoteBuffer(d_float); +} + + + +int allocateDouble(void **d_double, int n) +{ + return allocRemoteBuffer((void **)(d_double), n*sizeof(double)); +} + +int writeDouble(void *d_double, double* h_double, int n) +{ + int i; + + i = writeRemoteBuffer((void*)h_double, (void*)d_double, n*sizeof(double)); + + return i; +} + +int readDouble(void* d_double, double* h_double, int n) +{ int i; + i = readRemoteBuffer((void *) h_double, (void *) d_double, n*sizeof(double)); + + return(i); +} + +int writeDoubleFirst(int df, void *d_double, double* h_double, int n, int IndexBase) +{ + int i; + + double *dv=(double *) d_double; + dv = &dv[df-IndexBase]; + i = writeRemoteBuffer((void*)h_double, (void*)dv, n*sizeof(double)); + + return i; +} + +int readDoubleFirst(int df, void* d_double, double* h_double, int n, int IndexBase) +{ int i; + double *dv=(double *) d_double; + dv = &dv[df-IndexBase]; + //fprintf(stderr,"readDoubleFirst: %d %p %p %p %d \n",df,d_double,dv,h_double,n); + i = readRemoteBuffer((void *) h_double, (void *) dv, n*sizeof(double)); + + return(i); +} + +int allocateMultiDouble(void **d_double, int m, int n) +{ + return allocRemoteBuffer((void **)(d_double), m*n*sizeof(double)); +} + +int writeMultiDouble(void *d_double, double* h_double, int m, int n) +{ + int i,j; + i = writeRemoteBuffer((void*)h_double, (void*)d_double, m*n*sizeof(double)); + return i; +} + +int readMultiDouble(void* d_double, double* h_double, int m, int n) +{ int i; + i = readRemoteBuffer((void *) h_double, (void *) d_double, m*n*sizeof(double)); + //cudaSync(); + return(i); +} + +void freeDouble(void *d_double) +{ + freeRemoteBuffer(d_double); +} + + + +int allocateFloatComplex(void **d_FloatComplex, int n) +{ + return allocRemoteBuffer((void **)(d_FloatComplex), n*sizeof(cuFloatComplex)); +} + +int writeFloatComplex(void *d_FloatComplex, cuFloatComplex* h_FloatComplex, int n) +{ + int i; + + i = writeRemoteBuffer((void*)h_FloatComplex, (void*)d_FloatComplex, n*sizeof(cuFloatComplex)); + + return i; +} + +int readFloatComplex(void* d_FloatComplex, cuFloatComplex* h_FloatComplex, int n) +{ int i; + i = readRemoteBuffer((void *) h_FloatComplex, (void *) d_FloatComplex, n*sizeof(cuFloatComplex)); + + return(i); +} + +int allocateMultiFloatComplex(void **d_FloatComplex, int m, int n) +{ + return allocRemoteBuffer((void **)(d_FloatComplex), m*n*sizeof(cuFloatComplex)); +} + +int writeMultiFloatComplex(void *d_FloatComplex, cuFloatComplex* h_FloatComplex, int m, int n) +{ + int i,j; + i = writeRemoteBuffer((void*)h_FloatComplex, (void*)d_FloatComplex, m*n*sizeof(cuFloatComplex)); + return i; +} + +int readMultiFloatComplex(void* d_FloatComplex, cuFloatComplex* h_FloatComplex, int m, int n) +{ int i; + i = readRemoteBuffer((void *) h_FloatComplex, (void *) d_FloatComplex, m*n*sizeof(cuFloatComplex)); + //cudaSync(); + return(i); +} + +int writeFloatComplexFirst(int df, void *d_floatComplex, + cuFloatComplex* h_floatComplex, int n, int IndexBase) +{ + int i; + + cuFloatComplex *dv=(cuFloatComplex *) d_floatComplex; + dv = &dv[df-IndexBase]; + i = writeRemoteBuffer((void*)h_floatComplex, (void*)dv, n*sizeof(cuFloatComplex)); + + return i; +} + +int readFloatComplexFirst(int df, void* d_floatComplex, cuFloatComplex* h_floatComplex, + int n, int IndexBase) +{ int i; + cuFloatComplex *dv=(cuFloatComplex *) d_floatComplex; + dv = &dv[df-IndexBase]; + i = readRemoteBuffer((void *) h_floatComplex, (void *) dv, n*sizeof(cuFloatComplex)); + + return(i); +} + +void freeFloatComplex(void *d_FloatComplex) +{ + freeRemoteBuffer(d_FloatComplex); +} + + + + +int allocateDoubleComplex(void **d_DoubleComplex, int n) +{ + return allocRemoteBuffer((void **)(d_DoubleComplex), n*sizeof(cuDoubleComplex)); +} + +int writeDoubleComplex(void *d_DoubleComplex, cuDoubleComplex* h_DoubleComplex, int n) +{ + int i; + + i = writeRemoteBuffer((void*)h_DoubleComplex, (void*)d_DoubleComplex, n*sizeof(cuDoubleComplex)); + + return i; +} + +int readDoubleComplex(void* d_DoubleComplex, cuDoubleComplex* h_DoubleComplex, int n) +{ int i; + i = readRemoteBuffer((void *) h_DoubleComplex, (void *) d_DoubleComplex, n*sizeof(cuDoubleComplex)); + + return(i); +} + +int writeDoubleComplexFirst(int df, void *d_doubleComplex, + cuDoubleComplex* h_doubleComplex, int n, int IndexBase) +{ + int i; + + cuDoubleComplex *dv=(cuDoubleComplex *) d_doubleComplex; + dv = &dv[df-IndexBase]; + i = writeRemoteBuffer((void*)h_doubleComplex, (void*)dv, n*sizeof(cuDoubleComplex)); + + return i; +} + +int readDoubleComplexFirst(int df, void* d_doubleComplex, cuDoubleComplex* h_doubleComplex, + int n, int IndexBase) +{ int i; + cuDoubleComplex *dv=(cuDoubleComplex *) d_doubleComplex; + dv = &dv[df-IndexBase]; + i = readRemoteBuffer((void *) h_doubleComplex, (void *) dv, n*sizeof(cuDoubleComplex)); + + return(i); +} + +int allocateMultiDoubleComplex(void **d_DoubleComplex, int m, int n) +{ + return allocRemoteBuffer((void **)(d_DoubleComplex), m*n*sizeof(cuDoubleComplex)); +} + +int writeMultiDoubleComplex(void *d_DoubleComplex, cuDoubleComplex* h_DoubleComplex, int m, int n) +{ + int i,j; + i = writeRemoteBuffer((void*)h_DoubleComplex, (void*)d_DoubleComplex, m*n*sizeof(cuDoubleComplex)); + return i; +} + +int readMultiDoubleComplex(void* d_DoubleComplex, cuDoubleComplex* h_DoubleComplex, int m, int n) +{ int i; + i = readRemoteBuffer((void *) h_DoubleComplex, (void *) d_DoubleComplex, m*n*sizeof(cuDoubleComplex)); + //cudaSync(); + return(i); +} + +void freeDoubleComplex(void *d_DoubleComplex) +{ + freeRemoteBuffer(d_DoubleComplex); +} + + + +double etime() +{ + struct timeval tt; + struct timezone tz; + double temp; + if (gettimeofday(&tt,&tz) != 0) { + fprintf(stderr,"Fatal error for gettimeofday ??? \n"); + exit(-1); + } + temp = ((double)tt.tv_sec) + ((double)tt.tv_usec)*1.0e-6; + return(temp); +} + + + + +#endif diff --git a/gpu/cuda_util.h b/gpu/cuda_util.h new file mode 100644 index 000000000..03c7b4882 --- /dev/null +++ b/gpu/cuda_util.h @@ -0,0 +1,139 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _CUDA_UTIL_H_ +#define _CUDA_UTIL_H_ + +#include +#include +#include +#include + +#if defined(HAVE_CUDA) +#include "cuda_runtime.h" +#include "core.h" +#include "cuComplex.h" +#include "fcusparse.h" +#include "cublas_v2.h" + +int allocRemoteBuffer(void** buffer, int count); +int allocMappedMemory(void **buffer, void **dp, int size); +int registerMappedMemory(void *buffer, void **dp, int size); +int unregisterMappedMemory(void *buffer); +int writeRemoteBuffer(void* hostSrc, void* buffer, int count); +int readRemoteBuffer(void* hostDest, void* buffer, int count); +int freeRemoteBuffer(void* buffer); +int gpuInit(int dev); +int getDeviceCount(); +int getDevice(); +int setDevice(int dev); +int getGPUMultiProcessors(); +int getGPUMemoryBusWidth(); +int getGPUMemoryClockRate(); +int getGPUWarpSize(); +int getGPUMaxThreadsPerBlock(); +int getGPUMaxThreadsPerMP(); +int getGPUMaxRegistersPerBlock(); +void cpyGPUNameString(char *cstring); + + +void cudaSync(); +void cudaReset(); +void gpuClose(); + + +spgpuHandle_t psb_gpuGetHandle(); +void psb_gpuCreateHandle(); +void psb_gpuDestroyHandle(); +cudaStream_t psb_gpuGetStream(); +void psb_gpuSetStream(cudaStream_t stream); + +cublasHandle_t psb_gpuGetCublasHandle(); +void psb_gpuCreateCublasHandle(); +void psb_gpuDestroyCublasHandle(); + + +int allocateInt(void **, int); +int allocateMultiInt(void **, int, int); +int writeInt(void *, int *, int); +int writeMultiInt(void *, int* , int , int ); +int readInt(void *, int *, int); +int readMultiInt(void*, int*, int, int ); +int writeIntFirst(int,void *, int *, int,int); +int readIntFirst(int,void *, int *, int,int); +void freeInt(void *); + +int allocateFloat(void **, int); +int allocateMultiFloat(void **, int, int); +int writeFloat(void *, float *, int); +int writeMultiFloat(void *, float* , int , int ); +int readFloat(void *, float*, int); +int readMultiFloat(void*, float*, int, int ); +int writeFloatFirst(int, void *, float*, int, int); +int readFloatFirst(int, void *, float*, int, int); +void freeFloat(void *); + +int allocateDouble(void **, int); +int allocateMultiDouble(void **, int, int); +int writeDouble(void *, double*, int); +int writeMultiDouble(void *, double* , int , int ); +int readDouble(void *, double*, int); +int readMultiDouble(void*, double*, int, int ); +int writeDoubleFirst(int, void *, double*, int, int); +int readDoubleFirst(int, void *, double*, int, int); +void freeDouble(void *); + +int allocateFloatComplex(void **, int); +int allocateMultiFloatComplex(void **, int, int); +int writeFloatComplex(void *, cuFloatComplex*, int); +int writeMultiFloatComplex(void *, cuFloatComplex* , int , int ); +int readFloatComplex(void *, cuFloatComplex*, int); +int readMultiFloatComplex(void*, cuFloatComplex*, int, int ); +int writeFloatComplexFirst(int, void *, cuFloatComplex*, int, int); +int readFloatComplexFirst(int, void *, cuFloatComplex*, int, int); +void freeFloatComplex(void *); + +int allocateDoubleComplex(void **, int); +int allocateMultiDoubleComplex(void **, int, int); +int writeDoubleComplex(void *, cuDoubleComplex*, int); +int writeMultiDoubleComplex(void *, cuDoubleComplex* , int , int ); +int readDoubleComplex(void *, cuDoubleComplex*, int); +int readMultiDoubleComplex(void*, cuDoubleComplex*, int, int ); +int writeDoubleComplexFirst(int, void *, cuDoubleComplex*, int, int); +int readDoubleComplexFirst(int, void *, cuDoubleComplex*, int, int); +void freeDoubleComplex(void *); + +double etime(); + +#endif + +#endif diff --git a/gpu/cusparse_mod.F90 b/gpu/cusparse_mod.F90 new file mode 100644 index 000000000..4ae16cffc --- /dev/null +++ b/gpu/cusparse_mod.F90 @@ -0,0 +1,38 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 cusparse_mod + use base_cusparse_mod + use s_cusparse_mod + use d_cusparse_mod + use c_cusparse_mod + use z_cusparse_mod +end module cusparse_mod diff --git a/gpu/cvectordev.c b/gpu/cvectordev.c new file mode 100644 index 000000000..db55caef9 --- /dev/null +++ b/gpu/cvectordev.c @@ -0,0 +1,325 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +//#include "utils.h" +//#include "common.h" +#include "cvectordev.h" + + +int registerMappedFloatComplex(void *buff, void **d_p, int n, cuFloatComplex dummy) +{ + return registerMappedMemory(buff,d_p,n*sizeof(cuFloatComplex)); +} + +int writeMultiVecDeviceFloatComplex(void* deviceVec, cuFloatComplex* hostVec) +{ int i; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + // Ex updateFromHost vector function + i = writeRemoteBuffer((void*) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(cuFloatComplex)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocMultiVecDevice",i); + } + return(i); +} + +int writeMultiVecDeviceFloatComplexR2(void* deviceVec, cuFloatComplex* hostVec, int ld) +{ int i; + i = writeMultiVecDeviceFloatComplex(deviceVec, (void *) hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeMultiVecDeviceFloatComplexR2",i); + } + return(i); +} + +int readMultiVecDeviceFloatComplex(void* deviceVec, cuFloatComplex* hostVec) +{ int i,j; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = readRemoteBuffer((void *) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(cuFloatComplex)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceFloat",i); + } + return(i); +} + +int readMultiVecDeviceFloatComplexR2(void* deviceVec, cuFloatComplex* hostVec, int ld) +{ int i; + i = readMultiVecDeviceFloatComplex(deviceVec, hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceFloatComplexR2",i); + } + return(i); +} + +int setscalMultiVecDeviceFloatComplex(cuFloatComplex val, int first, int last, + int indexBase, void* devMultiVecX) +{ int i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuCsetscal(handle, first, last, indexBase, val, (cuFloatComplex *) devVecX->v_); + + return(i); +} + +int geinsMultiVecDeviceFloatComplex(int n, void* devMultiVecIrl, void* devMultiVecVal, + int dupl, int indexBase, void* devMultiVecX) +{ int j=0, i=0,nmin=0,nmax=0; + int pitch = 0; + cuFloatComplex beta; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecIrl = (struct MultiVectDevice *) devMultiVecIrl; + struct MultiVectDevice *devVecVal = (struct MultiVectDevice *) devMultiVecVal; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecIrl->pitch_; + if ((n > devVecIrl->size_) || (n>devVecVal->size_ )) + return SPGPU_UNSUPPORTED; + + //fprintf(stderr,"geins: %d %d %p %p %p\n",dupl,n,devVecIrl->v_,devVecVal->v_,devVecX->v_); + + if (dupl == INS_OVERWRITE) + beta = make_cuFloatComplex(0.0, 0.0); + else if (dupl == INS_ADD) + beta = make_cuFloatComplex(1.0, 0.0); + else + beta = make_cuFloatComplex(0.0, 0.0); + + spgpuCscat(handle, (cuFloatComplex *) devVecX->v_, n, (cuFloatComplex*)devVecVal->v_, + (int*)devVecIrl->v_, indexBase, beta); + + return(i); +} + + +int igathMultiVecDeviceFloatComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + + i= igathMultiVecDeviceFloatComplex(deviceVec, vectorId, n, + first, (void*) devIdx->v_, hfirst, host_values, indexBase); + return(i); +} + +int igathMultiVecDeviceFloatComplex(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx =(int *) indexes;; + cuFloatComplex *hv = (cuFloatComplex *) host_values;; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + i=0; + hv = &(hv[hfirst-indexBase]); + idx = &(idx[first-indexBase]); + spgpuCgath(handle,hv, n, idx,indexBase, + (cuFloatComplex *) devVec->v_+vectorId*devVec->pitch_); + return(i); +} + +int iscatMultiVecDeviceFloatComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void *deviceIdx, + int hfirst, void* host_values, + int indexBase, cuFloatComplex beta) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + i= iscatMultiVecDeviceFloatComplex(deviceVec, vectorId, n, first, + (void*) devIdx->v_, hfirst,host_values, + indexBase, beta); + return(i); +} + +int iscatMultiVecDeviceFloatComplex(void* deviceVec, int vectorId, int n, + int first, void *indexes, + int hfirst, void* host_values, + int indexBase, cuFloatComplex beta) +{ int i=0; + cuFloatComplex *hv = (cuFloatComplex *) host_values; + int *idx=(int *) indexes; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + idx = &(idx[first-indexBase]); + hv = &(hv[hfirst-indexBase]); + spgpuCscat(handle, (cuFloatComplex *) devVec->v_, n, hv, idx, indexBase, beta); + return SPGPU_SUCCESS; + +} + + +int nrm2MultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuCmnrm2(handle, y_res, n,(cuFloatComplex *)devVecA->v_, + devVecA->count_, devVecA->pitch_); + return(i); +} + +int amaxMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuCmamax(handle, y_res, n,(cuFloatComplex *)devVecA->v_, + devVecA->count_, devVecA->pitch_); + return(i); +} + +int asumMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuCmasum(handle, y_res, n,(cuFloatComplex *)devVecA->v_, + devVecA->count_, devVecA->pitch_); + + return(i); +} + +int scalMultiVecDeviceFloatComplex(cuFloatComplex alpha, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + // Note: inner kernel can handle aliased input/output + spgpuCscal(handle, (cuFloatComplex *)devVecA->v_, devVecA->pitch_, + alpha, (cuFloatComplex *)devVecA->v_); + return(i); +} + +int dotMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, + void* devMultiVecA, void* devMultiVecB) +{int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) devMultiVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuCmdot(handle, y_res, n, (cuFloatComplex*)devVecA->v_, + (cuFloatComplex*)devVecB->v_,devVecA->count_,devVecB->pitch_); + return(i); +} + +int axpbyMultiVecDeviceFloatComplex(int n,cuFloatComplex alpha, void* devMultiVecX, + cuFloatComplex beta, void* devMultiVecY) +{ int j=0, i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecY = (struct MultiVectDevice *) devMultiVecY; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecY->pitch_; + if ((n > devVecY->size_) || (n>devVecX->size_ )) + return SPGPU_UNSUPPORTED; + + for(j=0;jcount_;j++) + spgpuCaxpby(handle,(cuFloatComplex*)devVecY->v_+pitch*j, n, beta, + (cuFloatComplex*)devVecY->v_+pitch*j, alpha, + (cuFloatComplex*) devVecX->v_+pitch*j); + return(i); +} + +int axyMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, + void *deviceVecA, void *deviceVecB) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuCmaxy(handle, (cuFloatComplex*)devVecB->v_, n, alpha, + (cuFloatComplex*)devVecA->v_, + (cuFloatComplex*)devVecB->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int axybzMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void *deviceVecA, + void *deviceVecB, cuFloatComplex beta, + void *deviceVecZ) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + struct MultiVectDevice *devVecZ = (struct MultiVectDevice *) deviceVecZ; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ ) || (n>devVecZ->size_ )) + return SPGPU_UNSUPPORTED; + spgpuCmaxypbz(handle, (cuFloatComplex*)devVecZ->v_, n, beta, + (cuFloatComplex*)devVecZ->v_, + alpha, (cuFloatComplex*) devVecA->v_, (cuFloatComplex*) devVecB->v_, + devVecB->count_, devVecB->pitch_); + return(i); +} + + +int absMultiVecDeviceFloatComplex2(int n, cuFloatComplex alpha, void *deviceVecA, + void *deviceVecB) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuCabs(handle, (cuFloatComplex*)devVecB->v_, n, + alpha, (cuFloatComplex*)devVecA->v_); + + return(i); +} + +int absMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void *deviceVecA) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + spgpuHandle_t handle=psb_gpuGetHandle(); + if (n > devVecA->size_) + return SPGPU_UNSUPPORTED; + + spgpuCabs(handle, (cuFloatComplex*)devVecA->v_, n, + alpha, (cuFloatComplex*)devVecA->v_); + + return(i); +} + +#endif + diff --git a/gpu/cvectordev.h b/gpu/cvectordev.h new file mode 100644 index 000000000..f58fcca73 --- /dev/null +++ b/gpu/cvectordev.h @@ -0,0 +1,81 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include +#include "cuComplex.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +int registerMappedFloatComplex(void *, void **, int, cuFloatComplex); +int writeMultiVecDeviceFloatComplex(void* deviceMultiVec, cuFloatComplex* hostMultiVec); +int writeMultiVecDeviceFloatComplexR2(void* deviceMultiVec, cuFloatComplex* hostMultiVec, int ld); +int readMultiVecDeviceFloatComplex(void* deviceMultiVec, cuFloatComplex* hostMultiVec); +int readMultiVecDeviceFloatComplexR2(void* deviceMultiVec, cuFloatComplex* hostMultiVec, int ld); + +int setscalMultiVecDeviceFloatComplex(cuFloatComplex val, int first, int last, + int indexBase, void* devVecX); + +int geinsMultiVecDeviceFloatComplex(int n, void* devVecIrl, void* devVecVal, + int dupl, int indexBase, void* devVecX); + +int igathMultiVecDeviceFloatComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase); +int igathMultiVecDeviceFloatComplex(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, + int indexBase); +int iscatMultiVecDeviceFloatComplexVecIdx(void* deviceVec, int vectorId, int n, int first, + void *deviceIdx, int hfirst, void* host_values, + int indexBase, cuFloatComplex beta); +int iscatMultiVecDeviceFloatComplex(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, cuFloatComplex beta); + +int scalMultiVecDeviceFloatComplex(cuFloatComplex alpha, void* devMultiVecA); +int nrm2MultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devVecA); +int amaxMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devVecA); +int asumMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devVecA); +int dotMultiVecDeviceFloatComplex(cuFloatComplex* y_res, int n, void* devVecA, void* devVecB); + +int axpbyMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void* devVecX, cuFloatComplex beta, void* devVecY); +int axyMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void *deviceVecA, void *deviceVecB); +int axybzMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void *deviceVecA, + void *deviceVecB, cuFloatComplex beta, void *deviceVecZ); +int absMultiVecDeviceFloatComplex(int n, cuFloatComplex alpha, void *deviceVecA); +int absMultiVecDeviceFloatComplex2(int n, cuFloatComplex alpha, + void *deviceVecA, void *deviceVecB); + + +#endif diff --git a/gpu/d_cusparse_mod.F90 b/gpu/d_cusparse_mod.F90 new file mode 100644 index 000000000..cd8bd52f6 --- /dev/null +++ b/gpu/d_cusparse_mod.F90 @@ -0,0 +1,305 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 d_cusparse_mod + use base_cusparse_mod + + type, bind(c) :: d_Cmat + type(c_ptr) :: Mat = c_null_ptr + end type d_Cmat + +#if CUDA_SHORT_VERSION <= 10 + type, bind(c) :: d_Hmat + type(c_ptr) :: Mat = c_null_ptr + end type d_Hmat +#endif + + +#if defined(HAVE_CUDA) && defined(HAVE_SPGPU) + + interface CSRGDeviceFree + function d_CSRGDeviceFree(Mat) & + & bind(c,name="d_CSRGDeviceFree") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int) :: res + end function d_CSRGDeviceFree + end interface + + interface CSRGDeviceSetMatType + function d_CSRGDeviceSetMatType(Mat,type) & + & bind(c,name="d_CSRGDeviceSetMatType") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_CSRGDeviceSetMatType + end interface + + interface CSRGDeviceSetMatFillMode + function d_CSRGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="d_CSRGDeviceSetMatFillMode") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_CSRGDeviceSetMatFillMode + end interface + + interface CSRGDeviceSetMatDiagType + function d_CSRGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="d_CSRGDeviceSetMatDiagType") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_CSRGDeviceSetMatDiagType + end interface + + interface CSRGDeviceSetMatIndexBase + function d_CSRGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="d_CSRGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_CSRGDeviceSetMatIndexBase + end interface + + interface CSRGDeviceCsrsmAnalysis + function d_CSRGDeviceCsrsmAnalysis(Mat) & + & bind(c,name="d_CSRGDeviceCsrsmAnalysis") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int) :: res + end function d_CSRGDeviceCsrsmAnalysis + end interface + + interface CSRGDeviceAlloc + function d_CSRGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="d_CSRGDeviceAlloc") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function d_CSRGDeviceAlloc + end interface + + interface CSRGDeviceGetParms + function d_CSRGDeviceGetParms(Mat,nr,nc,nz) & + & bind(c,name="d_CSRGDeviceGetParms") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int) :: nr, nc, nz + integer(c_int) :: res + end function d_CSRGDeviceGetParms + end interface + + interface spsvCSRGDevice + function d_spsvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="d_spsvCSRGDevice") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_double), value :: alpha,beta + integer(c_int) :: res + end function d_spsvCSRGDevice + end interface + + interface spmvCSRGDevice + function d_spmvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="d_spmvCSRGDevice") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_double), value :: alpha,beta + integer(c_int) :: res + end function d_spmvCSRGDevice + end interface + + interface CSRGHost2Device + function d_CSRGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="d_CSRGHost2Device") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_double) :: val(*) + integer(c_int) :: res + end function d_CSRGHost2Device + end interface + + interface CSRGDevice2Host + function d_CSRGDevice2Host(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="d_CSRGDevice2Host") result(res) + use iso_c_binding + import d_Cmat + type(d_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_double) :: val(*) + integer(c_int) :: res + end function d_CSRGDevice2Host + end interface + +#if CUDA_SHORT_VERSION <= 10 + interface HYBGDeviceAlloc + function d_HYBGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="d_HYBGDeviceAlloc") result(res) + use iso_c_binding + import d_hmat + type(d_Hmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function d_HYBGDeviceAlloc + end interface + + interface HYBGDeviceFree + function d_HYBGDeviceFree(Mat) & + & bind(c,name="d_HYBGDeviceFree") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int) :: res + end function d_HYBGDeviceFree + end interface + + interface HYBGDeviceSetMatType + function d_HYBGDeviceSetMatType(Mat,type) & + & bind(c,name="d_HYBGDeviceSetMatType") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_HYBGDeviceSetMatType + end interface + + interface HYBGDeviceSetMatFillMode + function d_HYBGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="d_HYBGDeviceSetMatFillMode") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_HYBGDeviceSetMatFillMode + end interface + + interface HYBGDeviceSetMatDiagType + function d_HYBGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="d_HYBGDeviceSetMatDiagType") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_HYBGDeviceSetMatDiagType + end interface + + interface HYBGDeviceSetMatIndexBase + function d_HYBGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="d_HYBGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function d_HYBGDeviceSetMatIndexBase + end interface + + interface HYBGDeviceHybsmAnalysis + function d_HYBGDeviceHybsmAnalysis(Mat) & + & bind(c,name="d_HYBGDeviceHybsmAnalysis") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int) :: res + end function d_HYBGDeviceHybsmAnalysis + end interface + + interface spsvHYBGDevice + function d_spsvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="d_spsvHYBGDevice") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_double), value :: alpha,beta + integer(c_int) :: res + end function d_spsvHYBGDevice + end interface + + interface spmvHYBGDevice + function d_spmvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="d_spmvHYBGDevice") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_double), value :: alpha,beta + integer(c_int) :: res + end function d_spmvHYBGDevice + end interface + + interface HYBGHost2Device + function d_HYBGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="d_HYBGHost2Device") result(res) + use iso_c_binding + import d_Hmat + type(d_Hmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_double) :: val(*) + integer(c_int) :: res + end function d_HYBGHost2Device + end interface +#endif + +#endif + +end module d_cusparse_mod diff --git a/gpu/dcusparse.c b/gpu/dcusparse.c new file mode 100644 index 000000000..9659c1f95 --- /dev/null +++ b/gpu/dcusparse.c @@ -0,0 +1,95 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 + +#ifdef HAVE_SPGPU +#include +#include +#include "cintrf.h" +#include "fcusparse.h" + + +/* Double precision real */ +#define TYPE double +#define CUSPARSE_BASE_TYPE CUDA_R_64F +#define T_CSRGDeviceMat d_CSRGDeviceMat +#define T_Cmat d_Cmat +#define T_spmvCSRGDevice d_spmvCSRGDevice +#define T_spsvCSRGDevice d_spsvCSRGDevice +#define T_CSRGDeviceAlloc d_CSRGDeviceAlloc +#define T_CSRGDeviceFree d_CSRGDeviceFree +#define T_CSRGHost2Device d_CSRGHost2Device +#define T_CSRGDevice2Host d_CSRGDevice2Host +#define T_CSRGDeviceSetMatFillMode d_CSRGDeviceSetMatFillMode +#define T_CSRGDeviceSetMatDiagType d_CSRGDeviceSetMatDiagType +#define T_CSRGDeviceGetParms d_CSRGDeviceGetParms + +#if CUDA_SHORT_VERSION <= 10 +#define T_CSRGDeviceSetMatType d_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase d_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsmAnalysis d_CSRGDeviceCsrsmAnalysis +#define cusparseTcsrmv cusparseDcsrmv +#define cusparseTcsrsv_solve cusparseDcsrsv_solve +#define cusparseTcsrsv_analysis cusparseDcsrsv_analysis +#define T_HYBGDeviceMat d_HYBGDeviceMat +#define T_Hmat d_Hmat +#define T_HYBGDeviceFree d_HYBGDeviceFree +#define T_spmvHYBGDevice d_spmvHYBGDevice +#define T_HYBGDeviceAlloc d_HYBGDeviceAlloc +#define T_HYBGDeviceSetMatDiagType d_HYBGDeviceSetMatDiagType +#define T_HYBGDeviceSetMatIndexBase d_HYBGDeviceSetMatIndexBase +#define T_HYBGDeviceSetMatType d_HYBGDeviceSetMatType +#define T_HYBGDeviceSetMatFillMode d_HYBGDeviceSetMatFillMode +#define T_HYBGDeviceHybsmAnalysis d_HYBGDeviceHybsmAnalysis +#define T_spsvHYBGDevice d_spsvHYBGDevice +#define T_HYBGHost2Device d_HYBGHost2Device +#define cusparseThybmv cusparseDhybmv +#define cusparseThybsv_solve cusparseDhybsv_solve +#define cusparseThybsv_analysis cusparseDhybsv_analysis +#define cusparseTcsr2hyb cusparseDcsr2hyb + +#elif CUDA_VERSION < 11030 + +#define T_CSRGDeviceSetMatType d_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase d_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsv2Analysis d_CSRGDeviceCsrsv2Analysis +#define cusparseTcsrsv2_bufferSize cusparseDcsrsv2_bufferSize +#define cusparseTcsrsv2_analysis cusparseDcsrsv2_analysis +#define cusparseTcsrsv2_solve cusparseDcsrsv2_solve + +#endif + +#include "fcusparse_fct.h" + +#endif diff --git a/gpu/diagdev.c b/gpu/diagdev.c new file mode 100644 index 000000000..64879455a --- /dev/null +++ b/gpu/diagdev.c @@ -0,0 +1,291 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "diagdev.h" +#include +#include +#include +#include +#if defined(HAVE_SPGPU) +//new +DiagDeviceParams getDiagDeviceParams(unsigned int rows, unsigned int columns, unsigned int diags, unsigned int elementType) +{ + DiagDeviceParams params; + + params.elementType = elementType; + //numero di elementi di val + params.rows = rows; + params.columns = columns; + params.diags = diags; + + return params; + +} +//new +int allocDiagDevice(void ** remoteMatrix, DiagDeviceParams* params) +{ + struct DiagDevice *tmp = (struct DiagDevice *)malloc(sizeof(struct DiagDevice)); + int ret=SPGPU_SUCCESS; + *remoteMatrix = (void *)tmp; + + tmp->rows = params->rows; + + tmp->cols = params->columns; + + tmp->diags = params->diags; + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->off), tmp->diags*sizeof(int)); + + /* tmp->baseIndex = params->firstIndex; */ + + if (params->elementType == SPGPU_TYPE_INT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->rows*tmp->diags*sizeof(int)); + } + else if (params->elementType == SPGPU_TYPE_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->rows*tmp->diags*sizeof(float)); + } + else if (params->elementType == SPGPU_TYPE_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->rows*tmp->diags*sizeof(double)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->rows*tmp->diags*sizeof(cuFloatComplex)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->rows*tmp->diags*sizeof(cuDoubleComplex)); + } + else + return SPGPU_UNSUPPORTED; // Unsupported params + return ret; +} + +void freeDiagDevice(void* remoteMatrix) +{ + struct DiagDevice *devMat = (struct DiagDevice *) remoteMatrix; + //fprintf(stderr,"freeHllDevice\n"); + if (devMat != NULL) { + freeRemoteBuffer(devMat->off); + freeRemoteBuffer(devMat->cM); + free(remoteMatrix); + } +} + +//new +int FallocDiagDevice(void** deviceMat, unsigned int rows, unsigned int columns,unsigned int diags,unsigned int elementType) +{ int i; +#ifdef HAVE_SPGPU + DiagDeviceParams p; + + p = getDiagDeviceParams(rows, columns, diags,elementType); + i = allocDiagDevice(deviceMat, &p); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocEllDevice",i); + } + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeDiagDeviceDouble(void* deviceMat, double* a, int* off, int n) +{ int i,fo,fa; + char buf_a[255], buf_o[255],tmp[255]; +#ifdef HAVE_SPGPU + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + // Ex updateFromHost function + /* memset(buf_a,'\0',255); */ + /* memset(buf_o,'\0',255); */ + /* memset(tmp,'\0',255); */ + + /* strcat(buf_a,"mat_"); */ + /* strcat(buf_o,"off_"); */ + /* sprintf(tmp,"%d_%d.dat",devMat->rows,devMat->cols); */ + /* strcat(buf_a,tmp); */ + /* memset(tmp,'\0',255); */ + /* sprintf(tmp,"%d.dat",devMat->cols); */ + /* strcat(buf_o,tmp); */ + + /* fa = open(buf_a, O_CREAT | O_WRONLY | O_TRUNC, 0664); */ + /* fo = open(buf_o, O_CREAT | O_WRONLY | O_TRUNC, 0664); */ + + /* i = write(fa, a, sizeof(double)*devMat->cols*devMat->rows); */ + /* i = write(fo, off, sizeof(int)*devMat->cols); */ + + /* close(fa); */ + /* close(fo); */ + + i = writeRemoteBuffer((void*) a, (void *)devMat->cM, devMat->rows*devMat->diags*sizeof(double)); + i = writeRemoteBuffer((void*) off, (void *)devMat->off, devMat->diags*sizeof(int)); + + if(i==0) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readDiagDeviceDouble(void* deviceMat, double* a, int* off) +{ int i; +#ifdef HAVE_SPGPU + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + i = readRemoteBuffer((void *) a, (void *)devMat->cM,devMat->rows*devMat->diags*sizeof(double)); + i = readRemoteBuffer((void *) off, (void *)devMat->off, devMat->diags*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +//new +int spmvDiagDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY) +{ + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + /* spgpuDdiagspmv(handle, (double *)y->v_, (double *)y->v_,alpha,(double *)devMat->cM,devMat->off,devMat->rows,devMat->cols,x->v_,beta,devMat->baseIndex); */ + + spgpuDdiaspmv(handle, (double *)y->v_, (double *)y->v_,alpha,(double *)devMat->cM,devMat->off,devMat->rows,devMat->rows,devMat->cols,devMat->diags,x->v_,beta); + + //cudaSync(); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int writeDiagDeviceFloat(void* deviceMat, float* a, int* off, int n) +{ int i,fo,fa; + char buf_a[255], buf_o[255],tmp[255]; +#ifdef HAVE_SPGPU + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + // Ex updateFromHost function + /* memset(buf_a,'\0',255); */ + /* memset(buf_o,'\0',255); */ + /* memset(tmp,'\0',255); */ + + /* strcat(buf_a,"mat_"); */ + /* strcat(buf_o,"off_"); */ + /* sprintf(tmp,"%d_%d.dat",devMat->rows,devMat->cols); */ + /* strcat(buf_a,tmp); */ + /* memset(tmp,'\0',255); */ + /* sprintf(tmp,"%d.dat",devMat->cols); */ + /* strcat(buf_o,tmp); */ + + /* fa = open(buf_a, O_CREAT | O_WRONLY | O_TRUNC, 0664); */ + /* fo = open(buf_o, O_CREAT | O_WRONLY | O_TRUNC, 0664); */ + + /* i = write(fa, a, sizeof(float)*devMat->cols*devMat->rows); */ + /* i = write(fo, off, sizeof(int)*devMat->cols); */ + + /* close(fa); */ + /* close(fo); */ + + i = writeRemoteBuffer((void*) a, (void *)devMat->cM, devMat->rows*devMat->diags*sizeof(float)); + i = writeRemoteBuffer((void*) off, (void *)devMat->off, devMat->diags*sizeof(int)); + + if(i==0) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readDiagDeviceFloat(void* deviceMat, float* a, int* off) +{ int i; +#ifdef HAVE_SPGPU + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + i = readRemoteBuffer((void *) a, (void *)devMat->cM,devMat->rows*devMat->diags*sizeof(float)); + i = readRemoteBuffer((void *) off, (void *)devMat->off, devMat->diags*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +//new +int spmvDiagDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY) +{ + struct DiagDevice *devMat = (struct DiagDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + /* spgpuDdiagspmv(handle, (float *)y->v_, (float *)y->v_,alpha,(float *)devMat->cM,devMat->off,devMat->rows,devMat->cols,x->v_,beta,devMat->baseIndex); */ + + spgpuSdiaspmv(handle, (float *)y->v_, (float *)y->v_,alpha,(float *)devMat->cM,devMat->off,devMat->rows,devMat->rows,devMat->cols,devMat->diags,x->v_,beta); + + //cudaSync(); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +#endif diff --git a/gpu/diagdev.h b/gpu/diagdev.h new file mode 100644 index 000000000..83f38289f --- /dev/null +++ b/gpu/diagdev.h @@ -0,0 +1,95 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _DIAGDEV_H_ +#define _DIAGDEV_H_ + +#ifdef HAVE_SPGPU +#include "cintrf.h" +#include "dia.h" + +struct DiagDevice +{ + // Compressed matrix + void *cM; //it can be float or double + + // offset (same size of cM) + int *off; + + int rows; + + int cols; + + int diags; + +}; + +typedef struct DiagDeviceParams +{ + + unsigned int elementType; + + // Number of rows. + // Used to allocate rS array + unsigned int rows; + //unsigned int hackOffsLength; + + // Number of columns. + // Used for error-checking + unsigned int columns; + + unsigned int diags; + +} DiagDeviceParams; +DiagDeviceParams getDiagDeviceParams(unsigned int rows, unsigned int columns, + unsigned int elementType, unsigned int firstIndex); +int FallocDiagDevice(void** deviceMat, unsigned int rows, unsigned int cols, + unsigned int elementType, unsigned int firstIndex); +int allocDiagDevice(void ** remoteMatrix, DiagDeviceParams* params); +void freeDiagDevice(void* remoteMatrix); + +int readDiagDeviceDouble(void* deviceMat, double* a, int* off); +int writeDiagDeviceDouble(void* deviceMat, double* a, int* off, int n); +int spmvDiagDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY); + +int readDiagDeviceFloat(void* deviceMat, float* a, int* off); +int writeDiagDeviceFloat(void* deviceMat, float* a, int* off, int n); +int spmvDiagDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY); + + + +#else +#define CINTRF_UNSUPPORTED -1 +#endif + +#endif diff --git a/gpu/diagdev_mod.F90 b/gpu/diagdev_mod.F90 new file mode 100644 index 000000000..cbcc029e4 --- /dev/null +++ b/gpu/diagdev_mod.F90 @@ -0,0 +1,231 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 diagdev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: diagdev_parms + integer(c_int) :: element_type + integer(c_int) :: rows + integer(c_int) :: columns + integer(c_int) :: firstIndex + end type diagdev_parms + +#ifdef HAVE_SPGPU + + interface + function FgetDiagDeviceParams(rows, columns, elementType, firstIndex) & + & result(res) bind(c,name='getDiagDeviceParams') + use iso_c_binding + import :: diagdev_parms + type(diagdev_parms) :: res + integer(c_int), value :: rows,columns,elementType,firstIndex + end function FgetDiagDeviceParams + end interface + + + interface + function FallocDiagDevice(deviceMat,rows,columns,& + & elementType,firstIndex) & + & result(res) bind(c,name='FallocDiagDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: rows,columns,elementType,firstIndex + type(c_ptr) :: deviceMat + end function FallocDiagDevice + end interface + + + interface writeDiagDevice + + function writeDiagDeviceFloat(deviceMat,a,off,n) & + & result(res) bind(c,name='writeDiagDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: n + real(c_float) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function writeDiagDeviceFloat + + function writeDiagDeviceDouble(deviceMat,a,off,n) & + & result(res) bind(c,name='writeDiagDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int),value :: n + real(c_double) :: a(n,*) + integer(c_int) :: off(*) + end function writeDiagDeviceDouble + + function writeDiagDeviceFloatComplex(deviceMat,a,off,n) & + & result(res) bind(c,name='writeDiagDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: n + complex(c_float_complex) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function writeDiagDeviceFloatComplex + + function writeDiagDeviceDoubleComplex(deviceMat,a,off,n) & + & result(res) bind(c,name='writeDiagDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: n + complex(c_double_complex) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function writeDiagDeviceDoubleComplex + + end interface + + interface readDiagDevice + + function readDiagDeviceFloat(deviceMat,a,off,n) & + & result(res) bind(c,name='readDiagDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_float) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function readDiagDeviceFloat + + function readDiagDeviceDouble(deviceMat,a,off,n) & + & result(res) bind(c,name='readDiagDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int),value :: n + real(c_double) :: a(n,*) + integer(c_int) :: off(*) + end function readDiagDeviceDouble + + function readDiagDeviceFloatComplex(deviceMat,a,off,n) & + & result(res) bind(c,name='readDiagDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: n + complex(c_float_complex) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function readDiagDeviceFloatComplex + + function readDiagDeviceDoubleComplex(deviceMat,a,off,n) & + & result(res) bind(c,name='readDiagDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: n + complex(c_double_complex) :: a(n,*) + integer(c_int) :: off(*)!,irn(*) + end function readDiagDeviceDoubleComplex + + end interface + + interface + subroutine freeDiagDevice(deviceMat) & + & bind(c,name='freeDiagDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine freeDiagDevice + end interface + + interface + subroutine resetDiagTimer() bind(c,name='resetDiagTimer') + use iso_c_binding + end subroutine resetDiagTimer + end interface + interface + function getDiagTimer() & + & bind(c,name='getDiagTimer') result(res) + use iso_c_binding + real(c_double) :: res + end function getDiagTimer + end interface + + + interface + function getDiagDevicePitch(deviceMat) & + & bind(c,name='getDiagDevicePitch') result(res) + use iso_c_binding + type(c_ptr), value :: deviceMat + integer(c_int) :: res + end function getDiagDevicePitch + end interface + + interface + function getDiagDeviceMaxRowSize(deviceMat) & + & bind(c,name='getDiagDeviceMaxRowSize') result(res) + use iso_c_binding + type(c_ptr), value :: deviceMat + integer(c_int) :: res + end function getDiagDeviceMaxRowSize + end interface + + + interface spmvDiagDevice + function spmvDiagDeviceFloat(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvDiagDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_float),value :: alpha, beta + end function spmvDiagDeviceFloat + function spmvDiagDeviceDouble(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvDiagDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_double),value :: alpha, beta + end function spmvDiagDeviceDouble + function spmvDiagDeviceFloatComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvDiagDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_float_complex),value :: alpha, beta + end function spmvDiagDeviceFloatComplex + function spmvDiagDeviceDoubleComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvDiagDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_double_complex),value :: alpha, beta + end function spmvDiagDeviceDoubleComplex + end interface spmvDiagDevice + +#endif + + +end module diagdev_mod diff --git a/gpu/dnsdev.c b/gpu/dnsdev.c new file mode 100644 index 000000000..fb4d339c7 --- /dev/null +++ b/gpu/dnsdev.c @@ -0,0 +1,383 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "dnsdev.h" + +#if defined(HAVE_SPGPU) + +#define PASS_RS 0 + +#define IMIN(a,b) ((a)<(b) ? (a) : (b)) + +DnsDeviceParams getDnsDeviceParams(unsigned int rows, unsigned int columns, + unsigned int elementType, unsigned int firstIndex) +{ + DnsDeviceParams params; + + if (elementType == SPGPU_TYPE_DOUBLE) + { + params.pitch = ((rows + ELL_PITCH_ALIGN_D - 1)/ELL_PITCH_ALIGN_D)*ELL_PITCH_ALIGN_D; + } + else + { + params.pitch = ((rows + ELL_PITCH_ALIGN_S - 1)/ELL_PITCH_ALIGN_S)*ELL_PITCH_ALIGN_S; + } + //For complex? + params.elementType = elementType; + params.rows = rows; + params.columns = columns; + params.firstIndex = firstIndex; + + return params; + +} +//new +int allocDnsDevice(void ** remoteMatrix, DnsDeviceParams* params) +{ + struct DnsDevice *tmp = (struct DnsDevice *)malloc(sizeof(struct DnsDevice)); + *remoteMatrix = (void *)tmp; + tmp->rows = params->rows; + tmp->columns = params->columns; + tmp->cMPitch = params->pitch; + tmp->pitch= tmp->cMPitch; + tmp->allocsize = (int)tmp->columns * tmp->pitch; + tmp->baseIndex = params->firstIndex; + //fprintf(stderr,"allocDnsDevice: %d %d %d \n",tmp->pitch, params->maxRowSize, params->avgRowSize); + if (params->elementType == SPGPU_TYPE_FLOAT) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(float)); + else if (params->elementType == SPGPU_TYPE_DOUBLE) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(double)); + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuFloatComplex)); + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuDoubleComplex)); + else + return SPGPU_UNSUPPORTED; // Unsupported params + //fprintf(stderr,"From allocDnsDevice: %d %d %d %p %p %p\n",tmp->maxRowSize, + // tmp->avgRowSize,tmp->allocsize,tmp->rS,tmp->rP,tmp->cM); + + return SPGPU_SUCCESS; +} + +void freeDnsDevice(void* remoteMatrix) +{ + struct DnsDevice *devMat = (struct DnsDevice *) remoteMatrix; + //fprintf(stderr,"freeDnsDevice\n"); + if (devMat != NULL) { + freeRemoteBuffer(devMat->cM); + free(remoteMatrix); + } +} + +//new +int FallocDnsDevice(void** deviceMat, unsigned int rows, + unsigned int columns, unsigned int elementType, + unsigned int firstIndex) +{ int i; +#ifdef HAVE_SPGPU + DnsDeviceParams p; + + p = getDnsDeviceParams(rows, columns, elementType, firstIndex); + i = allocDnsDevice(deviceMat, &p); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocDnsDevice",i); + } + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int spmvDnsDeviceFloat(char transa, int m, int n, int k, float *alpha, + void *deviceMat, void* deviceX, float *beta, void* deviceY) +{ + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + int status; +#ifdef HAVE_SPGPU + + cublasHandle_t handle=psb_gpuGetCublasHandle(); + cublasOperation_t trans=((transa == 'N')? CUBLAS_OP_N:((transa=='T')? CUBLAS_OP_T:CUBLAS_OP_C)); + /* Note: the M,N,K choices according to TRANS have already been handled in the caller */ + if (n == 1) { + status = cublasSgemv(handle, trans, m,k, + alpha, devMat->cM,devMat->pitch, x->v_,1, + beta, y->v_,1); + } else { + status = cublasSgemm(handle, trans, CUBLAS_OP_N, m,n,k, + alpha, devMat->cM,devMat->pitch, x->v_,x->pitch_, + beta, y->v_,y->pitch_); + } + + if (status == CUBLAS_STATUS_SUCCESS) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvDnsDeviceDouble(char transa, int m, int n, int k, double *alpha, + void *deviceMat, void* deviceX, double *beta, void* deviceY) +{ + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + int status; +#ifdef HAVE_SPGPU + + cublasHandle_t handle=psb_gpuGetCublasHandle(); + cublasOperation_t trans=((transa == 'N')? CUBLAS_OP_N:((transa=='T')? CUBLAS_OP_T:CUBLAS_OP_C)); + /* Note: the M,N,K choices according to TRANS have already been handled in the caller */ + if (n == 1) { + status = cublasDgemv(handle, trans, m,k, + alpha, devMat->cM,devMat->pitch, x->v_,1, + beta, y->v_,1); + } else { + status = cublasDgemm(handle, trans, CUBLAS_OP_N, m,n,k, + alpha, devMat->cM,devMat->pitch, x->v_,x->pitch_, + beta, y->v_,y->pitch_); + } + + if (status == CUBLAS_STATUS_SUCCESS) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvDnsDeviceFloatComplex(char transa, int m, int n, int k, float complex *alpha, + void *deviceMat, void* deviceX, float complex *beta, void* deviceY) +{ + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + int status; +#ifdef HAVE_SPGPU + + cublasHandle_t handle=psb_gpuGetCublasHandle(); + cublasOperation_t trans=((transa == 'N')? CUBLAS_OP_N:((transa=='T')? CUBLAS_OP_T:CUBLAS_OP_C)); + /* Note: the M,N,K choices according to TRANS have already been handled in the caller */ + if (n == 1) { + status = cublasCgemv(handle, trans, m,k, + alpha, devMat->cM,devMat->pitch, x->v_,1, + beta, y->v_,1); + } else { + status = cublasCgemm(handle, trans, CUBLAS_OP_N, m,n,k, + alpha, devMat->cM,devMat->pitch, x->v_,x->pitch_, + beta, y->v_,y->pitch_); + } + + if (status == CUBLAS_STATUS_SUCCESS) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvDnsDeviceDoubleComplex(char transa, int m, int n, int k, double complex *alpha, + void *deviceMat, void* deviceX, double complex *beta, void* deviceY) +{ + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + int status; +#ifdef HAVE_SPGPU + + cublasHandle_t handle=psb_gpuGetCublasHandle(); + cublasOperation_t trans=((transa == 'N')? CUBLAS_OP_N:((transa=='T')? CUBLAS_OP_T:CUBLAS_OP_C)); + /* Note: the M,N,K choices according to TRANS have already been handled in the caller */ + if (n == 1) { + status = cublasZgemv(handle, trans, m,k, + alpha, devMat->cM,devMat->pitch, x->v_,1, + beta, y->v_,1); + } else { + status = cublasZgemm(handle, trans, CUBLAS_OP_N, m,n,k, + alpha, devMat->cM,devMat->pitch, x->v_,x->pitch_, + beta, y->v_,y->pitch_); + } + + if (status == CUBLAS_STATUS_SUCCESS) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int writeDnsDeviceFloat(void* deviceMat, float* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasSetMatrix(lda,nc,sizeof(float), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeDnsDeviceFloat",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeDnsDeviceDouble(void* deviceMat, double* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasSetMatrix(lda,nc,sizeof(double), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeDnsDeviceDouble",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int writeDnsDeviceFloatComplex(void* deviceMat, float complex* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasSetMatrix(lda,nc,sizeof(cuFloatComplex), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeDnsDeviceFloatComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeDnsDeviceDoubleComplex(void* deviceMat, double complex* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasSetMatrix(lda,nc,sizeof(cuDoubleComplex), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeDnsDeviceDoubleComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int readDnsDeviceFloat(void* deviceMat, float* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasGetMatrix(lda,nc,sizeof(float), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readDnsDeviceFloat",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readDnsDeviceDouble(void* deviceMat, double* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasGetMatrix(lda,nc,sizeof(double), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readDnsDeviceDouble",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int readDnsDeviceFloatComplex(void* deviceMat, float complex* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasGetMatrix(lda,nc,sizeof(cuFloatComplex), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readDnsDeviceFloatComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readDnsDeviceDoubleComplex(void* deviceMat, double complex* val, int lda, int nc) +{ int i; +#ifdef HAVE_SPGPU + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; + int pitch=devMat->pitch; + i = cublasGetMatrix(lda,nc,sizeof(cuDoubleComplex), (void*) val,lda, (void *)devMat->cM, pitch); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readDnsDeviceDoubleComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int getDnsDevicePitch(void* deviceMat) +{ int i; + struct DnsDevice *devMat = (struct DnsDevice *) deviceMat; +#ifdef HAVE_SPGPU + i = devMat->pitch; + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + +#endif + diff --git a/gpu/dnsdev.h b/gpu/dnsdev.h new file mode 100644 index 000000000..7c8b06c9e --- /dev/null +++ b/gpu/dnsdev.h @@ -0,0 +1,122 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _DNSDEV_H_ +#define _DNSDEV_H_ + +#if defined(HAVE_SPGPU) +#include "cintrf.h" +#include "cuComplex.h" +#include "cublas_v2.h" + + +struct DnsDevice +{ + // Compressed matrix + void *cM; //it can be float or double + + + //matrix size (uncompressed) + int rows; + int columns; + + int pitch; //old + + int cMPitch; + + //allocation size (in elements) + int allocsize; + + /*(i.e. 0 for C, 1 for Fortran)*/ + int baseIndex; +}; + +typedef struct DnsDeviceParams +{ + // The resulting allocation for cM and rP will be pitch*maxRowSize*(size of the elementType) + unsigned int elementType; + + // Pitch (in number of elements) + unsigned int pitch; + + // Number of rows. + // Used to allocate rS array + unsigned int rows; + + // Number of columns. + // Used for error-checking + unsigned int columns; + + // First index (e.g 0 or 1) + unsigned int firstIndex; +} DnsDeviceParams; + +int FallocDnsDevice(void** deviceMat, unsigned int rows, + unsigned int columns, unsigned int elementType, + unsigned int firstIndex); +int allocDnsDevice(void ** remoteMatrix, DnsDeviceParams* params); +void freeDnsDevice(void* remoteMatrix); + +int writeDnsDeviceFloat(void* deviceMat, float* val, int lda, int nc); +int writeDnsDeviceDouble(void* deviceMat, double* val, int lda, int nc); +int writeDnsDeviceFloatComplex(void* deviceMat, float complex* val, int lda, int nc); +int writeDnsDeviceDoubleComplex(void* deviceMat, double complex* val, int lda, int nc); + +int readDnsDeviceFloat(void* deviceMat, float* val, int lda, int nc); +int readDnsDeviceDouble(void* deviceMat, double* val, int lda, int nc); +int readDnsDeviceFloatComplex(void* deviceMat, float complex* val, int lda, int nc); +int readDnsDeviceDoubleComplex(void* deviceMat, double complex* val, int lda, int nc); + +int spmvDnsDeviceFloat(char transa, int m, int n, int k, + float *alpha, void *deviceMat, void* deviceX, + float *beta, void* deviceY); +int spmvDnsDeviceDouble(char transa, int m, int n, int k, + double *alpha, void *deviceMat, void* deviceX, + double *beta, void* deviceY); +int spmvDnsDeviceFloatComplex(char transa, int m, int n, int k, + float complex *alpha, void *deviceMat, void* deviceX, + float complex *beta, void* deviceY); +int spmvDnsDeviceDoubleComplex(char transa, int m, int n, int k, + double complex *alpha, void *deviceMat, void* deviceX, + double complex *beta, void* deviceY); + +int getDnsDevicePitch(void* deviceMat); + +// sparse Dns matrix-vector product +//int spmvDnsDeviceFloat(void *deviceMat, float* alpha, void* deviceX, float* beta, void* deviceY); +//int spmvDnsDeviceDouble(void *deviceMat, double* alpha, void* deviceX, double* beta, void* deviceY); + +#else +#define CINTRF_UNSUPPORTED -1 +#endif + +#endif diff --git a/gpu/dnsdev_mod.F90 b/gpu/dnsdev_mod.F90 new file mode 100644 index 000000000..8b96b9185 --- /dev/null +++ b/gpu/dnsdev_mod.F90 @@ -0,0 +1,275 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 dnsdev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: dnsdev_parms + integer(c_int) :: element_type + integer(c_int) :: pitch + integer(c_int) :: rows + integer(c_int) :: columns + integer(c_int) :: maxRowSize + integer(c_int) :: avgRowSize + integer(c_int) :: firstIndex + end type dnsdev_parms + +#ifdef HAVE_SPGPU + + interface + function FgetDnsDeviceParams(rows, columns, elementType, firstIndex) & + & result(res) bind(c,name='getDnsDeviceParams') + use iso_c_binding + import :: dnsdev_parms + type(dnsdev_parms) :: res + integer(c_int), value :: rows,columns,elementType,firstIndex + end function FgetDnsDeviceParams + end interface + + + interface + function FallocDnsDevice(deviceMat,rows,columns,& + & elementType,firstIndex) & + & result(res) bind(c,name='FallocDnsDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: rows,columns,elementType,firstIndex + type(c_ptr) :: deviceMat + end function FallocDnsDevice + end interface + + + interface writeDnsDevice + + function writeDnsDeviceFloat(deviceMat,val,lda,nc) & + & result(res) bind(c,name='writeDnsDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + real(c_float) :: val(lda,*) + end function writeDnsDeviceFloat + + + function writeDnsDeviceDouble(deviceMat,val,lda,nc) & + & result(res) bind(c,name='writeDnsDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + real(c_double) :: val(lda,*) + end function writeDnsDeviceDouble + + + function writeDnsDeviceFloatComplex(deviceMat,val,lda,nc) & + & result(res) bind(c,name='writeDnsDeviceFloatComple') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + complex(c_float_complex) :: val(lda,*) + end function writeDnsDeviceFloatComplex + + + function writeDnsDeviceDoubleComplex(deviceMat,val,lda,nc) & + & result(res) bind(c,name='writeDnsDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + complex(c_double_complex) :: val(lda,*) + end function writeDnsDeviceDoubleComplex + + end interface + + interface readDnsDevice + + function readDnsDeviceFloat(deviceMat,val,lda,nc) & + & result(res) bind(c,name='readDnsDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + real(c_float) :: val(lda,*) + end function readDnsDeviceFloat + + + function readDnsDeviceDouble(deviceMat,val,lda,nc) & + & result(res) bind(c,name='readDnsDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + real(c_double) :: val(lda,*) + end function readDnsDeviceDouble + + + function readDnsDeviceFloatComplex(deviceMat,val,lda,nc) & + & result(res) bind(c,name='readDnsDeviceFloatComple') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + complex(c_float_complex) :: val(lda,*) + end function readDnsDeviceFloatComplex + + + function readDnsDeviceDoubleComplex(deviceMat,val,lda,nc) & + & result(res) bind(c,name='readDnsDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: lda,nc + complex(c_double_complex) :: val(lda,*) + end function readDnsDeviceDoubleComplex + + end interface + + interface + subroutine freeDnsDevice(deviceMat) & + & bind(c,name='freeDnsDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine freeDnsDevice + end interface + + interface + subroutine resetDnsTimer() bind(c,name='resetDnsTimer') + use iso_c_binding + end subroutine resetDnsTimer + end interface + interface + function getDnsTimer() & + & bind(c,name='getDnsTimer') result(res) + use iso_c_binding + real(c_double) :: res + end function getDnsTimer + end interface + + + interface + function getDnsDevicePitch(deviceMat) & + & bind(c,name='getDnsDevicePitch') result(res) + use iso_c_binding + type(c_ptr), value :: deviceMat + integer(c_int) :: res + end function getDnsDevicePitch + end interface + +!!$ interface csputDnsDeviceFloat +!!$ function dev_csputDnsDeviceFloat(deviceMat, nnz, ia, ja, val) & +!!$ & result(res) bind(c,name='dev_csputDnsDeviceFloat') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat , ia, ja, val +!!$ integer(c_int), value :: nnz +!!$ end function dev_csputDnsDeviceFloat +!!$ end interface +!!$ +!!$ interface csputDnsDeviceDouble +!!$ function dev_csputDnsDeviceDouble(deviceMat, nnz, ia, ja, val) & +!!$ & result(res) bind(c,name='dev_csputDnsDeviceDouble') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat , ia, ja, val +!!$ integer(c_int), value :: nnz +!!$ end function dev_csputDnsDeviceDouble +!!$ end interface +!!$ +!!$ interface csputDnsDeviceFloatComplex +!!$ function dev_csputDnsDeviceFloatComplex(deviceMat, nnz, ia, ja, val) & +!!$ & result(res) bind(c,name='dev_csputDnsDeviceFloatComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat , ia, ja, val +!!$ integer(c_int), value :: nnz +!!$ end function dev_csputDnsDeviceFloatComplex +!!$ end interface +!!$ +!!$ interface csputDnsDeviceDoubleComplex +!!$ function dev_csputDnsDeviceDoubleComplex(deviceMat, nnz, ia, ja, val) & +!!$ & result(res) bind(c,name='dev_csputDnsDeviceDoubleComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat , ia, ja, val +!!$ integer(c_int), value :: nnz +!!$ end function dev_csputDnsDeviceDoubleComplex +!!$ end interface + + interface spmvDnsDevice + function spmvDnsDeviceFloat(transa,m,n,k,alpha,deviceMat,x,beta,y) & + & result(res) bind(c,name='spmvDnsDeviceFloat') + use iso_c_binding + character(c_char), value :: transa + integer(c_int), value :: m, n, k + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_float) :: alpha, beta + end function spmvDnsDeviceFloat + + function spmvDnsDeviceDouble(transa,m,n,k,alpha,deviceMat,x,beta,y) & + & result(res) bind(c,name='spmvDnsDeviceDouble') + use iso_c_binding + character(c_char), value :: transa + integer(c_int), value :: m, n, k + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_double) :: alpha, beta + end function spmvDnsDeviceDouble + + function spmvDnsDeviceFloatComplex(transa,m,n,k,alpha,deviceMat,x,beta,y) & + & result(res) bind(c,name='spmvDnsDeviceFloatComplex') + use iso_c_binding + character(c_char), value :: transa + integer(c_int), value :: m, n, k + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_float_complex) :: alpha, beta + end function spmvDnsDeviceFloatComplex + + function spmvDnsDeviceDoubleComplex(transa,m,n,k,alpha,deviceMat,x,beta,y) & + & result(res) bind(c,name='spmvDnsDeviceDoubleComplex') + use iso_c_binding + character(c_char), value :: transa + integer(c_int), value :: m, n, k + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_double_complex) :: alpha, beta + end function spmvDnsDeviceDoubleComplex + + end interface + +#endif + + +end module dnsdev_mod diff --git a/gpu/dvectordev.c b/gpu/dvectordev.c new file mode 100644 index 000000000..8b020c16d --- /dev/null +++ b/gpu/dvectordev.c @@ -0,0 +1,305 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +//#include "utils.h" +//#include "common.h" +#include "dvectordev.h" + + +int registerMappedDouble(void *buff, void **d_p, int n, double dummy) +{ + return registerMappedMemory(buff,d_p,n*sizeof(double)); +} + +int writeMultiVecDeviceDouble(void* deviceVec, double* hostVec) +{ int i; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + // Ex updateFromHost vector function + i = writeRemoteBuffer((void*) hostVec, (void *)devVec->v_, devVec->pitch_*devVec->count_*sizeof(double)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocMultiVecDevice",i); + } + return(i); +} + +int writeMultiVecDeviceDoubleR2(void* deviceVec, double* hostVec, int ld) +{ int i; + i = writeMultiVecDeviceDouble(deviceVec, (void *) hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeMultiVecDeviceDoubleR2",i); + } + return(i); +} + +int readMultiVecDeviceDouble(void* deviceVec, double* hostVec) +{ int i,j; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = readRemoteBuffer((void *) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(double)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceDouble",i); + } + return(i); +} + +int readMultiVecDeviceDoubleR2(void* deviceVec, double* hostVec, int ld) +{ int i; + i = readMultiVecDeviceDouble(deviceVec, hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceDoubleR2",i); + } + return(i); +} + +int setscalMultiVecDeviceDouble(double val, int first, int last, + int indexBase, void* devMultiVecX) +{ int i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuDsetscal(handle, first, last, indexBase, val, (double *) devVecX->v_); + + return(i); +} + + +int geinsMultiVecDeviceDouble(int n, void* devMultiVecIrl, void* devMultiVecVal, + int dupl, int indexBase, void* devMultiVecX) +{ int j=0, i=0,nmin=0,nmax=0; + int pitch = 0; + double beta; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecIrl = (struct MultiVectDevice *) devMultiVecIrl; + struct MultiVectDevice *devVecVal = (struct MultiVectDevice *) devMultiVecVal; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecIrl->pitch_; + if ((n > devVecIrl->size_) || (n>devVecVal->size_ )) + return SPGPU_UNSUPPORTED; + + //fprintf(stderr,"geins: %d %d %p %p %p\n",dupl,n,devVecIrl->v_,devVecVal->v_,devVecX->v_); + + if (dupl == INS_OVERWRITE) + beta = 0.0; + else if (dupl == INS_ADD) + beta = 1.0; + else + beta = 0.0; + + spgpuDscat(handle, (double *) devVecX->v_, n, (double*)devVecVal->v_, + (int*)devVecIrl->v_, indexBase, beta); + + return(i); +} + + +int igathMultiVecDeviceDoubleVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + + i= igathMultiVecDeviceDouble(deviceVec, vectorId, n, + first, (void*) devIdx->v_, hfirst, host_values, indexBase); + return(i); +} + +int igathMultiVecDeviceDouble(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, int indexBase) +{ + int i, *idx =(int *) indexes;; + double *hv = (double *) host_values;; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + i=0; + hv = &(hv[hfirst-indexBase]); + idx = &(idx[first-indexBase]); + spgpuDgath(handle,hv, n, idx,indexBase, (double *) devVec->v_+vectorId*devVec->pitch_); + return(i); +} + +int iscatMultiVecDeviceDoubleVecIdx(void* deviceVec, int vectorId, int n, int first, void *deviceIdx, + int hfirst, void* host_values, int indexBase, double beta) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + i= iscatMultiVecDeviceDouble(deviceVec, vectorId, n, first, + (void*) devIdx->v_, hfirst,host_values, indexBase, beta); + return(i); +} + +int iscatMultiVecDeviceDouble(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, double beta) +{ int i=0; + double *hv = (double *) host_values; + int *idx=(int *) indexes; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + idx = &(idx[first-indexBase]); + hv = &(hv[hfirst-indexBase]); + spgpuDscat(handle, (double *) devVec->v_, n, hv, idx, indexBase, beta); + return SPGPU_SUCCESS; + +} + +int scalMultiVecDeviceDouble(double alpha, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + // Note: inner kernel can handle aliased input/output + spgpuDscal(handle, (double *)devVecA->v_, devVecA->pitch_, + alpha, (double *)devVecA->v_); + return(i); +} + +int nrm2MultiVecDeviceDouble(double* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuDmnrm2(handle, y_res, n,(double *)devVecA->v_, devVecA->count_, devVecA->pitch_); + return(i); +} + +int amaxMultiVecDeviceDouble(double* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuDmamax(handle, y_res, n,(double *)devVecA->v_, devVecA->count_, devVecA->pitch_); + return(i); +} + +int asumMultiVecDeviceDouble(double* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuDmasum(handle, y_res, n,(double *)devVecA->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int dotMultiVecDeviceDouble(double* y_res, int n, void* devMultiVecA, void* devMultiVecB) +{int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) devMultiVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuDmdot(handle, y_res, n, (double*)devVecA->v_, (double*)devVecB->v_,devVecA->count_,devVecB->pitch_); + return(i); +} + +int axpbyMultiVecDeviceDouble(int n,double alpha, void* devMultiVecX, + double beta, void* devMultiVecY) +{ int j=0, i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecY = (struct MultiVectDevice *) devMultiVecY; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecY->pitch_; + if ((n > devVecY->size_) || (n>devVecX->size_ )) + return SPGPU_UNSUPPORTED; + + for(j=0;jcount_;j++) + spgpuDaxpby(handle,(double*)devVecY->v_+pitch*j, n, beta, + (double*)devVecY->v_+pitch*j, alpha,(double*) devVecX->v_+pitch*j); + return(i); +} + +int axyMultiVecDeviceDouble(int n, double alpha, void *deviceVecA, void *deviceVecB) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuDmaxy(handle, (double*)devVecB->v_, n, alpha, (double*)devVecA->v_, + (double*)devVecB->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int axybzMultiVecDeviceDouble(int n, double alpha, void *deviceVecA, + void *deviceVecB, double beta, void *deviceVecZ) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + struct MultiVectDevice *devVecZ = (struct MultiVectDevice *) deviceVecZ; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ ) || (n>devVecZ->size_ )) + return SPGPU_UNSUPPORTED; + spgpuDmaxypbz(handle, (double*)devVecZ->v_, n, beta, (double*)devVecZ->v_, + alpha, (double*) devVecA->v_, (double*) devVecB->v_, + devVecB->count_, devVecB->pitch_); + return(i); +} + +int absMultiVecDeviceDouble2(int n, double alpha, void *deviceVecA, + void *deviceVecB) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuDabs(handle, (double*)devVecB->v_, n, alpha, (double*)devVecA->v_); + + return(i); +} + +int absMultiVecDeviceDouble(int n, double alpha, void *deviceVecA) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + spgpuHandle_t handle=psb_gpuGetHandle(); + if (n > devVecA->size_) + return SPGPU_UNSUPPORTED; + + spgpuDabs(handle, (double*)devVecA->v_, n, alpha, (double*)devVecA->v_); + + return(i); +} + + +#endif + diff --git a/gpu/dvectordev.h b/gpu/dvectordev.h new file mode 100644 index 000000000..960958c5c --- /dev/null +++ b/gpu/dvectordev.h @@ -0,0 +1,78 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +int registerMappedDouble(void *, void **, int, double); +int writeMultiVecDeviceDouble(void* deviceMultiVec, double* hostMultiVec); +int writeMultiVecDeviceDoubleR2(void* deviceMultiVec, double* hostMultiVec, int ld); +int readMultiVecDeviceDouble(void* deviceMultiVec, double* hostMultiVec); +int readMultiVecDeviceDoubleR2(void* deviceMultiVec, double* hostMultiVec, int ld); + +int setscalMultiVecDeviceDouble(double val, int first, int last, + int indexBase, void* devVecX); + +int geinsMultiVecDeviceDouble(int n, void* devVecIrl, void* devVecVal, + int dupl, int indexBase, void* devVecX); + +int igathMultiVecDeviceDoubleVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase); +int igathMultiVecDeviceDouble(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, + int indexBase); +int iscatMultiVecDeviceDoubleVecIdx(void* deviceVec, int vectorId, int n, int first, + void *deviceIdx, int hfirst, void* host_values, + int indexBase, double beta); +int iscatMultiVecDeviceDouble(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, double beta); + +int scalMultiVecDeviceDouble(double alpha, void* devMultiVecA); +int nrm2MultiVecDeviceDouble(double* y_res, int n, void* devVecA); +int amaxMultiVecDeviceDouble(double* y_res, int n, void* devVecA); +int asumMultiVecDeviceDouble(double* y_res, int n, void* devVecA); +int dotMultiVecDeviceDouble(double* y_res, int n, void* devVecA, void* devVecB); + +int axpbyMultiVecDeviceDouble(int n, double alpha, void* devVecX, double beta, void* devVecY); +int axyMultiVecDeviceDouble(int n, double alpha, void *deviceVecA, void *deviceVecB); +int axybzMultiVecDeviceDouble(int n, double alpha, void *deviceVecA, + void *deviceVecB, double beta, void *deviceVecZ); +int absMultiVecDeviceDouble(int n, double alpha, void *deviceVecA); +int absMultiVecDeviceDouble2(int n, double alpha, void *deviceVecA, void *deviceVecB); + + +#endif diff --git a/gpu/elldev.c b/gpu/elldev.c new file mode 100644 index 000000000..8fd7aeb55 --- /dev/null +++ b/gpu/elldev.c @@ -0,0 +1,773 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "elldev.h" + +#if defined(HAVE_SPGPU) + +#define PASS_RS 0 + +EllDeviceParams getEllDeviceParams(unsigned int rows, unsigned int maxRowSize, + unsigned int nnzeros, + unsigned int columns, unsigned int elementType, + unsigned int firstIndex) +{ + EllDeviceParams params; + + if (elementType == SPGPU_TYPE_DOUBLE) + { + params.pitch = ((rows + ELL_PITCH_ALIGN_D - 1)/ELL_PITCH_ALIGN_D)*ELL_PITCH_ALIGN_D; + } + else + { + params.pitch = ((rows + ELL_PITCH_ALIGN_S - 1)/ELL_PITCH_ALIGN_S)*ELL_PITCH_ALIGN_S; + } + //For complex? + params.elementType = elementType; + + params.rows = rows; + params.maxRowSize = maxRowSize; + params.avgRowSize = (nnzeros+rows-1)/rows; + params.columns = columns; + params.firstIndex = firstIndex; + + //params.pitch = computeEllAllocPitch(rows); + + return params; + +} +//new +int allocEllDevice(void ** remoteMatrix, EllDeviceParams* params) +{ + struct EllDevice *tmp = (struct EllDevice *)malloc(sizeof(struct EllDevice)); + *remoteMatrix = (void *)tmp; + tmp->rows = params->rows; + tmp->cMPitch = computeEllAllocPitch(tmp->rows); + tmp->rPPitch = tmp->cMPitch; + tmp->pitch= tmp->cMPitch; + tmp->maxRowSize = params->maxRowSize; + tmp->avgRowSize = params->avgRowSize; + tmp->allocsize = (int)tmp->maxRowSize * tmp->pitch; + //tmp->allocsize = (int)params->maxRowSize * tmp->cMPitch; + allocRemoteBuffer((void **)&(tmp->rS), tmp->rows*sizeof(int)); + allocRemoteBuffer((void **)&(tmp->diag), tmp->rows*sizeof(int)); + allocRemoteBuffer((void **)&(tmp->rP), tmp->allocsize*sizeof(int)); + tmp->columns = params->columns; + tmp->baseIndex = params->firstIndex; + tmp->dataType = params->elementType; + //fprintf(stderr,"allocEllDevice: %d %d %d \n",tmp->pitch, params->maxRowSize, params->avgRowSize); + if (params->elementType == SPGPU_TYPE_FLOAT) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(float)); + else if (params->elementType == SPGPU_TYPE_DOUBLE) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(double)); + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuFloatComplex)); + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuDoubleComplex)); + else + return SPGPU_UNSUPPORTED; // Unsupported params + //fprintf(stderr,"From allocEllDevice: %d %d %d %p %p %p\n",tmp->maxRowSize, + // tmp->avgRowSize,tmp->allocsize,tmp->rS,tmp->rP,tmp->cM); + + return SPGPU_SUCCESS; +} + +//new +void zeroEllDevice(void *remoteMatrix) +{ + struct EllDevice *tmp = (struct EllDevice *) remoteMatrix; + + if (tmp->dataType == SPGPU_TYPE_FLOAT) + cudaMemset((void *)tmp->cM, 0, tmp->allocsize*sizeof(float)); + else if (tmp->dataType == SPGPU_TYPE_DOUBLE) + cudaMemset((void *)tmp->cM, 0, tmp->allocsize*sizeof(double)); + else if (tmp->dataType == SPGPU_TYPE_COMPLEX_FLOAT) + cudaMemset((void *)tmp->cM, 0, tmp->allocsize*sizeof(cuFloatComplex)); + else if (tmp->dataType == SPGPU_TYPE_COMPLEX_DOUBLE) + cudaMemset((void *)tmp->cM, 0, tmp->allocsize*sizeof(cuDoubleComplex)); + else + return SPGPU_UNSUPPORTED; // Unsupported params + //fprintf(stderr,"From allocEllDevice: %d %d %d %p %p %p\n",tmp->maxRowSize, + // tmp->avgRowSize,tmp->allocsize,tmp->rS,tmp->rP,tmp->cM); + + return; +} + + +void freeEllDevice(void* remoteMatrix) +{ + struct EllDevice *devMat = (struct EllDevice *) remoteMatrix; + //fprintf(stderr,"freeEllDevice\n"); + if (devMat != NULL) { + freeRemoteBuffer(devMat->rS); + freeRemoteBuffer(devMat->rP); + freeRemoteBuffer(devMat->cM); + free(remoteMatrix); + } +} + +//new +int FallocEllDevice(void** deviceMat,unsigned int rows, unsigned int maxRowSize, + unsigned int nnzeros, + unsigned int columns, unsigned int elementType, + unsigned int firstIndex) +{ int i; +#ifdef HAVE_SPGPU + EllDeviceParams p; + + p = getEllDeviceParams(rows, maxRowSize, nnzeros, columns, elementType, firstIndex); + i = allocEllDevice(deviceMat, &p); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocEllDevice",i); + } + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + +void sspmdmm_gpu(float *z,int s, int vPitch, float *y, float alpha, float* cM, int* rP, int* rS, + int avgRowSize, int maxRowSize, int rows, int pitch, float *x, float beta, int firstIndex) +{ + int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + + for (i=0; icount_ == x->count_, "ERROR: x and y don't share the same number of vectors"); + __assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)"); + __assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)"); +#endif + /*spgpuSellspmv (handle, (float*) y->v_, (float*)y->v_, alpha, + (float*) devMat->cM, devMat->rP, devMat->cMPitch, + devMat->rPPitch, devMat->rS, devMat->rows, + (float*)x->v_, beta, devMat->baseIndex);*/ + sspmdmm_gpu ( (float *)y->v_,y->count_, y->pitch_, (float *)y->v_, alpha, (float *)devMat->cM, devMat->rP, devMat->rS, + devMat->avgRowSize, devMat->maxRowSize, devMat->rows, devMat->pitch, + (float *)x->v_, beta, devMat->baseIndex); + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +void +dspmdmm_gpu (double *z,int s, int vPitch, double *y, double alpha, double* cM, int* rP, + int* rS, int avgRowSize, int maxRowSize, int rows, int pitch, + double *x, double beta, int firstIndex) +{ + int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + for (i=0; iv_, (double*)y->v_, alpha, (double*) devMat->cM, devMat->rP, devMat->cMPitch, devMat->rPPitch, devMat->rS, devMat->rows, (double*)x->v_, beta, devMat->baseIndex);*/ + /* fprintf(stderr,"From spmvEllDouble: mat %d %d %d %d y %d %d \n", */ + /* devMat->avgRowSize, devMat->maxRowSize, devMat->rows, */ + /* devMat->pitch, y->count_, y->pitch_); */ + dspmdmm_gpu ((double *)y->v_, y->count_, y->pitch_, (double *)y->v_, + alpha, (double *)devMat->cM, + devMat->rP, devMat->rS, devMat->avgRowSize, + devMat->maxRowSize, devMat->rows, devMat->pitch, + (double *)x->v_, beta, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +void +cspmdmm_gpu (cuFloatComplex *z, int s, int vPitch, cuFloatComplex *y, + cuFloatComplex alpha, cuFloatComplex* cM, + int* rP, int* rS, int avgRowSize, int maxRowSize, int rows, int pitch, + cuFloatComplex *x, cuFloatComplex beta, int firstIndex) +{ + int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + for (i=0; iv_, y->count_, y->pitch_, (cuFloatComplex *)y->v_, a, (cuFloatComplex *)devMat->cM, + devMat->rP, devMat->rS, devMat->avgRowSize, devMat->maxRowSize, devMat->rows, devMat->pitch, + (cuFloatComplex *)x->v_, b, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +void +zspmdmm_gpu (cuDoubleComplex *z, int s, int vPitch, cuDoubleComplex *y, cuDoubleComplex alpha, cuDoubleComplex* cM, + int* rP, int* rS, int avgRowSize, int maxRowSize, int rows, int pitch, + cuDoubleComplex *x, cuDoubleComplex beta, int firstIndex) +{ + int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + for (i=0; iv_, y->count_, y->pitch_, (cuDoubleComplex *)y->v_, a, (cuDoubleComplex *)devMat->cM, + devMat->rP, devMat->rS, devMat->avgRowSize, devMat->maxRowSize, devMat->rows, + devMat->pitch, (cuDoubleComplex *)x->v_, b, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeEllDeviceFloat(void* deviceMat, float* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(float)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + //i = writeEllDevice(deviceMat, (void *) val, ja, irn); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeEllDeviceDouble(void* deviceMat, double* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(double)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeEllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuFloatComplex)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeEllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuDoubleComplex)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readEllDeviceFloat(void* deviceMat, float* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(float)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + /*i = readEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readEllDeviceDouble(void* deviceMat, double* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(double)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readEllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuFloatComplex)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readEllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int ldj, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuDoubleComplex)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int getEllDevicePitch(void* deviceMat) +{ int i; + struct EllDevice *devMat = (struct EllDevice *) deviceMat; +#ifdef HAVE_SPGPU + i = devMat->pitch; //old + //i = getPitchEllDevice(deviceMat); + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int getEllDeviceMaxRowSize(void* deviceMat) +{ int i; + struct EllDevice *devMat = (struct EllDevice *) deviceMat; +#ifdef HAVE_SPGPU + i = devMat->maxRowSize; + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + + +// New copying interface + +int psiCopyCooToElgFloat(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, float *val, void *deviceMat) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + float *devVal; + int *devIdisp, *devJa; + spgpuHandle_t handle; + handle = psb_gpuGetHandle(); + + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(float)); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(float)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + + if (i==0) psi_cuda_s_CopyCooToElg(handle,nr,nc,nza,devMat->baseIndex,hacksz,ldv,nzm, + (int *) devMat->rS,devIdisp,devJa,devVal, + (int *) devMat->diag, (int *) devMat->rP, (float *)devMat->cM); + // Ex updateFromHost function + //i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(float)); + //if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + //if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceFloat",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + +int psiCopyCooToElgDouble(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, double *val, void *deviceMat) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + double *devVal; + int *devIdisp, *devJa; + spgpuHandle_t handle; + handle = psb_gpuGetHandle(); + + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(double)); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(double)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + + if (i==0) psi_cuda_d_CopyCooToElg(handle,nr,nc,nza,devMat->baseIndex,hacksz,ldv,nzm, + (int *) devMat->rS,devIdisp,devJa,devVal, + (int *) devMat->diag, (int *) devMat->rP, (double *)devMat->cM); + // Ex updateFromHost function + //i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(double)); + //if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + //if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int psiCopyCooToElgFloatComplex(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, float complex *val, void *deviceMat) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + float complex *devVal; + int *devIdisp, *devJa; + spgpuHandle_t handle; + handle = psb_gpuGetHandle(); + + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(cuFloatComplex)); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(cuFloatComplex)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + + if (i==0) psi_cuda_c_CopyCooToElg(handle,nr,nc,nza,devMat->baseIndex,hacksz,ldv,nzm, + (int *) devMat->rS,devIdisp,devJa,devVal, + (int *) devMat->diag,(int *) devMat->rP, (float complex *)devMat->cM); + // Ex updateFromHost function + //i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(float complex)); + //if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + //if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceFloatComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + +int psiCopyCooToElgDoubleComplex(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, double complex *val, void *deviceMat) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + double complex *devVal; + int *devIdisp, *devJa; + spgpuHandle_t handle; + handle = psb_gpuGetHandle(); + + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(cuDoubleComplex)); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(cuDoubleComplex)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + + if (i==0) psi_cuda_z_CopyCooToElg(handle,nr,nc,nza,devMat->baseIndex,hacksz,ldv,nzm, + (int *) devMat->rS,devIdisp,devJa,devVal, + (int *) devMat->diag,(int *) devMat->rP, (double complex *)devMat->cM); + // Ex updateFromHost function + //i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(double complex)); + //if (i==0) i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + //if (i==0) i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDoubleComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int dev_csputEllDeviceFloat(void* deviceMat, int nnz, void *ia, void *ja, void *val) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + struct MultiVectDevice *devVal = (struct MultiVectDevice *) val; + struct MultiVectDevice *devIa = (struct MultiVectDevice *) ia; + struct MultiVectDevice *devJa = (struct MultiVectDevice *) ja; + float alpha=1.0; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if (nnz <=0) return SPGPU_SUCCESS; + //fprintf(stderr,"Going through csputEllDeviceDouble %d %p %d\n",nnz,devUpdIdx,cnt); + + spgpuSellcsput(handle,alpha,(float *) devMat->cM, + devMat->rP,devMat->pitch, devMat->pitch, devMat->rS, + nnz, devIa->v_, devJa->v_, (float *) devVal->v_, 1); + +#endif + return SPGPU_SUCCESS; +} + +int dev_csputEllDeviceDouble(void* deviceMat, int nnz, void *ia, void *ja, void *val) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + struct MultiVectDevice *devVal = (struct MultiVectDevice *) val; + struct MultiVectDevice *devIa = (struct MultiVectDevice *) ia; + struct MultiVectDevice *devJa = (struct MultiVectDevice *) ja; + double alpha=1.0; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if (nnz <=0) return SPGPU_SUCCESS; + //fprintf(stderr,"Going through csputEllDeviceDouble %d %p %d\n",nnz,devUpdIdx,cnt); + + spgpuDellcsput(handle,alpha,(double *) devMat->cM, + devMat->rP,devMat->pitch, devMat->pitch, devMat->rS, + nnz, devIa->v_, devJa->v_, (double *) devVal->v_, 1); + +#endif + return SPGPU_SUCCESS; +} + + +int dev_csputEllDeviceFloatComplex(void* deviceMat, int nnz, + void *ia, void *ja, void *val) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + struct MultiVectDevice *devVal = (struct MultiVectDevice *) val; + struct MultiVectDevice *devIa = (struct MultiVectDevice *) ia; + struct MultiVectDevice *devJa = (struct MultiVectDevice *) ja; + cuFloatComplex alpha = make_cuFloatComplex(1.0, 0.0); + spgpuHandle_t handle=psb_gpuGetHandle(); + + if (nnz <=0) return SPGPU_SUCCESS; + //fprintf(stderr,"Going through csputEllDeviceDouble %d %p %d\n",nnz,devUpdIdx,cnt); + + spgpuCellcsput(handle,alpha,(cuFloatComplex *) devMat->cM, + devMat->rP,devMat->pitch, devMat->pitch, devMat->rS, + nnz, devIa->v_, devJa->v_, (cuFloatComplex *) devVal->v_, 1); + +#endif + return SPGPU_SUCCESS; +} + +int dev_csputEllDeviceDoubleComplex(void* deviceMat, int nnz, + void *ia, void *ja, void *val) +{ int i; +#ifdef HAVE_SPGPU + struct EllDevice *devMat = (struct EllDevice *) deviceMat; + struct MultiVectDevice *devVal = (struct MultiVectDevice *) val; + struct MultiVectDevice *devIa = (struct MultiVectDevice *) ia; + struct MultiVectDevice *devJa = (struct MultiVectDevice *) ja; + cuDoubleComplex alpha = make_cuDoubleComplex(1.0, 0.0); + spgpuHandle_t handle=psb_gpuGetHandle(); + + if (nnz <=0) return SPGPU_SUCCESS; + //fprintf(stderr,"Going through csputEllDeviceDouble %d %p %d\n",nnz,devUpdIdx,cnt); + + spgpuZellcsput(handle,alpha,(cuDoubleComplex *) devMat->cM, + devMat->rP,devMat->pitch, devMat->pitch, devMat->rS, + nnz, devIa->v_, devJa->v_, (cuDoubleComplex *) devVal->v_, 1); + +#endif + return SPGPU_SUCCESS; +} + +#endif + diff --git a/gpu/elldev.h b/gpu/elldev.h new file mode 100644 index 000000000..6a0814e2a --- /dev/null +++ b/gpu/elldev.h @@ -0,0 +1,183 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _ELLDEV_H_ +#define _ELLDEV_H_ + +#if defined(HAVE_SPGPU) +#include "cintrf.h" +#include "cuComplex.h" +#include "ell.h" + + +struct EllDevice +{ + // Compressed matrix + void *cM; //it can be float or double + + // row pointers (same size of cM) + int *rP; + int *diag; + // row size + int *rS; + + //matrix size (uncompressed) + int rows; + int columns; + + int pitch; //old + + int cMPitch; + + int rPPitch; + + int maxRowSize; + int avgRowSize; + + //allocation size (in elements) + int allocsize; + + /*(i.e. 0 for C, 1 for Fortran)*/ + int baseIndex; + /* real/complex, single/double */ + int dataType; + +}; + +typedef struct EllDeviceParams +{ + // The resulting allocation for cM and rP will be pitch*maxRowSize*(size of the elementType) + unsigned int elementType; + + // Pitch (in number of elements) + unsigned int pitch; + + // Number of rows. + // Used to allocate rS array + unsigned int rows; + + // Number of columns. + // Used for error-checking + unsigned int columns; + + // Largest row size + unsigned int maxRowSize; + unsigned int avgRowSize; + + // First index (e.g 0 or 1) + unsigned int firstIndex; +} EllDeviceParams; + +int FallocEllDevice(void** deviceMat, unsigned int rows, unsigned int maxRowSize, + unsigned int nnzeros, + unsigned int columns, unsigned int elementType, + unsigned int firstIndex); +int allocEllDevice(void ** remoteMatrix, EllDeviceParams* params); +void freeEllDevice(void* remoteMatrix); + +int writeEllDeviceFloat(void* deviceMat, float* val, int* ja, int ldj, int* irn, int *idiag); +int writeEllDeviceDouble(void* deviceMat, double* val, int* ja, int ldj, int* irn, int *idiag); +int writeEllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int ldj, int* irn, int *idiag); +int writeEllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int ldj, int* irn, int *idiag); + +int readEllDeviceFloat(void* deviceMat, float* val, int* ja, int ldj, int* irn, int *idiag); +int readEllDeviceDouble(void* deviceMat, double* val, int* ja, int ldj, int* irn, int *idiag); +int readEllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int ldj, int* irn, int *idiag); +int readEllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int ldj, int* irn, int *idiag); + +int spmvEllDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY); +int spmvEllDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY); +int spmvEllDeviceFloatComplex(void *deviceMat, float complex alpha, void* deviceX, + float complex beta, void* deviceY); +int spmvEllDeviceDoubleComplex(void *deviceMat, double complex alpha, void* deviceX, + double complex beta, void* deviceY); + + + +int psiCopyCooToElgFloat(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, float *val, void *deviceMat); + +int psiCopyCooToElgDouble(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, double *val, void *deviceMat); + +int psiCopyCooToElgFloatComplex(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, float complex *val, void *deviceMat); + +int psiCopyCooToElgDoubleComplex(int nr, int nc, int nza, int hacksz, int ldv, int nzm, int *irn, + int *idisp, int *ja, double complex *val, void *deviceMat); + + +void psi_cuda_s_CopyCooToElg(spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, + int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, float *devVal, + int *idiag, int *rP, float *cM); + +void psi_cuda_d_CopyCooToElg(spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, + int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, double *devVal, + int *idiag, int *rP, double *cM); + +void psi_cuda_c_CopyCooToElg(spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, + int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, float complex *devVal, + int *idiag, int *rP, float complex *cM); + +void psi_cuda_z_CopyCooToElg(spgpuHandle_t handle, int nr, int nc, int nza, int baseIdx, + int hacksz, int ldv, int nzm, + int *rS,int *devIdisp, int *devJa, double complex *devVal, + int *idiag, int *rP, double complex *cM); + + +int dev_csputEllDeviceFloat(void* deviceMat, int nnz, + void *ia, void *ja, void *val); +int dev_csputEllDeviceDouble(void* deviceMat, int nnz, + void *ia, void *ja, void *val); +int dev_csputEllDeviceFloatComplex(void* deviceMat, int nnz, + void *ia, void *ja, void *val); +int dev_csputEllDeviceDoubleComplex(void* deviceMat, int nnz, + void *ia, void *ja, void *val); + +void zeroEllDevice(void* deviceMat); + +int getEllDevicePitch(void* deviceMat); + +// sparse Ell matrix-vector product +//int spmvEllDeviceFloat(void *deviceMat, float* alpha, void* deviceX, float* beta, void* deviceY); +//int spmvEllDeviceDouble(void *deviceMat, double* alpha, void* deviceX, double* beta, void* deviceY); + +#else +#define CINTRF_UNSUPPORTED -1 +#endif + +#endif diff --git a/gpu/elldev_mod.F90 b/gpu/elldev_mod.F90 new file mode 100644 index 000000000..49656d191 --- /dev/null +++ b/gpu/elldev_mod.F90 @@ -0,0 +1,326 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 elldev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: elldev_parms + integer(c_int) :: element_type + integer(c_int) :: pitch + integer(c_int) :: rows + integer(c_int) :: columns + integer(c_int) :: maxRowSize + integer(c_int) :: avgRowSize + integer(c_int) :: firstIndex + end type elldev_parms + +#ifdef HAVE_SPGPU + + interface + function FgetEllDeviceParams(rows, maxRowSize, nnzeros, columns, elementType, firstIndex) & + & result(res) bind(c,name='getEllDeviceParams') + use iso_c_binding + import :: elldev_parms + type(elldev_parms) :: res + integer(c_int), value :: rows,maxRowSize,nnzeros,columns,elementType,firstIndex + end function FgetEllDeviceParams + end interface + + + interface + function FallocEllDevice(deviceMat,rows,maxRowSize,nnzeros,columns,& + & elementType,firstIndex) & + & result(res) bind(c,name='FallocEllDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: rows,maxRowSize,nnzeros,columns,elementType,firstIndex + type(c_ptr) :: deviceMat + end function FallocEllDevice + end interface + + + interface writeEllDevice + + function writeEllDeviceFloat(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='writeEllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + real(c_float) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function writeEllDeviceFloat + + function writeEllDeviceDouble(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='writeEllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + real(c_double) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function writeEllDeviceDouble + + function writeEllDeviceFloatComplex(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='writeEllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + complex(c_float_complex) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function writeEllDeviceFloatComplex + + function writeEllDeviceDoubleComplex(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='writeEllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + complex(c_double_complex) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function writeEllDeviceDoubleComplex + + end interface + + interface readEllDevice + + function readEllDeviceFloat(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='readEllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + real(c_float) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function readEllDeviceFloat + + function readEllDeviceDouble(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='readEllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + real(c_double) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function readEllDeviceDouble + + function readEllDeviceFloatComplex(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='readEllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + complex(c_float_complex) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function readEllDeviceFloatComplex + + function readEllDeviceDoubleComplex(deviceMat,val,ja,ldj,irn,idiag) & + & result(res) bind(c,name='readEllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int), value :: ldj + complex(c_double_complex) :: val(ldj,*) + integer(c_int) :: ja(ldj,*),irn(*),idiag(*) + end function readEllDeviceDoubleComplex + + end interface + + interface + subroutine freeEllDevice(deviceMat) & + & bind(c,name='freeEllDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine freeEllDevice + end interface + + interface + subroutine zeroEllDevice(deviceMat) & + & bind(c,name='zeroEllDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine zeroEllDevice + end interface + + interface + subroutine resetEllTimer() bind(c,name='resetEllTimer') + use iso_c_binding + end subroutine resetEllTimer + end interface + interface + function getEllTimer() & + & bind(c,name='getEllTimer') result(res) + use iso_c_binding + real(c_double) :: res + end function getEllTimer + end interface + + + interface + function getEllDevicePitch(deviceMat) & + & bind(c,name='getEllDevicePitch') result(res) + use iso_c_binding + type(c_ptr), value :: deviceMat + integer(c_int) :: res + end function getEllDevicePitch + end interface + + interface + function getEllDeviceMaxRowSize(deviceMat) & + & bind(c,name='getEllDeviceMaxRowSize') result(res) + use iso_c_binding + type(c_ptr), value :: deviceMat + integer(c_int) :: res + end function getEllDeviceMaxRowSize + end interface + + + interface psi_CopyCooToElg + function psiCopyCooToElgFloat(nr, nc, nza, hacksz, ldv, nzm, irn, & + & idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToElgFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,ldv,nzm + type(c_ptr), value :: deviceMat + real(c_float) :: val(*) + integer(c_int) :: irn(*),idisp(*),ja(*) + end function psiCopyCooToElgFloat + function psiCopyCooToElgDouble(nr, nc, nza, hacksz, ldv, nzm, irn, & + & idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToElgDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,ldv,nzm + type(c_ptr), value :: deviceMat + real(c_double) :: val(*) + integer(c_int) :: irn(*),idisp(*),ja(*) + end function psiCopyCooToElgDouble + function psiCopyCooToElgFloatComplex(nr, nc, nza, hacksz, ldv, nzm, irn, & + & idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToElgFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,ldv,nzm + type(c_ptr), value :: deviceMat + complex(c_float_complex) :: val(*) + integer(c_int) :: irn(*),idisp(*),ja(*) + end function psiCopyCooToElgFloatComplex + function psiCopyCooToElgDoubleComplex(nr, nc, nza, hacksz, ldv, nzm, irn, & + & idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToElgDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,ldv,nzm + type(c_ptr), value :: deviceMat + complex(c_double_complex) :: val(*) + integer(c_int) :: irn(*),idisp(*),ja(*) + end function psiCopyCooToElgDoubleComplex + end interface + + interface csputEllDeviceFloat + function dev_csputEllDeviceFloat(deviceMat, nnz, ia, ja, val) & + & result(res) bind(c,name='dev_csputEllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat , ia, ja, val + integer(c_int), value :: nnz + end function dev_csputEllDeviceFloat + end interface + + interface csputEllDeviceDouble + function dev_csputEllDeviceDouble(deviceMat, nnz, ia, ja, val) & + & result(res) bind(c,name='dev_csputEllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat , ia, ja, val + integer(c_int), value :: nnz + end function dev_csputEllDeviceDouble + end interface + + interface csputEllDeviceFloatComplex + function dev_csputEllDeviceFloatComplex(deviceMat, nnz, ia, ja, val) & + & result(res) bind(c,name='dev_csputEllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat , ia, ja, val + integer(c_int), value :: nnz + end function dev_csputEllDeviceFloatComplex + end interface + + interface csputEllDeviceDoubleComplex + function dev_csputEllDeviceDoubleComplex(deviceMat, nnz, ia, ja, val) & + & result(res) bind(c,name='dev_csputEllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat , ia, ja, val + integer(c_int), value :: nnz + end function dev_csputEllDeviceDoubleComplex + end interface + + interface spmvEllDevice + function spmvEllDeviceFloat(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvEllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_float),value :: alpha, beta + end function spmvEllDeviceFloat + function spmvEllDeviceDouble(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvEllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_double),value :: alpha, beta + end function spmvEllDeviceDouble + function spmvEllDeviceFloatComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvEllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_float_complex),value :: alpha, beta + end function spmvEllDeviceFloatComplex + function spmvEllDeviceDoubleComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvEllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_double_complex),value :: alpha, beta + end function spmvEllDeviceDoubleComplex + end interface + +#endif + + +end module elldev_mod diff --git a/gpu/fcusparse.c b/gpu/fcusparse.c new file mode 100644 index 000000000..5f0c12d96 --- /dev/null +++ b/gpu/fcusparse.c @@ -0,0 +1,77 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 + +#ifdef HAVE_SPGPU +#include +#include "cintrf.h" +#include "fcusparse.h" + +static cusparseHandle_t *cusparse_handle=NULL; + + +void setHandle(cusparseHandle_t); + +int FcusparseCreate() +{ + int ret=CUSPARSE_STATUS_SUCCESS; + cusparseHandle_t *handle; + if (cusparse_handle == NULL) { + if ((handle = (cusparseHandle_t *)malloc(sizeof(cusparseHandle_t)))==NULL) + return((int) CUSPARSE_STATUS_ALLOC_FAILED); + ret = (int)cusparseCreate(handle); + if (ret == CUSPARSE_STATUS_SUCCESS) + cusparse_handle = handle; + } + return (ret); +} + +int FcusparseDestroy() +{ + int val; + val = (int) cusparseDestroy(*cusparse_handle); + free(cusparse_handle); + cusparse_handle=NULL; + return(val); +} +cusparseHandle_t *getHandle() +{ + if (cusparse_handle == NULL) + FcusparseCreate(); + return(cusparse_handle); +} + + + +#endif diff --git a/gpu/fcusparse.h b/gpu/fcusparse.h new file mode 100644 index 000000000..2bab2aca4 --- /dev/null +++ b/gpu/fcusparse.h @@ -0,0 +1,70 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 FCUSPARSE_ +#define FCUSPARSE_ + +#ifdef HAVE_SPGPU +#include +#if CUDA_SHORT_VERSION <= 10 +#include +#else +#include +#endif +#include "cintrf.h" + +int FcusparseCreate(); +int FcusparseDestroy(); +cusparseHandle_t *getHandle(); + +#define CHECK_CUDA(func) \ +{ \ + cudaError_t status = (func); \ + if (status != cudaSuccess) { \ + printf("CUDA API failed at line %d with error: %s (%d)\n", \ + __LINE__, cudaGetErrorString(status), status); \ + return EXIT_FAILURE; \ + } \ +} + +#define CHECK_CUSPARSE(func) \ +{ \ + cusparseStatus_t status = (func); \ + if (status != CUSPARSE_STATUS_SUCCESS) { \ + printf("CUSPARSE API failed at line %d with error: %s (%d)\n", \ + __LINE__, cusparseGetErrorString(status), status); \ + return EXIT_FAILURE; \ + } \ +} + +#endif +#endif diff --git a/gpu/fcusparse_fct.h b/gpu/fcusparse_fct.h new file mode 100644 index 000000000..5a3b1ac65 --- /dev/null +++ b/gpu/fcusparse_fct.h @@ -0,0 +1,770 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + +typedef struct T_CSRGDeviceMat +{ +#if CUDA_SHORT_VERSION <= 10 + cusparseMatDescr_t descr; + cusparseSolveAnalysisInfo_t triang; +#elif CUDA_VERSION < 11030 + cusparseMatDescr_t descr; + csrsv2Info_t triang; + size_t mvbsize, svbsize; + void *mvbuffer, *svbuffer; +#else + cusparseSpMatDescr_t descr; + cusparseSpSVDescr_t *spsvDescr; + size_t mvbsize, svbsize; + void *mvbuffer, *svbuffer; +#endif + int m, n, nz; + TYPE *val; + int *irp; + int *ja; +} T_CSRGDeviceMat; + +/* Interoperability: type coming from Fortran side to distinguish D/S/C/Z. */ +typedef struct T_Cmat +{ + T_CSRGDeviceMat *mat; +} T_Cmat; + +#if CUDA_SHORT_VERSION <= 10 +typedef struct T_HYBGDeviceMat +{ + cusparseMatDescr_t descr; + cusparseSolveAnalysisInfo_t triang; + cusparseHybMat_t hybA; + int m, n, nz; + TYPE *val; + int *irp; + int *ja; +} T_HYBGDeviceMat; + + +/* Interoperability: type coming from Fortran side to distinguish D/S/C/Z. */ +typedef struct T_Hmat +{ + T_HYBGDeviceMat *mat; +} T_Hmat; +#endif + +int T_spmvCSRGDevice(T_Cmat *Mat, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY); +int T_spsvCSRGDevice(T_Cmat *Mat, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY); +int T_CSRGDeviceAlloc(T_Cmat *Mat,int nr, int nc, int nz); +int T_CSRGDeviceFree(T_Cmat *Mat); + + +int T_CSRGHost2Device(T_Cmat *Mat, int m, int n, int nz, + int *irp, int *ja, TYPE *val); +int T_CSRGDevice2Host(T_Cmat *Mat, int m, int n, int nz, + int *irp, int *ja, TYPE *val); + +int T_CSRGDeviceGetParms(T_Cmat *Mat,int *nr, int *nc, int *nz); + +#if CUDA_SHORT_VERSION <= 10 +int T_CSRGDeviceSetMatType(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatFillMode(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatDiagType(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatIndexBase(T_Cmat *Mat, int type); +int T_CSRGDeviceCsrsmAnalysis(T_Cmat *Mat); +#elif CUDA_VERSION < 11030 +int T_CSRGDeviceSetMatType(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatFillMode(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatDiagType(T_Cmat *Mat, int type); +int T_CSRGDeviceSetMatIndexBase(T_Cmat *Mat, int type); +#endif + + + +#if CUDA_SHORT_VERSION <= 10 + + +int T_HYBGDeviceFree(T_Hmat *Matrix); +int T_spmvHYBGDevice(T_Hmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY); +int T_HYBGDeviceAlloc(T_Hmat *Matrix,int nr, int nc, int nz); +int T_HYBGDeviceSetMatDiagType(T_Hmat *Matrix, int type); +int T_HYBGDeviceSetMatIndexBase(T_Hmat *Matrix, int type); +int T_HYBGDeviceSetMatType(T_Hmat *Matrix, int type); +int T_HYBGDeviceSetMatFillMode(T_Hmat *Matrix, int type); +int T_HYBGDeviceHybsmAnalysis(T_Hmat *Matrix); +int T_spsvHYBGDevice(T_Hmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY); +int T_HYBGHost2Device(T_Hmat *Matrix, int m, int n, int nz, + int *irp, int *ja, TYPE *val); +#endif + +int T_spmvCSRGDevice(T_Cmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY) +{ + T_CSRGDeviceMat *cMat=Matrix->mat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + void *vX, *vY; + int r,n; + cusparseHandle_t *my_handle=getHandle(); + TYPE ealpha=alpha, ebeta=beta; +#if CUDA_SHORT_VERSION <= 10 + /*getAddrMultiVecDevice(deviceX, &vX); + getAddrMultiVecDevice(deviceY, &vY); */ + vX=x->v_; + vY=y->v_; + + return cusparseTcsrmv(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->n,cMat->nz,(const TYPE *) &alpha,cMat->descr, + cMat->val, cMat->irp, cMat->ja, + (const TYPE *) vX, (const TYPE *) &beta, (TYPE *) vY); +#elif CUDA_VERSION < 11030 + size_t bfsz; + vX=x->v_; + vY=y->v_; +#if 1 + CHECK_CUSPARSE(cusparseCsrmvEx_bufferSize(*my_handle,CUSPARSE_ALG_MERGE_PATH, + CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->n,cMat->nz, + (const void *) &ealpha,CUSPARSE_BASE_TYPE, + cMat->descr, + (const void *) cMat->val, + CUSPARSE_BASE_TYPE, + (const int *) cMat->irp, + (const int *) cMat->ja, + (const void *) vX, CUSPARSE_BASE_TYPE, + (const void *) &ebeta, CUSPARSE_BASE_TYPE, + (void *) vY, CUSPARSE_BASE_TYPE, + CUSPARSE_BASE_TYPE, &bfsz)); +#else + bfsz=cMat->nz; +#endif + + if (bfsz > cMat->mvbsize) { + if (cMat->mvbuffer != NULL) { + CHECK_CUDA(cudaFree(cMat->mvbuffer)); + cMat->mvbuffer = NULL; + } + CHECK_CUDA(cudaMalloc((void **) &(cMat->mvbuffer), bfsz)); + cMat->mvbsize = bfsz; + } + CHECK_CUSPARSE(cusparseCsrmvEx(*my_handle, + CUSPARSE_ALG_MERGE_PATH, + CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->n,cMat->nz, + (const void *) &ealpha,CUSPARSE_BASE_TYPE, + cMat->descr, + (const void *) cMat->val, CUSPARSE_BASE_TYPE, + (const int *) cMat->irp, (const int *) cMat->ja, + (const void *) vX, CUSPARSE_BASE_TYPE, + (const void *) &ebeta, CUSPARSE_BASE_TYPE, + (void *) vY, CUSPARSE_BASE_TYPE, + CUSPARSE_BASE_TYPE, (void *) cMat->mvbuffer)); + +#else + cusparseDnVecDescr_t vecX, vecY; + size_t bfsz; + vX=x->v_; + vY=y->v_; + CHECK_CUSPARSE( cusparseCreateDnVec(&vecY, cMat->m, vY, CUSPARSE_BASE_TYPE) ); + CHECK_CUSPARSE( cusparseCreateDnVec(&vecX, cMat->n, vX, CUSPARSE_BASE_TYPE) ); + CHECK_CUSPARSE(cusparseSpMV_bufferSize(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + &alpha,cMat->descr,vecX,&beta,vecY, + CUSPARSE_BASE_TYPE,CUSPARSE_SPMV_ALG_DEFAULT, + &bfsz)); + if (bfsz > cMat->mvbsize) { + if (cMat->mvbuffer != NULL) { + CHECK_CUDA(cudaFree(cMat->mvbuffer)); + cMat->mvbuffer = NULL; + } + CHECK_CUDA(cudaMalloc((void **) &(cMat->mvbuffer), bfsz)); + cMat->mvbsize = bfsz; + } + CHECK_CUSPARSE(cusparseSpMV(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + &alpha,cMat->descr,vecX,&beta,vecY, + CUSPARSE_BASE_TYPE,CUSPARSE_SPMV_ALG_DEFAULT, + cMat->mvbuffer)); + CHECK_CUSPARSE(cusparseDestroyDnVec(vecX) ); + CHECK_CUSPARSE(cusparseDestroyDnVec(vecY) ); +#endif +} + +int T_spsvCSRGDevice(T_Cmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY) +{ + T_CSRGDeviceMat *cMat=Matrix->mat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + void *vX, *vY; + int r,n; + cusparseHandle_t *my_handle=getHandle(); +#if CUDA_SHORT_VERSION <= 10 + vX=x->v_; + vY=y->v_; + + return cusparseTcsrsv_solve(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,(const TYPE *) &alpha,cMat->descr, + cMat->val, cMat->irp, cMat->ja, cMat->triang, + (const TYPE *) vX, (TYPE *) vY); +#elif CUDA_VERSION < 11030 + vX=x->v_; + vY=y->v_; + CHECK_CUSPARSE(cusparseTcsrsv2_solve(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->nz, + (const TYPE *) &alpha, + cMat->descr, + cMat->val, cMat->irp, cMat->ja, + cMat->triang, + (const TYPE *) vX, (TYPE *) vY, + CUSPARSE_SOLVE_POLICY_USE_LEVEL, + (void *) cMat->svbuffer)); +#else + cusparseDnVecDescr_t vecX, vecY; + size_t bfsz; + vX=x->v_; + vY=y->v_; + cMat->spsvDescr=(cusparseSpSVDescr_t *) malloc(sizeof(cusparseSpSVDescr_t *)); + CHECK_CUSPARSE( cusparseCreateDnVec(&vecY, cMat->m, vY, CUSPARSE_BASE_TYPE) ); + CHECK_CUSPARSE( cusparseCreateDnVec(&vecX, cMat->n, vX, CUSPARSE_BASE_TYPE) ); + CHECK_CUSPARSE(cusparseSpSV_bufferSize(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + &alpha,cMat->descr,vecX,vecY, + CUSPARSE_BASE_TYPE, + CUSPARSE_SPSV_ALG_DEFAULT, + *(cMat->spsvDescr), + &bfsz)); + if (bfsz > cMat->svbsize) { + if (cMat->svbuffer != NULL) { + CHECK_CUDA(cudaFree(cMat->svbuffer)); + cMat->svbuffer = NULL; + } + CHECK_CUDA(cudaMalloc((void **) &(cMat->svbuffer), bfsz)); + cMat->svbsize=bfsz; + } + if (cMat->spsvDescr==NULL) { + CHECK_CUSPARSE(cusparseSpSV_analysis(*my_handle, + CUSPARSE_OPERATION_NON_TRANSPOSE, + &alpha, + cMat->descr, + vecX, vecY, + CUSPARSE_BASE_TYPE, + CUSPARSE_SPSV_ALG_DEFAULT, + *(cMat->spsvDescr), + cMat->svbuffer)); + } + + CHECK_CUSPARSE(cusparseSpSV_solve(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + &alpha,cMat->descr,vecX,vecY, + CUSPARSE_BASE_TYPE, + CUSPARSE_SPSV_ALG_DEFAULT, + *(cMat->spsvDescr))); + CHECK_CUSPARSE(cusparseDestroyDnVec(vecX) ); + CHECK_CUSPARSE(cusparseDestroyDnVec(vecY) ); +#endif +} + +int T_CSRGDeviceAlloc(T_Cmat *Matrix,int nr, int nc, int nz) +{ + T_CSRGDeviceMat *cMat; + int nr1=nr, nz1=nz, rc; + cusparseHandle_t *my_handle=getHandle(); + int bfsz; + + if ((nr<0)||(nc<0)||(nz<0)) + return((int) CUSPARSE_STATUS_INVALID_VALUE); + if ((cMat=(T_CSRGDeviceMat *) malloc(sizeof(T_CSRGDeviceMat)))==NULL) + return((int) CUSPARSE_STATUS_ALLOC_FAILED); + cMat->m = nr; + cMat->n = nc; + cMat->nz = nz; + if (nr1 == 0) nr1 = 1; + if (nz1 == 0) nz1 = 1; + if ((rc= allocRemoteBuffer(((void **) &(cMat->irp)), ((nr1+1)*sizeof(int)))) != 0) + return(rc); + if ((rc= allocRemoteBuffer(((void **) &(cMat->ja)), ((nz1)*sizeof(int)))) != 0) + return(rc); + if ((rc= allocRemoteBuffer(((void **) &(cMat->val)), ((nz1)*sizeof(TYPE)))) != 0) + return(rc); +#if CUDA_SHORT_VERSION <= 10 + if ((rc= cusparseCreateMatDescr(&(cMat->descr))) !=0) + return(rc); + if ((rc= cusparseCreateSolveAnalysisInfo(&(cMat->triang))) !=0) + return(rc); +#elif CUDA_VERSION < 11030 + if ((rc= cusparseCreateMatDescr(&(cMat->descr))) !=0) + return(rc); + CHECK_CUSPARSE(cusparseSetMatType(cMat->descr,CUSPARSE_MATRIX_TYPE_GENERAL)); + CHECK_CUSPARSE(cusparseSetMatDiagType(cMat->descr,CUSPARSE_DIAG_TYPE_NON_UNIT)); + CHECK_CUSPARSE(cusparseSetMatIndexBase(cMat->descr,CUSPARSE_INDEX_BASE_ONE)); + CHECK_CUSPARSE(cusparseCreateCsrsv2Info(&(cMat->triang))); + if (cMat->nz > 0) { + CHECK_CUSPARSE(cusparseTcsrsv2_bufferSize(*my_handle, + CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->nz, cMat->descr, + cMat->val, cMat->irp, cMat->ja, + cMat->triang, &bfsz)); + } else { + bfsz = 0; + } + + /* if (cMat->svbuffer != NULL) { */ + /* fprintf(stderr,"Calling cudaFree\n"); */ + /* CHECK_CUDA(cudaFree(cMat->svbuffer)); */ + /* cMat->svbuffer = NULL; */ + /* } */ + if (bfsz > 0) { + CHECK_CUDA(cudaMalloc((void **) &(cMat->svbuffer), bfsz)); + } else { + cMat->svbuffer=NULL; + } + cMat->svbsize=bfsz; + + cMat->mvbuffer=NULL; + cMat->mvbsize = 0; + + +#else + int64_t rows=nr, cols=nc, nnz=nz; + + CHECK_CUSPARSE(cusparseCreateCsr(&(cMat->descr), + rows, cols, nnz, + (void *) cMat->irp, + (void *) cMat->ja, + (void *) cMat->val, + CUSPARSE_INDEX_32I, + CUSPARSE_INDEX_32I, + CUSPARSE_INDEX_BASE_ONE, + CUSPARSE_BASE_TYPE) ); + cMat->spsvDescr=NULL; + cMat->mvbuffer=NULL; + cMat->svbuffer=NULL; + cMat->mvbsize=0; + cMat->svbsize=0; +#endif + Matrix->mat = cMat; + return(CUSPARSE_STATUS_SUCCESS); +} + +int T_CSRGDeviceFree(T_Cmat *Matrix) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + + if (cMat!=NULL) { + freeRemoteBuffer(cMat->irp); + freeRemoteBuffer(cMat->ja); + freeRemoteBuffer(cMat->val); +#if CUDA_SHORT_VERSION <= 10 + cusparseDestroyMatDescr(cMat->descr); + cusparseDestroySolveAnalysisInfo(cMat->triang); +#elif CUDA_VERSION < 11030 + cusparseDestroyMatDescr(cMat->descr); + cusparseDestroyCsrsv2Info(cMat->triang); +#else + cusparseDestroySpMat(cMat->descr); + if (cMat->spsvDescr!=NULL) { + CHECK_CUSPARSE( cusparseSpSV_destroyDescr(*(cMat->spsvDescr))); + free(cMat->spsvDescr); + cMat->spsvDescr=NULL; + } + if (cMat->mvbuffer!=NULL) + CHECK_CUDA( cudaFree(cMat->mvbuffer)); + if (cMat->svbuffer!=NULL) + CHECK_CUDA( cudaFree(cMat->svbuffer)); + cMat->spsvDescr=NULL; + cMat->mvbuffer=NULL; + cMat->svbuffer=NULL; + cMat->mvbsize=0; + cMat->svbsize=0; +#endif + free(cMat); + Matrix->mat = NULL; + } + return(CUSPARSE_STATUS_SUCCESS); +} + +int T_CSRGDeviceGetParms(T_Cmat *Matrix,int *nr, int *nc, int *nz) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + + if (cMat!=NULL) { + *nr = cMat->m ; + *nc = cMat->n ; + *nz = cMat->nz ; + return(CUSPARSE_STATUS_SUCCESS); + } else { + return((int) CUSPARSE_STATUS_ALLOC_FAILED); + } +} + +#if CUDA_SHORT_VERSION <= 10 + +int T_CSRGDeviceSetMatType(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatType(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatFillMode(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatFillMode(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatDiagType(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatDiagType(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatIndexBase(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatIndexBase(cMat->descr,type)); +} + +int T_CSRGDeviceCsrsmAnalysis(T_Cmat *Matrix) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + int rc, buffersize; + cusparseHandle_t *my_handle=getHandle(); + cusparseSolveAnalysisInfo_t info; + + rc= (int) cusparseTcsrsv_analysis(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->nz,cMat->descr, + cMat->val, cMat->irp, cMat->ja, + cMat->triang); + if (rc !=0) { + fprintf(stderr,"From csrsv_analysis: %d\n",rc); + } + return(rc); +} + +#elif CUDA_VERSION < 11030 +int T_CSRGDeviceSetMatType(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatType(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatFillMode(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatFillMode(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatDiagType(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatDiagType(cMat->descr,type)); +} + +int T_CSRGDeviceSetMatIndexBase(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + return ((int) cusparseSetMatIndexBase(cMat->descr,type)); +} + +#else + +int T_CSRGDeviceSetMatFillMode(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + cusparseFillMode_t mode=type; + + CHECK_CUSPARSE(cusparseSpMatSetAttribute(cMat->descr, + CUSPARSE_SPMAT_FILL_MODE, + (const void*) &mode, + sizeof(cusparseFillMode_t))); + return(0); +} + +int T_CSRGDeviceSetMatDiagType(T_Cmat *Matrix, int type) +{ + T_CSRGDeviceMat *cMat= Matrix->mat; + cusparseDiagType_t cutype=type; + CHECK_CUSPARSE(cusparseSpMatSetAttribute(cMat->descr, + CUSPARSE_SPMAT_DIAG_TYPE, + (const void*) &cutype, + sizeof(cusparseDiagType_t))); + return(0); +} + +#endif + +int T_CSRGHost2Device(T_Cmat *Matrix, int m, int n, int nz, + int *irp, int *ja, TYPE *val) +{ + int rc; + T_CSRGDeviceMat *cMat= Matrix->mat; + cusparseHandle_t *my_handle=getHandle(); + + if ((rc=writeRemoteBuffer((void *) irp, (void *) cMat->irp, + (m+1)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + + if ((rc=writeRemoteBuffer((void *) ja,(void *) cMat->ja, + (nz)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + if ((rc=writeRemoteBuffer((void *) val, (void *) cMat->val, + (nz)*sizeof(TYPE))) + != SPGPU_SUCCESS) + return(rc); +#if (CUDA_SHORT_VERSION > 10 ) && (CUDA_VERSION < 11030) + if (cusparseGetMatType(cMat->descr)== CUSPARSE_MATRIX_TYPE_TRIANGULAR) { + // Why do we need to set TYPE_GENERAL??? cuSPARSE can be misterious sometimes. + cusparseSetMatType(cMat->descr,CUSPARSE_MATRIX_TYPE_GENERAL); + CHECK_CUSPARSE(cusparseTcsrsv2_analysis(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + cMat->m,cMat->nz, cMat->descr, + cMat->val, cMat->irp, cMat->ja, + cMat->triang, CUSPARSE_SOLVE_POLICY_USE_LEVEL, + cMat->svbuffer)); + } +#endif + return(CUSPARSE_STATUS_SUCCESS); +} + +int T_CSRGDevice2Host(T_Cmat *Matrix, int m, int n, int nz, + int *irp, int *ja, TYPE *val) +{ + int rc; + T_CSRGDeviceMat *cMat = Matrix->mat; + + if ((rc=readRemoteBuffer((void *) irp, (void *) cMat->irp, (m+1)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + + if ((rc=readRemoteBuffer((void *) ja, (void *) cMat->ja, (nz)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + if ((rc=readRemoteBuffer((void *) val, (void *) cMat->val, (nz)*sizeof(TYPE))) + != SPGPU_SUCCESS) + return(rc); + + return(CUSPARSE_STATUS_SUCCESS); +} + +#if CUDA_SHORT_VERSION <= 10 +int T_HYBGDeviceFree(T_Hmat *Matrix) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + if (hMat != NULL) { + cusparseDestroyMatDescr(hMat->descr); + cusparseDestroySolveAnalysisInfo(hMat->triang); + cusparseDestroyHybMat(hMat->hybA); + free(hMat); + } + Matrix->mat = NULL; + return(CUSPARSE_STATUS_SUCCESS); +} + +int T_spmvHYBGDevice(T_Hmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY) +{ + T_HYBGDeviceMat *hMat=Matrix->mat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + void *vX, *vY; + int r,n,rc; + cusparseMatrixType_t type; + cusparseHandle_t *my_handle=getHandle(); + + /*getAddrMultiVecDevice(deviceX, &vX); + getAddrMultiVecDevice(deviceY, &vY); */ + vX=x->v_; + vY=y->v_; + + /* rc = (int) cusparseGetMatType(hMat->descr); */ + /* fprintf(stderr,"Spmv MatType: %d\n",rc); */ + /* rc = (int) cusparseGetMatDiagType(hMat->descr); */ + /* fprintf(stderr,"Spmv DiagType: %d\n",rc); */ + /* rc = (int) cusparseGetMatFillMode(hMat->descr); */ + /* fprintf(stderr,"Spmv FillMode: %d\n",rc); */ + /* Dirty trick: apparently hybmv does not accept a triangular + matrix even though it should not make a difference. So + we claim it's general anyway */ + type = cusparseGetMatType(hMat->descr); + rc = cusparseSetMatType(hMat->descr,CUSPARSE_MATRIX_TYPE_GENERAL); + if (rc == 0) + rc = (int) cusparseThybmv(*my_handle, CUSPARSE_OPERATION_NON_TRANSPOSE, + (const TYPE *) &alpha, hMat->descr, hMat->hybA, + (const TYPE *) vX, (const TYPE *) &beta, + (TYPE *) vY); + if (rc == 0) + rc = cusparseSetMatType(hMat->descr,type); + return(rc); +} + +int T_HYBGDeviceAlloc(T_Hmat *Matrix,int nr, int nc, int nz) +{ + T_HYBGDeviceMat *hMat; + int nr1=nr, nz1=nz, rc; + if ((nr<0)||(nc<0)||(nz<0)) + return((int) CUSPARSE_STATUS_INVALID_VALUE); + if ((hMat=(T_HYBGDeviceMat *) malloc(sizeof(T_HYBGDeviceMat)))==NULL) + return((int) CUSPARSE_STATUS_ALLOC_FAILED); + hMat->m = nr; + hMat->n = nc; + hMat->nz = nz; + + if ((rc= cusparseCreateMatDescr(&(hMat->descr))) !=0) + return(rc); + if ((rc= cusparseCreateSolveAnalysisInfo(&(hMat->triang))) !=0) + return(rc); + if((rc = cusparseCreateHybMat(&(hMat->hybA))) != 0) + return(rc); + Matrix->mat = hMat; + return(CUSPARSE_STATUS_SUCCESS); +} + +int T_HYBGDeviceSetMatDiagType(T_Hmat *Matrix, int type) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + return ((int) cusparseSetMatDiagType(hMat->descr,type)); +} + +int T_HYBGDeviceSetMatIndexBase(T_Hmat *Matrix, int type) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + return ((int) cusparseSetMatIndexBase(hMat->descr,type)); +} + +int T_HYBGDeviceSetMatType(T_Hmat *Matrix, int type) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + return ((int) cusparseSetMatType(hMat->descr,type)); +} + +int T_HYBGDeviceSetMatFillMode(T_Hmat *Matrix, int type) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + return ((int) cusparseSetMatFillMode(hMat->descr,type)); +} + +int T_spsvHYBGDevice(T_Hmat *Matrix, TYPE alpha, void *deviceX, + TYPE beta, void *deviceY) +{ + //beta?? + T_HYBGDeviceMat *hMat=Matrix->mat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + void *vX, *vY; + int r,n; + cusparseHandle_t *my_handle=getHandle(); + /*getAddrMultiVecDevice(deviceX, &vX); + getAddrMultiVecDevice(deviceY, &vY); */ + vX=x->v_; + vY=y->v_; + + return cusparseThybsv_solve(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + (const TYPE *) &alpha, hMat->descr, + hMat->hybA, hMat->triang, + (const TYPE *) vX, (TYPE *) vY); +} + +int T_HYBGDeviceHybsmAnalysis(T_Hmat *Matrix) +{ + T_HYBGDeviceMat *hMat= Matrix->mat; + cusparseSolveAnalysisInfo_t info; + int rc; + cusparseHandle_t *my_handle=getHandle(); + + /* rc = (int) cusparseGetMatType(hMat->descr); */ + /* fprintf(stderr,"Analysis MatType: %d\n",rc); */ + /* rc = (int) cusparseGetMatDiagType(hMat->descr); */ + /* fprintf(stderr,"Analysis DiagType: %d\n",rc); */ + /* rc = (int) cusparseGetMatFillMode(hMat->descr); */ + /* fprintf(stderr,"Analysis FillMode: %d\n",rc); */ + rc = (int) cusparseThybsv_analysis(*my_handle,CUSPARSE_OPERATION_NON_TRANSPOSE, + hMat->descr, hMat->hybA, hMat->triang); + + if (rc !=0) { + fprintf(stderr,"From csrsv_analysis: %d\n",rc); + } + return(rc); +} + +int T_HYBGHost2Device(T_Hmat *Matrix, int m, int n, int nz, + int *irp, int *ja, TYPE *val) +{ + int rc; double t1,t2; + int nr1=m, nz1=nz; + T_HYBGDeviceMat *hMat= Matrix->mat; + cusparseHandle_t *my_handle=getHandle(); + + if (nr1 == 0) nr1 = 1; + if (nz1 == 0) nz1 = 1; + if ((rc= allocRemoteBuffer(((void **) &(hMat->irp)), ((nr1+1)*sizeof(int)))) != 0) + return(rc); + if ((rc= allocRemoteBuffer(((void **) &(hMat->ja)), ((nz1)*sizeof(int)))) != 0) + return(rc); + if ((rc= allocRemoteBuffer(((void **) &(hMat->val)), ((nz1)*sizeof(TYPE)))) != 0) + return(rc); + + if ((rc=writeRemoteBuffer((void *) irp, (void *) hMat->irp, + (m+1)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + + if ((rc=writeRemoteBuffer((void *) ja,(void *) hMat->ja, + (nz)*sizeof(int))) + != SPGPU_SUCCESS) + return(rc); + if ((rc=writeRemoteBuffer((void *) val, (void *) hMat->val, + (nz)*sizeof(TYPE))) + != SPGPU_SUCCESS) + return(rc); + /* rc = (int) cusparseGetMatType(hMat->descr); */ + /* fprintf(stderr,"Conversion MatType: %d\n",rc); */ + /* rc = (int) cusparseGetMatDiagType(hMat->descr); */ + /* fprintf(stderr,"Conversion DiagType: %d\n",rc); */ + /* rc = (int) cusparseGetMatFillMode(hMat->descr); */ + /* fprintf(stderr,"Conversion FillMode: %d\n",rc); */ + //t1=etime(); + rc = (int) cusparseTcsr2hyb(*my_handle, m, n, + hMat->descr, + (const TYPE *)hMat->val, + (const int *)hMat->irp, (const int *)hMat->ja, + hMat->hybA,0, + CUSPARSE_HYB_PARTITION_AUTO); + + freeRemoteBuffer(hMat->irp); hMat->irp = NULL; + freeRemoteBuffer(hMat->ja); hMat->ja = NULL; + freeRemoteBuffer(hMat->val); hMat->val = NULL; + + //cudaSync(); + //t2 = etime(); + //fprintf(stderr,"Inner call to cusparseTcsr2hyb: %lf\n",(t2-t1)); + if (rc != 0) { + fprintf(stderr,"From csr2hyb: %d\n",rc); + } + return(rc); +} +#endif + diff --git a/gpu/hdiagdev.c b/gpu/hdiagdev.c new file mode 100644 index 000000000..4e6402789 --- /dev/null +++ b/gpu/hdiagdev.c @@ -0,0 +1,425 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "hdiagdev.h" +#include +#include +#include +#include +#if defined(HAVE_SPGPU) +#define DEBUG 0 + + +void freeHdiagDevice(void* remoteMatrix) +{ + struct HdiagDevice *devMat = (struct HdiagDevice *) remoteMatrix; + //fprintf(stderr,"freeHllDevice\n"); + if (devMat != NULL) { + freeRemoteBuffer(devMat->hackOffsets); + freeRemoteBuffer(devMat->cM); + free(remoteMatrix); + } +} + + +HdiagDeviceParams getHdiagDeviceParams(unsigned int rows, unsigned int columns, + unsigned int allocationHeight, unsigned int hackSize, + unsigned int hackCount, unsigned int elementType) +{ + HdiagDeviceParams params; + + params.elementType = elementType; + //numero di elementi di val + params.rows = rows; + params.columns = columns; + params.allocationHeight = allocationHeight; + params.hackSize = hackSize; + params.hackCount = hackCount; + + return params; + +} + +int allocHdiagDevice(void **remoteMatrix, HdiagDeviceParams* params) +{ + struct HdiagDevice *tmp = (struct HdiagDevice *)malloc(sizeof(struct HdiagDevice)); + int ret=SPGPU_SUCCESS; + int *tmpOff = NULL; + + *remoteMatrix = (void *) tmp; +#if DEBUG + fprintf(stderr,"From alloc: %p\n",*remoteMatrix); +#endif + + tmp->rows = params->rows; + + tmp->hackSize = params->hackSize; + + tmp->cols = params->columns; + + tmp->allocationHeight = params->allocationHeight; + + tmp->hackCount = params->hackCount; + + + +#if DEBUG + fprintf(stderr,"hackcount %d allocationHeight %d\n",tmp->hackCount,tmp->allocationHeight); +#endif + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->hackOffsets), (tmp->hackCount+1)*sizeof(int)); + + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->hdiaOffsets), tmp->allocationHeight*sizeof(int)); + + /* tmp->baseIndex = params->firstIndex; */ + + if (params->elementType == SPGPU_TYPE_INT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->hackSize*tmp->allocationHeight*sizeof(int)); + } + else if (params->elementType == SPGPU_TYPE_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->hackSize*tmp->allocationHeight*sizeof(float)); + } + else if (params->elementType == SPGPU_TYPE_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->hackSize*tmp->allocationHeight*sizeof(double)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->hackSize*tmp->allocationHeight*sizeof(cuFloatComplex)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->hackSize*tmp->allocationHeight*sizeof(cuDoubleComplex)); + } + else + return SPGPU_UNSUPPORTED; // Unsupported params + return ret; +} + +int FallocHdiagDevice(void** deviceMat, unsigned int rows, unsigned int cols, + unsigned int allocationHeight, unsigned int hackSize, + unsigned int hackCount, unsigned int elementType) +{ int i=0; +#ifdef HAVE_SPGPU + HdiagDeviceParams p; + + p = getHdiagDeviceParams(rows, cols, allocationHeight, hackSize, hackCount,elementType); + + i = allocHdiagDevice(deviceMat, &p); +#if DEBUG + fprintf(stderr," Falloc %p \n",*deviceMat); +#endif + + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocEllDevice",i); + } + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif + + +} + +int writeHdiagDeviceDouble(void* deviceMat, double* val, int* hdiaOffsets, int *hackOffsets) +{ int i=0,fo,fa,j,k,p; + char buf_a[255], buf_o[255],tmp[255]; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + + i=SPGPU_SUCCESS; + + +#if DEBUG + fprintf(stderr," Write %p \n",devMat); + + fprintf(stderr,"HDIAG writing to device memory: allocationHeight %d hackCount %d\n", + devMat->allocationHeight,devMat->hackCount); + fprintf(stderr,"HackOffsets: "); + for (j=0; jhackCount+1; j++) + fprintf(stderr," %d",hackOffsets[j]); + fprintf(stderr,"\n"); + fprintf(stderr,"diaOffsets: "); + for (j=0; jallocationHeight; j++) + fprintf(stderr," %d",hdiaOffsets[j]); + fprintf(stderr,"\n"); +#if 1 + fprintf(stderr,"values: \n"); + p=0; + for (j=0; jhackCount; j++){ + fprintf(stderr,"Hack no: %d\n",j+1); + for (k=0; khackSize*(devMat->allocationHeight/devMat->hackCount); k++){ + fprintf(stderr," %d %lf\n",p+1,val[p]); p++; + } + } + fprintf(stderr,"\n"); +#endif +#endif + + + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void *) hackOffsets,(void *) devMat->hackOffsets, + (devMat->hackCount+1)*sizeof(int)); + + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void*) hdiaOffsets, (void *)devMat->hdiaOffsets, + devMat->allocationHeight*sizeof(int)); + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, + devMat->allocationHeight*devMat->hackSize*sizeof(double)); + if (i!=0) + fprintf(stderr,"Error in writeHdiagDeviceDouble %d\n",i); + +#if DEBUG + fprintf(stderr," EndWrite %p \n",devMat); +#endif + + if(i==0) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + +long long int sizeofHdiagDeviceDouble(void* deviceMat) +{ int i=0,fo,fa; + int *hoff=NULL,*hackoff=NULL; + long long int memsize=0; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + + + memsize += (devMat->hackCount+1)*sizeof(int); + memsize += devMat->allocationHeight*sizeof(int); + memsize += devMat->allocationHeight*devMat->hackSize*sizeof(double); + +#endif + return(memsize); +} + + + +int readHdiagDeviceDouble(void* deviceMat, double* a, int* off) +{ int i; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + /* i = readRemoteBuffer((void *) a, (void *)devMat->cM,devMat->rows*devMat->diags*sizeof(double)); */ + /* i = readRemoteBuffer((void *) off, (void *)devMat->off, devMat->diags*sizeof(int)); */ + + + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvHdiagDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY) +{ + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif +#if DEBUG + fprintf(stderr," First %p \n",devMat); + fprintf(stderr,"%d %d %d %p %p %p\n",devMat->rows,devMat->cols, devMat->hackSize, + devMat->hackOffsets, devMat->hdiaOffsets, devMat->cM); +#endif + spgpuDhdiaspmv (handle, (double*)y->v_, (double *)y->v_, alpha, + (double *)devMat->cM,devMat->hdiaOffsets, + devMat->hackSize, devMat->hackOffsets, devMat->rows,devMat->cols, + x->v_, beta); + + //cudaSync(); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeHdiagDeviceFloat(void* deviceMat, float* val, int* hdiaOffsets, int *hackOffsets) +{ int i=0,fo,fa,j,k,p; + char buf_a[255], buf_o[255],tmp[255]; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + + i=SPGPU_SUCCESS; + + +#if DEBUG + fprintf(stderr," Write %p \n",devMat); + + fprintf(stderr,"HDIAG writing to device memory: allocationHeight %d hackCount %d\n", + devMat->allocationHeight,devMat->hackCount); + fprintf(stderr,"HackOffsets: "); + for (j=0; jhackCount+1; j++) + fprintf(stderr," %d",hackOffsets[j]); + fprintf(stderr,"\n"); + fprintf(stderr,"diaOffsets: "); + for (j=0; jallocationHeight; j++) + fprintf(stderr," %d",hdiaOffsets[j]); + fprintf(stderr,"\n"); +#if 1 + fprintf(stderr,"values: \n"); + p=0; + for (j=0; jhackCount; j++){ + fprintf(stderr,"Hack no: %d\n",j+1); + for (k=0; khackSize*(devMat->allocationHeight/devMat->hackCount); k++){ + fprintf(stderr," %d %lf\n",p+1,val[p]); p++; + } + } + fprintf(stderr,"\n"); +#endif +#endif + + + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void *) hackOffsets,(void *) devMat->hackOffsets, + (devMat->hackCount+1)*sizeof(int)); + + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void*) hdiaOffsets, (void *)devMat->hdiaOffsets, + devMat->allocationHeight*sizeof(int)); + if(i== SPGPU_SUCCESS) + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, + devMat->allocationHeight*devMat->hackSize*sizeof(float)); + if (i!=0) + fprintf(stderr,"Error in writeHdiagDeviceFloat %d\n",i); + +#if DEBUG + fprintf(stderr," EndWrite %p \n",devMat); +#endif + + if(i==0) + return SPGPU_SUCCESS; + else + return SPGPU_UNSUPPORTED; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + +long long int sizeofHdiagDeviceFloat(void* deviceMat) +{ int i=0,fo,fa; + int *hoff=NULL,*hackoff=NULL; + long long int memsize=0; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + + + memsize += (devMat->hackCount+1)*sizeof(int); + memsize += devMat->allocationHeight*sizeof(int); + memsize += devMat->allocationHeight*devMat->hackSize*sizeof(float); + +#endif + return(memsize); +} + + + +int readHdiagDeviceFloat(void* deviceMat, float* a, int* off) +{ int i; +#ifdef HAVE_SPGPU + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + /* i = readRemoteBuffer((void *) a, (void *)devMat->cM,devMat->rows*devMat->diags*sizeof(float)); */ + /* i = readRemoteBuffer((void *) off, (void *)devMat->off, devMat->diags*sizeof(int)); */ + + + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvHdiagDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY) +{ + struct HdiagDevice *devMat = (struct HdiagDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif +#if DEBUG + fprintf(stderr," First %p \n",devMat); + fprintf(stderr,"%d %d %d %p %p %p\n",devMat->rows,devMat->cols, devMat->hackSize, + devMat->hackOffsets, devMat->hdiaOffsets, devMat->cM); +#endif + spgpuShdiaspmv (handle, (float*)y->v_, (float *)y->v_, alpha, + (float *)devMat->cM,devMat->hdiaOffsets, + devMat->hackSize, devMat->hackOffsets, devMat->rows,devMat->cols, + x->v_, beta); + + //cudaSync(); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +#endif diff --git a/gpu/hdiagdev.h b/gpu/hdiagdev.h new file mode 100644 index 000000000..4bce5066d --- /dev/null +++ b/gpu/hdiagdev.h @@ -0,0 +1,111 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _HDIAGDEV_H_ +#define _HDIAGDEV_H_ + +#ifdef HAVE_SPGPU +#include "cintrf.h" +#include "hdia.h" + +struct HdiagDevice +{ + // Compressed matrix + void *cM; //it can be float or double + + // offset (same size of cM) + int *hdiaOffsets; + + int *hackOffsets; + + int hackCount; + + int rows; + + int cols; + + + int hackSize; + + int allocationHeight; + +}; + +typedef struct HdiagDeviceParams +{ + + unsigned int elementType; + + // Number of rows. + // Used to allocate rS array + unsigned int rows; + //unsigned int hackOffsLength; + + // Number of columns. + // Used for error-checking + unsigned int columns; + + unsigned int hackSize; + unsigned int hackCount; + unsigned int allocationHeight; + + +} HdiagDeviceParams; + + + +HdiagDeviceParams getHdiagDeviceParams(unsigned int rows, unsigned int columns, + unsigned int allocationHeight, unsigned int hackSize, + unsigned int hackCount, unsigned int elementType); + +int FallocHdiagDevice(void** deviceMat, unsigned int rows, unsigned int cols, + unsigned int allocationHeight, unsigned int hackSize, + unsigned int hackCount, unsigned int elementType); + +int allocHdiagDevice(void ** remoteMatrix, HdiagDeviceParams* params); + + +void freeHdiagDevice(void* remoteMatrix); + +int writeHdiagDeviceFloat(void* deviceMat, float* val, int* hdiaOffsets, int *hackOffsets); +int spmvHdiagDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY); + +int writeHdiagDeviceDouble(void* deviceMat, double* val, int* hdiaOffsets, int *hackOffsets); +int spmvHdiagDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY); + + +#else +#define CINTRF_UNSUPPORTED -1 +#endif + +#endif diff --git a/gpu/hdiagdev_mod.F90 b/gpu/hdiagdev_mod.F90 new file mode 100644 index 000000000..ad0f7cc5c --- /dev/null +++ b/gpu/hdiagdev_mod.F90 @@ -0,0 +1,203 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 hdiagdev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: hdiagdev_parms + integer(c_int) :: element_type + integer(c_int) :: rows + integer(c_int) :: columns + integer(c_int) :: hackSize + integer(c_int) :: hackCount + integer(c_int) :: allocationHeight + end type hdiagdev_parms + +#ifdef HAVE_SPGPU + + ! interface computeHdiaHacksCount + ! function computeHdiaHacksCountDouble(allocationHeight,hackOffsets,hackSize, & + ! & diaValues,diaValuesPitch,diags,rows)& + ! & result(res) bind(c,name='computeHdiaHackOffsetsDouble') + ! use iso_c_binding + ! integer(c_int) :: res + ! integer(c_int), value :: rows,diags,diaValuesPitch,hackSize,elementType + ! real(c_double) :: diaValues(rows,:) + ! integer(c_int) :: hackOffsets,allocationHeight + ! end function computeHdiaHacksCountDouble + ! end interface computeHdiaHacksCount + + interface + function FgetHdiagDeviceParams(rows, columns, allocationHeight,hackSize, & + & hackCount, elementType) & + & result(res) bind(c,name='getHdiagDeviceParams') + use iso_c_binding + import :: hdiagdev_parms + type(hdiagdev_parms) :: res + integer(c_int), value :: rows,columns,allocationHeight,& + & elementType,hackSize,hackCount + end function FgetHdiagDeviceParams + end interface + + + interface + function FallocHdiagDevice(deviceMat,rows,columns,allocationHeight,& + & hackSize,hackCount,elementType) & + & result(res) bind(c,name='FallocHdiagDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: rows,columns,allocationHeight,hackSize,& + & hackCount,elementType + type(c_ptr) :: deviceMat + end function FallocHdiagDevice + end interface + + + interface + function sizeofHdiagDeviceDouble(deviceMat) & + & result(res) bind(c,name='sizeofHdiagDeviceDouble') + use iso_c_binding + integer(c_long_long) :: res + type(c_ptr), value :: deviceMat + end function sizeofHdiagDeviceDouble + end interface + + interface writeHdiagDevice + + function writeHdiagDeviceFloat(deviceMat,val,hdiaOffsets, hackOffsets) & + & result(res) bind(c,name='writeHdiagDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_float) :: val(*) + integer(c_int) :: hdiaOffsets(*), hackOffsets(*) + end function writeHdiagDeviceFloat + + function writeHdiagDeviceDouble(deviceMat,val,hdiaOffsets, hackOffsets) & + & result(res) bind(c,name='writeHdiagDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_double) :: val(*) + integer(c_int) :: hdiaOffsets(*), hackOffsets(*) + end function writeHdiagDeviceDouble + + end interface writeHdiagDevice + +!!$ interface readHdiagDevice +!!$ +!!$ function readHdiagDeviceFloat(deviceMat,val,ja,ldj,irn) & +!!$ & result(res) bind(c,name='readHdiagDeviceFloat') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat +!!$ integer(c_int), value :: ldj +!!$ real(c_float) :: val(ldj,*) +!!$ integer(c_int) :: ja(ldj,*),irn(*) +!!$ end function readHdiagDeviceFloat +!!$ +!!$ function readHdiagDeviceDouble(deviceMat,a,off,n) & +!!$ & result(res) bind(c,name='readHdiagDeviceDouble') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat +!!$ integer(c_int),value :: n +!!$ real(c_double) :: a(n,*) +!!$ integer(c_int) :: off(*) +!!$ end function readHdiagDeviceDouble +!!$ +!!$ function readHdiagDeviceFloatComplex(deviceMat,val,ja,ldj,irn) & +!!$ & result(res) bind(c,name='readHdiagDeviceFloatComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat +!!$ integer(c_int), value :: ldj +!!$ complex(c_float_complex) :: val(ldj,*) +!!$ integer(c_int) :: ja(ldj,*),irn(*) +!!$ end function readHdiagDeviceFloatComplex +!!$ +!!$ function readHdiagDeviceDoubleComplex(deviceMat,val,ja,ldj,irn) & +!!$ & result(res) bind(c,name='readHdiagDeviceDoubleComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat +!!$ integer(c_int), value :: ldj +!!$ complex(c_double_complex) :: val(ldj,*) +!!$ integer(c_int) :: ja(ldj,*),irn(*) +!!$ end function readHdiagDeviceDoubleComplex +!!$ +!!$ end interface readHdiagDevice +!!$ + interface + subroutine freeHdiagDevice(deviceMat) & + & bind(c,name='freeHdiagDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine freeHdiagDevice + end interface + + + interface spmvHdiagDevice + function spmvHdiagDeviceFloat(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHdiagDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_float),value :: alpha, beta + end function spmvHdiagDeviceFloat + function spmvHdiagDeviceDouble(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHdiagDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_double),value :: alpha, beta + end function spmvHdiagDeviceDouble +!!$ function spmvHdiagDeviceFloatComplex(deviceMat,alpha,x,beta,y) & +!!$ & result(res) bind(c,name='spmvHdiagDeviceFloatComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat, x, y +!!$ complex(c_float_complex),value :: alpha, beta +!!$ end function spmvHdiagDeviceFloatComplex +!!$ function spmvHdiagDeviceDoubleComplex(deviceMat,alpha,x,beta,y) & +!!$ & result(res) bind(c,name='spmvHdiagDeviceDoubleComplex') +!!$ use iso_c_binding +!!$ integer(c_int) :: res +!!$ type(c_ptr), value :: deviceMat, x, y +!!$ complex(c_double_complex),value :: alpha, beta +!!$ end function spmvHdiagDeviceDoubleComplex + end interface spmvHdiagDevice + +#endif + +end module hdiagdev_mod diff --git a/gpu/hlldev.c b/gpu/hlldev.c new file mode 100644 index 000000000..afff1df10 --- /dev/null +++ b/gpu/hlldev.c @@ -0,0 +1,615 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 "hlldev.h" +#if defined(HAVE_SPGPU) +//new +HllDeviceParams bldHllDeviceParams(unsigned int hksize, unsigned int rows, unsigned int nzeros, + unsigned int allocsize, unsigned int elementType, unsigned int firstIndex) +{ + HllDeviceParams params; + + params.elementType = elementType; + params.hackSize = hksize; + //numero di elementi di val + params.allocsize = allocsize; + params.rows = rows; + params.nzt = nzeros; + params.avgNzr = (nzeros+rows-1)/rows; + params.firstIndex = firstIndex; + return params; + +} + +int getHllDeviceParams(HllDevice* mat, int *hksize, int *rows, int *nzeros, + int *allocsize, int *hackOffsLength, int *firstIndex, int *avgnzr) +{ + + + if (mat!=NULL) { + *hackOffsLength = mat->hackOffsLength ; + *hksize = mat->hackSize ; + *nzeros = mat->nzt ; + *allocsize = mat->allocsize ; + *rows = mat->rows ; + *avgnzr = mat->avgNzr ; + *firstIndex = mat->baseIndex ; + return SPGPU_SUCCESS; + } else { + return SPGPU_UNSUPPORTED; + } +} +//new +int allocHllDevice(void ** remoteMatrix, HllDeviceParams* params) +{ + HllDevice *tmp = (HllDevice *)malloc(sizeof(HllDevice)); + int ret=SPGPU_SUCCESS; + *remoteMatrix = (void *)tmp; + + tmp->hackSize = params->hackSize; + + tmp->allocsize = params->allocsize; + + tmp->rows = params->rows; + tmp->avgNzr = params->avgNzr; + tmp->nzt = params->nzt; + tmp->baseIndex = params->firstIndex; + //fprintf(stderr,"Allocating HLG with %d avgNzr\n",params->avgNzr); + tmp->hackOffsLength = (int)(tmp->rows+tmp->hackSize-1)/tmp->hackSize; + + //printf("hackOffsLength %d\n",tmp->hackOffsLength); + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->rP), tmp->allocsize*sizeof(int)); + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->rS), tmp->rows*sizeof(int)); + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->diag), tmp->rows*sizeof(int)); + + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->hackOffs), ((tmp->hackOffsLength+1)*sizeof(int))); + + if (params->elementType == SPGPU_TYPE_INT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(int)); + } + else if (params->elementType == SPGPU_TYPE_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(float)); + } + else if (params->elementType == SPGPU_TYPE_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(double)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuFloatComplex)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + { + if (ret == SPGPU_SUCCESS) + ret=allocRemoteBuffer((void **)&(tmp->cM), tmp->allocsize*sizeof(cuDoubleComplex)); + } + else + return SPGPU_UNSUPPORTED; // Unsupported params + return ret; +} + +void freeHllDevice(void* remoteMatrix) +{ + HllDevice *devMat = (HllDevice *) remoteMatrix; + //fprintf(stderr,"freeHllDevice\n"); + if (devMat != NULL) { + freeRemoteBuffer(devMat->rS); + freeRemoteBuffer(devMat->diag); + freeRemoteBuffer(devMat->rP); + freeRemoteBuffer(devMat->cM); + free(remoteMatrix); + } +} + +//new +int FallocHllDevice(void** deviceMat,unsigned int hksize, unsigned int rows, unsigned int nzeros, + unsigned int allocsize, + unsigned int elementType, unsigned int firstIndex) +{ int i; +#ifdef HAVE_SPGPU + HllDeviceParams p; + + p = bldHllDeviceParams(hksize, rows, nzeros, allocsize, elementType, firstIndex); + i = allocHllDevice(deviceMat, &p); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocEllDevice",i); + } + return(i); +#else + return SPGPU_UNSUPPORTED; +#endif +} + + +int spmvHllDeviceFloat(void *deviceMat, float alpha, void* deviceX, + float beta, void* deviceY) +{ + HllDevice *devMat = (HllDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + /*dspmdmm_gpu ((double *)z->v_, y->count_, y->pitch_, (double *)y->v_, alpha, (double *)devMat->cM, + devMat->rP, devMat->rS, devMat->rows, devMat->pitch, (double *)x->v_, beta, + devMat->baseIndex);*/ + + spgpuShellspmv (handle, (float *)y->v_, (float *)y->v_, alpha, (float *)devMat->cM, + devMat->rP,devMat->hackSize,devMat->hackOffs, devMat->rS, NULL, + devMat->avgNzr, devMat->rows, (float *)x->v_, beta, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +//new +int spmvHllDeviceDouble(void *deviceMat, double alpha, void* deviceX, + double beta, void* deviceY) +{ + HllDevice *devMat = (HllDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + /*dspmdmm_gpu ((double *)z->v_, y->count_, y->pitch_, (double *)y->v_, alpha, (double *)devMat->cM, + devMat->rP, devMat->rS, devMat->rows, devMat->pitch, (double *)x->v_, beta, + devMat->baseIndex);*/ + + spgpuDhellspmv (handle, (double *)y->v_, (double *)y->v_, alpha, (double*)devMat->cM, + devMat->rP,devMat->hackSize,devMat->hackOffs, devMat->rS, NULL, + devMat->avgNzr, devMat->rows, (double *)x->v_, beta, devMat->baseIndex); + //cudaSync(); + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvHllDeviceFloatComplex(void *deviceMat, float complex alpha, void* deviceX, + float complex beta, void* deviceY) +{ + HllDevice *devMat = (HllDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU + cuFloatComplex a = make_cuFloatComplex(crealf(alpha),cimagf(alpha)); + cuFloatComplex b = make_cuFloatComplex(crealf(beta),cimagf(beta)); +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + /*dspmdmm_gpu ((double *)z->v_, y->count_, y->pitch_, (double *)y->v_, alpha, (double *)devMat->cM, + devMat->rP, devMat->rS, devMat->rows, devMat->pitch, (double *)x->v_, beta, + devMat->baseIndex);*/ + + spgpuChellspmv (handle, (cuFloatComplex *)y->v_, (cuFloatComplex *)y->v_, a, (cuFloatComplex *)devMat->cM, + devMat->rP,devMat->hackSize,devMat->hackOffs, devMat->rS, NULL, + devMat->avgNzr, devMat->rows, (cuFloatComplex *)x->v_, b, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int spmvHllDeviceDoubleComplex(void *deviceMat, double complex alpha, void* deviceX, + double complex beta, void* deviceY) +{ + HllDevice *devMat = (HllDevice *) deviceMat; + struct MultiVectDevice *x = (struct MultiVectDevice *) deviceX; + struct MultiVectDevice *y = (struct MultiVectDevice *) deviceY; + spgpuHandle_t handle=psb_gpuGetHandle(); + +#ifdef HAVE_SPGPU + cuDoubleComplex a = make_cuDoubleComplex(creal(alpha),cimag(alpha)); + cuDoubleComplex b = make_cuDoubleComplex(creal(beta),cimag(beta)); +#ifdef VERBOSE + /*__assert(x->count_ == x->count_, "ERROR: x and y don't share the same number of vectors");*/ + /*__assert(x->size_ >= devMat->columns, "ERROR: x vector's size is not >= to matrix size (columns)");*/ + /*__assert(y->size_ >= devMat->rows, "ERROR: y vector's size is not >= to matrix size (rows)");*/ +#endif + + spgpuZhellspmv (handle, (cuDoubleComplex *)y->v_, (cuDoubleComplex *)y->v_, a, (cuDoubleComplex *)devMat->cM, + devMat->rP,devMat->hackSize,devMat->hackOffs, devMat->rS, NULL, + devMat->avgNzr,devMat->rows, (cuDoubleComplex *)x->v_, b, devMat->baseIndex); + + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeHllDeviceFloat(void* deviceMat, float* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(float)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + //i = writeEllDevice(deviceMat, (void *) val, ja, irn); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeHllDeviceDouble(void* deviceMat, double* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(double)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeHllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuFloatComplex)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int writeHllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + // Ex updateFromHost function + i = writeRemoteBuffer((void*) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuDoubleComplex)); + i = writeRemoteBuffer((void*) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = writeRemoteBuffer((void*) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = writeRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readHllDeviceFloat(void* deviceMat, float* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(float)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*i = readEllDevice(deviceMat, (void *) val, ja, irn); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceFloat",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readHllDeviceDouble(void* deviceMat, double* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(double)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void *) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readHllDeviceFloatComplex(void* deviceMat, float complex* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuFloatComplex)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int readHllDeviceDoubleComplex(void* deviceMat, double complex* val, int* ja, int *hkoffs, int* irn, int *idiag) +{ int i; +#ifdef HAVE_SPGPU + HllDevice *devMat = (HllDevice *) deviceMat; + i = readRemoteBuffer((void *) val, (void *)devMat->cM, devMat->allocsize*sizeof(cuDoubleComplex)); + i = readRemoteBuffer((void *) ja, (void *)devMat->rP, devMat->allocsize*sizeof(int)); + i = readRemoteBuffer((void *) irn, (void *)devMat->rS, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void*) idiag, (void *)devMat->diag, devMat->rows*sizeof(int)); + i = readRemoteBuffer((void*) hkoffs, (void *)devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + /*if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readEllDeviceDouble",i); + }*/ + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +// New copy routines. + +int psiCopyCooToHlgFloat(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + float *val, void *deviceMat) +{ int i,j; +#ifdef HAVE_SPGPU + spgpuHandle_t handle; + HllDevice *devMat = (HllDevice *) deviceMat; + float *devVal; + int *devIdisp, *devJa; + int *tja; + //fprintf(stderr,"devMat: %p\n",devMat); + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(float)); + + // fprintf(stderr,"Writing: %d %d %d %d %d %d %d\n",nr,devMat->rows,nza,isz, hoffs[noffs], noffs, devMat->hackOffsLength); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(float)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) hoffs, (void *) devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + //cudaSync(); + + handle = psb_gpuGetHandle(); + psi_cuda_s_CopyCooToHlg(handle, nr,nc,nza,devMat->baseIndex,hacksz,noffs,isz, + (int *) devMat->rS, (int *) devMat->hackOffs, + devIdisp,devJa,devVal, + (int *) devMat->diag, (int *) devMat->rP, (float *)devMat->cM); + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeHllDeviceFloat",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int psiCopyCooToHlgDouble(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + double *val, void *deviceMat) +{ int i,j; +#ifdef HAVE_SPGPU + spgpuHandle_t handle; + HllDevice *devMat = (HllDevice *) deviceMat; + double *devVal; + int *devIdisp, *devJa; + int *tja; + //fprintf(stderr,"devMat: %p\n",devMat); + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(double)); + + // fprintf(stderr,"Writing: %d %d %d %d %d %d %d\n",nr,devMat->rows,nza,isz, hoffs[noffs], noffs, devMat->hackOffsLength); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(double)); + //fprintf(stderr,"WriteRemoteBuffer val %d\n",i); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + //fprintf(stderr,"WriteRemoteBuffer ja %d\n",i); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + //fprintf(stderr,"WriteRemoteBuffer irn %d\n",i); + if (i==0) i = writeRemoteBuffer((void*) hoffs, (void *) devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + //fprintf(stderr,"WriteRemoteBuffer hoffs %d\n",i); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + //fprintf(stderr,"WriteRemoteBuffer idisp %d\n",i); + //cudaSync(); + //fprintf(stderr," hacksz: %d \n",hacksz); + handle = psb_gpuGetHandle(); + psi_cuda_d_CopyCooToHlg(handle, nr,nc,nza,devMat->baseIndex,hacksz,noffs,isz, + (int *) devMat->rS, (int *) devMat->hackOffs, + devIdisp,devJa,devVal, + (int *) devMat->diag, (int *) devMat->rP, (double *)devMat->cM); + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeHllDeviceDouble",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int psiCopyCooToHlgFloatComplex(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + float complex *val, void *deviceMat) +{ int i,j; +#ifdef HAVE_SPGPU + spgpuHandle_t handle; + HllDevice *devMat = (HllDevice *) deviceMat; + float complex *devVal; + int *devIdisp, *devJa; + int *tja; + //fprintf(stderr,"devMat: %p\n",devMat); + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(cuFloatComplex)); + + // fprintf(stderr,"Writing: %d %d %d %d %d %d %d\n",nr,devMat->rows,nza,isz, hoffs[noffs], noffs, devMat->hackOffsLength); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(cuFloatComplex)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) hoffs, (void *) devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + //cudaSync(); + + handle = psb_gpuGetHandle(); + psi_cuda_c_CopyCooToHlg(handle, nr,nc,nza,devMat->baseIndex,hacksz,noffs,isz, + (int *) devMat->rS, (int *) devMat->hackOffs, + devIdisp,devJa,devVal, + (int *) devMat->diag,(int *) devMat->rP, (float complex *)devMat->cM); + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeHllDeviceFloatComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + +int psiCopyCooToHlgDoubleComplex(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + double complex *val, void *deviceMat) +{ int i,j; +#ifdef HAVE_SPGPU + spgpuHandle_t handle; + HllDevice *devMat = (HllDevice *) deviceMat; + double complex *devVal; + int *devIdisp, *devJa; + int *tja; + //fprintf(stderr,"devMat: %p\n",devMat); + allocRemoteBuffer((void **)&(devIdisp), (nr+1)*sizeof(int)); + allocRemoteBuffer((void **)&(devJa), (nza)*sizeof(int)); + allocRemoteBuffer((void **)&(devVal), (nza)*sizeof(cuDoubleComplex)); + + // fprintf(stderr,"Writing: %d %d %d %d %d %d %d\n",nr,devMat->rows,nza,isz, hoffs[noffs], noffs, devMat->hackOffsLength); + i = writeRemoteBuffer((void*) val, (void *)devVal, nza*sizeof(cuDoubleComplex)); + if (i==0) i = writeRemoteBuffer((void*) ja, (void *) devJa, nza*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) irn, (void *) devMat->rS, devMat->rows*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) hoffs, (void *) devMat->hackOffs, (devMat->hackOffsLength+1)*sizeof(int)); + if (i==0) i = writeRemoteBuffer((void*) idisp, (void *) devIdisp, (devMat->rows+1)*sizeof(int)); + //cudaSync(); + + handle = psb_gpuGetHandle(); + psi_cuda_z_CopyCooToHlg(handle, nr,nc,nza,devMat->baseIndex,hacksz,noffs,isz, + (int *) devMat->rS, (int *) devMat->hackOffs, + devIdisp,devJa,devVal, + (int *) devMat->diag,(int *) devMat->rP, (double complex *)devMat->cM); + + freeRemoteBuffer(devIdisp); + freeRemoteBuffer(devJa); + freeRemoteBuffer(devVal); + + /*i = writeEllDevice(deviceMat, (void *) val, ja, irn);*/ + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeHllDeviceDoubleComplex",i); + } + return SPGPU_SUCCESS; +#else + return SPGPU_UNSUPPORTED; +#endif +} + + + + + +#endif diff --git a/gpu/hlldev.h b/gpu/hlldev.h new file mode 100644 index 000000000..478ad86e0 --- /dev/null +++ b/gpu/hlldev.h @@ -0,0 +1,161 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 _HLLDEV_H_ +#define _HLLDEV_H_ + +#ifdef HAVE_SPGPU +#include "cintrf.h" +#include "hell.h" + + +typedef struct hlldevice +{ + // Compressed matrix + void *cM; //it can be float or double + + // row pointers (same size of cM) + int *rP; + + // row size and diagonal position + int *rS; + int *diag; + + int *hackOffs; + + int rows; + int avgNzr; + int hackOffsLength; + int nzt; + int hackSize; //must be multiple of 32 + + //matrix size (uncompressed) + //int rows; + //int columns; + + //allocation size + int allocsize; + + /*(i.e. 0 for C, 1 for Fortran)*/ + int baseIndex; +} HllDevice; + +typedef struct hlldeviceparams +{ + + unsigned int elementType; + + unsigned int hackSize; + + // Number of rows. + // Used to allocate rS array + unsigned int rows; + unsigned int avgNzr; + unsigned int nzt; + //unsigned int hackOffsLength; + + // Number of columns. + // Used for error-checking + // unsigned int columns; + + unsigned int allocsize; + + // First index (e.g 0 or 1) + unsigned int firstIndex; + +} HllDeviceParams; + + +HllDeviceParams bldHllDeviceParams(unsigned int hksize, unsigned int rows, unsigned int nzeros, + unsigned int allocsize, + unsigned int elementType, unsigned int firstIndex); +int getHllDeviceParams(HllDevice* mat, int *hksize, int *rows, int *nzeros, + int *allocsize, int *hackOffsLength, int *firstIndex, int *avgnzr); +int FallocHllDevice(void** deviceMat,unsigned int hksize, unsigned int rows, unsigned int nzeros, + unsigned int allocsize, unsigned int elementType, unsigned int firstIndex); +int allocHllDevice(void ** remoteMatrix, HllDeviceParams* params); +void freeHllDevice(void* remoteMatrix); +int writeHllDeviceFloat(void* deviceMat, float* val, int* ja, int *hkoffs, int* irn, int *idiag); +int writeHllDeviceDouble(void* deviceMat, double* val, int* ja, int *hkoffs, int* irn, int *idiag); +int writeHllDeviceFloatComplex(void* deviceMat, float complex* val, + int* ja, int *hkoffs, int* irn, int *idiag); +int writeHllDeviceDoubleComplex(void* deviceMat, double complex* val, + int* ja, int *hkoffs, int* irn, int *idiag); +int readHllDeviceFloat(void* deviceMat, float* val, int* ja, int *hkoffs, int* irn, int *idiag); +int readHllDeviceDouble(void* deviceMat, double* val, int* ja, int *hkoffs, int* irn, int *idiag); +int readHllDeviceFloatComplex(void* deviceMat, float complex* val, + int* ja, int *hkoffs, int* irn, int *idiag); +int readHllDeviceDoubleComplex(void* deviceMat, double complex* val, + int* ja, int *hkoffs, int* irn, int *idiag); + + +int psiCopyCooToHlgFloat(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + float *val, void *deviceMat); +int psiCopyCooToHlgDouble(int nr, int nc, int nza, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, int *ja, + double *val, void *deviceMat); +int psiCopyCooToHlgFloatComplex(int nr, int nc, int nza, int hacksz, + int noffs, int isz, int *irn, + int *hoffs, int *idisp, int *ja, + float complex *val, void *deviceMat); +int psiCopyCooToHlgDoubleComplex(int nr, int nc, int nza, int hacksz, + int noffs, int isz, int *irn, + int *hoffs, int *idisp, int *ja, + double complex *val, void *deviceMat); + +int psi_cuda_s_CopyCooToHlg(spgpuHandle_t handle,int nr, int nc, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, + int *ja, float *val, + int *idiag, int *rP, float *cM); +int psi_cuda_d_CopyCooToHlg(spgpuHandle_t handle,int nr, int nc, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, + int *ja, double *val, + int *idiag, int *rP, double *cM); +int psi_cuda_c_CopyCooToHlg(spgpuHandle_t handle,int nr, int nc, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, + int *ja, float complex *val, + int *idiag, int *rP, float complex *cM); +int psi_cuda_z_CopyCooToHlg(spgpuHandle_t handle,int nr, int nc, int nza, + int baseIdx, int hacksz, int noffs, int isz, + int *irn, int *hoffs, int *idisp, + int *ja, double complex *val, + int *idiag, int *rP, double complex *cM); + + +#else +#define CINTRF_UNSUPPORTED -1 +#endif + +#endif diff --git a/gpu/hlldev_mod.F90 b/gpu/hlldev_mod.F90 new file mode 100644 index 000000000..4eaa5ce04 --- /dev/null +++ b/gpu/hlldev_mod.F90 @@ -0,0 +1,273 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 hlldev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: hlldev_parms + integer(c_int) :: element_type + integer(c_int) :: hackSize + integer(c_int) :: rows + integer(c_int) :: avgNzr + integer(c_int) :: allocsize + integer(c_int) :: firstIndex + end type hlldev_parms + +#ifdef HAVE_SPGPU + + interface + function bldHllDeviceParams(hksize, rows, nzeros, allocsize, elementType, firstIndex) & + & result(res) bind(c,name='bldHllDeviceParams') + use iso_c_binding + import :: hlldev_parms + type(hlldev_parms) :: res + integer(c_int), value :: hksize,rows,nzeros,allocsize,elementType,firstIndex + end function BldHllDeviceParams + end interface + + interface + function getHllDeviceParams(deviceMat,hksize, rows, nzeros, allocsize,& + & hackOffsLength, firstIndex,avgnzr) & + & result(res) bind(c,name='getHllDeviceParams') + use iso_c_binding + import :: hlldev_parms + integer(c_int) :: res + type(c_ptr), value :: deviceMat + integer(c_int) :: hksize,rows,nzeros,allocsize,hackOffsLength,firstIndex,avgnzr + end function GetHllDeviceParams + end interface + + + interface + function FallocHllDevice(deviceMat,hksize,rows, nzeros,allocsize, & + & elementType,firstIndex) & + & result(res) bind(c,name='FallocHllDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: hksize,rows,nzeros,allocsize,elementType,firstIndex + type(c_ptr) :: deviceMat + end function FallocHllDevice + end interface + + + interface writeHllDevice + + function writeHllDeviceFloat(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='writeHllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_float) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function writeHllDeviceFloat + + function writeHllDeviceDouble(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='writeHllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_double) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function writeHllDeviceDouble + + function writeHllDeviceFloatComplex(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='writeHllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + complex(c_float_complex) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function writeHllDeviceFloatComplex + + function writeHllDeviceDoubleComplex(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='writeHllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + complex(c_double_complex) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function writeHllDeviceDoubleComplex + + end interface + + interface readHllDevice + + function readHllDeviceFloat(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='readHllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_float) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function readHllDeviceFloat + + function readHllDeviceDouble(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='readHllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + real(c_double) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function readHllDeviceDouble + + function readHllDeviceFloatComplex(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='readHllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + complex(c_float_complex) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function readHllDeviceFloatComplex + + function readHllDeviceDoubleComplex(deviceMat,val,ja,hkoffs,irn,idiag) & + & result(res) bind(c,name='readHllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat + complex(c_double_complex) :: val(*) + integer(c_int) :: ja(*),irn(*),hkoffs(*),idiag(*) + end function readHllDeviceDoubleComplex + + end interface + + interface + subroutine freeHllDevice(deviceMat) & + & bind(c,name='freeHllDevice') + use iso_c_binding + type(c_ptr), value :: deviceMat + end subroutine freeHllDevice + end interface + + + interface psi_CopyCooToHlg + function psiCopyCooToHlgFloat(nr, nc, nza, hacksz, noffs, isz, irn, & + & hoffs, idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToHlgFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,noffs,isz + type(c_ptr), value :: deviceMat + real(c_float) :: val(*) + integer(c_int) :: irn(*), idisp(*), ja(*), hoffs(*) + end function psiCopyCooToHlgFloat + function psiCopyCooToHlgDouble(nr, nc, nza, hacksz, noffs, isz, irn, & + & hoffs, idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToHlgDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,noffs,isz + type(c_ptr), value :: deviceMat + real(c_double) :: val(*) + integer(c_int) :: irn(*), idisp(*), ja(*), hoffs(*) + end function psiCopyCooToHlgDouble + function psiCopyCooToHlgFloatComplex(nr, nc, nza, hacksz, noffs, isz, irn, & + & hoffs, idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToHlgFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,noffs,isz + type(c_ptr), value :: deviceMat + complex(c_float_complex) :: val(*) + integer(c_int) :: irn(*), idisp(*), ja(*), hoffs(*) + end function psiCopyCooToHlgFloatComplex + function psiCopyCooToHlgDoubleComplex(nr, nc, nza, hacksz, noffs, isz, irn, & + & hoffs, idisp, ja, val, deviceMat) & + & result(res) bind(c,name='psiCopyCooToHlgDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: nr,nc,nza,hacksz,noffs,isz + type(c_ptr), value :: deviceMat + complex(c_double_complex) :: val(*) + integer(c_int) :: irn(*), idisp(*), ja(*), hoffs(*) + end function psiCopyCooToHlgDoubleComplex + end interface + + + !interface + ! function getHllDevicePitch(deviceMat) & + ! & bind(c,name='getHllDevicePitch') result(res) + ! use iso_c_binding + ! type(c_ptr), value :: deviceMat + ! integer(c_int) :: res + ! end function getHllDevicePitch + !end interface + + !interface + ! function getHllDeviceMaxRowSize(deviceMat) & + ! & bind(c,name='getHllDeviceMaxRowSize') result(res) + ! use iso_c_binding + ! type(c_ptr), value :: deviceMat + ! integer(c_int) :: res + ! end function getHllDeviceMaxRowSize + !end interface + + interface spmvHllDevice + + function spmvHllDeviceFloat(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHllDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_float),value :: alpha, beta + end function spmvHllDeviceFloat + + function spmvHllDeviceDouble(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHllDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + real(c_double),value :: alpha, beta + end function spmvHllDeviceDouble + + function spmvHllDeviceFloatComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHllDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_float_complex),value :: alpha, beta + end function spmvHllDeviceFloatComplex + + function spmvHllDeviceDoubleComplex(deviceMat,alpha,x,beta,y) & + & result(res) bind(c,name='spmvHllDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceMat, x, y + complex(c_double_complex),value :: alpha, beta + end function spmvHllDeviceDoubleComplex + + end interface + +#endif + + +end module hlldev_mod diff --git a/gpu/impl/Makefile b/gpu/impl/Makefile new file mode 100755 index 000000000..158066f2e --- /dev/null +++ b/gpu/impl/Makefile @@ -0,0 +1,294 @@ +include ../../Make.inc +LIBDIR=../../lib +INCDIR=../../include +MODDIR=../../modules +PSBLAS_LIB= -L$(PSBLIBDIR) -lpsb_util -lpsb_base +#-lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base +LDLIBS=$(PSBLDLIBS) +# +# Compilers and such +# +#CCOPT= -g +FINCLUDES=$(FMFLAG).. $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(FIFLAG).. +CINCLUDES=-I$(GPU_INCDIR) -I$(CUDA_INCDIR) +LIBNAME=libpsb_gpu.a + +OBJS= \ +psb_d_cp_csrg_from_coo.o \ +psb_d_cp_csrg_from_fmt.o \ +psb_d_cp_elg_from_coo.o \ +psb_d_cp_elg_from_fmt.o \ +psb_s_cp_csrg_from_coo.o \ +psb_s_cp_csrg_from_fmt.o \ +psb_s_csrg_allocate_mnnz.o \ +psb_s_csrg_csmm.o \ +psb_s_csrg_csmv.o \ +psb_s_csrg_mold.o \ +psb_s_csrg_reallocate_nz.o \ +psb_s_csrg_scal.o \ +psb_s_csrg_scals.o \ +psb_s_csrg_from_gpu.o \ +psb_s_csrg_to_gpu.o \ +psb_s_csrg_vect_mv.o \ +psb_s_csrg_inner_vect_sv.o \ +psb_d_csrg_allocate_mnnz.o \ +psb_d_csrg_csmm.o \ +psb_d_csrg_csmv.o \ +psb_d_csrg_mold.o \ +psb_d_csrg_reallocate_nz.o \ +psb_d_csrg_scal.o \ +psb_d_csrg_scals.o \ +psb_d_csrg_from_gpu.o \ +psb_d_csrg_to_gpu.o \ +psb_d_csrg_vect_mv.o \ +psb_d_csrg_inner_vect_sv.o \ +psb_d_elg_allocate_mnnz.o \ +psb_d_elg_asb.o \ +psb_d_elg_csmm.o \ +psb_d_elg_csmv.o \ +psb_d_elg_csput.o \ +psb_d_elg_from_gpu.o \ +psb_d_elg_inner_vect_sv.o \ +psb_d_elg_mold.o \ +psb_d_elg_reallocate_nz.o \ +psb_d_elg_scal.o \ +psb_d_elg_scals.o \ +psb_d_elg_to_gpu.o \ +psb_d_elg_vect_mv.o \ +psb_d_mv_csrg_from_coo.o \ +psb_d_mv_csrg_from_fmt.o \ +psb_d_mv_elg_from_coo.o \ +psb_d_mv_elg_from_fmt.o \ +psb_s_mv_csrg_from_coo.o \ +psb_s_mv_csrg_from_fmt.o \ +psb_s_cp_elg_from_coo.o \ +psb_s_cp_elg_from_fmt.o \ +psb_s_elg_allocate_mnnz.o \ +psb_s_elg_asb.o \ +psb_s_elg_csmm.o \ +psb_s_elg_csmv.o \ +psb_s_elg_csput.o \ +psb_s_elg_inner_vect_sv.o \ +psb_s_elg_mold.o \ +psb_s_elg_reallocate_nz.o \ +psb_s_elg_scal.o \ +psb_s_elg_scals.o \ +psb_s_elg_to_gpu.o \ +psb_s_elg_from_gpu.o \ +psb_s_elg_vect_mv.o \ +psb_s_mv_elg_from_coo.o \ +psb_s_mv_elg_from_fmt.o \ +psb_s_cp_hlg_from_fmt.o \ +psb_s_cp_hlg_from_coo.o \ +psb_d_cp_hlg_from_fmt.o \ +psb_d_cp_hlg_from_coo.o \ +psb_d_hlg_allocate_mnnz.o \ +psb_d_hlg_csmm.o \ +psb_d_hlg_csmv.o \ +psb_d_hlg_inner_vect_sv.o \ +psb_d_hlg_mold.o \ +psb_d_hlg_reallocate_nz.o \ +psb_d_hlg_scal.o \ +psb_d_hlg_scals.o \ +psb_d_hlg_from_gpu.o \ +psb_d_hlg_to_gpu.o \ +psb_d_hlg_vect_mv.o \ +psb_s_hlg_allocate_mnnz.o \ +psb_s_hlg_csmm.o \ +psb_s_hlg_csmv.o \ +psb_s_hlg_inner_vect_sv.o \ +psb_s_hlg_mold.o \ +psb_s_hlg_reallocate_nz.o \ +psb_s_hlg_scal.o \ +psb_s_hlg_scals.o \ +psb_s_hlg_from_gpu.o \ +psb_s_hlg_to_gpu.o \ +psb_s_hlg_vect_mv.o \ +psb_s_mv_hlg_from_coo.o \ +psb_s_cp_hlg_from_coo.o \ +psb_s_mv_hlg_from_fmt.o \ +psb_d_mv_hlg_from_coo.o \ +psb_d_cp_hlg_from_coo.o \ +psb_d_mv_hlg_from_fmt.o \ +psb_s_hybg_allocate_mnnz.o \ +psb_s_hybg_csmm.o \ +psb_s_hybg_csmv.o \ +psb_s_hybg_reallocate_nz.o \ +psb_s_hybg_scal.o \ +psb_s_hybg_scals.o \ +psb_s_hybg_to_gpu.o \ +psb_s_hybg_vect_mv.o \ +psb_s_hybg_inner_vect_sv.o \ +psb_s_cp_hybg_from_coo.o \ +psb_s_cp_hybg_from_fmt.o \ +psb_s_mv_hybg_from_fmt.o \ +psb_s_mv_hybg_from_coo.o \ +psb_s_hybg_mold.o \ +psb_d_hybg_allocate_mnnz.o \ +psb_d_hybg_csmm.o \ +psb_d_hybg_csmv.o \ +psb_d_hybg_reallocate_nz.o \ +psb_d_hybg_scal.o \ +psb_d_hybg_scals.o \ +psb_d_hybg_to_gpu.o \ +psb_d_hybg_vect_mv.o \ +psb_d_hybg_inner_vect_sv.o \ +psb_d_cp_hybg_from_coo.o \ +psb_d_cp_hybg_from_fmt.o \ +psb_d_mv_hybg_from_fmt.o \ +psb_d_mv_hybg_from_coo.o \ +psb_d_hybg_mold.o \ +psb_z_cp_csrg_from_coo.o \ +psb_z_cp_csrg_from_fmt.o \ +psb_z_cp_elg_from_coo.o \ +psb_z_cp_elg_from_fmt.o \ +psb_c_cp_csrg_from_coo.o \ +psb_c_cp_csrg_from_fmt.o \ +psb_c_csrg_allocate_mnnz.o \ +psb_c_csrg_csmm.o \ +psb_c_csrg_csmv.o \ +psb_c_csrg_mold.o \ +psb_c_csrg_reallocate_nz.o \ +psb_c_csrg_scal.o \ +psb_c_csrg_scals.o \ +psb_c_csrg_from_gpu.o \ +psb_c_csrg_to_gpu.o \ +psb_c_csrg_vect_mv.o \ +psb_c_csrg_inner_vect_sv.o \ +psb_z_csrg_allocate_mnnz.o \ +psb_z_csrg_csmm.o \ +psb_z_csrg_csmv.o \ +psb_z_csrg_mold.o \ +psb_z_csrg_reallocate_nz.o \ +psb_z_csrg_scal.o \ +psb_z_csrg_scals.o \ +psb_z_csrg_from_gpu.o \ +psb_z_csrg_to_gpu.o \ +psb_z_csrg_vect_mv.o \ +psb_z_csrg_inner_vect_sv.o \ +psb_z_elg_allocate_mnnz.o \ +psb_z_elg_asb.o \ +psb_z_elg_csmm.o \ +psb_z_elg_csmv.o \ +psb_z_elg_csput.o \ +psb_z_elg_inner_vect_sv.o \ +psb_z_elg_mold.o \ +psb_z_elg_reallocate_nz.o \ +psb_z_elg_scal.o \ +psb_z_elg_scals.o \ +psb_z_elg_to_gpu.o \ +psb_z_elg_from_gpu.o \ +psb_z_elg_vect_mv.o \ +psb_z_mv_csrg_from_coo.o \ +psb_z_mv_csrg_from_fmt.o \ +psb_z_mv_elg_from_coo.o \ +psb_z_mv_elg_from_fmt.o \ +psb_c_mv_csrg_from_coo.o \ +psb_c_mv_csrg_from_fmt.o \ +psb_c_cp_elg_from_coo.o \ +psb_c_cp_elg_from_fmt.o \ +psb_c_elg_allocate_mnnz.o \ +psb_c_elg_asb.o \ +psb_c_elg_csmm.o \ +psb_c_elg_csmv.o \ +psb_c_elg_csput.o \ +psb_c_elg_inner_vect_sv.o \ +psb_c_elg_mold.o \ +psb_c_elg_reallocate_nz.o \ +psb_c_elg_scal.o \ +psb_c_elg_scals.o \ +psb_c_elg_to_gpu.o \ +psb_c_elg_from_gpu.o \ +psb_c_elg_vect_mv.o \ +psb_c_mv_elg_from_coo.o \ +psb_c_mv_elg_from_fmt.o \ +psb_c_cp_hlg_from_fmt.o \ +psb_c_cp_hlg_from_coo.o \ +psb_z_cp_hlg_from_fmt.o \ +psb_z_cp_hlg_from_coo.o \ +psb_z_hlg_allocate_mnnz.o \ +psb_z_hlg_csmm.o \ +psb_z_hlg_csmv.o \ +psb_z_hlg_inner_vect_sv.o \ +psb_z_hlg_mold.o \ +psb_z_hlg_reallocate_nz.o \ +psb_z_hlg_scal.o \ +psb_z_hlg_scals.o \ +psb_z_hlg_from_gpu.o \ +psb_z_hlg_to_gpu.o \ +psb_z_hlg_vect_mv.o \ +psb_c_hlg_allocate_mnnz.o \ +psb_c_hlg_csmm.o \ +psb_c_hlg_csmv.o \ +psb_c_hlg_inner_vect_sv.o \ +psb_c_hlg_mold.o \ +psb_c_hlg_reallocate_nz.o \ +psb_c_hlg_scal.o \ +psb_c_hlg_scals.o \ +psb_c_hlg_from_gpu.o \ +psb_c_hlg_to_gpu.o \ +psb_c_hlg_vect_mv.o \ +psb_c_mv_hlg_from_coo.o \ +psb_c_cp_hlg_from_coo.o \ +psb_c_mv_hlg_from_fmt.o \ +psb_z_mv_hlg_from_coo.o \ +psb_z_cp_hlg_from_coo.o \ +psb_z_mv_hlg_from_fmt.o \ +psb_c_hybg_allocate_mnnz.o \ +psb_c_hybg_csmm.o \ +psb_c_hybg_csmv.o \ +psb_c_hybg_reallocate_nz.o \ +psb_c_hybg_scal.o \ +psb_c_hybg_scals.o \ +psb_c_hybg_to_gpu.o \ +psb_c_hybg_vect_mv.o \ +psb_c_hybg_inner_vect_sv.o \ +psb_c_cp_hybg_from_coo.o \ +psb_c_cp_hybg_from_fmt.o \ +psb_c_mv_hybg_from_fmt.o \ +psb_c_mv_hybg_from_coo.o \ +psb_c_hybg_mold.o \ +psb_z_hybg_allocate_mnnz.o \ +psb_z_hybg_csmm.o \ +psb_z_hybg_csmv.o \ +psb_z_hybg_reallocate_nz.o \ +psb_z_hybg_scal.o \ +psb_z_hybg_scals.o \ +psb_z_hybg_to_gpu.o \ +psb_z_hybg_vect_mv.o \ +psb_z_hybg_inner_vect_sv.o \ +psb_z_cp_hybg_from_coo.o \ +psb_z_cp_hybg_from_fmt.o \ +psb_z_mv_hybg_from_fmt.o \ +psb_z_mv_hybg_from_coo.o \ +psb_z_hybg_mold.o \ +psb_d_cp_diag_from_coo.o \ +psb_d_mv_diag_from_coo.o \ +psb_d_diag_to_gpu.o \ +psb_d_diag_csmv.o \ +psb_d_diag_mold.o \ +psb_d_diag_vect_mv.o \ +psb_d_cp_hdiag_from_coo.o \ +psb_d_mv_hdiag_from_coo.o \ +psb_d_hdiag_to_gpu.o \ +psb_d_hdiag_csmv.o \ +psb_d_hdiag_mold.o \ +psb_d_hdiag_vect_mv.o \ +psb_s_cp_hdiag_from_coo.o \ +psb_s_mv_hdiag_from_coo.o \ +psb_s_hdiag_to_gpu.o \ +psb_s_hdiag_csmv.o \ +psb_s_hdiag_mold.o \ +psb_s_hdiag_vect_mv.o \ +psb_s_dnsg_mat_impl.o \ +psb_d_dnsg_mat_impl.o \ +psb_c_dnsg_mat_impl.o \ +psb_z_dnsg_mat_impl.o + + +objs: $(OBJS) +lib: objs + ar cur ../$(LIBNAME) $(OBJS) + +clean: + /bin/rm -f $(OBJS) diff --git a/gpu/impl/psb_c_cp_csrg_from_coo.F90 b/gpu/impl/psb_c_cp_csrg_from_coo.F90 new file mode 100644 index 000000000..9ab3b7f07 --- /dev/null +++ b/gpu/impl/psb_c_cp_csrg_from_coo.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_c_cp_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_cp_csrg_from_coo +#else + use psb_c_csrg_mat_mod +#endif + implicit none + + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_c_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_cp_csrg_from_coo diff --git a/gpu/impl/psb_c_cp_csrg_from_fmt.F90 b/gpu/impl/psb_c_cp_csrg_from_fmt.F90 new file mode 100644 index 000000000..5229244fa --- /dev/null +++ b/gpu/impl/psb_c_cp_csrg_from_fmt.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_c_cp_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_cp_csrg_from_fmt +#else + use psb_c_csrg_mat_mod +#endif + !use iso_c_binding + implicit none + + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + select type(b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_c_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_c_cp_csrg_from_fmt diff --git a/gpu/impl/psb_c_cp_diag_from_coo.F90 b/gpu/impl/psb_c_cp_diag_from_coo.F90 new file mode 100644 index 000000000..8d1968918 --- /dev/null +++ b/gpu/impl/psb_c_cp_diag_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_c_diag_mat_mod, psb_protect_name => psb_c_cp_diag_from_coo +#else + use psb_c_diag_mat_mod +#endif + implicit none + + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + call a%psb_c_dia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_cp_diag_from_coo diff --git a/gpu/impl/psb_c_cp_elg_from_coo.F90 b/gpu/impl/psb_c_cp_elg_from_coo.F90 new file mode 100644 index 000000000..95193c139 --- /dev/null +++ b/gpu/impl/psb_c_cp_elg_from_coo.F90 @@ -0,0 +1,184 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_cp_elg_from_coo + use psi_ext_util_mod + use psb_gpu_env_mod +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, ld, ldv, hacksize + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + type(psb_c_coo_sparse_mat) :: tmp + integer(psb_ipk_), allocatable :: idisp(:) + + info = psb_success_ +#ifdef HAVE_SPGPU + hacksize = max(1,psb_gpu_WarpSize()) +#else + hacksize = 1 +#endif + if (b%is_dev()) call b%sync() + + if (b%is_by_rows()) then + +#ifdef HAVE_SPGPU + call psi_c_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,b%ja,b%val, a%deviceMat) + call a%set_dev() +#else + + call psi_c_convert_ell_from_coo(a,b,info,hacksize=hacksize) + call a%set_host() +#endif + + else + call b%cp_to_coo(tmp,info) +#ifdef HAVE_SPGPU + call psi_c_count_ell_from_coo(a,tmp,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,tmp%ja,tmp%val, a%deviceMat) + + call a%set_dev() +#else + + call psi_c_convert_ell_from_coo(a,tmp,info,hacksize=hacksize) + call a%set_host() +#endif + end if + + if (info /= psb_success_) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + + subroutine psi_c_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize) + + use psb_base_mod + use psi_ext_util_mod + implicit none + + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(out) :: info, nzm, ldv + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, & + & ir, ic, hsz_ + real(psb_dpk_) :: t0,t1 + logical, parameter :: timing=.true. + + + info = psb_success_ + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == psb_success_) call psb_realloc(nr+1,idisp,info) + if (info /= psb_success_) return + if (timing) t0=psb_wtime() + + a%irn = 0 + do i=1, nza + ir = b%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + idisp(1) = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + idisp(i+1) = a%nzt + end do + + end subroutine psi_c_count_ell_from_coo + +end subroutine psb_c_cp_elg_from_coo diff --git a/gpu/impl/psb_c_cp_elg_from_fmt.F90 b/gpu/impl/psb_c_cp_elg_from_fmt.F90 new file mode 100644 index 000000000..e8be8a8d2 --- /dev/null +++ b/gpu/impl/psb_c_cp_elg_from_fmt.F90 @@ -0,0 +1,101 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_cp_elg_from_fmt +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_c_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_c_ell_sparse_mat) + nzm = psb_size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat + if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) + if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) + if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) + if (info == 0) call psb_safe_cpy( b%val, a%val , info) + if (info == 0) call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + end if + a%nzt = nza +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_c_cp_elg_from_fmt diff --git a/gpu/impl/psb_c_cp_hdiag_from_coo.F90 b/gpu/impl/psb_c_cp_hdiag_from_coo.F90 new file mode 100644 index 000000000..f0ec00ada --- /dev/null +++ b/gpu/impl/psb_c_cp_hdiag_from_coo.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_c_hdiag_mat_mod, psb_protect_name => psb_c_cp_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_c_hdiag_mat_mod +#endif + implicit none + + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_c_hdia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_cp_hdiag_from_coo diff --git a/gpu/impl/psb_c_cp_hlg_from_coo.F90 b/gpu/impl/psb_c_cp_hlg_from_coo.F90 new file mode 100644 index 000000000..cf3055929 --- /dev/null +++ b/gpu/impl/psb_c_cp_hlg_from_coo.F90 @@ -0,0 +1,198 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_cp_hlg_from_coo +#else + use psb_c_hlg_mat_mod +#endif + implicit none + + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_c_coo_sparse_mat) :: tmp + integer(psb_ipk_) :: debug_level, debug_unit, hksz + integer(psb_ipk_), allocatable :: idisp(:) + character(len=20) :: name='hll_from_coo' + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + integer(psb_ipk_), allocatable :: irn(:), ja(:), hko(:) + real(psb_dpk_), allocatable :: val(:) + logical, parameter :: debug=.false. + + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() +#ifdef HAVE_SPGPU + hksz = max(1,psb_gpu_WarpSize()) +#else + hksz = psi_get_hksz() +#endif + + if (b%is_by_rows()) then + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + if (debug) write(0,*) 'Copying through GPU',nza + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,b%ja, b%val, a%deviceMat) + call a%set_dev() + else + ! This is to guarantee tmp%is_by_rows() + call b%cp_to_coo(tmp,info) + call tmp%fix(info) + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + if (debug) write(0,*) 'Copying through GPU' + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,tmp,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,tmp%ja, tmp%val, a%deviceMat) + + call tmp%free() + call a%set_dev() + end if + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + subroutine psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + use psb_base_mod + use psi_ext_util_mod + implicit none + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info, noffs, isz + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, kc + logical, parameter :: debug=.false. + + info = 0 + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + ! If it is sorted then we can lessen memory impact + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat + if (debug) write(0,*) 'Start compute hckoff_from_coo',nr,nc,nza + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == 0) call psb_realloc(nr+1,idisp,info) + if (info /= 0) return + a%irn = 0 + if (debug) then + do i=1, nza + if ((1<=b%ia(i)).and.(b%ia(i)<= nr)) then + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + else + write(0,*) 'Out of bouds IA ',i,b%ia(i),nr + end if + end do + else + do i=1, nza + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + end do + end if + a%nzt = nza + + + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (debug) write(0,*) ' noffsets ',noffs,info + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + idisp(1) = 0 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + idisp(i+1) = idisp(i) + a%irn(i) + do k=1,ir-1 + idisp(i+k+1) = idisp(i+k) + a%irn(i+k) + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) +!!$ write(*,*) 'End of psi_comput_hckoff ',info + end subroutine psi_compute_hckoff_from_coo + +end subroutine psb_c_cp_hlg_from_coo diff --git a/gpu/impl/psb_c_cp_hlg_from_fmt.F90 b/gpu/impl/psb_c_cp_hlg_from_fmt.F90 new file mode 100644 index 000000000..559c501c0 --- /dev/null +++ b/gpu/impl/psb_c_cp_hlg_from_fmt.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_cp_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_cp_hlg_from_fmt +#else + use psb_c_hlg_mat_mod +#endif + implicit none + + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_c_hll_sparse_mat%cp_from_fmt(b,info) +#ifdef HAVE_SPGPU + if (info == 0) call a%to_gpu(info) +#endif + end select + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_cp_hlg_from_fmt diff --git a/gpu/impl/psb_c_cp_hybg_from_coo.F90 b/gpu/impl/psb_c_cp_hybg_from_coo.F90 new file mode 100644 index 000000000..00a7d4ee7 --- /dev/null +++ b/gpu/impl/psb_c_cp_hybg_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_cp_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_cp_hybg_from_coo +#else + use psb_c_hybg_mat_mod +#endif + implicit none + + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_c_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_cp_hybg_from_coo +#endif diff --git a/gpu/impl/psb_c_cp_hybg_from_fmt.F90 b/gpu/impl/psb_c_cp_hybg_from_fmt.F90 new file mode 100644 index 000000000..643abf999 --- /dev/null +++ b/gpu/impl/psb_c_cp_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_cp_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_cp_hybg_from_fmt +#else + use psb_c_hybg_mat_mod +#endif + implicit none + + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_c_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_c_cp_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_c_csrg_allocate_mnnz.F90 b/gpu/impl/psb_c_csrg_allocate_mnnz.F90 new file mode 100644 index 000000000..2183ee638 --- /dev/null +++ b/gpu/impl/psb_c_csrg_allocate_mnnz.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_allocate_mnnz +#else + use psb_c_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_c_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + if (info == 0) call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_allocate_mnnz diff --git a/gpu/impl/psb_c_csrg_csmm.F90 b/gpu/impl/psb_c_csrg_csmm.F90 new file mode 100644 index 000000000..cef5d288e --- /dev/null +++ b/gpu/impl/psb_c_csrg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_csmm +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_csrg_csmv +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + complex(psb_spk_) :: acc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_csrg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_csrg_from_gpu +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, n, nz + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat%mat))) then + call a%free() + return + end if + + info = CSRGDeviceGetParms(a%deviceMat,m,n,nz) + if (info /= psb_success_) return + + if (info == 0) call psb_realloc(m+1,a%irp,info) + if (info == 0) call psb_realloc(nz,a%ja,info) + if (info == 0) call psb_realloc(nz,a%val,info) + if (info == 0) info = & + & CSRGDevice2Host(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) +#if (CUDA_SHORT_VERSION <= 10) || (CUDA_VERSION < 11030) + a%irp(:) = a%irp(:)+1 + a%ja(:) = a%ja(:)+1 +#endif + + call a%set_sync() +#endif + +end subroutine psb_c_csrg_from_gpu diff --git a/gpu/impl/psb_c_csrg_inner_vect_sv.F90 b/gpu/impl/psb_c_csrg_inner_vect_sv.F90 new file mode 100644 index 000000000..39938752d --- /dev/null +++ b/gpu/impl/psb_c_csrg_inner_vect_sv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_c_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_inner_vect_sv +#else + use psb_c_csrg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_csrg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=dzero)) then + call x%sync() + call y%sync() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='csrg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_inner_vect_sv diff --git a/gpu/impl/psb_c_csrg_mold.F90 b/gpu/impl/psb_c_csrg_mold.F90 new file mode 100644 index 000000000..8b1b616a8 --- /dev/null +++ b/gpu/impl/psb_c_csrg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_mold(a,b,info) + + use psb_base_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_mold + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='csrg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_csrg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_mold diff --git a/gpu/impl/psb_c_csrg_reallocate_nz.F90 b/gpu/impl/psb_c_csrg_reallocate_nz.F90 new file mode 100644 index 000000000..e9db41281 --- /dev/null +++ b/gpu/impl/psb_c_csrg_reallocate_nz.F90 @@ -0,0 +1,70 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_reallocate_nz +#else + use psb_c_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='c_csrg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_c_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_reallocate_nz diff --git a/gpu/impl/psb_c_csrg_scal.F90 b/gpu/impl/psb_c_csrg_scal.F90 new file mode 100644 index 000000000..f183a8224 --- /dev/null +++ b/gpu/impl/psb_c_csrg_scal.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_scal +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + call a%psb_c_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_scal diff --git a/gpu/impl/psb_c_csrg_scals.F90 b/gpu/impl/psb_c_csrg_scals.F90 new file mode 100644 index 000000000..13f0d7072 --- /dev/null +++ b/gpu/impl/psb_c_csrg_scals.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_scals +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + call a%psb_c_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_csrg_scals diff --git a/gpu/impl/psb_c_csrg_to_gpu.F90 b/gpu/impl/psb_c_csrg_to_gpu.F90 new file mode 100644 index 000000000..a04f1bab6 --- /dev/null +++ b/gpu/impl/psb_c_csrg_to_gpu.F90 @@ -0,0 +1,325 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_to_gpu +#else + use psb_c_csrg_mat_mod +#endif + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + complex(psb_spk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = CSRGDeviceFree(a%deviceMat) + end if +#if CUDA_SHORT_VERSION <= 10 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = cone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = cone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceCsrsmAnalysis(a%deviceMat) + end if + +#elif CUDA_VERSION < 11030 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) +!!$ write(0,*) 'Done deviceAlloc' + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_zero) +!!$ write(0,*) 'Done SetIndexBase' + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(0:nzdi),valdi(0:nzdi),stat=info) + if (info == 0) then + irpdi(1) = 0 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = cone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = cone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ write(0,*) 'Done deviceAlloc', info + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,& + & cusparse_index_base_zero) +!!$ write(0,*) 'Done setIndexBase', info + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + nzdi=a%irp(m+1)-1 + if (info == 0) allocate(irpdi(m+1),jadi(max(nzdi,1)),stat=info) + if (info == 0) then + irpdi(1:m+1) = a%irp(1:m+1) -1 + jadi(1:nzdi) = a%ja(1:nzdi) -1 + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,irpdi,jadi,a%val) +!!$ write(0,*) 'Done Host2Device', info + endif + + +#else + + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = cone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = cone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + +!!$ if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceCsrsmAnalysis(a%deviceMat) +!!$ end if + +#endif + call a%set_sync() + + if (info /= 0) then + write(0,*) 'Error in CSRG_TO_GPU ',info + end if +#endif + +end subroutine psb_c_csrg_to_gpu diff --git a/gpu/impl/psb_c_csrg_vect_mv.F90 b/gpu/impl/psb_c_csrg_vect_mv.F90 new file mode 100644 index 000000000..0feb03fd4 --- /dev/null +++ b/gpu/impl/psb_c_csrg_vect_mv.F90 @@ -0,0 +1,125 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_csrg_vect_mv +#else + use psb_c_csrg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_csrg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= czero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_c_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= czero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_c_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_c_csrg_vect_mv diff --git a/gpu/impl/psb_c_diag_csmv.F90 b/gpu/impl/psb_c_diag_csmv.F90 new file mode 100644 index 000000000..05ca102f8 --- /dev/null +++ b/gpu/impl/psb_c_diag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_diag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_c_diag_mat_mod, psb_protect_name => psb_c_diag_csmv +#else + use psb_c_diag_mat_mod +#endif + implicit none + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='c_diag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_diag_mold + implicit none + class(psb_c_diag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='diag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_diag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_diag_mold diff --git a/gpu/impl/psb_c_diag_to_gpu.F90 b/gpu/impl/psb_c_diag_to_gpu.F90 new file mode 100644 index 000000000..a60fc7414 --- /dev/null +++ b/gpu/impl/psb_c_diag_to_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_diag_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_c_diag_mat_mod, psb_protect_name => psb_c_diag_to_gpu +#else + use psb_c_diag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_c_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, c,pitch,maxrowsize,d +#ifdef HAVE_SPGPU + type(diagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%data)).or.(.not.allocated(a%offset))) return + + n = size(a%data,1) + d = size(a%data,2) + c = a%get_ncols() + !allocsize = a%get_size() + !write(*,*) 'Create the DIAG matrix' + gpu_parms = FgetDiagDeviceParams(n,c,d,spgpu_type_complex_float) + if (c_associated(a%deviceMat)) then + call freeDiagDevice(a%deviceMat) + endif + info = FallocDiagDevice(a%deviceMat,n,c,d,spgpu_type_complex_float) + if (info == 0) info = & + & writeDiagDevice(a%deviceMat,a%data,a%offset,n) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_c_diag_to_gpu diff --git a/gpu/impl/psb_c_diag_vect_mv.F90 b/gpu/impl/psb_c_diag_vect_mv.F90 new file mode 100644 index 000000000..e680a737a --- /dev/null +++ b/gpu/impl/psb_c_diag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_diag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_c_diag_mat_mod, psb_protect_name => psb_c_diag_vect_mv +#else + use psb_c_diag_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_diag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_c_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_c_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_diag_vect_mv diff --git a/gpu/impl/psb_c_dnsg_mat_impl.F90 b/gpu/impl/psb_c_dnsg_mat_impl.F90 new file mode 100644 index 000000000..b70f383ad --- /dev/null +++ b/gpu/impl/psb_c_dnsg_mat_impl.F90 @@ -0,0 +1,461 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_c_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_dnsg_vect_mv +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + class(psb_c_dnsg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + logical :: tra + character :: trans_ + complex(psb_spk_), allocatable :: rx(:), ry(:) + Integer(Psb_ipk_) :: err_act, m, n, k + character(len=20) :: name='c_dnsg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (trans_ =='N') then + m = a%get_nrows() + n = 1 + k = a%get_ncols() + else + m = a%get_ncols() + n = 1 + k = a%get_nrows() + end if + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= czero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDnsDevice(trans_,m,n,k,alpha,a%deviceMat,& + & xx%deviceVect,beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDnsDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_dnsg_vect_mv + + +subroutine psb_c_dnsg_mold(a,b,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_dnsg_mold +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + class(psb_c_dnsg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='dnsg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_dnsg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_dnsg_mold + + +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_c_dnsg_sparse_mat, psb_spk_, psb_c_base_vect_type +!!$ class(psb_c_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_c_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_c_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_c_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_c_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_c_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_c_dnsg_allocate_mnnz +!!$ end interface + + +subroutine psb_c_dnsg_to_gpu(a,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_dnsg_to_gpu +#else + use psb_c_dnsg_mat_mod +#endif + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act, pitch, lda + logical, parameter :: debug=.false. + character(len=20) :: name='c_dnsg_to_gpu' + + call psb_erractionsave(err_act) + info = psb_success_ +#ifdef HAVE_SPGPU + if (debug) write(0,*) 'DNS_TO_GPU',size(a%val,1),size(a%val,2) + info = FallocDnsDevice(a%deviceMat,a%get_nrows(),a%get_ncols(),& + & spgpu_type_complex_float,1) + if (info == 0) info = writeDnsDevice(a%deviceMat,a%val,size(a%val,1),size(a%val,2)) + if (debug) write(0,*) 'DNS_TO_GPU: From writeDnsDEvice',info + + +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_dnsg_to_gpu + + + +subroutine psb_c_cp_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_cp_dnsg_from_coo +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_dnsg_cp_from_coo' + integer(psb_ipk_) :: debug_level, debug_unit + logical, parameter :: debug=.false. + type(psb_c_coo_sparse_mat) :: tmp + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + call a%psb_c_dns_sparse_mat%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_cp_from_coo: dns_cp',info + if (info == 0) call a%to_gpu(info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_cp_dnsg_from_coo + +subroutine psb_c_cp_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_cp_dnsg_from_fmt +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + type(psb_c_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_c_coo_sparse_mat) + call a%cp_from_coo(b,info) + +!!$ class is (psb_c_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_cp_dnsg_from_fmt + + + +subroutine psb_c_mv_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_mv_dnsg_from_coo +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + logical, parameter :: debug=.false. + character(len=20) :: name='c_dnsg_mv_from_coo' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_mv_from_coo: cp_from_coo:',info + call b%free() + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_mv_dnsg_from_coo + + +subroutine psb_c_mv_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_c_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_c_vectordev_mod + use psb_c_dnsg_mat_mod, psb_protect_name => psb_c_mv_dnsg_from_fmt +#else + use psb_c_dnsg_mat_mod +#endif + implicit none + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + type(psb_c_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + +!!$ class is (psb_c_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_c_mv_dnsg_from_fmt diff --git a/gpu/impl/psb_c_elg_allocate_mnnz.F90 b/gpu/impl/psb_c_elg_allocate_mnnz.F90 new file mode 100644 index 000000000..ac9e654f6 --- /dev/null +++ b/gpu/impl/psb_c_elg_allocate_mnnz.F90 @@ -0,0 +1,113 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_allocate_mnnz +#else + use psb_c_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (n < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/2*ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (present(nz)) then + nz_ = (max(nz,ione) + m -1 )/m + else + nz_ = (max(7*m,7*n,ione)+m-1)/m + end if + if (nz_ < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/3*ione,izero,izero,izero,izero/)) + goto 9999 + endif + +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nz_,nz_*m,n,spgpu_type_complex_float,1) + ld = gpu_parms%pitch + nz_ = gpu_parms%maxRowSize +#else + ld = m +#endif + + if (info == psb_success_) call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%val,info) + if (info == psb_success_) then + a%irn = 0 + a%idiag = 0 + a%nzt = 0 + call a%set_nrows(m) + call a%set_ncols(n) + call a%set_bld() + call a%set_triangle(.false.) + call a%set_unit(.false.) + call a%set_dupl(psb_dupl_def_) + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_allocate_mnnz diff --git a/gpu/impl/psb_c_elg_asb.f90 b/gpu/impl/psb_c_elg_asb.f90 new file mode 100644 index 000000000..f2a8c641c --- /dev/null +++ b/gpu/impl/psb_c_elg_asb.f90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_asb(a) + + use psb_base_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_asb + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + + integer(psb_ipk_) :: err_act, info + character(len=20) :: name='elg_asb' + logical :: clear_ + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: valt(:,:) + integer(psb_ipk_), allocatable :: jat(:,:) + integer(psb_ipk_) :: nr, nc + + call psb_erractionsave(err_act) + info = psb_success_ + + ! Only call sync() if we are on host + if (a%is_host()) then + call a%sync() + end if + call a%set_asb() + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_asb diff --git a/gpu/impl/psb_c_elg_csmm.F90 b/gpu/impl/psb_c_elg_csmm.F90 new file mode 100644 index 000000000..5d355d884 --- /dev/null +++ b/gpu/impl/psb_c_elg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_csmm +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_elg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_elg_csmv +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + complex(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_elg_csput_a +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_elg_csput_a' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +!!$ write(0,*) 'In ELG_csput_a' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(ia) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (size(ja) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(val) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then +!!$ write(*,*) 'elg_csput_a ' + if (a%is_dev()) call a%sync() + call a%psb_c_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + call a%set_host() + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_csput_a + + + +subroutine psb_c_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use iso_c_binding +#ifdef HAVE_SPGPU + use elldev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_csput_v + use psb_c_gpu_vect_mod +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_elg_csput_v' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit, nrw + logical :: gpu_invoked + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + integer(psb_ipk_), allocatable :: idxs(:) + logical, parameter :: debug_idxs=.false., debug_vals=.false. + + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +! write(0,*) 'In ELG_csput_v' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (ia%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (ja%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (val%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then + + t1=psb_wtime() + gpu_invoked = .false. + select type (ia) + class is (psb_i_vect_gpu) + select type (ja) + class is (psb_i_vect_gpu) + select type (val) + class is (psb_c_vect_gpu) + if (a%is_host()) call a%sync() + if (val%is_host()) call val%sync() + if (ia%is_host()) call ia%sync() + if (ja%is_host()) call ja%sync() + info = csputEllDeviceFloatComplex(a%deviceMat,nz,& + & ia%deviceVect,ja%deviceVect,val%deviceVect) + call a%set_dev() + gpu_invoked=.true. + end select + end select + end select + if (.not.gpu_invoked) then +!!$ write(0,*)'Not gpu_invoked ' + if (a%is_dev()) call a%sync() + call a%psb_c_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + call a%set_host() + end if + + if (info /= 0) then + info = psb_err_internal_error_ + end if + + + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_c_elg_csput_v diff --git a/gpu/impl/psb_c_elg_from_gpu.F90 b/gpu/impl/psb_c_elg_from_gpu.F90 new file mode 100644 index 000000000..eda653800 --- /dev/null +++ b/gpu/impl/psb_c_elg_from_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_from_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_from_gpu +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + if (info == 0) call psb_realloc(pitch,a%irn,info) + end if + if (info == 0) info = & + & readEllDevice(a%deviceMat,a%val,a%ja,pitch,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_c_elg_from_gpu diff --git a/gpu/impl/psb_c_elg_inner_vect_sv.F90 b/gpu/impl/psb_c_elg_inner_vect_sv.F90 new file mode 100644 index 000000000..97f0f7ff8 --- /dev/null +++ b/gpu/impl/psb_c_elg_inner_vect_sv.F90 @@ -0,0 +1,89 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_inner_vect_sv +#else + use psb_c_elg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_elg_inner_vect_sv' + logical, parameter :: debug=.false. + complex(psb_spk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + if (a%is_dev()) call a%sync() + if (.false.) then + rx = x%get_vect() + ry = y%get_vect() + call a%inner_spsm(alpha,rx,beta,ry,info,trans) + call y%bld(ry) + else + call x%sync() + call y%sync() + call a%psb_c_ell_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_inner_vect_sv diff --git a/gpu/impl/psb_c_elg_mold.F90 b/gpu/impl/psb_c_elg_mold.F90 new file mode 100644 index 000000000..17cd2ce2a --- /dev/null +++ b/gpu/impl/psb_c_elg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_mold(a,b,info) + + use psb_base_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_mold + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='elg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_elg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_mold diff --git a/gpu/impl/psb_c_elg_reallocate_nz.F90 b/gpu/impl/psb_c_elg_reallocate_nz.F90 new file mode 100644 index 000000000..40d94d36f --- /dev/null +++ b/gpu/impl/psb_c_elg_reallocate_nz.F90 @@ -0,0 +1,79 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_reallocate_nz +#else + use psb_c_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='c_elg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + ! + ! What should this really do??? + ! + if (a%is_dev()) call a%sync() + m = a%get_nrows() + nzrm = (max(nz,ione)+m-1)/m + ld = size(a%ja,1) + call psb_realloc(ld,nzrm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzrm,a%val,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nzrm) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_reallocate_nz diff --git a/gpu/impl/psb_c_elg_scal.F90 b/gpu/impl/psb_c_elg_scal.F90 new file mode 100644 index 000000000..63d9907e9 --- /dev/null +++ b/gpu/impl/psb_c_elg_scal.F90 @@ -0,0 +1,78 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_scal +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_c_ell_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_scal diff --git a/gpu/impl/psb_c_elg_scals.F90 b/gpu/impl/psb_c_elg_scals.F90 new file mode 100644 index 000000000..b954e0a1f --- /dev/null +++ b/gpu/impl/psb_c_elg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_scals +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + call a%make_nonunit() + end if + + a%val(:,:) = a%val(:,:) * d + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_scals diff --git a/gpu/impl/psb_c_elg_to_gpu.F90 b/gpu/impl/psb_c_elg_to_gpu.F90 new file mode 100644 index 000000000..b967a59be --- /dev/null +++ b/gpu/impl/psb_c_elg_to_gpu.F90 @@ -0,0 +1,93 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_to_gpu +#else + use psb_c_elg_mat_mod +#endif + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize, nzt +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + nzt = a%get_nzeros() + if (present(nzrm)) nzm = max(nzm,nzrm) + + gpu_parms = FgetEllDeviceParams(m,nzm,nzt,n,spgpu_type_complex_float,1) + + if (c_associated(a%deviceMat)) then + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + else + pitch = -1 + maxrowsize = -1 + end if + + if ((pitch /= gpu_parms%pitch).or.(maxrowsize /= gpu_parms%maxRowSize)) then + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + info = FallocEllDevice(a%deviceMat,m,nzm,nzt,n,spgpu_type_complex_float,1) + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + end if + if (info == 0) then + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + end if + end if + if (info == 0) info = & + & writeEllDevice(a%deviceMat,a%val,a%ja,size(a%ja,1),a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_c_elg_to_gpu diff --git a/gpu/impl/psb_c_elg_trim.f90 b/gpu/impl/psb_c_elg_trim.f90 new file mode 100644 index 000000000..bc0c0696d --- /dev/null +++ b/gpu/impl/psb_c_elg_trim.f90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_trim(a) + + use psb_base_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_trim + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + Integer(psb_ipk_) :: err_act, info, nz, m, nzm,ld + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + m = max(1_psb_ipk_,a%get_nrows()) + ld = max(1_psb_ipk_,size(a%ja,1)) + nzm = max(1_psb_ipk_,maxval(a%irn(1:m))) + + call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%val,info) + + if (info /= psb_success_) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_trim diff --git a/gpu/impl/psb_c_elg_vect_mv.F90 b/gpu/impl/psb_c_elg_vect_mv.F90 new file mode 100644 index 000000000..ec6e5b50b --- /dev/null +++ b/gpu/impl/psb_c_elg_vect_mv.F90 @@ -0,0 +1,131 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_elg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_elg_vect_mv +#else + use psb_c_elg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_elg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (a%is_dev()) call a%sync() + if (.not.x%is_host()) call x%sync() + if (beta /= czero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_c_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= czero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvEllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvELLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + if (a%is_dev()) call a%sync() + call a%psb_c_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_elg_vect_mv diff --git a/gpu/impl/psb_c_hdiag_csmv.F90 b/gpu/impl/psb_c_hdiag_csmv.F90 new file mode 100644 index 000000000..1ba58c6f4 --- /dev/null +++ b/gpu/impl/psb_c_hdiag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hdiag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_c_hdiag_mat_mod, psb_protect_name => psb_c_hdiag_csmv +#else + use psb_c_hdiag_mat_mod +#endif + implicit none + class(psb_c_hdiag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='c_hdiag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_hdiag_mold + implicit none + class(psb_c_hdiag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='hdiag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_hdiag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hdiag_mold diff --git a/gpu/impl/psb_c_hdiag_to_gpu.F90 b/gpu/impl/psb_c_hdiag_to_gpu.F90 new file mode 100644 index 000000000..565babe01 --- /dev/null +++ b/gpu/impl/psb_c_hdiag_to_gpu.F90 @@ -0,0 +1,86 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hdiag_to_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_c_hdiag_mat_mod, psb_protect_name => psb_c_hdiag_to_gpu +#else + use psb_c_hdiag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nr, nc, hacksize, hackcount, allocheight +#ifdef HAVE_SPGPU + type(hdiagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + nr = a%get_nrows() + nc = a%get_ncols() + hacksize = a%hackSize + hackCount = a%nhacks + if (.not.allocated(a%hackOffsets)) then + info = -1 + return + end if + allocheight = a%hackOffsets(hackCount+1) +!!$ write(*,*) 'HDIAG TO GPU:',nr,nc,hacksize,hackCount,allocheight,& +!!$ & size(a%hackoffsets),size(a%diaoffsets), size(a%val) + if (.not.allocated(a%diaOffsets)) then + info = -2 + return + end if + if (.not.allocated(a%val)) then + info = -3 + return + end if + + if (c_associated(a%deviceMat)) then + call freeHdiagDevice(a%deviceMat) + endif + + info = FAllocHdiagDevice(a%deviceMat,nr,nc,& + & allocheight,hacksize,hackCount,spgpu_type_double) + if (info == 0) info = & + & writeHdiagDevice(a%deviceMat,a%val,a%diaOffsets,a%hackOffsets) + +#endif + +end subroutine psb_c_hdiag_to_gpu diff --git a/gpu/impl/psb_c_hdiag_vect_mv.F90 b/gpu/impl/psb_c_hdiag_vect_mv.F90 new file mode 100644 index 000000000..a891a274d --- /dev/null +++ b/gpu/impl/psb_c_hdiag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_c_hdiag_mat_mod, psb_protect_name => psb_c_hdiag_vect_mv +#else + use psb_c_hdiag_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_hdiag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hdiag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_c_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHdiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_c_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hdiag_vect_mv diff --git a/gpu/impl/psb_c_hlg_allocate_mnnz.F90 b/gpu/impl/psb_c_hlg_allocate_mnnz.F90 new file mode 100644 index 000000000..27e5c0b6e --- /dev/null +++ b/gpu/impl/psb_c_hlg_allocate_mnnz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_allocate_mnnz +#else + use psb_c_hlg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(hlldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_c_hll_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hlg_allocate_mnnz diff --git a/gpu/impl/psb_c_hlg_csmm.F90 b/gpu/impl/psb_c_hlg_csmm.F90 new file mode 100644 index 000000000..c33b2dde4 --- /dev/null +++ b/gpu/impl/psb_c_hlg_csmm.F90 @@ -0,0 +1,132 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_csmm +#else + use psb_c_hlg_mat_mod +#endif + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hlg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_hlg_csmv +#else + use psb_c_hlg_mat_mod +#endif + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='c_hlg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_hlg_from_gpu +#else + use psb_c_hlg_mat_mod +#endif + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: hksize,rows,nzeros,allocsize,hackOffsLength,firstIndex,avgnzr + + info = 0 + +#ifdef HAVE_SPGPU + if (a%is_sync()) return + if (a%is_host()) return + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + + info = getHllDeviceParams(a%deviceMat,hksize, rows, nzeros, allocsize,& + & hackOffsLength, firstIndex,avgnzr) + + if (info == 0) call a%set_nzeros(nzeros) + if (info == 0) call a%set_hksz(hksize) + if (info == 0) call psb_realloc(rows,a%irn,info) + if (info == 0) call psb_realloc(rows,a%idiag,info) + if (info == 0) call psb_realloc(allocsize,a%ja,info) + if (info == 0) call psb_realloc(allocsize,a%val,info) + if (info == 0) call psb_realloc((hackOffsLength+1),a%hkoffs,info) + + if (info == 0) info = & + & readHllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_c_hlg_from_gpu diff --git a/gpu/impl/psb_c_hlg_inner_vect_sv.F90 b/gpu/impl/psb_c_hlg_inner_vect_sv.F90 new file mode 100644 index 000000000..0955d8a1c --- /dev/null +++ b/gpu/impl/psb_c_hlg_inner_vect_sv.F90 @@ -0,0 +1,81 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_inner_vect_sv +#else + use psb_c_hlg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_base_inner_vect_sv' + logical, parameter :: debug=.false. + complex(psb_spk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + info = psb_success_ + + + call x%sync() + call y%sync() + if (a%is_dev()) call a%sync() + call a%psb_c_hll_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hlg_inner_vect_sv diff --git a/gpu/impl/psb_c_hlg_mold.F90 b/gpu/impl/psb_c_hlg_mold.F90 new file mode 100644 index 000000000..321111f02 --- /dev/null +++ b/gpu/impl/psb_c_hlg_mold.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_mold(a,b,info) + + use psb_base_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_mold + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='hlg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_hlg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_c_hlg_mold diff --git a/gpu/impl/psb_c_hlg_reallocate_nz.F90 b/gpu/impl/psb_c_hlg_reallocate_nz.F90 new file mode 100644 index 000000000..a27c3f550 --- /dev/null +++ b/gpu/impl/psb_c_hlg_reallocate_nz.F90 @@ -0,0 +1,67 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_reallocate_nz +#else + use psb_c_hlg_mat_mod +#endif + use iso_c_binding + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_c_hlg_sparse_mat), intent(inout) :: a + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='c_hlg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + call a%psb_c_hll_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hlg_reallocate_nz diff --git a/gpu/impl/psb_c_hlg_scal.F90 b/gpu/impl/psb_c_hlg_scal.F90 new file mode 100644 index 000000000..b2c9d30de --- /dev/null +++ b/gpu/impl/psb_c_hlg_scal.F90 @@ -0,0 +1,75 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_scal +#else + use psb_c_hlg_mat_mod +#endif + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_c_hll_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hlg_scal diff --git a/gpu/impl/psb_c_hlg_scals.F90 b/gpu/impl/psb_c_hlg_scals.F90 new file mode 100644 index 000000000..af2efb195 --- /dev/null +++ b/gpu/impl/psb_c_hlg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_scals +#else + use psb_c_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_c_hll_sparse_mat%scal(d,info) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_c_hlg_scals diff --git a/gpu/impl/psb_c_hlg_to_gpu.F90 b/gpu/impl/psb_c_hlg_to_gpu.F90 new file mode 100644 index 000000000..0d37bc244 --- /dev/null +++ b/gpu/impl/psb_c_hlg_to_gpu.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_to_gpu +#else + use psb_c_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, nza, n, pitch,maxrowsize, allocsize + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + n = a%get_nrows() + allocsize = a%get_size() + nza = a%get_nzeros() + if (c_associated(a%deviceMat)) then + call freehllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,a%hksz,n,nza,allocsize,spgpu_type_complex_float,1) + if (info == 0) info = & + & writehllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_c_hlg_to_gpu diff --git a/gpu/impl/psb_c_hlg_vect_mv.F90 b/gpu/impl/psb_c_hlg_vect_mv.F90 new file mode 100644 index 000000000..bc4e2f562 --- /dev/null +++ b/gpu/impl/psb_c_hlg_vect_mv.F90 @@ -0,0 +1,129 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_hlg_vect_mv +#else + use psb_c_hlg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hlg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= czero) then + if (.not.y%is_host()) call y%sync() + end if + if (a%is_dev()) call a%sync() + call a%psb_c_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvhllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHLLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_c_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hlg_vect_mv diff --git a/gpu/impl/psb_c_hybg_allocate_mnnz.F90 b/gpu/impl/psb_c_hybg_allocate_mnnz.F90 new file mode 100644 index 000000000..5cd57fa25 --- /dev/null +++ b/gpu/impl/psb_c_hybg_allocate_mnnz.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_allocate_mnnz +#else + use psb_c_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_c_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_allocate_mnnz +#endif diff --git a/gpu/impl/psb_c_hybg_csmm.F90 b/gpu/impl/psb_c_hybg_csmm.F90 new file mode 100644 index 000000000..7c8bb582a --- /dev/null +++ b/gpu/impl/psb_c_hybg_csmm.F90 @@ -0,0 +1,135 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_csmm +#else + use psb_c_hybg_mat_mod +#endif + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hybg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_hybg_csmv +#else + use psb_c_hybg_mat_mod +#endif + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hybg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_c_hybg_inner_vect_sv +#else + use psb_c_hybg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_hybg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=czero)) then + call x%sync() + call y%sync() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= czero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_c_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='hybg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_inner_vect_sv +#endif diff --git a/gpu/impl/psb_c_hybg_mold.F90 b/gpu/impl/psb_c_hybg_mold.F90 new file mode 100644 index 000000000..54dd24c2b --- /dev/null +++ b/gpu/impl/psb_c_hybg_mold.F90 @@ -0,0 +1,66 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_mold(a,b,info) + + use psb_base_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_mold + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='hybg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_c_hybg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_mold +#endif diff --git a/gpu/impl/psb_c_hybg_reallocate_nz.F90 b/gpu/impl/psb_c_hybg_reallocate_nz.F90 new file mode 100644 index 000000000..3272b7979 --- /dev/null +++ b/gpu/impl/psb_c_hybg_reallocate_nz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_reallocate_nz +#else + use psb_c_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_c_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='c_hybg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_c_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_reallocate_nz +#endif diff --git a/gpu/impl/psb_c_hybg_scal.F90 b/gpu/impl/psb_c_hybg_scal.F90 new file mode 100644 index 000000000..1019f9795 --- /dev/null +++ b/gpu/impl/psb_c_hybg_scal.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_scal +#else + use psb_c_hybg_mat_mod +#endif + implicit none + class(psb_c_hybg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m,n,nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_c_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_scal +#endif diff --git a/gpu/impl/psb_c_hybg_scals.F90 b/gpu/impl/psb_c_hybg_scals.F90 new file mode 100644 index 000000000..1d09abbb4 --- /dev/null +++ b/gpu/impl/psb_c_hybg_scals.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_scals +#else + use psb_c_hybg_mat_mod +#endif + implicit none + class(psb_c_hybg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + + call a%psb_c_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_scals +#endif diff --git a/gpu/impl/psb_c_hybg_to_gpu.F90 b/gpu/impl/psb_c_hybg_to_gpu.F90 new file mode 100644 index 000000000..107efba9f --- /dev/null +++ b/gpu/impl/psb_c_hybg_to_gpu.F90 @@ -0,0 +1,154 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_to_gpu +#else + use psb_c_hybg_mat_mod +#endif + implicit none + class(psb_c_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + complex(psb_spk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = HYBGDeviceFree(a%deviceMat) + end if + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! We are explicitly adding the diagonal + if (info == 0) info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = cone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = cone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + else + + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) then + if (a%is_unit()) then + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + endif + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceHybsmAnalysis(a%deviceMat) + end if + + + if (info /= 0) then + write(0,*) 'Error in HYBG_TO_GPU ',info + end if +#endif + +end subroutine psb_c_hybg_to_gpu +#endif diff --git a/gpu/impl/psb_c_hybg_vect_mv.F90 b/gpu/impl/psb_c_hybg_vect_mv.F90 new file mode 100644 index 000000000..3ed0f7fda --- /dev/null +++ b/gpu/impl/psb_c_hybg_vect_mv.F90 @@ -0,0 +1,127 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_hybg_vect_mv +#else + use psb_c_hybg_mat_mod +#endif + use psb_c_gpu_vect_mod + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='c_hybg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= czero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_c_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_c_vect_gpu) + select type(yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= czero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_c_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_c_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_hybg_vect_mv +#endif diff --git a/gpu/impl/psb_c_mv_csrg_from_coo.F90 b/gpu/impl/psb_c_mv_csrg_from_coo.F90 new file mode 100644 index 000000000..d2533c2d2 --- /dev/null +++ b/gpu/impl/psb_c_mv_csrg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_mv_csrg_from_coo +#else + use psb_c_csrg_mat_mod +#endif + implicit none + + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + + info = psb_success_ + + call a%psb_c_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_mv_csrg_from_coo diff --git a/gpu/impl/psb_c_mv_csrg_from_fmt.F90 b/gpu/impl/psb_c_mv_csrg_from_fmt.F90 new file mode 100644 index 000000000..3e898e8f8 --- /dev/null +++ b/gpu/impl/psb_c_mv_csrg_from_fmt.F90 @@ -0,0 +1,63 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_csrg_mat_mod, psb_protect_name => psb_c_mv_csrg_from_fmt +#else + use psb_c_csrg_mat_mod +#endif + implicit none + + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + + info = psb_success_ + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_c_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_c_mv_csrg_from_fmt diff --git a/gpu/impl/psb_c_mv_diag_from_coo.F90 b/gpu/impl/psb_c_mv_diag_from_coo.F90 new file mode 100644 index 000000000..34fe69b74 --- /dev/null +++ b/gpu/impl/psb_c_mv_diag_from_coo.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_c_diag_mat_mod, psb_protect_name => psb_c_mv_diag_from_coo +#else + use psb_c_diag_mat_mod +#endif + + implicit none + + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) goto 9999 + + call a%cp_from_coo(b,info) + if (info /= 0) goto 9999 + + call b%free() + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_mv_diag_from_coo diff --git a/gpu/impl/psb_c_mv_elg_from_coo.F90 b/gpu/impl/psb_c_mv_elg_from_coo.F90 new file mode 100644 index 000000000..acf7e28c8 --- /dev/null +++ b/gpu/impl/psb_c_mv_elg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_mv_elg_from_coo +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + call b%free() + + return + + +end subroutine psb_c_mv_elg_from_coo diff --git a/gpu/impl/psb_c_mv_elg_from_fmt.F90 b/gpu/impl/psb_c_mv_elg_from_fmt.F90 new file mode 100644 index 000000000..fb9e3cfeb --- /dev/null +++ b/gpu/impl/psb_c_mv_elg_from_fmt.F90 @@ -0,0 +1,99 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_c_elg_mat_mod, psb_protect_name => psb_c_mv_elg_from_fmt +#else + use psb_c_elg_mat_mod +#endif + implicit none + + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_c_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + + if (b%is_dev()) call b%sync() + select type (b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + + class is (psb_c_ell_sparse_mat) + nzm = size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat + call move_alloc(b%irn, a%irn) + call move_alloc(b%idiag, a%idiag) + call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + deallocate(b%ja,stat=info) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + deallocate(b%val,stat=info) + end if + a%nzt = nza + call b%free() +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_c_mv_elg_from_fmt diff --git a/gpu/impl/psb_c_mv_hdiag_from_coo.F90 b/gpu/impl/psb_c_mv_hdiag_from_coo.F90 new file mode 100644 index 000000000..1d07bddbf --- /dev/null +++ b/gpu/impl/psb_c_mv_hdiag_from_coo.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_c_hdiag_mat_mod, psb_protect_name => psb_c_mv_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_c_hdiag_mat_mod +#endif + + implicit none + + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_c_hdia_sparse_mat%mv_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_mv_hdiag_from_coo diff --git a/gpu/impl/psb_c_mv_hlg_from_coo.F90 b/gpu/impl/psb_c_mv_hlg_from_coo.F90 new file mode 100644 index 000000000..0fa2d72d5 --- /dev/null +++ b/gpu/impl/psb_c_mv_hlg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_mv_hlg_from_coo +#else + use psb_c_hlg_mat_mod +#endif + implicit none + + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + + call a%cp_from_coo(b,info) + call b%free() + + return + +end subroutine psb_c_mv_hlg_from_coo diff --git a/gpu/impl/psb_c_mv_hlg_from_fmt.F90 b/gpu/impl/psb_c_mv_hlg_from_fmt.F90 new file mode 100644 index 000000000..0581c7d64 --- /dev/null +++ b/gpu/impl/psb_c_mv_hlg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_c_mv_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_c_hlg_mat_mod, psb_protect_name => psb_c_mv_hlg_from_fmt +#else + use psb_c_hlg_mat_mod +#endif + implicit none + + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_c_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_c_mv_hlg_from_fmt diff --git a/gpu/impl/psb_c_mv_hybg_from_coo.F90 b/gpu/impl/psb_c_mv_hybg_from_coo.F90 new file mode 100644 index 000000000..7aca6065c --- /dev/null +++ b/gpu/impl/psb_c_mv_hybg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_mv_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_mv_hybg_from_coo +#else + use psb_c_hybg_mat_mod +#endif + implicit none + + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + call a%psb_c_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_c_mv_hybg_from_coo +#endif diff --git a/gpu/impl/psb_c_mv_hybg_from_fmt.F90 b/gpu/impl/psb_c_mv_hybg_from_fmt.F90 new file mode 100644 index 000000000..41581b858 --- /dev/null +++ b/gpu/impl/psb_c_mv_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_c_mv_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_c_hybg_mat_mod, psb_protect_name => psb_c_mv_hybg_from_fmt +#else + use psb_c_hybg_mat_mod +#endif + implicit none + + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + select type(b) + type is (psb_c_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_c_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select +end subroutine psb_c_mv_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_d_cp_csrg_from_coo.F90 b/gpu/impl/psb_d_cp_csrg_from_coo.F90 new file mode 100644 index 000000000..ec00007e3 --- /dev/null +++ b/gpu/impl/psb_d_cp_csrg_from_coo.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_d_cp_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_cp_csrg_from_coo +#else + use psb_d_csrg_mat_mod +#endif + implicit none + + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_d_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_cp_csrg_from_coo diff --git a/gpu/impl/psb_d_cp_csrg_from_fmt.F90 b/gpu/impl/psb_d_cp_csrg_from_fmt.F90 new file mode 100644 index 000000000..b3aabeedd --- /dev/null +++ b/gpu/impl/psb_d_cp_csrg_from_fmt.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_d_cp_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_cp_csrg_from_fmt +#else + use psb_d_csrg_mat_mod +#endif + !use iso_c_binding + implicit none + + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + select type(b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_d_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_d_cp_csrg_from_fmt diff --git a/gpu/impl/psb_d_cp_diag_from_coo.F90 b/gpu/impl/psb_d_cp_diag_from_coo.F90 new file mode 100644 index 000000000..06aff19dd --- /dev/null +++ b/gpu/impl/psb_d_cp_diag_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_d_diag_mat_mod, psb_protect_name => psb_d_cp_diag_from_coo +#else + use psb_d_diag_mat_mod +#endif + implicit none + + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + call a%psb_d_dia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_cp_diag_from_coo diff --git a/gpu/impl/psb_d_cp_elg_from_coo.F90 b/gpu/impl/psb_d_cp_elg_from_coo.F90 new file mode 100644 index 000000000..381e4bfbd --- /dev/null +++ b/gpu/impl/psb_d_cp_elg_from_coo.F90 @@ -0,0 +1,184 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_cp_elg_from_coo + use psi_ext_util_mod + use psb_gpu_env_mod +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, ld, ldv, hacksize + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + type(psb_d_coo_sparse_mat) :: tmp + integer(psb_ipk_), allocatable :: idisp(:) + + info = psb_success_ +#ifdef HAVE_SPGPU + hacksize = max(1,psb_gpu_WarpSize()) +#else + hacksize = 1 +#endif + if (b%is_dev()) call b%sync() + + if (b%is_by_rows()) then + +#ifdef HAVE_SPGPU + call psi_d_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,b%ja,b%val, a%deviceMat) + call a%set_dev() +#else + + call psi_d_convert_ell_from_coo(a,b,info,hacksize=hacksize) + call a%set_host() +#endif + + else + call b%cp_to_coo(tmp,info) +#ifdef HAVE_SPGPU + call psi_d_count_ell_from_coo(a,tmp,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,tmp%ja,tmp%val, a%deviceMat) + + call a%set_dev() +#else + + call psi_d_convert_ell_from_coo(a,tmp,info,hacksize=hacksize) + call a%set_host() +#endif + end if + + if (info /= psb_success_) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + + subroutine psi_d_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize) + + use psb_base_mod + use psi_ext_util_mod + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(out) :: info, nzm, ldv + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, & + & ir, ic, hsz_ + real(psb_dpk_) :: t0,t1 + logical, parameter :: timing=.true. + + + info = psb_success_ + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == psb_success_) call psb_realloc(nr+1,idisp,info) + if (info /= psb_success_) return + if (timing) t0=psb_wtime() + + a%irn = 0 + do i=1, nza + ir = b%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + idisp(1) = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + idisp(i+1) = a%nzt + end do + + end subroutine psi_d_count_ell_from_coo + +end subroutine psb_d_cp_elg_from_coo diff --git a/gpu/impl/psb_d_cp_elg_from_fmt.F90 b/gpu/impl/psb_d_cp_elg_from_fmt.F90 new file mode 100644 index 000000000..9a6b6d41d --- /dev/null +++ b/gpu/impl/psb_d_cp_elg_from_fmt.F90 @@ -0,0 +1,101 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_cp_elg_from_fmt +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_d_ell_sparse_mat) + nzm = psb_size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) + if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) + if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) + if (info == 0) call psb_safe_cpy( b%val, a%val , info) + if (info == 0) call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + end if + a%nzt = nza +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_d_cp_elg_from_fmt diff --git a/gpu/impl/psb_d_cp_hdiag_from_coo.F90 b/gpu/impl/psb_d_cp_hdiag_from_coo.F90 new file mode 100644 index 000000000..443452a10 --- /dev/null +++ b/gpu/impl/psb_d_cp_hdiag_from_coo.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_d_hdiag_mat_mod, psb_protect_name => psb_d_cp_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_d_hdiag_mat_mod +#endif + implicit none + + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_d_hdia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_cp_hdiag_from_coo diff --git a/gpu/impl/psb_d_cp_hlg_from_coo.F90 b/gpu/impl/psb_d_cp_hlg_from_coo.F90 new file mode 100644 index 000000000..02855fef4 --- /dev/null +++ b/gpu/impl/psb_d_cp_hlg_from_coo.F90 @@ -0,0 +1,198 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_cp_hlg_from_coo +#else + use psb_d_hlg_mat_mod +#endif + implicit none + + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + integer(psb_ipk_) :: debug_level, debug_unit, hksz + integer(psb_ipk_), allocatable :: idisp(:) + character(len=20) :: name='hll_from_coo' + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + integer(psb_ipk_), allocatable :: irn(:), ja(:), hko(:) + real(psb_dpk_), allocatable :: val(:) + logical, parameter :: debug=.false. + + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() +#ifdef HAVE_SPGPU + hksz = max(1,psb_gpu_WarpSize()) +#else + hksz = psi_get_hksz() +#endif + + if (b%is_by_rows()) then + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + if (debug) write(0,*) 'Copying through GPU',nza + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,b%ja, b%val, a%deviceMat) + call a%set_dev() + else + ! This is to guarantee tmp%is_by_rows() + call b%cp_to_coo(tmp,info) + call tmp%fix(info) + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + if (debug) write(0,*) 'Copying through GPU' + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,tmp,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,tmp%ja, tmp%val, a%deviceMat) + + call tmp%free() + call a%set_dev() + end if + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + subroutine psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + use psb_base_mod + use psi_ext_util_mod + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info, noffs, isz + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, kc + logical, parameter :: debug=.false. + + info = 0 + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + ! If it is sorted then we can lessen memory impact + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + if (debug) write(0,*) 'Start compute hckoff_from_coo',nr,nc,nza + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == 0) call psb_realloc(nr+1,idisp,info) + if (info /= 0) return + a%irn = 0 + if (debug) then + do i=1, nza + if ((1<=b%ia(i)).and.(b%ia(i)<= nr)) then + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + else + write(0,*) 'Out of bouds IA ',i,b%ia(i),nr + end if + end do + else + do i=1, nza + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + end do + end if + a%nzt = nza + + + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (debug) write(0,*) ' noffsets ',noffs,info + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + idisp(1) = 0 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + idisp(i+1) = idisp(i) + a%irn(i) + do k=1,ir-1 + idisp(i+k+1) = idisp(i+k) + a%irn(i+k) + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) +!!$ write(*,*) 'End of psi_comput_hckoff ',info + end subroutine psi_compute_hckoff_from_coo + +end subroutine psb_d_cp_hlg_from_coo diff --git a/gpu/impl/psb_d_cp_hlg_from_fmt.F90 b/gpu/impl/psb_d_cp_hlg_from_fmt.F90 new file mode 100644 index 000000000..133fbb325 --- /dev/null +++ b/gpu/impl/psb_d_cp_hlg_from_fmt.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_cp_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_cp_hlg_from_fmt +#else + use psb_d_hlg_mat_mod +#endif + implicit none + + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_d_hll_sparse_mat%cp_from_fmt(b,info) +#ifdef HAVE_SPGPU + if (info == 0) call a%to_gpu(info) +#endif + end select + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_cp_hlg_from_fmt diff --git a/gpu/impl/psb_d_cp_hybg_from_coo.F90 b/gpu/impl/psb_d_cp_hybg_from_coo.F90 new file mode 100644 index 000000000..a74409cbc --- /dev/null +++ b/gpu/impl/psb_d_cp_hybg_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_cp_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_cp_hybg_from_coo +#else + use psb_d_hybg_mat_mod +#endif + implicit none + + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_d_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_cp_hybg_from_coo +#endif diff --git a/gpu/impl/psb_d_cp_hybg_from_fmt.F90 b/gpu/impl/psb_d_cp_hybg_from_fmt.F90 new file mode 100644 index 000000000..91d590606 --- /dev/null +++ b/gpu/impl/psb_d_cp_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_cp_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_cp_hybg_from_fmt +#else + use psb_d_hybg_mat_mod +#endif + implicit none + + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_d_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_d_cp_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_d_csrg_allocate_mnnz.F90 b/gpu/impl/psb_d_csrg_allocate_mnnz.F90 new file mode 100644 index 000000000..7d2d4470c --- /dev/null +++ b/gpu/impl/psb_d_csrg_allocate_mnnz.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_allocate_mnnz +#else + use psb_d_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_d_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + if (info == 0) call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_allocate_mnnz diff --git a/gpu/impl/psb_d_csrg_csmm.F90 b/gpu/impl/psb_d_csrg_csmm.F90 new file mode 100644 index 000000000..59c8343ef --- /dev/null +++ b/gpu/impl/psb_d_csrg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_csmm +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_csrg_csmv +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_csrg_from_gpu +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, n, nz + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat%mat))) then + call a%free() + return + end if + + info = CSRGDeviceGetParms(a%deviceMat,m,n,nz) + if (info /= psb_success_) return + + if (info == 0) call psb_realloc(m+1,a%irp,info) + if (info == 0) call psb_realloc(nz,a%ja,info) + if (info == 0) call psb_realloc(nz,a%val,info) + if (info == 0) info = & + & CSRGDevice2Host(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) +#if (CUDA_SHORT_VERSION <= 10) || (CUDA_VERSION < 11030) + a%irp(:) = a%irp(:)+1 + a%ja(:) = a%ja(:)+1 +#endif + + call a%set_sync() +#endif + +end subroutine psb_d_csrg_from_gpu diff --git a/gpu/impl/psb_d_csrg_inner_vect_sv.F90 b/gpu/impl/psb_d_csrg_inner_vect_sv.F90 new file mode 100644 index 000000000..016d63d6c --- /dev/null +++ b/gpu/impl/psb_d_csrg_inner_vect_sv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_d_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_inner_vect_sv +#else + use psb_d_csrg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=dzero)) then + call x%sync() + call y%sync() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='csrg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_inner_vect_sv diff --git a/gpu/impl/psb_d_csrg_mold.F90 b/gpu/impl/psb_d_csrg_mold.F90 new file mode 100644 index 000000000..d7288868a --- /dev/null +++ b/gpu/impl/psb_d_csrg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_mold(a,b,info) + + use psb_base_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_mold + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='csrg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_csrg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_mold diff --git a/gpu/impl/psb_d_csrg_reallocate_nz.F90 b/gpu/impl/psb_d_csrg_reallocate_nz.F90 new file mode 100644 index 000000000..083091f51 --- /dev/null +++ b/gpu/impl/psb_d_csrg_reallocate_nz.F90 @@ -0,0 +1,70 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_reallocate_nz +#else + use psb_d_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_csrg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_d_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_reallocate_nz diff --git a/gpu/impl/psb_d_csrg_scal.F90 b/gpu/impl/psb_d_csrg_scal.F90 new file mode 100644 index 000000000..60dbaecd6 --- /dev/null +++ b/gpu/impl/psb_d_csrg_scal.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_scal +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + call a%psb_d_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_scal diff --git a/gpu/impl/psb_d_csrg_scals.F90 b/gpu/impl/psb_d_csrg_scals.F90 new file mode 100644 index 000000000..6d4a1f407 --- /dev/null +++ b/gpu/impl/psb_d_csrg_scals.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_scals +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + call a%psb_d_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_csrg_scals diff --git a/gpu/impl/psb_d_csrg_to_gpu.F90 b/gpu/impl/psb_d_csrg_to_gpu.F90 new file mode 100644 index 000000000..eb5d39423 --- /dev/null +++ b/gpu/impl/psb_d_csrg_to_gpu.F90 @@ -0,0 +1,325 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_to_gpu +#else + use psb_d_csrg_mat_mod +#endif + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + real(psb_dpk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = CSRGDeviceFree(a%deviceMat) + end if +#if CUDA_SHORT_VERSION <= 10 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = done + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = done + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceCsrsmAnalysis(a%deviceMat) + end if + +#elif CUDA_VERSION < 11030 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) +!!$ write(0,*) 'Done deviceAlloc' + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_zero) +!!$ write(0,*) 'Done SetIndexBase' + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(0:nzdi),valdi(0:nzdi),stat=info) + if (info == 0) then + irpdi(1) = 0 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = done + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = done + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ write(0,*) 'Done deviceAlloc', info + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,& + & cusparse_index_base_zero) +!!$ write(0,*) 'Done setIndexBase', info + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + nzdi=a%irp(m+1)-1 + if (info == 0) allocate(irpdi(m+1),jadi(max(nzdi,1)),stat=info) + if (info == 0) then + irpdi(1:m+1) = a%irp(1:m+1) -1 + jadi(1:nzdi) = a%ja(1:nzdi) -1 + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,irpdi,jadi,a%val) +!!$ write(0,*) 'Done Host2Device', info + endif + + +#else + + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = done + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = done + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + +!!$ if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceCsrsmAnalysis(a%deviceMat) +!!$ end if + +#endif + call a%set_sync() + + if (info /= 0) then + write(0,*) 'Error in CSRG_TO_GPU ',info + end if +#endif + +end subroutine psb_d_csrg_to_gpu diff --git a/gpu/impl/psb_d_csrg_vect_mv.F90 b/gpu/impl/psb_d_csrg_vect_mv.F90 new file mode 100644 index 000000000..f7124bbbf --- /dev/null +++ b/gpu/impl/psb_d_csrg_vect_mv.F90 @@ -0,0 +1,125 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_csrg_vect_mv +#else + use psb_d_csrg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_d_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_d_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_d_csrg_vect_mv diff --git a/gpu/impl/psb_d_diag_csmv.F90 b/gpu/impl/psb_d_diag_csmv.F90 new file mode 100644 index 000000000..af9ad2db5 --- /dev/null +++ b/gpu/impl/psb_d_diag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_diag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_d_diag_mat_mod, psb_protect_name => psb_d_diag_csmv +#else + use psb_d_diag_mat_mod +#endif + implicit none + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='d_diag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_diag_mold + implicit none + class(psb_d_diag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='diag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_diag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_diag_mold diff --git a/gpu/impl/psb_d_diag_to_gpu.F90 b/gpu/impl/psb_d_diag_to_gpu.F90 new file mode 100644 index 000000000..de244124a --- /dev/null +++ b/gpu/impl/psb_d_diag_to_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_diag_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_d_diag_mat_mod, psb_protect_name => psb_d_diag_to_gpu +#else + use psb_d_diag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_d_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, c,pitch,maxrowsize,d +#ifdef HAVE_SPGPU + type(diagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%data)).or.(.not.allocated(a%offset))) return + + n = size(a%data,1) + d = size(a%data,2) + c = a%get_ncols() + !allocsize = a%get_size() + !write(*,*) 'Create the DIAG matrix' + gpu_parms = FgetDiagDeviceParams(n,c,d,spgpu_type_double) + if (c_associated(a%deviceMat)) then + call freeDiagDevice(a%deviceMat) + endif + info = FallocDiagDevice(a%deviceMat,n,c,d,spgpu_type_double) + if (info == 0) info = & + & writeDiagDevice(a%deviceMat,a%data,a%offset,n) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_d_diag_to_gpu diff --git a/gpu/impl/psb_d_diag_vect_mv.F90 b/gpu/impl/psb_d_diag_vect_mv.F90 new file mode 100644 index 000000000..3f2f5ac6f --- /dev/null +++ b/gpu/impl/psb_d_diag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_diag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_d_diag_mat_mod, psb_protect_name => psb_d_diag_vect_mv +#else + use psb_d_diag_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_diag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_d_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_d_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_diag_vect_mv diff --git a/gpu/impl/psb_d_dnsg_mat_impl.F90 b/gpu/impl/psb_d_dnsg_mat_impl.F90 new file mode 100644 index 000000000..a79158983 --- /dev/null +++ b/gpu/impl/psb_d_dnsg_mat_impl.F90 @@ -0,0 +1,461 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_d_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_dnsg_vect_mv +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + class(psb_d_dnsg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + logical :: tra + character :: trans_ + real(psb_dpk_), allocatable :: rx(:), ry(:) + Integer(Psb_ipk_) :: err_act, m, n, k + character(len=20) :: name='d_dnsg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (trans_ =='N') then + m = a%get_nrows() + n = 1 + k = a%get_ncols() + else + m = a%get_ncols() + n = 1 + k = a%get_nrows() + end if + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDnsDevice(trans_,m,n,k,alpha,a%deviceMat,& + & xx%deviceVect,beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDnsDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_dnsg_vect_mv + + +subroutine psb_d_dnsg_mold(a,b,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_dnsg_mold +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + class(psb_d_dnsg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='dnsg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_dnsg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_dnsg_mold + + +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_d_dnsg_sparse_mat, psb_dpk_, psb_d_base_vect_type +!!$ class(psb_d_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_d_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_d_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_d_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_d_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_d_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_d_dnsg_allocate_mnnz +!!$ end interface + + +subroutine psb_d_dnsg_to_gpu(a,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_dnsg_to_gpu +#else + use psb_d_dnsg_mat_mod +#endif + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act, pitch, lda + logical, parameter :: debug=.false. + character(len=20) :: name='d_dnsg_to_gpu' + + call psb_erractionsave(err_act) + info = psb_success_ +#ifdef HAVE_SPGPU + if (debug) write(0,*) 'DNS_TO_GPU',size(a%val,1),size(a%val,2) + info = FallocDnsDevice(a%deviceMat,a%get_nrows(),a%get_ncols(),& + & spgpu_type_double,1) + if (info == 0) info = writeDnsDevice(a%deviceMat,a%val,size(a%val,1),size(a%val,2)) + if (debug) write(0,*) 'DNS_TO_GPU: From writeDnsDEvice',info + + +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_dnsg_to_gpu + + + +subroutine psb_d_cp_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_cp_dnsg_from_coo +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_dnsg_cp_from_coo' + integer(psb_ipk_) :: debug_level, debug_unit + logical, parameter :: debug=.false. + type(psb_d_coo_sparse_mat) :: tmp + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + call a%psb_d_dns_sparse_mat%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_cp_from_coo: dns_cp',info + if (info == 0) call a%to_gpu(info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_cp_dnsg_from_coo + +subroutine psb_d_cp_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_cp_dnsg_from_fmt +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + type(psb_d_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + +!!$ class is (psb_d_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_cp_dnsg_from_fmt + + + +subroutine psb_d_mv_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_mv_dnsg_from_coo +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + logical, parameter :: debug=.false. + character(len=20) :: name='d_dnsg_mv_from_coo' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_mv_from_coo: cp_from_coo:',info + call b%free() + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_mv_dnsg_from_coo + + +subroutine psb_d_mv_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_d_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_d_vectordev_mod + use psb_d_dnsg_mat_mod, psb_protect_name => psb_d_mv_dnsg_from_fmt +#else + use psb_d_dnsg_mat_mod +#endif + implicit none + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + type(psb_d_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + +!!$ class is (psb_d_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_d_mv_dnsg_from_fmt diff --git a/gpu/impl/psb_d_elg_allocate_mnnz.F90 b/gpu/impl/psb_d_elg_allocate_mnnz.F90 new file mode 100644 index 000000000..105f5617e --- /dev/null +++ b/gpu/impl/psb_d_elg_allocate_mnnz.F90 @@ -0,0 +1,113 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_allocate_mnnz +#else + use psb_d_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (n < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/2*ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (present(nz)) then + nz_ = (max(nz,ione) + m -1 )/m + else + nz_ = (max(7*m,7*n,ione)+m-1)/m + end if + if (nz_ < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/3*ione,izero,izero,izero,izero/)) + goto 9999 + endif + +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nz_,nz_*m,n,spgpu_type_double,1) + ld = gpu_parms%pitch + nz_ = gpu_parms%maxRowSize +#else + ld = m +#endif + + if (info == psb_success_) call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%val,info) + if (info == psb_success_) then + a%irn = 0 + a%idiag = 0 + a%nzt = 0 + call a%set_nrows(m) + call a%set_ncols(n) + call a%set_bld() + call a%set_triangle(.false.) + call a%set_unit(.false.) + call a%set_dupl(psb_dupl_def_) + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_allocate_mnnz diff --git a/gpu/impl/psb_d_elg_asb.f90 b/gpu/impl/psb_d_elg_asb.f90 new file mode 100644 index 000000000..f80537ef7 --- /dev/null +++ b/gpu/impl/psb_d_elg_asb.f90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_asb(a) + + use psb_base_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_asb + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + + integer(psb_ipk_) :: err_act, info + character(len=20) :: name='elg_asb' + logical :: clear_ + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: valt(:,:) + integer(psb_ipk_), allocatable :: jat(:,:) + integer(psb_ipk_) :: nr, nc + + call psb_erractionsave(err_act) + info = psb_success_ + + ! Only call sync() if we are on host + if (a%is_host()) then + call a%sync() + end if + call a%set_asb() + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_asb diff --git a/gpu/impl/psb_d_elg_csmm.F90 b/gpu/impl/psb_d_elg_csmm.F90 new file mode 100644 index 000000000..add9c3b26 --- /dev/null +++ b/gpu/impl/psb_d_elg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_csmm +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_elg_csmv +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_elg_csput_a +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csput_a' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +!!$ write(0,*) 'In ELG_csput_a' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(ia) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (size(ja) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(val) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then +!!$ write(*,*) 'elg_csput_a ' + if (a%is_dev()) call a%sync() + call a%psb_d_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + call a%set_host() + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_csput_a + + + +subroutine psb_d_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use iso_c_binding +#ifdef HAVE_SPGPU + use elldev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_csput_v + use psb_d_gpu_vect_mod +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csput_v' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit, nrw + logical :: gpu_invoked + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + integer(psb_ipk_), allocatable :: idxs(:) + logical, parameter :: debug_idxs=.false., debug_vals=.false. + + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +! write(0,*) 'In ELG_csput_v' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (ia%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (ja%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (val%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then + + t1=psb_wtime() + gpu_invoked = .false. + select type (ia) + class is (psb_i_vect_gpu) + select type (ja) + class is (psb_i_vect_gpu) + select type (val) + class is (psb_d_vect_gpu) + if (a%is_host()) call a%sync() + if (val%is_host()) call val%sync() + if (ia%is_host()) call ia%sync() + if (ja%is_host()) call ja%sync() + info = csputEllDeviceDouble(a%deviceMat,nz,& + & ia%deviceVect,ja%deviceVect,val%deviceVect) + call a%set_dev() + gpu_invoked=.true. + end select + end select + end select + if (.not.gpu_invoked) then +!!$ write(0,*)'Not gpu_invoked ' + if (a%is_dev()) call a%sync() + call a%psb_d_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + call a%set_host() + end if + + if (info /= 0) then + info = psb_err_internal_error_ + end if + + + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_d_elg_csput_v diff --git a/gpu/impl/psb_d_elg_from_gpu.F90 b/gpu/impl/psb_d_elg_from_gpu.F90 new file mode 100644 index 000000000..c1da9584b --- /dev/null +++ b/gpu/impl/psb_d_elg_from_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_from_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_from_gpu +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + if (info == 0) call psb_realloc(pitch,a%irn,info) + end if + if (info == 0) info = & + & readEllDevice(a%deviceMat,a%val,a%ja,pitch,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_d_elg_from_gpu diff --git a/gpu/impl/psb_d_elg_inner_vect_sv.F90 b/gpu/impl/psb_d_elg_inner_vect_sv.F90 new file mode 100644 index 000000000..333946bfa --- /dev/null +++ b/gpu/impl/psb_d_elg_inner_vect_sv.F90 @@ -0,0 +1,89 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_inner_vect_sv +#else + use psb_d_elg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_elg_inner_vect_sv' + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + if (a%is_dev()) call a%sync() + if (.false.) then + rx = x%get_vect() + ry = y%get_vect() + call a%inner_spsm(alpha,rx,beta,ry,info,trans) + call y%bld(ry) + else + call x%sync() + call y%sync() + call a%psb_d_ell_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_inner_vect_sv diff --git a/gpu/impl/psb_d_elg_mold.F90 b/gpu/impl/psb_d_elg_mold.F90 new file mode 100644 index 000000000..3fd6d0710 --- /dev/null +++ b/gpu/impl/psb_d_elg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_mold(a,b,info) + + use psb_base_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_mold + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='elg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_elg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_mold diff --git a/gpu/impl/psb_d_elg_reallocate_nz.F90 b/gpu/impl/psb_d_elg_reallocate_nz.F90 new file mode 100644 index 000000000..70b3705c1 --- /dev/null +++ b/gpu/impl/psb_d_elg_reallocate_nz.F90 @@ -0,0 +1,79 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_reallocate_nz +#else + use psb_d_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_elg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + ! + ! What should this really do??? + ! + if (a%is_dev()) call a%sync() + m = a%get_nrows() + nzrm = (max(nz,ione)+m-1)/m + ld = size(a%ja,1) + call psb_realloc(ld,nzrm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzrm,a%val,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nzrm) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_reallocate_nz diff --git a/gpu/impl/psb_d_elg_scal.F90 b/gpu/impl/psb_d_elg_scal.F90 new file mode 100644 index 000000000..53ab82d77 --- /dev/null +++ b/gpu/impl/psb_d_elg_scal.F90 @@ -0,0 +1,78 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_scal +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_d_ell_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_scal diff --git a/gpu/impl/psb_d_elg_scals.F90 b/gpu/impl/psb_d_elg_scals.F90 new file mode 100644 index 000000000..f85780cec --- /dev/null +++ b/gpu/impl/psb_d_elg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_scals +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + call a%make_nonunit() + end if + + a%val(:,:) = a%val(:,:) * d + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_scals diff --git a/gpu/impl/psb_d_elg_to_gpu.F90 b/gpu/impl/psb_d_elg_to_gpu.F90 new file mode 100644 index 000000000..28e616060 --- /dev/null +++ b/gpu/impl/psb_d_elg_to_gpu.F90 @@ -0,0 +1,93 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_to_gpu +#else + use psb_d_elg_mat_mod +#endif + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize, nzt +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + nzt = a%get_nzeros() + if (present(nzrm)) nzm = max(nzm,nzrm) + + gpu_parms = FgetEllDeviceParams(m,nzm,nzt,n,spgpu_type_double,1) + + if (c_associated(a%deviceMat)) then + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + else + pitch = -1 + maxrowsize = -1 + end if + + if ((pitch /= gpu_parms%pitch).or.(maxrowsize /= gpu_parms%maxRowSize)) then + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + info = FallocEllDevice(a%deviceMat,m,nzm,nzt,n,spgpu_type_double,1) + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + end if + if (info == 0) then + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + end if + end if + if (info == 0) info = & + & writeEllDevice(a%deviceMat,a%val,a%ja,size(a%ja,1),a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_d_elg_to_gpu diff --git a/gpu/impl/psb_d_elg_trim.f90 b/gpu/impl/psb_d_elg_trim.f90 new file mode 100644 index 000000000..d2a2047c8 --- /dev/null +++ b/gpu/impl/psb_d_elg_trim.f90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_trim(a) + + use psb_base_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_trim + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + Integer(psb_ipk_) :: err_act, info, nz, m, nzm,ld + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + m = max(1_psb_ipk_,a%get_nrows()) + ld = max(1_psb_ipk_,size(a%ja,1)) + nzm = max(1_psb_ipk_,maxval(a%irn(1:m))) + + call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%val,info) + + if (info /= psb_success_) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_trim diff --git a/gpu/impl/psb_d_elg_vect_mv.F90 b/gpu/impl/psb_d_elg_vect_mv.F90 new file mode 100644 index 000000000..e46f84da5 --- /dev/null +++ b/gpu/impl/psb_d_elg_vect_mv.F90 @@ -0,0 +1,131 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_elg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_elg_vect_mv +#else + use psb_d_elg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (a%is_dev()) call a%sync() + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_d_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvEllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvELLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + if (a%is_dev()) call a%sync() + call a%psb_d_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_elg_vect_mv diff --git a/gpu/impl/psb_d_hdiag_csmv.F90 b/gpu/impl/psb_d_hdiag_csmv.F90 new file mode 100644 index 000000000..6f6bcedf6 --- /dev/null +++ b/gpu/impl/psb_d_hdiag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hdiag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_d_hdiag_mat_mod, psb_protect_name => psb_d_hdiag_csmv +#else + use psb_d_hdiag_mat_mod +#endif + implicit none + class(psb_d_hdiag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='d_hdiag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_hdiag_mold + implicit none + class(psb_d_hdiag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='hdiag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_hdiag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hdiag_mold diff --git a/gpu/impl/psb_d_hdiag_to_gpu.F90 b/gpu/impl/psb_d_hdiag_to_gpu.F90 new file mode 100644 index 000000000..fb013586c --- /dev/null +++ b/gpu/impl/psb_d_hdiag_to_gpu.F90 @@ -0,0 +1,86 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hdiag_to_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_d_hdiag_mat_mod, psb_protect_name => psb_d_hdiag_to_gpu +#else + use psb_d_hdiag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nr, nc, hacksize, hackcount, allocheight +#ifdef HAVE_SPGPU + type(hdiagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + nr = a%get_nrows() + nc = a%get_ncols() + hacksize = a%hackSize + hackCount = a%nhacks + if (.not.allocated(a%hackOffsets)) then + info = -1 + return + end if + allocheight = a%hackOffsets(hackCount+1) +!!$ write(*,*) 'HDIAG TO GPU:',nr,nc,hacksize,hackCount,allocheight,& +!!$ & size(a%hackoffsets),size(a%diaoffsets), size(a%val) + if (.not.allocated(a%diaOffsets)) then + info = -2 + return + end if + if (.not.allocated(a%val)) then + info = -3 + return + end if + + if (c_associated(a%deviceMat)) then + call freeHdiagDevice(a%deviceMat) + endif + + info = FAllocHdiagDevice(a%deviceMat,nr,nc,& + & allocheight,hacksize,hackCount,spgpu_type_double) + if (info == 0) info = & + & writeHdiagDevice(a%deviceMat,a%val,a%diaOffsets,a%hackOffsets) + +#endif + +end subroutine psb_d_hdiag_to_gpu diff --git a/gpu/impl/psb_d_hdiag_vect_mv.F90 b/gpu/impl/psb_d_hdiag_vect_mv.F90 new file mode 100644 index 000000000..db7ec9c65 --- /dev/null +++ b/gpu/impl/psb_d_hdiag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_d_hdiag_mat_mod, psb_protect_name => psb_d_hdiag_vect_mv +#else + use psb_d_hdiag_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_hdiag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hdiag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_d_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHdiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_d_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hdiag_vect_mv diff --git a/gpu/impl/psb_d_hlg_allocate_mnnz.F90 b/gpu/impl/psb_d_hlg_allocate_mnnz.F90 new file mode 100644 index 000000000..6f327e816 --- /dev/null +++ b/gpu/impl/psb_d_hlg_allocate_mnnz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_allocate_mnnz +#else + use psb_d_hlg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(hlldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_d_hll_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hlg_allocate_mnnz diff --git a/gpu/impl/psb_d_hlg_csmm.F90 b/gpu/impl/psb_d_hlg_csmm.F90 new file mode 100644 index 000000000..120f3e06f --- /dev/null +++ b/gpu/impl/psb_d_hlg_csmm.F90 @@ -0,0 +1,132 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_csmm +#else + use psb_d_hlg_mat_mod +#endif + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hlg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_hlg_csmv +#else + use psb_d_hlg_mat_mod +#endif + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='d_hlg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_hlg_from_gpu +#else + use psb_d_hlg_mat_mod +#endif + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: hksize,rows,nzeros,allocsize,hackOffsLength,firstIndex,avgnzr + + info = 0 + +#ifdef HAVE_SPGPU + if (a%is_sync()) return + if (a%is_host()) return + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + + info = getHllDeviceParams(a%deviceMat,hksize, rows, nzeros, allocsize,& + & hackOffsLength, firstIndex,avgnzr) + + if (info == 0) call a%set_nzeros(nzeros) + if (info == 0) call a%set_hksz(hksize) + if (info == 0) call psb_realloc(rows,a%irn,info) + if (info == 0) call psb_realloc(rows,a%idiag,info) + if (info == 0) call psb_realloc(allocsize,a%ja,info) + if (info == 0) call psb_realloc(allocsize,a%val,info) + if (info == 0) call psb_realloc((hackOffsLength+1),a%hkoffs,info) + + if (info == 0) info = & + & readHllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_d_hlg_from_gpu diff --git a/gpu/impl/psb_d_hlg_inner_vect_sv.F90 b/gpu/impl/psb_d_hlg_inner_vect_sv.F90 new file mode 100644 index 000000000..0ad867a3d --- /dev/null +++ b/gpu/impl/psb_d_hlg_inner_vect_sv.F90 @@ -0,0 +1,81 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_inner_vect_sv +#else + use psb_d_hlg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_inner_vect_sv' + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + info = psb_success_ + + + call x%sync() + call y%sync() + if (a%is_dev()) call a%sync() + call a%psb_d_hll_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hlg_inner_vect_sv diff --git a/gpu/impl/psb_d_hlg_mold.F90 b/gpu/impl/psb_d_hlg_mold.F90 new file mode 100644 index 000000000..3ce9f33a4 --- /dev/null +++ b/gpu/impl/psb_d_hlg_mold.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_mold(a,b,info) + + use psb_base_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_mold + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='hlg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_hlg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_d_hlg_mold diff --git a/gpu/impl/psb_d_hlg_reallocate_nz.F90 b/gpu/impl/psb_d_hlg_reallocate_nz.F90 new file mode 100644 index 000000000..c9fa47712 --- /dev/null +++ b/gpu/impl/psb_d_hlg_reallocate_nz.F90 @@ -0,0 +1,67 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_reallocate_nz +#else + use psb_d_hlg_mat_mod +#endif + use iso_c_binding + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hlg_sparse_mat), intent(inout) :: a + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_hlg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + call a%psb_d_hll_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hlg_reallocate_nz diff --git a/gpu/impl/psb_d_hlg_scal.F90 b/gpu/impl/psb_d_hlg_scal.F90 new file mode 100644 index 000000000..b487303db --- /dev/null +++ b/gpu/impl/psb_d_hlg_scal.F90 @@ -0,0 +1,75 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_scal +#else + use psb_d_hlg_mat_mod +#endif + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_d_hll_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hlg_scal diff --git a/gpu/impl/psb_d_hlg_scals.F90 b/gpu/impl/psb_d_hlg_scals.F90 new file mode 100644 index 000000000..e3f676e95 --- /dev/null +++ b/gpu/impl/psb_d_hlg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_scals +#else + use psb_d_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_d_hll_sparse_mat%scal(d,info) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_d_hlg_scals diff --git a/gpu/impl/psb_d_hlg_to_gpu.F90 b/gpu/impl/psb_d_hlg_to_gpu.F90 new file mode 100644 index 000000000..5e3b35583 --- /dev/null +++ b/gpu/impl/psb_d_hlg_to_gpu.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_to_gpu +#else + use psb_d_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, nza, n, pitch,maxrowsize, allocsize + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + n = a%get_nrows() + allocsize = a%get_size() + nza = a%get_nzeros() + if (c_associated(a%deviceMat)) then + call freehllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,a%hksz,n,nza,allocsize,spgpu_type_double,1) + if (info == 0) info = & + & writehllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_d_hlg_to_gpu diff --git a/gpu/impl/psb_d_hlg_vect_mv.F90 b/gpu/impl/psb_d_hlg_vect_mv.F90 new file mode 100644 index 000000000..cd5e95e5c --- /dev/null +++ b/gpu/impl/psb_d_hlg_vect_mv.F90 @@ -0,0 +1,129 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_hlg_vect_mv +#else + use psb_d_hlg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hlg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + if (a%is_dev()) call a%sync() + call a%psb_d_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvhllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHLLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_d_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hlg_vect_mv diff --git a/gpu/impl/psb_d_hybg_allocate_mnnz.F90 b/gpu/impl/psb_d_hybg_allocate_mnnz.F90 new file mode 100644 index 000000000..1565a719e --- /dev/null +++ b/gpu/impl/psb_d_hybg_allocate_mnnz.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_allocate_mnnz +#else + use psb_d_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_d_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_allocate_mnnz +#endif diff --git a/gpu/impl/psb_d_hybg_csmm.F90 b/gpu/impl/psb_d_hybg_csmm.F90 new file mode 100644 index 000000000..abc0e0c2b --- /dev/null +++ b/gpu/impl/psb_d_hybg_csmm.F90 @@ -0,0 +1,135 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_csmm +#else + use psb_d_hybg_mat_mod +#endif + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hybg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_hybg_csmv +#else + use psb_d_hybg_mat_mod +#endif + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hybg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_d_hybg_inner_vect_sv +#else + use psb_d_hybg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_hybg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=dzero)) then + call x%sync() + call y%sync() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_d_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='hybg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_inner_vect_sv +#endif diff --git a/gpu/impl/psb_d_hybg_mold.F90 b/gpu/impl/psb_d_hybg_mold.F90 new file mode 100644 index 000000000..27390db05 --- /dev/null +++ b/gpu/impl/psb_d_hybg_mold.F90 @@ -0,0 +1,66 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_mold(a,b,info) + + use psb_base_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_mold + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='hybg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_d_hybg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_mold +#endif diff --git a/gpu/impl/psb_d_hybg_reallocate_nz.F90 b/gpu/impl/psb_d_hybg_reallocate_nz.F90 new file mode 100644 index 000000000..537101e92 --- /dev/null +++ b/gpu/impl/psb_d_hybg_reallocate_nz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_reallocate_nz +#else + use psb_d_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_hybg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_d_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_reallocate_nz +#endif diff --git a/gpu/impl/psb_d_hybg_scal.F90 b/gpu/impl/psb_d_hybg_scal.F90 new file mode 100644 index 000000000..32ef2da0e --- /dev/null +++ b/gpu/impl/psb_d_hybg_scal.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_scal +#else + use psb_d_hybg_mat_mod +#endif + implicit none + class(psb_d_hybg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m,n,nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_d_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_scal +#endif diff --git a/gpu/impl/psb_d_hybg_scals.F90 b/gpu/impl/psb_d_hybg_scals.F90 new file mode 100644 index 000000000..8c38328a3 --- /dev/null +++ b/gpu/impl/psb_d_hybg_scals.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_scals +#else + use psb_d_hybg_mat_mod +#endif + implicit none + class(psb_d_hybg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + + call a%psb_d_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_scals +#endif diff --git a/gpu/impl/psb_d_hybg_to_gpu.F90 b/gpu/impl/psb_d_hybg_to_gpu.F90 new file mode 100644 index 000000000..33bf55b88 --- /dev/null +++ b/gpu/impl/psb_d_hybg_to_gpu.F90 @@ -0,0 +1,154 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_to_gpu +#else + use psb_d_hybg_mat_mod +#endif + implicit none + class(psb_d_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + real(psb_dpk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = HYBGDeviceFree(a%deviceMat) + end if + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! We are explicitly adding the diagonal + if (info == 0) info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = done + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = done + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + else + + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) then + if (a%is_unit()) then + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + endif + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceHybsmAnalysis(a%deviceMat) + end if + + + if (info /= 0) then + write(0,*) 'Error in HYBG_TO_GPU ',info + end if +#endif + +end subroutine psb_d_hybg_to_gpu +#endif diff --git a/gpu/impl/psb_d_hybg_vect_mv.F90 b/gpu/impl/psb_d_hybg_vect_mv.F90 new file mode 100644 index 000000000..d9653a489 --- /dev/null +++ b/gpu/impl/psb_d_hybg_vect_mv.F90 @@ -0,0 +1,127 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_hybg_vect_mv +#else + use psb_d_hybg_mat_mod +#endif + use psb_d_gpu_vect_mod + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hybg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_d_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_d_vect_gpu) + select type(yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_d_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_d_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_hybg_vect_mv +#endif diff --git a/gpu/impl/psb_d_mv_csrg_from_coo.F90 b/gpu/impl/psb_d_mv_csrg_from_coo.F90 new file mode 100644 index 000000000..8c59e6d10 --- /dev/null +++ b/gpu/impl/psb_d_mv_csrg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_mv_csrg_from_coo +#else + use psb_d_csrg_mat_mod +#endif + implicit none + + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + + info = psb_success_ + + call a%psb_d_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_mv_csrg_from_coo diff --git a/gpu/impl/psb_d_mv_csrg_from_fmt.F90 b/gpu/impl/psb_d_mv_csrg_from_fmt.F90 new file mode 100644 index 000000000..30c133e4e --- /dev/null +++ b/gpu/impl/psb_d_mv_csrg_from_fmt.F90 @@ -0,0 +1,63 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_csrg_mat_mod, psb_protect_name => psb_d_mv_csrg_from_fmt +#else + use psb_d_csrg_mat_mod +#endif + implicit none + + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + + info = psb_success_ + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_d_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_d_mv_csrg_from_fmt diff --git a/gpu/impl/psb_d_mv_diag_from_coo.F90 b/gpu/impl/psb_d_mv_diag_from_coo.F90 new file mode 100644 index 000000000..f37a5523d --- /dev/null +++ b/gpu/impl/psb_d_mv_diag_from_coo.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_d_diag_mat_mod, psb_protect_name => psb_d_mv_diag_from_coo +#else + use psb_d_diag_mat_mod +#endif + + implicit none + + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) goto 9999 + + call a%cp_from_coo(b,info) + if (info /= 0) goto 9999 + + call b%free() + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_mv_diag_from_coo diff --git a/gpu/impl/psb_d_mv_elg_from_coo.F90 b/gpu/impl/psb_d_mv_elg_from_coo.F90 new file mode 100644 index 000000000..73216cfa1 --- /dev/null +++ b/gpu/impl/psb_d_mv_elg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_mv_elg_from_coo +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + call b%free() + + return + + +end subroutine psb_d_mv_elg_from_coo diff --git a/gpu/impl/psb_d_mv_elg_from_fmt.F90 b/gpu/impl/psb_d_mv_elg_from_fmt.F90 new file mode 100644 index 000000000..5038c50ef --- /dev/null +++ b/gpu/impl/psb_d_mv_elg_from_fmt.F90 @@ -0,0 +1,99 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_d_elg_mat_mod, psb_protect_name => psb_d_mv_elg_from_fmt +#else + use psb_d_elg_mat_mod +#endif + implicit none + + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + + if (b%is_dev()) call b%sync() + select type (b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + + class is (psb_d_ell_sparse_mat) + nzm = size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat + call move_alloc(b%irn, a%irn) + call move_alloc(b%idiag, a%idiag) + call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + deallocate(b%ja,stat=info) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + deallocate(b%val,stat=info) + end if + a%nzt = nza + call b%free() +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_d_mv_elg_from_fmt diff --git a/gpu/impl/psb_d_mv_hdiag_from_coo.F90 b/gpu/impl/psb_d_mv_hdiag_from_coo.F90 new file mode 100644 index 000000000..ee0e983f7 --- /dev/null +++ b/gpu/impl/psb_d_mv_hdiag_from_coo.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_d_hdiag_mat_mod, psb_protect_name => psb_d_mv_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_d_hdiag_mat_mod +#endif + + implicit none + + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_d_hdia_sparse_mat%mv_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_mv_hdiag_from_coo diff --git a/gpu/impl/psb_d_mv_hlg_from_coo.F90 b/gpu/impl/psb_d_mv_hlg_from_coo.F90 new file mode 100644 index 000000000..fe0304159 --- /dev/null +++ b/gpu/impl/psb_d_mv_hlg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_mv_hlg_from_coo +#else + use psb_d_hlg_mat_mod +#endif + implicit none + + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + + call a%cp_from_coo(b,info) + call b%free() + + return + +end subroutine psb_d_mv_hlg_from_coo diff --git a/gpu/impl/psb_d_mv_hlg_from_fmt.F90 b/gpu/impl/psb_d_mv_hlg_from_fmt.F90 new file mode 100644 index 000000000..e538b0179 --- /dev/null +++ b/gpu/impl/psb_d_mv_hlg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_d_mv_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_d_hlg_mat_mod, psb_protect_name => psb_d_mv_hlg_from_fmt +#else + use psb_d_hlg_mat_mod +#endif + implicit none + + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_d_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_d_mv_hlg_from_fmt diff --git a/gpu/impl/psb_d_mv_hybg_from_coo.F90 b/gpu/impl/psb_d_mv_hybg_from_coo.F90 new file mode 100644 index 000000000..4fe76c72e --- /dev/null +++ b/gpu/impl/psb_d_mv_hybg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_mv_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_mv_hybg_from_coo +#else + use psb_d_hybg_mat_mod +#endif + implicit none + + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + call a%psb_d_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_d_mv_hybg_from_coo +#endif diff --git a/gpu/impl/psb_d_mv_hybg_from_fmt.F90 b/gpu/impl/psb_d_mv_hybg_from_fmt.F90 new file mode 100644 index 000000000..454533d02 --- /dev/null +++ b/gpu/impl/psb_d_mv_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_d_mv_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_d_hybg_mat_mod, psb_protect_name => psb_d_mv_hybg_from_fmt +#else + use psb_d_hybg_mat_mod +#endif + implicit none + + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + select type(b) + type is (psb_d_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_d_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select +end subroutine psb_d_mv_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_s_cp_csrg_from_coo.F90 b/gpu/impl/psb_s_cp_csrg_from_coo.F90 new file mode 100644 index 000000000..4a714d41e --- /dev/null +++ b/gpu/impl/psb_s_cp_csrg_from_coo.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_s_cp_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_cp_csrg_from_coo +#else + use psb_s_csrg_mat_mod +#endif + implicit none + + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_s_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_cp_csrg_from_coo diff --git a/gpu/impl/psb_s_cp_csrg_from_fmt.F90 b/gpu/impl/psb_s_cp_csrg_from_fmt.F90 new file mode 100644 index 000000000..962a8c9d0 --- /dev/null +++ b/gpu/impl/psb_s_cp_csrg_from_fmt.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_s_cp_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_cp_csrg_from_fmt +#else + use psb_s_csrg_mat_mod +#endif + !use iso_c_binding + implicit none + + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + select type(b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_s_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_s_cp_csrg_from_fmt diff --git a/gpu/impl/psb_s_cp_diag_from_coo.F90 b/gpu/impl/psb_s_cp_diag_from_coo.F90 new file mode 100644 index 000000000..6b105ef25 --- /dev/null +++ b/gpu/impl/psb_s_cp_diag_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_s_diag_mat_mod, psb_protect_name => psb_s_cp_diag_from_coo +#else + use psb_s_diag_mat_mod +#endif + implicit none + + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + call a%psb_s_dia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_cp_diag_from_coo diff --git a/gpu/impl/psb_s_cp_elg_from_coo.F90 b/gpu/impl/psb_s_cp_elg_from_coo.F90 new file mode 100644 index 000000000..af8c7d28b --- /dev/null +++ b/gpu/impl/psb_s_cp_elg_from_coo.F90 @@ -0,0 +1,184 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_cp_elg_from_coo + use psi_ext_util_mod + use psb_gpu_env_mod +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, ld, ldv, hacksize + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + type(psb_s_coo_sparse_mat) :: tmp + integer(psb_ipk_), allocatable :: idisp(:) + + info = psb_success_ +#ifdef HAVE_SPGPU + hacksize = max(1,psb_gpu_WarpSize()) +#else + hacksize = 1 +#endif + if (b%is_dev()) call b%sync() + + if (b%is_by_rows()) then + +#ifdef HAVE_SPGPU + call psi_s_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,b%ja,b%val, a%deviceMat) + call a%set_dev() +#else + + call psi_s_convert_ell_from_coo(a,b,info,hacksize=hacksize) + call a%set_host() +#endif + + else + call b%cp_to_coo(tmp,info) +#ifdef HAVE_SPGPU + call psi_s_count_ell_from_coo(a,tmp,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,tmp%ja,tmp%val, a%deviceMat) + + call a%set_dev() +#else + + call psi_s_convert_ell_from_coo(a,tmp,info,hacksize=hacksize) + call a%set_host() +#endif + end if + + if (info /= psb_success_) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + + subroutine psi_s_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize) + + use psb_base_mod + use psi_ext_util_mod + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(out) :: info, nzm, ldv + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, & + & ir, ic, hsz_ + real(psb_dpk_) :: t0,t1 + logical, parameter :: timing=.true. + + + info = psb_success_ + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == psb_success_) call psb_realloc(nr+1,idisp,info) + if (info /= psb_success_) return + if (timing) t0=psb_wtime() + + a%irn = 0 + do i=1, nza + ir = b%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + idisp(1) = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + idisp(i+1) = a%nzt + end do + + end subroutine psi_s_count_ell_from_coo + +end subroutine psb_s_cp_elg_from_coo diff --git a/gpu/impl/psb_s_cp_elg_from_fmt.F90 b/gpu/impl/psb_s_cp_elg_from_fmt.F90 new file mode 100644 index 000000000..c3d973e15 --- /dev/null +++ b/gpu/impl/psb_s_cp_elg_from_fmt.F90 @@ -0,0 +1,101 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_cp_elg_from_fmt +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_s_ell_sparse_mat) + nzm = psb_size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat + if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) + if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) + if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) + if (info == 0) call psb_safe_cpy( b%val, a%val , info) + if (info == 0) call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + end if + a%nzt = nza +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_s_cp_elg_from_fmt diff --git a/gpu/impl/psb_s_cp_hdiag_from_coo.F90 b/gpu/impl/psb_s_cp_hdiag_from_coo.F90 new file mode 100644 index 000000000..0509706de --- /dev/null +++ b/gpu/impl/psb_s_cp_hdiag_from_coo.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_s_hdiag_mat_mod, psb_protect_name => psb_s_cp_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_s_hdiag_mat_mod +#endif + implicit none + + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_s_hdia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_cp_hdiag_from_coo diff --git a/gpu/impl/psb_s_cp_hlg_from_coo.F90 b/gpu/impl/psb_s_cp_hlg_from_coo.F90 new file mode 100644 index 000000000..5988c8ddb --- /dev/null +++ b/gpu/impl/psb_s_cp_hlg_from_coo.F90 @@ -0,0 +1,198 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_cp_hlg_from_coo +#else + use psb_s_hlg_mat_mod +#endif + implicit none + + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + integer(psb_ipk_) :: debug_level, debug_unit, hksz + integer(psb_ipk_), allocatable :: idisp(:) + character(len=20) :: name='hll_from_coo' + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + integer(psb_ipk_), allocatable :: irn(:), ja(:), hko(:) + real(psb_dpk_), allocatable :: val(:) + logical, parameter :: debug=.false. + + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() +#ifdef HAVE_SPGPU + hksz = max(1,psb_gpu_WarpSize()) +#else + hksz = psi_get_hksz() +#endif + + if (b%is_by_rows()) then + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + if (debug) write(0,*) 'Copying through GPU',nza + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,b%ja, b%val, a%deviceMat) + call a%set_dev() + else + ! This is to guarantee tmp%is_by_rows() + call b%cp_to_coo(tmp,info) + call tmp%fix(info) + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + if (debug) write(0,*) 'Copying through GPU' + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,tmp,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,tmp%ja, tmp%val, a%deviceMat) + + call tmp%free() + call a%set_dev() + end if + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + subroutine psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + use psb_base_mod + use psi_ext_util_mod + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info, noffs, isz + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, kc + logical, parameter :: debug=.false. + + info = 0 + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + ! If it is sorted then we can lessen memory impact + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat + if (debug) write(0,*) 'Start compute hckoff_from_coo',nr,nc,nza + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == 0) call psb_realloc(nr+1,idisp,info) + if (info /= 0) return + a%irn = 0 + if (debug) then + do i=1, nza + if ((1<=b%ia(i)).and.(b%ia(i)<= nr)) then + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + else + write(0,*) 'Out of bouds IA ',i,b%ia(i),nr + end if + end do + else + do i=1, nza + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + end do + end if + a%nzt = nza + + + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (debug) write(0,*) ' noffsets ',noffs,info + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + idisp(1) = 0 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + idisp(i+1) = idisp(i) + a%irn(i) + do k=1,ir-1 + idisp(i+k+1) = idisp(i+k) + a%irn(i+k) + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) +!!$ write(*,*) 'End of psi_comput_hckoff ',info + end subroutine psi_compute_hckoff_from_coo + +end subroutine psb_s_cp_hlg_from_coo diff --git a/gpu/impl/psb_s_cp_hlg_from_fmt.F90 b/gpu/impl/psb_s_cp_hlg_from_fmt.F90 new file mode 100644 index 000000000..41c208662 --- /dev/null +++ b/gpu/impl/psb_s_cp_hlg_from_fmt.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_cp_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_cp_hlg_from_fmt +#else + use psb_s_hlg_mat_mod +#endif + implicit none + + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_s_hll_sparse_mat%cp_from_fmt(b,info) +#ifdef HAVE_SPGPU + if (info == 0) call a%to_gpu(info) +#endif + end select + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_cp_hlg_from_fmt diff --git a/gpu/impl/psb_s_cp_hybg_from_coo.F90 b/gpu/impl/psb_s_cp_hybg_from_coo.F90 new file mode 100644 index 000000000..92dc4a681 --- /dev/null +++ b/gpu/impl/psb_s_cp_hybg_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_cp_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_cp_hybg_from_coo +#else + use psb_s_hybg_mat_mod +#endif + implicit none + + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_s_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_cp_hybg_from_coo +#endif diff --git a/gpu/impl/psb_s_cp_hybg_from_fmt.F90 b/gpu/impl/psb_s_cp_hybg_from_fmt.F90 new file mode 100644 index 000000000..53143776a --- /dev/null +++ b/gpu/impl/psb_s_cp_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_cp_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_cp_hybg_from_fmt +#else + use psb_s_hybg_mat_mod +#endif + implicit none + + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_s_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_s_cp_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_s_csrg_allocate_mnnz.F90 b/gpu/impl/psb_s_csrg_allocate_mnnz.F90 new file mode 100644 index 000000000..e93452d2d --- /dev/null +++ b/gpu/impl/psb_s_csrg_allocate_mnnz.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_allocate_mnnz +#else + use psb_s_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_s_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + if (info == 0) call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_allocate_mnnz diff --git a/gpu/impl/psb_s_csrg_csmm.F90 b/gpu/impl/psb_s_csrg_csmm.F90 new file mode 100644 index 000000000..550870536 --- /dev/null +++ b/gpu/impl/psb_s_csrg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_csmm +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_csrg_csmv +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + real(psb_spk_) :: acc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_csrg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_csrg_from_gpu +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, n, nz + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat%mat))) then + call a%free() + return + end if + + info = CSRGDeviceGetParms(a%deviceMat,m,n,nz) + if (info /= psb_success_) return + + if (info == 0) call psb_realloc(m+1,a%irp,info) + if (info == 0) call psb_realloc(nz,a%ja,info) + if (info == 0) call psb_realloc(nz,a%val,info) + if (info == 0) info = & + & CSRGDevice2Host(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) +#if (CUDA_SHORT_VERSION <= 10) || (CUDA_VERSION < 11030) + a%irp(:) = a%irp(:)+1 + a%ja(:) = a%ja(:)+1 +#endif + + call a%set_sync() +#endif + +end subroutine psb_s_csrg_from_gpu diff --git a/gpu/impl/psb_s_csrg_inner_vect_sv.F90 b/gpu/impl/psb_s_csrg_inner_vect_sv.F90 new file mode 100644 index 000000000..133a63508 --- /dev/null +++ b/gpu/impl/psb_s_csrg_inner_vect_sv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_s_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_inner_vect_sv +#else + use psb_s_csrg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_csrg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=dzero)) then + call x%sync() + call y%sync() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='csrg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_inner_vect_sv diff --git a/gpu/impl/psb_s_csrg_mold.F90 b/gpu/impl/psb_s_csrg_mold.F90 new file mode 100644 index 000000000..6ac4cc3da --- /dev/null +++ b/gpu/impl/psb_s_csrg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_mold(a,b,info) + + use psb_base_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_mold + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='csrg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_csrg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_mold diff --git a/gpu/impl/psb_s_csrg_reallocate_nz.F90 b/gpu/impl/psb_s_csrg_reallocate_nz.F90 new file mode 100644 index 000000000..dd9a50d07 --- /dev/null +++ b/gpu/impl/psb_s_csrg_reallocate_nz.F90 @@ -0,0 +1,70 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_reallocate_nz +#else + use psb_s_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_csrg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_s_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_reallocate_nz diff --git a/gpu/impl/psb_s_csrg_scal.F90 b/gpu/impl/psb_s_csrg_scal.F90 new file mode 100644 index 000000000..5e0fbcf06 --- /dev/null +++ b/gpu/impl/psb_s_csrg_scal.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_scal +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + call a%psb_s_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_scal diff --git a/gpu/impl/psb_s_csrg_scals.F90 b/gpu/impl/psb_s_csrg_scals.F90 new file mode 100644 index 000000000..54b299a11 --- /dev/null +++ b/gpu/impl/psb_s_csrg_scals.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_scals +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + call a%psb_s_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_csrg_scals diff --git a/gpu/impl/psb_s_csrg_to_gpu.F90 b/gpu/impl/psb_s_csrg_to_gpu.F90 new file mode 100644 index 000000000..f90ae4eae --- /dev/null +++ b/gpu/impl/psb_s_csrg_to_gpu.F90 @@ -0,0 +1,325 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_to_gpu +#else + use psb_s_csrg_mat_mod +#endif + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + real(psb_spk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = CSRGDeviceFree(a%deviceMat) + end if +#if CUDA_SHORT_VERSION <= 10 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = sone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = sone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceCsrsmAnalysis(a%deviceMat) + end if + +#elif CUDA_VERSION < 11030 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) +!!$ write(0,*) 'Done deviceAlloc' + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_zero) +!!$ write(0,*) 'Done SetIndexBase' + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(0:nzdi),valdi(0:nzdi),stat=info) + if (info == 0) then + irpdi(1) = 0 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = sone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = sone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ write(0,*) 'Done deviceAlloc', info + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,& + & cusparse_index_base_zero) +!!$ write(0,*) 'Done setIndexBase', info + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + nzdi=a%irp(m+1)-1 + if (info == 0) allocate(irpdi(m+1),jadi(max(nzdi,1)),stat=info) + if (info == 0) then + irpdi(1:m+1) = a%irp(1:m+1) -1 + jadi(1:nzdi) = a%ja(1:nzdi) -1 + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,irpdi,jadi,a%val) +!!$ write(0,*) 'Done Host2Device', info + endif + + +#else + + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = sone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = sone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + +!!$ if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceCsrsmAnalysis(a%deviceMat) +!!$ end if + +#endif + call a%set_sync() + + if (info /= 0) then + write(0,*) 'Error in CSRG_TO_GPU ',info + end if +#endif + +end subroutine psb_s_csrg_to_gpu diff --git a/gpu/impl/psb_s_csrg_vect_mv.F90 b/gpu/impl/psb_s_csrg_vect_mv.F90 new file mode 100644 index 000000000..ff88bf894 --- /dev/null +++ b/gpu/impl/psb_s_csrg_vect_mv.F90 @@ -0,0 +1,125 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_csrg_vect_mv +#else + use psb_s_csrg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_csrg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_s_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= szero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_s_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_s_csrg_vect_mv diff --git a/gpu/impl/psb_s_diag_csmv.F90 b/gpu/impl/psb_s_diag_csmv.F90 new file mode 100644 index 000000000..4cf14d12d --- /dev/null +++ b/gpu/impl/psb_s_diag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_diag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_s_diag_mat_mod, psb_protect_name => psb_s_diag_csmv +#else + use psb_s_diag_mat_mod +#endif + implicit none + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='s_diag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_diag_mold + implicit none + class(psb_s_diag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='diag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_diag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_diag_mold diff --git a/gpu/impl/psb_s_diag_to_gpu.F90 b/gpu/impl/psb_s_diag_to_gpu.F90 new file mode 100644 index 000000000..bb09b1272 --- /dev/null +++ b/gpu/impl/psb_s_diag_to_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_diag_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_s_diag_mat_mod, psb_protect_name => psb_s_diag_to_gpu +#else + use psb_s_diag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_s_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, c,pitch,maxrowsize,d +#ifdef HAVE_SPGPU + type(diagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%data)).or.(.not.allocated(a%offset))) return + + n = size(a%data,1) + d = size(a%data,2) + c = a%get_ncols() + !allocsize = a%get_size() + !write(*,*) 'Create the DIAG matrix' + gpu_parms = FgetDiagDeviceParams(n,c,d,spgpu_type_float) + if (c_associated(a%deviceMat)) then + call freeDiagDevice(a%deviceMat) + endif + info = FallocDiagDevice(a%deviceMat,n,c,d,spgpu_type_float) + if (info == 0) info = & + & writeDiagDevice(a%deviceMat,a%data,a%offset,n) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_s_diag_to_gpu diff --git a/gpu/impl/psb_s_diag_vect_mv.F90 b/gpu/impl/psb_s_diag_vect_mv.F90 new file mode 100644 index 000000000..31976247c --- /dev/null +++ b/gpu/impl/psb_s_diag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_diag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_s_diag_mat_mod, psb_protect_name => psb_s_diag_vect_mv +#else + use psb_s_diag_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_diag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_s_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_s_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_diag_vect_mv diff --git a/gpu/impl/psb_s_dnsg_mat_impl.F90 b/gpu/impl/psb_s_dnsg_mat_impl.F90 new file mode 100644 index 000000000..13c58985d --- /dev/null +++ b/gpu/impl/psb_s_dnsg_mat_impl.F90 @@ -0,0 +1,461 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_s_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_dnsg_vect_mv +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + class(psb_s_dnsg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + logical :: tra + character :: trans_ + real(psb_spk_), allocatable :: rx(:), ry(:) + Integer(Psb_ipk_) :: err_act, m, n, k + character(len=20) :: name='s_dnsg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (trans_ =='N') then + m = a%get_nrows() + n = 1 + k = a%get_ncols() + else + m = a%get_ncols() + n = 1 + k = a%get_nrows() + end if + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= szero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDnsDevice(trans_,m,n,k,alpha,a%deviceMat,& + & xx%deviceVect,beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDnsDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_dnsg_vect_mv + + +subroutine psb_s_dnsg_mold(a,b,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_dnsg_mold +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + class(psb_s_dnsg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='dnsg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_dnsg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_dnsg_mold + + +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_s_dnsg_sparse_mat, psb_spk_, psb_s_base_vect_type +!!$ class(psb_s_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_s_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_s_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_s_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_s_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_s_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_s_dnsg_allocate_mnnz +!!$ end interface + + +subroutine psb_s_dnsg_to_gpu(a,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_dnsg_to_gpu +#else + use psb_s_dnsg_mat_mod +#endif + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act, pitch, lda + logical, parameter :: debug=.false. + character(len=20) :: name='s_dnsg_to_gpu' + + call psb_erractionsave(err_act) + info = psb_success_ +#ifdef HAVE_SPGPU + if (debug) write(0,*) 'DNS_TO_GPU',size(a%val,1),size(a%val,2) + info = FallocDnsDevice(a%deviceMat,a%get_nrows(),a%get_ncols(),& + & spgpu_type_float,1) + if (info == 0) info = writeDnsDevice(a%deviceMat,a%val,size(a%val,1),size(a%val,2)) + if (debug) write(0,*) 'DNS_TO_GPU: From writeDnsDEvice',info + + +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_dnsg_to_gpu + + + +subroutine psb_s_cp_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_cp_dnsg_from_coo +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_dnsg_cp_from_coo' + integer(psb_ipk_) :: debug_level, debug_unit + logical, parameter :: debug=.false. + type(psb_s_coo_sparse_mat) :: tmp + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + call a%psb_s_dns_sparse_mat%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_cp_from_coo: dns_cp',info + if (info == 0) call a%to_gpu(info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_cp_dnsg_from_coo + +subroutine psb_s_cp_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_cp_dnsg_from_fmt +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + type(psb_s_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + +!!$ class is (psb_s_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_cp_dnsg_from_fmt + + + +subroutine psb_s_mv_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_mv_dnsg_from_coo +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + logical, parameter :: debug=.false. + character(len=20) :: name='s_dnsg_mv_from_coo' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_mv_from_coo: cp_from_coo:',info + call b%free() + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_mv_dnsg_from_coo + + +subroutine psb_s_mv_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_s_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_s_vectordev_mod + use psb_s_dnsg_mat_mod, psb_protect_name => psb_s_mv_dnsg_from_fmt +#else + use psb_s_dnsg_mat_mod +#endif + implicit none + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + type(psb_s_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + +!!$ class is (psb_s_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_s_mv_dnsg_from_fmt diff --git a/gpu/impl/psb_s_elg_allocate_mnnz.F90 b/gpu/impl/psb_s_elg_allocate_mnnz.F90 new file mode 100644 index 000000000..f3b1d743a --- /dev/null +++ b/gpu/impl/psb_s_elg_allocate_mnnz.F90 @@ -0,0 +1,113 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_allocate_mnnz +#else + use psb_s_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (n < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/2*ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (present(nz)) then + nz_ = (max(nz,ione) + m -1 )/m + else + nz_ = (max(7*m,7*n,ione)+m-1)/m + end if + if (nz_ < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/3*ione,izero,izero,izero,izero/)) + goto 9999 + endif + +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nz_,nz_*m,n,spgpu_type_float,1) + ld = gpu_parms%pitch + nz_ = gpu_parms%maxRowSize +#else + ld = m +#endif + + if (info == psb_success_) call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%val,info) + if (info == psb_success_) then + a%irn = 0 + a%idiag = 0 + a%nzt = 0 + call a%set_nrows(m) + call a%set_ncols(n) + call a%set_bld() + call a%set_triangle(.false.) + call a%set_unit(.false.) + call a%set_dupl(psb_dupl_def_) + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_allocate_mnnz diff --git a/gpu/impl/psb_s_elg_asb.f90 b/gpu/impl/psb_s_elg_asb.f90 new file mode 100644 index 000000000..190be710c --- /dev/null +++ b/gpu/impl/psb_s_elg_asb.f90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_asb(a) + + use psb_base_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_asb + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + + integer(psb_ipk_) :: err_act, info + character(len=20) :: name='elg_asb' + logical :: clear_ + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: valt(:,:) + integer(psb_ipk_), allocatable :: jat(:,:) + integer(psb_ipk_) :: nr, nc + + call psb_erractionsave(err_act) + info = psb_success_ + + ! Only call sync() if we are on host + if (a%is_host()) then + call a%sync() + end if + call a%set_asb() + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_asb diff --git a/gpu/impl/psb_s_elg_csmm.F90 b/gpu/impl/psb_s_elg_csmm.F90 new file mode 100644 index 000000000..8bda23e3e --- /dev/null +++ b/gpu/impl/psb_s_elg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_csmm +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_elg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_elg_csmv +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + real(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_elg_csput_a +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_elg_csput_a' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +!!$ write(0,*) 'In ELG_csput_a' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(ia) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (size(ja) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(val) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then +!!$ write(*,*) 'elg_csput_a ' + if (a%is_dev()) call a%sync() + call a%psb_s_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + call a%set_host() + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_csput_a + + + +subroutine psb_s_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use iso_c_binding +#ifdef HAVE_SPGPU + use elldev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_csput_v + use psb_s_gpu_vect_mod +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_elg_csput_v' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit, nrw + logical :: gpu_invoked + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + integer(psb_ipk_), allocatable :: idxs(:) + logical, parameter :: debug_idxs=.false., debug_vals=.false. + + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +! write(0,*) 'In ELG_csput_v' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (ia%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (ja%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (val%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then + + t1=psb_wtime() + gpu_invoked = .false. + select type (ia) + class is (psb_i_vect_gpu) + select type (ja) + class is (psb_i_vect_gpu) + select type (val) + class is (psb_s_vect_gpu) + if (a%is_host()) call a%sync() + if (val%is_host()) call val%sync() + if (ia%is_host()) call ia%sync() + if (ja%is_host()) call ja%sync() + info = csputEllDeviceFloat(a%deviceMat,nz,& + & ia%deviceVect,ja%deviceVect,val%deviceVect) + call a%set_dev() + gpu_invoked=.true. + end select + end select + end select + if (.not.gpu_invoked) then +!!$ write(0,*)'Not gpu_invoked ' + if (a%is_dev()) call a%sync() + call a%psb_s_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + call a%set_host() + end if + + if (info /= 0) then + info = psb_err_internal_error_ + end if + + + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_s_elg_csput_v diff --git a/gpu/impl/psb_s_elg_from_gpu.F90 b/gpu/impl/psb_s_elg_from_gpu.F90 new file mode 100644 index 000000000..d043790d5 --- /dev/null +++ b/gpu/impl/psb_s_elg_from_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_from_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_from_gpu +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + if (info == 0) call psb_realloc(pitch,a%irn,info) + end if + if (info == 0) info = & + & readEllDevice(a%deviceMat,a%val,a%ja,pitch,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_s_elg_from_gpu diff --git a/gpu/impl/psb_s_elg_inner_vect_sv.F90 b/gpu/impl/psb_s_elg_inner_vect_sv.F90 new file mode 100644 index 000000000..83c79cf3d --- /dev/null +++ b/gpu/impl/psb_s_elg_inner_vect_sv.F90 @@ -0,0 +1,89 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_inner_vect_sv +#else + use psb_s_elg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_elg_inner_vect_sv' + logical, parameter :: debug=.false. + real(psb_spk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + if (a%is_dev()) call a%sync() + if (.false.) then + rx = x%get_vect() + ry = y%get_vect() + call a%inner_spsm(alpha,rx,beta,ry,info,trans) + call y%bld(ry) + else + call x%sync() + call y%sync() + call a%psb_s_ell_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_inner_vect_sv diff --git a/gpu/impl/psb_s_elg_mold.F90 b/gpu/impl/psb_s_elg_mold.F90 new file mode 100644 index 000000000..a481d6050 --- /dev/null +++ b/gpu/impl/psb_s_elg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_mold(a,b,info) + + use psb_base_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_mold + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='elg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_elg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_mold diff --git a/gpu/impl/psb_s_elg_reallocate_nz.F90 b/gpu/impl/psb_s_elg_reallocate_nz.F90 new file mode 100644 index 000000000..229168529 --- /dev/null +++ b/gpu/impl/psb_s_elg_reallocate_nz.F90 @@ -0,0 +1,79 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_reallocate_nz +#else + use psb_s_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_elg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + ! + ! What should this really do??? + ! + if (a%is_dev()) call a%sync() + m = a%get_nrows() + nzrm = (max(nz,ione)+m-1)/m + ld = size(a%ja,1) + call psb_realloc(ld,nzrm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzrm,a%val,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nzrm) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_reallocate_nz diff --git a/gpu/impl/psb_s_elg_scal.F90 b/gpu/impl/psb_s_elg_scal.F90 new file mode 100644 index 000000000..913ae47ef --- /dev/null +++ b/gpu/impl/psb_s_elg_scal.F90 @@ -0,0 +1,78 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_scal +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_s_ell_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_scal diff --git a/gpu/impl/psb_s_elg_scals.F90 b/gpu/impl/psb_s_elg_scals.F90 new file mode 100644 index 000000000..8261fc942 --- /dev/null +++ b/gpu/impl/psb_s_elg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_scals +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + call a%make_nonunit() + end if + + a%val(:,:) = a%val(:,:) * d + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_scals diff --git a/gpu/impl/psb_s_elg_to_gpu.F90 b/gpu/impl/psb_s_elg_to_gpu.F90 new file mode 100644 index 000000000..bf86343bd --- /dev/null +++ b/gpu/impl/psb_s_elg_to_gpu.F90 @@ -0,0 +1,93 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_to_gpu +#else + use psb_s_elg_mat_mod +#endif + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize, nzt +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + nzt = a%get_nzeros() + if (present(nzrm)) nzm = max(nzm,nzrm) + + gpu_parms = FgetEllDeviceParams(m,nzm,nzt,n,spgpu_type_float,1) + + if (c_associated(a%deviceMat)) then + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + else + pitch = -1 + maxrowsize = -1 + end if + + if ((pitch /= gpu_parms%pitch).or.(maxrowsize /= gpu_parms%maxRowSize)) then + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + info = FallocEllDevice(a%deviceMat,m,nzm,nzt,n,spgpu_type_float,1) + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + end if + if (info == 0) then + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + end if + end if + if (info == 0) info = & + & writeEllDevice(a%deviceMat,a%val,a%ja,size(a%ja,1),a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_s_elg_to_gpu diff --git a/gpu/impl/psb_s_elg_trim.f90 b/gpu/impl/psb_s_elg_trim.f90 new file mode 100644 index 000000000..f3bd3b2f7 --- /dev/null +++ b/gpu/impl/psb_s_elg_trim.f90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_trim(a) + + use psb_base_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_trim + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + Integer(psb_ipk_) :: err_act, info, nz, m, nzm,ld + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + m = max(1_psb_ipk_,a%get_nrows()) + ld = max(1_psb_ipk_,size(a%ja,1)) + nzm = max(1_psb_ipk_,maxval(a%irn(1:m))) + + call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%val,info) + + if (info /= psb_success_) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_trim diff --git a/gpu/impl/psb_s_elg_vect_mv.F90 b/gpu/impl/psb_s_elg_vect_mv.F90 new file mode 100644 index 000000000..f8d297d1c --- /dev/null +++ b/gpu/impl/psb_s_elg_vect_mv.F90 @@ -0,0 +1,131 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_elg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_elg_vect_mv +#else + use psb_s_elg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_elg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (a%is_dev()) call a%sync() + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_s_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= szero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvEllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvELLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + if (a%is_dev()) call a%sync() + call a%psb_s_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_elg_vect_mv diff --git a/gpu/impl/psb_s_hdiag_csmv.F90 b/gpu/impl/psb_s_hdiag_csmv.F90 new file mode 100644 index 000000000..3320901c3 --- /dev/null +++ b/gpu/impl/psb_s_hdiag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hdiag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_s_hdiag_mat_mod, psb_protect_name => psb_s_hdiag_csmv +#else + use psb_s_hdiag_mat_mod +#endif + implicit none + class(psb_s_hdiag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='s_hdiag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_hdiag_mold + implicit none + class(psb_s_hdiag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='hdiag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_hdiag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hdiag_mold diff --git a/gpu/impl/psb_s_hdiag_to_gpu.F90 b/gpu/impl/psb_s_hdiag_to_gpu.F90 new file mode 100644 index 000000000..ade1c080c --- /dev/null +++ b/gpu/impl/psb_s_hdiag_to_gpu.F90 @@ -0,0 +1,86 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hdiag_to_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_s_hdiag_mat_mod, psb_protect_name => psb_s_hdiag_to_gpu +#else + use psb_s_hdiag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nr, nc, hacksize, hackcount, allocheight +#ifdef HAVE_SPGPU + type(hdiagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + nr = a%get_nrows() + nc = a%get_ncols() + hacksize = a%hackSize + hackCount = a%nhacks + if (.not.allocated(a%hackOffsets)) then + info = -1 + return + end if + allocheight = a%hackOffsets(hackCount+1) +!!$ write(*,*) 'HDIAG TO GPU:',nr,nc,hacksize,hackCount,allocheight,& +!!$ & size(a%hackoffsets),size(a%diaoffsets), size(a%val) + if (.not.allocated(a%diaOffsets)) then + info = -2 + return + end if + if (.not.allocated(a%val)) then + info = -3 + return + end if + + if (c_associated(a%deviceMat)) then + call freeHdiagDevice(a%deviceMat) + endif + + info = FAllocHdiagDevice(a%deviceMat,nr,nc,& + & allocheight,hacksize,hackCount,spgpu_type_double) + if (info == 0) info = & + & writeHdiagDevice(a%deviceMat,a%val,a%diaOffsets,a%hackOffsets) + +#endif + +end subroutine psb_s_hdiag_to_gpu diff --git a/gpu/impl/psb_s_hdiag_vect_mv.F90 b/gpu/impl/psb_s_hdiag_vect_mv.F90 new file mode 100644 index 000000000..ac261e927 --- /dev/null +++ b/gpu/impl/psb_s_hdiag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_s_hdiag_mat_mod, psb_protect_name => psb_s_hdiag_vect_mv +#else + use psb_s_hdiag_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_hdiag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hdiag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_s_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHdiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_s_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hdiag_vect_mv diff --git a/gpu/impl/psb_s_hlg_allocate_mnnz.F90 b/gpu/impl/psb_s_hlg_allocate_mnnz.F90 new file mode 100644 index 000000000..c7e430f13 --- /dev/null +++ b/gpu/impl/psb_s_hlg_allocate_mnnz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_allocate_mnnz +#else + use psb_s_hlg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(hlldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_s_hll_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hlg_allocate_mnnz diff --git a/gpu/impl/psb_s_hlg_csmm.F90 b/gpu/impl/psb_s_hlg_csmm.F90 new file mode 100644 index 000000000..126b17e69 --- /dev/null +++ b/gpu/impl/psb_s_hlg_csmm.F90 @@ -0,0 +1,132 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_csmm +#else + use psb_s_hlg_mat_mod +#endif + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + real(psb_spk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hlg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_hlg_csmv +#else + use psb_s_hlg_mat_mod +#endif + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + real(psb_spk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='s_hlg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_hlg_from_gpu +#else + use psb_s_hlg_mat_mod +#endif + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: hksize,rows,nzeros,allocsize,hackOffsLength,firstIndex,avgnzr + + info = 0 + +#ifdef HAVE_SPGPU + if (a%is_sync()) return + if (a%is_host()) return + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + + info = getHllDeviceParams(a%deviceMat,hksize, rows, nzeros, allocsize,& + & hackOffsLength, firstIndex,avgnzr) + + if (info == 0) call a%set_nzeros(nzeros) + if (info == 0) call a%set_hksz(hksize) + if (info == 0) call psb_realloc(rows,a%irn,info) + if (info == 0) call psb_realloc(rows,a%idiag,info) + if (info == 0) call psb_realloc(allocsize,a%ja,info) + if (info == 0) call psb_realloc(allocsize,a%val,info) + if (info == 0) call psb_realloc((hackOffsLength+1),a%hkoffs,info) + + if (info == 0) info = & + & readHllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_s_hlg_from_gpu diff --git a/gpu/impl/psb_s_hlg_inner_vect_sv.F90 b/gpu/impl/psb_s_hlg_inner_vect_sv.F90 new file mode 100644 index 000000000..d545eb021 --- /dev/null +++ b/gpu/impl/psb_s_hlg_inner_vect_sv.F90 @@ -0,0 +1,81 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_inner_vect_sv +#else + use psb_s_hlg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_base_inner_vect_sv' + logical, parameter :: debug=.false. + real(psb_spk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + info = psb_success_ + + + call x%sync() + call y%sync() + if (a%is_dev()) call a%sync() + call a%psb_s_hll_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hlg_inner_vect_sv diff --git a/gpu/impl/psb_s_hlg_mold.F90 b/gpu/impl/psb_s_hlg_mold.F90 new file mode 100644 index 000000000..c5dc4774f --- /dev/null +++ b/gpu/impl/psb_s_hlg_mold.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_mold(a,b,info) + + use psb_base_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_mold + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='hlg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_hlg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_s_hlg_mold diff --git a/gpu/impl/psb_s_hlg_reallocate_nz.F90 b/gpu/impl/psb_s_hlg_reallocate_nz.F90 new file mode 100644 index 000000000..19cd95df2 --- /dev/null +++ b/gpu/impl/psb_s_hlg_reallocate_nz.F90 @@ -0,0 +1,67 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_reallocate_nz +#else + use psb_s_hlg_mat_mod +#endif + use iso_c_binding + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hlg_sparse_mat), intent(inout) :: a + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_hlg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + call a%psb_s_hll_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hlg_reallocate_nz diff --git a/gpu/impl/psb_s_hlg_scal.F90 b/gpu/impl/psb_s_hlg_scal.F90 new file mode 100644 index 000000000..cd389baae --- /dev/null +++ b/gpu/impl/psb_s_hlg_scal.F90 @@ -0,0 +1,75 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_scal +#else + use psb_s_hlg_mat_mod +#endif + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_s_hll_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hlg_scal diff --git a/gpu/impl/psb_s_hlg_scals.F90 b/gpu/impl/psb_s_hlg_scals.F90 new file mode 100644 index 000000000..256fac3e5 --- /dev/null +++ b/gpu/impl/psb_s_hlg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_scals +#else + use psb_s_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_s_hll_sparse_mat%scal(d,info) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_s_hlg_scals diff --git a/gpu/impl/psb_s_hlg_to_gpu.F90 b/gpu/impl/psb_s_hlg_to_gpu.F90 new file mode 100644 index 000000000..139482c21 --- /dev/null +++ b/gpu/impl/psb_s_hlg_to_gpu.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_to_gpu +#else + use psb_s_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, nza, n, pitch,maxrowsize, allocsize + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + n = a%get_nrows() + allocsize = a%get_size() + nza = a%get_nzeros() + if (c_associated(a%deviceMat)) then + call freehllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,a%hksz,n,nza,allocsize,spgpu_type_float,1) + if (info == 0) info = & + & writehllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_s_hlg_to_gpu diff --git a/gpu/impl/psb_s_hlg_vect_mv.F90 b/gpu/impl/psb_s_hlg_vect_mv.F90 new file mode 100644 index 000000000..52f322aae --- /dev/null +++ b/gpu/impl/psb_s_hlg_vect_mv.F90 @@ -0,0 +1,129 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_hlg_vect_mv +#else + use psb_s_hlg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hlg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + if (a%is_dev()) call a%sync() + call a%psb_s_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvhllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHLLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_s_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hlg_vect_mv diff --git a/gpu/impl/psb_s_hybg_allocate_mnnz.F90 b/gpu/impl/psb_s_hybg_allocate_mnnz.F90 new file mode 100644 index 000000000..f2b79c774 --- /dev/null +++ b/gpu/impl/psb_s_hybg_allocate_mnnz.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_allocate_mnnz +#else + use psb_s_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_s_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_allocate_mnnz +#endif diff --git a/gpu/impl/psb_s_hybg_csmm.F90 b/gpu/impl/psb_s_hybg_csmm.F90 new file mode 100644 index 000000000..9de67633e --- /dev/null +++ b/gpu/impl/psb_s_hybg_csmm.F90 @@ -0,0 +1,135 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_csmm +#else + use psb_s_hybg_mat_mod +#endif + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hybg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_hybg_csmv +#else + use psb_s_hybg_mat_mod +#endif + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hybg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_s_hybg_inner_vect_sv +#else + use psb_s_hybg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_hybg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=szero)) then + call x%sync() + call y%sync() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= szero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_s_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='hybg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_inner_vect_sv +#endif diff --git a/gpu/impl/psb_s_hybg_mold.F90 b/gpu/impl/psb_s_hybg_mold.F90 new file mode 100644 index 000000000..882990c02 --- /dev/null +++ b/gpu/impl/psb_s_hybg_mold.F90 @@ -0,0 +1,66 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_mold(a,b,info) + + use psb_base_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_mold + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='hybg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_s_hybg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_mold +#endif diff --git a/gpu/impl/psb_s_hybg_reallocate_nz.F90 b/gpu/impl/psb_s_hybg_reallocate_nz.F90 new file mode 100644 index 000000000..46079a92f --- /dev/null +++ b/gpu/impl/psb_s_hybg_reallocate_nz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_reallocate_nz +#else + use psb_s_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_hybg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_s_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_reallocate_nz +#endif diff --git a/gpu/impl/psb_s_hybg_scal.F90 b/gpu/impl/psb_s_hybg_scal.F90 new file mode 100644 index 000000000..a55a8b2cc --- /dev/null +++ b/gpu/impl/psb_s_hybg_scal.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_scal +#else + use psb_s_hybg_mat_mod +#endif + implicit none + class(psb_s_hybg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m,n,nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_s_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_scal +#endif diff --git a/gpu/impl/psb_s_hybg_scals.F90 b/gpu/impl/psb_s_hybg_scals.F90 new file mode 100644 index 000000000..ae92166f1 --- /dev/null +++ b/gpu/impl/psb_s_hybg_scals.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_scals +#else + use psb_s_hybg_mat_mod +#endif + implicit none + class(psb_s_hybg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + + call a%psb_s_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_scals +#endif diff --git a/gpu/impl/psb_s_hybg_to_gpu.F90 b/gpu/impl/psb_s_hybg_to_gpu.F90 new file mode 100644 index 000000000..bfb9b261e --- /dev/null +++ b/gpu/impl/psb_s_hybg_to_gpu.F90 @@ -0,0 +1,154 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_to_gpu +#else + use psb_s_hybg_mat_mod +#endif + implicit none + class(psb_s_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + real(psb_spk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = HYBGDeviceFree(a%deviceMat) + end if + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! We are explicitly adding the diagonal + if (info == 0) info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = sone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = sone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + else + + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) then + if (a%is_unit()) then + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + endif + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceHybsmAnalysis(a%deviceMat) + end if + + + if (info /= 0) then + write(0,*) 'Error in HYBG_TO_GPU ',info + end if +#endif + +end subroutine psb_s_hybg_to_gpu +#endif diff --git a/gpu/impl/psb_s_hybg_vect_mv.F90 b/gpu/impl/psb_s_hybg_vect_mv.F90 new file mode 100644 index 000000000..5fe102f6c --- /dev/null +++ b/gpu/impl/psb_s_hybg_vect_mv.F90 @@ -0,0 +1,127 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_hybg_vect_mv +#else + use psb_s_hybg_mat_mod +#endif + use psb_s_gpu_vect_mod + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + real(psb_spk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_hybg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_s_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_s_vect_gpu) + select type(yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= szero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_s_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_s_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_hybg_vect_mv +#endif diff --git a/gpu/impl/psb_s_mv_csrg_from_coo.F90 b/gpu/impl/psb_s_mv_csrg_from_coo.F90 new file mode 100644 index 000000000..01c9db066 --- /dev/null +++ b/gpu/impl/psb_s_mv_csrg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_mv_csrg_from_coo +#else + use psb_s_csrg_mat_mod +#endif + implicit none + + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + + info = psb_success_ + + call a%psb_s_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_mv_csrg_from_coo diff --git a/gpu/impl/psb_s_mv_csrg_from_fmt.F90 b/gpu/impl/psb_s_mv_csrg_from_fmt.F90 new file mode 100644 index 000000000..0ac28af31 --- /dev/null +++ b/gpu/impl/psb_s_mv_csrg_from_fmt.F90 @@ -0,0 +1,63 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_csrg_mat_mod, psb_protect_name => psb_s_mv_csrg_from_fmt +#else + use psb_s_csrg_mat_mod +#endif + implicit none + + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + + info = psb_success_ + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_s_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_s_mv_csrg_from_fmt diff --git a/gpu/impl/psb_s_mv_diag_from_coo.F90 b/gpu/impl/psb_s_mv_diag_from_coo.F90 new file mode 100644 index 000000000..f51607e52 --- /dev/null +++ b/gpu/impl/psb_s_mv_diag_from_coo.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_s_diag_mat_mod, psb_protect_name => psb_s_mv_diag_from_coo +#else + use psb_s_diag_mat_mod +#endif + + implicit none + + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) goto 9999 + + call a%cp_from_coo(b,info) + if (info /= 0) goto 9999 + + call b%free() + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_mv_diag_from_coo diff --git a/gpu/impl/psb_s_mv_elg_from_coo.F90 b/gpu/impl/psb_s_mv_elg_from_coo.F90 new file mode 100644 index 000000000..ac153f6c0 --- /dev/null +++ b/gpu/impl/psb_s_mv_elg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_mv_elg_from_coo +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + call b%free() + + return + + +end subroutine psb_s_mv_elg_from_coo diff --git a/gpu/impl/psb_s_mv_elg_from_fmt.F90 b/gpu/impl/psb_s_mv_elg_from_fmt.F90 new file mode 100644 index 000000000..9238544cf --- /dev/null +++ b/gpu/impl/psb_s_mv_elg_from_fmt.F90 @@ -0,0 +1,99 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_s_elg_mat_mod, psb_protect_name => psb_s_mv_elg_from_fmt +#else + use psb_s_elg_mat_mod +#endif + implicit none + + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + + if (b%is_dev()) call b%sync() + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + + class is (psb_s_ell_sparse_mat) + nzm = size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat + call move_alloc(b%irn, a%irn) + call move_alloc(b%idiag, a%idiag) + call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + deallocate(b%ja,stat=info) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + deallocate(b%val,stat=info) + end if + a%nzt = nza + call b%free() +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_s_mv_elg_from_fmt diff --git a/gpu/impl/psb_s_mv_hdiag_from_coo.F90 b/gpu/impl/psb_s_mv_hdiag_from_coo.F90 new file mode 100644 index 000000000..dcbcfe4dc --- /dev/null +++ b/gpu/impl/psb_s_mv_hdiag_from_coo.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_s_hdiag_mat_mod, psb_protect_name => psb_s_mv_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_s_hdiag_mat_mod +#endif + + implicit none + + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_s_hdia_sparse_mat%mv_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_mv_hdiag_from_coo diff --git a/gpu/impl/psb_s_mv_hlg_from_coo.F90 b/gpu/impl/psb_s_mv_hlg_from_coo.F90 new file mode 100644 index 000000000..dc72a1358 --- /dev/null +++ b/gpu/impl/psb_s_mv_hlg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_mv_hlg_from_coo +#else + use psb_s_hlg_mat_mod +#endif + implicit none + + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + + call a%cp_from_coo(b,info) + call b%free() + + return + +end subroutine psb_s_mv_hlg_from_coo diff --git a/gpu/impl/psb_s_mv_hlg_from_fmt.F90 b/gpu/impl/psb_s_mv_hlg_from_fmt.F90 new file mode 100644 index 000000000..bbe42e4ab --- /dev/null +++ b/gpu/impl/psb_s_mv_hlg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_s_mv_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_s_hlg_mat_mod, psb_protect_name => psb_s_mv_hlg_from_fmt +#else + use psb_s_hlg_mat_mod +#endif + implicit none + + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_s_mv_hlg_from_fmt diff --git a/gpu/impl/psb_s_mv_hybg_from_coo.F90 b/gpu/impl/psb_s_mv_hybg_from_coo.F90 new file mode 100644 index 000000000..7d3197a8c --- /dev/null +++ b/gpu/impl/psb_s_mv_hybg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_mv_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_mv_hybg_from_coo +#else + use psb_s_hybg_mat_mod +#endif + implicit none + + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + call a%psb_s_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_s_mv_hybg_from_coo +#endif diff --git a/gpu/impl/psb_s_mv_hybg_from_fmt.F90 b/gpu/impl/psb_s_mv_hybg_from_fmt.F90 new file mode 100644 index 000000000..51d8a2e69 --- /dev/null +++ b/gpu/impl/psb_s_mv_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_s_mv_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_s_hybg_mat_mod, psb_protect_name => psb_s_mv_hybg_from_fmt +#else + use psb_s_hybg_mat_mod +#endif + implicit none + + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + select type(b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_s_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select +end subroutine psb_s_mv_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_z_cp_csrg_from_coo.F90 b/gpu/impl/psb_z_cp_csrg_from_coo.F90 new file mode 100644 index 000000000..c3b0eebdd --- /dev/null +++ b/gpu/impl/psb_z_cp_csrg_from_coo.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_z_cp_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_cp_csrg_from_coo +#else + use psb_z_csrg_mat_mod +#endif + implicit none + + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_z_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_cp_csrg_from_coo diff --git a/gpu/impl/psb_z_cp_csrg_from_fmt.F90 b/gpu/impl/psb_z_cp_csrg_from_fmt.F90 new file mode 100644 index 000000000..218d6c7b8 --- /dev/null +++ b/gpu/impl/psb_z_cp_csrg_from_fmt.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_z_cp_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_cp_csrg_from_fmt +#else + use psb_z_csrg_mat_mod +#endif + !use iso_c_binding + implicit none + + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + select type(b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_z_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_z_cp_csrg_from_fmt diff --git a/gpu/impl/psb_z_cp_diag_from_coo.F90 b/gpu/impl/psb_z_cp_diag_from_coo.F90 new file mode 100644 index 000000000..013e88cd7 --- /dev/null +++ b/gpu/impl/psb_z_cp_diag_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_z_diag_mat_mod, psb_protect_name => psb_z_cp_diag_from_coo +#else + use psb_z_diag_mat_mod +#endif + implicit none + + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + call a%psb_z_dia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_cp_diag_from_coo diff --git a/gpu/impl/psb_z_cp_elg_from_coo.F90 b/gpu/impl/psb_z_cp_elg_from_coo.F90 new file mode 100644 index 000000000..c9b61a998 --- /dev/null +++ b/gpu/impl/psb_z_cp_elg_from_coo.F90 @@ -0,0 +1,184 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_cp_elg_from_coo + use psi_ext_util_mod + use psb_gpu_env_mod +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, ld, ldv, hacksize + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + type(psb_z_coo_sparse_mat) :: tmp + integer(psb_ipk_), allocatable :: idisp(:) + + info = psb_success_ +#ifdef HAVE_SPGPU + hacksize = max(1,psb_gpu_WarpSize()) +#else + hacksize = 1 +#endif + if (b%is_dev()) call b%sync() + + if (b%is_by_rows()) then + +#ifdef HAVE_SPGPU + call psi_z_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,b%ja,b%val, a%deviceMat) + call a%set_dev() +#else + + call psi_z_convert_ell_from_coo(a,b,info,hacksize=hacksize) + call a%set_host() +#endif + + else + call b%cp_to_coo(tmp,info) +#ifdef HAVE_SPGPU + call psi_z_count_ell_from_coo(a,tmp,idisp,ldv,nzm,info,hacksize=hacksize) + + + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + info = FallocEllDevice(a%deviceMat,nr,nzm,nza,nc,spgpu_type_double,1) + + if (info == 0) info = psi_CopyCooToElg(nr,nc,nza, hacksize,ldv,nzm, & + & a%irn,idisp,tmp%ja,tmp%val, a%deviceMat) + + call a%set_dev() +#else + + call psi_z_convert_ell_from_coo(a,tmp,info,hacksize=hacksize) + call a%set_host() +#endif + end if + + if (info /= psb_success_) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + + subroutine psi_z_count_ell_from_coo(a,b,idisp,ldv,nzm,info,hacksize) + + use psb_base_mod + use psi_ext_util_mod + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(out) :: info, nzm, ldv + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, & + & ir, ic, hsz_ + real(psb_dpk_) :: t0,t1 + logical, parameter :: timing=.true. + + + info = psb_success_ + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == psb_success_) call psb_realloc(nr+1,idisp,info) + if (info /= psb_success_) return + if (timing) t0=psb_wtime() + + a%irn = 0 + do i=1, nza + ir = b%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + idisp(1) = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + idisp(i+1) = a%nzt + end do + + end subroutine psi_z_count_ell_from_coo + +end subroutine psb_z_cp_elg_from_coo diff --git a/gpu/impl/psb_z_cp_elg_from_fmt.F90 b/gpu/impl/psb_z_cp_elg_from_fmt.F90 new file mode 100644 index 000000000..23468b8a8 --- /dev/null +++ b/gpu/impl/psb_z_cp_elg_from_fmt.F90 @@ -0,0 +1,101 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_cp_elg_from_fmt +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_z_ell_sparse_mat) + nzm = psb_size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat + if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) + if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) + if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) + if (info == 0) call psb_safe_cpy( b%val, a%val , info) + if (info == 0) call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + end if + a%nzt = nza +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_z_cp_elg_from_fmt diff --git a/gpu/impl/psb_z_cp_hdiag_from_coo.F90 b/gpu/impl/psb_z_cp_hdiag_from_coo.F90 new file mode 100644 index 000000000..b44c2854f --- /dev/null +++ b/gpu/impl/psb_z_cp_hdiag_from_coo.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_z_hdiag_mat_mod, psb_protect_name => psb_z_cp_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_z_hdiag_mat_mod +#endif + implicit none + + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + + info = psb_success_ + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_z_hdia_sparse_mat%cp_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_cp_hdiag_from_coo diff --git a/gpu/impl/psb_z_cp_hlg_from_coo.F90 b/gpu/impl/psb_z_cp_hlg_from_coo.F90 new file mode 100644 index 000000000..51d0c8e6f --- /dev/null +++ b/gpu/impl/psb_z_cp_hlg_from_coo.F90 @@ -0,0 +1,198 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_cp_hlg_from_coo +#else + use psb_z_hlg_mat_mod +#endif + implicit none + + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + integer(psb_ipk_) :: debug_level, debug_unit, hksz + integer(psb_ipk_), allocatable :: idisp(:) + character(len=20) :: name='hll_from_coo' + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + integer(psb_ipk_), allocatable :: irn(:), ja(:), hko(:) + real(psb_dpk_), allocatable :: val(:) + logical, parameter :: debug=.false. + + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() +#ifdef HAVE_SPGPU + hksz = max(1,psb_gpu_WarpSize()) +#else + hksz = psi_get_hksz() +#endif + + if (b%is_by_rows()) then + + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + if (debug) write(0,*) 'Copying through GPU',nza + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,b%ja, b%val, a%deviceMat) + call a%set_dev() + else + ! This is to guarantee tmp%is_by_rows() + call b%cp_to_coo(tmp,info) + call tmp%fix(info) + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + if (debug) write(0,*) 'Copying through GPU' + call psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,tmp,info) + if (info /=0) then + write(0,*) ' Error from psi_compute_hckoff:',info, noffs,isz + return + end if + if (debug)write(0,*) ' From psi_compute_hckoff:',noffs,isz,a%hkoffs(1:min(10,noffs+1)) + + if (c_associated(a%deviceMat)) then + call freeHllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,hksz,nr,nza,isz,spgpu_type_double,1) + if (info == 0) info = psi_CopyCooToHlg(nr,nc,nza, hksz,noffs,isz,& + & a%irn,a%hkoffs,idisp,tmp%ja, tmp%val, a%deviceMat) + + call tmp%free() + call a%set_dev() + end if + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +contains + subroutine psi_compute_hckoff_from_coo(a,noffs,isz,hksz,idisp,b,info) + use psb_base_mod + use psi_ext_util_mod + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), allocatable, intent(out) :: idisp(:) + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info, noffs, isz + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, kc + logical, parameter :: debug=.false. + + info = 0 + nr = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() + + ! If it is sorted then we can lessen memory impact + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat + if (debug) write(0,*) 'Start compute hckoff_from_coo',nr,nc,nza + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info == 0) call psb_realloc(nr+1,idisp,info) + if (info /= 0) return + a%irn = 0 + if (debug) then + do i=1, nza + if ((1<=b%ia(i)).and.(b%ia(i)<= nr)) then + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + else + write(0,*) 'Out of bouds IA ',i,b%ia(i),nr + end if + end do + else + do i=1, nza + a%irn(b%ia(i)) = a%irn(b%ia(i)) + 1 + end do + end if + a%nzt = nza + + + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (debug) write(0,*) ' noffsets ',noffs,info + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + idisp(1) = 0 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + idisp(i+1) = idisp(i) + a%irn(i) + do k=1,ir-1 + idisp(i+k+1) = idisp(i+k) + a%irn(i+k) + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) +!!$ write(*,*) 'End of psi_comput_hckoff ',info + end subroutine psi_compute_hckoff_from_coo + +end subroutine psb_z_cp_hlg_from_coo diff --git a/gpu/impl/psb_z_cp_hlg_from_fmt.F90 b/gpu/impl/psb_z_cp_hlg_from_fmt.F90 new file mode 100644 index 000000000..a6dd5970d --- /dev/null +++ b/gpu/impl/psb_z_cp_hlg_from_fmt.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_cp_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_cp_hlg_from_fmt +#else + use psb_z_hlg_mat_mod +#endif + implicit none + + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_z_hll_sparse_mat%cp_from_fmt(b,info) +#ifdef HAVE_SPGPU + if (info == 0) call a%to_gpu(info) +#endif + end select + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_cp_hlg_from_fmt diff --git a/gpu/impl/psb_z_cp_hybg_from_coo.F90 b/gpu/impl/psb_z_cp_hybg_from_coo.F90 new file mode 100644 index 000000000..ebb6f60ae --- /dev/null +++ b/gpu/impl/psb_z_cp_hybg_from_coo.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_cp_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_cp_hybg_from_coo +#else + use psb_z_hybg_mat_mod +#endif + implicit none + + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + call a%psb_z_csr_sparse_mat%cp_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_cp_hybg_from_coo +#endif diff --git a/gpu/impl/psb_z_cp_hybg_from_fmt.F90 b/gpu/impl/psb_z_cp_hybg_from_fmt.F90 new file mode 100644 index 000000000..82f2ac65e --- /dev/null +++ b/gpu/impl/psb_z_cp_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_cp_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_cp_hybg_from_fmt +#else + use psb_z_hybg_mat_mod +#endif + implicit none + + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + info = psb_success_ + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + class default + call a%psb_z_csr_sparse_mat%cp_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_z_cp_hybg_from_fmt +#endif diff --git a/gpu/impl/psb_z_csrg_allocate_mnnz.F90 b/gpu/impl/psb_z_csrg_allocate_mnnz.F90 new file mode 100644 index 000000000..8cb2ccb1c --- /dev/null +++ b/gpu/impl/psb_z_csrg_allocate_mnnz.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_allocate_mnnz +#else + use psb_z_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_z_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + if (info == 0) call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_allocate_mnnz diff --git a/gpu/impl/psb_z_csrg_csmm.F90 b/gpu/impl/psb_z_csrg_csmm.F90 new file mode 100644 index 000000000..eb8a4d7f0 --- /dev/null +++ b/gpu/impl/psb_z_csrg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_csmm +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csrg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_csrg_csmv +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + complex(psb_dpk_) :: acc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_csrg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_csrg_from_gpu +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, n, nz + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat%mat))) then + call a%free() + return + end if + + info = CSRGDeviceGetParms(a%deviceMat,m,n,nz) + if (info /= psb_success_) return + + if (info == 0) call psb_realloc(m+1,a%irp,info) + if (info == 0) call psb_realloc(nz,a%ja,info) + if (info == 0) call psb_realloc(nz,a%val,info) + if (info == 0) info = & + & CSRGDevice2Host(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) +#if (CUDA_SHORT_VERSION <= 10) || (CUDA_VERSION < 11030) + a%irp(:) = a%irp(:)+1 + a%ja(:) = a%ja(:)+1 +#endif + + call a%set_sync() +#endif + +end subroutine psb_z_csrg_from_gpu diff --git a/gpu/impl/psb_z_csrg_inner_vect_sv.F90 b/gpu/impl/psb_z_csrg_inner_vect_sv.F90 new file mode 100644 index 000000000..75d6800bd --- /dev/null +++ b/gpu/impl/psb_z_csrg_inner_vect_sv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_z_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_inner_vect_sv +#else + use psb_z_csrg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_csrg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=dzero)) then + call x%sync() + call y%sync() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='csrg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_inner_vect_sv diff --git a/gpu/impl/psb_z_csrg_mold.F90 b/gpu/impl/psb_z_csrg_mold.F90 new file mode 100644 index 000000000..e83deb3f1 --- /dev/null +++ b/gpu/impl/psb_z_csrg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_mold(a,b,info) + + use psb_base_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_mold + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='csrg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_csrg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_mold diff --git a/gpu/impl/psb_z_csrg_reallocate_nz.F90 b/gpu/impl/psb_z_csrg_reallocate_nz.F90 new file mode 100644 index 000000000..c2509c229 --- /dev/null +++ b/gpu/impl/psb_z_csrg_reallocate_nz.F90 @@ -0,0 +1,70 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_reallocate_nz +#else + use psb_z_csrg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_csrg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_z_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_reallocate_nz diff --git a/gpu/impl/psb_z_csrg_scal.F90 b/gpu/impl/psb_z_csrg_scal.F90 new file mode 100644 index 000000000..d8ab0ca39 --- /dev/null +++ b/gpu/impl/psb_z_csrg_scal.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_scal +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + call a%psb_z_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_scal diff --git a/gpu/impl/psb_z_csrg_scals.F90 b/gpu/impl/psb_z_csrg_scals.F90 new file mode 100644 index 000000000..3d14998d1 --- /dev/null +++ b/gpu/impl/psb_z_csrg_scals.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_scals +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + call a%psb_z_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_csrg_scals diff --git a/gpu/impl/psb_z_csrg_to_gpu.F90 b/gpu/impl/psb_z_csrg_to_gpu.F90 new file mode 100644 index 000000000..4548935db --- /dev/null +++ b/gpu/impl/psb_z_csrg_to_gpu.F90 @@ -0,0 +1,325 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_to_gpu +#else + use psb_z_csrg_mat_mod +#endif + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + complex(psb_dpk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = CSRGDeviceFree(a%deviceMat) + end if +#if CUDA_SHORT_VERSION <= 10 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = zone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = zone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceCsrsmAnalysis(a%deviceMat) + end if + +#elif CUDA_VERSION < 11030 + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) +!!$ write(0,*) 'Done deviceAlloc' + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_zero) +!!$ write(0,*) 'Done SetIndexBase' + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(0:nzdi),valdi(0:nzdi),stat=info) + if (info == 0) then + irpdi(1) = 0 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = zone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1)-1 + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = zone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ write(0,*) 'Done deviceAlloc', info + if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,& + & cusparse_index_base_zero) +!!$ write(0,*) 'Done setIndexBase', info + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then + info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + nzdi=a%irp(m+1)-1 + if (info == 0) allocate(irpdi(m+1),jadi(max(nzdi,1)),stat=info) + if (info == 0) then + irpdi(1:m+1) = a%irp(1:m+1) -1 + jadi(1:nzdi) = a%ja(1:nzdi) -1 + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,irpdi,jadi,a%val) +!!$ write(0,*) 'Done Host2Device', info + endif + + +#else + + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + !!! We are explicitly adding the diagonal + !! info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = zone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = zone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + + else + + if (info == 0) info = CSRGDeviceAlloc(a%deviceMat,m,n,nz) +!!$ if (info == 0) info = CSRGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + if (info == 0) then + if (a%is_unit()) then + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = CSRGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = CSRGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + if (info == 0) info = CSRGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + endif + +!!$ if ((info == 0) .and. a%is_triangle()) then +!!$ info = CSRGDeviceCsrsmAnalysis(a%deviceMat) +!!$ end if + +#endif + call a%set_sync() + + if (info /= 0) then + write(0,*) 'Error in CSRG_TO_GPU ',info + end if +#endif + +end subroutine psb_z_csrg_to_gpu diff --git a/gpu/impl/psb_z_csrg_vect_mv.F90 b/gpu/impl/psb_z_csrg_vect_mv.F90 new file mode 100644 index 000000000..0770d4489 --- /dev/null +++ b/gpu/impl/psb_z_csrg_vect_mv.F90 @@ -0,0 +1,125 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_csrg_vect_mv +#else + use psb_z_csrg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_csrg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= zzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_z_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= zzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvCSRGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvCSRGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_z_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_z_csrg_vect_mv diff --git a/gpu/impl/psb_z_diag_csmv.F90 b/gpu/impl/psb_z_diag_csmv.F90 new file mode 100644 index 000000000..667e1a1f4 --- /dev/null +++ b/gpu/impl/psb_z_diag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_diag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_z_diag_mat_mod, psb_protect_name => psb_z_diag_csmv +#else + use psb_z_diag_mat_mod +#endif + implicit none + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='z_diag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_diag_mold + implicit none + class(psb_z_diag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='diag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_diag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_diag_mold diff --git a/gpu/impl/psb_z_diag_to_gpu.F90 b/gpu/impl/psb_z_diag_to_gpu.F90 new file mode 100644 index 000000000..409136245 --- /dev/null +++ b/gpu/impl/psb_z_diag_to_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_diag_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_z_diag_mat_mod, psb_protect_name => psb_z_diag_to_gpu +#else + use psb_z_diag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_z_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, c,pitch,maxrowsize,d +#ifdef HAVE_SPGPU + type(diagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%data)).or.(.not.allocated(a%offset))) return + + n = size(a%data,1) + d = size(a%data,2) + c = a%get_ncols() + !allocsize = a%get_size() + !write(*,*) 'Create the DIAG matrix' + gpu_parms = FgetDiagDeviceParams(n,c,d,spgpu_type_complex_double) + if (c_associated(a%deviceMat)) then + call freeDiagDevice(a%deviceMat) + endif + info = FallocDiagDevice(a%deviceMat,n,c,d,spgpu_type_complex_double) + if (info == 0) info = & + & writeDiagDevice(a%deviceMat,a%data,a%offset,n) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_z_diag_to_gpu diff --git a/gpu/impl/psb_z_diag_vect_mv.F90 b/gpu/impl/psb_z_diag_vect_mv.F90 new file mode 100644 index 000000000..b89464918 --- /dev/null +++ b/gpu/impl/psb_z_diag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_diag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_z_diag_mat_mod, psb_protect_name => psb_z_diag_vect_mv +#else + use psb_z_diag_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_diag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= szero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_z_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_z_dia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_diag_vect_mv diff --git a/gpu/impl/psb_z_dnsg_mat_impl.F90 b/gpu/impl/psb_z_dnsg_mat_impl.F90 new file mode 100644 index 000000000..407deaa2d --- /dev/null +++ b/gpu/impl/psb_z_dnsg_mat_impl.F90 @@ -0,0 +1,461 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +subroutine psb_z_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_dnsg_vect_mv +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + class(psb_z_dnsg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + logical :: tra + character :: trans_ + complex(psb_dpk_), allocatable :: rx(:), ry(:) + Integer(Psb_ipk_) :: err_act, m, n, k + character(len=20) :: name='z_dnsg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (trans_ =='N') then + m = a%get_nrows() + n = 1 + k = a%get_ncols() + else + m = a%get_ncols() + n = 1 + k = a%get_nrows() + end if + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= zzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvDnsDevice(trans_,m,n,k,alpha,a%deviceMat,& + & xx%deviceVect,beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvDnsDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_dnsg_vect_mv + + +subroutine psb_z_dnsg_mold(a,b,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_dnsg_mold +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + class(psb_z_dnsg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='dnsg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_dnsg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_dnsg_mold + + +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_z_dnsg_sparse_mat, psb_dpk_, psb_z_base_vect_type +!!$ class(psb_z_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_z_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_z_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_z_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_z_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_z_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_z_dnsg_allocate_mnnz +!!$ end interface + + +subroutine psb_z_dnsg_to_gpu(a,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_dnsg_to_gpu +#else + use psb_z_dnsg_mat_mod +#endif + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act, pitch, lda + logical, parameter :: debug=.false. + character(len=20) :: name='z_dnsg_to_gpu' + + call psb_erractionsave(err_act) + info = psb_success_ +#ifdef HAVE_SPGPU + if (debug) write(0,*) 'DNS_TO_GPU',size(a%val,1),size(a%val,2) + info = FallocDnsDevice(a%deviceMat,a%get_nrows(),a%get_ncols(),& + & spgpu_type_complex_double,1) + if (info == 0) info = writeDnsDevice(a%deviceMat,a%val,size(a%val,1),size(a%val,2)) + if (debug) write(0,*) 'DNS_TO_GPU: From writeDnsDEvice',info + + +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_dnsg_to_gpu + + + +subroutine psb_z_cp_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_cp_dnsg_from_coo +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_dnsg_cp_from_coo' + integer(psb_ipk_) :: debug_level, debug_unit + logical, parameter :: debug=.false. + type(psb_z_coo_sparse_mat) :: tmp + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + call a%psb_z_dns_sparse_mat%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_cp_from_coo: dns_cp',info + if (info == 0) call a%to_gpu(info) + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_cp_dnsg_from_coo + +subroutine psb_z_cp_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_cp_dnsg_from_fmt +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + type(psb_z_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + +!!$ class is (psb_z_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_cp_dnsg_from_fmt + + + +subroutine psb_z_mv_dnsg_from_coo(a,b,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_mv_dnsg_from_coo +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + logical, parameter :: debug=.false. + character(len=20) :: name='z_dnsg_mv_from_coo' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + if (debug) write(0,*) 'dnsg_mv_from_coo: cp_from_coo:',info + call b%free() + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_mv_dnsg_from_coo + + +subroutine psb_z_mv_dnsg_from_fmt(a,b,info) + use psb_base_mod + use psb_z_gpu_vect_mod +#ifdef HAVE_SPGPU + use dnsdev_mod + use psb_z_vectordev_mod + use psb_z_dnsg_mat_mod, psb_protect_name => psb_z_mv_dnsg_from_fmt +#else + use psb_z_dnsg_mat_mod +#endif + implicit none + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + type(psb_z_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_dnsg_cp_from_fmt' + + call psb_erractionsave(err_act) + info = psb_success_ + if (b%is_dev()) call b%sync() + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + +!!$ class is (psb_z_ell_sparse_mat) +!!$ nzm = psb_size(b%ja,2) +!!$ m = b%get_nrows() +!!$ nc = b%get_ncols() +!!$ nza = b%get_nzeros() +!!$#ifdef HAVE_SPGPU +!!$ gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) +!!$ ld = gpu_parms%pitch +!!$ nzm = gpu_parms%maxRowSize +!!$#else +!!$ ld = m +!!$#endif +!!$ a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat +!!$ if (info == 0) call psb_safe_cpy( b%idiag, a%idiag , info) +!!$ if (info == 0) call psb_safe_cpy( b%irn, a%irn , info) +!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) +!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) +!!$ if (info == 0) call psb_realloc(ld,nzm,a%ja,info) +!!$ if (info == 0) then +!!$ a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) +!!$ end if +!!$ if (info == 0) call psb_realloc(ld,nzm,a%val,info) +!!$ if (info == 0) then +!!$ a%val(1:m,1:nzm) = b%val(1:m,1:nzm) +!!$ end if +!!$ a%nzt = nza +!!$#ifdef HAVE_SPGPU +!!$ call a%to_gpu(info) +!!$#endif + + class default + + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_z_mv_dnsg_from_fmt diff --git a/gpu/impl/psb_z_elg_allocate_mnnz.F90 b/gpu/impl/psb_z_elg_allocate_mnnz.F90 new file mode 100644 index 000000000..39d14dd20 --- /dev/null +++ b/gpu/impl/psb_z_elg_allocate_mnnz.F90 @@ -0,0 +1,113 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_allocate_mnnz +#else + use psb_z_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + if (m < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (n < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/2*ione,izero,izero,izero,izero/)) + goto 9999 + endif + if (present(nz)) then + nz_ = (max(nz,ione) + m -1 )/m + else + nz_ = (max(7*m,7*n,ione)+m-1)/m + end if + if (nz_ < 0) then + info = psb_err_iarg_neg_ + call psb_errpush(info,name,i_err=(/3*ione,izero,izero,izero,izero/)) + goto 9999 + endif + +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nz_,nz_*m,n,spgpu_type_complex_double,1) + ld = gpu_parms%pitch + nz_ = gpu_parms%maxRowSize +#else + ld = m +#endif + + if (info == psb_success_) call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nz_,a%val,info) + if (info == psb_success_) then + a%irn = 0 + a%idiag = 0 + a%nzt = 0 + call a%set_nrows(m) + call a%set_ncols(n) + call a%set_bld() + call a%set_triangle(.false.) + call a%set_unit(.false.) + call a%set_dupl(psb_dupl_def_) + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_allocate_mnnz diff --git a/gpu/impl/psb_z_elg_asb.f90 b/gpu/impl/psb_z_elg_asb.f90 new file mode 100644 index 000000000..515f579a2 --- /dev/null +++ b/gpu/impl/psb_z_elg_asb.f90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_asb(a) + + use psb_base_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_asb + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + + integer(psb_ipk_) :: err_act, info + character(len=20) :: name='elg_asb' + logical :: clear_ + logical, parameter :: debug=.false. + real(psb_dpk_), allocatable :: valt(:,:) + integer(psb_ipk_), allocatable :: jat(:,:) + integer(psb_ipk_) :: nr, nc + + call psb_erractionsave(err_act) + info = psb_success_ + + ! Only call sync() if we are on host + if (a%is_host()) then + call a%sync() + end if + call a%set_asb() + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_asb diff --git a/gpu/impl/psb_z_elg_csmm.F90 b/gpu/impl/psb_z_elg_csmm.F90 new file mode 100644 index 000000000..aa27419c2 --- /dev/null +++ b/gpu/impl/psb_z_elg_csmm.F90 @@ -0,0 +1,134 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_csmm +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_elg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_elg_csmv +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + complex(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_elg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_elg_csput_a +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_elg_csput_a' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +!!$ write(0,*) 'In ELG_csput_a' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(ia) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (size(ja) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (size(val) < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then +!!$ write(*,*) 'elg_csput_a ' + if (a%is_dev()) call a%sync() + call a%psb_z_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + call a%set_host() + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_csput_a + + + +subroutine psb_z_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use iso_c_binding +#ifdef HAVE_SPGPU + use elldev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_csput_v + use psb_z_gpu_vect_mod +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + + + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_elg_csput_v' + logical, parameter :: debug=.false. + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit, nrw + logical :: gpu_invoked + real(psb_dpk_) :: t1,t2,t3 + type(c_ptr) :: devIdxUpd + integer(psb_ipk_), allocatable :: idxs(:) + logical, parameter :: debug_idxs=.false., debug_vals=.false. + + + call psb_erractionsave(err_act) + info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + +! write(0,*) 'In ELG_csput_v' + if (nz <= 0) then + info = psb_err_iarg_neg_ + int_err(1)=1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (ia%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=2 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (ja%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=3 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + if (val%get_nrows() < nz) then + info = psb_err_input_asize_invalid_i_ + int_err(1)=4 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + if (nz == 0) return + + + if (a%is_bld()) then + ! Build phase should only ever be in COO + info = psb_err_invalid_mat_state_ + + else if (a%is_upd()) then + + t1=psb_wtime() + gpu_invoked = .false. + select type (ia) + class is (psb_i_vect_gpu) + select type (ja) + class is (psb_i_vect_gpu) + select type (val) + class is (psb_z_vect_gpu) + if (a%is_host()) call a%sync() + if (val%is_host()) call val%sync() + if (ia%is_host()) call ia%sync() + if (ja%is_host()) call ja%sync() + info = csputEllDeviceDoubleComplex(a%deviceMat,nz,& + & ia%deviceVect,ja%deviceVect,val%deviceVect) + call a%set_dev() + gpu_invoked=.true. + end select + end select + end select + if (.not.gpu_invoked) then +!!$ write(0,*)'Not gpu_invoked ' + if (a%is_dev()) call a%sync() + call a%psb_z_ell_sparse_mat%csput(nz,ia,ja,val,& + & imin,imax,jmin,jmax,info) + call a%set_host() + end if + + if (info /= 0) then + info = psb_err_internal_error_ + end if + + + else + ! State is wrong. + info = psb_err_invalid_mat_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + +end subroutine psb_z_elg_csput_v diff --git a/gpu/impl/psb_z_elg_from_gpu.F90 b/gpu/impl/psb_z_elg_from_gpu.F90 new file mode 100644 index 000000000..e8670cd45 --- /dev/null +++ b/gpu/impl/psb_z_elg_from_gpu.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_from_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_from_gpu +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize + + info = 0 + +#ifdef HAVE_SPGPU + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + if (info == 0) call psb_realloc(pitch,a%irn,info) + end if + if (info == 0) info = & + & readEllDevice(a%deviceMat,a%val,a%ja,pitch,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_z_elg_from_gpu diff --git a/gpu/impl/psb_z_elg_inner_vect_sv.F90 b/gpu/impl/psb_z_elg_inner_vect_sv.F90 new file mode 100644 index 000000000..66d7eed87 --- /dev/null +++ b/gpu/impl/psb_z_elg_inner_vect_sv.F90 @@ -0,0 +1,89 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_inner_vect_sv +#else + use psb_z_elg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_elg_inner_vect_sv' + logical, parameter :: debug=.false. + complex(psb_dpk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + if (a%is_dev()) call a%sync() + if (.false.) then + rx = x%get_vect() + ry = y%get_vect() + call a%inner_spsm(alpha,rx,beta,ry,info,trans) + call y%bld(ry) + else + call x%sync() + call y%sync() + call a%psb_z_ell_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_inner_vect_sv diff --git a/gpu/impl/psb_z_elg_mold.F90 b/gpu/impl/psb_z_elg_mold.F90 new file mode 100644 index 000000000..1a5ebe543 --- /dev/null +++ b/gpu/impl/psb_z_elg_mold.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_mold(a,b,info) + + use psb_base_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_mold + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='elg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_elg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_mold diff --git a/gpu/impl/psb_z_elg_reallocate_nz.F90 b/gpu/impl/psb_z_elg_reallocate_nz.F90 new file mode 100644 index 000000000..f6bc194f8 --- /dev/null +++ b/gpu/impl/psb_z_elg_reallocate_nz.F90 @@ -0,0 +1,79 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_reallocate_nz +#else + use psb_z_elg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_elg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + ! + ! What should this really do??? + ! + if (a%is_dev()) call a%sync() + m = a%get_nrows() + nzrm = (max(nz,ione)+m-1)/m + ld = size(a%ja,1) + call psb_realloc(ld,nzrm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzrm,a%val,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nzrm) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_reallocate_nz diff --git a/gpu/impl/psb_z_elg_scal.F90 b/gpu/impl/psb_z_elg_scal.F90 new file mode 100644 index 000000000..eed9007a4 --- /dev/null +++ b/gpu/impl/psb_z_elg_scal.F90 @@ -0,0 +1,78 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_scal +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_z_ell_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_scal diff --git a/gpu/impl/psb_z_elg_scals.F90 b/gpu/impl/psb_z_elg_scals.F90 new file mode 100644 index 000000000..1e3f36820 --- /dev/null +++ b/gpu/impl/psb_z_elg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_scals +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + call a%make_nonunit() + end if + + a%val(:,:) = a%val(:,:) * d + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_scals diff --git a/gpu/impl/psb_z_elg_to_gpu.F90 b/gpu/impl/psb_z_elg_to_gpu.F90 new file mode 100644 index 000000000..71a5ec660 --- /dev/null +++ b/gpu/impl/psb_z_elg_to_gpu.F90 @@ -0,0 +1,93 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_to_gpu +#else + use psb_z_elg_mat_mod +#endif + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize, nzt +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + nzm = psb_size(a%val,2) + n = a%get_ncols() + nzt = a%get_nzeros() + if (present(nzrm)) nzm = max(nzm,nzrm) + + gpu_parms = FgetEllDeviceParams(m,nzm,nzt,n,spgpu_type_complex_double,1) + + if (c_associated(a%deviceMat)) then + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + else + pitch = -1 + maxrowsize = -1 + end if + + if ((pitch /= gpu_parms%pitch).or.(maxrowsize /= gpu_parms%maxRowSize)) then + if (c_associated(a%deviceMat)) then + call freeEllDevice(a%deviceMat) + endif + info = FallocEllDevice(a%deviceMat,m,nzm,nzt,n,spgpu_type_complex_double,1) + pitch = getEllDevicePitch(a%deviceMat) + maxrowsize = getEllDeviceMaxRowSize(a%deviceMat) + end if + if (info == 0) then + if ((pitch /= psb_size(a%val,1)).or.(maxrowsize /= psb_size(a%val,2))) then + call psb_realloc(pitch,maxrowsize,a%val,info) + if (info == 0) call psb_realloc(pitch,maxrowsize,a%ja,info) + end if + end if + if (info == 0) info = & + & writeEllDevice(a%deviceMat,a%val,a%ja,size(a%ja,1),a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_z_elg_to_gpu diff --git a/gpu/impl/psb_z_elg_trim.f90 b/gpu/impl/psb_z_elg_trim.f90 new file mode 100644 index 000000000..9bd433126 --- /dev/null +++ b/gpu/impl/psb_z_elg_trim.f90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_trim(a) + + use psb_base_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_trim + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + Integer(psb_ipk_) :: err_act, info, nz, m, nzm,ld + character(len=20) :: name='trim' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + m = max(1_psb_ipk_,a%get_nrows()) + ld = max(1_psb_ipk_,size(a%ja,1)) + nzm = max(1_psb_ipk_,maxval(a%irn(1:m))) + + call psb_realloc(m,a%irn,info) + if (info == psb_success_) call psb_realloc(m,a%idiag,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ld,nzm,a%val,info) + + if (info /= psb_success_) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_trim diff --git a/gpu/impl/psb_z_elg_vect_mv.F90 b/gpu/impl/psb_z_elg_vect_mv.F90 new file mode 100644 index 000000000..5cd72e447 --- /dev/null +++ b/gpu/impl/psb_z_elg_vect_mv.F90 @@ -0,0 +1,131 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_elg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_elg_vect_mv +#else + use psb_z_elg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_elg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (a%is_dev()) call a%sync() + if (.not.x%is_host()) call x%sync() + if (beta /= zzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_z_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (a%is_host()) call a%sync() + if (xx%is_host()) call xx%sync() + if (beta /= zzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvEllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvELLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + if (a%is_dev()) call a%sync() + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + if (a%is_dev()) call a%sync() + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + if (a%is_dev()) call a%sync() + call a%psb_z_ell_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_elg_vect_mv diff --git a/gpu/impl/psb_z_hdiag_csmv.F90 b/gpu/impl/psb_z_hdiag_csmv.F90 new file mode 100644 index 000000000..baf730a2c --- /dev/null +++ b/gpu/impl/psb_z_hdiag_csmv.F90 @@ -0,0 +1,136 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hdiag_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_z_hdiag_mat_mod, psb_protect_name => psb_z_hdiag_csmv +#else + use psb_z_hdiag_mat_mod +#endif + implicit none + class(psb_z_hdiag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='z_hdiag_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_hdiag_mold + implicit none + class(psb_z_hdiag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='hdiag_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_hdiag_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hdiag_mold diff --git a/gpu/impl/psb_z_hdiag_to_gpu.F90 b/gpu/impl/psb_z_hdiag_to_gpu.F90 new file mode 100644 index 000000000..622a01415 --- /dev/null +++ b/gpu/impl/psb_z_hdiag_to_gpu.F90 @@ -0,0 +1,86 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hdiag_to_gpu(a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_z_hdiag_mat_mod, psb_protect_name => psb_z_hdiag_to_gpu +#else + use psb_z_hdiag_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nr, nc, hacksize, hackcount, allocheight +#ifdef HAVE_SPGPU + type(hdiagdev_parms) :: gpu_parms +#endif + + info = 0 + +#ifdef HAVE_SPGPU + nr = a%get_nrows() + nc = a%get_ncols() + hacksize = a%hackSize + hackCount = a%nhacks + if (.not.allocated(a%hackOffsets)) then + info = -1 + return + end if + allocheight = a%hackOffsets(hackCount+1) +!!$ write(*,*) 'HDIAG TO GPU:',nr,nc,hacksize,hackCount,allocheight,& +!!$ & size(a%hackoffsets),size(a%diaoffsets), size(a%val) + if (.not.allocated(a%diaOffsets)) then + info = -2 + return + end if + if (.not.allocated(a%val)) then + info = -3 + return + end if + + if (c_associated(a%deviceMat)) then + call freeHdiagDevice(a%deviceMat) + endif + + info = FAllocHdiagDevice(a%deviceMat,nr,nc,& + & allocheight,hacksize,hackCount,spgpu_type_double) + if (info == 0) info = & + & writeHdiagDevice(a%deviceMat,a%val,a%diaOffsets,a%hackOffsets) + +#endif + +end subroutine psb_z_hdiag_to_gpu diff --git a/gpu/impl/psb_z_hdiag_vect_mv.F90 b/gpu/impl/psb_z_hdiag_vect_mv.F90 new file mode 100644 index 000000000..3e1c859e9 --- /dev/null +++ b/gpu/impl/psb_z_hdiag_vect_mv.F90 @@ -0,0 +1,126 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_z_hdiag_mat_mod, psb_protect_name => psb_z_hdiag_vect_mv +#else + use psb_z_hdiag_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_hdiag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hdiag_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= dzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_z_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHdiagDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHDIAGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_z_hdia_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hdiag_vect_mv diff --git a/gpu/impl/psb_z_hlg_allocate_mnnz.F90 b/gpu/impl/psb_z_hlg_allocate_mnnz.F90 new file mode 100644 index 000000000..e3c05ec1a --- /dev/null +++ b/gpu/impl/psb_z_hlg_allocate_mnnz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_allocate_mnnz +#else + use psb_z_hlg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. +#ifdef HAVE_SPGPU + type(hlldev_parms) :: gpu_parms +#endif + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_z_hll_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz_) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hlg_allocate_mnnz diff --git a/gpu/impl/psb_z_hlg_csmm.F90 b/gpu/impl/psb_z_hlg_csmm.F90 new file mode 100644 index 000000000..3432c1770 --- /dev/null +++ b/gpu/impl/psb_z_hlg_csmm.F90 @@ -0,0 +1,132 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_csmm +#else + use psb_z_hlg_mat_mod +#endif + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + complex(psb_dpk_), allocatable :: acc(:) + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hlg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_hlg_csmv +#else + use psb_z_hlg_mat_mod +#endif + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer, intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer :: i,j,k,m,n, nnz, ir, jc + complex(psb_dpk_) :: acc + type(c_ptr) :: gpX, gpY + logical :: tra + Integer :: err_act + character(len=20) :: name='z_hlg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_hlg_from_gpu +#else + use psb_z_hlg_mat_mod +#endif + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: hksize,rows,nzeros,allocsize,hackOffsLength,firstIndex,avgnzr + + info = 0 + +#ifdef HAVE_SPGPU + if (a%is_sync()) return + if (a%is_host()) return + if (.not.(c_associated(a%deviceMat))) then + call a%free() + return + end if + + + info = getHllDeviceParams(a%deviceMat,hksize, rows, nzeros, allocsize,& + & hackOffsLength, firstIndex,avgnzr) + + if (info == 0) call a%set_nzeros(nzeros) + if (info == 0) call a%set_hksz(hksize) + if (info == 0) call psb_realloc(rows,a%irn,info) + if (info == 0) call psb_realloc(rows,a%idiag,info) + if (info == 0) call psb_realloc(allocsize,a%ja,info) + if (info == 0) call psb_realloc(allocsize,a%val,info) + if (info == 0) call psb_realloc((hackOffsLength+1),a%hkoffs,info) + + if (info == 0) info = & + & readHllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) + call a%set_sync() +#endif + +end subroutine psb_z_hlg_from_gpu diff --git a/gpu/impl/psb_z_hlg_inner_vect_sv.F90 b/gpu/impl/psb_z_hlg_inner_vect_sv.F90 new file mode 100644 index 000000000..5a7b10318 --- /dev/null +++ b/gpu/impl/psb_z_hlg_inner_vect_sv.F90 @@ -0,0 +1,81 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_inner_vect_sv +#else + use psb_z_hlg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_base_inner_vect_sv' + logical, parameter :: debug=.false. + complex(psb_dpk_), allocatable :: rx(:), ry(:) + + call psb_get_erraction(err_act) + info = psb_success_ + + + call x%sync() + call y%sync() + if (a%is_dev()) call a%sync() + call a%psb_z_hll_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hlg_inner_vect_sv diff --git a/gpu/impl/psb_z_hlg_mold.F90 b/gpu/impl/psb_z_hlg_mold.F90 new file mode 100644 index 000000000..f9ff0c7ab --- /dev/null +++ b/gpu/impl/psb_z_hlg_mold.F90 @@ -0,0 +1,64 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_mold(a,b,info) + + use psb_base_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_mold + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer, intent(out) :: info + Integer :: err_act + character(len=20) :: name='hlg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_hlg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_z_hlg_mold diff --git a/gpu/impl/psb_z_hlg_reallocate_nz.F90 b/gpu/impl/psb_z_hlg_reallocate_nz.F90 new file mode 100644 index 000000000..f3d506262 --- /dev/null +++ b/gpu/impl/psb_z_hlg_reallocate_nz.F90 @@ -0,0 +1,67 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_reallocate_nz +#else + use psb_z_hlg_mat_mod +#endif + use iso_c_binding + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hlg_sparse_mat), intent(inout) :: a + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_hlg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + call a%psb_z_hll_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hlg_reallocate_nz diff --git a/gpu/impl/psb_z_hlg_scal.F90 b/gpu/impl/psb_z_hlg_scal.F90 new file mode 100644 index 000000000..8aa855006 --- /dev/null +++ b/gpu/impl/psb_z_hlg_scal.F90 @@ -0,0 +1,75 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_scal +#else + use psb_z_hlg_mat_mod +#endif + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_z_hll_sparse_mat%scal(d,info,side) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hlg_scal diff --git a/gpu/impl/psb_z_hlg_scals.F90 b/gpu/impl/psb_z_hlg_scals.F90 new file mode 100644 index 000000000..d5689c064 --- /dev/null +++ b/gpu/impl/psb_z_hlg_scals.F90 @@ -0,0 +1,73 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_scals +#else + use psb_z_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_z_hll_sparse_mat%scal(d,info) + if (info /= psb_success_) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return +end subroutine psb_z_hlg_scals diff --git a/gpu/impl/psb_z_hlg_to_gpu.F90 b/gpu/impl/psb_z_hlg_to_gpu.F90 new file mode 100644 index 000000000..d63aee9ca --- /dev/null +++ b/gpu/impl/psb_z_hlg_to_gpu.F90 @@ -0,0 +1,68 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_to_gpu +#else + use psb_z_hlg_mat_mod +#endif + use iso_c_binding + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, nza, n, pitch,maxrowsize, allocsize + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + n = a%get_nrows() + allocsize = a%get_size() + nza = a%get_nzeros() + if (c_associated(a%deviceMat)) then + call freehllDevice(a%deviceMat) + endif + info = FallochllDevice(a%deviceMat,a%hksz,n,nza,allocsize,spgpu_type_complex_double,1) + if (info == 0) info = & + & writehllDevice(a%deviceMat,a%val,a%ja,a%hkoffs,a%irn,a%idiag) +! if (info /= 0) goto 9999 +#endif + +end subroutine psb_z_hlg_to_gpu diff --git a/gpu/impl/psb_z_hlg_vect_mv.F90 b/gpu/impl/psb_z_hlg_vect_mv.F90 new file mode 100644 index 000000000..9efefc0a1 --- /dev/null +++ b/gpu/impl/psb_z_hlg_vect_mv.F90 @@ -0,0 +1,129 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_hlg_vect_mv +#else + use psb_z_hlg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hlg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= zzero) then + if (.not.y%is_host()) call y%sync() + end if + if (a%is_dev()) call a%sync() + call a%psb_z_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= dzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvhllDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHLLDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + if (a%is_dev()) call a%sync() + call a%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + + end if +#else + call a%psb_z_hll_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hlg_vect_mv diff --git a/gpu/impl/psb_z_hybg_allocate_mnnz.F90 b/gpu/impl/psb_z_hybg_allocate_mnnz.F90 new file mode 100644 index 000000000..2c38c5368 --- /dev/null +++ b/gpu/impl/psb_z_hybg_allocate_mnnz.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_allocate_mnnz(m,n,a,nz) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_allocate_mnnz +#else + use psb_z_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + Integer(Psb_ipk_) :: err_act, info, nz_,ld + character(len=20) :: name='allocate_mnz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + call a%psb_z_csr_sparse_mat%allocate(m,n,nz) + +#ifdef HAVE_SPGPU + info = initFcusparse() + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_allocate_mnnz +#endif diff --git a/gpu/impl/psb_z_hybg_csmm.F90 b/gpu/impl/psb_z_hybg_csmm.F90 new file mode 100644 index 000000000..5ec9701ba --- /dev/null +++ b/gpu/impl/psb_z_hybg_csmm.F90 @@ -0,0 +1,135 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_csmm +#else + use psb_z_hybg_mat_mod +#endif + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy + type(c_ptr) :: gpX, gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hybg_csmm' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_hybg_csmv +#else + use psb_z_hybg_mat_mod +#endif + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + character :: trans_ + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc + type(c_ptr) :: gpX + type(c_ptr) :: gpY + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hybg_csmv' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + if (tra) then + m = a%get_ncols() + n = a%get_nrows() + else + n = a%get_ncols() + m = a%get_nrows() + end if + + if (size(x,1) psb_z_hybg_inner_vect_sv +#else + use psb_z_hybg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_hybg_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + +#ifdef HAVE_SPGPU + if (tra.or.(beta/=zzero)) then + call x%sync() + call y%sync() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() + else + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= zzero) then + if (yy%is_host()) call yy%sync() + end if + info = spsvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spsvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call x%sync() + call y%sync() + call a%psb_z_csr_sparse_mat%inner_spsm(alpha,x,beta,y,info,trans) + call y%set_host() +#endif + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='hybg_vect_sv') + goto 9999 + end if + + + call psb_erractionrestore(err_act) + return + + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_inner_vect_sv +#endif diff --git a/gpu/impl/psb_z_hybg_mold.F90 b/gpu/impl/psb_z_hybg_mold.F90 new file mode 100644 index 000000000..3a17dbd27 --- /dev/null +++ b/gpu/impl/psb_z_hybg_mold.F90 @@ -0,0 +1,66 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_mold(a,b,info) + + use psb_base_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_mold + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='hybg_mold' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + + info = 0 + if (allocated(b)) then + call b%free() + deallocate(b,stat=info) + end if + if (info == 0) allocate(psb_z_hybg_sparse_mat :: b, stat=info) + + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_mold +#endif diff --git a/gpu/impl/psb_z_hybg_reallocate_nz.F90 b/gpu/impl/psb_z_hybg_reallocate_nz.F90 new file mode 100644 index 000000000..79d81911d --- /dev/null +++ b/gpu/impl/psb_z_hybg_reallocate_nz.F90 @@ -0,0 +1,71 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_reallocate_nz(nz,a) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_reallocate_nz +#else + use psb_z_hybg_mat_mod +#endif + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_hybg_reallocate_nz' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + ! + ! What should this really do??? + ! + call a%psb_z_csr_sparse_mat%reallocate(nz) + +#ifdef HAVE_SPGPU + call a%to_gpu(info,nzrm=nz) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_reallocate_nz +#endif diff --git a/gpu/impl/psb_z_hybg_scal.F90 b/gpu/impl/psb_z_hybg_scal.F90 new file mode 100644 index 000000000..c8179bf2a --- /dev/null +++ b/gpu/impl/psb_z_hybg_scal.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_scal(d,a,info,side) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_scal +#else + use psb_z_hybg_mat_mod +#endif + implicit none + class(psb_z_hybg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m,n,nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + call a%psb_z_csr_sparse_mat%scal(d,info,side=side) + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_scal +#endif diff --git a/gpu/impl/psb_z_hybg_scals.F90 b/gpu/impl/psb_z_hybg_scals.F90 new file mode 100644 index 000000000..3729412d5 --- /dev/null +++ b/gpu/impl/psb_z_hybg_scals.F90 @@ -0,0 +1,76 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_scals(d,a,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_scals +#else + use psb_z_hybg_mat_mod +#endif + implicit none + class(psb_z_hybg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + + Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, nz + character(len=20) :: name='scal' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + + if (a%is_unit()) then + call a%make_nonunit() + end if + + + call a%psb_z_csr_sparse_mat%scal(d,info) + + if (info /= 0) goto 9999 + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_scals +#endif diff --git a/gpu/impl/psb_z_hybg_to_gpu.F90 b/gpu/impl/psb_z_hybg_to_gpu.F90 new file mode 100644 index 000000000..4a2a9b1cd --- /dev/null +++ b/gpu/impl/psb_z_hybg_to_gpu.F90 @@ -0,0 +1,154 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_to_gpu(a,info,nzrm) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_to_gpu +#else + use psb_z_hybg_mat_mod +#endif + implicit none + class(psb_z_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + + integer(psb_ipk_) :: m, nzm, n, pitch,maxrowsize,nz + integer(psb_ipk_) :: nzdi,i,j,k,nrz + integer(psb_ipk_), allocatable :: irpdi(:),jadi(:) + complex(psb_dpk_), allocatable :: valdi(:) + + info = 0 + +#ifdef HAVE_SPGPU + if ((.not.allocated(a%val)).or.(.not.allocated(a%ja))) return + + m = a%get_nrows() + n = a%get_ncols() + nz = a%get_nzeros() + if (c_associated(a%deviceMat%Mat)) then + info = HYBGDeviceFree(a%deviceMat) + end if + if (a%is_unit()) then + ! + ! CUSPARSE has the habit of storing the diagonal and then ignoring, + ! whereas we do not store it. Hence this adapter code. + ! + nzdi = nz + m + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nzdi) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! We are explicitly adding the diagonal + if (info == 0) info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) allocate(irpdi(m+1),jadi(nzdi),valdi(nzdi),stat=info) + if (info == 0) then + irpdi(1) = 1 + if (a%is_triangle().and.a%is_upper()) then + do i=1,m + j = irpdi(i) + jadi(j) = i + valdi(j) = zone + nrz = a%irp(i+1)-a%irp(i) + jadi(j+1:j+nrz) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+1:j+nrz) = a%val(a%irp(i):a%irp(i+1)-1) + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + else + do i=1,m + j = irpdi(i) + nrz = a%irp(i+1)-a%irp(i) + jadi(j+0:j+nrz-1) = a%ja(a%irp(i):a%irp(i+1)-1) + valdi(j+0:j+nrz-1) = a%val(a%irp(i):a%irp(i+1)-1) + jadi(j+nrz) = i + valdi(j+nrz) = zone + irpdi(i+1) = j + nrz + 1 + ! write(0,*) 'Row ',i,' : ',irpdi(i:i+1),':',jadi(j:j+nrz),valdi(j:j+nrz) + end do + end if + end if + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nzdi,irpdi,jadi,valdi) + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + else + + if (info == 0) info = HYBGDeviceAlloc(a%deviceMat,m,n,nz) + if (info == 0) info = HYBGDeviceSetMatIndexBase(a%deviceMat,cusparse_index_base_one) + ! Dirty trick: CUSPARSE 4.1 wants to have a matrix declared GENERAL when + ! doing csr2hyb (inside Host2Device), so we do it here, and afterwards overwrite with + ! TRIANGULAR if needed. Weird, but works. + if (info == 0) info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_general) + if (info == 0) then + if (a%is_unit()) then + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_unit) + else + info = HYBGDeviceSetMatDiagType(a%deviceMat,cusparse_diag_type_non_unit) + end if + end if + + if (info == 0) info = HYBGHost2Device(a%deviceMat,m,n,nz,a%irp,a%ja,a%val) + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceSetMatType(a%deviceMat,cusparse_matrix_type_triangular) + if ((info == 0).and.a%is_upper()) then + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_upper) + else + info = HYBGDeviceSetMatFillMode(a%deviceMat,cusparse_fill_mode_lower) + end if + end if + + endif + + if ((info == 0) .and. a%is_triangle()) then + info = HYBGDeviceHybsmAnalysis(a%deviceMat) + end if + + + if (info /= 0) then + write(0,*) 'Error in HYBG_TO_GPU ',info + end if +#endif + +end subroutine psb_z_hybg_to_gpu +#endif diff --git a/gpu/impl/psb_z_hybg_vect_mv.F90 b/gpu/impl/psb_z_hybg_vect_mv.F90 new file mode 100644 index 000000000..f3b6695e2 --- /dev/null +++ b/gpu/impl/psb_z_hybg_vect_mv.F90 @@ -0,0 +1,127 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use elldev_mod + use psb_vectordev_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_hybg_vect_mv +#else + use psb_z_hybg_mat_mod +#endif + use psb_z_gpu_vect_mod + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + complex(psb_dpk_), allocatable :: rx(:), ry(:) + logical :: tra + character :: trans_ + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hybg_vect_mv' + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(trans)) then + trans_ = trans + else + trans_ = 'N' + end if + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') + + +#ifdef HAVE_SPGPU + if (tra) then + if (.not.x%is_host()) call x%sync() + if (beta /= zzero) then + if (.not.y%is_host()) call y%sync() + end if + call a%psb_z_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) + call y%set_host() + else + if (a%is_host()) call a%sync() + select type (xx => x) + type is (psb_z_vect_gpu) + select type(yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (beta /= zzero) then + if (yy%is_host()) call yy%sync() + end if + info = spmvHYBGDevice(a%deviceMat,alpha,xx%deviceVect,& + & beta,yy%deviceVect) + if (info /= 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='spmvHYBGDevice',i_err=(/info,izero,izero,izero,izero/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + call yy%set_dev() + class default + rx = xx%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + class default + rx = x%get_vect() + ry = y%get_vect() + call a%psb_z_csr_sparse_mat%spmm(alpha,rx,beta,ry,info) + call y%bld(ry) + end select + end if +#else + call a%psb_z_csr_sparse_mat%spmm(alpha,x,beta,y,info,trans) +#endif + if (info /= 0) goto 9999 + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_hybg_vect_mv +#endif diff --git a/gpu/impl/psb_z_mv_csrg_from_coo.F90 b/gpu/impl/psb_z_mv_csrg_from_coo.F90 new file mode 100644 index 000000000..21771b89e --- /dev/null +++ b/gpu/impl/psb_z_mv_csrg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_csrg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_mv_csrg_from_coo +#else + use psb_z_csrg_mat_mod +#endif + implicit none + + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + + info = psb_success_ + + call a%psb_z_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + if (info /= 0) goto 9999 + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_mv_csrg_from_coo diff --git a/gpu/impl/psb_z_mv_csrg_from_fmt.F90 b/gpu/impl/psb_z_mv_csrg_from_fmt.F90 new file mode 100644 index 000000000..314082146 --- /dev/null +++ b/gpu/impl/psb_z_mv_csrg_from_fmt.F90 @@ -0,0 +1,63 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_csrg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_csrg_mat_mod, psb_protect_name => psb_z_mv_csrg_from_fmt +#else + use psb_z_csrg_mat_mod +#endif + implicit none + + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer, intent(out) :: info + + !locals + + info = psb_success_ + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_z_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select + +end subroutine psb_z_mv_csrg_from_fmt diff --git a/gpu/impl/psb_z_mv_diag_from_coo.F90 b/gpu/impl/psb_z_mv_diag_from_coo.F90 new file mode 100644 index 000000000..8872c8907 --- /dev/null +++ b/gpu/impl/psb_z_mv_diag_from_coo.F90 @@ -0,0 +1,69 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_diag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use diagdev_mod + use psb_vectordev_mod + use psb_z_diag_mat_mod, psb_protect_name => psb_z_mv_diag_from_coo +#else + use psb_z_diag_mat_mod +#endif + + implicit none + + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) goto 9999 + + call a%cp_from_coo(b,info) + if (info /= 0) goto 9999 + + call b%free() + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_mv_diag_from_coo diff --git a/gpu/impl/psb_z_mv_elg_from_coo.F90 b/gpu/impl/psb_z_mv_elg_from_coo.F90 new file mode 100644 index 000000000..2d78edc6e --- /dev/null +++ b/gpu/impl/psb_z_mv_elg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_elg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_mv_elg_from_coo +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + if (b%is_dev()) call b%sync() + call a%cp_from_coo(b,info) + call b%free() + + return + + +end subroutine psb_z_mv_elg_from_coo diff --git a/gpu/impl/psb_z_mv_elg_from_fmt.F90 b/gpu/impl/psb_z_mv_elg_from_fmt.F90 new file mode 100644 index 000000000..3bf663b3d --- /dev/null +++ b/gpu/impl/psb_z_mv_elg_from_fmt.F90 @@ -0,0 +1,99 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_elg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use elldev_mod + use psb_vectordev_mod + use psb_z_elg_mat_mod, psb_protect_name => psb_z_mv_elg_from_fmt +#else + use psb_z_elg_mat_mod +#endif + implicit none + + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, ld, nzm, m +#ifdef HAVE_SPGPU + type(elldev_parms) :: gpu_parms +#endif + + info = psb_success_ + + if (b%is_dev()) call b%sync() + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + + class is (psb_z_ell_sparse_mat) + nzm = size(b%ja,2) + m = b%get_nrows() + nc = b%get_ncols() + nza = b%get_nzeros() +#ifdef HAVE_SPGPU + gpu_parms = FgetEllDeviceParams(m,nzm,nza,nc,spgpu_type_double,1) + ld = gpu_parms%pitch + nzm = gpu_parms%maxRowSize +#else + ld = m +#endif + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat + call move_alloc(b%irn, a%irn) + call move_alloc(b%idiag, a%idiag) + call psb_realloc(ld,nzm,a%ja,info) + if (info == 0) then + a%ja(1:m,1:nzm) = b%ja(1:m,1:nzm) + deallocate(b%ja,stat=info) + end if + if (info == 0) call psb_realloc(ld,nzm,a%val,info) + if (info == 0) then + a%val(1:m,1:nzm) = b%val(1:m,1:nzm) + deallocate(b%val,stat=info) + end if + a%nzt = nza + call b%free() +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_z_mv_elg_from_fmt diff --git a/gpu/impl/psb_z_mv_hdiag_from_coo.F90 b/gpu/impl/psb_z_mv_hdiag_from_coo.F90 new file mode 100644 index 000000000..e1df9cc41 --- /dev/null +++ b/gpu/impl/psb_z_mv_hdiag_from_coo.F90 @@ -0,0 +1,74 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_hdiag_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hdiagdev_mod + use psb_vectordev_mod + use psb_z_hdiag_mat_mod, psb_protect_name => psb_z_mv_hdiag_from_coo + use psb_gpu_env_mod +#else + use psb_z_hdiag_mat_mod +#endif + + implicit none + + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + + +#ifdef HAVE_SPGPU + a%hacksize = psb_gpu_WarpSize() +#endif + + call a%psb_z_hdia_sparse_mat%mv_from_coo(b,info) + +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_mv_hdiag_from_coo diff --git a/gpu/impl/psb_z_mv_hlg_from_coo.F90 b/gpu/impl/psb_z_mv_hlg_from_coo.F90 new file mode 100644 index 000000000..ce037be27 --- /dev/null +++ b/gpu/impl/psb_z_mv_hlg_from_coo.F90 @@ -0,0 +1,61 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_hlg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_gpu_env_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_mv_hlg_from_coo +#else + use psb_z_hlg_mat_mod +#endif + implicit none + + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + + info = psb_success_ + + if (.not.b%is_by_rows()) call b%fix(info) + if (info /= psb_success_) return + + call a%cp_from_coo(b,info) + call b%free() + + return + +end subroutine psb_z_mv_hlg_from_coo diff --git a/gpu/impl/psb_z_mv_hlg_from_fmt.F90 b/gpu/impl/psb_z_mv_hlg_from_fmt.F90 new file mode 100644 index 000000000..4ea1b385a --- /dev/null +++ b/gpu/impl/psb_z_mv_hlg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + + +subroutine psb_z_mv_hlg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use hlldev_mod + use psb_vectordev_mod + use psb_z_hlg_mat_mod, psb_protect_name => psb_z_mv_hlg_from_fmt +#else + use psb_z_hlg_mat_mod +#endif + implicit none + + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call b%mv_to_coo(tmp,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) + end select + +end subroutine psb_z_mv_hlg_from_fmt diff --git a/gpu/impl/psb_z_mv_hybg_from_coo.F90 b/gpu/impl/psb_z_mv_hybg_from_coo.F90 new file mode 100644 index 000000000..3424caea4 --- /dev/null +++ b/gpu/impl/psb_z_mv_hybg_from_coo.F90 @@ -0,0 +1,65 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_mv_hybg_from_coo(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_mv_hybg_from_coo +#else + use psb_z_hybg_mat_mod +#endif + implicit none + + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + call a%psb_z_csr_sparse_mat%mv_from_coo(b,info) + if (info /= 0) goto 9999 +#ifdef HAVE_SPGPU + call a%to_gpu(info) + if (info /= 0) goto 9999 +#endif + + return + +9999 continue + info = psb_err_alloc_dealloc_ + return + +end subroutine psb_z_mv_hybg_from_coo +#endif diff --git a/gpu/impl/psb_z_mv_hybg_from_fmt.F90 b/gpu/impl/psb_z_mv_hybg_from_fmt.F90 new file mode 100644 index 000000000..90c358977 --- /dev/null +++ b/gpu/impl/psb_z_mv_hybg_from_fmt.F90 @@ -0,0 +1,62 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! +#if CUDA_SHORT_VERSION <= 10 + +subroutine psb_z_mv_hybg_from_fmt(a,b,info) + + use psb_base_mod +#ifdef HAVE_SPGPU + use cusparse_mod + use psb_z_hybg_mat_mod, psb_protect_name => psb_z_mv_hybg_from_fmt +#else + use psb_z_hybg_mat_mod +#endif + implicit none + + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + info = psb_success_ + + select type(b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + class default + call a%psb_z_csr_sparse_mat%mv_from_fmt(b,info) + if (info /= 0) return +#ifdef HAVE_SPGPU + call a%to_gpu(info) +#endif + end select +end subroutine psb_z_mv_hybg_from_fmt +#endif diff --git a/gpu/ivectordev.c b/gpu/ivectordev.c new file mode 100644 index 000000000..936364655 --- /dev/null +++ b/gpu/ivectordev.c @@ -0,0 +1,182 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +//#include "utils.h" +//#include "common.h" +#include "ivectordev.h" + + +int registerMappedInt(void *buff, void **d_p, int n, int dummy) +{ + return registerMappedMemory(buff,d_p,n*sizeof(int)); +} + +int writeMultiVecDeviceInt(void* deviceVec, int* hostVec) +{ int i; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = writeRemoteBuffer((void*) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(int)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocMultiVecDevice",i); + } + + return(i); +} + +int writeMultiVecDeviceIntR2(void* deviceVec, int* hostVec, int ld) +{ int i; + i = writeMultiVecDeviceInt(deviceVec, (void *) hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeMultiVecDeviceIntR2",i); + } + return(i); +} + +int readMultiVecDeviceInt(void* deviceVec, int* hostVec) +{ int i,j; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = readRemoteBuffer((void *) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(int)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceInt",i); + } + return(i); +} + +int readMultiVecDeviceIntR2(void* deviceVec, int* hostVec, int ld) +{ int i; + i = readMultiVecDeviceInt(deviceVec, hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceIntR2",i); + } + return(i); +} + + +int setscalMultiVecDeviceInt(int val, int first, int last, + int indexBase, void* devMultiVecX) +{ int i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuIsetscal(handle, first, last, indexBase, val, (int *) devVecX->v_); + + return(i); +} + +int geinsMultiVecDeviceInt(int n, void* devMultiVecIrl, void* devMultiVecVal, + int dupl, int indexBase, void* devMultiVecX) +{ int j=0, i=0,nmin=0,nmax=0; + int pitch = 0; + int beta; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecIrl = (struct MultiVectDevice *) devMultiVecIrl; + struct MultiVectDevice *devVecVal = (struct MultiVectDevice *) devMultiVecVal; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecIrl->pitch_; + if ((n > devVecIrl->size_) || (n>devVecVal->size_ )) + return SPGPU_UNSUPPORTED; + + //fprintf(stderr,"geins: %d %d %p %p %p\n",dupl,n,devVecIrl->v_,devVecVal->v_,devVecX->v_); + + if (dupl == INS_OVERWRITE) + beta = 0; + else if (dupl == INS_ADD) + beta = 1; + else + beta = 0; + + spgpuIscat(handle, (int *) devVecX->v_, n, (int *)devVecVal->v_, + (int*)devVecIrl->v_, indexBase, beta); + + return(i); +} + + +int igathMultiVecDeviceIntVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + + i= igathMultiVecDeviceInt(deviceVec, vectorId, n, + first, (void*) devIdx->v_, hfirst, host_values, indexBase); + return(i); +} + +int igathMultiVecDeviceInt(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, int indexBase) +{ + int i, *idx =(int *) indexes;; + int *hv = (int *) host_values;; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + i=0; + hv = &(hv[hfirst-indexBase]); + idx = &(idx[first-indexBase]); + spgpuIgath(handle,hv, n, idx,indexBase, (int *) devVec->v_+vectorId*devVec->pitch_); + return(i); +} + +int iscatMultiVecDeviceIntVecIdx(void* deviceVec, int vectorId, int n, int first, void *deviceIdx, + int hfirst, void* host_values, int indexBase, int beta) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + i= iscatMultiVecDeviceInt(deviceVec, vectorId, n, first, + (void*) devIdx->v_, hfirst,host_values, indexBase, beta); + return(i); +} + +int iscatMultiVecDeviceInt(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, int beta) +{ int i=0; + int *hv = (int *) host_values; + int *idx=(int *) indexes; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + idx = &(idx[first-indexBase]); + hv = &(hv[hfirst-indexBase]); + spgpuIscat(handle, (int *) devVec->v_, n, hv, idx, indexBase, beta); + return SPGPU_SUCCESS; + +} + +#endif + diff --git a/gpu/ivectordev.h b/gpu/ivectordev.h new file mode 100644 index 000000000..5f7ca9741 --- /dev/null +++ b/gpu/ivectordev.h @@ -0,0 +1,64 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +int registerMappedInt(void *, void **, int, int); +int writeMultiVecDeviceInt(void* deviceMultiVec, int* hostMultiVec); +int writeMultiVecDeviceIntR2(void* deviceMultiVec, int* hostMultiVec, int ld); +int readMultiVecDeviceInt(void* deviceMultiVec, int* hostMultiVec); +int readMultiVecDeviceIntR2(void* deviceMultiVec, int* hostMultiVec, int ld); + +int setscalMultiVecDeviceInt(int val, int first, int last, + int indexBase, void* devVecX); + +int geinsMultiVecDeviceInt(int n, void* devVecIrl, void* devVecVal, + int dupl, int indexBase, void* devVecX); + +int igathMultiVecDeviceIntVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase); +int igathMultiVecDeviceInt(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, + int indexBase); +int iscatMultiVecDeviceIntVecIdx(void* deviceVec, int vectorId, int n, int first, + void *deviceIdx, int hfirst, void* host_values, + int indexBase, int beta); +int iscatMultiVecDeviceInt(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, int beta); + +#endif diff --git a/gpu/psb_base_vectordev_mod.F90 b/gpu/psb_base_vectordev_mod.F90 new file mode 100644 index 000000000..f8c303d0e --- /dev/null +++ b/gpu/psb_base_vectordev_mod.F90 @@ -0,0 +1,104 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_base_vectordev_mod + use iso_c_binding + use core_mod + + type, bind(c) :: multivec_dev_parms + integer(c_int) :: count + integer(c_int) :: element_type + integer(c_int) :: pitch + integer(c_int) :: size + end type multivec_dev_parms + +#ifdef HAVE_SPGPU + + + interface + function FallocMultiVecDevice(deviceVec,count,Size,elementType) & + & result(res) bind(c,name='FallocMultiVecDevice') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: count,Size,elementType + type(c_ptr) :: deviceVec + end function FallocMultiVecDevice + end interface + + + interface + subroutine unregisterMapped(buf) & + & bind(c,name='unregisterMapped') + use iso_c_binding + type(c_ptr), value :: buf + end subroutine unregisterMapped + end interface + + interface + subroutine freeMultiVecDevice(deviceVec) & + & bind(c,name='freeMultiVecDevice') + use iso_c_binding + type(c_ptr), value :: deviceVec + end subroutine freeMultiVecDevice + end interface + + interface + function getMultiVecDeviceSize(deviceVec) & + & bind(c,name='getMultiVecDeviceSize') result(res) + use iso_c_binding + type(c_ptr), value :: deviceVec + integer(c_int) :: res + end function getMultiVecDeviceSize + end interface + + interface + function getMultiVecDeviceCount(deviceVec) & + & bind(c,name='getMultiVecDeviceCount') result(res) + use iso_c_binding + type(c_ptr), value :: deviceVec + integer(c_int) :: res + end function getMultiVecDeviceCount + end interface + + interface + function getMultiVecDevicePitch(deviceVec) & + & bind(c,name='getMultiVecDevicePitch') result(res) + use iso_c_binding + type(c_ptr), value :: deviceVec + integer(c_int) :: res + end function getMultiVecDevicePitch + end interface + +#endif + + +end module psb_base_vectordev_mod diff --git a/gpu/psb_c_csrg_mat_mod.F90 b/gpu/psb_c_csrg_mat_mod.F90 new file mode 100644 index 000000000..203a6dbfc --- /dev/null +++ b/gpu/psb_c_csrg_mat_mod.F90 @@ -0,0 +1,393 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_csrg_mat_mod + + use iso_c_binding + use psb_c_mat_mod + use cusparse_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_c_csr_sparse_mat) :: psb_c_csrg_sparse_mat + ! + ! cuSPARSE 4.0 CSR format. + ! + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(c_Cmat) :: deviceMat + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => c_csrg_get_fmt + procedure, pass(a) :: sizeof => c_csrg_sizeof + procedure, pass(a) :: vect_mv => psb_c_csrg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_c_csrg_inner_vect_sv + procedure, pass(a) :: csmm => psb_c_csrg_csmm + procedure, pass(a) :: csmv => psb_c_csrg_csmv + procedure, pass(a) :: scals => psb_c_csrg_scals + procedure, pass(a) :: scalv => psb_c_csrg_scal + procedure, pass(a) :: reallocate_nz => psb_c_csrg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_csrg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_csrg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_c_cp_csrg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_csrg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_c_mv_csrg_from_fmt + procedure, pass(a) :: free => c_csrg_free + procedure, pass(a) :: mold => psb_c_csrg_mold + procedure, pass(a) :: is_host => c_csrg_is_host + procedure, pass(a) :: is_dev => c_csrg_is_dev + procedure, pass(a) :: is_sync => c_csrg_is_sync + procedure, pass(a) :: set_host => c_csrg_set_host + procedure, pass(a) :: set_dev => c_csrg_set_dev + procedure, pass(a) :: set_sync => c_csrg_set_sync + procedure, pass(a) :: sync => c_csrg_sync + procedure, pass(a) :: to_gpu => psb_c_csrg_to_gpu + procedure, pass(a) :: from_gpu => psb_c_csrg_from_gpu + final :: c_csrg_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_csrg_mold +#endif + end type psb_c_csrg_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_csrg_get_nzeros, c_csrg_free, c_csrg_get_fmt, & + & c_csrg_get_size, c_csrg_sizeof, c_csrg_get_nz_row + + + interface + subroutine psb_c_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_csrg_inner_vect_sv + end interface + + + interface + subroutine psb_c_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_csrg_vect_mv + end interface + + interface + subroutine psb_c_csrg_reallocate_nz(nz,a) + import :: psb_c_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_csrg_sparse_mat), intent(inout) :: a + end subroutine psb_c_csrg_reallocate_nz + end interface + + interface + subroutine psb_c_csrg_allocate_mnnz(m,n,a,nz) + import :: psb_c_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_csrg_allocate_mnnz + end interface + + interface + subroutine psb_c_csrg_mold(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_csrg_mold + end interface + + interface + subroutine psb_c_csrg_to_gpu(a,info, nzrm) + import :: psb_c_csrg_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_c_csrg_to_gpu + end interface + + interface + subroutine psb_c_csrg_from_gpu(a,info) + import :: psb_c_csrg_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_csrg_from_gpu + end interface + + interface + subroutine psb_c_cp_csrg_from_coo(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_csrg_from_coo + end interface + + interface + subroutine psb_c_cp_csrg_from_fmt(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_csrg_from_fmt + end interface + + interface + subroutine psb_c_mv_csrg_from_coo(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_csrg_from_coo + end interface + + interface + subroutine psb_c_mv_csrg_from_fmt(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_csrg_from_fmt + end interface + + interface + subroutine psb_c_csrg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_csrg_csmv + end interface + interface + subroutine psb_c_csrg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_csrg_csmm + end interface + + interface + subroutine psb_c_csrg_scal(d,a,info,side) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_c_csrg_scal + end interface + + interface + subroutine psb_c_csrg_scals(d,a,info) + import :: psb_c_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_csrg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_csrg_sizeof(a) result(res) + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function c_csrg_sizeof + + function c_csrg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'CSRG' + end function c_csrg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + + subroutine c_csrg_set_host(a) + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine c_csrg_set_host + + subroutine c_csrg_set_dev(a) + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine c_csrg_set_dev + + subroutine c_csrg_set_sync(a) + implicit none + class(psb_c_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine c_csrg_set_sync + + function c_csrg_is_dev(a) result(res) + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function c_csrg_is_dev + + function c_csrg_is_host(a) result(res) + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function c_csrg_is_host + + function c_csrg_is_sync(a) result(res) + implicit none + class(psb_c_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function c_csrg_is_sync + + + subroutine c_csrg_sync(a) + implicit none + class(psb_c_csrg_sparse_mat), target, intent(in) :: a + class(psb_c_csrg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine c_csrg_sync + + subroutine c_csrg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_c_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + call a%psb_c_csr_sparse_mat%free() + + return + + end subroutine c_csrg_free + + subroutine c_csrg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + type(psb_c_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + + return + + end subroutine c_csrg_finalize + +#else + interface + subroutine psb_c_csrg_mold(a,b,info) + import :: psb_c_csrg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_csrg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_csrg_mold + end interface + +#endif + +end module psb_c_csrg_mat_mod diff --git a/gpu/psb_c_diag_mat_mod.F90 b/gpu/psb_c_diag_mat_mod.F90 new file mode 100644 index 000000000..a7ab2fbb3 --- /dev/null +++ b/gpu/psb_c_diag_mat_mod.F90 @@ -0,0 +1,308 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_diag_mat_mod + + use iso_c_binding + use psb_base_mod + use psb_c_dia_mat_mod + + type, extends(psb_c_dia_sparse_mat) :: psb_c_diag_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => c_diag_get_fmt + procedure, pass(a) :: sizeof => c_diag_sizeof + procedure, pass(a) :: vect_mv => psb_c_diag_vect_mv +! procedure, pass(a) :: csmm => psb_c_diag_csmm + procedure, pass(a) :: csmv => psb_c_diag_csmv +! procedure, pass(a) :: in_vect_sv => psb_c_diag_inner_vect_sv +! procedure, pass(a) :: scals => psb_c_diag_scals +! procedure, pass(a) :: scalv => psb_c_diag_scal +! procedure, pass(a) :: reallocate_nz => psb_c_diag_reallocate_nz +! procedure, pass(a) :: allocate_mnnz => psb_c_diag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_diag_from_coo +! procedure, pass(a) :: cp_from_fmt => psb_c_cp_diag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_diag_from_coo +! procedure, pass(a) :: mv_from_fmt => psb_c_mv_diag_from_fmt + procedure, pass(a) :: free => c_diag_free + procedure, pass(a) :: mold => psb_c_diag_mold + procedure, pass(a) :: to_gpu => psb_c_diag_to_gpu + final :: c_diag_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_diag_mold +#endif + end type psb_c_diag_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_diag_get_nzeros, c_diag_free, c_diag_get_fmt, & + & c_diag_get_size, c_diag_sizeof, c_diag_get_nz_row + + + interface + subroutine psb_c_diag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_diag_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_diag_vect_mv + end interface + + interface + subroutine psb_c_diag_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_c_diag_sparse_mat, psb_spk_, psb_c_base_vect_type + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_diag_inner_vect_sv + end interface + + interface + subroutine psb_c_diag_reallocate_nz(nz,a) + import :: psb_c_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_diag_sparse_mat), intent(inout) :: a + end subroutine psb_c_diag_reallocate_nz + end interface + + interface + subroutine psb_c_diag_allocate_mnnz(m,n,a,nz) + import :: psb_c_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_diag_allocate_mnnz + end interface + + interface + subroutine psb_c_diag_mold(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_diag_mold + end interface + + interface + subroutine psb_c_diag_to_gpu(a,info, nzrm) + import :: psb_c_diag_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_c_diag_to_gpu + end interface + + interface + subroutine psb_c_cp_diag_from_coo(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_diag_from_coo + end interface + + interface + subroutine psb_c_cp_diag_from_fmt(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_diag_from_fmt + end interface + + interface + subroutine psb_c_mv_diag_from_coo(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_diag_from_coo + end interface + + + interface + subroutine psb_c_mv_diag_from_fmt(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_diag_from_fmt + end interface + + interface + subroutine psb_c_diag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_diag_csmv + end interface + interface + subroutine psb_c_diag_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_diag_csmm + end interface + + interface + subroutine psb_c_diag_scal(d,a,info, side) + import :: psb_c_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_c_diag_scal + end interface + + interface + subroutine psb_c_diag_scals(d,a,info) + import :: psb_c_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_diag_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_diag_sizeof(a) result(res) + implicit none + class(psb_c_diag_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function c_diag_sizeof + + function c_diag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIAG' + end function c_diag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_diag_free(a) + use diagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_c_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_dia_sparse_mat%free() + + return + + end subroutine c_diag_free + + subroutine c_diag_finalize(a) + use diagdev_mod + implicit none + type(psb_c_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine c_diag_finalize + +#else + + interface + subroutine psb_c_diag_mold(a,b,info) + import :: psb_c_diag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_diag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_diag_mold + end interface + +#endif + +end module psb_c_diag_mat_mod diff --git a/gpu/psb_c_dnsg_mat_mod.F90 b/gpu/psb_c_dnsg_mat_mod.F90 new file mode 100644 index 000000000..7fe5fddaf --- /dev/null +++ b/gpu/psb_c_dnsg_mat_mod.F90 @@ -0,0 +1,294 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_dnsg_mat_mod + + use iso_c_binding + use psb_c_mat_mod + use psb_c_dns_mat_mod + use dnsdev_mod + + type, extends(psb_c_dns_sparse_mat) :: psb_c_dnsg_sparse_mat + ! + ! ITPACK/DNS format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of DNS, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => c_dnsg_get_fmt + ! procedure, pass(a) :: sizeof => c_dnsg_sizeof + procedure, pass(a) :: vect_mv => psb_c_dnsg_vect_mv +!!$ procedure, pass(a) :: csmm => psb_c_dnsg_csmm +!!$ procedure, pass(a) :: csmv => psb_c_dnsg_csmv +!!$ procedure, pass(a) :: in_vect_sv => psb_c_dnsg_inner_vect_sv +!!$ procedure, pass(a) :: scals => psb_c_dnsg_scals +!!$ procedure, pass(a) :: scalv => psb_c_dnsg_scal +!!$ procedure, pass(a) :: reallocate_nz => psb_c_dnsg_reallocate_nz +!!$ procedure, pass(a) :: allocate_mnnz => psb_c_dnsg_allocate_mnnz + ! Note: we *do* need the TO methods, because of the need to invoke SYNC + ! + procedure, pass(a) :: cp_from_coo => psb_c_cp_dnsg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_c_cp_dnsg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_dnsg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_c_mv_dnsg_from_fmt + procedure, pass(a) :: free => c_dnsg_free + procedure, pass(a) :: mold => psb_c_dnsg_mold + procedure, pass(a) :: to_gpu => psb_c_dnsg_to_gpu + final :: c_dnsg_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_dnsg_mold +#endif + end type psb_c_dnsg_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_dnsg_get_nzeros, c_dnsg_free, c_dnsg_get_fmt, & + & c_dnsg_get_size, c_dnsg_get_nz_row + + + interface + subroutine psb_c_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_dnsg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_dnsg_vect_mv + end interface +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_c_dnsg_sparse_mat, psb_spk_, psb_c_base_vect_type +!!$ class(psb_c_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_c_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_c_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_c_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_c_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_c_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_c_dnsg_allocate_mnnz +!!$ end interface + + interface + subroutine psb_c_dnsg_mold(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dnsg_mold + end interface + + interface + subroutine psb_c_dnsg_to_gpu(a,info) + import :: psb_c_dnsg_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dnsg_to_gpu + end interface + + interface + subroutine psb_c_cp_dnsg_from_coo(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dnsg_from_coo + end interface + + interface + subroutine psb_c_cp_dnsg_from_fmt(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dnsg_from_fmt + end interface + + interface + subroutine psb_c_mv_dnsg_from_coo(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dnsg_from_coo + end interface + + + interface + subroutine psb_c_mv_dnsg_from_fmt(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dnsg_from_fmt + end interface + +!!$ interface +!!$ subroutine psb_c_dnsg_csmv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta, x(:) +!!$ complex(psb_spk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_dnsg_csmv +!!$ end interface +!!$ interface +!!$ subroutine psb_c_dnsg_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_dnsg_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_scal(d,a,info, side) +!!$ import :: psb_c_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_c_dnsg_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_dnsg_scals(d,a,info) +!!$ import :: psb_c_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_dnsg_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_dnsg_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + + function c_dnsg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNSG' + end function c_dnsg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_dnsg_free(a) + use dnsdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_c_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_dns_sparse_mat%free() + + return + + end subroutine c_dnsg_free + + subroutine c_dnsg_finalize(a) + use dnsdev_mod + implicit none + type(psb_c_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine c_dnsg_finalize + +#else + + interface + subroutine psb_c_dnsg_mold(a,b,info) + import :: psb_c_dnsg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dnsg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dnsg_mold + end interface + +#endif + +end module psb_c_dnsg_mat_mod diff --git a/gpu/psb_c_elg_mat_mod.F90 b/gpu/psb_c_elg_mat_mod.F90 new file mode 100644 index 000000000..83355b9d4 --- /dev/null +++ b/gpu/psb_c_elg_mat_mod.F90 @@ -0,0 +1,483 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_elg_mat_mod + + use iso_c_binding + use psb_c_mat_mod + use psb_c_ell_mat_mod + use psb_i_gpu_vect_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_c_ell_sparse_mat) :: psb_c_elg_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of ELL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => c_elg_get_fmt + procedure, pass(a) :: sizeof => c_elg_sizeof + procedure, pass(a) :: vect_mv => psb_c_elg_vect_mv + procedure, pass(a) :: csmm => psb_c_elg_csmm + procedure, pass(a) :: csmv => psb_c_elg_csmv + procedure, pass(a) :: in_vect_sv => psb_c_elg_inner_vect_sv + procedure, pass(a) :: scals => psb_c_elg_scals + procedure, pass(a) :: scalv => psb_c_elg_scal + procedure, pass(a) :: reallocate_nz => psb_c_elg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_elg_allocate_mnnz + procedure, pass(a) :: reinit => c_elg_reinit + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_elg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_c_cp_elg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_elg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_c_mv_elg_from_fmt + procedure, pass(a) :: free => c_elg_free + procedure, pass(a) :: mold => psb_c_elg_mold + procedure, pass(a) :: csput_a => psb_c_elg_csput_a + procedure, pass(a) :: csput_v => psb_c_elg_csput_v + procedure, pass(a) :: is_host => c_elg_is_host + procedure, pass(a) :: is_dev => c_elg_is_dev + procedure, pass(a) :: is_sync => c_elg_is_sync + procedure, pass(a) :: set_host => c_elg_set_host + procedure, pass(a) :: set_dev => c_elg_set_dev + procedure, pass(a) :: set_sync => c_elg_set_sync + procedure, pass(a) :: sync => c_elg_sync + procedure, pass(a) :: from_gpu => psb_c_elg_from_gpu + procedure, pass(a) :: to_gpu => psb_c_elg_to_gpu + procedure, pass(a) :: asb => psb_c_elg_asb + final :: c_elg_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_elg_mold + procedure, pass(a) :: asb => psb_c_elg_asb +#endif + end type psb_c_elg_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_elg_get_nzeros, c_elg_free, c_elg_get_fmt, & + & c_elg_get_size, c_elg_sizeof, c_elg_get_nz_row, c_elg_sync + + + interface + subroutine psb_c_elg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_elg_vect_mv + end interface + + interface + subroutine psb_c_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_c_elg_sparse_mat, psb_spk_, psb_c_base_vect_type + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_elg_inner_vect_sv + end interface + + interface + subroutine psb_c_elg_reallocate_nz(nz,a) + import :: psb_c_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_elg_sparse_mat), intent(inout) :: a + end subroutine psb_c_elg_reallocate_nz + end interface + + interface + subroutine psb_c_elg_allocate_mnnz(m,n,a,nz) + import :: psb_c_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_elg_allocate_mnnz + end interface + + interface + subroutine psb_c_elg_mold(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_mold + end interface + + interface + subroutine psb_c_elg_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_csput_a + end interface + + interface + subroutine psb_c_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_c_elg_sparse_mat, psb_dpk_, psb_ipk_, psb_c_base_vect_type,& + & psb_i_base_vect_type + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_csput_v + end interface + + interface + subroutine psb_c_elg_from_gpu(a,info) + import :: psb_c_elg_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_from_gpu + end interface + + interface + subroutine psb_c_elg_to_gpu(a,info, nzrm) + import :: psb_c_elg_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_c_elg_to_gpu + end interface + + interface + subroutine psb_c_cp_elg_from_coo(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_elg_from_coo + end interface + + interface + subroutine psb_c_cp_elg_from_fmt(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_elg_from_fmt + end interface + + interface + subroutine psb_c_mv_elg_from_coo(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_elg_from_coo + end interface + + + interface + subroutine psb_c_mv_elg_from_fmt(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_elg_from_fmt + end interface + + interface + subroutine psb_c_elg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_elg_csmv + end interface + interface + subroutine psb_c_elg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_elg_csmm + end interface + + interface + subroutine psb_c_elg_scal(d,a,info, side) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_c_elg_scal + end interface + + interface + subroutine psb_c_elg_scals(d,a,info) + import :: psb_c_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_scals + end interface + + interface + subroutine psb_c_elg_asb(a) + import :: psb_c_elg_sparse_mat + class(psb_c_elg_sparse_mat), intent(inout) :: a + end subroutine psb_c_elg_asb + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_elg_sizeof(a) result(res) + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function c_elg_sizeof + + function c_elg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELG' + end function c_elg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + subroutine c_elg_reinit(a,clear) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_c_elg_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + integer(psb_ipk_) :: isz, err_act + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + if (a%is_bld() .or. a%is_upd()) then + ! do nothing + return + else if (a%is_asb()) then + if (a%is_dev().or.a%is_sync()) then + if (clear_) call zeroEllDevice(a%deviceMat) + call a%set_dev() + else if (a%is_host()) then + a%val(:,:) = czero + end if + call a%set_upd() + else + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine c_elg_reinit + + subroutine c_elg_free(a) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_c_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_ell_sparse_mat%free() + call a%set_sync() + + return + + end subroutine c_elg_free + + subroutine c_elg_sync(a) + implicit none + class(psb_c_elg_sparse_mat), target, intent(in) :: a + class(psb_c_elg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine c_elg_sync + + subroutine c_elg_set_host(a) + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine c_elg_set_host + + subroutine c_elg_set_dev(a) + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine c_elg_set_dev + + subroutine c_elg_set_sync(a) + implicit none + class(psb_c_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine c_elg_set_sync + + function c_elg_is_dev(a) result(res) + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function c_elg_is_dev + + function c_elg_is_host(a) result(res) + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function c_elg_is_host + + function c_elg_is_sync(a) result(res) + implicit none + class(psb_c_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function c_elg_is_sync + + subroutine c_elg_finalize(a) + use elldev_mod + implicit none + type(psb_c_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + return + + end subroutine c_elg_finalize + +#else + + interface + subroutine psb_c_elg_asb(a) + import :: psb_c_elg_sparse_mat + class(psb_c_elg_sparse_mat), intent(inout) :: a + end subroutine psb_c_elg_asb + end interface + + interface + subroutine psb_c_elg_mold(a,b,info) + import :: psb_c_elg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_elg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_elg_mold + end interface + +#endif + +end module psb_c_elg_mat_mod diff --git a/gpu/psb_c_gpu_vect_mod.F90 b/gpu/psb_c_gpu_vect_mod.F90 new file mode 100644 index 000000000..4c31154fc --- /dev/null +++ b/gpu/psb_c_gpu_vect_mod.F90 @@ -0,0 +1,1989 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_gpu_vect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_c_vect_mod + use psb_i_vect_mod +#ifdef HAVE_SPGPU + use psb_gpu_env_mod + use psb_i_gpu_vect_mod + use psb_i_vectordev_mod + use psb_c_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_c_base_vect_type) :: psb_c_vect_gpu +#ifdef HAVE_SPGPU + integer :: state = is_host + type(c_ptr) :: deviceVect = c_null_ptr + complex(c_float_complex), allocatable :: pinned_buffer(:) + type(c_ptr) :: dt_p_buf = c_null_ptr + complex(c_float_complex), allocatable :: buffer(:) + type(c_ptr) :: dt_buf = c_null_ptr + integer :: dt_buf_sz = 0 + type(c_ptr) :: i_buf = c_null_ptr + integer :: i_buf_sz = 0 + contains + procedure, pass(x) :: get_nrows => c_gpu_get_nrows + procedure, nopass :: get_fmt => c_gpu_get_fmt + + procedure, pass(x) :: all => c_gpu_all + procedure, pass(x) :: zero => c_gpu_zero + procedure, pass(x) :: asb_m => c_gpu_asb_m + procedure, pass(x) :: sync => c_gpu_sync + procedure, pass(x) :: sync_space => c_gpu_sync_space + procedure, pass(x) :: bld_x => c_gpu_bld_x + procedure, pass(x) :: bld_mn => c_gpu_bld_mn + procedure, pass(x) :: free => c_gpu_free + procedure, pass(x) :: ins_a => c_gpu_ins_a + procedure, pass(x) :: ins_v => c_gpu_ins_v + procedure, pass(x) :: is_host => c_gpu_is_host + procedure, pass(x) :: is_dev => c_gpu_is_dev + procedure, pass(x) :: is_sync => c_gpu_is_sync + procedure, pass(x) :: set_host => c_gpu_set_host + procedure, pass(x) :: set_dev => c_gpu_set_dev + procedure, pass(x) :: set_sync => c_gpu_set_sync + procedure, pass(x) :: set_scal => c_gpu_set_scal +!!$ procedure, pass(x) :: set_vect => c_gpu_set_vect + procedure, pass(x) :: gthzv_x => c_gpu_gthzv_x + procedure, pass(y) :: sctb => c_gpu_sctb + procedure, pass(y) :: sctb_x => c_gpu_sctb_x + procedure, pass(x) :: gthzbuf => c_gpu_gthzbuf + procedure, pass(y) :: sctb_buf => c_gpu_sctb_buf + procedure, pass(x) :: new_buffer => c_gpu_new_buffer + procedure, nopass :: device_wait => c_gpu_device_wait + procedure, pass(x) :: free_buffer => c_gpu_free_buffer + procedure, pass(x) :: maybe_free_buffer => c_gpu_maybe_free_buffer + procedure, pass(x) :: dot_v => c_gpu_dot_v + procedure, pass(x) :: dot_a => c_gpu_dot_a + procedure, pass(y) :: axpby_v => c_gpu_axpby_v + procedure, pass(y) :: axpby_a => c_gpu_axpby_a + procedure, pass(y) :: mlt_v => c_gpu_mlt_v + procedure, pass(y) :: mlt_a => c_gpu_mlt_a + procedure, pass(z) :: mlt_a_2 => c_gpu_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => c_gpu_mlt_v_2 + procedure, pass(x) :: scal => c_gpu_scal + procedure, pass(x) :: nrm2 => c_gpu_nrm2 + procedure, pass(x) :: amax => c_gpu_amax + procedure, pass(x) :: asum => c_gpu_asum + procedure, pass(x) :: absval1 => c_gpu_absval1 + procedure, pass(x) :: absval2 => c_gpu_absval2 + + final :: c_gpu_vect_finalize +#endif + end type psb_c_vect_gpu + + public :: psb_c_vect_gpu_ + private :: constructor + interface psb_c_vect_gpu_ + module procedure constructor + end interface psb_c_vect_gpu_ + +contains + + function constructor(x) result(this) + complex(psb_spk_) :: x(:) + type(psb_c_vect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x),info) + + end function constructor + +#ifdef HAVE_SPGPU + + subroutine c_gpu_device_wait() + call psb_cudaSync() + end subroutine c_gpu_device_wait + + subroutine c_gpu_new_buffer(n,x,info) + use psb_realloc_mod + use psb_gpu_env_mod + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + integer(psb_ipk_), intent(out) :: info + + + if (psb_gpu_DeviceHasUVA()) then + if (allocated(x%combuf)) then + if (size(x%combuf) idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + ! + ! Only need a sync in this branch; in the others + ! cudamemCpy acts as a sync point. + ! + if (allocated(x%pinned_buffer)) then + if (size(x%pinned_buffer) < n) then + call inner_unregister(x%pinned_buffer) + deallocate(x%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(x%pinned_buffer)) then + allocate(x%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(x%pinned_buffer,x%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + info = igathMultiVecDeviceFloatComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_p_buf, 1) + call psb_cudaSync() + y(1:n) = x%pinned_buffer(1:n) + + else + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeFloatComplex(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateFloatComplex(x%dt_buf,n) + x%dt_buf_sz=n + end if + if (info == 0) & + & info = igathMultiVecDeviceFloatComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_buf, 1) + if (info == 0) & + & info = readFloatComplex(x%dt_buf,y,n) + + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + + if (x%i_buf_sz < ni) then + if (c_associated(x%i_buf)) then + call freeInt(x%i_buf) + x%i_buf = c_null_ptr + end if + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeFloatComplex(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateFloatComplex(x%dt_buf,n) + x%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(x%i_buf,ii%v,ni) + if (info == 0) & + & info = igathMultiVecDeviceFloatComplex(x%deviceVect,& + & 0, n, i, x%i_buf, 1, x%dt_buf, 1) + if (info == 0) & + & info = readFloatComplex(x%dt_buf,y,n) + + end select + + end subroutine c_gpu_gthzv_x + + subroutine c_gpu_gthzbuf(i,n,idx,x) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i,n + class(psb_i_base_vect_type) :: idx + class(psb_c_vect_gpu) :: x + integer :: info, ni + + info = 0 +!!$ write(0,*) 'Starting gth_zbuf' + if (.not.allocated(x%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'gthzbuf') + return + end if + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + info = igathMultiVecDeviceFloatComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_p_buf, 1) + + else + info = igathMultiVecDeviceFloatComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_buf, 1) + if (info == 0) & + & info = readFloatComplex(i,x%dt_buf,x%combuf(i:),n,1) + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + info = 0 + if (.not.c_associated(x%i_buf)) then + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,x%i_buf,ii%v(i:),n,1) + + if (info == 0) & + & info = igathMultiVecDeviceFloatComplex(x%deviceVect,& + & 0, n, i, x%i_buf, i,x%dt_buf, 1) + + if (info == 0) & + & info = readFloatComplex(i,x%dt_buf,x%combuf(i:),n,1) + + end select + + end subroutine c_gpu_gthzbuf + + subroutine c_gpu_sctb(n,idx,x,beta,y) + implicit none + !use psb_const_mod + integer(psb_ipk_) :: n, idx(:) + complex(psb_spk_) :: beta, x(:) + class(psb_c_vect_gpu) :: y + integer(psb_ipk_) :: info + + if (n == 0) return + + if (y%is_dev()) call y%sync() + + call y%psb_c_base_vect_type%sctb(n,idx,x,beta) + call y%set_host() + + end subroutine c_gpu_sctb + + subroutine c_gpu_sctb_x(i,n,idx,x,beta,y) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + complex(psb_spk_) :: beta, x(:) + class(psb_c_vect_gpu) :: y + integer :: info, ni + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + + ! + if (psb_gpu_DeviceHasUVA()) then + if (allocated(y%pinned_buffer)) then + if (size(y%pinned_buffer) < n) then + call inner_unregister(y%pinned_buffer) + deallocate(y%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(y%pinned_buffer)) then + allocate(y%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(y%pinned_buffer,y%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + y%pinned_buffer(1:n) = x(1:n) + info = iscatMultiVecDeviceFloatComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_p_buf, 1,beta) + else + + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeFloatComplex(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateFloatComplex(y%dt_buf,n) + y%dt_buf_sz=n + end if + info = writeFloatComplex(y%dt_buf,x,n) + info = iscatMultiVecDeviceFloatComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_buf, 1,beta) + + end if + + class default + ni = size(ii%v) + + if (y%i_buf_sz < ni) then + if (c_associated(y%i_buf)) then + call freeInt(y%i_buf) + y%i_buf = c_null_ptr + end if + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeFloatComplex(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateFloatComplex(y%dt_buf,n) + y%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(y%i_buf,ii%v(i:i+n-1),n) + info = writeFloatComplex(y%dt_buf,x,n) + info = iscatMultiVecDeviceFloatComplex(y%deviceVect,& + & 0, n, 1, y%i_buf, 1, y%dt_buf, 1,beta) + + + end select + ! + ! Need a sync here to make sure we are not reallocating + ! the buffers before iscatMulti has finished. + ! + call psb_cudaSync() + call y%set_dev() + + end subroutine c_gpu_sctb_x + + subroutine c_gpu_sctb_buf(i,n,idx,beta,y) + use psi_serial_mod + use psb_gpu_env_mod + implicit none + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + complex(psb_spk_) :: beta + class(psb_c_vect_gpu) :: y + integer(psb_ipk_) :: info, ni + +!!$ write(0,*) 'Starting sctb_buf' + if (.not.allocated(y%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'sctb_buf') + return + end if + + + select type(ii=> idx) + class is (psb_i_vect_gpu) + + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + if (psb_gpu_DeviceHasUVA()) then + info = iscatMultiVecDeviceFloatComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_p_buf, 1,beta) + else + info = writeFloatComplex(i,y%dt_buf,y%combuf(i:),n,1) + info = iscatMultiVecDeviceFloatComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_buf, 1,beta) + + end if + + class default + !call y%sct(n,ii%v(i:),x,beta) + ni = size(ii%v) + info = 0 + if (.not.c_associated(y%i_buf)) then + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,y%i_buf,ii%v(i:),n,1) + if (info == 0) & + & info = writeFloatComplex(i,y%dt_buf,y%combuf(i:),n,1) + if (info == 0) info = iscatMultiVecDeviceFloatComplex(y%deviceVect,& + & 0, n, i, y%i_buf, i, y%dt_buf, 1,beta) + end select +!!$ write(0,*) 'Done sctb_buf' + + end subroutine c_gpu_sctb_buf + + + subroutine c_gpu_bld_x(x,this) + use psb_base_mod + complex(psb_spk_), intent(in) :: this(:) + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'c_gpu_bld_x',& + & i_err=(/size(this),izero,izero,izero,izero/)) + end if + x%v(:) = this(:) + call x%set_host() + call x%sync() + + end subroutine c_gpu_bld_x + + subroutine c_gpu_bld_mn(x,n) + integer(psb_mpk_), intent(in) :: n + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(n,info) + if (info /= 0) then + call psb_errpush(info,'c_gpu_bld_n',i_err=(/n,n,n,n,n/)) + end if + + end subroutine c_gpu_bld_mn + + subroutine c_gpu_set_host(x) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine c_gpu_set_host + + subroutine c_gpu_set_dev(x) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine c_gpu_set_dev + + subroutine c_gpu_set_sync(x) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine c_gpu_set_sync + + function c_gpu_is_dev(x) result(res) + implicit none + class(psb_c_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function c_gpu_is_dev + + function c_gpu_is_host(x) result(res) + implicit none + class(psb_c_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function c_gpu_is_host + + function c_gpu_is_sync(x) result(res) + implicit none + class(psb_c_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function c_gpu_is_sync + + + function c_gpu_get_nrows(x) result(res) + implicit none + class(psb_c_vect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = 0 + if (allocated(x%v)) res = size(x%v) + end function c_gpu_get_nrows + + function c_gpu_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'cGPU' + end function c_gpu_get_fmt + + subroutine c_gpu_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: n + class(psb_c_vect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(n,x%v,info) + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'c_gpu_all',& + & i_err=(/n,n,n,n,n/)) + end if + end subroutine c_gpu_all + + subroutine c_gpu_zero(x) + use psi_serial_mod + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=czero + call x%set_host() + end subroutine c_gpu_zero + + subroutine c_gpu_asb_m(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_mpk_), intent(in) :: n + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: nd + + if (x%is_dev()) then + nd = getMultiVecDeviceSize(x%deviceVect) + if (nd < n) then + call x%sync() + call x%psb_c_base_vect_type%asb(n,info) + if (info == psb_success_) call x%sync_space(info) + call x%set_host() + end if + else ! + if (x%get_nrows() size(x%v)).or.(n > x%get_nrows())) then +!!$ write(0,*) 'Incoherent situation : sizes',n,size(x%v),x%get_nrows() + call psb_realloc(n,x%v,info) + end if + info = readMultiVecDevice(x%deviceVect,x%v) + end if + if (info == 0) call x%set_sync() + if (info /= 0) then + info=psb_err_internal_error_ + call psb_errpush(info,'c_gpu_sync') + end if + + end subroutine c_gpu_sync + + subroutine c_gpu_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (c_associated(x%deviceVect)) then +!!$ write(0,*)'d_gpu_free Calling freeMultiVecDevice' + call freeMultiVecDevice(x%deviceVect) + x%deviceVect=c_null_ptr + end if + call x%free_buffer(info) + call x%set_sync() + end subroutine c_gpu_free + + subroutine c_gpu_set_scal(x,val,first,last) + class(psb_c_vect_gpu), intent(inout) :: x + complex(psb_spk_), intent(in) :: val + integer(psb_ipk_), optional :: first, last + + integer(psb_ipk_) :: info, first_, last_ + + first_ = 1 + last_ = x%get_nrows() + if (present(first)) first_ = max(1,first) + if (present(last)) last_ = min(last,last_) + + if (x%is_host()) call x%sync() + info = setScalDevice(val,first_,last_,1,x%deviceVect) + call x%set_dev() + + end subroutine c_gpu_set_scal +!!$ +!!$ subroutine c_gpu_set_vect(x,val) +!!$ class(psb_c_vect_gpu), intent(inout) :: x +!!$ complex(psb_spk_), intent(in) :: val(:) +!!$ integer(psb_ipk_) :: nr +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_c_base_vect_type%set_vect(val) +!!$ call x%set_host() +!!$ +!!$ end subroutine c_gpu_set_vect + + + + function c_gpu_dot_v(n,x,y) result(res) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(in) :: n + complex(psb_spk_) :: res + complex(psb_spk_), external :: ddot + integer(psb_ipk_) :: info + + res = czero + ! + ! Note: this is the gpu implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_c_vect + ! + select type(yy => y) + type is (psb_c_base_vect_type) + if (x%is_dev()) call x%sync() + res = ddot(n,x%v,1,yy%v,1) + type is (psb_c_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) + if (info /= 0) then + info = psb_err_internal_error_ + call psb_errpush(info,'c_gpu_dot_v') + end if + + class default + ! y%sync is done in dot_a + call x%sync() + res = y%dot(n,x%v) + end select + + end function c_gpu_dot_v + + function c_gpu_dot_a(n,x,y) result(res) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + complex(psb_spk_), intent(in) :: y(:) + integer(psb_ipk_), intent(in) :: n + complex(psb_spk_) :: res + complex(psb_spk_), external :: ddot + + if (x%is_dev()) call x%sync() + res = ddot(n,y,1,x%v,1) + + end function c_gpu_dot_a + + subroutine c_gpu_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer(psb_ipk_), intent(in) :: m + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_vect_gpu), intent(inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nx, ny + + info = psb_success_ + + select type(xx => x) + type is (psb_c_vect_gpu) + ! Do something different here + if ((beta /= czero).and.y%is_host())& + & call y%sync() + if (xx%is_host()) call xx%sync() + nx = getMultiVecDeviceSize(xx%deviceVect) + ny = getMultiVecDeviceSize(y%deviceVect) + if ((nx x) + type is (psb_c_base_vect_type) + if (y%is_dev()) call y%sync() + do i=1, n + y%v(i) = y%v(i) * xx%v(i) + end do + call y%set_host() + type is (psb_c_vect_gpu) + ! Do something different here + if (y%is_host()) call y%sync() + if (xx%is_host()) call xx%sync() + info = axyMultiVecDevice(n,cone,xx%deviceVect,y%deviceVect) + call y%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (y%is_dev()) call y%sync() + call y%mlt(xx%v,info) + call y%set_host() + end select + + end subroutine c_gpu_mlt_v + + subroutine c_gpu_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_vect_gpu), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + call y%psb_c_base_vect_type%mlt(x,info) + ! set_host() is invoked in the base method + end subroutine c_gpu_mlt_a + + subroutine c_gpu_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: x(:) + complex(psb_spk_), intent(in) :: y(:) + class(psb_c_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (z%is_dev()) call z%sync() + call z%psb_c_base_vect_type%mlt(alpha,x,y,beta,info) + ! set_host() is invoked in the base method + end subroutine c_gpu_mlt_a_2 + + subroutine c_gpu_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + class(psb_c_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer(psb_ipk_) :: i, n + logical :: conjgx_, conjgy_ + + if (.false.) then + ! These are present just for coherence with the + ! complex versions; they do nothing here. + conjgx_=.false. + if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') + conjgy_=.false. + if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') + end if + + n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) + + ! + ! Need to reconsider BETA in the GPU side + ! of things. + ! + info = 0 + select type(xx => x) + type is (psb_c_vect_gpu) + select type (yy => y) + type is (psb_c_vect_gpu) + if (xx%is_host()) call xx%sync() + if (yy%is_host()) call yy%sync() + if ((beta /= czero).and.(z%is_host())) call z%sync() + info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& + & yy%deviceVect,beta,z%deviceVect) + call z%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (yy%is_dev()) call yy%sync() + if ((beta /= czero).and.(z%is_dev())) call z%sync() + call z%psb_c_base_vect_type%mlt(alpha,xx,yy,beta,info) + call z%set_host() + end select + + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + if ((beta /= czero).and.(z%is_dev())) call z%sync() + call z%psb_c_base_vect_type%mlt(alpha,x,y,beta,info) + call z%set_host() + end select + end subroutine c_gpu_mlt_v_2 + + subroutine c_gpu_scal(alpha, x) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + complex(psb_spk_), intent (in) :: alpha + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = scalMultiVecDevice(alpha,x%deviceVect) + call x%set_dev() + end subroutine c_gpu_scal + + + function c_gpu_nrm2(n,x) result(res) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + ! WARNING: this should be changed. + if (x%is_host()) call x%sync() + info = nrm2MultiVecDeviceComplex(res,n,x%deviceVect) + + end function c_gpu_nrm2 + + function c_gpu_amax(n,x) result(res) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = amaxMultiVecDeviceComplex(res,n,x%deviceVect) + + end function c_gpu_amax + + function c_gpu_asum(n,x) result(res) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = asumMultiVecDeviceComplex(res,n,x%deviceVect) + + end function c_gpu_asum + + subroutine c_gpu_absval1(x) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + n=x%get_nrows() + info = absMultiVecDevice(n,cone,x%deviceVect) + + end subroutine c_gpu_absval1 + + subroutine c_gpu_absval2(x,y) + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + n=min(x%get_nrows(),y%get_nrows()) + select type (yy=> y) + class is (psb_c_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = absMultiVecDevice(n,cone,x%deviceVect,yy%deviceVect) + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + call x%psb_c_base_vect_type%absval(y) + end select + end subroutine c_gpu_absval2 + + + subroutine c_gpu_vect_finalize(x) + use psi_serial_mod + use psb_realloc_mod + implicit none + type(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + info = 0 + call x%free(info) + end subroutine c_gpu_vect_finalize + + subroutine c_gpu_ins_v(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + class(psb_i_base_vect_type), intent(inout) :: irl + class(psb_c_base_vect_type), intent(inout) :: val + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i, isz + logical :: done_gpu + + info = 0 + if (psb_errstatus_fatal()) return + + done_gpu = .false. + select type(virl => irl) + class is (psb_i_vect_gpu) + select type(vval => val) + class is (psb_c_vect_gpu) + if (vval%is_host()) call vval%sync() + if (virl%is_host()) call virl%sync() + if (x%is_host()) call x%sync() + info = geinsMultiVecDeviceFloatComplex(n,virl%deviceVect,& + & vval%deviceVect,dupl,1,x%deviceVect) + call x%set_dev() + done_gpu=.true. + end select + end select + + if (.not.done_gpu) then + if (irl%is_dev()) call irl%sync() + if (val%is_dev()) call val%sync() + call x%ins(n,irl%v,val%v,dupl,info) + end if + + if (info /= 0) then + call psb_errpush(info,'gpu_vect_ins') + return + end if + + end subroutine c_gpu_ins_v + + subroutine c_gpu_ins_a(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_c_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + integer(psb_ipk_), intent(in) :: irl(:) + complex(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i + + info = 0 + if (x%is_dev()) call x%sync() + call x%psb_c_base_vect_type%ins(n,irl,val,dupl,info) + call x%set_host() + + end subroutine c_gpu_ins_a + +#endif + +end module psb_c_gpu_vect_mod + + +! +! Multivectors +! + + + +module psb_c_gpu_multivect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_c_multivect_mod + use psb_c_base_multivect_mod + + use psb_i_multivect_mod +#ifdef HAVE_SPGPU + use psb_i_gpu_multivect_mod + use psb_c_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_c_base_multivect_type) :: psb_c_multivect_gpu +#ifdef HAVE_SPGPU + + integer(psb_ipk_) :: state = is_host, m_nrows=0, m_ncols=0 + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: buffer(:,:) + type(c_ptr) :: dt_buf = c_null_ptr + contains + procedure, pass(x) :: get_nrows => c_gpu_multi_get_nrows + procedure, pass(x) :: get_ncols => c_gpu_multi_get_ncols + procedure, nopass :: get_fmt => c_gpu_multi_get_fmt +!!$ procedure, pass(x) :: dot_v => c_gpu_multi_dot_v +!!$ procedure, pass(x) :: dot_a => c_gpu_multi_dot_a +!!$ procedure, pass(y) :: axpby_v => c_gpu_multi_axpby_v +!!$ procedure, pass(y) :: axpby_a => c_gpu_multi_axpby_a +!!$ procedure, pass(y) :: mlt_v => c_gpu_multi_mlt_v +!!$ procedure, pass(y) :: mlt_a => c_gpu_multi_mlt_a +!!$ procedure, pass(z) :: mlt_a_2 => c_gpu_multi_mlt_a_2 +!!$ procedure, pass(z) :: mlt_v_2 => c_gpu_multi_mlt_v_2 +!!$ procedure, pass(x) :: scal => c_gpu_multi_scal +!!$ procedure, pass(x) :: nrm2 => c_gpu_multi_nrm2 +!!$ procedure, pass(x) :: amax => c_gpu_multi_amax +!!$ procedure, pass(x) :: asum => c_gpu_multi_asum + procedure, pass(x) :: all => c_gpu_multi_all + procedure, pass(x) :: zero => c_gpu_multi_zero + procedure, pass(x) :: asb => c_gpu_multi_asb + procedure, pass(x) :: sync => c_gpu_multi_sync + procedure, pass(x) :: sync_space => c_gpu_multi_sync_space + procedure, pass(x) :: bld_x => c_gpu_multi_bld_x + procedure, pass(x) :: bld_n => c_gpu_multi_bld_n + procedure, pass(x) :: free => c_gpu_multi_free + procedure, pass(x) :: ins => c_gpu_multi_ins + procedure, pass(x) :: is_host => c_gpu_multi_is_host + procedure, pass(x) :: is_dev => c_gpu_multi_is_dev + procedure, pass(x) :: is_sync => c_gpu_multi_is_sync + procedure, pass(x) :: set_host => c_gpu_multi_set_host + procedure, pass(x) :: set_dev => c_gpu_multi_set_dev + procedure, pass(x) :: set_sync => c_gpu_multi_set_sync + procedure, pass(x) :: set_scal => c_gpu_multi_set_scal + procedure, pass(x) :: set_vect => c_gpu_multi_set_vect +!!$ procedure, pass(x) :: gthzv_x => c_gpu_multi_gthzv_x +!!$ procedure, pass(y) :: sctb => c_gpu_multi_sctb +!!$ procedure, pass(y) :: sctb_x => c_gpu_multi_sctb_x + final :: c_gpu_multi_vect_finalize +#endif + end type psb_c_multivect_gpu + + public :: psb_c_multivect_gpu + private :: constructor + interface psb_c_multivect_gpu + module procedure constructor + end interface + +contains + + function constructor(x) result(this) + complex(psb_spk_) :: x(:,:) + type(psb_c_multivect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x,1),size(x,2),info) + + end function constructor + +#ifdef HAVE_SPGPU + +!!$ subroutine c_gpu_multi_gthzv_x(i,n,idx,x,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i,n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ complex(psb_spk_) :: y(:) +!!$ class(psb_c_multivect_gpu) :: x +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (x%is_host()) call x%sync() +!!$ +!!$ if (allocated(x%buffer)) then +!!$ if (size(x%buffer) < n) then +!!$ call inner_unregister(x%buffer) +!!$ deallocate(x%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(x%buffer)) then +!!$ allocate(x%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(x%buffer,x%dt_buf) +!!$ endif +!!$ info = igathMultiVecDeviceDouble(x%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, x%dt_buf, 1) +!!$ call psb_cudaSync() +!!$ y(1:n) = x%buffer(1:n) +!!$ +!!$ class default +!!$ call x%gth(n,ii%v(i:),y) +!!$ end select +!!$ +!!$ +!!$ end subroutine c_gpu_multi_gthzv_x +!!$ +!!$ +!!$ +!!$ subroutine c_gpu_multi_sctb(n,idx,x,beta,y) +!!$ implicit none +!!$ !use psb_const_mod +!!$ integer(psb_ipk_) :: n, idx(:) +!!$ complex(psb_spk_) :: beta, x(:) +!!$ class(psb_c_multivect_gpu) :: y +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (n == 0) return +!!$ +!!$ if (y%is_dev()) call y%sync() +!!$ +!!$ call y%psb_c_base_multivect_type%sctb(n,idx,x,beta) +!!$ call y%set_host() +!!$ +!!$ end subroutine c_gpu_multi_sctb +!!$ +!!$ subroutine c_gpu_multi_sctb_x(i,n,idx,x,beta,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i, n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ complex(psb_spk_) :: beta, x(:) +!!$ class(psb_c_multivect_gpu) :: y +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (y%is_host()) call y%sync() +!!$ +!!$ if (allocated(y%buffer)) then +!!$ if (size(y%buffer) < n) then +!!$ call inner_unregister(y%buffer) +!!$ deallocate(y%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(y%buffer)) then +!!$ allocate(y%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(y%buffer,y%dt_buf) +!!$ endif +!!$ y%buffer(1:n) = x(1:n) +!!$ info = iscatMultiVecDeviceDouble(y%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, y%dt_buf, 1,beta) +!!$ +!!$ call y%set_dev() +!!$ call psb_cudaSync() +!!$ +!!$ class default +!!$ call y%sct(n,ii%v(i:),x,beta) +!!$ end select +!!$ +!!$ end subroutine c_gpu_multi_sctb_x + + + subroutine c_gpu_multi_bld_x(x,this) + use psb_base_mod + complex(psb_spk_), intent(in) :: this(:,:) + class(psb_c_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info, m, n + + m=size(this,1) + n=size(this,2) + x%m_nrows = m + x%m_ncols = n + call psb_realloc(m,n,x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'c_gpu_multi_bld_x',& + & i_err=(/size(this,1),size(this,2),izero,izero,izero,izero/)) + end if + x%v(1:m,1:n) = this(1:m,1:n) + call x%set_host() + call x%sync() + + end subroutine c_gpu_multi_bld_x + + subroutine c_gpu_multi_bld_n(x,m,n) + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(m,n,info) + if (info /= 0) then + call psb_errpush(info,'c_gpu_multi_bld_n',i_err=(/m,n,n,n,n/)) + end if + + end subroutine c_gpu_multi_bld_n + + + subroutine c_gpu_multi_set_host(x) + implicit none + class(psb_c_multivect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine c_gpu_multi_set_host + + subroutine c_gpu_multi_set_dev(x) + implicit none + class(psb_c_multivect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine c_gpu_multi_set_dev + + subroutine c_gpu_multi_set_sync(x) + implicit none + class(psb_c_multivect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine c_gpu_multi_set_sync + + function c_gpu_multi_is_dev(x) result(res) + implicit none + class(psb_c_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function c_gpu_multi_is_dev + + function c_gpu_multi_is_host(x) result(res) + implicit none + class(psb_c_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function c_gpu_multi_is_host + + function c_gpu_multi_is_sync(x) result(res) + implicit none + class(psb_c_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function c_gpu_multi_is_sync + + + function c_gpu_multi_get_nrows(x) result(res) + implicit none + class(psb_c_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_nrows + + end function c_gpu_multi_get_nrows + + function c_gpu_multi_get_ncols(x) result(res) + implicit none + class(psb_c_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_ncols + + end function c_gpu_multi_get_ncols + + function c_gpu_multi_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'cGPU' + end function c_gpu_multi_get_fmt + +!!$ function c_gpu_multi_dot_v(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ class(psb_c_base_multivect_type), intent(inout) :: y +!!$ integer(psb_ipk_), intent(in) :: n +!!$ complex(psb_spk_) :: res +!!$ complex(psb_spk_), external :: ddot +!!$ integer(psb_ipk_) :: info +!!$ +!!$ res = dzero +!!$ ! +!!$ ! Note: this is the gpu implementation. +!!$ ! When we get here, we are sure that X is of +!!$ ! TYPE psb_c_vect +!!$ ! +!!$ select type(yy => y) +!!$ type is (psb_c_base_multivect_type) +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,x%v,1,yy%v,1) +!!$ type is (psb_c_multivect_gpu) +!!$ if (x%is_host()) call x%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) +!!$ if (info /= 0) then +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,'c_gpu_multi_dot_v') +!!$ end if +!!$ +!!$ class default +!!$ ! y%sync is done in dot_a +!!$ call x%sync() +!!$ res = y%dot(n,x%v) +!!$ end select +!!$ +!!$ end function c_gpu_multi_dot_v +!!$ +!!$ function c_gpu_multi_dot_a(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ complex(psb_spk_), intent(in) :: y(:) +!!$ integer(psb_ipk_), intent(in) :: n +!!$ complex(psb_spk_) :: res +!!$ complex(psb_spk_), external :: ddot +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,y,1,x%v,1) +!!$ +!!$ end function c_gpu_multi_dot_a +!!$ +!!$ subroutine c_gpu_multi_axpby_v(m,alpha, x, beta, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: m +!!$ class(psb_c_base_multivect_type), intent(inout) :: x +!!$ class(psb_c_multivect_gpu), intent(inout) :: y +!!$ complex(psb_spk_), intent (in) :: alpha, beta +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: nx, ny +!!$ +!!$ info = psb_success_ +!!$ +!!$ select type(xx => x) +!!$ type is (psb_c_base_multivect_type) +!!$ if ((beta /= dzero).and.(y%is_dev()))& +!!$ & call y%sync() +!!$ call psb_geaxpby(m,alpha,xx%v,beta,y%v,info) +!!$ call y%set_host() +!!$ type is (psb_c_multivect_gpu) +!!$ ! Do something different here +!!$ if ((beta /= dzero).and.y%is_host())& +!!$ & call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ nx = getMultiVecDeviceSize(xx%deviceVect) +!!$ ny = getMultiVecDeviceSize(y%deviceVect) +!!$ if ((nx x) +!!$ type is (psb_c_base_multivect_type) +!!$ if (y%is_dev()) call y%sync() +!!$ do i=1, n +!!$ y%v(i) = y%v(i) * xx%v(i) +!!$ end do +!!$ call y%set_host() +!!$ type is (psb_c_multivect_gpu) +!!$ ! Do something different here +!!$ if (y%is_host()) call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) +!!$ call y%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call y%mlt(xx%v,info) +!!$ call y%set_host() +!!$ end select +!!$ +!!$ end subroutine c_gpu_multi_mlt_v +!!$ +!!$ subroutine c_gpu_multi_mlt_a(x, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ complex(psb_spk_), intent(in) :: x(:) +!!$ class(psb_c_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ call y%sync() +!!$ call y%psb_c_base_multivect_type%mlt(x,info) +!!$ call y%set_host() +!!$ end subroutine c_gpu_multi_mlt_a +!!$ +!!$ subroutine c_gpu_multi_mlt_a_2(alpha,x,y,beta,z,info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ complex(psb_spk_), intent(in) :: alpha,beta +!!$ complex(psb_spk_), intent(in) :: x(:) +!!$ complex(psb_spk_), intent(in) :: y(:) +!!$ class(psb_c_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ if (z%is_dev()) call z%sync() +!!$ call z%psb_c_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end subroutine c_gpu_multi_mlt_a_2 +!!$ +!!$ subroutine c_gpu_multi_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) +!!$ use psi_serial_mod +!!$ use psb_string_mod +!!$ implicit none +!!$ complex(psb_spk_), intent(in) :: alpha,beta +!!$ class(psb_c_base_multivect_type), intent(inout) :: x +!!$ class(psb_c_base_multivect_type), intent(inout) :: y +!!$ class(psb_c_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character(len=1), intent(in), optional :: conjgx, conjgy +!!$ integer(psb_ipk_) :: i, n +!!$ logical :: conjgx_, conjgy_ +!!$ +!!$ if (.false.) then +!!$ ! These are present just for coherence with the +!!$ ! complex versions; they do nothing here. +!!$ conjgx_=.false. +!!$ if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') +!!$ conjgy_=.false. +!!$ if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') +!!$ end if +!!$ +!!$ n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) +!!$ +!!$ ! +!!$ ! Need to reconsider BETA in the GPU side +!!$ ! of things. +!!$ ! +!!$ info = 0 +!!$ select type(xx => x) +!!$ type is (psb_c_multivect_gpu) +!!$ select type (yy => y) +!!$ type is (psb_c_multivect_gpu) +!!$ if (xx%is_host()) call xx%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ ! Z state is irrelevant: it will be done on the GPU. +!!$ info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& +!!$ & yy%deviceVect,beta,z%deviceVect) +!!$ call z%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call yy%sync() +!!$ call z%psb_c_base_multivect_type%mlt(alpha,xx,yy,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ +!!$ class default +!!$ call x%sync() +!!$ call y%sync() +!!$ call z%psb_c_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ end subroutine c_gpu_multi_mlt_v_2 + + + subroutine c_gpu_multi_set_scal(x,val) + class(psb_c_multivect_gpu), intent(inout) :: x + complex(psb_spk_), intent(in) :: val + + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_c_base_multivect_type%set_scal(val) + call x%set_host() + end subroutine c_gpu_multi_set_scal + + subroutine c_gpu_multi_set_vect(x,val) + class(psb_c_multivect_gpu), intent(inout) :: x + complex(psb_spk_), intent(in) :: val(:,:) + integer(psb_ipk_) :: nr + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_c_base_multivect_type%set_vect(val) + call x%set_host() + + end subroutine c_gpu_multi_set_vect + + + +!!$ subroutine c_gpu_multi_scal(alpha, x) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ complex(psb_spk_), intent (in) :: alpha +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_c_base_multivect_type%scal(alpha) +!!$ call x%set_host() +!!$ end subroutine c_gpu_multi_scal +!!$ +!!$ +!!$ function c_gpu_multi_nrm2(n,x) result(res) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ integer(psb_ipk_) :: info +!!$ ! WARNING: this should be changed. +!!$ if (x%is_host()) call x%sync() +!!$ info = nrm2MultiVecDevice(res,n,x%deviceVect) +!!$ +!!$ end function c_gpu_multi_nrm2 +!!$ +!!$ function c_gpu_multi_amax(n,x) result(res) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = maxval(abs(x%v(1:n))) +!!$ +!!$ end function c_gpu_multi_amax +!!$ +!!$ function c_gpu_multi_asum(n,x) result(res) +!!$ implicit none +!!$ class(psb_c_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = sum(abs(x%v(1:n))) +!!$ +!!$ end function c_gpu_multi_asum + + subroutine c_gpu_multi_all(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_multivect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(m,n,x%v,info,pad=czero) + x%m_nrows = m + x%m_ncols = n + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'c_gpu_multi_all',& + & i_err=(/m,n,n,n,n/)) + end if + end subroutine c_gpu_multi_all + + subroutine c_gpu_multi_zero(x) + use psi_serial_mod + implicit none + class(psb_c_multivect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine c_gpu_multi_zero + + subroutine c_gpu_multi_asb(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nd, nc + + + x%m_nrows = m + x%m_ncols = n + if (x%is_host()) then + call x%psb_c_base_multivect_type%asb(m,n,info) + if (info == psb_success_) call x%sync_space(info) + else if (x%is_dev()) then + nd = getMultiVecDevicePitch(x%deviceVect) + nc = getMultiVecDeviceCount(x%deviceVect) + if ((nd < m).or.(nc c_hdiag_get_fmt + ! procedure, pass(a) :: sizeof => c_hdiag_sizeof + procedure, pass(a) :: vect_mv => psb_c_hdiag_vect_mv + ! procedure, pass(a) :: csmm => psb_c_hdiag_csmm + procedure, pass(a) :: csmv => psb_c_hdiag_csmv + ! procedure, pass(a) :: in_vect_sv => psb_c_hdiag_inner_vect_sv + ! procedure, pass(a) :: scals => psb_c_hdiag_scals + ! procedure, pass(a) :: scalv => psb_c_hdiag_scal + ! procedure, pass(a) :: reallocate_nz => psb_c_hdiag_reallocate_nz + ! procedure, pass(a) :: allocate_mnnz => psb_c_hdiag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_hdiag_from_coo + ! procedure, pass(a) :: cp_from_fmt => psb_c_cp_hdiag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_hdiag_from_coo + ! procedure, pass(a) :: mv_from_fmt => psb_c_mv_hdiag_from_fmt + procedure, pass(a) :: free => c_hdiag_free + procedure, pass(a) :: mold => psb_c_hdiag_mold + procedure, pass(a) :: to_gpu => psb_c_hdiag_to_gpu + final :: c_hdiag_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_hdiag_mold +#endif + end type psb_c_hdiag_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_hdiag_get_nzeros, c_hdiag_free, c_hdiag_get_fmt, & + & c_hdiag_get_size, c_hdiag_sizeof, c_hdiag_get_nz_row + + + interface + subroutine psb_c_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hdiag_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hdiag_vect_mv + end interface + +!!$ interface +!!$ subroutine psb_c_hdiag_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_c_hdiag_sparse_mat, psb_spk_, psb_c_base_vect_type +!!$ class(psb_c_hdiag_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_c_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_hdiag_inner_vect_sv +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdiag_reallocate_nz(nz,a) +!!$ import :: psb_c_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_c_hdiag_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdiag_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_c_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_c_hdiag_allocate_mnnz +!!$ end interface + + interface + subroutine psb_c_hdiag_mold(a,b,info) + import :: psb_c_hdiag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hdiag_mold + end interface + + interface + subroutine psb_c_hdiag_to_gpu(a,info) + import :: psb_c_hdiag_sparse_mat, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hdiag_to_gpu + end interface + + interface + subroutine psb_c_cp_hdiag_from_coo(a,b,info) + import :: psb_c_hdiag_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hdiag_from_coo + end interface + +!!$ interface +!!$ subroutine psb_c_cp_hdiag_from_fmt(a,b,info) +!!$ import :: psb_c_hdiag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_c_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_cp_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_c_mv_hdiag_from_coo(a,b,info) + import :: psb_c_hdiag_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hdiag_from_coo + end interface + +!!$ +!!$ interface +!!$ subroutine psb_c_mv_hdiag_from_fmt(a,b,info) +!!$ import :: psb_c_hdiag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_c_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_mv_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_c_hdiag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hdiag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hdiag_csmv + end interface + +!!$ interface +!!$ subroutine psb_c_hdiag_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdiag_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_c_hdiag_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdiag_scal(d,a,info, side) +!!$ import :: psb_c_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_c_hdiag_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdiag_scals(d,a,info) +!!$ import :: psb_c_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdiag_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_hdiag_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + function c_hdiag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIAG' + end function c_hdiag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_hdiag_free(a) + use hdiagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_c_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_hdia_sparse_mat%free() + + return + + end subroutine c_hdiag_free + + subroutine c_hdiag_finalize(a) + use hdiagdev_mod + implicit none + type(psb_c_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_hdia_sparse_mat%free() + + return + end subroutine c_hdiag_finalize + +#else + + interface + subroutine psb_c_hdiag_mold(a,b,info) + import :: psb_c_hdiag_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hdiag_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hdiag_mold + end interface + +#endif + +end module psb_c_hdiag_mat_mod diff --git a/gpu/psb_c_hlg_mat_mod.F90 b/gpu/psb_c_hlg_mat_mod.F90 new file mode 100644 index 000000000..9236a202f --- /dev/null +++ b/gpu/psb_c_hlg_mat_mod.F90 @@ -0,0 +1,398 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_hlg_mat_mod + + use iso_c_binding + use psb_c_mat_mod + use psb_c_hll_mat_mod + + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_c_hll_sparse_mat) :: psb_c_hlg_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer :: devstate = is_host + + contains + procedure, nopass :: get_fmt => c_hlg_get_fmt + procedure, pass(a) :: sizeof => c_hlg_sizeof + procedure, pass(a) :: vect_mv => psb_c_hlg_vect_mv + procedure, pass(a) :: csmm => psb_c_hlg_csmm + procedure, pass(a) :: csmv => psb_c_hlg_csmv + procedure, pass(a) :: in_vect_sv => psb_c_hlg_inner_vect_sv + procedure, pass(a) :: scals => psb_c_hlg_scals + procedure, pass(a) :: scalv => psb_c_hlg_scal + procedure, pass(a) :: reallocate_nz => psb_c_hlg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_hlg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_hlg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_c_cp_hlg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_hlg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_c_mv_hlg_from_fmt + procedure, pass(a) :: free => c_hlg_free + procedure, pass(a) :: mold => psb_c_hlg_mold + procedure, pass(a) :: is_host => c_hlg_is_host + procedure, pass(a) :: is_dev => c_hlg_is_dev + procedure, pass(a) :: is_sync => c_hlg_is_sync + procedure, pass(a) :: set_host => c_hlg_set_host + procedure, pass(a) :: set_dev => c_hlg_set_dev + procedure, pass(a) :: set_sync => c_hlg_set_sync + procedure, pass(a) :: sync => c_hlg_sync + procedure, pass(a) :: from_gpu => psb_c_hlg_from_gpu + procedure, pass(a) :: to_gpu => psb_c_hlg_to_gpu + final :: c_hlg_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_hlg_mold +#endif + end type psb_c_hlg_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_hlg_get_nzeros, c_hlg_free, c_hlg_get_fmt, & + & c_hlg_get_size, c_hlg_sizeof, c_hlg_get_nz_row + + + interface + subroutine psb_c_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hlg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hlg_vect_mv + end interface + + interface + subroutine psb_c_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_c_hlg_sparse_mat, psb_spk_, psb_c_base_vect_type + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hlg_inner_vect_sv + end interface + + interface + subroutine psb_c_hlg_reallocate_nz(nz,a) + import :: psb_c_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_hlg_sparse_mat), intent(inout) :: a + end subroutine psb_c_hlg_reallocate_nz + end interface + + interface + subroutine psb_c_hlg_allocate_mnnz(m,n,a,nz) + import :: psb_c_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_hlg_allocate_mnnz + end interface + + interface + subroutine psb_c_hlg_mold(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hlg_mold + end interface + + interface + subroutine psb_c_hlg_from_gpu(a,info) + import :: psb_c_hlg_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hlg_from_gpu + end interface + + interface + subroutine psb_c_hlg_to_gpu(a,info, nzrm) + import :: psb_c_hlg_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_c_hlg_to_gpu + end interface + + interface + subroutine psb_c_cp_hlg_from_coo(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hlg_from_coo + end interface + + interface + subroutine psb_c_cp_hlg_from_fmt(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hlg_from_fmt + end interface + + interface + subroutine psb_c_mv_hlg_from_coo(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hlg_from_coo + end interface + + + interface + subroutine psb_c_mv_hlg_from_fmt(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hlg_from_fmt + end interface + + interface + subroutine psb_c_hlg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hlg_csmv + end interface + interface + subroutine psb_c_hlg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hlg_csmm + end interface + + interface + subroutine psb_c_hlg_scal(d,a,info, side) + import :: psb_c_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_c_hlg_scal + end interface + + interface + subroutine psb_c_hlg_scals(d,a,info) + import :: psb_c_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hlg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_hlg_sizeof(a) result(res) + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%hkoffs) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function c_hlg_sizeof + + function c_hlg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLG' + end function c_hlg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_hlg_free(a) + use hlldev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_c_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_c_hll_sparse_mat%free() + + return + + end subroutine c_hlg_free + + + subroutine c_hlg_sync(a) + implicit none + class(psb_c_hlg_sparse_mat), target, intent(in) :: a + class(psb_c_hlg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine c_hlg_sync + + subroutine c_hlg_set_host(a) + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine c_hlg_set_host + + subroutine c_hlg_set_dev(a) + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine c_hlg_set_dev + + subroutine c_hlg_set_sync(a) + implicit none + class(psb_c_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine c_hlg_set_sync + + function c_hlg_is_dev(a) result(res) + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function c_hlg_is_dev + + function c_hlg_is_host(a) result(res) + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function c_hlg_is_host + + function c_hlg_is_sync(a) result(res) + implicit none + class(psb_c_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function c_hlg_is_sync + + + subroutine c_hlg_finalize(a) + use hlldev_mod + implicit none + type(psb_c_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine c_hlg_finalize + +#else + + interface + subroutine psb_c_hlg_mold(a,b,info) + import :: psb_c_hlg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hlg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hlg_mold + end interface + +#endif + +end module psb_c_hlg_mat_mod diff --git a/gpu/psb_c_hybg_mat_mod.F90 b/gpu/psb_c_hybg_mat_mod.F90 new file mode 100644 index 000000000..d5c605ec3 --- /dev/null +++ b/gpu/psb_c_hybg_mat_mod.F90 @@ -0,0 +1,306 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +#if CUDA_SHORT_VERSION <= 10 + +module psb_c_hybg_mat_mod + + use iso_c_binding + use psb_c_mat_mod + use cusparse_mod + + type, extends(psb_c_csr_sparse_mat) :: psb_c_hybg_sparse_mat + ! + ! HYBG. An interface to the cuSPARSE HYB + ! On the CPU side we keep a CSR storage. + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(c_Hmat) :: deviceMat + + contains + procedure, nopass :: get_fmt => c_hybg_get_fmt + procedure, pass(a) :: sizeof => c_hybg_sizeof + procedure, pass(a) :: vect_mv => psb_c_hybg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_c_hybg_inner_vect_sv + procedure, pass(a) :: csmm => psb_c_hybg_csmm + procedure, pass(a) :: csmv => psb_c_hybg_csmv + procedure, pass(a) :: scals => psb_c_hybg_scals + procedure, pass(a) :: scalv => psb_c_hybg_scal + procedure, pass(a) :: reallocate_nz => psb_c_hybg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_hybg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_c_cp_hybg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_c_cp_hybg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_c_mv_hybg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_c_mv_hybg_from_fmt + procedure, pass(a) :: free => c_hybg_free + procedure, pass(a) :: mold => psb_c_hybg_mold + procedure, pass(a) :: to_gpu => psb_c_hybg_to_gpu + final :: c_hybg_finalize +#else + contains + procedure, pass(a) :: mold => psb_c_hybg_mold +#endif + end type psb_c_hybg_sparse_mat + +#ifdef HAVE_SPGPU + private :: c_hybg_get_nzeros, c_hybg_free, c_hybg_get_fmt, & + & c_hybg_get_size, c_hybg_sizeof, c_hybg_get_nz_row + + + interface + subroutine psb_c_hybg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hybg_inner_vect_sv + end interface + + interface + subroutine psb_c_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_c_base_vect_type, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hybg_vect_mv + end interface + + interface + subroutine psb_c_hybg_reallocate_nz(nz,a) + import :: psb_c_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_hybg_sparse_mat), intent(inout) :: a + end subroutine psb_c_hybg_reallocate_nz + end interface + + interface + subroutine psb_c_hybg_allocate_mnnz(m,n,a,nz) + import :: psb_c_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_hybg_allocate_mnnz + end interface + + interface + subroutine psb_c_hybg_mold(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hybg_mold + end interface + + interface + subroutine psb_c_hybg_to_gpu(a,info, nzrm) + import :: psb_c_hybg_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_c_hybg_to_gpu + end interface + + interface + subroutine psb_c_cp_hybg_from_coo(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hybg_from_coo + end interface + + interface + subroutine psb_c_cp_hybg_from_fmt(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hybg_from_fmt + end interface + + interface + subroutine psb_c_mv_hybg_from_coo(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hybg_from_coo + end interface + + interface + subroutine psb_c_mv_hybg_from_fmt(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hybg_from_fmt + end interface + + interface + subroutine psb_c_hybg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:) + complex(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hybg_csmv + end interface + interface + subroutine psb_c_hybg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_hybg_csmm + end interface + + interface + subroutine psb_c_hybg_scal(d,a,info,side) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_c_hybg_scal + end interface + + interface + subroutine psb_c_hybg_scals(d,a,info) + import :: psb_c_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hybg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_hybg_sizeof(a) result(res) + implicit none + class(psb_c_hybg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function c_hybg_sizeof + + function c_hybg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HYBG' + end function c_hybg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_hybg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + class(psb_c_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + call a%psb_c_csr_sparse_mat%free() + + return + + end subroutine c_hybg_free + + subroutine c_hybg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + type(psb_c_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + + return + end subroutine c_hybg_finalize + +#else + + interface + subroutine psb_c_hybg_mold(a,b,info) + import :: psb_c_hybg_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hybg_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hybg_mold + end interface + +#endif + +end module psb_c_hybg_mat_mod +#endif diff --git a/gpu/psb_c_vectordev_mod.F90 b/gpu/psb_c_vectordev_mod.F90 new file mode 100644 index 000000000..f3c243a6b --- /dev/null +++ b/gpu/psb_c_vectordev_mod.F90 @@ -0,0 +1,390 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_c_vectordev_mod + + use psb_base_vectordev_mod + +#ifdef HAVE_SPGPU + + interface registerMapped + function registerMappedFloatComplex(buf,d_p,n,dummy) & + & result(res) bind(c,name='registerMappedFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: buf + type(c_ptr) :: d_p + integer(c_int),value :: n + complex(c_float_complex), value :: dummy + end function registerMappedFloatComplex + end interface + + interface writeMultiVecDevice + function writeMultiVecDeviceFloatComplex(deviceVec,hostVec) & + & result(res) bind(c,name='writeMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + complex(c_float_complex) :: hostVec(*) + end function writeMultiVecDeviceFloatComplex + function writeMultiVecDeviceFloatComplexR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='writeMultiVecDeviceFloatComplexR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + complex(c_float_complex) :: hostVec(ld,*) + end function writeMultiVecDeviceFloatComplexR2 + end interface + + interface readMultiVecDevice + function readMultiVecDeviceFloatComplex(deviceVec,hostVec) & + & result(res) bind(c,name='readMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + complex(c_float_complex) :: hostVec(*) + end function readMultiVecDeviceFloatComplex + function readMultiVecDeviceFloatComplexR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='readMultiVecDeviceFloatComplexR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + complex(c_float_complex) :: hostVec(ld,*) + end function readMultiVecDeviceFloatComplexR2 + end interface + + interface allocateFloatComplex + function allocateFloatComplex(didx,n) & + & result(res) bind(c,name='allocateFloatComplex') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: n + integer(c_int) :: res + end function allocateFloatComplex + function allocateMultiFloatComplex(didx,m,n) & + & result(res) bind(c,name='allocateMultiFloatComplex') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: m,n + integer(c_int) :: res + end function allocateMultiFloatComplex + end interface + + interface writeFloatComplex + function writeFloatComplex(didx,hidx,n) & + & result(res) bind(c,name='writeFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(*) + integer(c_int),value :: n + end function writeFloatComplex + function writeFloatComplexFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='writeFloatComplexFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function writeFloatComplexFirst + function writeMultiFloatComplex(didx,hidx,m,n) & + & result(res) bind(c,name='writeMultiFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(m,*) + integer(c_int),value :: m,n + end function writeMultiFloatComplex + end interface + + interface readFloatComplex + function readFloatComplex(didx,hidx,n) & + & result(res) bind(c,name='readFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(*) + integer(c_int),value :: n + end function readFloatComplex + function readFloatComplexFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='readFloatComplexFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function readFloatComplexFirst + function readMultiFloatComplex(didx,hidx,m,n) & + & result(res) bind(c,name='readMultiFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_float_complex) :: hidx(m,*) + integer(c_int),value :: m,n + end function readMultiFloatComplex + end interface + + interface + subroutine freeFloatComplex(didx) & + & bind(c,name='freeFloatComplex') + use iso_c_binding + type(c_ptr), value :: didx + end subroutine freeFloatComplex + end interface + + + interface setScalDevice + function setScalMultiVecDeviceFloatComplex(val, first, last, & + & indexBase, deviceVecX) result(res) & + & bind(c,name='setscalMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: first,last,indexbase + complex(c_float_complex), value :: val + type(c_ptr), value :: deviceVecX + end function setScalMultiVecDeviceFloatComplex + end interface + + interface + function geinsMultiVecDeviceFloatComplex(n,deviceVecIrl,deviceVecVal,& + & dupl,indexbase,deviceVecX) & + & result(res) bind(c,name='geinsMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n, dupl,indexbase + type(c_ptr), value :: deviceVecIrl, deviceVecVal, deviceVecX + end function geinsMultiVecDeviceFloatComplex + end interface + + ! New gather functions + + interface + function igathMultiVecDeviceFloatComplex(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceFloatComplex + end interface + + interface + function igathMultiVecDeviceFloatComplexVecIdx(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceFloatComplexVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceFloatComplexVecIdx + end interface + + interface + function iscatMultiVecDeviceFloatComplex(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + complex(c_float_complex),value :: beta + end function iscatMultiVecDeviceFloatComplex + end interface + + interface + function iscatMultiVecDeviceFloatComplexVecIdx(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceFloatComplexVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + complex(c_float_complex),value :: beta + end function iscatMultiVecDeviceFloatComplexVecIdx + end interface + + + interface scalMultiVecDevice + function scalMultiVecDeviceFloatComplex(alpha,deviceVecA) & + & result(val) bind(c,name='scalMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + complex(c_float_complex), value :: alpha + type(c_ptr), value :: deviceVecA + end function scalMultiVecDeviceFloatComplex + end interface + + interface dotMultiVecDevice + function dotMultiVecDeviceFloatComplex(res, n,deviceVecA,deviceVecB) & + & result(val) bind(c,name='dotMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + complex(c_float_complex) :: res + type(c_ptr), value :: deviceVecA, deviceVecB + end function dotMultiVecDeviceFloatComplex + end interface + + interface nrm2MultiVecDeviceComplex + function nrm2MultiVecDeviceFloatComplex(res,n,deviceVecA) & + & result(val) bind(c,name='nrm2MultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function nrm2MultiVecDeviceFloatComplex + end interface + + interface amaxMultiVecDeviceComplex + function amaxMultiVecDeviceFloatComplex(res,n,deviceVecA) & + & result(val) bind(c,name='amaxMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function amaxMultiVecDeviceFloatComplex + end interface + + interface asumMultiVecDeviceComplex + function asumMultiVecDeviceFloatComplex(res,n,deviceVecA) & + & result(val) bind(c,name='asumMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function asumMultiVecDeviceFloatComplex + end interface + + + interface axpbyMultiVecDevice + function axpbyMultiVecDeviceFloatComplex(n,alpha,deviceVecA,beta,deviceVecB) & + & result(res) bind(c,name='axpbyMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_float_complex), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB + end function axpbyMultiVecDeviceFloatComplex + end interface + + interface axyMultiVecDevice + function axyMultiVecDeviceFloatComplex(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='axyMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_float_complex), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function axyMultiVecDeviceFloatComplex + end interface + + interface axybzMultiVecDevice + function axybzMultiVecDeviceFloatComplex(n,alpha,deviceVecA,deviceVecB,beta,deviceVecZ) & + & result(res) bind(c,name='axybzMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_float_complex), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB,deviceVecZ + end function axybzMultiVecDeviceFloatComplex + end interface + + + interface absMultiVecDevice + function absMultiVecDeviceFloatComplex(n,alpha,deviceVecA) & + & result(res) bind(c,name='absMultiVecDeviceFloatComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_float_complex), value :: alpha + type(c_ptr), value :: deviceVecA + end function absMultiVecDeviceFloatComplex + function absMultiVecDeviceFloatComplex2(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='absMultiVecDeviceFloatComplex2') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_float_complex), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function absMultiVecDeviceFloatComplex2 + end interface + + interface inner_register + module procedure inner_registerFloatComplex + end interface + + interface inner_unregister + module procedure inner_unregisterFloatComplex + end interface + +contains + + + function inner_registerFloatComplex(buffer,dval) result(res) + complex(c_float_complex), allocatable, target :: buffer(:) + type(c_ptr) :: dval + integer(c_int) :: res + complex(c_float_complex) :: dummy + res = registerMapped(c_loc(buffer),dval,size(buffer), dummy) + end function inner_registerFloatComplex + + subroutine inner_unregisterFloatComplex(buffer) + complex(c_float_complex), allocatable, target :: buffer(:) + + call unregisterMapped(c_loc(buffer)) + end subroutine inner_unregisterFloatComplex + +#endif + +end module psb_c_vectordev_mod diff --git a/gpu/psb_d_csrg_mat_mod.F90 b/gpu/psb_d_csrg_mat_mod.F90 new file mode 100644 index 000000000..177c7440d --- /dev/null +++ b/gpu/psb_d_csrg_mat_mod.F90 @@ -0,0 +1,393 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_csrg_mat_mod + + use iso_c_binding + use psb_d_mat_mod + use cusparse_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_d_csr_sparse_mat) :: psb_d_csrg_sparse_mat + ! + ! cuSPARSE 4.0 CSR format. + ! + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(d_Cmat) :: deviceMat + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => d_csrg_get_fmt + procedure, pass(a) :: sizeof => d_csrg_sizeof + procedure, pass(a) :: vect_mv => psb_d_csrg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_d_csrg_inner_vect_sv + procedure, pass(a) :: csmm => psb_d_csrg_csmm + procedure, pass(a) :: csmv => psb_d_csrg_csmv + procedure, pass(a) :: scals => psb_d_csrg_scals + procedure, pass(a) :: scalv => psb_d_csrg_scal + procedure, pass(a) :: reallocate_nz => psb_d_csrg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_csrg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_csrg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_d_cp_csrg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_csrg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_d_mv_csrg_from_fmt + procedure, pass(a) :: free => d_csrg_free + procedure, pass(a) :: mold => psb_d_csrg_mold + procedure, pass(a) :: is_host => d_csrg_is_host + procedure, pass(a) :: is_dev => d_csrg_is_dev + procedure, pass(a) :: is_sync => d_csrg_is_sync + procedure, pass(a) :: set_host => d_csrg_set_host + procedure, pass(a) :: set_dev => d_csrg_set_dev + procedure, pass(a) :: set_sync => d_csrg_set_sync + procedure, pass(a) :: sync => d_csrg_sync + procedure, pass(a) :: to_gpu => psb_d_csrg_to_gpu + procedure, pass(a) :: from_gpu => psb_d_csrg_from_gpu + final :: d_csrg_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_csrg_mold +#endif + end type psb_d_csrg_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_csrg_get_nzeros, d_csrg_free, d_csrg_get_fmt, & + & d_csrg_get_size, d_csrg_sizeof, d_csrg_get_nz_row + + + interface + subroutine psb_d_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_csrg_inner_vect_sv + end interface + + + interface + subroutine psb_d_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_csrg_vect_mv + end interface + + interface + subroutine psb_d_csrg_reallocate_nz(nz,a) + import :: psb_d_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_csrg_sparse_mat), intent(inout) :: a + end subroutine psb_d_csrg_reallocate_nz + end interface + + interface + subroutine psb_d_csrg_allocate_mnnz(m,n,a,nz) + import :: psb_d_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_csrg_allocate_mnnz + end interface + + interface + subroutine psb_d_csrg_mold(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_csrg_mold + end interface + + interface + subroutine psb_d_csrg_to_gpu(a,info, nzrm) + import :: psb_d_csrg_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_d_csrg_to_gpu + end interface + + interface + subroutine psb_d_csrg_from_gpu(a,info) + import :: psb_d_csrg_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_csrg_from_gpu + end interface + + interface + subroutine psb_d_cp_csrg_from_coo(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_csrg_from_coo + end interface + + interface + subroutine psb_d_cp_csrg_from_fmt(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_csrg_from_fmt + end interface + + interface + subroutine psb_d_mv_csrg_from_coo(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_csrg_from_coo + end interface + + interface + subroutine psb_d_mv_csrg_from_fmt(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_csrg_from_fmt + end interface + + interface + subroutine psb_d_csrg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_csrg_csmv + end interface + interface + subroutine psb_d_csrg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_csrg_csmm + end interface + + interface + subroutine psb_d_csrg_scal(d,a,info,side) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_csrg_scal + end interface + + interface + subroutine psb_d_csrg_scals(d,a,info) + import :: psb_d_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_csrg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_csrg_sizeof(a) result(res) + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function d_csrg_sizeof + + function d_csrg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'CSRG' + end function d_csrg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + + subroutine d_csrg_set_host(a) + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine d_csrg_set_host + + subroutine d_csrg_set_dev(a) + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine d_csrg_set_dev + + subroutine d_csrg_set_sync(a) + implicit none + class(psb_d_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine d_csrg_set_sync + + function d_csrg_is_dev(a) result(res) + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function d_csrg_is_dev + + function d_csrg_is_host(a) result(res) + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function d_csrg_is_host + + function d_csrg_is_sync(a) result(res) + implicit none + class(psb_d_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function d_csrg_is_sync + + + subroutine d_csrg_sync(a) + implicit none + class(psb_d_csrg_sparse_mat), target, intent(in) :: a + class(psb_d_csrg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine d_csrg_sync + + subroutine d_csrg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_d_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + call a%psb_d_csr_sparse_mat%free() + + return + + end subroutine d_csrg_free + + subroutine d_csrg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + type(psb_d_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + + return + + end subroutine d_csrg_finalize + +#else + interface + subroutine psb_d_csrg_mold(a,b,info) + import :: psb_d_csrg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_csrg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_csrg_mold + end interface + +#endif + +end module psb_d_csrg_mat_mod diff --git a/gpu/psb_d_diag_mat_mod.F90 b/gpu/psb_d_diag_mat_mod.F90 new file mode 100644 index 000000000..564f7a13a --- /dev/null +++ b/gpu/psb_d_diag_mat_mod.F90 @@ -0,0 +1,308 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_diag_mat_mod + + use iso_c_binding + use psb_base_mod + use psb_d_dia_mat_mod + + type, extends(psb_d_dia_sparse_mat) :: psb_d_diag_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => d_diag_get_fmt + procedure, pass(a) :: sizeof => d_diag_sizeof + procedure, pass(a) :: vect_mv => psb_d_diag_vect_mv +! procedure, pass(a) :: csmm => psb_d_diag_csmm + procedure, pass(a) :: csmv => psb_d_diag_csmv +! procedure, pass(a) :: in_vect_sv => psb_d_diag_inner_vect_sv +! procedure, pass(a) :: scals => psb_d_diag_scals +! procedure, pass(a) :: scalv => psb_d_diag_scal +! procedure, pass(a) :: reallocate_nz => psb_d_diag_reallocate_nz +! procedure, pass(a) :: allocate_mnnz => psb_d_diag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_diag_from_coo +! procedure, pass(a) :: cp_from_fmt => psb_d_cp_diag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_diag_from_coo +! procedure, pass(a) :: mv_from_fmt => psb_d_mv_diag_from_fmt + procedure, pass(a) :: free => d_diag_free + procedure, pass(a) :: mold => psb_d_diag_mold + procedure, pass(a) :: to_gpu => psb_d_diag_to_gpu + final :: d_diag_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_diag_mold +#endif + end type psb_d_diag_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_diag_get_nzeros, d_diag_free, d_diag_get_fmt, & + & d_diag_get_size, d_diag_sizeof, d_diag_get_nz_row + + + interface + subroutine psb_d_diag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_diag_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_diag_vect_mv + end interface + + interface + subroutine psb_d_diag_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_d_diag_sparse_mat, psb_dpk_, psb_d_base_vect_type + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_diag_inner_vect_sv + end interface + + interface + subroutine psb_d_diag_reallocate_nz(nz,a) + import :: psb_d_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_diag_sparse_mat), intent(inout) :: a + end subroutine psb_d_diag_reallocate_nz + end interface + + interface + subroutine psb_d_diag_allocate_mnnz(m,n,a,nz) + import :: psb_d_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_diag_allocate_mnnz + end interface + + interface + subroutine psb_d_diag_mold(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_diag_mold + end interface + + interface + subroutine psb_d_diag_to_gpu(a,info, nzrm) + import :: psb_d_diag_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_d_diag_to_gpu + end interface + + interface + subroutine psb_d_cp_diag_from_coo(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_diag_from_coo + end interface + + interface + subroutine psb_d_cp_diag_from_fmt(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_diag_from_fmt + end interface + + interface + subroutine psb_d_mv_diag_from_coo(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_diag_from_coo + end interface + + + interface + subroutine psb_d_mv_diag_from_fmt(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_diag_from_fmt + end interface + + interface + subroutine psb_d_diag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_diag_csmv + end interface + interface + subroutine psb_d_diag_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_diag_csmm + end interface + + interface + subroutine psb_d_diag_scal(d,a,info, side) + import :: psb_d_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_diag_scal + end interface + + interface + subroutine psb_d_diag_scals(d,a,info) + import :: psb_d_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_diag_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_diag_sizeof(a) result(res) + implicit none + class(psb_d_diag_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = 8 + res = res + psb_sizeof_dp * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function d_diag_sizeof + + function d_diag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIAG' + end function d_diag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_diag_free(a) + use diagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_d_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_dia_sparse_mat%free() + + return + + end subroutine d_diag_free + + subroutine d_diag_finalize(a) + use diagdev_mod + implicit none + type(psb_d_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine d_diag_finalize + +#else + + interface + subroutine psb_d_diag_mold(a,b,info) + import :: psb_d_diag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_diag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_diag_mold + end interface + +#endif + +end module psb_d_diag_mat_mod diff --git a/gpu/psb_d_dnsg_mat_mod.F90 b/gpu/psb_d_dnsg_mat_mod.F90 new file mode 100644 index 000000000..966c23119 --- /dev/null +++ b/gpu/psb_d_dnsg_mat_mod.F90 @@ -0,0 +1,294 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_dnsg_mat_mod + + use iso_c_binding + use psb_d_mat_mod + use psb_d_dns_mat_mod + use dnsdev_mod + + type, extends(psb_d_dns_sparse_mat) :: psb_d_dnsg_sparse_mat + ! + ! ITPACK/DNS format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of DNS, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => d_dnsg_get_fmt + ! procedure, pass(a) :: sizeof => d_dnsg_sizeof + procedure, pass(a) :: vect_mv => psb_d_dnsg_vect_mv +!!$ procedure, pass(a) :: csmm => psb_d_dnsg_csmm +!!$ procedure, pass(a) :: csmv => psb_d_dnsg_csmv +!!$ procedure, pass(a) :: in_vect_sv => psb_d_dnsg_inner_vect_sv +!!$ procedure, pass(a) :: scals => psb_d_dnsg_scals +!!$ procedure, pass(a) :: scalv => psb_d_dnsg_scal +!!$ procedure, pass(a) :: reallocate_nz => psb_d_dnsg_reallocate_nz +!!$ procedure, pass(a) :: allocate_mnnz => psb_d_dnsg_allocate_mnnz + ! Note: we *do* need the TO methods, because of the need to invoke SYNC + ! + procedure, pass(a) :: cp_from_coo => psb_d_cp_dnsg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_d_cp_dnsg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_dnsg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_d_mv_dnsg_from_fmt + procedure, pass(a) :: free => d_dnsg_free + procedure, pass(a) :: mold => psb_d_dnsg_mold + procedure, pass(a) :: to_gpu => psb_d_dnsg_to_gpu + final :: d_dnsg_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_dnsg_mold +#endif + end type psb_d_dnsg_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_dnsg_get_nzeros, d_dnsg_free, d_dnsg_get_fmt, & + & d_dnsg_get_size, d_dnsg_get_nz_row + + + interface + subroutine psb_d_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_dnsg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dnsg_vect_mv + end interface +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_d_dnsg_sparse_mat, psb_dpk_, psb_d_base_vect_type +!!$ class(psb_d_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_d_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_d_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_d_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_d_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_d_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_d_dnsg_allocate_mnnz +!!$ end interface + + interface + subroutine psb_d_dnsg_mold(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dnsg_mold + end interface + + interface + subroutine psb_d_dnsg_to_gpu(a,info) + import :: psb_d_dnsg_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dnsg_to_gpu + end interface + + interface + subroutine psb_d_cp_dnsg_from_coo(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dnsg_from_coo + end interface + + interface + subroutine psb_d_cp_dnsg_from_fmt(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dnsg_from_fmt + end interface + + interface + subroutine psb_d_mv_dnsg_from_coo(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dnsg_from_coo + end interface + + + interface + subroutine psb_d_mv_dnsg_from_fmt(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dnsg_from_fmt + end interface + +!!$ interface +!!$ subroutine psb_d_dnsg_csmv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:) +!!$ real(psb_dpk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_dnsg_csmv +!!$ end interface +!!$ interface +!!$ subroutine psb_d_dnsg_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_dnsg_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_scal(d,a,info, side) +!!$ import :: psb_d_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_d_dnsg_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_dnsg_scals(d,a,info) +!!$ import :: psb_d_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_dnsg_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_dnsg_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + + function d_dnsg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNSG' + end function d_dnsg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_dnsg_free(a) + use dnsdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_d_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_dns_sparse_mat%free() + + return + + end subroutine d_dnsg_free + + subroutine d_dnsg_finalize(a) + use dnsdev_mod + implicit none + type(psb_d_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine d_dnsg_finalize + +#else + + interface + subroutine psb_d_dnsg_mold(a,b,info) + import :: psb_d_dnsg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dnsg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dnsg_mold + end interface + +#endif + +end module psb_d_dnsg_mat_mod diff --git a/gpu/psb_d_elg_mat_mod.F90 b/gpu/psb_d_elg_mat_mod.F90 new file mode 100644 index 000000000..eac7bb369 --- /dev/null +++ b/gpu/psb_d_elg_mat_mod.F90 @@ -0,0 +1,483 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_elg_mat_mod + + use iso_c_binding + use psb_d_mat_mod + use psb_d_ell_mat_mod + use psb_i_gpu_vect_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_d_ell_sparse_mat) :: psb_d_elg_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of ELL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => d_elg_get_fmt + procedure, pass(a) :: sizeof => d_elg_sizeof + procedure, pass(a) :: vect_mv => psb_d_elg_vect_mv + procedure, pass(a) :: csmm => psb_d_elg_csmm + procedure, pass(a) :: csmv => psb_d_elg_csmv + procedure, pass(a) :: in_vect_sv => psb_d_elg_inner_vect_sv + procedure, pass(a) :: scals => psb_d_elg_scals + procedure, pass(a) :: scalv => psb_d_elg_scal + procedure, pass(a) :: reallocate_nz => psb_d_elg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_elg_allocate_mnnz + procedure, pass(a) :: reinit => d_elg_reinit + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_elg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_d_cp_elg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_elg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_d_mv_elg_from_fmt + procedure, pass(a) :: free => d_elg_free + procedure, pass(a) :: mold => psb_d_elg_mold + procedure, pass(a) :: csput_a => psb_d_elg_csput_a + procedure, pass(a) :: csput_v => psb_d_elg_csput_v + procedure, pass(a) :: is_host => d_elg_is_host + procedure, pass(a) :: is_dev => d_elg_is_dev + procedure, pass(a) :: is_sync => d_elg_is_sync + procedure, pass(a) :: set_host => d_elg_set_host + procedure, pass(a) :: set_dev => d_elg_set_dev + procedure, pass(a) :: set_sync => d_elg_set_sync + procedure, pass(a) :: sync => d_elg_sync + procedure, pass(a) :: from_gpu => psb_d_elg_from_gpu + procedure, pass(a) :: to_gpu => psb_d_elg_to_gpu + procedure, pass(a) :: asb => psb_d_elg_asb + final :: d_elg_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_elg_mold + procedure, pass(a) :: asb => psb_d_elg_asb +#endif + end type psb_d_elg_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_elg_get_nzeros, d_elg_free, d_elg_get_fmt, & + & d_elg_get_size, d_elg_sizeof, d_elg_get_nz_row, d_elg_sync + + + interface + subroutine psb_d_elg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_elg_vect_mv + end interface + + interface + subroutine psb_d_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_d_elg_sparse_mat, psb_dpk_, psb_d_base_vect_type + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_elg_inner_vect_sv + end interface + + interface + subroutine psb_d_elg_reallocate_nz(nz,a) + import :: psb_d_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_elg_sparse_mat), intent(inout) :: a + end subroutine psb_d_elg_reallocate_nz + end interface + + interface + subroutine psb_d_elg_allocate_mnnz(m,n,a,nz) + import :: psb_d_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_elg_allocate_mnnz + end interface + + interface + subroutine psb_d_elg_mold(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_mold + end interface + + interface + subroutine psb_d_elg_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_csput_a + end interface + + interface + subroutine psb_d_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_, psb_d_base_vect_type,& + & psb_i_base_vect_type + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_csput_v + end interface + + interface + subroutine psb_d_elg_from_gpu(a,info) + import :: psb_d_elg_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_from_gpu + end interface + + interface + subroutine psb_d_elg_to_gpu(a,info, nzrm) + import :: psb_d_elg_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_d_elg_to_gpu + end interface + + interface + subroutine psb_d_cp_elg_from_coo(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_elg_from_coo + end interface + + interface + subroutine psb_d_cp_elg_from_fmt(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_elg_from_fmt + end interface + + interface + subroutine psb_d_mv_elg_from_coo(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_elg_from_coo + end interface + + + interface + subroutine psb_d_mv_elg_from_fmt(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_elg_from_fmt + end interface + + interface + subroutine psb_d_elg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_elg_csmv + end interface + interface + subroutine psb_d_elg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_elg_csmm + end interface + + interface + subroutine psb_d_elg_scal(d,a,info, side) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_elg_scal + end interface + + interface + subroutine psb_d_elg_scals(d,a,info) + import :: psb_d_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_scals + end interface + + interface + subroutine psb_d_elg_asb(a) + import :: psb_d_elg_sparse_mat + class(psb_d_elg_sparse_mat), intent(inout) :: a + end subroutine psb_d_elg_asb + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_elg_sizeof(a) result(res) + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function d_elg_sizeof + + function d_elg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELG' + end function d_elg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + subroutine d_elg_reinit(a,clear) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_d_elg_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + integer(psb_ipk_) :: isz, err_act + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + if (a%is_bld() .or. a%is_upd()) then + ! do nothing + return + else if (a%is_asb()) then + if (a%is_dev().or.a%is_sync()) then + if (clear_) call zeroEllDevice(a%deviceMat) + call a%set_dev() + else if (a%is_host()) then + a%val(:,:) = dzero + end if + call a%set_upd() + else + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine d_elg_reinit + + subroutine d_elg_free(a) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_d_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_ell_sparse_mat%free() + call a%set_sync() + + return + + end subroutine d_elg_free + + subroutine d_elg_sync(a) + implicit none + class(psb_d_elg_sparse_mat), target, intent(in) :: a + class(psb_d_elg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine d_elg_sync + + subroutine d_elg_set_host(a) + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine d_elg_set_host + + subroutine d_elg_set_dev(a) + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine d_elg_set_dev + + subroutine d_elg_set_sync(a) + implicit none + class(psb_d_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine d_elg_set_sync + + function d_elg_is_dev(a) result(res) + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function d_elg_is_dev + + function d_elg_is_host(a) result(res) + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function d_elg_is_host + + function d_elg_is_sync(a) result(res) + implicit none + class(psb_d_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function d_elg_is_sync + + subroutine d_elg_finalize(a) + use elldev_mod + implicit none + type(psb_d_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + return + + end subroutine d_elg_finalize + +#else + + interface + subroutine psb_d_elg_asb(a) + import :: psb_d_elg_sparse_mat + class(psb_d_elg_sparse_mat), intent(inout) :: a + end subroutine psb_d_elg_asb + end interface + + interface + subroutine psb_d_elg_mold(a,b,info) + import :: psb_d_elg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_elg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_elg_mold + end interface + +#endif + +end module psb_d_elg_mat_mod diff --git a/gpu/psb_d_gpu_vect_mod.F90 b/gpu/psb_d_gpu_vect_mod.F90 new file mode 100644 index 000000000..cd3757c34 --- /dev/null +++ b/gpu/psb_d_gpu_vect_mod.F90 @@ -0,0 +1,1989 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_gpu_vect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_d_vect_mod + use psb_i_vect_mod +#ifdef HAVE_SPGPU + use psb_gpu_env_mod + use psb_i_gpu_vect_mod + use psb_i_vectordev_mod + use psb_d_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_d_base_vect_type) :: psb_d_vect_gpu +#ifdef HAVE_SPGPU + integer :: state = is_host + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: pinned_buffer(:) + type(c_ptr) :: dt_p_buf = c_null_ptr + real(c_double), allocatable :: buffer(:) + type(c_ptr) :: dt_buf = c_null_ptr + integer :: dt_buf_sz = 0 + type(c_ptr) :: i_buf = c_null_ptr + integer :: i_buf_sz = 0 + contains + procedure, pass(x) :: get_nrows => d_gpu_get_nrows + procedure, nopass :: get_fmt => d_gpu_get_fmt + + procedure, pass(x) :: all => d_gpu_all + procedure, pass(x) :: zero => d_gpu_zero + procedure, pass(x) :: asb_m => d_gpu_asb_m + procedure, pass(x) :: sync => d_gpu_sync + procedure, pass(x) :: sync_space => d_gpu_sync_space + procedure, pass(x) :: bld_x => d_gpu_bld_x + procedure, pass(x) :: bld_mn => d_gpu_bld_mn + procedure, pass(x) :: free => d_gpu_free + procedure, pass(x) :: ins_a => d_gpu_ins_a + procedure, pass(x) :: ins_v => d_gpu_ins_v + procedure, pass(x) :: is_host => d_gpu_is_host + procedure, pass(x) :: is_dev => d_gpu_is_dev + procedure, pass(x) :: is_sync => d_gpu_is_sync + procedure, pass(x) :: set_host => d_gpu_set_host + procedure, pass(x) :: set_dev => d_gpu_set_dev + procedure, pass(x) :: set_sync => d_gpu_set_sync + procedure, pass(x) :: set_scal => d_gpu_set_scal +!!$ procedure, pass(x) :: set_vect => d_gpu_set_vect + procedure, pass(x) :: gthzv_x => d_gpu_gthzv_x + procedure, pass(y) :: sctb => d_gpu_sctb + procedure, pass(y) :: sctb_x => d_gpu_sctb_x + procedure, pass(x) :: gthzbuf => d_gpu_gthzbuf + procedure, pass(y) :: sctb_buf => d_gpu_sctb_buf + procedure, pass(x) :: new_buffer => d_gpu_new_buffer + procedure, nopass :: device_wait => d_gpu_device_wait + procedure, pass(x) :: free_buffer => d_gpu_free_buffer + procedure, pass(x) :: maybe_free_buffer => d_gpu_maybe_free_buffer + procedure, pass(x) :: dot_v => d_gpu_dot_v + procedure, pass(x) :: dot_a => d_gpu_dot_a + procedure, pass(y) :: axpby_v => d_gpu_axpby_v + procedure, pass(y) :: axpby_a => d_gpu_axpby_a + procedure, pass(y) :: mlt_v => d_gpu_mlt_v + procedure, pass(y) :: mlt_a => d_gpu_mlt_a + procedure, pass(z) :: mlt_a_2 => d_gpu_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => d_gpu_mlt_v_2 + procedure, pass(x) :: scal => d_gpu_scal + procedure, pass(x) :: nrm2 => d_gpu_nrm2 + procedure, pass(x) :: amax => d_gpu_amax + procedure, pass(x) :: asum => d_gpu_asum + procedure, pass(x) :: absval1 => d_gpu_absval1 + procedure, pass(x) :: absval2 => d_gpu_absval2 + + final :: d_gpu_vect_finalize +#endif + end type psb_d_vect_gpu + + public :: psb_d_vect_gpu_ + private :: constructor + interface psb_d_vect_gpu_ + module procedure constructor + end interface psb_d_vect_gpu_ + +contains + + function constructor(x) result(this) + real(psb_dpk_) :: x(:) + type(psb_d_vect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x),info) + + end function constructor + +#ifdef HAVE_SPGPU + + subroutine d_gpu_device_wait() + call psb_cudaSync() + end subroutine d_gpu_device_wait + + subroutine d_gpu_new_buffer(n,x,info) + use psb_realloc_mod + use psb_gpu_env_mod + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + integer(psb_ipk_), intent(out) :: info + + + if (psb_gpu_DeviceHasUVA()) then + if (allocated(x%combuf)) then + if (size(x%combuf) idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + ! + ! Only need a sync in this branch; in the others + ! cudamemCpy acts as a sync point. + ! + if (allocated(x%pinned_buffer)) then + if (size(x%pinned_buffer) < n) then + call inner_unregister(x%pinned_buffer) + deallocate(x%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(x%pinned_buffer)) then + allocate(x%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(x%pinned_buffer,x%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + info = igathMultiVecDeviceDoubleVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_p_buf, 1) + call psb_cudaSync() + y(1:n) = x%pinned_buffer(1:n) + + else + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeDouble(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateDouble(x%dt_buf,n) + x%dt_buf_sz=n + end if + if (info == 0) & + & info = igathMultiVecDeviceDoubleVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_buf, 1) + if (info == 0) & + & info = readDouble(x%dt_buf,y,n) + + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + + if (x%i_buf_sz < ni) then + if (c_associated(x%i_buf)) then + call freeInt(x%i_buf) + x%i_buf = c_null_ptr + end if + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeDouble(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateDouble(x%dt_buf,n) + x%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(x%i_buf,ii%v,ni) + if (info == 0) & + & info = igathMultiVecDeviceDouble(x%deviceVect,& + & 0, n, i, x%i_buf, 1, x%dt_buf, 1) + if (info == 0) & + & info = readDouble(x%dt_buf,y,n) + + end select + + end subroutine d_gpu_gthzv_x + + subroutine d_gpu_gthzbuf(i,n,idx,x) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i,n + class(psb_i_base_vect_type) :: idx + class(psb_d_vect_gpu) :: x + integer :: info, ni + + info = 0 +!!$ write(0,*) 'Starting gth_zbuf' + if (.not.allocated(x%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'gthzbuf') + return + end if + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + info = igathMultiVecDeviceDoubleVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_p_buf, 1) + + else + info = igathMultiVecDeviceDoubleVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_buf, 1) + if (info == 0) & + & info = readDouble(i,x%dt_buf,x%combuf(i:),n,1) + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + info = 0 + if (.not.c_associated(x%i_buf)) then + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,x%i_buf,ii%v(i:),n,1) + + if (info == 0) & + & info = igathMultiVecDeviceDouble(x%deviceVect,& + & 0, n, i, x%i_buf, i,x%dt_buf, 1) + + if (info == 0) & + & info = readDouble(i,x%dt_buf,x%combuf(i:),n,1) + + end select + + end subroutine d_gpu_gthzbuf + + subroutine d_gpu_sctb(n,idx,x,beta,y) + implicit none + !use psb_const_mod + integer(psb_ipk_) :: n, idx(:) + real(psb_dpk_) :: beta, x(:) + class(psb_d_vect_gpu) :: y + integer(psb_ipk_) :: info + + if (n == 0) return + + if (y%is_dev()) call y%sync() + + call y%psb_d_base_vect_type%sctb(n,idx,x,beta) + call y%set_host() + + end subroutine d_gpu_sctb + + subroutine d_gpu_sctb_x(i,n,idx,x,beta,y) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + real(psb_dpk_) :: beta, x(:) + class(psb_d_vect_gpu) :: y + integer :: info, ni + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + + ! + if (psb_gpu_DeviceHasUVA()) then + if (allocated(y%pinned_buffer)) then + if (size(y%pinned_buffer) < n) then + call inner_unregister(y%pinned_buffer) + deallocate(y%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(y%pinned_buffer)) then + allocate(y%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(y%pinned_buffer,y%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + y%pinned_buffer(1:n) = x(1:n) + info = iscatMultiVecDeviceDoubleVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_p_buf, 1,beta) + else + + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeDouble(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateDouble(y%dt_buf,n) + y%dt_buf_sz=n + end if + info = writeDouble(y%dt_buf,x,n) + info = iscatMultiVecDeviceDoubleVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_buf, 1,beta) + + end if + + class default + ni = size(ii%v) + + if (y%i_buf_sz < ni) then + if (c_associated(y%i_buf)) then + call freeInt(y%i_buf) + y%i_buf = c_null_ptr + end if + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeDouble(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateDouble(y%dt_buf,n) + y%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(y%i_buf,ii%v(i:i+n-1),n) + info = writeDouble(y%dt_buf,x,n) + info = iscatMultiVecDeviceDouble(y%deviceVect,& + & 0, n, 1, y%i_buf, 1, y%dt_buf, 1,beta) + + + end select + ! + ! Need a sync here to make sure we are not reallocating + ! the buffers before iscatMulti has finished. + ! + call psb_cudaSync() + call y%set_dev() + + end subroutine d_gpu_sctb_x + + subroutine d_gpu_sctb_buf(i,n,idx,beta,y) + use psi_serial_mod + use psb_gpu_env_mod + implicit none + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + real(psb_dpk_) :: beta + class(psb_d_vect_gpu) :: y + integer(psb_ipk_) :: info, ni + +!!$ write(0,*) 'Starting sctb_buf' + if (.not.allocated(y%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'sctb_buf') + return + end if + + + select type(ii=> idx) + class is (psb_i_vect_gpu) + + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + if (psb_gpu_DeviceHasUVA()) then + info = iscatMultiVecDeviceDoubleVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_p_buf, 1,beta) + else + info = writeDouble(i,y%dt_buf,y%combuf(i:),n,1) + info = iscatMultiVecDeviceDoubleVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_buf, 1,beta) + + end if + + class default + !call y%sct(n,ii%v(i:),x,beta) + ni = size(ii%v) + info = 0 + if (.not.c_associated(y%i_buf)) then + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,y%i_buf,ii%v(i:),n,1) + if (info == 0) & + & info = writeDouble(i,y%dt_buf,y%combuf(i:),n,1) + if (info == 0) info = iscatMultiVecDeviceDouble(y%deviceVect,& + & 0, n, i, y%i_buf, i, y%dt_buf, 1,beta) + end select +!!$ write(0,*) 'Done sctb_buf' + + end subroutine d_gpu_sctb_buf + + + subroutine d_gpu_bld_x(x,this) + use psb_base_mod + real(psb_dpk_), intent(in) :: this(:) + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'d_gpu_bld_x',& + & i_err=(/size(this),izero,izero,izero,izero/)) + end if + x%v(:) = this(:) + call x%set_host() + call x%sync() + + end subroutine d_gpu_bld_x + + subroutine d_gpu_bld_mn(x,n) + integer(psb_mpk_), intent(in) :: n + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(n,info) + if (info /= 0) then + call psb_errpush(info,'d_gpu_bld_n',i_err=(/n,n,n,n,n/)) + end if + + end subroutine d_gpu_bld_mn + + subroutine d_gpu_set_host(x) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine d_gpu_set_host + + subroutine d_gpu_set_dev(x) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine d_gpu_set_dev + + subroutine d_gpu_set_sync(x) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine d_gpu_set_sync + + function d_gpu_is_dev(x) result(res) + implicit none + class(psb_d_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function d_gpu_is_dev + + function d_gpu_is_host(x) result(res) + implicit none + class(psb_d_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function d_gpu_is_host + + function d_gpu_is_sync(x) result(res) + implicit none + class(psb_d_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function d_gpu_is_sync + + + function d_gpu_get_nrows(x) result(res) + implicit none + class(psb_d_vect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = 0 + if (allocated(x%v)) res = size(x%v) + end function d_gpu_get_nrows + + function d_gpu_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'dGPU' + end function d_gpu_get_fmt + + subroutine d_gpu_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: n + class(psb_d_vect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(n,x%v,info) + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'d_gpu_all',& + & i_err=(/n,n,n,n,n/)) + end if + end subroutine d_gpu_all + + subroutine d_gpu_zero(x) + use psi_serial_mod + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine d_gpu_zero + + subroutine d_gpu_asb_m(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_mpk_), intent(in) :: n + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: nd + + if (x%is_dev()) then + nd = getMultiVecDeviceSize(x%deviceVect) + if (nd < n) then + call x%sync() + call x%psb_d_base_vect_type%asb(n,info) + if (info == psb_success_) call x%sync_space(info) + call x%set_host() + end if + else ! + if (x%get_nrows() size(x%v)).or.(n > x%get_nrows())) then +!!$ write(0,*) 'Incoherent situation : sizes',n,size(x%v),x%get_nrows() + call psb_realloc(n,x%v,info) + end if + info = readMultiVecDevice(x%deviceVect,x%v) + end if + if (info == 0) call x%set_sync() + if (info /= 0) then + info=psb_err_internal_error_ + call psb_errpush(info,'d_gpu_sync') + end if + + end subroutine d_gpu_sync + + subroutine d_gpu_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (c_associated(x%deviceVect)) then +!!$ write(0,*)'d_gpu_free Calling freeMultiVecDevice' + call freeMultiVecDevice(x%deviceVect) + x%deviceVect=c_null_ptr + end if + call x%free_buffer(info) + call x%set_sync() + end subroutine d_gpu_free + + subroutine d_gpu_set_scal(x,val,first,last) + class(psb_d_vect_gpu), intent(inout) :: x + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), optional :: first, last + + integer(psb_ipk_) :: info, first_, last_ + + first_ = 1 + last_ = x%get_nrows() + if (present(first)) first_ = max(1,first) + if (present(last)) last_ = min(last,last_) + + if (x%is_host()) call x%sync() + info = setScalDevice(val,first_,last_,1,x%deviceVect) + call x%set_dev() + + end subroutine d_gpu_set_scal +!!$ +!!$ subroutine d_gpu_set_vect(x,val) +!!$ class(psb_d_vect_gpu), intent(inout) :: x +!!$ real(psb_dpk_), intent(in) :: val(:) +!!$ integer(psb_ipk_) :: nr +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_d_base_vect_type%set_vect(val) +!!$ call x%set_host() +!!$ +!!$ end subroutine d_gpu_set_vect + + + + function d_gpu_dot_v(n,x,y) result(res) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + integer(psb_ipk_) :: info + + res = dzero + ! + ! Note: this is the gpu implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_d_vect + ! + select type(yy => y) + type is (psb_d_base_vect_type) + if (x%is_dev()) call x%sync() + res = ddot(n,x%v,1,yy%v,1) + type is (psb_d_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) + if (info /= 0) then + info = psb_err_internal_error_ + call psb_errpush(info,'d_gpu_dot_v') + end if + + class default + ! y%sync is done in dot_a + call x%sync() + res = y%dot(n,x%v) + end select + + end function d_gpu_dot_v + + function d_gpu_dot_a(n,x,y) result(res) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + real(psb_dpk_), intent(in) :: y(:) + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + + if (x%is_dev()) call x%sync() + res = ddot(n,y,1,x%v,1) + + end function d_gpu_dot_a + + subroutine d_gpu_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer(psb_ipk_), intent(in) :: m + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_vect_gpu), intent(inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nx, ny + + info = psb_success_ + + select type(xx => x) + type is (psb_d_vect_gpu) + ! Do something different here + if ((beta /= dzero).and.y%is_host())& + & call y%sync() + if (xx%is_host()) call xx%sync() + nx = getMultiVecDeviceSize(xx%deviceVect) + ny = getMultiVecDeviceSize(y%deviceVect) + if ((nx x) + type is (psb_d_base_vect_type) + if (y%is_dev()) call y%sync() + do i=1, n + y%v(i) = y%v(i) * xx%v(i) + end do + call y%set_host() + type is (psb_d_vect_gpu) + ! Do something different here + if (y%is_host()) call y%sync() + if (xx%is_host()) call xx%sync() + info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) + call y%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (y%is_dev()) call y%sync() + call y%mlt(xx%v,info) + call y%set_host() + end select + + end subroutine d_gpu_mlt_v + + subroutine d_gpu_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_vect_gpu), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + call y%psb_d_base_vect_type%mlt(x,info) + ! set_host() is invoked in the base method + end subroutine d_gpu_mlt_a + + subroutine d_gpu_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: x(:) + real(psb_dpk_), intent(in) :: y(:) + class(psb_d_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (z%is_dev()) call z%sync() + call z%psb_d_base_vect_type%mlt(alpha,x,y,beta,info) + ! set_host() is invoked in the base method + end subroutine d_gpu_mlt_a_2 + + subroutine d_gpu_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + class(psb_d_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer(psb_ipk_) :: i, n + logical :: conjgx_, conjgy_ + + if (.false.) then + ! These are present just for coherence with the + ! complex versions; they do nothing here. + conjgx_=.false. + if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') + conjgy_=.false. + if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') + end if + + n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) + + ! + ! Need to reconsider BETA in the GPU side + ! of things. + ! + info = 0 + select type(xx => x) + type is (psb_d_vect_gpu) + select type (yy => y) + type is (psb_d_vect_gpu) + if (xx%is_host()) call xx%sync() + if (yy%is_host()) call yy%sync() + if ((beta /= dzero).and.(z%is_host())) call z%sync() + info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& + & yy%deviceVect,beta,z%deviceVect) + call z%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (yy%is_dev()) call yy%sync() + if ((beta /= dzero).and.(z%is_dev())) call z%sync() + call z%psb_d_base_vect_type%mlt(alpha,xx,yy,beta,info) + call z%set_host() + end select + + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + if ((beta /= dzero).and.(z%is_dev())) call z%sync() + call z%psb_d_base_vect_type%mlt(alpha,x,y,beta,info) + call z%set_host() + end select + end subroutine d_gpu_mlt_v_2 + + subroutine d_gpu_scal(alpha, x) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + real(psb_dpk_), intent (in) :: alpha + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = scalMultiVecDevice(alpha,x%deviceVect) + call x%set_dev() + end subroutine d_gpu_scal + + + function d_gpu_nrm2(n,x) result(res) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + ! WARNING: this should be changed. + if (x%is_host()) call x%sync() + info = nrm2MultiVecDevice(res,n,x%deviceVect) + + end function d_gpu_nrm2 + + function d_gpu_amax(n,x) result(res) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = amaxMultiVecDevice(res,n,x%deviceVect) + + end function d_gpu_amax + + function d_gpu_asum(n,x) result(res) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = asumMultiVecDevice(res,n,x%deviceVect) + + end function d_gpu_asum + + subroutine d_gpu_absval1(x) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + n=x%get_nrows() + info = absMultiVecDevice(n,done,x%deviceVect) + + end subroutine d_gpu_absval1 + + subroutine d_gpu_absval2(x,y) + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + n=min(x%get_nrows(),y%get_nrows()) + select type (yy=> y) + class is (psb_d_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = absMultiVecDevice(n,done,x%deviceVect,yy%deviceVect) + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + call x%psb_d_base_vect_type%absval(y) + end select + end subroutine d_gpu_absval2 + + + subroutine d_gpu_vect_finalize(x) + use psi_serial_mod + use psb_realloc_mod + implicit none + type(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + info = 0 + call x%free(info) + end subroutine d_gpu_vect_finalize + + subroutine d_gpu_ins_v(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + class(psb_i_base_vect_type), intent(inout) :: irl + class(psb_d_base_vect_type), intent(inout) :: val + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i, isz + logical :: done_gpu + + info = 0 + if (psb_errstatus_fatal()) return + + done_gpu = .false. + select type(virl => irl) + class is (psb_i_vect_gpu) + select type(vval => val) + class is (psb_d_vect_gpu) + if (vval%is_host()) call vval%sync() + if (virl%is_host()) call virl%sync() + if (x%is_host()) call x%sync() + info = geinsMultiVecDeviceDouble(n,virl%deviceVect,& + & vval%deviceVect,dupl,1,x%deviceVect) + call x%set_dev() + done_gpu=.true. + end select + end select + + if (.not.done_gpu) then + if (irl%is_dev()) call irl%sync() + if (val%is_dev()) call val%sync() + call x%ins(n,irl%v,val%v,dupl,info) + end if + + if (info /= 0) then + call psb_errpush(info,'gpu_vect_ins') + return + end if + + end subroutine d_gpu_ins_v + + subroutine d_gpu_ins_a(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_d_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + integer(psb_ipk_), intent(in) :: irl(:) + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i + + info = 0 + if (x%is_dev()) call x%sync() + call x%psb_d_base_vect_type%ins(n,irl,val,dupl,info) + call x%set_host() + + end subroutine d_gpu_ins_a + +#endif + +end module psb_d_gpu_vect_mod + + +! +! Multivectors +! + + + +module psb_d_gpu_multivect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_d_multivect_mod + use psb_d_base_multivect_mod + + use psb_i_multivect_mod +#ifdef HAVE_SPGPU + use psb_i_gpu_multivect_mod + use psb_d_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_d_base_multivect_type) :: psb_d_multivect_gpu +#ifdef HAVE_SPGPU + + integer(psb_ipk_) :: state = is_host, m_nrows=0, m_ncols=0 + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: buffer(:,:) + type(c_ptr) :: dt_buf = c_null_ptr + contains + procedure, pass(x) :: get_nrows => d_gpu_multi_get_nrows + procedure, pass(x) :: get_ncols => d_gpu_multi_get_ncols + procedure, nopass :: get_fmt => d_gpu_multi_get_fmt +!!$ procedure, pass(x) :: dot_v => d_gpu_multi_dot_v +!!$ procedure, pass(x) :: dot_a => d_gpu_multi_dot_a +!!$ procedure, pass(y) :: axpby_v => d_gpu_multi_axpby_v +!!$ procedure, pass(y) :: axpby_a => d_gpu_multi_axpby_a +!!$ procedure, pass(y) :: mlt_v => d_gpu_multi_mlt_v +!!$ procedure, pass(y) :: mlt_a => d_gpu_multi_mlt_a +!!$ procedure, pass(z) :: mlt_a_2 => d_gpu_multi_mlt_a_2 +!!$ procedure, pass(z) :: mlt_v_2 => d_gpu_multi_mlt_v_2 +!!$ procedure, pass(x) :: scal => d_gpu_multi_scal +!!$ procedure, pass(x) :: nrm2 => d_gpu_multi_nrm2 +!!$ procedure, pass(x) :: amax => d_gpu_multi_amax +!!$ procedure, pass(x) :: asum => d_gpu_multi_asum + procedure, pass(x) :: all => d_gpu_multi_all + procedure, pass(x) :: zero => d_gpu_multi_zero + procedure, pass(x) :: asb => d_gpu_multi_asb + procedure, pass(x) :: sync => d_gpu_multi_sync + procedure, pass(x) :: sync_space => d_gpu_multi_sync_space + procedure, pass(x) :: bld_x => d_gpu_multi_bld_x + procedure, pass(x) :: bld_n => d_gpu_multi_bld_n + procedure, pass(x) :: free => d_gpu_multi_free + procedure, pass(x) :: ins => d_gpu_multi_ins + procedure, pass(x) :: is_host => d_gpu_multi_is_host + procedure, pass(x) :: is_dev => d_gpu_multi_is_dev + procedure, pass(x) :: is_sync => d_gpu_multi_is_sync + procedure, pass(x) :: set_host => d_gpu_multi_set_host + procedure, pass(x) :: set_dev => d_gpu_multi_set_dev + procedure, pass(x) :: set_sync => d_gpu_multi_set_sync + procedure, pass(x) :: set_scal => d_gpu_multi_set_scal + procedure, pass(x) :: set_vect => d_gpu_multi_set_vect +!!$ procedure, pass(x) :: gthzv_x => d_gpu_multi_gthzv_x +!!$ procedure, pass(y) :: sctb => d_gpu_multi_sctb +!!$ procedure, pass(y) :: sctb_x => d_gpu_multi_sctb_x + final :: d_gpu_multi_vect_finalize +#endif + end type psb_d_multivect_gpu + + public :: psb_d_multivect_gpu + private :: constructor + interface psb_d_multivect_gpu + module procedure constructor + end interface + +contains + + function constructor(x) result(this) + real(psb_dpk_) :: x(:,:) + type(psb_d_multivect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x,1),size(x,2),info) + + end function constructor + +#ifdef HAVE_SPGPU + +!!$ subroutine d_gpu_multi_gthzv_x(i,n,idx,x,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i,n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ real(psb_dpk_) :: y(:) +!!$ class(psb_d_multivect_gpu) :: x +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (x%is_host()) call x%sync() +!!$ +!!$ if (allocated(x%buffer)) then +!!$ if (size(x%buffer) < n) then +!!$ call inner_unregister(x%buffer) +!!$ deallocate(x%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(x%buffer)) then +!!$ allocate(x%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(x%buffer,x%dt_buf) +!!$ endif +!!$ info = igathMultiVecDeviceDouble(x%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, x%dt_buf, 1) +!!$ call psb_cudaSync() +!!$ y(1:n) = x%buffer(1:n) +!!$ +!!$ class default +!!$ call x%gth(n,ii%v(i:),y) +!!$ end select +!!$ +!!$ +!!$ end subroutine d_gpu_multi_gthzv_x +!!$ +!!$ +!!$ +!!$ subroutine d_gpu_multi_sctb(n,idx,x,beta,y) +!!$ implicit none +!!$ !use psb_const_mod +!!$ integer(psb_ipk_) :: n, idx(:) +!!$ real(psb_dpk_) :: beta, x(:) +!!$ class(psb_d_multivect_gpu) :: y +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (n == 0) return +!!$ +!!$ if (y%is_dev()) call y%sync() +!!$ +!!$ call y%psb_d_base_multivect_type%sctb(n,idx,x,beta) +!!$ call y%set_host() +!!$ +!!$ end subroutine d_gpu_multi_sctb +!!$ +!!$ subroutine d_gpu_multi_sctb_x(i,n,idx,x,beta,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i, n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ real(psb_dpk_) :: beta, x(:) +!!$ class(psb_d_multivect_gpu) :: y +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (y%is_host()) call y%sync() +!!$ +!!$ if (allocated(y%buffer)) then +!!$ if (size(y%buffer) < n) then +!!$ call inner_unregister(y%buffer) +!!$ deallocate(y%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(y%buffer)) then +!!$ allocate(y%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(y%buffer,y%dt_buf) +!!$ endif +!!$ y%buffer(1:n) = x(1:n) +!!$ info = iscatMultiVecDeviceDouble(y%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, y%dt_buf, 1,beta) +!!$ +!!$ call y%set_dev() +!!$ call psb_cudaSync() +!!$ +!!$ class default +!!$ call y%sct(n,ii%v(i:),x,beta) +!!$ end select +!!$ +!!$ end subroutine d_gpu_multi_sctb_x + + + subroutine d_gpu_multi_bld_x(x,this) + use psb_base_mod + real(psb_dpk_), intent(in) :: this(:,:) + class(psb_d_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info, m, n + + m=size(this,1) + n=size(this,2) + x%m_nrows = m + x%m_ncols = n + call psb_realloc(m,n,x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'d_gpu_multi_bld_x',& + & i_err=(/size(this,1),size(this,2),izero,izero,izero,izero/)) + end if + x%v(1:m,1:n) = this(1:m,1:n) + call x%set_host() + call x%sync() + + end subroutine d_gpu_multi_bld_x + + subroutine d_gpu_multi_bld_n(x,m,n) + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(m,n,info) + if (info /= 0) then + call psb_errpush(info,'d_gpu_multi_bld_n',i_err=(/m,n,n,n,n/)) + end if + + end subroutine d_gpu_multi_bld_n + + + subroutine d_gpu_multi_set_host(x) + implicit none + class(psb_d_multivect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine d_gpu_multi_set_host + + subroutine d_gpu_multi_set_dev(x) + implicit none + class(psb_d_multivect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine d_gpu_multi_set_dev + + subroutine d_gpu_multi_set_sync(x) + implicit none + class(psb_d_multivect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine d_gpu_multi_set_sync + + function d_gpu_multi_is_dev(x) result(res) + implicit none + class(psb_d_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function d_gpu_multi_is_dev + + function d_gpu_multi_is_host(x) result(res) + implicit none + class(psb_d_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function d_gpu_multi_is_host + + function d_gpu_multi_is_sync(x) result(res) + implicit none + class(psb_d_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function d_gpu_multi_is_sync + + + function d_gpu_multi_get_nrows(x) result(res) + implicit none + class(psb_d_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_nrows + + end function d_gpu_multi_get_nrows + + function d_gpu_multi_get_ncols(x) result(res) + implicit none + class(psb_d_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_ncols + + end function d_gpu_multi_get_ncols + + function d_gpu_multi_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'dGPU' + end function d_gpu_multi_get_fmt + +!!$ function d_gpu_multi_dot_v(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ class(psb_d_base_multivect_type), intent(inout) :: y +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ real(psb_dpk_), external :: ddot +!!$ integer(psb_ipk_) :: info +!!$ +!!$ res = dzero +!!$ ! +!!$ ! Note: this is the gpu implementation. +!!$ ! When we get here, we are sure that X is of +!!$ ! TYPE psb_d_vect +!!$ ! +!!$ select type(yy => y) +!!$ type is (psb_d_base_multivect_type) +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,x%v,1,yy%v,1) +!!$ type is (psb_d_multivect_gpu) +!!$ if (x%is_host()) call x%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) +!!$ if (info /= 0) then +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,'d_gpu_multi_dot_v') +!!$ end if +!!$ +!!$ class default +!!$ ! y%sync is done in dot_a +!!$ call x%sync() +!!$ res = y%dot(n,x%v) +!!$ end select +!!$ +!!$ end function d_gpu_multi_dot_v +!!$ +!!$ function d_gpu_multi_dot_a(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ real(psb_dpk_), intent(in) :: y(:) +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ real(psb_dpk_), external :: ddot +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,y,1,x%v,1) +!!$ +!!$ end function d_gpu_multi_dot_a +!!$ +!!$ subroutine d_gpu_multi_axpby_v(m,alpha, x, beta, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: m +!!$ class(psb_d_base_multivect_type), intent(inout) :: x +!!$ class(psb_d_multivect_gpu), intent(inout) :: y +!!$ real(psb_dpk_), intent (in) :: alpha, beta +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: nx, ny +!!$ +!!$ info = psb_success_ +!!$ +!!$ select type(xx => x) +!!$ type is (psb_d_base_multivect_type) +!!$ if ((beta /= dzero).and.(y%is_dev()))& +!!$ & call y%sync() +!!$ call psb_geaxpby(m,alpha,xx%v,beta,y%v,info) +!!$ call y%set_host() +!!$ type is (psb_d_multivect_gpu) +!!$ ! Do something different here +!!$ if ((beta /= dzero).and.y%is_host())& +!!$ & call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ nx = getMultiVecDeviceSize(xx%deviceVect) +!!$ ny = getMultiVecDeviceSize(y%deviceVect) +!!$ if ((nx x) +!!$ type is (psb_d_base_multivect_type) +!!$ if (y%is_dev()) call y%sync() +!!$ do i=1, n +!!$ y%v(i) = y%v(i) * xx%v(i) +!!$ end do +!!$ call y%set_host() +!!$ type is (psb_d_multivect_gpu) +!!$ ! Do something different here +!!$ if (y%is_host()) call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) +!!$ call y%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call y%mlt(xx%v,info) +!!$ call y%set_host() +!!$ end select +!!$ +!!$ end subroutine d_gpu_multi_mlt_v +!!$ +!!$ subroutine d_gpu_multi_mlt_a(x, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ real(psb_dpk_), intent(in) :: x(:) +!!$ class(psb_d_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ call y%sync() +!!$ call y%psb_d_base_multivect_type%mlt(x,info) +!!$ call y%set_host() +!!$ end subroutine d_gpu_multi_mlt_a +!!$ +!!$ subroutine d_gpu_multi_mlt_a_2(alpha,x,y,beta,z,info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ real(psb_dpk_), intent(in) :: alpha,beta +!!$ real(psb_dpk_), intent(in) :: x(:) +!!$ real(psb_dpk_), intent(in) :: y(:) +!!$ class(psb_d_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ if (z%is_dev()) call z%sync() +!!$ call z%psb_d_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end subroutine d_gpu_multi_mlt_a_2 +!!$ +!!$ subroutine d_gpu_multi_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) +!!$ use psi_serial_mod +!!$ use psb_string_mod +!!$ implicit none +!!$ real(psb_dpk_), intent(in) :: alpha,beta +!!$ class(psb_d_base_multivect_type), intent(inout) :: x +!!$ class(psb_d_base_multivect_type), intent(inout) :: y +!!$ class(psb_d_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character(len=1), intent(in), optional :: conjgx, conjgy +!!$ integer(psb_ipk_) :: i, n +!!$ logical :: conjgx_, conjgy_ +!!$ +!!$ if (.false.) then +!!$ ! These are present just for coherence with the +!!$ ! complex versions; they do nothing here. +!!$ conjgx_=.false. +!!$ if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') +!!$ conjgy_=.false. +!!$ if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') +!!$ end if +!!$ +!!$ n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) +!!$ +!!$ ! +!!$ ! Need to reconsider BETA in the GPU side +!!$ ! of things. +!!$ ! +!!$ info = 0 +!!$ select type(xx => x) +!!$ type is (psb_d_multivect_gpu) +!!$ select type (yy => y) +!!$ type is (psb_d_multivect_gpu) +!!$ if (xx%is_host()) call xx%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ ! Z state is irrelevant: it will be done on the GPU. +!!$ info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& +!!$ & yy%deviceVect,beta,z%deviceVect) +!!$ call z%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call yy%sync() +!!$ call z%psb_d_base_multivect_type%mlt(alpha,xx,yy,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ +!!$ class default +!!$ call x%sync() +!!$ call y%sync() +!!$ call z%psb_d_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ end subroutine d_gpu_multi_mlt_v_2 + + + subroutine d_gpu_multi_set_scal(x,val) + class(psb_d_multivect_gpu), intent(inout) :: x + real(psb_dpk_), intent(in) :: val + + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_d_base_multivect_type%set_scal(val) + call x%set_host() + end subroutine d_gpu_multi_set_scal + + subroutine d_gpu_multi_set_vect(x,val) + class(psb_d_multivect_gpu), intent(inout) :: x + real(psb_dpk_), intent(in) :: val(:,:) + integer(psb_ipk_) :: nr + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_d_base_multivect_type%set_vect(val) + call x%set_host() + + end subroutine d_gpu_multi_set_vect + + + +!!$ subroutine d_gpu_multi_scal(alpha, x) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ real(psb_dpk_), intent (in) :: alpha +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_d_base_multivect_type%scal(alpha) +!!$ call x%set_host() +!!$ end subroutine d_gpu_multi_scal +!!$ +!!$ +!!$ function d_gpu_multi_nrm2(n,x) result(res) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ integer(psb_ipk_) :: info +!!$ ! WARNING: this should be changed. +!!$ if (x%is_host()) call x%sync() +!!$ info = nrm2MultiVecDevice(res,n,x%deviceVect) +!!$ +!!$ end function d_gpu_multi_nrm2 +!!$ +!!$ function d_gpu_multi_amax(n,x) result(res) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = maxval(abs(x%v(1:n))) +!!$ +!!$ end function d_gpu_multi_amax +!!$ +!!$ function d_gpu_multi_asum(n,x) result(res) +!!$ implicit none +!!$ class(psb_d_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = sum(abs(x%v(1:n))) +!!$ +!!$ end function d_gpu_multi_asum + + subroutine d_gpu_multi_all(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_multivect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(m,n,x%v,info,pad=dzero) + x%m_nrows = m + x%m_ncols = n + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'d_gpu_multi_all',& + & i_err=(/m,n,n,n,n/)) + end if + end subroutine d_gpu_multi_all + + subroutine d_gpu_multi_zero(x) + use psi_serial_mod + implicit none + class(psb_d_multivect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine d_gpu_multi_zero + + subroutine d_gpu_multi_asb(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nd, nc + + + x%m_nrows = m + x%m_ncols = n + if (x%is_host()) then + call x%psb_d_base_multivect_type%asb(m,n,info) + if (info == psb_success_) call x%sync_space(info) + else if (x%is_dev()) then + nd = getMultiVecDevicePitch(x%deviceVect) + nc = getMultiVecDeviceCount(x%deviceVect) + if ((nd < m).or.(nc d_hdiag_get_fmt + ! procedure, pass(a) :: sizeof => d_hdiag_sizeof + procedure, pass(a) :: vect_mv => psb_d_hdiag_vect_mv + ! procedure, pass(a) :: csmm => psb_d_hdiag_csmm + procedure, pass(a) :: csmv => psb_d_hdiag_csmv + ! procedure, pass(a) :: in_vect_sv => psb_d_hdiag_inner_vect_sv + ! procedure, pass(a) :: scals => psb_d_hdiag_scals + ! procedure, pass(a) :: scalv => psb_d_hdiag_scal + ! procedure, pass(a) :: reallocate_nz => psb_d_hdiag_reallocate_nz + ! procedure, pass(a) :: allocate_mnnz => psb_d_hdiag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_hdiag_from_coo + ! procedure, pass(a) :: cp_from_fmt => psb_d_cp_hdiag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_hdiag_from_coo + ! procedure, pass(a) :: mv_from_fmt => psb_d_mv_hdiag_from_fmt + procedure, pass(a) :: free => d_hdiag_free + procedure, pass(a) :: mold => psb_d_hdiag_mold + procedure, pass(a) :: to_gpu => psb_d_hdiag_to_gpu + final :: d_hdiag_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_hdiag_mold +#endif + end type psb_d_hdiag_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_hdiag_get_nzeros, d_hdiag_free, d_hdiag_get_fmt, & + & d_hdiag_get_size, d_hdiag_sizeof, d_hdiag_get_nz_row + + + interface + subroutine psb_d_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hdiag_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hdiag_vect_mv + end interface + +!!$ interface +!!$ subroutine psb_d_hdiag_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_d_hdiag_sparse_mat, psb_dpk_, psb_d_base_vect_type +!!$ class(psb_d_hdiag_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_d_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_hdiag_inner_vect_sv +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdiag_reallocate_nz(nz,a) +!!$ import :: psb_d_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_d_hdiag_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdiag_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_d_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_d_hdiag_allocate_mnnz +!!$ end interface + + interface + subroutine psb_d_hdiag_mold(a,b,info) + import :: psb_d_hdiag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hdiag_mold + end interface + + interface + subroutine psb_d_hdiag_to_gpu(a,info) + import :: psb_d_hdiag_sparse_mat, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hdiag_to_gpu + end interface + + interface + subroutine psb_d_cp_hdiag_from_coo(a,b,info) + import :: psb_d_hdiag_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hdiag_from_coo + end interface + +!!$ interface +!!$ subroutine psb_d_cp_hdiag_from_fmt(a,b,info) +!!$ import :: psb_d_hdiag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_d_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_cp_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_d_mv_hdiag_from_coo(a,b,info) + import :: psb_d_hdiag_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hdiag_from_coo + end interface + +!!$ +!!$ interface +!!$ subroutine psb_d_mv_hdiag_from_fmt(a,b,info) +!!$ import :: psb_d_hdiag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_d_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_mv_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_d_hdiag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hdiag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hdiag_csmv + end interface + +!!$ interface +!!$ subroutine psb_d_hdiag_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdiag_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_hdiag_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdiag_scal(d,a,info, side) +!!$ import :: psb_d_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_d_hdiag_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdiag_scals(d,a,info) +!!$ import :: psb_d_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdiag_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_hdiag_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + function d_hdiag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIAG' + end function d_hdiag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_hdiag_free(a) + use hdiagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_d_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_hdia_sparse_mat%free() + + return + + end subroutine d_hdiag_free + + subroutine d_hdiag_finalize(a) + use hdiagdev_mod + implicit none + type(psb_d_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_hdia_sparse_mat%free() + + return + end subroutine d_hdiag_finalize + +#else + + interface + subroutine psb_d_hdiag_mold(a,b,info) + import :: psb_d_hdiag_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hdiag_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hdiag_mold + end interface + +#endif + +end module psb_d_hdiag_mat_mod diff --git a/gpu/psb_d_hlg_mat_mod.F90 b/gpu/psb_d_hlg_mat_mod.F90 new file mode 100644 index 000000000..756d13aae --- /dev/null +++ b/gpu/psb_d_hlg_mat_mod.F90 @@ -0,0 +1,398 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_hlg_mat_mod + + use iso_c_binding + use psb_d_mat_mod + use psb_d_hll_mat_mod + + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_d_hll_sparse_mat) :: psb_d_hlg_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer :: devstate = is_host + + contains + procedure, nopass :: get_fmt => d_hlg_get_fmt + procedure, pass(a) :: sizeof => d_hlg_sizeof + procedure, pass(a) :: vect_mv => psb_d_hlg_vect_mv + procedure, pass(a) :: csmm => psb_d_hlg_csmm + procedure, pass(a) :: csmv => psb_d_hlg_csmv + procedure, pass(a) :: in_vect_sv => psb_d_hlg_inner_vect_sv + procedure, pass(a) :: scals => psb_d_hlg_scals + procedure, pass(a) :: scalv => psb_d_hlg_scal + procedure, pass(a) :: reallocate_nz => psb_d_hlg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_hlg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_hlg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_d_cp_hlg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_hlg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_d_mv_hlg_from_fmt + procedure, pass(a) :: free => d_hlg_free + procedure, pass(a) :: mold => psb_d_hlg_mold + procedure, pass(a) :: is_host => d_hlg_is_host + procedure, pass(a) :: is_dev => d_hlg_is_dev + procedure, pass(a) :: is_sync => d_hlg_is_sync + procedure, pass(a) :: set_host => d_hlg_set_host + procedure, pass(a) :: set_dev => d_hlg_set_dev + procedure, pass(a) :: set_sync => d_hlg_set_sync + procedure, pass(a) :: sync => d_hlg_sync + procedure, pass(a) :: from_gpu => psb_d_hlg_from_gpu + procedure, pass(a) :: to_gpu => psb_d_hlg_to_gpu + final :: d_hlg_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_hlg_mold +#endif + end type psb_d_hlg_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_hlg_get_nzeros, d_hlg_free, d_hlg_get_fmt, & + & d_hlg_get_size, d_hlg_sizeof, d_hlg_get_nz_row + + + interface + subroutine psb_d_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hlg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hlg_vect_mv + end interface + + interface + subroutine psb_d_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_d_hlg_sparse_mat, psb_dpk_, psb_d_base_vect_type + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hlg_inner_vect_sv + end interface + + interface + subroutine psb_d_hlg_reallocate_nz(nz,a) + import :: psb_d_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hlg_sparse_mat), intent(inout) :: a + end subroutine psb_d_hlg_reallocate_nz + end interface + + interface + subroutine psb_d_hlg_allocate_mnnz(m,n,a,nz) + import :: psb_d_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_hlg_allocate_mnnz + end interface + + interface + subroutine psb_d_hlg_mold(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hlg_mold + end interface + + interface + subroutine psb_d_hlg_from_gpu(a,info) + import :: psb_d_hlg_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hlg_from_gpu + end interface + + interface + subroutine psb_d_hlg_to_gpu(a,info, nzrm) + import :: psb_d_hlg_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_d_hlg_to_gpu + end interface + + interface + subroutine psb_d_cp_hlg_from_coo(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hlg_from_coo + end interface + + interface + subroutine psb_d_cp_hlg_from_fmt(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hlg_from_fmt + end interface + + interface + subroutine psb_d_mv_hlg_from_coo(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hlg_from_coo + end interface + + + interface + subroutine psb_d_mv_hlg_from_fmt(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hlg_from_fmt + end interface + + interface + subroutine psb_d_hlg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hlg_csmv + end interface + interface + subroutine psb_d_hlg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hlg_csmm + end interface + + interface + subroutine psb_d_hlg_scal(d,a,info, side) + import :: psb_d_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_hlg_scal + end interface + + interface + subroutine psb_d_hlg_scals(d,a,info) + import :: psb_d_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hlg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_hlg_sizeof(a) result(res) + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%hkoffs) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function d_hlg_sizeof + + function d_hlg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLG' + end function d_hlg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_hlg_free(a) + use hlldev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_d_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_d_hll_sparse_mat%free() + + return + + end subroutine d_hlg_free + + + subroutine d_hlg_sync(a) + implicit none + class(psb_d_hlg_sparse_mat), target, intent(in) :: a + class(psb_d_hlg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine d_hlg_sync + + subroutine d_hlg_set_host(a) + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine d_hlg_set_host + + subroutine d_hlg_set_dev(a) + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine d_hlg_set_dev + + subroutine d_hlg_set_sync(a) + implicit none + class(psb_d_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine d_hlg_set_sync + + function d_hlg_is_dev(a) result(res) + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function d_hlg_is_dev + + function d_hlg_is_host(a) result(res) + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function d_hlg_is_host + + function d_hlg_is_sync(a) result(res) + implicit none + class(psb_d_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function d_hlg_is_sync + + + subroutine d_hlg_finalize(a) + use hlldev_mod + implicit none + type(psb_d_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine d_hlg_finalize + +#else + + interface + subroutine psb_d_hlg_mold(a,b,info) + import :: psb_d_hlg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hlg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hlg_mold + end interface + +#endif + +end module psb_d_hlg_mat_mod diff --git a/gpu/psb_d_hybg_mat_mod.F90 b/gpu/psb_d_hybg_mat_mod.F90 new file mode 100644 index 000000000..d764daa71 --- /dev/null +++ b/gpu/psb_d_hybg_mat_mod.F90 @@ -0,0 +1,306 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +#if CUDA_SHORT_VERSION <= 10 + +module psb_d_hybg_mat_mod + + use iso_c_binding + use psb_d_mat_mod + use cusparse_mod + + type, extends(psb_d_csr_sparse_mat) :: psb_d_hybg_sparse_mat + ! + ! HYBG. An interface to the cuSPARSE HYB + ! On the CPU side we keep a CSR storage. + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(d_Hmat) :: deviceMat + + contains + procedure, nopass :: get_fmt => d_hybg_get_fmt + procedure, pass(a) :: sizeof => d_hybg_sizeof + procedure, pass(a) :: vect_mv => psb_d_hybg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_d_hybg_inner_vect_sv + procedure, pass(a) :: csmm => psb_d_hybg_csmm + procedure, pass(a) :: csmv => psb_d_hybg_csmv + procedure, pass(a) :: scals => psb_d_hybg_scals + procedure, pass(a) :: scalv => psb_d_hybg_scal + procedure, pass(a) :: reallocate_nz => psb_d_hybg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_hybg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_d_cp_hybg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_d_cp_hybg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_d_mv_hybg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_d_mv_hybg_from_fmt + procedure, pass(a) :: free => d_hybg_free + procedure, pass(a) :: mold => psb_d_hybg_mold + procedure, pass(a) :: to_gpu => psb_d_hybg_to_gpu + final :: d_hybg_finalize +#else + contains + procedure, pass(a) :: mold => psb_d_hybg_mold +#endif + end type psb_d_hybg_sparse_mat + +#ifdef HAVE_SPGPU + private :: d_hybg_get_nzeros, d_hybg_free, d_hybg_get_fmt, & + & d_hybg_get_size, d_hybg_sizeof, d_hybg_get_nz_row + + + interface + subroutine psb_d_hybg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hybg_inner_vect_sv + end interface + + interface + subroutine psb_d_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_d_base_vect_type, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hybg_vect_mv + end interface + + interface + subroutine psb_d_hybg_reallocate_nz(nz,a) + import :: psb_d_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hybg_sparse_mat), intent(inout) :: a + end subroutine psb_d_hybg_reallocate_nz + end interface + + interface + subroutine psb_d_hybg_allocate_mnnz(m,n,a,nz) + import :: psb_d_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_hybg_allocate_mnnz + end interface + + interface + subroutine psb_d_hybg_mold(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hybg_mold + end interface + + interface + subroutine psb_d_hybg_to_gpu(a,info, nzrm) + import :: psb_d_hybg_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_d_hybg_to_gpu + end interface + + interface + subroutine psb_d_cp_hybg_from_coo(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hybg_from_coo + end interface + + interface + subroutine psb_d_cp_hybg_from_fmt(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hybg_from_fmt + end interface + + interface + subroutine psb_d_mv_hybg_from_coo(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hybg_from_coo + end interface + + interface + subroutine psb_d_mv_hybg_from_fmt(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hybg_from_fmt + end interface + + interface + subroutine psb_d_hybg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hybg_csmv + end interface + interface + subroutine psb_d_hybg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hybg_csmm + end interface + + interface + subroutine psb_d_hybg_scal(d,a,info,side) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_hybg_scal + end interface + + interface + subroutine psb_d_hybg_scals(d,a,info) + import :: psb_d_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hybg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_hybg_sizeof(a) result(res) + implicit none + class(psb_d_hybg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function d_hybg_sizeof + + function d_hybg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HYBG' + end function d_hybg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_hybg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + class(psb_d_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + call a%psb_d_csr_sparse_mat%free() + + return + + end subroutine d_hybg_free + + subroutine d_hybg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + type(psb_d_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + + return + end subroutine d_hybg_finalize + +#else + + interface + subroutine psb_d_hybg_mold(a,b,info) + import :: psb_d_hybg_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hybg_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hybg_mold + end interface + +#endif + +end module psb_d_hybg_mat_mod +#endif diff --git a/gpu/psb_d_vectordev_mod.F90 b/gpu/psb_d_vectordev_mod.F90 new file mode 100644 index 000000000..cda0d9d7d --- /dev/null +++ b/gpu/psb_d_vectordev_mod.F90 @@ -0,0 +1,390 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_d_vectordev_mod + + use psb_base_vectordev_mod + +#ifdef HAVE_SPGPU + + interface registerMapped + function registerMappedDouble(buf,d_p,n,dummy) & + & result(res) bind(c,name='registerMappedDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: buf + type(c_ptr) :: d_p + integer(c_int),value :: n + real(c_double), value :: dummy + end function registerMappedDouble + end interface + + interface writeMultiVecDevice + function writeMultiVecDeviceDouble(deviceVec,hostVec) & + & result(res) bind(c,name='writeMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + real(c_double) :: hostVec(*) + end function writeMultiVecDeviceDouble + function writeMultiVecDeviceDoubleR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='writeMultiVecDeviceDoubleR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + real(c_double) :: hostVec(ld,*) + end function writeMultiVecDeviceDoubleR2 + end interface + + interface readMultiVecDevice + function readMultiVecDeviceDouble(deviceVec,hostVec) & + & result(res) bind(c,name='readMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + real(c_double) :: hostVec(*) + end function readMultiVecDeviceDouble + function readMultiVecDeviceDoubleR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='readMultiVecDeviceDoubleR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + real(c_double) :: hostVec(ld,*) + end function readMultiVecDeviceDoubleR2 + end interface + + interface allocateDouble + function allocateDouble(didx,n) & + & result(res) bind(c,name='allocateDouble') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: n + integer(c_int) :: res + end function allocateDouble + function allocateMultiDouble(didx,m,n) & + & result(res) bind(c,name='allocateMultiDouble') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: m,n + integer(c_int) :: res + end function allocateMultiDouble + end interface + + interface writeDouble + function writeDouble(didx,hidx,n) & + & result(res) bind(c,name='writeDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(*) + integer(c_int),value :: n + end function writeDouble + function writeDoubleFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='writeDoubleFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function writeDoubleFirst + function writeMultiDouble(didx,hidx,m,n) & + & result(res) bind(c,name='writeMultiDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(m,*) + integer(c_int),value :: m,n + end function writeMultiDouble + end interface + + interface readDouble + function readDouble(didx,hidx,n) & + & result(res) bind(c,name='readDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(*) + integer(c_int),value :: n + end function readDouble + function readDoubleFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='readDoubleFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function readDoubleFirst + function readMultiDouble(didx,hidx,m,n) & + & result(res) bind(c,name='readMultiDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_double) :: hidx(m,*) + integer(c_int),value :: m,n + end function readMultiDouble + end interface + + interface + subroutine freeDouble(didx) & + & bind(c,name='freeDouble') + use iso_c_binding + type(c_ptr), value :: didx + end subroutine freeDouble + end interface + + + interface setScalDevice + function setScalMultiVecDeviceDouble(val, first, last, & + & indexBase, deviceVecX) result(res) & + & bind(c,name='setscalMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: first,last,indexbase + real(c_double), value :: val + type(c_ptr), value :: deviceVecX + end function setScalMultiVecDeviceDouble + end interface + + interface + function geinsMultiVecDeviceDouble(n,deviceVecIrl,deviceVecVal,& + & dupl,indexbase,deviceVecX) & + & result(res) bind(c,name='geinsMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n, dupl,indexbase + type(c_ptr), value :: deviceVecIrl, deviceVecVal, deviceVecX + end function geinsMultiVecDeviceDouble + end interface + + ! New gather functions + + interface + function igathMultiVecDeviceDouble(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceDouble + end interface + + interface + function igathMultiVecDeviceDoubleVecIdx(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceDoubleVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceDoubleVecIdx + end interface + + interface + function iscatMultiVecDeviceDouble(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + real(c_double),value :: beta + end function iscatMultiVecDeviceDouble + end interface + + interface + function iscatMultiVecDeviceDoubleVecIdx(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceDoubleVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + real(c_double),value :: beta + end function iscatMultiVecDeviceDoubleVecIdx + end interface + + + interface scalMultiVecDevice + function scalMultiVecDeviceDouble(alpha,deviceVecA) & + & result(val) bind(c,name='scalMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + real(c_double), value :: alpha + type(c_ptr), value :: deviceVecA + end function scalMultiVecDeviceDouble + end interface + + interface dotMultiVecDevice + function dotMultiVecDeviceDouble(res, n,deviceVecA,deviceVecB) & + & result(val) bind(c,name='dotMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA, deviceVecB + end function dotMultiVecDeviceDouble + end interface + + interface nrm2MultiVecDevice + function nrm2MultiVecDeviceDouble(res,n,deviceVecA) & + & result(val) bind(c,name='nrm2MultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function nrm2MultiVecDeviceDouble + end interface + + interface amaxMultiVecDevice + function amaxMultiVecDeviceDouble(res,n,deviceVecA) & + & result(val) bind(c,name='amaxMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function amaxMultiVecDeviceDouble + end interface + + interface asumMultiVecDevice + function asumMultiVecDeviceDouble(res,n,deviceVecA) & + & result(val) bind(c,name='asumMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function asumMultiVecDeviceDouble + end interface + + + interface axpbyMultiVecDevice + function axpbyMultiVecDeviceDouble(n,alpha,deviceVecA,beta,deviceVecB) & + & result(res) bind(c,name='axpbyMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_double), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB + end function axpbyMultiVecDeviceDouble + end interface + + interface axyMultiVecDevice + function axyMultiVecDeviceDouble(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='axyMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_double), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function axyMultiVecDeviceDouble + end interface + + interface axybzMultiVecDevice + function axybzMultiVecDeviceDouble(n,alpha,deviceVecA,deviceVecB,beta,deviceVecZ) & + & result(res) bind(c,name='axybzMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_double), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB,deviceVecZ + end function axybzMultiVecDeviceDouble + end interface + + + interface absMultiVecDevice + function absMultiVecDeviceDouble(n,alpha,deviceVecA) & + & result(res) bind(c,name='absMultiVecDeviceDouble') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_double), value :: alpha + type(c_ptr), value :: deviceVecA + end function absMultiVecDeviceDouble + function absMultiVecDeviceDouble2(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='absMultiVecDeviceDouble2') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_double), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function absMultiVecDeviceDouble2 + end interface + + interface inner_register + module procedure inner_registerDouble + end interface + + interface inner_unregister + module procedure inner_unregisterDouble + end interface + +contains + + + function inner_registerDouble(buffer,dval) result(res) + real(c_double), allocatable, target :: buffer(:) + type(c_ptr) :: dval + integer(c_int) :: res + real(c_double) :: dummy + res = registerMapped(c_loc(buffer),dval,size(buffer), dummy) + end function inner_registerDouble + + subroutine inner_unregisterDouble(buffer) + real(c_double), allocatable, target :: buffer(:) + + call unregisterMapped(c_loc(buffer)) + end subroutine inner_unregisterDouble + +#endif + +end module psb_d_vectordev_mod diff --git a/gpu/psb_gpu_env_mod.F90 b/gpu/psb_gpu_env_mod.F90 new file mode 100644 index 000000000..0473f4ace --- /dev/null +++ b/gpu/psb_gpu_env_mod.F90 @@ -0,0 +1,340 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_gpu_env_mod + use psb_const_mod + use iso_c_binding + use base_cusparse_mod +! interface psb_gpu_init +! module procedure psb_gpu_init +! end interface +#if defined(HAVE_CUDA) + use core_mod + + interface + function psb_gpuGetHandle() & + & result(res) bind(c,name='psb_gpuGetHandle') + use iso_c_binding + type(c_ptr) :: res + end function psb_gpuGetHandle + end interface + + interface + function psb_gpuGetStream() & + & result(res) bind(c,name='psb_gpuGetStream') + use iso_c_binding + type(c_ptr) :: res + end function psb_gpuGetStream + end interface + + interface + function psb_C_gpu_init(dev) & + & result(res) bind(c,name='gpuInit') + use iso_c_binding + integer(c_int),value :: dev + integer(c_int) :: res + end function psb_C_gpu_init + end interface + + interface + function psb_cuda_getDeviceCount() & + & result(res) bind(c,name='getDeviceCount') + use iso_c_binding + integer(c_int) :: res + end function psb_cuda_getDeviceCount + end interface + + interface + function psb_cuda_getDevice() & + & result(res) bind(c,name='getDevice') + use iso_c_binding + integer(c_int) :: res + end function psb_cuda_getDevice + end interface + + interface + function psb_cuda_setDevice(dev) & + & result(res) bind(c,name='setDevice') + use iso_c_binding + integer(c_int), value :: dev + integer(c_int) :: res + end function psb_cuda_setDevice + end interface + + + interface + subroutine psb_gpuCreateHandle() & + & bind(c,name='psb_gpuCreateHandle') + use iso_c_binding + end subroutine psb_gpuCreateHandle + end interface + + interface + subroutine psb_gpuSetStream(handle,stream) & + & bind(c,name='psb_gpuSetStream') + use iso_c_binding + type(c_ptr), value :: handle, stream + end subroutine psb_gpuSetStream + end interface + + interface + subroutine psb_gpuDestroyHandle() & + & bind(c,name='psb_gpuDestroyHandle') + use iso_c_binding + end subroutine psb_gpuDestroyHandle + end interface + + interface + subroutine psb_cudaReset() & + & bind(c,name='cudaReset') + use iso_c_binding + end subroutine psb_cudaReset + end interface + + interface + subroutine psb_gpuClose() & + & bind(c,name='gpuClose') + use iso_c_binding + end subroutine psb_gpuClose + end interface +#endif + + interface + function psb_C_DeviceHasUVA() & + & result(res) bind(c,name='DeviceHasUVA') + use iso_c_binding + integer(c_int) :: res + end function psb_C_DeviceHasUVA + end interface + + interface + function psb_C_get_MultiProcessors() & + & result(res) bind(c,name='getGPUMultiProcessors') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_MultiProcessors + function psb_C_get_MemoryBusWidth() & + & result(res) bind(c,name='getGPUMemoryBusWidth') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_MemoryBusWidth + function psb_C_get_MemoryClockRate() & + & result(res) bind(c,name='getGPUMemoryClockRate') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_MemoryClockRate + function psb_C_get_WarpSize() & + & result(res) bind(c,name='getGPUWarpSize') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_WarpSize + function psb_C_get_MaxThreadsPerMP() & + & result(res) bind(c,name='getGPUMaxThreadsPerMP') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_MaxThreadsPerMP + function psb_C_get_MaxRegistersPerBlock() & + & result(res) bind(c,name='getGPUMaxRegistersPerBlock') + use iso_c_binding + integer(c_int) :: res + end function psb_C_get_MaxRegistersPerBlock + end interface + interface + subroutine psb_C_cpy_NameString(cstring) & + & bind(c,name='cpyGPUNameString') + use iso_c_binding + character(c_char) :: cstring(*) + end subroutine psb_C_cpy_NameString + end interface + + logical, private :: gpu_do_maybe_free_buffer = .false. + +Contains + + function psb_gpu_get_maybe_free_buffer() result(res) + logical :: res + res = gpu_do_maybe_free_buffer + end function psb_gpu_get_maybe_free_buffer + + subroutine psb_gpu_set_maybe_free_buffer(val) + logical, intent(in) :: val + gpu_do_maybe_free_buffer = val + end subroutine psb_gpu_set_maybe_free_buffer + + ! !!!!!!!!!!!!!!!!!!!!!! + ! + ! Environment handling + ! + ! !!!!!!!!!!!!!!!!!!!!!! + + + subroutine psb_gpu_init(ctxt,dev) + use psb_penv_mod + use psb_const_mod + use psb_error_mod + type(psb_ctxt_type), intent(in) :: ctxt + integer, intent(in), optional :: dev + + integer :: np, npavail, iam, info, count, dev_ + Integer(Psb_ipk_) :: err_act + + info = psb_success_ + call psb_erractionsave(err_act) +#if defined (HAVE_CUDA) +#if defined(SERIAL_MPI) + iam = 0 +#else + call psb_info(ctxt,iam,np) +#endif + + count = psb_cuda_getDeviceCount() + + if (present(dev)) then + info = psb_C_gpu_init(dev) + else + if (count >0) then + dev_ = mod(iam,count) + else + dev_ = 0 + end if + info = psb_C_gpu_init(dev_) + end if + if (info == 0) info = initFcusparse() + if (info /= 0) then + call psb_errpush(psb_err_internal_error_,'psb_gpu_init') + goto 9999 + end if + call psb_gpuCreateHandle() +#endif + call psb_erractionrestore(err_act) + return +9999 call psb_error_handler(ctxt,err_act) + + return + + end subroutine psb_gpu_init + + + subroutine psb_gpu_DeviceSync() +#if defined(HAVE_CUDA) + call psb_cudaSync() +#endif + end subroutine psb_gpu_DeviceSync + + function psb_gpu_getDeviceCount() result(res) + integer :: res +#if defined(HAVE_CUDA) + res = psb_cuda_getDeviceCount() +#else + res = 0 +#endif + end function psb_gpu_getDeviceCount + + subroutine psb_gpu_exit() + integer :: res + res = closeFcusparse() + call psb_gpuClose() + call psb_cudaReset() + end subroutine psb_gpu_exit + + function psb_gpu_DeviceHasUVA() result(res) + logical :: res + res = (psb_C_DeviceHasUVA() == 1) + end function psb_gpu_DeviceHasUVA + + function psb_gpu_MultiProcessors() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_MultiProcessors() + end function psb_gpu_MultiProcessors + + function psb_gpu_MaxRegistersPerBlock() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_MaxRegistersPerBlock() + end function psb_gpu_MaxRegistersPerBlock + + function psb_gpu_MaxThreadsPerMP() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_MaxThreadsPerMP() + end function psb_gpu_MaxThreadsPerMP + + function psb_gpu_WarpSize() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_WarpSize() + end function psb_gpu_WarpSize + + function psb_gpu_MemoryClockRate() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_MemoryClockRate() + end function psb_gpu_MemoryClockRate + + function psb_gpu_MemoryBusWidth() result(res) + integer(psb_ipk_) :: res + res = psb_C_get_MemoryBusWidth() + end function psb_gpu_MemoryBusWidth + + function psb_gpu_MemoryPeakBandwidth() result(res) + real(psb_dpk_) :: res + ! Formula here: 2*ClockRate(KHz)*BusWidth(bit) + ! normalization: bit/byte, KHz/MHz + ! output: MBytes/s + res = 2.d0*0.125d0*1.d-3*psb_C_get_MemoryBusWidth()*psb_C_get_MemoryClockRate() + end function psb_gpu_MemoryPeakBandwidth + + function psb_gpu_DeviceName() result(res) + character(len=256) :: res + character :: cstring(256) + call psb_C_cpy_NameString(cstring) + call stringc2f(cstring,res) + end function psb_gpu_DeviceName + + + subroutine stringc2f(cstring,fstring) + character(c_char) :: cstring(*) + character(len=*) :: fstring + integer :: i + + i = 1 + do + if (cstring(i) == c_null_char) exit + if (i > len(fstring)) exit + fstring(i:i) = cstring(i) + i = i + 1 + end do + do + if (i > len(fstring)) exit + fstring(i:i) = " " + i = i + 1 + end do + return + end subroutine stringc2f + +end module psb_gpu_env_mod diff --git a/gpu/psb_gpu_mod.F90 b/gpu/psb_gpu_mod.F90 new file mode 100644 index 000000000..7eba80629 --- /dev/null +++ b/gpu/psb_gpu_mod.F90 @@ -0,0 +1,89 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_gpu_mod + use psb_const_mod + use psb_gpu_env_mod + + use psb_i_gpu_vect_mod + use psb_s_gpu_vect_mod + use psb_d_gpu_vect_mod + use psb_c_gpu_vect_mod + use psb_z_gpu_vect_mod + + use psb_i_gpu_multivect_mod + use psb_s_gpu_multivect_mod + use psb_d_gpu_multivect_mod + use psb_c_gpu_multivect_mod + use psb_z_gpu_multivect_mod + + use psb_d_ell_mat_mod + use psb_d_elg_mat_mod + use psb_s_ell_mat_mod + use psb_s_elg_mat_mod + use psb_z_ell_mat_mod + use psb_z_elg_mat_mod + use psb_c_ell_mat_mod + use psb_c_elg_mat_mod + + use psb_s_hll_mat_mod + use psb_s_hlg_mat_mod + use psb_d_hll_mat_mod + use psb_d_hlg_mat_mod + use psb_c_hll_mat_mod + use psb_c_hlg_mat_mod + use psb_z_hll_mat_mod + use psb_z_hlg_mat_mod + + use psb_s_csrg_mat_mod + use psb_d_csrg_mat_mod + use psb_c_csrg_mat_mod + use psb_z_csrg_mat_mod +#if CUDA_SHORT_VERSION <= 10 + use psb_s_hybg_mat_mod + use psb_d_hybg_mat_mod + use psb_c_hybg_mat_mod + use psb_z_hybg_mat_mod +#endif + use psb_d_diag_mat_mod + use psb_d_hdiag_mat_mod + + use psb_s_dnsg_mat_mod + use psb_d_dnsg_mat_mod + use psb_c_dnsg_mat_mod + use psb_z_dnsg_mat_mod + + use psb_s_hdiag_mat_mod + ! use psb_s_diag_mat_mod + +end module psb_gpu_mod + diff --git a/gpu/psb_i_csrg_mat_mod.F90 b/gpu/psb_i_csrg_mat_mod.F90 new file mode 100644 index 000000000..de25370fd --- /dev/null +++ b/gpu/psb_i_csrg_mat_mod.F90 @@ -0,0 +1,393 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_csrg_mat_mod + + use iso_c_binding + use psb_i_mat_mod + use cusparse_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_i_csr_sparse_mat) :: psb_i_csrg_sparse_mat + ! + ! cuSPARSE 4.0 CSR format. + ! + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(i_Cmat) :: deviceMat + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => i_csrg_get_fmt + procedure, pass(a) :: sizeof => i_csrg_sizeof + procedure, pass(a) :: vect_mv => psb_i_csrg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_i_csrg_inner_vect_sv + procedure, pass(a) :: csmm => psb_i_csrg_csmm + procedure, pass(a) :: csmv => psb_i_csrg_csmv + procedure, pass(a) :: scals => psb_i_csrg_scals + procedure, pass(a) :: scalv => psb_i_csrg_scal + procedure, pass(a) :: reallocate_nz => psb_i_csrg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_i_csrg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_csrg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_i_cp_csrg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_csrg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_i_mv_csrg_from_fmt + procedure, pass(a) :: free => i_csrg_free + procedure, pass(a) :: mold => psb_i_csrg_mold + procedure, pass(a) :: is_host => i_csrg_is_host + procedure, pass(a) :: is_dev => i_csrg_is_dev + procedure, pass(a) :: is_sync => i_csrg_is_sync + procedure, pass(a) :: set_host => i_csrg_set_host + procedure, pass(a) :: set_dev => i_csrg_set_dev + procedure, pass(a) :: set_sync => i_csrg_set_sync + procedure, pass(a) :: sync => i_csrg_sync + procedure, pass(a) :: to_gpu => psb_i_csrg_to_gpu + procedure, pass(a) :: from_gpu => psb_i_csrg_from_gpu + final :: i_csrg_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_csrg_mold +#endif + end type psb_i_csrg_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_csrg_get_nzeros, i_csrg_free, i_csrg_get_fmt, & + & i_csrg_get_size, i_csrg_sizeof, i_csrg_get_nz_row + + + interface + subroutine psb_i_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_csrg_inner_vect_sv + end interface + + + interface + subroutine psb_i_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_csrg_vect_mv + end interface + + interface + subroutine psb_i_csrg_reallocate_nz(nz,a) + import :: psb_i_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_i_csrg_sparse_mat), intent(inout) :: a + end subroutine psb_i_csrg_reallocate_nz + end interface + + interface + subroutine psb_i_csrg_allocate_mnnz(m,n,a,nz) + import :: psb_i_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_i_csrg_allocate_mnnz + end interface + + interface + subroutine psb_i_csrg_mold(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_csrg_mold + end interface + + interface + subroutine psb_i_csrg_to_gpu(a,info, nzrm) + import :: psb_i_csrg_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_i_csrg_to_gpu + end interface + + interface + subroutine psb_i_csrg_from_gpu(a,info) + import :: psb_i_csrg_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_csrg_from_gpu + end interface + + interface + subroutine psb_i_cp_csrg_from_coo(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_csrg_from_coo + end interface + + interface + subroutine psb_i_cp_csrg_from_fmt(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_csrg_from_fmt + end interface + + interface + subroutine psb_i_mv_csrg_from_coo(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_csrg_from_coo + end interface + + interface + subroutine psb_i_mv_csrg_from_fmt(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_csrg_from_fmt + end interface + + interface + subroutine psb_i_csrg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_csrg_csmv + end interface + interface + subroutine psb_i_csrg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) + integer(psb_ipk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_csrg_csmm + end interface + + interface + subroutine psb_i_csrg_scal(d,a,info,side) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_i_csrg_scal + end interface + + interface + subroutine psb_i_csrg_scals(d,a,info) + import :: psb_i_csrg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_csrg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function i_csrg_sizeof(a) result(res) + implicit none + class(psb_i_csrg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_int * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function i_csrg_sizeof + + function i_csrg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'CSRG' + end function i_csrg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + + subroutine i_csrg_set_host(a) + implicit none + class(psb_i_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine i_csrg_set_host + + subroutine i_csrg_set_dev(a) + implicit none + class(psb_i_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine i_csrg_set_dev + + subroutine i_csrg_set_sync(a) + implicit none + class(psb_i_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine i_csrg_set_sync + + function i_csrg_is_dev(a) result(res) + implicit none + class(psb_i_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function i_csrg_is_dev + + function i_csrg_is_host(a) result(res) + implicit none + class(psb_i_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function i_csrg_is_host + + function i_csrg_is_sync(a) result(res) + implicit none + class(psb_i_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function i_csrg_is_sync + + + subroutine i_csrg_sync(a) + implicit none + class(psb_i_csrg_sparse_mat), target, intent(in) :: a + class(psb_i_csrg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine i_csrg_sync + + subroutine i_csrg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_i_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + call a%psb_i_csr_sparse_mat%free() + + return + + end subroutine i_csrg_free + + subroutine i_csrg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + type(psb_i_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + + return + + end subroutine i_csrg_finalize + +#else + interface + subroutine psb_i_csrg_mold(a,b,info) + import :: psb_i_csrg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_csrg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_csrg_mold + end interface + +#endif + +end module psb_i_csrg_mat_mod diff --git a/gpu/psb_i_diag_mat_mod.F90 b/gpu/psb_i_diag_mat_mod.F90 new file mode 100644 index 000000000..3559c09aa --- /dev/null +++ b/gpu/psb_i_diag_mat_mod.F90 @@ -0,0 +1,308 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_diag_mat_mod + + use iso_c_binding + use psb_base_mod + use psb_i_dia_mat_mod + + type, extends(psb_i_dia_sparse_mat) :: psb_i_diag_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => i_diag_get_fmt + procedure, pass(a) :: sizeof => i_diag_sizeof + procedure, pass(a) :: vect_mv => psb_i_diag_vect_mv +! procedure, pass(a) :: csmm => psb_i_diag_csmm + procedure, pass(a) :: csmv => psb_i_diag_csmv +! procedure, pass(a) :: in_vect_sv => psb_i_diag_inner_vect_sv +! procedure, pass(a) :: scals => psb_i_diag_scals +! procedure, pass(a) :: scalv => psb_i_diag_scal +! procedure, pass(a) :: reallocate_nz => psb_i_diag_reallocate_nz +! procedure, pass(a) :: allocate_mnnz => psb_i_diag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_diag_from_coo +! procedure, pass(a) :: cp_from_fmt => psb_i_cp_diag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_diag_from_coo +! procedure, pass(a) :: mv_from_fmt => psb_i_mv_diag_from_fmt + procedure, pass(a) :: free => i_diag_free + procedure, pass(a) :: mold => psb_i_diag_mold + procedure, pass(a) :: to_gpu => psb_i_diag_to_gpu + final :: i_diag_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_diag_mold +#endif + end type psb_i_diag_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_diag_get_nzeros, i_diag_free, i_diag_get_fmt, & + & i_diag_get_size, i_diag_sizeof, i_diag_get_nz_row + + + interface + subroutine psb_i_diag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_diag_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_diag_vect_mv + end interface + + interface + subroutine psb_i_diag_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_i_diag_sparse_mat, psb_ipk_, psb_i_base_vect_type + class(psb_i_diag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_diag_inner_vect_sv + end interface + + interface + subroutine psb_i_diag_reallocate_nz(nz,a) + import :: psb_i_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_i_diag_sparse_mat), intent(inout) :: a + end subroutine psb_i_diag_reallocate_nz + end interface + + interface + subroutine psb_i_diag_allocate_mnnz(m,n,a,nz) + import :: psb_i_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_i_diag_allocate_mnnz + end interface + + interface + subroutine psb_i_diag_mold(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_diag_mold + end interface + + interface + subroutine psb_i_diag_to_gpu(a,info, nzrm) + import :: psb_i_diag_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_i_diag_to_gpu + end interface + + interface + subroutine psb_i_cp_diag_from_coo(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_diag_from_coo + end interface + + interface + subroutine psb_i_cp_diag_from_fmt(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_diag_from_fmt + end interface + + interface + subroutine psb_i_mv_diag_from_coo(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_diag_from_coo + end interface + + + interface + subroutine psb_i_mv_diag_from_fmt(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_diag_from_fmt + end interface + + interface + subroutine psb_i_diag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_diag_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_diag_csmv + end interface + interface + subroutine psb_i_diag_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_i_diag_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) + integer(psb_ipk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_diag_csmm + end interface + + interface + subroutine psb_i_diag_scal(d,a,info, side) + import :: psb_i_diag_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_i_diag_scal + end interface + + interface + subroutine psb_i_diag_scals(d,a,info) + import :: psb_i_diag_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_diag_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function i_diag_sizeof(a) result(res) + implicit none + class(psb_i_diag_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = 8 + res = res + psb_sizeof_int * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function i_diag_sizeof + + function i_diag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIAG' + end function i_diag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine i_diag_free(a) + use diagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_i_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_dia_sparse_mat%free() + + return + + end subroutine i_diag_free + + subroutine i_diag_finalize(a) + use diagdev_mod + implicit none + type(psb_i_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine i_diag_finalize + +#else + + interface + subroutine psb_i_diag_mold(a,b,info) + import :: psb_i_diag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_diag_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_diag_mold + end interface + +#endif + +end module psb_i_diag_mat_mod diff --git a/gpu/psb_i_dnsg_mat_mod.F90 b/gpu/psb_i_dnsg_mat_mod.F90 new file mode 100644 index 000000000..978996ae8 --- /dev/null +++ b/gpu/psb_i_dnsg_mat_mod.F90 @@ -0,0 +1,294 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_dnsg_mat_mod + + use iso_c_binding + use psb_i_mat_mod + use psb_i_dns_mat_mod + use dnsdev_mod + + type, extends(psb_i_dns_sparse_mat) :: psb_i_dnsg_sparse_mat + ! + ! ITPACK/DNS format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of DNS, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => i_dnsg_get_fmt + ! procedure, pass(a) :: sizeof => i_dnsg_sizeof + procedure, pass(a) :: vect_mv => psb_i_dnsg_vect_mv +!!$ procedure, pass(a) :: csmm => psb_i_dnsg_csmm +!!$ procedure, pass(a) :: csmv => psb_i_dnsg_csmv +!!$ procedure, pass(a) :: in_vect_sv => psb_i_dnsg_inner_vect_sv +!!$ procedure, pass(a) :: scals => psb_i_dnsg_scals +!!$ procedure, pass(a) :: scalv => psb_i_dnsg_scal +!!$ procedure, pass(a) :: reallocate_nz => psb_i_dnsg_reallocate_nz +!!$ procedure, pass(a) :: allocate_mnnz => psb_i_dnsg_allocate_mnnz + ! Note: we *do* need the TO methods, because of the need to invoke SYNC + ! + procedure, pass(a) :: cp_from_coo => psb_i_cp_dnsg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_i_cp_dnsg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_dnsg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_i_mv_dnsg_from_fmt + procedure, pass(a) :: free => i_dnsg_free + procedure, pass(a) :: mold => psb_i_dnsg_mold + procedure, pass(a) :: to_gpu => psb_i_dnsg_to_gpu + final :: i_dnsg_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_dnsg_mold +#endif + end type psb_i_dnsg_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_dnsg_get_nzeros, i_dnsg_free, i_dnsg_get_fmt, & + & i_dnsg_get_size, i_dnsg_get_nz_row + + + interface + subroutine psb_i_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_dnsg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_dnsg_vect_mv + end interface +!!$ +!!$ interface +!!$ subroutine psb_i_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_i_dnsg_sparse_mat, psb_ipk_, psb_i_base_vect_type +!!$ class(psb_i_dnsg_sparse_mat), intent(in) :: a +!!$ integer(psb_ipk_), intent(in) :: alpha, beta +!!$ class(psb_i_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_i_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_i_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_i_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_i_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_i_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_i_dnsg_allocate_mnnz +!!$ end interface + + interface + subroutine psb_i_dnsg_mold(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_dnsg_mold + end interface + + interface + subroutine psb_i_dnsg_to_gpu(a,info) + import :: psb_i_dnsg_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_dnsg_to_gpu + end interface + + interface + subroutine psb_i_cp_dnsg_from_coo(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_dnsg_from_coo + end interface + + interface + subroutine psb_i_cp_dnsg_from_fmt(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_dnsg_from_fmt + end interface + + interface + subroutine psb_i_mv_dnsg_from_coo(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_dnsg_from_coo + end interface + + + interface + subroutine psb_i_mv_dnsg_from_fmt(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_dnsg_from_fmt + end interface + +!!$ interface +!!$ subroutine psb_i_dnsg_csmv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_dnsg_sparse_mat), intent(in) :: a +!!$ integer(psb_ipk_), intent(in) :: alpha, beta, x(:) +!!$ integer(psb_ipk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_i_dnsg_csmv +!!$ end interface +!!$ interface +!!$ subroutine psb_i_dnsg_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_dnsg_sparse_mat), intent(in) :: a +!!$ integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) +!!$ integer(psb_ipk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_i_dnsg_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_dnsg_scal(d,a,info, side) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_i_dnsg_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_dnsg_scals(d,a,info) +!!$ import :: psb_i_dnsg_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_i_dnsg_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + + function i_dnsg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNSG' + end function i_dnsg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine i_dnsg_free(a) + use dnsdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_i_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_dns_sparse_mat%free() + + return + + end subroutine i_dnsg_free + + subroutine i_dnsg_finalize(a) + use dnsdev_mod + implicit none + type(psb_i_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine i_dnsg_finalize + +#else + + interface + subroutine psb_i_dnsg_mold(a,b,info) + import :: psb_i_dnsg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_dnsg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_dnsg_mold + end interface + +#endif + +end module psb_i_dnsg_mat_mod diff --git a/gpu/psb_i_elg_mat_mod.F90 b/gpu/psb_i_elg_mat_mod.F90 new file mode 100644 index 000000000..afc716625 --- /dev/null +++ b/gpu/psb_i_elg_mat_mod.F90 @@ -0,0 +1,483 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_elg_mat_mod + + use iso_c_binding + use psb_i_mat_mod + use psb_i_ell_mat_mod + use psb_i_gpu_vect_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_i_ell_sparse_mat) :: psb_i_elg_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of ELL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => i_elg_get_fmt + procedure, pass(a) :: sizeof => i_elg_sizeof + procedure, pass(a) :: vect_mv => psb_i_elg_vect_mv + procedure, pass(a) :: csmm => psb_i_elg_csmm + procedure, pass(a) :: csmv => psb_i_elg_csmv + procedure, pass(a) :: in_vect_sv => psb_i_elg_inner_vect_sv + procedure, pass(a) :: scals => psb_i_elg_scals + procedure, pass(a) :: scalv => psb_i_elg_scal + procedure, pass(a) :: reallocate_nz => psb_i_elg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_i_elg_allocate_mnnz + procedure, pass(a) :: reinit => i_elg_reinit + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_elg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_i_cp_elg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_elg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_i_mv_elg_from_fmt + procedure, pass(a) :: free => i_elg_free + procedure, pass(a) :: mold => psb_i_elg_mold + procedure, pass(a) :: csput_a => psb_i_elg_csput_a + procedure, pass(a) :: csput_v => psb_i_elg_csput_v + procedure, pass(a) :: is_host => i_elg_is_host + procedure, pass(a) :: is_dev => i_elg_is_dev + procedure, pass(a) :: is_sync => i_elg_is_sync + procedure, pass(a) :: set_host => i_elg_set_host + procedure, pass(a) :: set_dev => i_elg_set_dev + procedure, pass(a) :: set_sync => i_elg_set_sync + procedure, pass(a) :: sync => i_elg_sync + procedure, pass(a) :: from_gpu => psb_i_elg_from_gpu + procedure, pass(a) :: to_gpu => psb_i_elg_to_gpu + procedure, pass(a) :: asb => psb_i_elg_asb + final :: i_elg_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_elg_mold + procedure, pass(a) :: asb => psb_i_elg_asb +#endif + end type psb_i_elg_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_elg_get_nzeros, i_elg_free, i_elg_get_fmt, & + & i_elg_get_size, i_elg_sizeof, i_elg_get_nz_row, i_elg_sync + + + interface + subroutine psb_i_elg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_elg_vect_mv + end interface + + interface + subroutine psb_i_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_i_elg_sparse_mat, psb_ipk_, psb_i_base_vect_type + class(psb_i_elg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_elg_inner_vect_sv + end interface + + interface + subroutine psb_i_elg_reallocate_nz(nz,a) + import :: psb_i_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_i_elg_sparse_mat), intent(inout) :: a + end subroutine psb_i_elg_reallocate_nz + end interface + + interface + subroutine psb_i_elg_allocate_mnnz(m,n,a,nz) + import :: psb_i_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_i_elg_allocate_mnnz + end interface + + interface + subroutine psb_i_elg_mold(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_mold + end interface + + interface + subroutine psb_i_elg_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_csput_a + end interface + + interface + subroutine psb_i_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_i_elg_sparse_mat, psb_dpk_, psb_ipk_, psb_i_base_vect_type,& + & psb_i_base_vect_type + class(psb_i_elg_sparse_mat), intent(inout) :: a + class(psb_i_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_csput_v + end interface + + interface + subroutine psb_i_elg_from_gpu(a,info) + import :: psb_i_elg_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_from_gpu + end interface + + interface + subroutine psb_i_elg_to_gpu(a,info, nzrm) + import :: psb_i_elg_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_i_elg_to_gpu + end interface + + interface + subroutine psb_i_cp_elg_from_coo(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_elg_from_coo + end interface + + interface + subroutine psb_i_cp_elg_from_fmt(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_elg_from_fmt + end interface + + interface + subroutine psb_i_mv_elg_from_coo(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_elg_from_coo + end interface + + + interface + subroutine psb_i_mv_elg_from_fmt(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_elg_from_fmt + end interface + + interface + subroutine psb_i_elg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_elg_csmv + end interface + interface + subroutine psb_i_elg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) + integer(psb_ipk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_elg_csmm + end interface + + interface + subroutine psb_i_elg_scal(d,a,info, side) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_i_elg_scal + end interface + + interface + subroutine psb_i_elg_scals(d,a,info) + import :: psb_i_elg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_scals + end interface + + interface + subroutine psb_i_elg_asb(a) + import :: psb_i_elg_sparse_mat + class(psb_i_elg_sparse_mat), intent(inout) :: a + end subroutine psb_i_elg_asb + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function i_elg_sizeof(a) result(res) + implicit none + class(psb_i_elg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_int * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function i_elg_sizeof + + function i_elg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELG' + end function i_elg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + subroutine i_elg_reinit(a,clear) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_i_elg_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + integer(psb_ipk_) :: isz, err_act + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + if (a%is_bld() .or. a%is_upd()) then + ! do nothing + return + else if (a%is_asb()) then + if (a%is_dev().or.a%is_sync()) then + if (clear_) call zeroEllDevice(a%deviceMat) + call a%set_dev() + else if (a%is_host()) then + a%val(:,:) = izero + end if + call a%set_upd() + else + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine i_elg_reinit + + subroutine i_elg_free(a) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_i_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_ell_sparse_mat%free() + call a%set_sync() + + return + + end subroutine i_elg_free + + subroutine i_elg_sync(a) + implicit none + class(psb_i_elg_sparse_mat), target, intent(in) :: a + class(psb_i_elg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine i_elg_sync + + subroutine i_elg_set_host(a) + implicit none + class(psb_i_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine i_elg_set_host + + subroutine i_elg_set_dev(a) + implicit none + class(psb_i_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine i_elg_set_dev + + subroutine i_elg_set_sync(a) + implicit none + class(psb_i_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine i_elg_set_sync + + function i_elg_is_dev(a) result(res) + implicit none + class(psb_i_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function i_elg_is_dev + + function i_elg_is_host(a) result(res) + implicit none + class(psb_i_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function i_elg_is_host + + function i_elg_is_sync(a) result(res) + implicit none + class(psb_i_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function i_elg_is_sync + + subroutine i_elg_finalize(a) + use elldev_mod + implicit none + type(psb_i_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + return + + end subroutine i_elg_finalize + +#else + + interface + subroutine psb_i_elg_asb(a) + import :: psb_i_elg_sparse_mat + class(psb_i_elg_sparse_mat), intent(inout) :: a + end subroutine psb_i_elg_asb + end interface + + interface + subroutine psb_i_elg_mold(a,b,info) + import :: psb_i_elg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_elg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_elg_mold + end interface + +#endif + +end module psb_i_elg_mat_mod diff --git a/gpu/psb_i_gpu_vect_mod.F90 b/gpu/psb_i_gpu_vect_mod.F90 new file mode 100644 index 000000000..ca4950a0d --- /dev/null +++ b/gpu/psb_i_gpu_vect_mod.F90 @@ -0,0 +1,1671 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_gpu_vect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_i_vect_mod +#ifdef HAVE_SPGPU + use psb_gpu_env_mod + use psb_i_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_i_base_vect_type) :: psb_i_vect_gpu +#ifdef HAVE_SPGPU + integer :: state = is_host + type(c_ptr) :: deviceVect = c_null_ptr + integer(c_int), allocatable :: pinned_buffer(:) + type(c_ptr) :: dt_p_buf = c_null_ptr + integer(c_int), allocatable :: buffer(:) + type(c_ptr) :: dt_buf = c_null_ptr + integer :: dt_buf_sz = 0 + type(c_ptr) :: i_buf = c_null_ptr + integer :: i_buf_sz = 0 + contains + procedure, pass(x) :: get_nrows => i_gpu_get_nrows + procedure, nopass :: get_fmt => i_gpu_get_fmt + + procedure, pass(x) :: all => i_gpu_all + procedure, pass(x) :: zero => i_gpu_zero + procedure, pass(x) :: asb_m => i_gpu_asb_m + procedure, pass(x) :: sync => i_gpu_sync + procedure, pass(x) :: sync_space => i_gpu_sync_space + procedure, pass(x) :: bld_x => i_gpu_bld_x + procedure, pass(x) :: bld_mn => i_gpu_bld_mn + procedure, pass(x) :: free => i_gpu_free + procedure, pass(x) :: ins_a => i_gpu_ins_a + procedure, pass(x) :: ins_v => i_gpu_ins_v + procedure, pass(x) :: is_host => i_gpu_is_host + procedure, pass(x) :: is_dev => i_gpu_is_dev + procedure, pass(x) :: is_sync => i_gpu_is_sync + procedure, pass(x) :: set_host => i_gpu_set_host + procedure, pass(x) :: set_dev => i_gpu_set_dev + procedure, pass(x) :: set_sync => i_gpu_set_sync + procedure, pass(x) :: set_scal => i_gpu_set_scal +!!$ procedure, pass(x) :: set_vect => i_gpu_set_vect + procedure, pass(x) :: gthzv_x => i_gpu_gthzv_x + procedure, pass(y) :: sctb => i_gpu_sctb + procedure, pass(y) :: sctb_x => i_gpu_sctb_x + procedure, pass(x) :: gthzbuf => i_gpu_gthzbuf + procedure, pass(y) :: sctb_buf => i_gpu_sctb_buf + procedure, pass(x) :: new_buffer => i_gpu_new_buffer + procedure, nopass :: device_wait => i_gpu_device_wait + procedure, pass(x) :: free_buffer => i_gpu_free_buffer + procedure, pass(x) :: maybe_free_buffer => i_gpu_maybe_free_buffer + + final :: i_gpu_vect_finalize +#endif + end type psb_i_vect_gpu + + public :: psb_i_vect_gpu_ + private :: constructor + interface psb_i_vect_gpu_ + module procedure constructor + end interface psb_i_vect_gpu_ + +contains + + function constructor(x) result(this) + integer(psb_ipk_) :: x(:) + type(psb_i_vect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x),info) + + end function constructor + +#ifdef HAVE_SPGPU + + subroutine i_gpu_device_wait() + call psb_cudaSync() + end subroutine i_gpu_device_wait + + subroutine i_gpu_new_buffer(n,x,info) + use psb_realloc_mod + use psb_gpu_env_mod + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + integer(psb_ipk_), intent(out) :: info + + + if (psb_gpu_DeviceHasUVA()) then + if (allocated(x%combuf)) then + if (size(x%combuf) idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + ! + ! Only need a sync in this branch; in the others + ! cudamemCpy acts as a sync point. + ! + if (allocated(x%pinned_buffer)) then + if (size(x%pinned_buffer) < n) then + call inner_unregister(x%pinned_buffer) + deallocate(x%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(x%pinned_buffer)) then + allocate(x%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(x%pinned_buffer,x%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + info = igathMultiVecDeviceIntVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_p_buf, 1) + call psb_cudaSync() + y(1:n) = x%pinned_buffer(1:n) + + else + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeInt(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateInt(x%dt_buf,n) + x%dt_buf_sz=n + end if + if (info == 0) & + & info = igathMultiVecDeviceIntVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_buf, 1) + if (info == 0) & + & info = readInt(x%dt_buf,y,n) + + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + + if (x%i_buf_sz < ni) then + if (c_associated(x%i_buf)) then + call freeInt(x%i_buf) + x%i_buf = c_null_ptr + end if + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeInt(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateInt(x%dt_buf,n) + x%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(x%i_buf,ii%v,ni) + if (info == 0) & + & info = igathMultiVecDeviceInt(x%deviceVect,& + & 0, n, i, x%i_buf, 1, x%dt_buf, 1) + if (info == 0) & + & info = readInt(x%dt_buf,y,n) + + end select + + end subroutine i_gpu_gthzv_x + + subroutine i_gpu_gthzbuf(i,n,idx,x) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i,n + class(psb_i_base_vect_type) :: idx + class(psb_i_vect_gpu) :: x + integer :: info, ni + + info = 0 +!!$ write(0,*) 'Starting gth_zbuf' + if (.not.allocated(x%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'gthzbuf') + return + end if + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + info = igathMultiVecDeviceIntVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_p_buf, 1) + + else + info = igathMultiVecDeviceIntVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_buf, 1) + if (info == 0) & + & info = readInt(i,x%dt_buf,x%combuf(i:),n,1) + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + info = 0 + if (.not.c_associated(x%i_buf)) then + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,x%i_buf,ii%v(i:),n,1) + + if (info == 0) & + & info = igathMultiVecDeviceInt(x%deviceVect,& + & 0, n, i, x%i_buf, i,x%dt_buf, 1) + + if (info == 0) & + & info = readInt(i,x%dt_buf,x%combuf(i:),n,1) + + end select + + end subroutine i_gpu_gthzbuf + + subroutine i_gpu_sctb(n,idx,x,beta,y) + implicit none + !use psb_const_mod + integer(psb_ipk_) :: n, idx(:) + integer(psb_ipk_) :: beta, x(:) + class(psb_i_vect_gpu) :: y + integer(psb_ipk_) :: info + + if (n == 0) return + + if (y%is_dev()) call y%sync() + + call y%psb_i_base_vect_type%sctb(n,idx,x,beta) + call y%set_host() + + end subroutine i_gpu_sctb + + subroutine i_gpu_sctb_x(i,n,idx,x,beta,y) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + integer(psb_ipk_) :: beta, x(:) + class(psb_i_vect_gpu) :: y + integer :: info, ni + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + + ! + if (psb_gpu_DeviceHasUVA()) then + if (allocated(y%pinned_buffer)) then + if (size(y%pinned_buffer) < n) then + call inner_unregister(y%pinned_buffer) + deallocate(y%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(y%pinned_buffer)) then + allocate(y%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(y%pinned_buffer,y%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + y%pinned_buffer(1:n) = x(1:n) + info = iscatMultiVecDeviceIntVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_p_buf, 1,beta) + else + + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeInt(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateInt(y%dt_buf,n) + y%dt_buf_sz=n + end if + info = writeInt(y%dt_buf,x,n) + info = iscatMultiVecDeviceIntVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_buf, 1,beta) + + end if + + class default + ni = size(ii%v) + + if (y%i_buf_sz < ni) then + if (c_associated(y%i_buf)) then + call freeInt(y%i_buf) + y%i_buf = c_null_ptr + end if + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeInt(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateInt(y%dt_buf,n) + y%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(y%i_buf,ii%v(i:i+n-1),n) + info = writeInt(y%dt_buf,x,n) + info = iscatMultiVecDeviceInt(y%deviceVect,& + & 0, n, 1, y%i_buf, 1, y%dt_buf, 1,beta) + + + end select + ! + ! Need a sync here to make sure we are not reallocating + ! the buffers before iscatMulti has finished. + ! + call psb_cudaSync() + call y%set_dev() + + end subroutine i_gpu_sctb_x + + subroutine i_gpu_sctb_buf(i,n,idx,beta,y) + use psi_serial_mod + use psb_gpu_env_mod + implicit none + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + integer(psb_ipk_) :: beta + class(psb_i_vect_gpu) :: y + integer(psb_ipk_) :: info, ni + +!!$ write(0,*) 'Starting sctb_buf' + if (.not.allocated(y%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'sctb_buf') + return + end if + + + select type(ii=> idx) + class is (psb_i_vect_gpu) + + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + if (psb_gpu_DeviceHasUVA()) then + info = iscatMultiVecDeviceIntVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_p_buf, 1,beta) + else + info = writeInt(i,y%dt_buf,y%combuf(i:),n,1) + info = iscatMultiVecDeviceIntVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_buf, 1,beta) + + end if + + class default + !call y%sct(n,ii%v(i:),x,beta) + ni = size(ii%v) + info = 0 + if (.not.c_associated(y%i_buf)) then + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,y%i_buf,ii%v(i:),n,1) + if (info == 0) & + & info = writeInt(i,y%dt_buf,y%combuf(i:),n,1) + if (info == 0) info = iscatMultiVecDeviceInt(y%deviceVect,& + & 0, n, i, y%i_buf, i, y%dt_buf, 1,beta) + end select +!!$ write(0,*) 'Done sctb_buf' + + end subroutine i_gpu_sctb_buf + + + subroutine i_gpu_bld_x(x,this) + use psb_base_mod + integer(psb_ipk_), intent(in) :: this(:) + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'i_gpu_bld_x',& + & i_err=(/size(this),izero,izero,izero,izero/)) + end if + x%v(:) = this(:) + call x%set_host() + call x%sync() + + end subroutine i_gpu_bld_x + + subroutine i_gpu_bld_mn(x,n) + integer(psb_mpk_), intent(in) :: n + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(n,info) + if (info /= 0) then + call psb_errpush(info,'i_gpu_bld_n',i_err=(/n,n,n,n,n/)) + end if + + end subroutine i_gpu_bld_mn + + subroutine i_gpu_set_host(x) + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine i_gpu_set_host + + subroutine i_gpu_set_dev(x) + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine i_gpu_set_dev + + subroutine i_gpu_set_sync(x) + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine i_gpu_set_sync + + function i_gpu_is_dev(x) result(res) + implicit none + class(psb_i_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function i_gpu_is_dev + + function i_gpu_is_host(x) result(res) + implicit none + class(psb_i_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function i_gpu_is_host + + function i_gpu_is_sync(x) result(res) + implicit none + class(psb_i_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function i_gpu_is_sync + + + function i_gpu_get_nrows(x) result(res) + implicit none + class(psb_i_vect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = 0 + if (allocated(x%v)) res = size(x%v) + end function i_gpu_get_nrows + + function i_gpu_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'iGPU' + end function i_gpu_get_fmt + + subroutine i_gpu_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: n + class(psb_i_vect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(n,x%v,info) + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'i_gpu_all',& + & i_err=(/n,n,n,n,n/)) + end if + end subroutine i_gpu_all + + subroutine i_gpu_zero(x) + use psi_serial_mod + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=izero + call x%set_host() + end subroutine i_gpu_zero + + subroutine i_gpu_asb_m(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_mpk_), intent(in) :: n + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: nd + + if (x%is_dev()) then + nd = getMultiVecDeviceSize(x%deviceVect) + if (nd < n) then + call x%sync() + call x%psb_i_base_vect_type%asb(n,info) + if (info == psb_success_) call x%sync_space(info) + call x%set_host() + end if + else ! + if (x%get_nrows() size(x%v)).or.(n > x%get_nrows())) then +!!$ write(0,*) 'Incoherent situation : sizes',n,size(x%v),x%get_nrows() + call psb_realloc(n,x%v,info) + end if + info = readMultiVecDevice(x%deviceVect,x%v) + end if + if (info == 0) call x%set_sync() + if (info /= 0) then + info=psb_err_internal_error_ + call psb_errpush(info,'i_gpu_sync') + end if + + end subroutine i_gpu_sync + + subroutine i_gpu_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (c_associated(x%deviceVect)) then +!!$ write(0,*)'d_gpu_free Calling freeMultiVecDevice' + call freeMultiVecDevice(x%deviceVect) + x%deviceVect=c_null_ptr + end if + call x%free_buffer(info) + call x%set_sync() + end subroutine i_gpu_free + + subroutine i_gpu_set_scal(x,val,first,last) + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), optional :: first, last + + integer(psb_ipk_) :: info, first_, last_ + + first_ = 1 + last_ = x%get_nrows() + if (present(first)) first_ = max(1,first) + if (present(last)) last_ = min(last,last_) + + if (x%is_host()) call x%sync() + info = setScalDevice(val,first_,last_,1,x%deviceVect) + call x%set_dev() + + end subroutine i_gpu_set_scal +!!$ +!!$ subroutine i_gpu_set_vect(x,val) +!!$ class(psb_i_vect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: val(:) +!!$ integer(psb_ipk_) :: nr +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_i_base_vect_type%set_vect(val) +!!$ call x%set_host() +!!$ +!!$ end subroutine i_gpu_set_vect + + + + subroutine i_gpu_vect_finalize(x) + use psi_serial_mod + use psb_realloc_mod + implicit none + type(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + info = 0 + call x%free(info) + end subroutine i_gpu_vect_finalize + + subroutine i_gpu_ins_v(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + class(psb_i_base_vect_type), intent(inout) :: irl + class(psb_i_base_vect_type), intent(inout) :: val + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i, isz + logical :: done_gpu + + info = 0 + if (psb_errstatus_fatal()) return + + done_gpu = .false. + select type(virl => irl) + class is (psb_i_vect_gpu) + select type(vval => val) + class is (psb_i_vect_gpu) + if (vval%is_host()) call vval%sync() + if (virl%is_host()) call virl%sync() + if (x%is_host()) call x%sync() + info = geinsMultiVecDeviceInt(n,virl%deviceVect,& + & vval%deviceVect,dupl,1,x%deviceVect) + call x%set_dev() + done_gpu=.true. + end select + end select + + if (.not.done_gpu) then + if (irl%is_dev()) call irl%sync() + if (val%is_dev()) call val%sync() + call x%ins(n,irl%v,val%v,dupl,info) + end if + + if (info /= 0) then + call psb_errpush(info,'gpu_vect_ins') + return + end if + + end subroutine i_gpu_ins_v + + subroutine i_gpu_ins_a(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_i_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + integer(psb_ipk_), intent(in) :: irl(:) + integer(psb_ipk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i + + info = 0 + if (x%is_dev()) call x%sync() + call x%psb_i_base_vect_type%ins(n,irl,val,dupl,info) + call x%set_host() + + end subroutine i_gpu_ins_a + +#endif + +end module psb_i_gpu_vect_mod + + +! +! Multivectors +! + + + +module psb_i_gpu_multivect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_i_multivect_mod + use psb_i_base_multivect_mod + +#ifdef HAVE_SPGPU + use psb_i_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_i_base_multivect_type) :: psb_i_multivect_gpu +#ifdef HAVE_SPGPU + + integer(psb_ipk_) :: state = is_host, m_nrows=0, m_ncols=0 + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: buffer(:,:) + type(c_ptr) :: dt_buf = c_null_ptr + contains + procedure, pass(x) :: get_nrows => i_gpu_multi_get_nrows + procedure, pass(x) :: get_ncols => i_gpu_multi_get_ncols + procedure, nopass :: get_fmt => i_gpu_multi_get_fmt +!!$ procedure, pass(x) :: dot_v => i_gpu_multi_dot_v +!!$ procedure, pass(x) :: dot_a => i_gpu_multi_dot_a +!!$ procedure, pass(y) :: axpby_v => i_gpu_multi_axpby_v +!!$ procedure, pass(y) :: axpby_a => i_gpu_multi_axpby_a +!!$ procedure, pass(y) :: mlt_v => i_gpu_multi_mlt_v +!!$ procedure, pass(y) :: mlt_a => i_gpu_multi_mlt_a +!!$ procedure, pass(z) :: mlt_a_2 => i_gpu_multi_mlt_a_2 +!!$ procedure, pass(z) :: mlt_v_2 => i_gpu_multi_mlt_v_2 +!!$ procedure, pass(x) :: scal => i_gpu_multi_scal +!!$ procedure, pass(x) :: nrm2 => i_gpu_multi_nrm2 +!!$ procedure, pass(x) :: amax => i_gpu_multi_amax +!!$ procedure, pass(x) :: asum => i_gpu_multi_asum + procedure, pass(x) :: all => i_gpu_multi_all + procedure, pass(x) :: zero => i_gpu_multi_zero + procedure, pass(x) :: asb => i_gpu_multi_asb + procedure, pass(x) :: sync => i_gpu_multi_sync + procedure, pass(x) :: sync_space => i_gpu_multi_sync_space + procedure, pass(x) :: bld_x => i_gpu_multi_bld_x + procedure, pass(x) :: bld_n => i_gpu_multi_bld_n + procedure, pass(x) :: free => i_gpu_multi_free + procedure, pass(x) :: ins => i_gpu_multi_ins + procedure, pass(x) :: is_host => i_gpu_multi_is_host + procedure, pass(x) :: is_dev => i_gpu_multi_is_dev + procedure, pass(x) :: is_sync => i_gpu_multi_is_sync + procedure, pass(x) :: set_host => i_gpu_multi_set_host + procedure, pass(x) :: set_dev => i_gpu_multi_set_dev + procedure, pass(x) :: set_sync => i_gpu_multi_set_sync + procedure, pass(x) :: set_scal => i_gpu_multi_set_scal + procedure, pass(x) :: set_vect => i_gpu_multi_set_vect +!!$ procedure, pass(x) :: gthzv_x => i_gpu_multi_gthzv_x +!!$ procedure, pass(y) :: sctb => i_gpu_multi_sctb +!!$ procedure, pass(y) :: sctb_x => i_gpu_multi_sctb_x + final :: i_gpu_multi_vect_finalize +#endif + end type psb_i_multivect_gpu + + public :: psb_i_multivect_gpu + private :: constructor + interface psb_i_multivect_gpu + module procedure constructor + end interface + +contains + + function constructor(x) result(this) + integer(psb_ipk_) :: x(:,:) + type(psb_i_multivect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x,1),size(x,2),info) + + end function constructor + +#ifdef HAVE_SPGPU + +!!$ subroutine i_gpu_multi_gthzv_x(i,n,idx,x,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i,n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ integer(psb_ipk_) :: y(:) +!!$ class(psb_i_multivect_gpu) :: x +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (x%is_host()) call x%sync() +!!$ +!!$ if (allocated(x%buffer)) then +!!$ if (size(x%buffer) < n) then +!!$ call inner_unregister(x%buffer) +!!$ deallocate(x%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(x%buffer)) then +!!$ allocate(x%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(x%buffer,x%dt_buf) +!!$ endif +!!$ info = igathMultiVecDeviceDouble(x%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, x%dt_buf, 1) +!!$ call psb_cudaSync() +!!$ y(1:n) = x%buffer(1:n) +!!$ +!!$ class default +!!$ call x%gth(n,ii%v(i:),y) +!!$ end select +!!$ +!!$ +!!$ end subroutine i_gpu_multi_gthzv_x +!!$ +!!$ +!!$ +!!$ subroutine i_gpu_multi_sctb(n,idx,x,beta,y) +!!$ implicit none +!!$ !use psb_const_mod +!!$ integer(psb_ipk_) :: n, idx(:) +!!$ integer(psb_ipk_) :: beta, x(:) +!!$ class(psb_i_multivect_gpu) :: y +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (n == 0) return +!!$ +!!$ if (y%is_dev()) call y%sync() +!!$ +!!$ call y%psb_i_base_multivect_type%sctb(n,idx,x,beta) +!!$ call y%set_host() +!!$ +!!$ end subroutine i_gpu_multi_sctb +!!$ +!!$ subroutine i_gpu_multi_sctb_x(i,n,idx,x,beta,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i, n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ integer(psb_ipk_) :: beta, x(:) +!!$ class(psb_i_multivect_gpu) :: y +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (y%is_host()) call y%sync() +!!$ +!!$ if (allocated(y%buffer)) then +!!$ if (size(y%buffer) < n) then +!!$ call inner_unregister(y%buffer) +!!$ deallocate(y%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(y%buffer)) then +!!$ allocate(y%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(y%buffer,y%dt_buf) +!!$ endif +!!$ y%buffer(1:n) = x(1:n) +!!$ info = iscatMultiVecDeviceDouble(y%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, y%dt_buf, 1,beta) +!!$ +!!$ call y%set_dev() +!!$ call psb_cudaSync() +!!$ +!!$ class default +!!$ call y%sct(n,ii%v(i:),x,beta) +!!$ end select +!!$ +!!$ end subroutine i_gpu_multi_sctb_x + + + subroutine i_gpu_multi_bld_x(x,this) + use psb_base_mod + integer(psb_ipk_), intent(in) :: this(:,:) + class(psb_i_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info, m, n + + m=size(this,1) + n=size(this,2) + x%m_nrows = m + x%m_ncols = n + call psb_realloc(m,n,x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'i_gpu_multi_bld_x',& + & i_err=(/size(this,1),size(this,2),izero,izero,izero,izero/)) + end if + x%v(1:m,1:n) = this(1:m,1:n) + call x%set_host() + call x%sync() + + end subroutine i_gpu_multi_bld_x + + subroutine i_gpu_multi_bld_n(x,m,n) + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(m,n,info) + if (info /= 0) then + call psb_errpush(info,'i_gpu_multi_bld_n',i_err=(/m,n,n,n,n/)) + end if + + end subroutine i_gpu_multi_bld_n + + + subroutine i_gpu_multi_set_host(x) + implicit none + class(psb_i_multivect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine i_gpu_multi_set_host + + subroutine i_gpu_multi_set_dev(x) + implicit none + class(psb_i_multivect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine i_gpu_multi_set_dev + + subroutine i_gpu_multi_set_sync(x) + implicit none + class(psb_i_multivect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine i_gpu_multi_set_sync + + function i_gpu_multi_is_dev(x) result(res) + implicit none + class(psb_i_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function i_gpu_multi_is_dev + + function i_gpu_multi_is_host(x) result(res) + implicit none + class(psb_i_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function i_gpu_multi_is_host + + function i_gpu_multi_is_sync(x) result(res) + implicit none + class(psb_i_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function i_gpu_multi_is_sync + + + function i_gpu_multi_get_nrows(x) result(res) + implicit none + class(psb_i_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_nrows + + end function i_gpu_multi_get_nrows + + function i_gpu_multi_get_ncols(x) result(res) + implicit none + class(psb_i_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_ncols + + end function i_gpu_multi_get_ncols + + function i_gpu_multi_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'iGPU' + end function i_gpu_multi_get_fmt + +!!$ function i_gpu_multi_dot_v(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ class(psb_i_base_multivect_type), intent(inout) :: y +!!$ integer(psb_ipk_), intent(in) :: n +!!$ integer(psb_ipk_) :: res +!!$ integer(psb_ipk_), external :: ddot +!!$ integer(psb_ipk_) :: info +!!$ +!!$ res = dzero +!!$ ! +!!$ ! Note: this is the gpu implementation. +!!$ ! When we get here, we are sure that X is of +!!$ ! TYPE psb_i_vect +!!$ ! +!!$ select type(yy => y) +!!$ type is (psb_i_base_multivect_type) +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,x%v,1,yy%v,1) +!!$ type is (psb_i_multivect_gpu) +!!$ if (x%is_host()) call x%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) +!!$ if (info /= 0) then +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,'i_gpu_multi_dot_v') +!!$ end if +!!$ +!!$ class default +!!$ ! y%sync is done in dot_a +!!$ call x%sync() +!!$ res = y%dot(n,x%v) +!!$ end select +!!$ +!!$ end function i_gpu_multi_dot_v +!!$ +!!$ function i_gpu_multi_dot_a(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: y(:) +!!$ integer(psb_ipk_), intent(in) :: n +!!$ integer(psb_ipk_) :: res +!!$ integer(psb_ipk_), external :: ddot +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,y,1,x%v,1) +!!$ +!!$ end function i_gpu_multi_dot_a +!!$ +!!$ subroutine i_gpu_multi_axpby_v(m,alpha, x, beta, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: m +!!$ class(psb_i_base_multivect_type), intent(inout) :: x +!!$ class(psb_i_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent (in) :: alpha, beta +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: nx, ny +!!$ +!!$ info = psb_success_ +!!$ +!!$ select type(xx => x) +!!$ type is (psb_i_base_multivect_type) +!!$ if ((beta /= dzero).and.(y%is_dev()))& +!!$ & call y%sync() +!!$ call psb_geaxpby(m,alpha,xx%v,beta,y%v,info) +!!$ call y%set_host() +!!$ type is (psb_i_multivect_gpu) +!!$ ! Do something different here +!!$ if ((beta /= dzero).and.y%is_host())& +!!$ & call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ nx = getMultiVecDeviceSize(xx%deviceVect) +!!$ ny = getMultiVecDeviceSize(y%deviceVect) +!!$ if ((nx x) +!!$ type is (psb_i_base_multivect_type) +!!$ if (y%is_dev()) call y%sync() +!!$ do i=1, n +!!$ y%v(i) = y%v(i) * xx%v(i) +!!$ end do +!!$ call y%set_host() +!!$ type is (psb_i_multivect_gpu) +!!$ ! Do something different here +!!$ if (y%is_host()) call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) +!!$ call y%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call y%mlt(xx%v,info) +!!$ call y%set_host() +!!$ end select +!!$ +!!$ end subroutine i_gpu_multi_mlt_v +!!$ +!!$ subroutine i_gpu_multi_mlt_a(x, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: x(:) +!!$ class(psb_i_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ call y%sync() +!!$ call y%psb_i_base_multivect_type%mlt(x,info) +!!$ call y%set_host() +!!$ end subroutine i_gpu_multi_mlt_a +!!$ +!!$ subroutine i_gpu_multi_mlt_a_2(alpha,x,y,beta,z,info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: alpha,beta +!!$ integer(psb_ipk_), intent(in) :: x(:) +!!$ integer(psb_ipk_), intent(in) :: y(:) +!!$ class(psb_i_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ if (z%is_dev()) call z%sync() +!!$ call z%psb_i_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end subroutine i_gpu_multi_mlt_a_2 +!!$ +!!$ subroutine i_gpu_multi_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) +!!$ use psi_serial_mod +!!$ use psb_string_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: alpha,beta +!!$ class(psb_i_base_multivect_type), intent(inout) :: x +!!$ class(psb_i_base_multivect_type), intent(inout) :: y +!!$ class(psb_i_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character(len=1), intent(in), optional :: conjgx, conjgy +!!$ integer(psb_ipk_) :: i, n +!!$ logical :: conjgx_, conjgy_ +!!$ +!!$ if (.false.) then +!!$ ! These are present just for coherence with the +!!$ ! complex versions; they do nothing here. +!!$ conjgx_=.false. +!!$ if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') +!!$ conjgy_=.false. +!!$ if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') +!!$ end if +!!$ +!!$ n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) +!!$ +!!$ ! +!!$ ! Need to reconsider BETA in the GPU side +!!$ ! of things. +!!$ ! +!!$ info = 0 +!!$ select type(xx => x) +!!$ type is (psb_i_multivect_gpu) +!!$ select type (yy => y) +!!$ type is (psb_i_multivect_gpu) +!!$ if (xx%is_host()) call xx%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ ! Z state is irrelevant: it will be done on the GPU. +!!$ info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& +!!$ & yy%deviceVect,beta,z%deviceVect) +!!$ call z%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call yy%sync() +!!$ call z%psb_i_base_multivect_type%mlt(alpha,xx,yy,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ +!!$ class default +!!$ call x%sync() +!!$ call y%sync() +!!$ call z%psb_i_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ end subroutine i_gpu_multi_mlt_v_2 + + + subroutine i_gpu_multi_set_scal(x,val) + class(psb_i_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: val + + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_i_base_multivect_type%set_scal(val) + call x%set_host() + end subroutine i_gpu_multi_set_scal + + subroutine i_gpu_multi_set_vect(x,val) + class(psb_i_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: val(:,:) + integer(psb_ipk_) :: nr + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_i_base_multivect_type%set_vect(val) + call x%set_host() + + end subroutine i_gpu_multi_set_vect + + + +!!$ subroutine i_gpu_multi_scal(alpha, x) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent (in) :: alpha +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_i_base_multivect_type%scal(alpha) +!!$ call x%set_host() +!!$ end subroutine i_gpu_multi_scal +!!$ +!!$ +!!$ function i_gpu_multi_nrm2(n,x) result(res) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ integer(psb_ipk_) :: res +!!$ integer(psb_ipk_) :: info +!!$ ! WARNING: this should be changed. +!!$ if (x%is_host()) call x%sync() +!!$ info = nrm2MultiVecDevice(res,n,x%deviceVect) +!!$ +!!$ end function i_gpu_multi_nrm2 +!!$ +!!$ function i_gpu_multi_amax(n,x) result(res) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ integer(psb_ipk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = maxval(abs(x%v(1:n))) +!!$ +!!$ end function i_gpu_multi_amax +!!$ +!!$ function i_gpu_multi_asum(n,x) result(res) +!!$ implicit none +!!$ class(psb_i_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ integer(psb_ipk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = sum(abs(x%v(1:n))) +!!$ +!!$ end function i_gpu_multi_asum + + subroutine i_gpu_multi_all(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_multivect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(m,n,x%v,info,pad=izero) + x%m_nrows = m + x%m_ncols = n + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'i_gpu_multi_all',& + & i_err=(/m,n,n,n,n/)) + end if + end subroutine i_gpu_multi_all + + subroutine i_gpu_multi_zero(x) + use psi_serial_mod + implicit none + class(psb_i_multivect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine i_gpu_multi_zero + + subroutine i_gpu_multi_asb(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nd, nc + + + x%m_nrows = m + x%m_ncols = n + if (x%is_host()) then + call x%psb_i_base_multivect_type%asb(m,n,info) + if (info == psb_success_) call x%sync_space(info) + else if (x%is_dev()) then + nd = getMultiVecDevicePitch(x%deviceVect) + nc = getMultiVecDeviceCount(x%deviceVect) + if ((nd < m).or.(nc i_hdiag_get_fmt + ! procedure, pass(a) :: sizeof => i_hdiag_sizeof + procedure, pass(a) :: vect_mv => psb_i_hdiag_vect_mv + ! procedure, pass(a) :: csmm => psb_i_hdiag_csmm + procedure, pass(a) :: csmv => psb_i_hdiag_csmv + ! procedure, pass(a) :: in_vect_sv => psb_i_hdiag_inner_vect_sv + ! procedure, pass(a) :: scals => psb_i_hdiag_scals + ! procedure, pass(a) :: scalv => psb_i_hdiag_scal + ! procedure, pass(a) :: reallocate_nz => psb_i_hdiag_reallocate_nz + ! procedure, pass(a) :: allocate_mnnz => psb_i_hdiag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_hdiag_from_coo + ! procedure, pass(a) :: cp_from_fmt => psb_i_cp_hdiag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_hdiag_from_coo + ! procedure, pass(a) :: mv_from_fmt => psb_i_mv_hdiag_from_fmt + procedure, pass(a) :: free => i_hdiag_free + procedure, pass(a) :: mold => psb_i_hdiag_mold + procedure, pass(a) :: to_gpu => psb_i_hdiag_to_gpu + final :: i_hdiag_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_hdiag_mold +#endif + end type psb_i_hdiag_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_hdiag_get_nzeros, i_hdiag_free, i_hdiag_get_fmt, & + & i_hdiag_get_size, i_hdiag_sizeof, i_hdiag_get_nz_row + + + interface + subroutine psb_i_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hdiag_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hdiag_vect_mv + end interface + +!!$ interface +!!$ subroutine psb_i_hdiag_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_i_hdiag_sparse_mat, psb_ipk_, psb_i_base_vect_type +!!$ class(psb_i_hdiag_sparse_mat), intent(in) :: a +!!$ integer(psb_ipk_), intent(in) :: alpha, beta +!!$ class(psb_i_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_i_hdiag_inner_vect_sv +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_hdiag_reallocate_nz(nz,a) +!!$ import :: psb_i_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_i_hdiag_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_hdiag_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_i_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_i_hdiag_allocate_mnnz +!!$ end interface + + interface + subroutine psb_i_hdiag_mold(a,b,info) + import :: psb_i_hdiag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hdiag_mold + end interface + + interface + subroutine psb_i_hdiag_to_gpu(a,info) + import :: psb_i_hdiag_sparse_mat, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hdiag_to_gpu + end interface + + interface + subroutine psb_i_cp_hdiag_from_coo(a,b,info) + import :: psb_i_hdiag_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_hdiag_from_coo + end interface + +!!$ interface +!!$ subroutine psb_i_cp_hdiag_from_fmt(a,b,info) +!!$ import :: psb_i_hdiag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_i_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_i_cp_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_i_mv_hdiag_from_coo(a,b,info) + import :: psb_i_hdiag_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_hdiag_from_coo + end interface + +!!$ +!!$ interface +!!$ subroutine psb_i_mv_hdiag_from_fmt(a,b,info) +!!$ import :: psb_i_hdiag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_i_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_i_mv_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_i_hdiag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hdiag_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hdiag_csmv + end interface + +!!$ interface +!!$ subroutine psb_i_hdiag_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_i_hdiag_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_hdiag_sparse_mat), intent(in) :: a +!!$ integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) +!!$ integer(psb_ipk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_i_hdiag_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_hdiag_scal(d,a,info, side) +!!$ import :: psb_i_hdiag_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_i_hdiag_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_i_hdiag_scals(d,a,info) +!!$ import :: psb_i_hdiag_sparse_mat, psb_ipk_, psb_ipk_ +!!$ class(psb_i_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_i_hdiag_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + function i_hdiag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIAG' + end function i_hdiag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine i_hdiag_free(a) + use hdiagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_i_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_hdia_sparse_mat%free() + + return + + end subroutine i_hdiag_free + + subroutine i_hdiag_finalize(a) + use hdiagdev_mod + implicit none + type(psb_i_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_hdia_sparse_mat%free() + + return + end subroutine i_hdiag_finalize + +#else + + interface + subroutine psb_i_hdiag_mold(a,b,info) + import :: psb_i_hdiag_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hdiag_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hdiag_mold + end interface + +#endif + +end module psb_i_hdiag_mat_mod diff --git a/gpu/psb_i_hlg_mat_mod.F90 b/gpu/psb_i_hlg_mat_mod.F90 new file mode 100644 index 000000000..92917d472 --- /dev/null +++ b/gpu/psb_i_hlg_mat_mod.F90 @@ -0,0 +1,398 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_hlg_mat_mod + + use iso_c_binding + use psb_i_mat_mod + use psb_i_hll_mat_mod + + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_i_hll_sparse_mat) :: psb_i_hlg_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer :: devstate = is_host + + contains + procedure, nopass :: get_fmt => i_hlg_get_fmt + procedure, pass(a) :: sizeof => i_hlg_sizeof + procedure, pass(a) :: vect_mv => psb_i_hlg_vect_mv + procedure, pass(a) :: csmm => psb_i_hlg_csmm + procedure, pass(a) :: csmv => psb_i_hlg_csmv + procedure, pass(a) :: in_vect_sv => psb_i_hlg_inner_vect_sv + procedure, pass(a) :: scals => psb_i_hlg_scals + procedure, pass(a) :: scalv => psb_i_hlg_scal + procedure, pass(a) :: reallocate_nz => psb_i_hlg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_i_hlg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_hlg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_i_cp_hlg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_hlg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_i_mv_hlg_from_fmt + procedure, pass(a) :: free => i_hlg_free + procedure, pass(a) :: mold => psb_i_hlg_mold + procedure, pass(a) :: is_host => i_hlg_is_host + procedure, pass(a) :: is_dev => i_hlg_is_dev + procedure, pass(a) :: is_sync => i_hlg_is_sync + procedure, pass(a) :: set_host => i_hlg_set_host + procedure, pass(a) :: set_dev => i_hlg_set_dev + procedure, pass(a) :: set_sync => i_hlg_set_sync + procedure, pass(a) :: sync => i_hlg_sync + procedure, pass(a) :: from_gpu => psb_i_hlg_from_gpu + procedure, pass(a) :: to_gpu => psb_i_hlg_to_gpu + final :: i_hlg_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_hlg_mold +#endif + end type psb_i_hlg_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_hlg_get_nzeros, i_hlg_free, i_hlg_get_fmt, & + & i_hlg_get_size, i_hlg_sizeof, i_hlg_get_nz_row + + + interface + subroutine psb_i_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hlg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hlg_vect_mv + end interface + + interface + subroutine psb_i_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_i_hlg_sparse_mat, psb_ipk_, psb_i_base_vect_type + class(psb_i_hlg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hlg_inner_vect_sv + end interface + + interface + subroutine psb_i_hlg_reallocate_nz(nz,a) + import :: psb_i_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_i_hlg_sparse_mat), intent(inout) :: a + end subroutine psb_i_hlg_reallocate_nz + end interface + + interface + subroutine psb_i_hlg_allocate_mnnz(m,n,a,nz) + import :: psb_i_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_i_hlg_allocate_mnnz + end interface + + interface + subroutine psb_i_hlg_mold(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hlg_mold + end interface + + interface + subroutine psb_i_hlg_from_gpu(a,info) + import :: psb_i_hlg_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hlg_from_gpu + end interface + + interface + subroutine psb_i_hlg_to_gpu(a,info, nzrm) + import :: psb_i_hlg_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_i_hlg_to_gpu + end interface + + interface + subroutine psb_i_cp_hlg_from_coo(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_hlg_from_coo + end interface + + interface + subroutine psb_i_cp_hlg_from_fmt(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_hlg_from_fmt + end interface + + interface + subroutine psb_i_mv_hlg_from_coo(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_hlg_from_coo + end interface + + + interface + subroutine psb_i_mv_hlg_from_fmt(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_hlg_from_fmt + end interface + + interface + subroutine psb_i_hlg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hlg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hlg_csmv + end interface + interface + subroutine psb_i_hlg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_i_hlg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) + integer(psb_ipk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hlg_csmm + end interface + + interface + subroutine psb_i_hlg_scal(d,a,info, side) + import :: psb_i_hlg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_i_hlg_scal + end interface + + interface + subroutine psb_i_hlg_scals(d,a,info) + import :: psb_i_hlg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hlg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function i_hlg_sizeof(a) result(res) + implicit none + class(psb_i_hlg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_int * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%hkoffs) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function i_hlg_sizeof + + function i_hlg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLG' + end function i_hlg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine i_hlg_free(a) + use hlldev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_i_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_i_hll_sparse_mat%free() + + return + + end subroutine i_hlg_free + + + subroutine i_hlg_sync(a) + implicit none + class(psb_i_hlg_sparse_mat), target, intent(in) :: a + class(psb_i_hlg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine i_hlg_sync + + subroutine i_hlg_set_host(a) + implicit none + class(psb_i_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine i_hlg_set_host + + subroutine i_hlg_set_dev(a) + implicit none + class(psb_i_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine i_hlg_set_dev + + subroutine i_hlg_set_sync(a) + implicit none + class(psb_i_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine i_hlg_set_sync + + function i_hlg_is_dev(a) result(res) + implicit none + class(psb_i_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function i_hlg_is_dev + + function i_hlg_is_host(a) result(res) + implicit none + class(psb_i_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function i_hlg_is_host + + function i_hlg_is_sync(a) result(res) + implicit none + class(psb_i_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function i_hlg_is_sync + + + subroutine i_hlg_finalize(a) + use hlldev_mod + implicit none + type(psb_i_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine i_hlg_finalize + +#else + + interface + subroutine psb_i_hlg_mold(a,b,info) + import :: psb_i_hlg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hlg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hlg_mold + end interface + +#endif + +end module psb_i_hlg_mat_mod diff --git a/gpu/psb_i_hybg_mat_mod.F90 b/gpu/psb_i_hybg_mat_mod.F90 new file mode 100644 index 000000000..9e682365e --- /dev/null +++ b/gpu/psb_i_hybg_mat_mod.F90 @@ -0,0 +1,306 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +#if CUDA_SHORT_VERSION <= 10 + +module psb_i_hybg_mat_mod + + use iso_c_binding + use psb_i_mat_mod + use cusparse_mod + + type, extends(psb_i_csr_sparse_mat) :: psb_i_hybg_sparse_mat + ! + ! HYBG. An interface to the cuSPARSE HYB + ! On the CPU side we keep a CSR storage. + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(i_Hmat) :: deviceMat + + contains + procedure, nopass :: get_fmt => i_hybg_get_fmt + procedure, pass(a) :: sizeof => i_hybg_sizeof + procedure, pass(a) :: vect_mv => psb_i_hybg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_i_hybg_inner_vect_sv + procedure, pass(a) :: csmm => psb_i_hybg_csmm + procedure, pass(a) :: csmv => psb_i_hybg_csmv + procedure, pass(a) :: scals => psb_i_hybg_scals + procedure, pass(a) :: scalv => psb_i_hybg_scal + procedure, pass(a) :: reallocate_nz => psb_i_hybg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_i_hybg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_i_cp_hybg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_i_cp_hybg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_i_mv_hybg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_i_mv_hybg_from_fmt + procedure, pass(a) :: free => i_hybg_free + procedure, pass(a) :: mold => psb_i_hybg_mold + procedure, pass(a) :: to_gpu => psb_i_hybg_to_gpu + final :: i_hybg_finalize +#else + contains + procedure, pass(a) :: mold => psb_i_hybg_mold +#endif + end type psb_i_hybg_sparse_mat + +#ifdef HAVE_SPGPU + private :: i_hybg_get_nzeros, i_hybg_free, i_hybg_get_fmt, & + & i_hybg_get_size, i_hybg_sizeof, i_hybg_get_nz_row + + + interface + subroutine psb_i_hybg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hybg_inner_vect_sv + end interface + + interface + subroutine psb_i_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_i_base_vect_type, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta + class(psb_i_base_vect_type), intent(inout) :: x + class(psb_i_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hybg_vect_mv + end interface + + interface + subroutine psb_i_hybg_reallocate_nz(nz,a) + import :: psb_i_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_i_hybg_sparse_mat), intent(inout) :: a + end subroutine psb_i_hybg_reallocate_nz + end interface + + interface + subroutine psb_i_hybg_allocate_mnnz(m,n,a,nz) + import :: psb_i_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_i_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_i_hybg_allocate_mnnz + end interface + + interface + subroutine psb_i_hybg_mold(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hybg_mold + end interface + + interface + subroutine psb_i_hybg_to_gpu(a,info, nzrm) + import :: psb_i_hybg_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_i_hybg_to_gpu + end interface + + interface + subroutine psb_i_cp_hybg_from_coo(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_hybg_from_coo + end interface + + interface + subroutine psb_i_cp_hybg_from_fmt(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_cp_hybg_from_fmt + end interface + + interface + subroutine psb_i_mv_hybg_from_coo(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_coo_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + class(psb_i_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_hybg_from_coo + end interface + + interface + subroutine psb_i_mv_hybg_from_fmt(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + class(psb_i_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_mv_hybg_from_fmt + end interface + + interface + subroutine psb_i_hybg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:) + integer(psb_ipk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hybg_csmv + end interface + interface + subroutine psb_i_hybg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: alpha, beta, x(:,:) + integer(psb_ipk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_i_hybg_csmm + end interface + + interface + subroutine psb_i_hybg_scal(d,a,info,side) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_i_hybg_scal + end interface + + interface + subroutine psb_i_hybg_scals(d,a,info) + import :: psb_i_hybg_sparse_mat, psb_ipk_, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hybg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function i_hybg_sizeof(a) result(res) + implicit none + class(psb_i_hybg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + res = 8 + res = res + psb_sizeof_int * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function i_hybg_sizeof + + function i_hybg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HYBG' + end function i_hybg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine i_hybg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + class(psb_i_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + call a%psb_i_csr_sparse_mat%free() + + return + + end subroutine i_hybg_free + + subroutine i_hybg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + type(psb_i_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + + return + end subroutine i_hybg_finalize + +#else + + interface + subroutine psb_i_hybg_mold(a,b,info) + import :: psb_i_hybg_sparse_mat, psb_i_base_sparse_mat, psb_ipk_ + class(psb_i_hybg_sparse_mat), intent(in) :: a + class(psb_i_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_i_hybg_mold + end interface + +#endif + +end module psb_i_hybg_mat_mod +#endif diff --git a/gpu/psb_i_vectordev_mod.F90 b/gpu/psb_i_vectordev_mod.F90 new file mode 100644 index 000000000..9998d355f --- /dev/null +++ b/gpu/psb_i_vectordev_mod.F90 @@ -0,0 +1,283 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_i_vectordev_mod + + use psb_base_vectordev_mod + +#ifdef HAVE_SPGPU + + interface registerMapped + function registerMappedInt(buf,d_p,n,dummy) & + & result(res) bind(c,name='registerMappedInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: buf + type(c_ptr) :: d_p + integer(c_int),value :: n + integer(c_int), value :: dummy + end function registerMappedInt + end interface + + interface writeMultiVecDevice + function writeMultiVecDeviceInt(deviceVec,hostVec) & + & result(res) bind(c,name='writeMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int) :: hostVec(*) + end function writeMultiVecDeviceInt + function writeMultiVecDeviceIntR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='writeMultiVecDeviceIntR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + integer(c_int) :: hostVec(ld,*) + end function writeMultiVecDeviceIntR2 + end interface + + interface readMultiVecDevice + function readMultiVecDeviceInt(deviceVec,hostVec) & + & result(res) bind(c,name='readMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int) :: hostVec(*) + end function readMultiVecDeviceInt + function readMultiVecDeviceIntR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='readMultiVecDeviceIntR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + integer(c_int) :: hostVec(ld,*) + end function readMultiVecDeviceIntR2 + end interface + + interface allocateInt + function allocateInt(didx,n) & + & result(res) bind(c,name='allocateInt') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: n + integer(c_int) :: res + end function allocateInt + function allocateMultiInt(didx,m,n) & + & result(res) bind(c,name='allocateMultiInt') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: m,n + integer(c_int) :: res + end function allocateMultiInt + end interface + + interface writeInt + function writeInt(didx,hidx,n) & + & result(res) bind(c,name='writeInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(*) + integer(c_int),value :: n + end function writeInt + function writeIntFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='writeIntFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function writeIntFirst + function writeMultiInt(didx,hidx,m,n) & + & result(res) bind(c,name='writeMultiInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(m,*) + integer(c_int),value :: m,n + end function writeMultiInt + end interface + + interface readInt + function readInt(didx,hidx,n) & + & result(res) bind(c,name='readInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(*) + integer(c_int),value :: n + end function readInt + function readIntFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='readIntFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function readIntFirst + function readMultiInt(didx,hidx,m,n) & + & result(res) bind(c,name='readMultiInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + integer(c_int) :: hidx(m,*) + integer(c_int),value :: m,n + end function readMultiInt + end interface + + interface + subroutine freeInt(didx) & + & bind(c,name='freeInt') + use iso_c_binding + type(c_ptr), value :: didx + end subroutine freeInt + end interface + + + interface setScalDevice + function setScalMultiVecDeviceInt(val, first, last, & + & indexBase, deviceVecX) result(res) & + & bind(c,name='setscalMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: first,last,indexbase + integer(c_int), value :: val + type(c_ptr), value :: deviceVecX + end function setScalMultiVecDeviceInt + end interface + + interface + function geinsMultiVecDeviceInt(n,deviceVecIrl,deviceVecVal,& + & dupl,indexbase,deviceVecX) & + & result(res) bind(c,name='geinsMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n, dupl,indexbase + type(c_ptr), value :: deviceVecIrl, deviceVecVal, deviceVecX + end function geinsMultiVecDeviceInt + end interface + + ! New gather functions + + interface + function igathMultiVecDeviceInt(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceInt + end interface + + interface + function igathMultiVecDeviceIntVecIdx(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceIntVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceIntVecIdx + end interface + + interface + function iscatMultiVecDeviceInt(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceInt') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + integer(c_int),value :: beta + end function iscatMultiVecDeviceInt + end interface + + interface + function iscatMultiVecDeviceIntVecIdx(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceIntVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + integer(c_int),value :: beta + end function iscatMultiVecDeviceIntVecIdx + end interface + + + + interface inner_register + module procedure inner_registerInt + end interface + + interface inner_unregister + module procedure inner_unregisterInt + end interface + +contains + + + function inner_registerInt(buffer,dval) result(res) + integer(c_int), allocatable, target :: buffer(:) + type(c_ptr) :: dval + integer(c_int) :: res + integer(c_int) :: dummy + res = registerMapped(c_loc(buffer),dval,size(buffer), dummy) + end function inner_registerInt + + subroutine inner_unregisterInt(buffer) + integer(c_int), allocatable, target :: buffer(:) + + call unregisterMapped(c_loc(buffer)) + end subroutine inner_unregisterInt + +#endif + +end module psb_i_vectordev_mod diff --git a/gpu/psb_s_csrg_mat_mod.F90 b/gpu/psb_s_csrg_mat_mod.F90 new file mode 100644 index 000000000..cface9f52 --- /dev/null +++ b/gpu/psb_s_csrg_mat_mod.F90 @@ -0,0 +1,393 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_csrg_mat_mod + + use iso_c_binding + use psb_s_mat_mod + use cusparse_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_s_csr_sparse_mat) :: psb_s_csrg_sparse_mat + ! + ! cuSPARSE 4.0 CSR format. + ! + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(s_Cmat) :: deviceMat + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => s_csrg_get_fmt + procedure, pass(a) :: sizeof => s_csrg_sizeof + procedure, pass(a) :: vect_mv => psb_s_csrg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_s_csrg_inner_vect_sv + procedure, pass(a) :: csmm => psb_s_csrg_csmm + procedure, pass(a) :: csmv => psb_s_csrg_csmv + procedure, pass(a) :: scals => psb_s_csrg_scals + procedure, pass(a) :: scalv => psb_s_csrg_scal + procedure, pass(a) :: reallocate_nz => psb_s_csrg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_csrg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_csrg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_s_cp_csrg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_csrg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_s_mv_csrg_from_fmt + procedure, pass(a) :: free => s_csrg_free + procedure, pass(a) :: mold => psb_s_csrg_mold + procedure, pass(a) :: is_host => s_csrg_is_host + procedure, pass(a) :: is_dev => s_csrg_is_dev + procedure, pass(a) :: is_sync => s_csrg_is_sync + procedure, pass(a) :: set_host => s_csrg_set_host + procedure, pass(a) :: set_dev => s_csrg_set_dev + procedure, pass(a) :: set_sync => s_csrg_set_sync + procedure, pass(a) :: sync => s_csrg_sync + procedure, pass(a) :: to_gpu => psb_s_csrg_to_gpu + procedure, pass(a) :: from_gpu => psb_s_csrg_from_gpu + final :: s_csrg_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_csrg_mold +#endif + end type psb_s_csrg_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_csrg_get_nzeros, s_csrg_free, s_csrg_get_fmt, & + & s_csrg_get_size, s_csrg_sizeof, s_csrg_get_nz_row + + + interface + subroutine psb_s_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_csrg_inner_vect_sv + end interface + + + interface + subroutine psb_s_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_csrg_vect_mv + end interface + + interface + subroutine psb_s_csrg_reallocate_nz(nz,a) + import :: psb_s_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_csrg_sparse_mat), intent(inout) :: a + end subroutine psb_s_csrg_reallocate_nz + end interface + + interface + subroutine psb_s_csrg_allocate_mnnz(m,n,a,nz) + import :: psb_s_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_csrg_allocate_mnnz + end interface + + interface + subroutine psb_s_csrg_mold(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_csrg_mold + end interface + + interface + subroutine psb_s_csrg_to_gpu(a,info, nzrm) + import :: psb_s_csrg_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_s_csrg_to_gpu + end interface + + interface + subroutine psb_s_csrg_from_gpu(a,info) + import :: psb_s_csrg_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_csrg_from_gpu + end interface + + interface + subroutine psb_s_cp_csrg_from_coo(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_csrg_from_coo + end interface + + interface + subroutine psb_s_cp_csrg_from_fmt(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_csrg_from_fmt + end interface + + interface + subroutine psb_s_mv_csrg_from_coo(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_csrg_from_coo + end interface + + interface + subroutine psb_s_mv_csrg_from_fmt(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_csrg_from_fmt + end interface + + interface + subroutine psb_s_csrg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_csrg_csmv + end interface + interface + subroutine psb_s_csrg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_csrg_csmm + end interface + + interface + subroutine psb_s_csrg_scal(d,a,info,side) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_csrg_scal + end interface + + interface + subroutine psb_s_csrg_scals(d,a,info) + import :: psb_s_csrg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_csrg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_csrg_sizeof(a) result(res) + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function s_csrg_sizeof + + function s_csrg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'CSRG' + end function s_csrg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + + subroutine s_csrg_set_host(a) + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine s_csrg_set_host + + subroutine s_csrg_set_dev(a) + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine s_csrg_set_dev + + subroutine s_csrg_set_sync(a) + implicit none + class(psb_s_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine s_csrg_set_sync + + function s_csrg_is_dev(a) result(res) + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function s_csrg_is_dev + + function s_csrg_is_host(a) result(res) + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function s_csrg_is_host + + function s_csrg_is_sync(a) result(res) + implicit none + class(psb_s_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function s_csrg_is_sync + + + subroutine s_csrg_sync(a) + implicit none + class(psb_s_csrg_sparse_mat), target, intent(in) :: a + class(psb_s_csrg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine s_csrg_sync + + subroutine s_csrg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_s_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + call a%psb_s_csr_sparse_mat%free() + + return + + end subroutine s_csrg_free + + subroutine s_csrg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + type(psb_s_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + + return + + end subroutine s_csrg_finalize + +#else + interface + subroutine psb_s_csrg_mold(a,b,info) + import :: psb_s_csrg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_csrg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_csrg_mold + end interface + +#endif + +end module psb_s_csrg_mat_mod diff --git a/gpu/psb_s_diag_mat_mod.F90 b/gpu/psb_s_diag_mat_mod.F90 new file mode 100644 index 000000000..1ed54f880 --- /dev/null +++ b/gpu/psb_s_diag_mat_mod.F90 @@ -0,0 +1,308 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_diag_mat_mod + + use iso_c_binding + use psb_base_mod + use psb_s_dia_mat_mod + + type, extends(psb_s_dia_sparse_mat) :: psb_s_diag_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => s_diag_get_fmt + procedure, pass(a) :: sizeof => s_diag_sizeof + procedure, pass(a) :: vect_mv => psb_s_diag_vect_mv +! procedure, pass(a) :: csmm => psb_s_diag_csmm + procedure, pass(a) :: csmv => psb_s_diag_csmv +! procedure, pass(a) :: in_vect_sv => psb_s_diag_inner_vect_sv +! procedure, pass(a) :: scals => psb_s_diag_scals +! procedure, pass(a) :: scalv => psb_s_diag_scal +! procedure, pass(a) :: reallocate_nz => psb_s_diag_reallocate_nz +! procedure, pass(a) :: allocate_mnnz => psb_s_diag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_diag_from_coo +! procedure, pass(a) :: cp_from_fmt => psb_s_cp_diag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_diag_from_coo +! procedure, pass(a) :: mv_from_fmt => psb_s_mv_diag_from_fmt + procedure, pass(a) :: free => s_diag_free + procedure, pass(a) :: mold => psb_s_diag_mold + procedure, pass(a) :: to_gpu => psb_s_diag_to_gpu + final :: s_diag_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_diag_mold +#endif + end type psb_s_diag_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_diag_get_nzeros, s_diag_free, s_diag_get_fmt, & + & s_diag_get_size, s_diag_sizeof, s_diag_get_nz_row + + + interface + subroutine psb_s_diag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_diag_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_diag_vect_mv + end interface + + interface + subroutine psb_s_diag_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_s_diag_sparse_mat, psb_spk_, psb_s_base_vect_type + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_diag_inner_vect_sv + end interface + + interface + subroutine psb_s_diag_reallocate_nz(nz,a) + import :: psb_s_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_diag_sparse_mat), intent(inout) :: a + end subroutine psb_s_diag_reallocate_nz + end interface + + interface + subroutine psb_s_diag_allocate_mnnz(m,n,a,nz) + import :: psb_s_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_diag_allocate_mnnz + end interface + + interface + subroutine psb_s_diag_mold(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_diag_mold + end interface + + interface + subroutine psb_s_diag_to_gpu(a,info, nzrm) + import :: psb_s_diag_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_s_diag_to_gpu + end interface + + interface + subroutine psb_s_cp_diag_from_coo(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_diag_from_coo + end interface + + interface + subroutine psb_s_cp_diag_from_fmt(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_diag_from_fmt + end interface + + interface + subroutine psb_s_mv_diag_from_coo(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_diag_from_coo + end interface + + + interface + subroutine psb_s_mv_diag_from_fmt(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_diag_from_fmt + end interface + + interface + subroutine psb_s_diag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_diag_csmv + end interface + interface + subroutine psb_s_diag_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_diag_csmm + end interface + + interface + subroutine psb_s_diag_scal(d,a,info, side) + import :: psb_s_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_diag_scal + end interface + + interface + subroutine psb_s_diag_scals(d,a,info) + import :: psb_s_diag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_diag_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_diag_sizeof(a) result(res) + implicit none + class(psb_s_diag_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = 8 + res = res + psb_sizeof_sp * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function s_diag_sizeof + + function s_diag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIAG' + end function s_diag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_diag_free(a) + use diagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_s_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_dia_sparse_mat%free() + + return + + end subroutine s_diag_free + + subroutine s_diag_finalize(a) + use diagdev_mod + implicit none + type(psb_s_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine s_diag_finalize + +#else + + interface + subroutine psb_s_diag_mold(a,b,info) + import :: psb_s_diag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_diag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_diag_mold + end interface + +#endif + +end module psb_s_diag_mat_mod diff --git a/gpu/psb_s_dnsg_mat_mod.F90 b/gpu/psb_s_dnsg_mat_mod.F90 new file mode 100644 index 000000000..1c5314635 --- /dev/null +++ b/gpu/psb_s_dnsg_mat_mod.F90 @@ -0,0 +1,294 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_dnsg_mat_mod + + use iso_c_binding + use psb_s_mat_mod + use psb_s_dns_mat_mod + use dnsdev_mod + + type, extends(psb_s_dns_sparse_mat) :: psb_s_dnsg_sparse_mat + ! + ! ITPACK/DNS format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of DNS, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => s_dnsg_get_fmt + ! procedure, pass(a) :: sizeof => s_dnsg_sizeof + procedure, pass(a) :: vect_mv => psb_s_dnsg_vect_mv +!!$ procedure, pass(a) :: csmm => psb_s_dnsg_csmm +!!$ procedure, pass(a) :: csmv => psb_s_dnsg_csmv +!!$ procedure, pass(a) :: in_vect_sv => psb_s_dnsg_inner_vect_sv +!!$ procedure, pass(a) :: scals => psb_s_dnsg_scals +!!$ procedure, pass(a) :: scalv => psb_s_dnsg_scal +!!$ procedure, pass(a) :: reallocate_nz => psb_s_dnsg_reallocate_nz +!!$ procedure, pass(a) :: allocate_mnnz => psb_s_dnsg_allocate_mnnz + ! Note: we *do* need the TO methods, because of the need to invoke SYNC + ! + procedure, pass(a) :: cp_from_coo => psb_s_cp_dnsg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_s_cp_dnsg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_dnsg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_s_mv_dnsg_from_fmt + procedure, pass(a) :: free => s_dnsg_free + procedure, pass(a) :: mold => psb_s_dnsg_mold + procedure, pass(a) :: to_gpu => psb_s_dnsg_to_gpu + final :: s_dnsg_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_dnsg_mold +#endif + end type psb_s_dnsg_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_dnsg_get_nzeros, s_dnsg_free, s_dnsg_get_fmt, & + & s_dnsg_get_size, s_dnsg_get_nz_row + + + interface + subroutine psb_s_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_dnsg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dnsg_vect_mv + end interface +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_s_dnsg_sparse_mat, psb_spk_, psb_s_base_vect_type +!!$ class(psb_s_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_s_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_s_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_s_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_s_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_s_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_s_dnsg_allocate_mnnz +!!$ end interface + + interface + subroutine psb_s_dnsg_mold(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dnsg_mold + end interface + + interface + subroutine psb_s_dnsg_to_gpu(a,info) + import :: psb_s_dnsg_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dnsg_to_gpu + end interface + + interface + subroutine psb_s_cp_dnsg_from_coo(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dnsg_from_coo + end interface + + interface + subroutine psb_s_cp_dnsg_from_fmt(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dnsg_from_fmt + end interface + + interface + subroutine psb_s_mv_dnsg_from_coo(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dnsg_from_coo + end interface + + + interface + subroutine psb_s_mv_dnsg_from_fmt(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dnsg_from_fmt + end interface + +!!$ interface +!!$ subroutine psb_s_dnsg_csmv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:) +!!$ real(psb_spk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_dnsg_csmv +!!$ end interface +!!$ interface +!!$ subroutine psb_s_dnsg_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_dnsg_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_dnsg_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_scal(d,a,info, side) +!!$ import :: psb_s_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_s_dnsg_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_dnsg_scals(d,a,info) +!!$ import :: psb_s_dnsg_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_dnsg_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_dnsg_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + + function s_dnsg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNSG' + end function s_dnsg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_dnsg_free(a) + use dnsdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_s_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_dns_sparse_mat%free() + + return + + end subroutine s_dnsg_free + + subroutine s_dnsg_finalize(a) + use dnsdev_mod + implicit none + type(psb_s_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine s_dnsg_finalize + +#else + + interface + subroutine psb_s_dnsg_mold(a,b,info) + import :: psb_s_dnsg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dnsg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dnsg_mold + end interface + +#endif + +end module psb_s_dnsg_mat_mod diff --git a/gpu/psb_s_elg_mat_mod.F90 b/gpu/psb_s_elg_mat_mod.F90 new file mode 100644 index 000000000..5c4eae9bd --- /dev/null +++ b/gpu/psb_s_elg_mat_mod.F90 @@ -0,0 +1,483 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_elg_mat_mod + + use iso_c_binding + use psb_s_mat_mod + use psb_s_ell_mat_mod + use psb_i_gpu_vect_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_s_ell_sparse_mat) :: psb_s_elg_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of ELL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => s_elg_get_fmt + procedure, pass(a) :: sizeof => s_elg_sizeof + procedure, pass(a) :: vect_mv => psb_s_elg_vect_mv + procedure, pass(a) :: csmm => psb_s_elg_csmm + procedure, pass(a) :: csmv => psb_s_elg_csmv + procedure, pass(a) :: in_vect_sv => psb_s_elg_inner_vect_sv + procedure, pass(a) :: scals => psb_s_elg_scals + procedure, pass(a) :: scalv => psb_s_elg_scal + procedure, pass(a) :: reallocate_nz => psb_s_elg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_elg_allocate_mnnz + procedure, pass(a) :: reinit => s_elg_reinit + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_elg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_s_cp_elg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_elg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_s_mv_elg_from_fmt + procedure, pass(a) :: free => s_elg_free + procedure, pass(a) :: mold => psb_s_elg_mold + procedure, pass(a) :: csput_a => psb_s_elg_csput_a + procedure, pass(a) :: csput_v => psb_s_elg_csput_v + procedure, pass(a) :: is_host => s_elg_is_host + procedure, pass(a) :: is_dev => s_elg_is_dev + procedure, pass(a) :: is_sync => s_elg_is_sync + procedure, pass(a) :: set_host => s_elg_set_host + procedure, pass(a) :: set_dev => s_elg_set_dev + procedure, pass(a) :: set_sync => s_elg_set_sync + procedure, pass(a) :: sync => s_elg_sync + procedure, pass(a) :: from_gpu => psb_s_elg_from_gpu + procedure, pass(a) :: to_gpu => psb_s_elg_to_gpu + procedure, pass(a) :: asb => psb_s_elg_asb + final :: s_elg_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_elg_mold + procedure, pass(a) :: asb => psb_s_elg_asb +#endif + end type psb_s_elg_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_elg_get_nzeros, s_elg_free, s_elg_get_fmt, & + & s_elg_get_size, s_elg_sizeof, s_elg_get_nz_row, s_elg_sync + + + interface + subroutine psb_s_elg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_elg_vect_mv + end interface + + interface + subroutine psb_s_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_s_elg_sparse_mat, psb_spk_, psb_s_base_vect_type + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_elg_inner_vect_sv + end interface + + interface + subroutine psb_s_elg_reallocate_nz(nz,a) + import :: psb_s_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_elg_sparse_mat), intent(inout) :: a + end subroutine psb_s_elg_reallocate_nz + end interface + + interface + subroutine psb_s_elg_allocate_mnnz(m,n,a,nz) + import :: psb_s_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_elg_allocate_mnnz + end interface + + interface + subroutine psb_s_elg_mold(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_mold + end interface + + interface + subroutine psb_s_elg_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_csput_a + end interface + + interface + subroutine psb_s_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_s_elg_sparse_mat, psb_dpk_, psb_ipk_, psb_s_base_vect_type,& + & psb_i_base_vect_type + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_csput_v + end interface + + interface + subroutine psb_s_elg_from_gpu(a,info) + import :: psb_s_elg_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_from_gpu + end interface + + interface + subroutine psb_s_elg_to_gpu(a,info, nzrm) + import :: psb_s_elg_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_s_elg_to_gpu + end interface + + interface + subroutine psb_s_cp_elg_from_coo(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_elg_from_coo + end interface + + interface + subroutine psb_s_cp_elg_from_fmt(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_elg_from_fmt + end interface + + interface + subroutine psb_s_mv_elg_from_coo(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_elg_from_coo + end interface + + + interface + subroutine psb_s_mv_elg_from_fmt(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_elg_from_fmt + end interface + + interface + subroutine psb_s_elg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_elg_csmv + end interface + interface + subroutine psb_s_elg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_elg_csmm + end interface + + interface + subroutine psb_s_elg_scal(d,a,info, side) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_elg_scal + end interface + + interface + subroutine psb_s_elg_scals(d,a,info) + import :: psb_s_elg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_scals + end interface + + interface + subroutine psb_s_elg_asb(a) + import :: psb_s_elg_sparse_mat + class(psb_s_elg_sparse_mat), intent(inout) :: a + end subroutine psb_s_elg_asb + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_elg_sizeof(a) result(res) + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function s_elg_sizeof + + function s_elg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELG' + end function s_elg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + subroutine s_elg_reinit(a,clear) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_s_elg_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + integer(psb_ipk_) :: isz, err_act + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + if (a%is_bld() .or. a%is_upd()) then + ! do nothing + return + else if (a%is_asb()) then + if (a%is_dev().or.a%is_sync()) then + if (clear_) call zeroEllDevice(a%deviceMat) + call a%set_dev() + else if (a%is_host()) then + a%val(:,:) = szero + end if + call a%set_upd() + else + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine s_elg_reinit + + subroutine s_elg_free(a) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_s_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_ell_sparse_mat%free() + call a%set_sync() + + return + + end subroutine s_elg_free + + subroutine s_elg_sync(a) + implicit none + class(psb_s_elg_sparse_mat), target, intent(in) :: a + class(psb_s_elg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine s_elg_sync + + subroutine s_elg_set_host(a) + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine s_elg_set_host + + subroutine s_elg_set_dev(a) + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine s_elg_set_dev + + subroutine s_elg_set_sync(a) + implicit none + class(psb_s_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine s_elg_set_sync + + function s_elg_is_dev(a) result(res) + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function s_elg_is_dev + + function s_elg_is_host(a) result(res) + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function s_elg_is_host + + function s_elg_is_sync(a) result(res) + implicit none + class(psb_s_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function s_elg_is_sync + + subroutine s_elg_finalize(a) + use elldev_mod + implicit none + type(psb_s_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + return + + end subroutine s_elg_finalize + +#else + + interface + subroutine psb_s_elg_asb(a) + import :: psb_s_elg_sparse_mat + class(psb_s_elg_sparse_mat), intent(inout) :: a + end subroutine psb_s_elg_asb + end interface + + interface + subroutine psb_s_elg_mold(a,b,info) + import :: psb_s_elg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_elg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_elg_mold + end interface + +#endif + +end module psb_s_elg_mat_mod diff --git a/gpu/psb_s_gpu_vect_mod.F90 b/gpu/psb_s_gpu_vect_mod.F90 new file mode 100644 index 000000000..1371db53d --- /dev/null +++ b/gpu/psb_s_gpu_vect_mod.F90 @@ -0,0 +1,1989 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_gpu_vect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_s_vect_mod + use psb_i_vect_mod +#ifdef HAVE_SPGPU + use psb_gpu_env_mod + use psb_i_gpu_vect_mod + use psb_i_vectordev_mod + use psb_s_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_s_base_vect_type) :: psb_s_vect_gpu +#ifdef HAVE_SPGPU + integer :: state = is_host + type(c_ptr) :: deviceVect = c_null_ptr + real(c_float), allocatable :: pinned_buffer(:) + type(c_ptr) :: dt_p_buf = c_null_ptr + real(c_float), allocatable :: buffer(:) + type(c_ptr) :: dt_buf = c_null_ptr + integer :: dt_buf_sz = 0 + type(c_ptr) :: i_buf = c_null_ptr + integer :: i_buf_sz = 0 + contains + procedure, pass(x) :: get_nrows => s_gpu_get_nrows + procedure, nopass :: get_fmt => s_gpu_get_fmt + + procedure, pass(x) :: all => s_gpu_all + procedure, pass(x) :: zero => s_gpu_zero + procedure, pass(x) :: asb_m => s_gpu_asb_m + procedure, pass(x) :: sync => s_gpu_sync + procedure, pass(x) :: sync_space => s_gpu_sync_space + procedure, pass(x) :: bld_x => s_gpu_bld_x + procedure, pass(x) :: bld_mn => s_gpu_bld_mn + procedure, pass(x) :: free => s_gpu_free + procedure, pass(x) :: ins_a => s_gpu_ins_a + procedure, pass(x) :: ins_v => s_gpu_ins_v + procedure, pass(x) :: is_host => s_gpu_is_host + procedure, pass(x) :: is_dev => s_gpu_is_dev + procedure, pass(x) :: is_sync => s_gpu_is_sync + procedure, pass(x) :: set_host => s_gpu_set_host + procedure, pass(x) :: set_dev => s_gpu_set_dev + procedure, pass(x) :: set_sync => s_gpu_set_sync + procedure, pass(x) :: set_scal => s_gpu_set_scal +!!$ procedure, pass(x) :: set_vect => s_gpu_set_vect + procedure, pass(x) :: gthzv_x => s_gpu_gthzv_x + procedure, pass(y) :: sctb => s_gpu_sctb + procedure, pass(y) :: sctb_x => s_gpu_sctb_x + procedure, pass(x) :: gthzbuf => s_gpu_gthzbuf + procedure, pass(y) :: sctb_buf => s_gpu_sctb_buf + procedure, pass(x) :: new_buffer => s_gpu_new_buffer + procedure, nopass :: device_wait => s_gpu_device_wait + procedure, pass(x) :: free_buffer => s_gpu_free_buffer + procedure, pass(x) :: maybe_free_buffer => s_gpu_maybe_free_buffer + procedure, pass(x) :: dot_v => s_gpu_dot_v + procedure, pass(x) :: dot_a => s_gpu_dot_a + procedure, pass(y) :: axpby_v => s_gpu_axpby_v + procedure, pass(y) :: axpby_a => s_gpu_axpby_a + procedure, pass(y) :: mlt_v => s_gpu_mlt_v + procedure, pass(y) :: mlt_a => s_gpu_mlt_a + procedure, pass(z) :: mlt_a_2 => s_gpu_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => s_gpu_mlt_v_2 + procedure, pass(x) :: scal => s_gpu_scal + procedure, pass(x) :: nrm2 => s_gpu_nrm2 + procedure, pass(x) :: amax => s_gpu_amax + procedure, pass(x) :: asum => s_gpu_asum + procedure, pass(x) :: absval1 => s_gpu_absval1 + procedure, pass(x) :: absval2 => s_gpu_absval2 + + final :: s_gpu_vect_finalize +#endif + end type psb_s_vect_gpu + + public :: psb_s_vect_gpu_ + private :: constructor + interface psb_s_vect_gpu_ + module procedure constructor + end interface psb_s_vect_gpu_ + +contains + + function constructor(x) result(this) + real(psb_spk_) :: x(:) + type(psb_s_vect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x),info) + + end function constructor + +#ifdef HAVE_SPGPU + + subroutine s_gpu_device_wait() + call psb_cudaSync() + end subroutine s_gpu_device_wait + + subroutine s_gpu_new_buffer(n,x,info) + use psb_realloc_mod + use psb_gpu_env_mod + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + integer(psb_ipk_), intent(out) :: info + + + if (psb_gpu_DeviceHasUVA()) then + if (allocated(x%combuf)) then + if (size(x%combuf) idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + ! + ! Only need a sync in this branch; in the others + ! cudamemCpy acts as a sync point. + ! + if (allocated(x%pinned_buffer)) then + if (size(x%pinned_buffer) < n) then + call inner_unregister(x%pinned_buffer) + deallocate(x%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(x%pinned_buffer)) then + allocate(x%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(x%pinned_buffer,x%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + info = igathMultiVecDeviceFloatVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_p_buf, 1) + call psb_cudaSync() + y(1:n) = x%pinned_buffer(1:n) + + else + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeFloat(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateFloat(x%dt_buf,n) + x%dt_buf_sz=n + end if + if (info == 0) & + & info = igathMultiVecDeviceFloatVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_buf, 1) + if (info == 0) & + & info = readFloat(x%dt_buf,y,n) + + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + + if (x%i_buf_sz < ni) then + if (c_associated(x%i_buf)) then + call freeInt(x%i_buf) + x%i_buf = c_null_ptr + end if + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeFloat(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateFloat(x%dt_buf,n) + x%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(x%i_buf,ii%v,ni) + if (info == 0) & + & info = igathMultiVecDeviceFloat(x%deviceVect,& + & 0, n, i, x%i_buf, 1, x%dt_buf, 1) + if (info == 0) & + & info = readFloat(x%dt_buf,y,n) + + end select + + end subroutine s_gpu_gthzv_x + + subroutine s_gpu_gthzbuf(i,n,idx,x) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i,n + class(psb_i_base_vect_type) :: idx + class(psb_s_vect_gpu) :: x + integer :: info, ni + + info = 0 +!!$ write(0,*) 'Starting gth_zbuf' + if (.not.allocated(x%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'gthzbuf') + return + end if + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + info = igathMultiVecDeviceFloatVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_p_buf, 1) + + else + info = igathMultiVecDeviceFloatVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_buf, 1) + if (info == 0) & + & info = readFloat(i,x%dt_buf,x%combuf(i:),n,1) + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + info = 0 + if (.not.c_associated(x%i_buf)) then + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,x%i_buf,ii%v(i:),n,1) + + if (info == 0) & + & info = igathMultiVecDeviceFloat(x%deviceVect,& + & 0, n, i, x%i_buf, i,x%dt_buf, 1) + + if (info == 0) & + & info = readFloat(i,x%dt_buf,x%combuf(i:),n,1) + + end select + + end subroutine s_gpu_gthzbuf + + subroutine s_gpu_sctb(n,idx,x,beta,y) + implicit none + !use psb_const_mod + integer(psb_ipk_) :: n, idx(:) + real(psb_spk_) :: beta, x(:) + class(psb_s_vect_gpu) :: y + integer(psb_ipk_) :: info + + if (n == 0) return + + if (y%is_dev()) call y%sync() + + call y%psb_s_base_vect_type%sctb(n,idx,x,beta) + call y%set_host() + + end subroutine s_gpu_sctb + + subroutine s_gpu_sctb_x(i,n,idx,x,beta,y) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + real(psb_spk_) :: beta, x(:) + class(psb_s_vect_gpu) :: y + integer :: info, ni + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + + ! + if (psb_gpu_DeviceHasUVA()) then + if (allocated(y%pinned_buffer)) then + if (size(y%pinned_buffer) < n) then + call inner_unregister(y%pinned_buffer) + deallocate(y%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(y%pinned_buffer)) then + allocate(y%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(y%pinned_buffer,y%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + y%pinned_buffer(1:n) = x(1:n) + info = iscatMultiVecDeviceFloatVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_p_buf, 1,beta) + else + + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeFloat(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateFloat(y%dt_buf,n) + y%dt_buf_sz=n + end if + info = writeFloat(y%dt_buf,x,n) + info = iscatMultiVecDeviceFloatVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_buf, 1,beta) + + end if + + class default + ni = size(ii%v) + + if (y%i_buf_sz < ni) then + if (c_associated(y%i_buf)) then + call freeInt(y%i_buf) + y%i_buf = c_null_ptr + end if + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeFloat(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateFloat(y%dt_buf,n) + y%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(y%i_buf,ii%v(i:i+n-1),n) + info = writeFloat(y%dt_buf,x,n) + info = iscatMultiVecDeviceFloat(y%deviceVect,& + & 0, n, 1, y%i_buf, 1, y%dt_buf, 1,beta) + + + end select + ! + ! Need a sync here to make sure we are not reallocating + ! the buffers before iscatMulti has finished. + ! + call psb_cudaSync() + call y%set_dev() + + end subroutine s_gpu_sctb_x + + subroutine s_gpu_sctb_buf(i,n,idx,beta,y) + use psi_serial_mod + use psb_gpu_env_mod + implicit none + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + real(psb_spk_) :: beta + class(psb_s_vect_gpu) :: y + integer(psb_ipk_) :: info, ni + +!!$ write(0,*) 'Starting sctb_buf' + if (.not.allocated(y%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'sctb_buf') + return + end if + + + select type(ii=> idx) + class is (psb_i_vect_gpu) + + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + if (psb_gpu_DeviceHasUVA()) then + info = iscatMultiVecDeviceFloatVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_p_buf, 1,beta) + else + info = writeFloat(i,y%dt_buf,y%combuf(i:),n,1) + info = iscatMultiVecDeviceFloatVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_buf, 1,beta) + + end if + + class default + !call y%sct(n,ii%v(i:),x,beta) + ni = size(ii%v) + info = 0 + if (.not.c_associated(y%i_buf)) then + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,y%i_buf,ii%v(i:),n,1) + if (info == 0) & + & info = writeFloat(i,y%dt_buf,y%combuf(i:),n,1) + if (info == 0) info = iscatMultiVecDeviceFloat(y%deviceVect,& + & 0, n, i, y%i_buf, i, y%dt_buf, 1,beta) + end select +!!$ write(0,*) 'Done sctb_buf' + + end subroutine s_gpu_sctb_buf + + + subroutine s_gpu_bld_x(x,this) + use psb_base_mod + real(psb_spk_), intent(in) :: this(:) + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'s_gpu_bld_x',& + & i_err=(/size(this),izero,izero,izero,izero/)) + end if + x%v(:) = this(:) + call x%set_host() + call x%sync() + + end subroutine s_gpu_bld_x + + subroutine s_gpu_bld_mn(x,n) + integer(psb_mpk_), intent(in) :: n + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(n,info) + if (info /= 0) then + call psb_errpush(info,'s_gpu_bld_n',i_err=(/n,n,n,n,n/)) + end if + + end subroutine s_gpu_bld_mn + + subroutine s_gpu_set_host(x) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine s_gpu_set_host + + subroutine s_gpu_set_dev(x) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine s_gpu_set_dev + + subroutine s_gpu_set_sync(x) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine s_gpu_set_sync + + function s_gpu_is_dev(x) result(res) + implicit none + class(psb_s_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function s_gpu_is_dev + + function s_gpu_is_host(x) result(res) + implicit none + class(psb_s_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function s_gpu_is_host + + function s_gpu_is_sync(x) result(res) + implicit none + class(psb_s_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function s_gpu_is_sync + + + function s_gpu_get_nrows(x) result(res) + implicit none + class(psb_s_vect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = 0 + if (allocated(x%v)) res = size(x%v) + end function s_gpu_get_nrows + + function s_gpu_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'sGPU' + end function s_gpu_get_fmt + + subroutine s_gpu_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: n + class(psb_s_vect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(n,x%v,info) + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'s_gpu_all',& + & i_err=(/n,n,n,n,n/)) + end if + end subroutine s_gpu_all + + subroutine s_gpu_zero(x) + use psi_serial_mod + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=szero + call x%set_host() + end subroutine s_gpu_zero + + subroutine s_gpu_asb_m(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_mpk_), intent(in) :: n + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: nd + + if (x%is_dev()) then + nd = getMultiVecDeviceSize(x%deviceVect) + if (nd < n) then + call x%sync() + call x%psb_s_base_vect_type%asb(n,info) + if (info == psb_success_) call x%sync_space(info) + call x%set_host() + end if + else ! + if (x%get_nrows() size(x%v)).or.(n > x%get_nrows())) then +!!$ write(0,*) 'Incoherent situation : sizes',n,size(x%v),x%get_nrows() + call psb_realloc(n,x%v,info) + end if + info = readMultiVecDevice(x%deviceVect,x%v) + end if + if (info == 0) call x%set_sync() + if (info /= 0) then + info=psb_err_internal_error_ + call psb_errpush(info,'s_gpu_sync') + end if + + end subroutine s_gpu_sync + + subroutine s_gpu_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (c_associated(x%deviceVect)) then +!!$ write(0,*)'d_gpu_free Calling freeMultiVecDevice' + call freeMultiVecDevice(x%deviceVect) + x%deviceVect=c_null_ptr + end if + call x%free_buffer(info) + call x%set_sync() + end subroutine s_gpu_free + + subroutine s_gpu_set_scal(x,val,first,last) + class(psb_s_vect_gpu), intent(inout) :: x + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), optional :: first, last + + integer(psb_ipk_) :: info, first_, last_ + + first_ = 1 + last_ = x%get_nrows() + if (present(first)) first_ = max(1,first) + if (present(last)) last_ = min(last,last_) + + if (x%is_host()) call x%sync() + info = setScalDevice(val,first_,last_,1,x%deviceVect) + call x%set_dev() + + end subroutine s_gpu_set_scal +!!$ +!!$ subroutine s_gpu_set_vect(x,val) +!!$ class(psb_s_vect_gpu), intent(inout) :: x +!!$ real(psb_spk_), intent(in) :: val(:) +!!$ integer(psb_ipk_) :: nr +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_s_base_vect_type%set_vect(val) +!!$ call x%set_host() +!!$ +!!$ end subroutine s_gpu_set_vect + + + + function s_gpu_dot_v(n,x,y) result(res) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: ddot + integer(psb_ipk_) :: info + + res = szero + ! + ! Note: this is the gpu implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_s_vect + ! + select type(yy => y) + type is (psb_s_base_vect_type) + if (x%is_dev()) call x%sync() + res = ddot(n,x%v,1,yy%v,1) + type is (psb_s_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) + if (info /= 0) then + info = psb_err_internal_error_ + call psb_errpush(info,'s_gpu_dot_v') + end if + + class default + ! y%sync is done in dot_a + call x%sync() + res = y%dot(n,x%v) + end select + + end function s_gpu_dot_v + + function s_gpu_dot_a(n,x,y) result(res) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + real(psb_spk_), intent(in) :: y(:) + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: ddot + + if (x%is_dev()) call x%sync() + res = ddot(n,y,1,x%v,1) + + end function s_gpu_dot_a + + subroutine s_gpu_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer(psb_ipk_), intent(in) :: m + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_vect_gpu), intent(inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nx, ny + + info = psb_success_ + + select type(xx => x) + type is (psb_s_vect_gpu) + ! Do something different here + if ((beta /= szero).and.y%is_host())& + & call y%sync() + if (xx%is_host()) call xx%sync() + nx = getMultiVecDeviceSize(xx%deviceVect) + ny = getMultiVecDeviceSize(y%deviceVect) + if ((nx x) + type is (psb_s_base_vect_type) + if (y%is_dev()) call y%sync() + do i=1, n + y%v(i) = y%v(i) * xx%v(i) + end do + call y%set_host() + type is (psb_s_vect_gpu) + ! Do something different here + if (y%is_host()) call y%sync() + if (xx%is_host()) call xx%sync() + info = axyMultiVecDevice(n,sone,xx%deviceVect,y%deviceVect) + call y%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (y%is_dev()) call y%sync() + call y%mlt(xx%v,info) + call y%set_host() + end select + + end subroutine s_gpu_mlt_v + + subroutine s_gpu_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: x(:) + class(psb_s_vect_gpu), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + call y%psb_s_base_vect_type%mlt(x,info) + ! set_host() is invoked in the base method + end subroutine s_gpu_mlt_a + + subroutine s_gpu_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: x(:) + real(psb_spk_), intent(in) :: y(:) + class(psb_s_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (z%is_dev()) call z%sync() + call z%psb_s_base_vect_type%mlt(alpha,x,y,beta,info) + ! set_host() is invoked in the base method + end subroutine s_gpu_mlt_a_2 + + subroutine s_gpu_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + class(psb_s_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer(psb_ipk_) :: i, n + logical :: conjgx_, conjgy_ + + if (.false.) then + ! These are present just for coherence with the + ! complex versions; they do nothing here. + conjgx_=.false. + if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') + conjgy_=.false. + if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') + end if + + n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) + + ! + ! Need to reconsider BETA in the GPU side + ! of things. + ! + info = 0 + select type(xx => x) + type is (psb_s_vect_gpu) + select type (yy => y) + type is (psb_s_vect_gpu) + if (xx%is_host()) call xx%sync() + if (yy%is_host()) call yy%sync() + if ((beta /= szero).and.(z%is_host())) call z%sync() + info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& + & yy%deviceVect,beta,z%deviceVect) + call z%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (yy%is_dev()) call yy%sync() + if ((beta /= szero).and.(z%is_dev())) call z%sync() + call z%psb_s_base_vect_type%mlt(alpha,xx,yy,beta,info) + call z%set_host() + end select + + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + if ((beta /= szero).and.(z%is_dev())) call z%sync() + call z%psb_s_base_vect_type%mlt(alpha,x,y,beta,info) + call z%set_host() + end select + end subroutine s_gpu_mlt_v_2 + + subroutine s_gpu_scal(alpha, x) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + real(psb_spk_), intent (in) :: alpha + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = scalMultiVecDevice(alpha,x%deviceVect) + call x%set_dev() + end subroutine s_gpu_scal + + + function s_gpu_nrm2(n,x) result(res) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + ! WARNING: this should be changed. + if (x%is_host()) call x%sync() + info = nrm2MultiVecDevice(res,n,x%deviceVect) + + end function s_gpu_nrm2 + + function s_gpu_amax(n,x) result(res) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = amaxMultiVecDevice(res,n,x%deviceVect) + + end function s_gpu_amax + + function s_gpu_asum(n,x) result(res) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_spk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = asumMultiVecDevice(res,n,x%deviceVect) + + end function s_gpu_asum + + subroutine s_gpu_absval1(x) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + n=x%get_nrows() + info = absMultiVecDevice(n,sone,x%deviceVect) + + end subroutine s_gpu_absval1 + + subroutine s_gpu_absval2(x,y) + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + n=min(x%get_nrows(),y%get_nrows()) + select type (yy=> y) + class is (psb_s_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = absMultiVecDevice(n,sone,x%deviceVect,yy%deviceVect) + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + call x%psb_s_base_vect_type%absval(y) + end select + end subroutine s_gpu_absval2 + + + subroutine s_gpu_vect_finalize(x) + use psi_serial_mod + use psb_realloc_mod + implicit none + type(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + info = 0 + call x%free(info) + end subroutine s_gpu_vect_finalize + + subroutine s_gpu_ins_v(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + class(psb_i_base_vect_type), intent(inout) :: irl + class(psb_s_base_vect_type), intent(inout) :: val + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i, isz + logical :: done_gpu + + info = 0 + if (psb_errstatus_fatal()) return + + done_gpu = .false. + select type(virl => irl) + class is (psb_i_vect_gpu) + select type(vval => val) + class is (psb_s_vect_gpu) + if (vval%is_host()) call vval%sync() + if (virl%is_host()) call virl%sync() + if (x%is_host()) call x%sync() + info = geinsMultiVecDeviceFloat(n,virl%deviceVect,& + & vval%deviceVect,dupl,1,x%deviceVect) + call x%set_dev() + done_gpu=.true. + end select + end select + + if (.not.done_gpu) then + if (irl%is_dev()) call irl%sync() + if (val%is_dev()) call val%sync() + call x%ins(n,irl%v,val%v,dupl,info) + end if + + if (info /= 0) then + call psb_errpush(info,'gpu_vect_ins') + return + end if + + end subroutine s_gpu_ins_v + + subroutine s_gpu_ins_a(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_s_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + integer(psb_ipk_), intent(in) :: irl(:) + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i + + info = 0 + if (x%is_dev()) call x%sync() + call x%psb_s_base_vect_type%ins(n,irl,val,dupl,info) + call x%set_host() + + end subroutine s_gpu_ins_a + +#endif + +end module psb_s_gpu_vect_mod + + +! +! Multivectors +! + + + +module psb_s_gpu_multivect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_s_multivect_mod + use psb_s_base_multivect_mod + + use psb_i_multivect_mod +#ifdef HAVE_SPGPU + use psb_i_gpu_multivect_mod + use psb_s_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_s_base_multivect_type) :: psb_s_multivect_gpu +#ifdef HAVE_SPGPU + + integer(psb_ipk_) :: state = is_host, m_nrows=0, m_ncols=0 + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: buffer(:,:) + type(c_ptr) :: dt_buf = c_null_ptr + contains + procedure, pass(x) :: get_nrows => s_gpu_multi_get_nrows + procedure, pass(x) :: get_ncols => s_gpu_multi_get_ncols + procedure, nopass :: get_fmt => s_gpu_multi_get_fmt +!!$ procedure, pass(x) :: dot_v => s_gpu_multi_dot_v +!!$ procedure, pass(x) :: dot_a => s_gpu_multi_dot_a +!!$ procedure, pass(y) :: axpby_v => s_gpu_multi_axpby_v +!!$ procedure, pass(y) :: axpby_a => s_gpu_multi_axpby_a +!!$ procedure, pass(y) :: mlt_v => s_gpu_multi_mlt_v +!!$ procedure, pass(y) :: mlt_a => s_gpu_multi_mlt_a +!!$ procedure, pass(z) :: mlt_a_2 => s_gpu_multi_mlt_a_2 +!!$ procedure, pass(z) :: mlt_v_2 => s_gpu_multi_mlt_v_2 +!!$ procedure, pass(x) :: scal => s_gpu_multi_scal +!!$ procedure, pass(x) :: nrm2 => s_gpu_multi_nrm2 +!!$ procedure, pass(x) :: amax => s_gpu_multi_amax +!!$ procedure, pass(x) :: asum => s_gpu_multi_asum + procedure, pass(x) :: all => s_gpu_multi_all + procedure, pass(x) :: zero => s_gpu_multi_zero + procedure, pass(x) :: asb => s_gpu_multi_asb + procedure, pass(x) :: sync => s_gpu_multi_sync + procedure, pass(x) :: sync_space => s_gpu_multi_sync_space + procedure, pass(x) :: bld_x => s_gpu_multi_bld_x + procedure, pass(x) :: bld_n => s_gpu_multi_bld_n + procedure, pass(x) :: free => s_gpu_multi_free + procedure, pass(x) :: ins => s_gpu_multi_ins + procedure, pass(x) :: is_host => s_gpu_multi_is_host + procedure, pass(x) :: is_dev => s_gpu_multi_is_dev + procedure, pass(x) :: is_sync => s_gpu_multi_is_sync + procedure, pass(x) :: set_host => s_gpu_multi_set_host + procedure, pass(x) :: set_dev => s_gpu_multi_set_dev + procedure, pass(x) :: set_sync => s_gpu_multi_set_sync + procedure, pass(x) :: set_scal => s_gpu_multi_set_scal + procedure, pass(x) :: set_vect => s_gpu_multi_set_vect +!!$ procedure, pass(x) :: gthzv_x => s_gpu_multi_gthzv_x +!!$ procedure, pass(y) :: sctb => s_gpu_multi_sctb +!!$ procedure, pass(y) :: sctb_x => s_gpu_multi_sctb_x + final :: s_gpu_multi_vect_finalize +#endif + end type psb_s_multivect_gpu + + public :: psb_s_multivect_gpu + private :: constructor + interface psb_s_multivect_gpu + module procedure constructor + end interface + +contains + + function constructor(x) result(this) + real(psb_spk_) :: x(:,:) + type(psb_s_multivect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x,1),size(x,2),info) + + end function constructor + +#ifdef HAVE_SPGPU + +!!$ subroutine s_gpu_multi_gthzv_x(i,n,idx,x,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i,n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ real(psb_spk_) :: y(:) +!!$ class(psb_s_multivect_gpu) :: x +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (x%is_host()) call x%sync() +!!$ +!!$ if (allocated(x%buffer)) then +!!$ if (size(x%buffer) < n) then +!!$ call inner_unregister(x%buffer) +!!$ deallocate(x%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(x%buffer)) then +!!$ allocate(x%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(x%buffer,x%dt_buf) +!!$ endif +!!$ info = igathMultiVecDeviceDouble(x%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, x%dt_buf, 1) +!!$ call psb_cudaSync() +!!$ y(1:n) = x%buffer(1:n) +!!$ +!!$ class default +!!$ call x%gth(n,ii%v(i:),y) +!!$ end select +!!$ +!!$ +!!$ end subroutine s_gpu_multi_gthzv_x +!!$ +!!$ +!!$ +!!$ subroutine s_gpu_multi_sctb(n,idx,x,beta,y) +!!$ implicit none +!!$ !use psb_const_mod +!!$ integer(psb_ipk_) :: n, idx(:) +!!$ real(psb_spk_) :: beta, x(:) +!!$ class(psb_s_multivect_gpu) :: y +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (n == 0) return +!!$ +!!$ if (y%is_dev()) call y%sync() +!!$ +!!$ call y%psb_s_base_multivect_type%sctb(n,idx,x,beta) +!!$ call y%set_host() +!!$ +!!$ end subroutine s_gpu_multi_sctb +!!$ +!!$ subroutine s_gpu_multi_sctb_x(i,n,idx,x,beta,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i, n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ real(psb_spk_) :: beta, x(:) +!!$ class(psb_s_multivect_gpu) :: y +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (y%is_host()) call y%sync() +!!$ +!!$ if (allocated(y%buffer)) then +!!$ if (size(y%buffer) < n) then +!!$ call inner_unregister(y%buffer) +!!$ deallocate(y%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(y%buffer)) then +!!$ allocate(y%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(y%buffer,y%dt_buf) +!!$ endif +!!$ y%buffer(1:n) = x(1:n) +!!$ info = iscatMultiVecDeviceDouble(y%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, y%dt_buf, 1,beta) +!!$ +!!$ call y%set_dev() +!!$ call psb_cudaSync() +!!$ +!!$ class default +!!$ call y%sct(n,ii%v(i:),x,beta) +!!$ end select +!!$ +!!$ end subroutine s_gpu_multi_sctb_x + + + subroutine s_gpu_multi_bld_x(x,this) + use psb_base_mod + real(psb_spk_), intent(in) :: this(:,:) + class(psb_s_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info, m, n + + m=size(this,1) + n=size(this,2) + x%m_nrows = m + x%m_ncols = n + call psb_realloc(m,n,x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'s_gpu_multi_bld_x',& + & i_err=(/size(this,1),size(this,2),izero,izero,izero,izero/)) + end if + x%v(1:m,1:n) = this(1:m,1:n) + call x%set_host() + call x%sync() + + end subroutine s_gpu_multi_bld_x + + subroutine s_gpu_multi_bld_n(x,m,n) + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(m,n,info) + if (info /= 0) then + call psb_errpush(info,'s_gpu_multi_bld_n',i_err=(/m,n,n,n,n/)) + end if + + end subroutine s_gpu_multi_bld_n + + + subroutine s_gpu_multi_set_host(x) + implicit none + class(psb_s_multivect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine s_gpu_multi_set_host + + subroutine s_gpu_multi_set_dev(x) + implicit none + class(psb_s_multivect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine s_gpu_multi_set_dev + + subroutine s_gpu_multi_set_sync(x) + implicit none + class(psb_s_multivect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine s_gpu_multi_set_sync + + function s_gpu_multi_is_dev(x) result(res) + implicit none + class(psb_s_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function s_gpu_multi_is_dev + + function s_gpu_multi_is_host(x) result(res) + implicit none + class(psb_s_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function s_gpu_multi_is_host + + function s_gpu_multi_is_sync(x) result(res) + implicit none + class(psb_s_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function s_gpu_multi_is_sync + + + function s_gpu_multi_get_nrows(x) result(res) + implicit none + class(psb_s_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_nrows + + end function s_gpu_multi_get_nrows + + function s_gpu_multi_get_ncols(x) result(res) + implicit none + class(psb_s_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_ncols + + end function s_gpu_multi_get_ncols + + function s_gpu_multi_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'sGPU' + end function s_gpu_multi_get_fmt + +!!$ function s_gpu_multi_dot_v(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ class(psb_s_base_multivect_type), intent(inout) :: y +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ real(psb_spk_), external :: ddot +!!$ integer(psb_ipk_) :: info +!!$ +!!$ res = dzero +!!$ ! +!!$ ! Note: this is the gpu implementation. +!!$ ! When we get here, we are sure that X is of +!!$ ! TYPE psb_s_vect +!!$ ! +!!$ select type(yy => y) +!!$ type is (psb_s_base_multivect_type) +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,x%v,1,yy%v,1) +!!$ type is (psb_s_multivect_gpu) +!!$ if (x%is_host()) call x%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) +!!$ if (info /= 0) then +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,'s_gpu_multi_dot_v') +!!$ end if +!!$ +!!$ class default +!!$ ! y%sync is done in dot_a +!!$ call x%sync() +!!$ res = y%dot(n,x%v) +!!$ end select +!!$ +!!$ end function s_gpu_multi_dot_v +!!$ +!!$ function s_gpu_multi_dot_a(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ real(psb_spk_), intent(in) :: y(:) +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ real(psb_spk_), external :: ddot +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,y,1,x%v,1) +!!$ +!!$ end function s_gpu_multi_dot_a +!!$ +!!$ subroutine s_gpu_multi_axpby_v(m,alpha, x, beta, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: m +!!$ class(psb_s_base_multivect_type), intent(inout) :: x +!!$ class(psb_s_multivect_gpu), intent(inout) :: y +!!$ real(psb_spk_), intent (in) :: alpha, beta +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: nx, ny +!!$ +!!$ info = psb_success_ +!!$ +!!$ select type(xx => x) +!!$ type is (psb_s_base_multivect_type) +!!$ if ((beta /= dzero).and.(y%is_dev()))& +!!$ & call y%sync() +!!$ call psb_geaxpby(m,alpha,xx%v,beta,y%v,info) +!!$ call y%set_host() +!!$ type is (psb_s_multivect_gpu) +!!$ ! Do something different here +!!$ if ((beta /= dzero).and.y%is_host())& +!!$ & call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ nx = getMultiVecDeviceSize(xx%deviceVect) +!!$ ny = getMultiVecDeviceSize(y%deviceVect) +!!$ if ((nx x) +!!$ type is (psb_s_base_multivect_type) +!!$ if (y%is_dev()) call y%sync() +!!$ do i=1, n +!!$ y%v(i) = y%v(i) * xx%v(i) +!!$ end do +!!$ call y%set_host() +!!$ type is (psb_s_multivect_gpu) +!!$ ! Do something different here +!!$ if (y%is_host()) call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) +!!$ call y%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call y%mlt(xx%v,info) +!!$ call y%set_host() +!!$ end select +!!$ +!!$ end subroutine s_gpu_multi_mlt_v +!!$ +!!$ subroutine s_gpu_multi_mlt_a(x, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ real(psb_spk_), intent(in) :: x(:) +!!$ class(psb_s_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ call y%sync() +!!$ call y%psb_s_base_multivect_type%mlt(x,info) +!!$ call y%set_host() +!!$ end subroutine s_gpu_multi_mlt_a +!!$ +!!$ subroutine s_gpu_multi_mlt_a_2(alpha,x,y,beta,z,info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ real(psb_spk_), intent(in) :: alpha,beta +!!$ real(psb_spk_), intent(in) :: x(:) +!!$ real(psb_spk_), intent(in) :: y(:) +!!$ class(psb_s_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ if (z%is_dev()) call z%sync() +!!$ call z%psb_s_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end subroutine s_gpu_multi_mlt_a_2 +!!$ +!!$ subroutine s_gpu_multi_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) +!!$ use psi_serial_mod +!!$ use psb_string_mod +!!$ implicit none +!!$ real(psb_spk_), intent(in) :: alpha,beta +!!$ class(psb_s_base_multivect_type), intent(inout) :: x +!!$ class(psb_s_base_multivect_type), intent(inout) :: y +!!$ class(psb_s_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character(len=1), intent(in), optional :: conjgx, conjgy +!!$ integer(psb_ipk_) :: i, n +!!$ logical :: conjgx_, conjgy_ +!!$ +!!$ if (.false.) then +!!$ ! These are present just for coherence with the +!!$ ! complex versions; they do nothing here. +!!$ conjgx_=.false. +!!$ if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') +!!$ conjgy_=.false. +!!$ if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') +!!$ end if +!!$ +!!$ n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) +!!$ +!!$ ! +!!$ ! Need to reconsider BETA in the GPU side +!!$ ! of things. +!!$ ! +!!$ info = 0 +!!$ select type(xx => x) +!!$ type is (psb_s_multivect_gpu) +!!$ select type (yy => y) +!!$ type is (psb_s_multivect_gpu) +!!$ if (xx%is_host()) call xx%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ ! Z state is irrelevant: it will be done on the GPU. +!!$ info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& +!!$ & yy%deviceVect,beta,z%deviceVect) +!!$ call z%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call yy%sync() +!!$ call z%psb_s_base_multivect_type%mlt(alpha,xx,yy,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ +!!$ class default +!!$ call x%sync() +!!$ call y%sync() +!!$ call z%psb_s_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ end subroutine s_gpu_multi_mlt_v_2 + + + subroutine s_gpu_multi_set_scal(x,val) + class(psb_s_multivect_gpu), intent(inout) :: x + real(psb_spk_), intent(in) :: val + + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_s_base_multivect_type%set_scal(val) + call x%set_host() + end subroutine s_gpu_multi_set_scal + + subroutine s_gpu_multi_set_vect(x,val) + class(psb_s_multivect_gpu), intent(inout) :: x + real(psb_spk_), intent(in) :: val(:,:) + integer(psb_ipk_) :: nr + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_s_base_multivect_type%set_vect(val) + call x%set_host() + + end subroutine s_gpu_multi_set_vect + + + +!!$ subroutine s_gpu_multi_scal(alpha, x) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ real(psb_spk_), intent (in) :: alpha +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_s_base_multivect_type%scal(alpha) +!!$ call x%set_host() +!!$ end subroutine s_gpu_multi_scal +!!$ +!!$ +!!$ function s_gpu_multi_nrm2(n,x) result(res) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ integer(psb_ipk_) :: info +!!$ ! WARNING: this should be changed. +!!$ if (x%is_host()) call x%sync() +!!$ info = nrm2MultiVecDevice(res,n,x%deviceVect) +!!$ +!!$ end function s_gpu_multi_nrm2 +!!$ +!!$ function s_gpu_multi_amax(n,x) result(res) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = maxval(abs(x%v(1:n))) +!!$ +!!$ end function s_gpu_multi_amax +!!$ +!!$ function s_gpu_multi_asum(n,x) result(res) +!!$ implicit none +!!$ class(psb_s_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_spk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = sum(abs(x%v(1:n))) +!!$ +!!$ end function s_gpu_multi_asum + + subroutine s_gpu_multi_all(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_multivect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(m,n,x%v,info,pad=szero) + x%m_nrows = m + x%m_ncols = n + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'s_gpu_multi_all',& + & i_err=(/m,n,n,n,n/)) + end if + end subroutine s_gpu_multi_all + + subroutine s_gpu_multi_zero(x) + use psi_serial_mod + implicit none + class(psb_s_multivect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine s_gpu_multi_zero + + subroutine s_gpu_multi_asb(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nd, nc + + + x%m_nrows = m + x%m_ncols = n + if (x%is_host()) then + call x%psb_s_base_multivect_type%asb(m,n,info) + if (info == psb_success_) call x%sync_space(info) + else if (x%is_dev()) then + nd = getMultiVecDevicePitch(x%deviceVect) + nc = getMultiVecDeviceCount(x%deviceVect) + if ((nd < m).or.(nc s_hdiag_get_fmt + ! procedure, pass(a) :: sizeof => s_hdiag_sizeof + procedure, pass(a) :: vect_mv => psb_s_hdiag_vect_mv + ! procedure, pass(a) :: csmm => psb_s_hdiag_csmm + procedure, pass(a) :: csmv => psb_s_hdiag_csmv + ! procedure, pass(a) :: in_vect_sv => psb_s_hdiag_inner_vect_sv + ! procedure, pass(a) :: scals => psb_s_hdiag_scals + ! procedure, pass(a) :: scalv => psb_s_hdiag_scal + ! procedure, pass(a) :: reallocate_nz => psb_s_hdiag_reallocate_nz + ! procedure, pass(a) :: allocate_mnnz => psb_s_hdiag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_hdiag_from_coo + ! procedure, pass(a) :: cp_from_fmt => psb_s_cp_hdiag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_hdiag_from_coo + ! procedure, pass(a) :: mv_from_fmt => psb_s_mv_hdiag_from_fmt + procedure, pass(a) :: free => s_hdiag_free + procedure, pass(a) :: mold => psb_s_hdiag_mold + procedure, pass(a) :: to_gpu => psb_s_hdiag_to_gpu + final :: s_hdiag_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_hdiag_mold +#endif + end type psb_s_hdiag_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_hdiag_get_nzeros, s_hdiag_free, s_hdiag_get_fmt, & + & s_hdiag_get_size, s_hdiag_sizeof, s_hdiag_get_nz_row + + + interface + subroutine psb_s_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hdiag_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hdiag_vect_mv + end interface + +!!$ interface +!!$ subroutine psb_s_hdiag_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_s_hdiag_sparse_mat, psb_spk_, psb_s_base_vect_type +!!$ class(psb_s_hdiag_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta +!!$ class(psb_s_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_hdiag_inner_vect_sv +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdiag_reallocate_nz(nz,a) +!!$ import :: psb_s_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_s_hdiag_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdiag_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_s_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_s_hdiag_allocate_mnnz +!!$ end interface + + interface + subroutine psb_s_hdiag_mold(a,b,info) + import :: psb_s_hdiag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hdiag_mold + end interface + + interface + subroutine psb_s_hdiag_to_gpu(a,info) + import :: psb_s_hdiag_sparse_mat, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hdiag_to_gpu + end interface + + interface + subroutine psb_s_cp_hdiag_from_coo(a,b,info) + import :: psb_s_hdiag_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hdiag_from_coo + end interface + +!!$ interface +!!$ subroutine psb_s_cp_hdiag_from_fmt(a,b,info) +!!$ import :: psb_s_hdiag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_s_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_cp_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_s_mv_hdiag_from_coo(a,b,info) + import :: psb_s_hdiag_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hdiag_from_coo + end interface + +!!$ +!!$ interface +!!$ subroutine psb_s_mv_hdiag_from_fmt(a,b,info) +!!$ import :: psb_s_hdiag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_s_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_mv_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_s_hdiag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hdiag_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hdiag_csmv + end interface + +!!$ interface +!!$ subroutine psb_s_hdiag_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdiag_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_hdiag_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdiag_scal(d,a,info, side) +!!$ import :: psb_s_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_s_hdiag_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdiag_scals(d,a,info) +!!$ import :: psb_s_hdiag_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdiag_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_hdiag_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + function s_hdiag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIAG' + end function s_hdiag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_hdiag_free(a) + use hdiagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_s_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_hdia_sparse_mat%free() + + return + + end subroutine s_hdiag_free + + subroutine s_hdiag_finalize(a) + use hdiagdev_mod + implicit none + type(psb_s_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_hdia_sparse_mat%free() + + return + end subroutine s_hdiag_finalize + +#else + + interface + subroutine psb_s_hdiag_mold(a,b,info) + import :: psb_s_hdiag_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hdiag_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hdiag_mold + end interface + +#endif + +end module psb_s_hdiag_mat_mod diff --git a/gpu/psb_s_hlg_mat_mod.F90 b/gpu/psb_s_hlg_mat_mod.F90 new file mode 100644 index 000000000..8f896e4bd --- /dev/null +++ b/gpu/psb_s_hlg_mat_mod.F90 @@ -0,0 +1,398 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_hlg_mat_mod + + use iso_c_binding + use psb_s_mat_mod + use psb_s_hll_mat_mod + + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_s_hll_sparse_mat) :: psb_s_hlg_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer :: devstate = is_host + + contains + procedure, nopass :: get_fmt => s_hlg_get_fmt + procedure, pass(a) :: sizeof => s_hlg_sizeof + procedure, pass(a) :: vect_mv => psb_s_hlg_vect_mv + procedure, pass(a) :: csmm => psb_s_hlg_csmm + procedure, pass(a) :: csmv => psb_s_hlg_csmv + procedure, pass(a) :: in_vect_sv => psb_s_hlg_inner_vect_sv + procedure, pass(a) :: scals => psb_s_hlg_scals + procedure, pass(a) :: scalv => psb_s_hlg_scal + procedure, pass(a) :: reallocate_nz => psb_s_hlg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_hlg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_hlg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_s_cp_hlg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_hlg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_s_mv_hlg_from_fmt + procedure, pass(a) :: free => s_hlg_free + procedure, pass(a) :: mold => psb_s_hlg_mold + procedure, pass(a) :: is_host => s_hlg_is_host + procedure, pass(a) :: is_dev => s_hlg_is_dev + procedure, pass(a) :: is_sync => s_hlg_is_sync + procedure, pass(a) :: set_host => s_hlg_set_host + procedure, pass(a) :: set_dev => s_hlg_set_dev + procedure, pass(a) :: set_sync => s_hlg_set_sync + procedure, pass(a) :: sync => s_hlg_sync + procedure, pass(a) :: from_gpu => psb_s_hlg_from_gpu + procedure, pass(a) :: to_gpu => psb_s_hlg_to_gpu + final :: s_hlg_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_hlg_mold +#endif + end type psb_s_hlg_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_hlg_get_nzeros, s_hlg_free, s_hlg_get_fmt, & + & s_hlg_get_size, s_hlg_sizeof, s_hlg_get_nz_row + + + interface + subroutine psb_s_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hlg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hlg_vect_mv + end interface + + interface + subroutine psb_s_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_s_hlg_sparse_mat, psb_spk_, psb_s_base_vect_type + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hlg_inner_vect_sv + end interface + + interface + subroutine psb_s_hlg_reallocate_nz(nz,a) + import :: psb_s_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hlg_sparse_mat), intent(inout) :: a + end subroutine psb_s_hlg_reallocate_nz + end interface + + interface + subroutine psb_s_hlg_allocate_mnnz(m,n,a,nz) + import :: psb_s_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_hlg_allocate_mnnz + end interface + + interface + subroutine psb_s_hlg_mold(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hlg_mold + end interface + + interface + subroutine psb_s_hlg_from_gpu(a,info) + import :: psb_s_hlg_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hlg_from_gpu + end interface + + interface + subroutine psb_s_hlg_to_gpu(a,info, nzrm) + import :: psb_s_hlg_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_s_hlg_to_gpu + end interface + + interface + subroutine psb_s_cp_hlg_from_coo(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hlg_from_coo + end interface + + interface + subroutine psb_s_cp_hlg_from_fmt(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hlg_from_fmt + end interface + + interface + subroutine psb_s_mv_hlg_from_coo(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hlg_from_coo + end interface + + + interface + subroutine psb_s_mv_hlg_from_fmt(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hlg_from_fmt + end interface + + interface + subroutine psb_s_hlg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hlg_csmv + end interface + interface + subroutine psb_s_hlg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hlg_csmm + end interface + + interface + subroutine psb_s_hlg_scal(d,a,info, side) + import :: psb_s_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_hlg_scal + end interface + + interface + subroutine psb_s_hlg_scals(d,a,info) + import :: psb_s_hlg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hlg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_hlg_sizeof(a) result(res) + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%hkoffs) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function s_hlg_sizeof + + function s_hlg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLG' + end function s_hlg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_hlg_free(a) + use hlldev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_s_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_s_hll_sparse_mat%free() + + return + + end subroutine s_hlg_free + + + subroutine s_hlg_sync(a) + implicit none + class(psb_s_hlg_sparse_mat), target, intent(in) :: a + class(psb_s_hlg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine s_hlg_sync + + subroutine s_hlg_set_host(a) + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine s_hlg_set_host + + subroutine s_hlg_set_dev(a) + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine s_hlg_set_dev + + subroutine s_hlg_set_sync(a) + implicit none + class(psb_s_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine s_hlg_set_sync + + function s_hlg_is_dev(a) result(res) + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function s_hlg_is_dev + + function s_hlg_is_host(a) result(res) + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function s_hlg_is_host + + function s_hlg_is_sync(a) result(res) + implicit none + class(psb_s_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function s_hlg_is_sync + + + subroutine s_hlg_finalize(a) + use hlldev_mod + implicit none + type(psb_s_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine s_hlg_finalize + +#else + + interface + subroutine psb_s_hlg_mold(a,b,info) + import :: psb_s_hlg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hlg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hlg_mold + end interface + +#endif + +end module psb_s_hlg_mat_mod diff --git a/gpu/psb_s_hybg_mat_mod.F90 b/gpu/psb_s_hybg_mat_mod.F90 new file mode 100644 index 000000000..5a8e0e5d1 --- /dev/null +++ b/gpu/psb_s_hybg_mat_mod.F90 @@ -0,0 +1,306 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +#if CUDA_SHORT_VERSION <= 10 + +module psb_s_hybg_mat_mod + + use iso_c_binding + use psb_s_mat_mod + use cusparse_mod + + type, extends(psb_s_csr_sparse_mat) :: psb_s_hybg_sparse_mat + ! + ! HYBG. An interface to the cuSPARSE HYB + ! On the CPU side we keep a CSR storage. + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(s_Hmat) :: deviceMat + + contains + procedure, nopass :: get_fmt => s_hybg_get_fmt + procedure, pass(a) :: sizeof => s_hybg_sizeof + procedure, pass(a) :: vect_mv => psb_s_hybg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_s_hybg_inner_vect_sv + procedure, pass(a) :: csmm => psb_s_hybg_csmm + procedure, pass(a) :: csmv => psb_s_hybg_csmv + procedure, pass(a) :: scals => psb_s_hybg_scals + procedure, pass(a) :: scalv => psb_s_hybg_scal + procedure, pass(a) :: reallocate_nz => psb_s_hybg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_hybg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_s_cp_hybg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_s_cp_hybg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_s_mv_hybg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_s_mv_hybg_from_fmt + procedure, pass(a) :: free => s_hybg_free + procedure, pass(a) :: mold => psb_s_hybg_mold + procedure, pass(a) :: to_gpu => psb_s_hybg_to_gpu + final :: s_hybg_finalize +#else + contains + procedure, pass(a) :: mold => psb_s_hybg_mold +#endif + end type psb_s_hybg_sparse_mat + +#ifdef HAVE_SPGPU + private :: s_hybg_get_nzeros, s_hybg_free, s_hybg_get_fmt, & + & s_hybg_get_size, s_hybg_sizeof, s_hybg_get_nz_row + + + interface + subroutine psb_s_hybg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hybg_inner_vect_sv + end interface + + interface + subroutine psb_s_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_s_base_vect_type, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hybg_vect_mv + end interface + + interface + subroutine psb_s_hybg_reallocate_nz(nz,a) + import :: psb_s_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hybg_sparse_mat), intent(inout) :: a + end subroutine psb_s_hybg_reallocate_nz + end interface + + interface + subroutine psb_s_hybg_allocate_mnnz(m,n,a,nz) + import :: psb_s_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_hybg_allocate_mnnz + end interface + + interface + subroutine psb_s_hybg_mold(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hybg_mold + end interface + + interface + subroutine psb_s_hybg_to_gpu(a,info, nzrm) + import :: psb_s_hybg_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_s_hybg_to_gpu + end interface + + interface + subroutine psb_s_cp_hybg_from_coo(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hybg_from_coo + end interface + + interface + subroutine psb_s_cp_hybg_from_fmt(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hybg_from_fmt + end interface + + interface + subroutine psb_s_mv_hybg_from_coo(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hybg_from_coo + end interface + + interface + subroutine psb_s_mv_hybg_from_fmt(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hybg_from_fmt + end interface + + interface + subroutine psb_s_hybg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hybg_csmv + end interface + interface + subroutine psb_s_hybg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hybg_csmm + end interface + + interface + subroutine psb_s_hybg_scal(d,a,info,side) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_hybg_scal + end interface + + interface + subroutine psb_s_hybg_scals(d,a,info) + import :: psb_s_hybg_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hybg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_hybg_sizeof(a) result(res) + implicit none + class(psb_s_hybg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function s_hybg_sizeof + + function s_hybg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HYBG' + end function s_hybg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_hybg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + class(psb_s_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + call a%psb_s_csr_sparse_mat%free() + + return + + end subroutine s_hybg_free + + subroutine s_hybg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + type(psb_s_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + + return + end subroutine s_hybg_finalize + +#else + + interface + subroutine psb_s_hybg_mold(a,b,info) + import :: psb_s_hybg_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hybg_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hybg_mold + end interface + +#endif + +end module psb_s_hybg_mat_mod +#endif diff --git a/gpu/psb_s_vectordev_mod.F90 b/gpu/psb_s_vectordev_mod.F90 new file mode 100644 index 000000000..a7319b951 --- /dev/null +++ b/gpu/psb_s_vectordev_mod.F90 @@ -0,0 +1,390 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_s_vectordev_mod + + use psb_base_vectordev_mod + +#ifdef HAVE_SPGPU + + interface registerMapped + function registerMappedFloat(buf,d_p,n,dummy) & + & result(res) bind(c,name='registerMappedFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: buf + type(c_ptr) :: d_p + integer(c_int),value :: n + real(c_float), value :: dummy + end function registerMappedFloat + end interface + + interface writeMultiVecDevice + function writeMultiVecDeviceFloat(deviceVec,hostVec) & + & result(res) bind(c,name='writeMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + real(c_float) :: hostVec(*) + end function writeMultiVecDeviceFloat + function writeMultiVecDeviceFloatR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='writeMultiVecDeviceFloatR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + real(c_float) :: hostVec(ld,*) + end function writeMultiVecDeviceFloatR2 + end interface + + interface readMultiVecDevice + function readMultiVecDeviceFloat(deviceVec,hostVec) & + & result(res) bind(c,name='readMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + real(c_float) :: hostVec(*) + end function readMultiVecDeviceFloat + function readMultiVecDeviceFloatR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='readMultiVecDeviceFloatR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + real(c_float) :: hostVec(ld,*) + end function readMultiVecDeviceFloatR2 + end interface + + interface allocateFloat + function allocateFloat(didx,n) & + & result(res) bind(c,name='allocateFloat') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: n + integer(c_int) :: res + end function allocateFloat + function allocateMultiFloat(didx,m,n) & + & result(res) bind(c,name='allocateMultiFloat') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: m,n + integer(c_int) :: res + end function allocateMultiFloat + end interface + + interface writeFloat + function writeFloat(didx,hidx,n) & + & result(res) bind(c,name='writeFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(*) + integer(c_int),value :: n + end function writeFloat + function writeFloatFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='writeFloatFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function writeFloatFirst + function writeMultiFloat(didx,hidx,m,n) & + & result(res) bind(c,name='writeMultiFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(m,*) + integer(c_int),value :: m,n + end function writeMultiFloat + end interface + + interface readFloat + function readFloat(didx,hidx,n) & + & result(res) bind(c,name='readFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(*) + integer(c_int),value :: n + end function readFloat + function readFloatFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='readFloatFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function readFloatFirst + function readMultiFloat(didx,hidx,m,n) & + & result(res) bind(c,name='readMultiFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + real(c_float) :: hidx(m,*) + integer(c_int),value :: m,n + end function readMultiFloat + end interface + + interface + subroutine freeFloat(didx) & + & bind(c,name='freeFloat') + use iso_c_binding + type(c_ptr), value :: didx + end subroutine freeFloat + end interface + + + interface setScalDevice + function setScalMultiVecDeviceFloat(val, first, last, & + & indexBase, deviceVecX) result(res) & + & bind(c,name='setscalMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: first,last,indexbase + real(c_float), value :: val + type(c_ptr), value :: deviceVecX + end function setScalMultiVecDeviceFloat + end interface + + interface + function geinsMultiVecDeviceFloat(n,deviceVecIrl,deviceVecVal,& + & dupl,indexbase,deviceVecX) & + & result(res) bind(c,name='geinsMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n, dupl,indexbase + type(c_ptr), value :: deviceVecIrl, deviceVecVal, deviceVecX + end function geinsMultiVecDeviceFloat + end interface + + ! New gather functions + + interface + function igathMultiVecDeviceFloat(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceFloat + end interface + + interface + function igathMultiVecDeviceFloatVecIdx(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceFloatVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceFloatVecIdx + end interface + + interface + function iscatMultiVecDeviceFloat(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + real(c_float),value :: beta + end function iscatMultiVecDeviceFloat + end interface + + interface + function iscatMultiVecDeviceFloatVecIdx(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceFloatVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + real(c_float),value :: beta + end function iscatMultiVecDeviceFloatVecIdx + end interface + + + interface scalMultiVecDevice + function scalMultiVecDeviceFloat(alpha,deviceVecA) & + & result(val) bind(c,name='scalMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + real(c_float), value :: alpha + type(c_ptr), value :: deviceVecA + end function scalMultiVecDeviceFloat + end interface + + interface dotMultiVecDevice + function dotMultiVecDeviceFloat(res, n,deviceVecA,deviceVecB) & + & result(val) bind(c,name='dotMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA, deviceVecB + end function dotMultiVecDeviceFloat + end interface + + interface nrm2MultiVecDevice + function nrm2MultiVecDeviceFloat(res,n,deviceVecA) & + & result(val) bind(c,name='nrm2MultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function nrm2MultiVecDeviceFloat + end interface + + interface amaxMultiVecDevice + function amaxMultiVecDeviceFloat(res,n,deviceVecA) & + & result(val) bind(c,name='amaxMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function amaxMultiVecDeviceFloat + end interface + + interface asumMultiVecDevice + function asumMultiVecDeviceFloat(res,n,deviceVecA) & + & result(val) bind(c,name='asumMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_float) :: res + type(c_ptr), value :: deviceVecA + end function asumMultiVecDeviceFloat + end interface + + + interface axpbyMultiVecDevice + function axpbyMultiVecDeviceFloat(n,alpha,deviceVecA,beta,deviceVecB) & + & result(res) bind(c,name='axpbyMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_float), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB + end function axpbyMultiVecDeviceFloat + end interface + + interface axyMultiVecDevice + function axyMultiVecDeviceFloat(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='axyMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_float), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function axyMultiVecDeviceFloat + end interface + + interface axybzMultiVecDevice + function axybzMultiVecDeviceFloat(n,alpha,deviceVecA,deviceVecB,beta,deviceVecZ) & + & result(res) bind(c,name='axybzMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_float), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB,deviceVecZ + end function axybzMultiVecDeviceFloat + end interface + + + interface absMultiVecDevice + function absMultiVecDeviceFloat(n,alpha,deviceVecA) & + & result(res) bind(c,name='absMultiVecDeviceFloat') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_float), value :: alpha + type(c_ptr), value :: deviceVecA + end function absMultiVecDeviceFloat + function absMultiVecDeviceFloat2(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='absMultiVecDeviceFloat2') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + real(c_float), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function absMultiVecDeviceFloat2 + end interface + + interface inner_register + module procedure inner_registerFloat + end interface + + interface inner_unregister + module procedure inner_unregisterFloat + end interface + +contains + + + function inner_registerFloat(buffer,dval) result(res) + real(c_float), allocatable, target :: buffer(:) + type(c_ptr) :: dval + integer(c_int) :: res + real(c_float) :: dummy + res = registerMapped(c_loc(buffer),dval,size(buffer), dummy) + end function inner_registerFloat + + subroutine inner_unregisterFloat(buffer) + real(c_float), allocatable, target :: buffer(:) + + call unregisterMapped(c_loc(buffer)) + end subroutine inner_unregisterFloat + +#endif + +end module psb_s_vectordev_mod diff --git a/gpu/psb_vectordev_mod.f90 b/gpu/psb_vectordev_mod.f90 new file mode 100644 index 000000000..1316d4584 --- /dev/null +++ b/gpu/psb_vectordev_mod.f90 @@ -0,0 +1,8 @@ +module psb_vectordev_mod + use psb_base_vectordev_mod + use psb_s_vectordev_mod + use psb_d_vectordev_mod + use psb_c_vectordev_mod + use psb_z_vectordev_mod + use psb_i_vectordev_mod +end module psb_vectordev_mod diff --git a/gpu/psb_z_csrg_mat_mod.F90 b/gpu/psb_z_csrg_mat_mod.F90 new file mode 100644 index 000000000..14df1124d --- /dev/null +++ b/gpu/psb_z_csrg_mat_mod.F90 @@ -0,0 +1,393 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_csrg_mat_mod + + use iso_c_binding + use psb_z_mat_mod + use cusparse_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_z_csr_sparse_mat) :: psb_z_csrg_sparse_mat + ! + ! cuSPARSE 4.0 CSR format. + ! + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(z_Cmat) :: deviceMat + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => z_csrg_get_fmt + procedure, pass(a) :: sizeof => z_csrg_sizeof + procedure, pass(a) :: vect_mv => psb_z_csrg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_z_csrg_inner_vect_sv + procedure, pass(a) :: csmm => psb_z_csrg_csmm + procedure, pass(a) :: csmv => psb_z_csrg_csmv + procedure, pass(a) :: scals => psb_z_csrg_scals + procedure, pass(a) :: scalv => psb_z_csrg_scal + procedure, pass(a) :: reallocate_nz => psb_z_csrg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_csrg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_csrg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_z_cp_csrg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_csrg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_z_mv_csrg_from_fmt + procedure, pass(a) :: free => z_csrg_free + procedure, pass(a) :: mold => psb_z_csrg_mold + procedure, pass(a) :: is_host => z_csrg_is_host + procedure, pass(a) :: is_dev => z_csrg_is_dev + procedure, pass(a) :: is_sync => z_csrg_is_sync + procedure, pass(a) :: set_host => z_csrg_set_host + procedure, pass(a) :: set_dev => z_csrg_set_dev + procedure, pass(a) :: set_sync => z_csrg_set_sync + procedure, pass(a) :: sync => z_csrg_sync + procedure, pass(a) :: to_gpu => psb_z_csrg_to_gpu + procedure, pass(a) :: from_gpu => psb_z_csrg_from_gpu + final :: z_csrg_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_csrg_mold +#endif + end type psb_z_csrg_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_csrg_get_nzeros, z_csrg_free, z_csrg_get_fmt, & + & z_csrg_get_size, z_csrg_sizeof, z_csrg_get_nz_row + + + interface + subroutine psb_z_csrg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_csrg_inner_vect_sv + end interface + + + interface + subroutine psb_z_csrg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_csrg_vect_mv + end interface + + interface + subroutine psb_z_csrg_reallocate_nz(nz,a) + import :: psb_z_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_csrg_sparse_mat), intent(inout) :: a + end subroutine psb_z_csrg_reallocate_nz + end interface + + interface + subroutine psb_z_csrg_allocate_mnnz(m,n,a,nz) + import :: psb_z_csrg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_csrg_allocate_mnnz + end interface + + interface + subroutine psb_z_csrg_mold(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_csrg_mold + end interface + + interface + subroutine psb_z_csrg_to_gpu(a,info, nzrm) + import :: psb_z_csrg_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_z_csrg_to_gpu + end interface + + interface + subroutine psb_z_csrg_from_gpu(a,info) + import :: psb_z_csrg_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_csrg_from_gpu + end interface + + interface + subroutine psb_z_cp_csrg_from_coo(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_csrg_from_coo + end interface + + interface + subroutine psb_z_cp_csrg_from_fmt(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_csrg_from_fmt + end interface + + interface + subroutine psb_z_mv_csrg_from_coo(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_csrg_from_coo + end interface + + interface + subroutine psb_z_mv_csrg_from_fmt(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_csrg_from_fmt + end interface + + interface + subroutine psb_z_csrg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_csrg_csmv + end interface + interface + subroutine psb_z_csrg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_csrg_csmm + end interface + + interface + subroutine psb_z_csrg_scal(d,a,info,side) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_csrg_scal + end interface + + interface + subroutine psb_z_csrg_scals(d,a,info) + import :: psb_z_csrg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_csrg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_csrg_sizeof(a) result(res) + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function z_csrg_sizeof + + function z_csrg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'CSRG' + end function z_csrg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + + subroutine z_csrg_set_host(a) + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine z_csrg_set_host + + subroutine z_csrg_set_dev(a) + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine z_csrg_set_dev + + subroutine z_csrg_set_sync(a) + implicit none + class(psb_z_csrg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine z_csrg_set_sync + + function z_csrg_is_dev(a) result(res) + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function z_csrg_is_dev + + function z_csrg_is_host(a) result(res) + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function z_csrg_is_host + + function z_csrg_is_sync(a) result(res) + implicit none + class(psb_z_csrg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function z_csrg_is_sync + + + subroutine z_csrg_sync(a) + implicit none + class(psb_z_csrg_sparse_mat), target, intent(in) :: a + class(psb_z_csrg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine z_csrg_sync + + subroutine z_csrg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_z_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + call a%psb_z_csr_sparse_mat%free() + + return + + end subroutine z_csrg_free + + subroutine z_csrg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + + type(psb_z_csrg_sparse_mat), intent(inout) :: a + + info = CSRGDeviceFree(a%deviceMat) + + return + + end subroutine z_csrg_finalize + +#else + interface + subroutine psb_z_csrg_mold(a,b,info) + import :: psb_z_csrg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_csrg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_csrg_mold + end interface + +#endif + +end module psb_z_csrg_mat_mod diff --git a/gpu/psb_z_diag_mat_mod.F90 b/gpu/psb_z_diag_mat_mod.F90 new file mode 100644 index 000000000..986d75d9e --- /dev/null +++ b/gpu/psb_z_diag_mat_mod.F90 @@ -0,0 +1,308 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_diag_mat_mod + + use iso_c_binding + use psb_base_mod + use psb_z_dia_mat_mod + + type, extends(psb_z_dia_sparse_mat) :: psb_z_diag_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => z_diag_get_fmt + procedure, pass(a) :: sizeof => z_diag_sizeof + procedure, pass(a) :: vect_mv => psb_z_diag_vect_mv +! procedure, pass(a) :: csmm => psb_z_diag_csmm + procedure, pass(a) :: csmv => psb_z_diag_csmv +! procedure, pass(a) :: in_vect_sv => psb_z_diag_inner_vect_sv +! procedure, pass(a) :: scals => psb_z_diag_scals +! procedure, pass(a) :: scalv => psb_z_diag_scal +! procedure, pass(a) :: reallocate_nz => psb_z_diag_reallocate_nz +! procedure, pass(a) :: allocate_mnnz => psb_z_diag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_diag_from_coo +! procedure, pass(a) :: cp_from_fmt => psb_z_cp_diag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_diag_from_coo +! procedure, pass(a) :: mv_from_fmt => psb_z_mv_diag_from_fmt + procedure, pass(a) :: free => z_diag_free + procedure, pass(a) :: mold => psb_z_diag_mold + procedure, pass(a) :: to_gpu => psb_z_diag_to_gpu + final :: z_diag_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_diag_mold +#endif + end type psb_z_diag_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_diag_get_nzeros, z_diag_free, z_diag_get_fmt, & + & z_diag_get_size, z_diag_sizeof, z_diag_get_nz_row + + + interface + subroutine psb_z_diag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_diag_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_diag_vect_mv + end interface + + interface + subroutine psb_z_diag_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_z_diag_sparse_mat, psb_dpk_, psb_z_base_vect_type + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_diag_inner_vect_sv + end interface + + interface + subroutine psb_z_diag_reallocate_nz(nz,a) + import :: psb_z_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_diag_sparse_mat), intent(inout) :: a + end subroutine psb_z_diag_reallocate_nz + end interface + + interface + subroutine psb_z_diag_allocate_mnnz(m,n,a,nz) + import :: psb_z_diag_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_diag_allocate_mnnz + end interface + + interface + subroutine psb_z_diag_mold(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_diag_mold + end interface + + interface + subroutine psb_z_diag_to_gpu(a,info, nzrm) + import :: psb_z_diag_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_z_diag_to_gpu + end interface + + interface + subroutine psb_z_cp_diag_from_coo(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_diag_from_coo + end interface + + interface + subroutine psb_z_cp_diag_from_fmt(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_diag_from_fmt + end interface + + interface + subroutine psb_z_mv_diag_from_coo(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_diag_from_coo + end interface + + + interface + subroutine psb_z_mv_diag_from_fmt(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_diag_from_fmt + end interface + + interface + subroutine psb_z_diag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_diag_csmv + end interface + interface + subroutine psb_z_diag_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_diag_csmm + end interface + + interface + subroutine psb_z_diag_scal(d,a,info, side) + import :: psb_z_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_diag_scal + end interface + + interface + subroutine psb_z_diag_scals(d,a,info) + import :: psb_z_diag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_diag_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_diag_sizeof(a) result(res) + implicit none + class(psb_z_diag_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function z_diag_sizeof + + function z_diag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIAG' + end function z_diag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_diag_free(a) + use diagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_z_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_dia_sparse_mat%free() + + return + + end subroutine z_diag_free + + subroutine z_diag_finalize(a) + use diagdev_mod + implicit none + type(psb_z_diag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine z_diag_finalize + +#else + + interface + subroutine psb_z_diag_mold(a,b,info) + import :: psb_z_diag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_diag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_diag_mold + end interface + +#endif + +end module psb_z_diag_mat_mod diff --git a/gpu/psb_z_dnsg_mat_mod.F90 b/gpu/psb_z_dnsg_mat_mod.F90 new file mode 100644 index 000000000..6a3d43696 --- /dev/null +++ b/gpu/psb_z_dnsg_mat_mod.F90 @@ -0,0 +1,294 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_dnsg_mat_mod + + use iso_c_binding + use psb_z_mat_mod + use psb_z_dns_mat_mod + use dnsdev_mod + + type, extends(psb_z_dns_sparse_mat) :: psb_z_dnsg_sparse_mat + ! + ! ITPACK/DNS format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of DNS, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + + contains + procedure, nopass :: get_fmt => z_dnsg_get_fmt + ! procedure, pass(a) :: sizeof => z_dnsg_sizeof + procedure, pass(a) :: vect_mv => psb_z_dnsg_vect_mv +!!$ procedure, pass(a) :: csmm => psb_z_dnsg_csmm +!!$ procedure, pass(a) :: csmv => psb_z_dnsg_csmv +!!$ procedure, pass(a) :: in_vect_sv => psb_z_dnsg_inner_vect_sv +!!$ procedure, pass(a) :: scals => psb_z_dnsg_scals +!!$ procedure, pass(a) :: scalv => psb_z_dnsg_scal +!!$ procedure, pass(a) :: reallocate_nz => psb_z_dnsg_reallocate_nz +!!$ procedure, pass(a) :: allocate_mnnz => psb_z_dnsg_allocate_mnnz + ! Note: we *do* need the TO methods, because of the need to invoke SYNC + ! + procedure, pass(a) :: cp_from_coo => psb_z_cp_dnsg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_z_cp_dnsg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_dnsg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_z_mv_dnsg_from_fmt + procedure, pass(a) :: free => z_dnsg_free + procedure, pass(a) :: mold => psb_z_dnsg_mold + procedure, pass(a) :: to_gpu => psb_z_dnsg_to_gpu + final :: z_dnsg_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_dnsg_mold +#endif + end type psb_z_dnsg_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_dnsg_get_nzeros, z_dnsg_free, z_dnsg_get_fmt, & + & z_dnsg_get_size, z_dnsg_get_nz_row + + + interface + subroutine psb_z_dnsg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_dnsg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dnsg_vect_mv + end interface +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_z_dnsg_sparse_mat, psb_dpk_, psb_z_base_vect_type +!!$ class(psb_z_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_z_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_dnsg_inner_vect_sv +!!$ end interface + +!!$ interface +!!$ subroutine psb_z_dnsg_reallocate_nz(nz,a) +!!$ import :: psb_z_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_z_dnsg_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_z_dnsg_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_z_dnsg_allocate_mnnz +!!$ end interface + + interface + subroutine psb_z_dnsg_mold(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dnsg_mold + end interface + + interface + subroutine psb_z_dnsg_to_gpu(a,info) + import :: psb_z_dnsg_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dnsg_to_gpu + end interface + + interface + subroutine psb_z_cp_dnsg_from_coo(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dnsg_from_coo + end interface + + interface + subroutine psb_z_cp_dnsg_from_fmt(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dnsg_from_fmt + end interface + + interface + subroutine psb_z_mv_dnsg_from_coo(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dnsg_from_coo + end interface + + + interface + subroutine psb_z_mv_dnsg_from_fmt(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dnsg_from_fmt + end interface + +!!$ interface +!!$ subroutine psb_z_dnsg_csmv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:) +!!$ complex(psb_dpk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_dnsg_csmv +!!$ end interface +!!$ interface +!!$ subroutine psb_z_dnsg_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_dnsg_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_dnsg_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_scal(d,a,info, side) +!!$ import :: psb_z_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_z_dnsg_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_dnsg_scals(d,a,info) +!!$ import :: psb_z_dnsg_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_dnsg_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_dnsg_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + + function z_dnsg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNSG' + end function z_dnsg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_dnsg_free(a) + use dnsdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_z_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_dns_sparse_mat%free() + + return + + end subroutine z_dnsg_free + + subroutine z_dnsg_finalize(a) + use dnsdev_mod + implicit none + type(psb_z_dnsg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeDnsDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine z_dnsg_finalize + +#else + + interface + subroutine psb_z_dnsg_mold(a,b,info) + import :: psb_z_dnsg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dnsg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dnsg_mold + end interface + +#endif + +end module psb_z_dnsg_mat_mod diff --git a/gpu/psb_z_elg_mat_mod.F90 b/gpu/psb_z_elg_mat_mod.F90 new file mode 100644 index 000000000..cf9e479c5 --- /dev/null +++ b/gpu/psb_z_elg_mat_mod.F90 @@ -0,0 +1,483 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_elg_mat_mod + + use iso_c_binding + use psb_z_mat_mod + use psb_z_ell_mat_mod + use psb_i_gpu_vect_mod + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_z_ell_sparse_mat) :: psb_z_elg_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of ELL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer(psb_ipk_) :: devstate = is_host + + contains + procedure, nopass :: get_fmt => z_elg_get_fmt + procedure, pass(a) :: sizeof => z_elg_sizeof + procedure, pass(a) :: vect_mv => psb_z_elg_vect_mv + procedure, pass(a) :: csmm => psb_z_elg_csmm + procedure, pass(a) :: csmv => psb_z_elg_csmv + procedure, pass(a) :: in_vect_sv => psb_z_elg_inner_vect_sv + procedure, pass(a) :: scals => psb_z_elg_scals + procedure, pass(a) :: scalv => psb_z_elg_scal + procedure, pass(a) :: reallocate_nz => psb_z_elg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_elg_allocate_mnnz + procedure, pass(a) :: reinit => z_elg_reinit + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_elg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_z_cp_elg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_elg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_z_mv_elg_from_fmt + procedure, pass(a) :: free => z_elg_free + procedure, pass(a) :: mold => psb_z_elg_mold + procedure, pass(a) :: csput_a => psb_z_elg_csput_a + procedure, pass(a) :: csput_v => psb_z_elg_csput_v + procedure, pass(a) :: is_host => z_elg_is_host + procedure, pass(a) :: is_dev => z_elg_is_dev + procedure, pass(a) :: is_sync => z_elg_is_sync + procedure, pass(a) :: set_host => z_elg_set_host + procedure, pass(a) :: set_dev => z_elg_set_dev + procedure, pass(a) :: set_sync => z_elg_set_sync + procedure, pass(a) :: sync => z_elg_sync + procedure, pass(a) :: from_gpu => psb_z_elg_from_gpu + procedure, pass(a) :: to_gpu => psb_z_elg_to_gpu + procedure, pass(a) :: asb => psb_z_elg_asb + final :: z_elg_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_elg_mold + procedure, pass(a) :: asb => psb_z_elg_asb +#endif + end type psb_z_elg_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_elg_get_nzeros, z_elg_free, z_elg_get_fmt, & + & z_elg_get_size, z_elg_sizeof, z_elg_get_nz_row, z_elg_sync + + + interface + subroutine psb_z_elg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_elg_vect_mv + end interface + + interface + subroutine psb_z_elg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_z_elg_sparse_mat, psb_dpk_, psb_z_base_vect_type + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_elg_inner_vect_sv + end interface + + interface + subroutine psb_z_elg_reallocate_nz(nz,a) + import :: psb_z_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_elg_sparse_mat), intent(inout) :: a + end subroutine psb_z_elg_reallocate_nz + end interface + + interface + subroutine psb_z_elg_allocate_mnnz(m,n,a,nz) + import :: psb_z_elg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_elg_allocate_mnnz + end interface + + interface + subroutine psb_z_elg_mold(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_mold + end interface + + interface + subroutine psb_z_elg_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_csput_a + end interface + + interface + subroutine psb_z_elg_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_, psb_z_base_vect_type,& + & psb_i_base_vect_type + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_vect_type), intent(inout) :: val + class(psb_i_base_vect_type), intent(inout) :: ia, ja + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_csput_v + end interface + + interface + subroutine psb_z_elg_from_gpu(a,info) + import :: psb_z_elg_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_from_gpu + end interface + + interface + subroutine psb_z_elg_to_gpu(a,info, nzrm) + import :: psb_z_elg_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_z_elg_to_gpu + end interface + + interface + subroutine psb_z_cp_elg_from_coo(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_elg_from_coo + end interface + + interface + subroutine psb_z_cp_elg_from_fmt(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_elg_from_fmt + end interface + + interface + subroutine psb_z_mv_elg_from_coo(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_elg_from_coo + end interface + + + interface + subroutine psb_z_mv_elg_from_fmt(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_elg_from_fmt + end interface + + interface + subroutine psb_z_elg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_elg_csmv + end interface + interface + subroutine psb_z_elg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_elg_csmm + end interface + + interface + subroutine psb_z_elg_scal(d,a,info, side) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_elg_scal + end interface + + interface + subroutine psb_z_elg_scals(d,a,info) + import :: psb_z_elg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_scals + end interface + + interface + subroutine psb_z_elg_asb(a) + import :: psb_z_elg_sparse_mat + class(psb_z_elg_sparse_mat), intent(inout) :: a + end subroutine psb_z_elg_asb + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_elg_sizeof(a) result(res) + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function z_elg_sizeof + + function z_elg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELG' + end function z_elg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + subroutine z_elg_reinit(a,clear) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_z_elg_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + integer(psb_ipk_) :: isz, err_act + character(len=20) :: name='reinit' + logical :: clear_ + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + if (a%is_bld() .or. a%is_upd()) then + ! do nothing + return + else if (a%is_asb()) then + if (a%is_dev().or.a%is_sync()) then + if (clear_) call zeroEllDevice(a%deviceMat) + call a%set_dev() + else if (a%is_host()) then + a%val(:,:) = zzero + end if + call a%set_upd() + else + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + + end subroutine z_elg_reinit + + subroutine z_elg_free(a) + use elldev_mod + implicit none + integer(psb_ipk_) :: info + + class(psb_z_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_ell_sparse_mat%free() + call a%set_sync() + + return + + end subroutine z_elg_free + + subroutine z_elg_sync(a) + implicit none + class(psb_z_elg_sparse_mat), target, intent(in) :: a + class(psb_z_elg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine z_elg_sync + + subroutine z_elg_set_host(a) + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine z_elg_set_host + + subroutine z_elg_set_dev(a) + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine z_elg_set_dev + + subroutine z_elg_set_sync(a) + implicit none + class(psb_z_elg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine z_elg_set_sync + + function z_elg_is_dev(a) result(res) + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function z_elg_is_dev + + function z_elg_is_host(a) result(res) + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function z_elg_is_host + + function z_elg_is_sync(a) result(res) + implicit none + class(psb_z_elg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function z_elg_is_sync + + subroutine z_elg_finalize(a) + use elldev_mod + implicit none + type(psb_z_elg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeEllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + return + + end subroutine z_elg_finalize + +#else + + interface + subroutine psb_z_elg_asb(a) + import :: psb_z_elg_sparse_mat + class(psb_z_elg_sparse_mat), intent(inout) :: a + end subroutine psb_z_elg_asb + end interface + + interface + subroutine psb_z_elg_mold(a,b,info) + import :: psb_z_elg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_elg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_elg_mold + end interface + +#endif + +end module psb_z_elg_mat_mod diff --git a/gpu/psb_z_gpu_vect_mod.F90 b/gpu/psb_z_gpu_vect_mod.F90 new file mode 100644 index 000000000..ca5ac9224 --- /dev/null +++ b/gpu/psb_z_gpu_vect_mod.F90 @@ -0,0 +1,1989 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_gpu_vect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_z_vect_mod + use psb_i_vect_mod +#ifdef HAVE_SPGPU + use psb_gpu_env_mod + use psb_i_gpu_vect_mod + use psb_i_vectordev_mod + use psb_z_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_z_base_vect_type) :: psb_z_vect_gpu +#ifdef HAVE_SPGPU + integer :: state = is_host + type(c_ptr) :: deviceVect = c_null_ptr + complex(c_double_complex), allocatable :: pinned_buffer(:) + type(c_ptr) :: dt_p_buf = c_null_ptr + complex(c_double_complex), allocatable :: buffer(:) + type(c_ptr) :: dt_buf = c_null_ptr + integer :: dt_buf_sz = 0 + type(c_ptr) :: i_buf = c_null_ptr + integer :: i_buf_sz = 0 + contains + procedure, pass(x) :: get_nrows => z_gpu_get_nrows + procedure, nopass :: get_fmt => z_gpu_get_fmt + + procedure, pass(x) :: all => z_gpu_all + procedure, pass(x) :: zero => z_gpu_zero + procedure, pass(x) :: asb_m => z_gpu_asb_m + procedure, pass(x) :: sync => z_gpu_sync + procedure, pass(x) :: sync_space => z_gpu_sync_space + procedure, pass(x) :: bld_x => z_gpu_bld_x + procedure, pass(x) :: bld_mn => z_gpu_bld_mn + procedure, pass(x) :: free => z_gpu_free + procedure, pass(x) :: ins_a => z_gpu_ins_a + procedure, pass(x) :: ins_v => z_gpu_ins_v + procedure, pass(x) :: is_host => z_gpu_is_host + procedure, pass(x) :: is_dev => z_gpu_is_dev + procedure, pass(x) :: is_sync => z_gpu_is_sync + procedure, pass(x) :: set_host => z_gpu_set_host + procedure, pass(x) :: set_dev => z_gpu_set_dev + procedure, pass(x) :: set_sync => z_gpu_set_sync + procedure, pass(x) :: set_scal => z_gpu_set_scal +!!$ procedure, pass(x) :: set_vect => z_gpu_set_vect + procedure, pass(x) :: gthzv_x => z_gpu_gthzv_x + procedure, pass(y) :: sctb => z_gpu_sctb + procedure, pass(y) :: sctb_x => z_gpu_sctb_x + procedure, pass(x) :: gthzbuf => z_gpu_gthzbuf + procedure, pass(y) :: sctb_buf => z_gpu_sctb_buf + procedure, pass(x) :: new_buffer => z_gpu_new_buffer + procedure, nopass :: device_wait => z_gpu_device_wait + procedure, pass(x) :: free_buffer => z_gpu_free_buffer + procedure, pass(x) :: maybe_free_buffer => z_gpu_maybe_free_buffer + procedure, pass(x) :: dot_v => z_gpu_dot_v + procedure, pass(x) :: dot_a => z_gpu_dot_a + procedure, pass(y) :: axpby_v => z_gpu_axpby_v + procedure, pass(y) :: axpby_a => z_gpu_axpby_a + procedure, pass(y) :: mlt_v => z_gpu_mlt_v + procedure, pass(y) :: mlt_a => z_gpu_mlt_a + procedure, pass(z) :: mlt_a_2 => z_gpu_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => z_gpu_mlt_v_2 + procedure, pass(x) :: scal => z_gpu_scal + procedure, pass(x) :: nrm2 => z_gpu_nrm2 + procedure, pass(x) :: amax => z_gpu_amax + procedure, pass(x) :: asum => z_gpu_asum + procedure, pass(x) :: absval1 => z_gpu_absval1 + procedure, pass(x) :: absval2 => z_gpu_absval2 + + final :: z_gpu_vect_finalize +#endif + end type psb_z_vect_gpu + + public :: psb_z_vect_gpu_ + private :: constructor + interface psb_z_vect_gpu_ + module procedure constructor + end interface psb_z_vect_gpu_ + +contains + + function constructor(x) result(this) + complex(psb_dpk_) :: x(:) + type(psb_z_vect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x),info) + + end function constructor + +#ifdef HAVE_SPGPU + + subroutine z_gpu_device_wait() + call psb_cudaSync() + end subroutine z_gpu_device_wait + + subroutine z_gpu_new_buffer(n,x,info) + use psb_realloc_mod + use psb_gpu_env_mod + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + integer(psb_ipk_), intent(out) :: info + + + if (psb_gpu_DeviceHasUVA()) then + if (allocated(x%combuf)) then + if (size(x%combuf) idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + ! + ! Only need a sync in this branch; in the others + ! cudamemCpy acts as a sync point. + ! + if (allocated(x%pinned_buffer)) then + if (size(x%pinned_buffer) < n) then + call inner_unregister(x%pinned_buffer) + deallocate(x%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(x%pinned_buffer)) then + allocate(x%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(x%pinned_buffer,x%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + info = igathMultiVecDeviceDoubleComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_p_buf, 1) + call psb_cudaSync() + y(1:n) = x%pinned_buffer(1:n) + + else + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeDoubleComplex(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateDoubleComplex(x%dt_buf,n) + x%dt_buf_sz=n + end if + if (info == 0) & + & info = igathMultiVecDeviceDoubleComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, 1, x%dt_buf, 1) + if (info == 0) & + & info = readDoubleComplex(x%dt_buf,y,n) + + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + + if (x%i_buf_sz < ni) then + if (c_associated(x%i_buf)) then + call freeInt(x%i_buf) + x%i_buf = c_null_ptr + end if + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (allocated(x%buffer)) then + if (size(x%buffer) < n) then + deallocate(x%buffer, stat=info) + end if + end if + + if (.not.allocated(x%buffer)) then + allocate(x%buffer(n),stat=info) + end if + + if (x%dt_buf_sz < n) then + if (c_associated(x%dt_buf)) then + call freeDoubleComplex(x%dt_buf) + x%dt_buf = c_null_ptr + end if + info = allocateDoubleComplex(x%dt_buf,n) + x%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(x%i_buf,ii%v,ni) + if (info == 0) & + & info = igathMultiVecDeviceDoubleComplex(x%deviceVect,& + & 0, n, i, x%i_buf, 1, x%dt_buf, 1) + if (info == 0) & + & info = readDoubleComplex(x%dt_buf,y,n) + + end select + + end subroutine z_gpu_gthzv_x + + subroutine z_gpu_gthzbuf(i,n,idx,x) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i,n + class(psb_i_base_vect_type) :: idx + class(psb_z_vect_gpu) :: x + integer :: info, ni + + info = 0 +!!$ write(0,*) 'Starting gth_zbuf' + if (.not.allocated(x%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'gthzbuf') + return + end if + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (x%is_host()) call x%sync() + + if (psb_gpu_DeviceHasUVA()) then + info = igathMultiVecDeviceDoubleComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_p_buf, 1) + + else + info = igathMultiVecDeviceDoubleComplexVecIdx(x%deviceVect,& + & 0, n, i, ii%deviceVect, i,x%dt_buf, 1) + if (info == 0) & + & info = readDoubleComplex(i,x%dt_buf,x%combuf(i:),n,1) + endif + + class default + ! Do not go for brute force, but move the index vector + ni = size(ii%v) + info = 0 + if (.not.c_associated(x%i_buf)) then + info = allocateInt(x%i_buf,ni) + x%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,x%i_buf,ii%v(i:),n,1) + + if (info == 0) & + & info = igathMultiVecDeviceDoubleComplex(x%deviceVect,& + & 0, n, i, x%i_buf, i,x%dt_buf, 1) + + if (info == 0) & + & info = readDoubleComplex(i,x%dt_buf,x%combuf(i:),n,1) + + end select + + end subroutine z_gpu_gthzbuf + + subroutine z_gpu_sctb(n,idx,x,beta,y) + implicit none + !use psb_const_mod + integer(psb_ipk_) :: n, idx(:) + complex(psb_dpk_) :: beta, x(:) + class(psb_z_vect_gpu) :: y + integer(psb_ipk_) :: info + + if (n == 0) return + + if (y%is_dev()) call y%sync() + + call y%psb_z_base_vect_type%sctb(n,idx,x,beta) + call y%set_host() + + end subroutine z_gpu_sctb + + subroutine z_gpu_sctb_x(i,n,idx,x,beta,y) + use psb_gpu_env_mod + use psi_serial_mod + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + complex(psb_dpk_) :: beta, x(:) + class(psb_z_vect_gpu) :: y + integer :: info, ni + + select type(ii=> idx) + class is (psb_i_vect_gpu) + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + + ! + if (psb_gpu_DeviceHasUVA()) then + if (allocated(y%pinned_buffer)) then + if (size(y%pinned_buffer) < n) then + call inner_unregister(y%pinned_buffer) + deallocate(y%pinned_buffer, stat=info) + end if + end if + + if (.not.allocated(y%pinned_buffer)) then + allocate(y%pinned_buffer(n),stat=info) + if (info == 0) info = inner_register(y%pinned_buffer,y%dt_p_buf) + if (info /= 0) & + & write(0,*) 'Error from inner_register ',info + endif + y%pinned_buffer(1:n) = x(1:n) + info = iscatMultiVecDeviceDoubleComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_p_buf, 1,beta) + else + + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeDoubleComplex(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateDoubleComplex(y%dt_buf,n) + y%dt_buf_sz=n + end if + info = writeDoubleComplex(y%dt_buf,x,n) + info = iscatMultiVecDeviceDoubleComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, 1, y%dt_buf, 1,beta) + + end if + + class default + ni = size(ii%v) + + if (y%i_buf_sz < ni) then + if (c_associated(y%i_buf)) then + call freeInt(y%i_buf) + y%i_buf = c_null_ptr + end if + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (allocated(y%buffer)) then + if (size(y%buffer) < n) then + deallocate(y%buffer, stat=info) + end if + end if + + if (.not.allocated(y%buffer)) then + allocate(y%buffer(n),stat=info) + end if + + if (y%dt_buf_sz < n) then + if (c_associated(y%dt_buf)) then + call freeDoubleComplex(y%dt_buf) + y%dt_buf = c_null_ptr + end if + info = allocateDoubleComplex(y%dt_buf,n) + y%dt_buf_sz=n + end if + + if (info == 0) & + & info = writeInt(y%i_buf,ii%v(i:i+n-1),n) + info = writeDoubleComplex(y%dt_buf,x,n) + info = iscatMultiVecDeviceDoubleComplex(y%deviceVect,& + & 0, n, 1, y%i_buf, 1, y%dt_buf, 1,beta) + + + end select + ! + ! Need a sync here to make sure we are not reallocating + ! the buffers before iscatMulti has finished. + ! + call psb_cudaSync() + call y%set_dev() + + end subroutine z_gpu_sctb_x + + subroutine z_gpu_sctb_buf(i,n,idx,beta,y) + use psi_serial_mod + use psb_gpu_env_mod + implicit none + integer(psb_ipk_) :: i, n + class(psb_i_base_vect_type) :: idx + complex(psb_dpk_) :: beta + class(psb_z_vect_gpu) :: y + integer(psb_ipk_) :: info, ni + +!!$ write(0,*) 'Starting sctb_buf' + if (.not.allocated(y%combuf)) then + call psb_errpush(psb_err_alloc_dealloc_,'sctb_buf') + return + end if + + + select type(ii=> idx) + class is (psb_i_vect_gpu) + + if (ii%is_host()) call ii%sync() + if (y%is_host()) call y%sync() + if (psb_gpu_DeviceHasUVA()) then + info = iscatMultiVecDeviceDoubleComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_p_buf, 1,beta) + else + info = writeDoubleComplex(i,y%dt_buf,y%combuf(i:),n,1) + info = iscatMultiVecDeviceDoubleComplexVecIdx(y%deviceVect,& + & 0, n, i, ii%deviceVect, i, y%dt_buf, 1,beta) + + end if + + class default + !call y%sct(n,ii%v(i:),x,beta) + ni = size(ii%v) + info = 0 + if (.not.c_associated(y%i_buf)) then + info = allocateInt(y%i_buf,ni) + y%i_buf_sz=ni + end if + if (info == 0) & + & info = writeInt(i,y%i_buf,ii%v(i:),n,1) + if (info == 0) & + & info = writeDoubleComplex(i,y%dt_buf,y%combuf(i:),n,1) + if (info == 0) info = iscatMultiVecDeviceDoubleComplex(y%deviceVect,& + & 0, n, i, y%i_buf, i, y%dt_buf, 1,beta) + end select +!!$ write(0,*) 'Done sctb_buf' + + end subroutine z_gpu_sctb_buf + + + subroutine z_gpu_bld_x(x,this) + use psb_base_mod + complex(psb_dpk_), intent(in) :: this(:) + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'z_gpu_bld_x',& + & i_err=(/size(this),izero,izero,izero,izero/)) + end if + x%v(:) = this(:) + call x%set_host() + call x%sync() + + end subroutine z_gpu_bld_x + + subroutine z_gpu_bld_mn(x,n) + integer(psb_mpk_), intent(in) :: n + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(n,info) + if (info /= 0) then + call psb_errpush(info,'z_gpu_bld_n',i_err=(/n,n,n,n,n/)) + end if + + end subroutine z_gpu_bld_mn + + subroutine z_gpu_set_host(x) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine z_gpu_set_host + + subroutine z_gpu_set_dev(x) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine z_gpu_set_dev + + subroutine z_gpu_set_sync(x) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine z_gpu_set_sync + + function z_gpu_is_dev(x) result(res) + implicit none + class(psb_z_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function z_gpu_is_dev + + function z_gpu_is_host(x) result(res) + implicit none + class(psb_z_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function z_gpu_is_host + + function z_gpu_is_sync(x) result(res) + implicit none + class(psb_z_vect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function z_gpu_is_sync + + + function z_gpu_get_nrows(x) result(res) + implicit none + class(psb_z_vect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = 0 + if (allocated(x%v)) res = size(x%v) + end function z_gpu_get_nrows + + function z_gpu_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'zGPU' + end function z_gpu_get_fmt + + subroutine z_gpu_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: n + class(psb_z_vect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(n,x%v,info) + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'z_gpu_all',& + & i_err=(/n,n,n,n,n/)) + end if + end subroutine z_gpu_all + + subroutine z_gpu_zero(x) + use psi_serial_mod + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=zzero + call x%set_host() + end subroutine z_gpu_zero + + subroutine z_gpu_asb_m(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_mpk_), intent(in) :: n + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: nd + + if (x%is_dev()) then + nd = getMultiVecDeviceSize(x%deviceVect) + if (nd < n) then + call x%sync() + call x%psb_z_base_vect_type%asb(n,info) + if (info == psb_success_) call x%sync_space(info) + call x%set_host() + end if + else ! + if (x%get_nrows() size(x%v)).or.(n > x%get_nrows())) then +!!$ write(0,*) 'Incoherent situation : sizes',n,size(x%v),x%get_nrows() + call psb_realloc(n,x%v,info) + end if + info = readMultiVecDevice(x%deviceVect,x%v) + end if + if (info == 0) call x%set_sync() + if (info /= 0) then + info=psb_err_internal_error_ + call psb_errpush(info,'z_gpu_sync') + end if + + end subroutine z_gpu_sync + + subroutine z_gpu_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (c_associated(x%deviceVect)) then +!!$ write(0,*)'d_gpu_free Calling freeMultiVecDevice' + call freeMultiVecDevice(x%deviceVect) + x%deviceVect=c_null_ptr + end if + call x%free_buffer(info) + call x%set_sync() + end subroutine z_gpu_free + + subroutine z_gpu_set_scal(x,val,first,last) + class(psb_z_vect_gpu), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val + integer(psb_ipk_), optional :: first, last + + integer(psb_ipk_) :: info, first_, last_ + + first_ = 1 + last_ = x%get_nrows() + if (present(first)) first_ = max(1,first) + if (present(last)) last_ = min(last,last_) + + if (x%is_host()) call x%sync() + info = setScalDevice(val,first_,last_,1,x%deviceVect) + call x%set_dev() + + end subroutine z_gpu_set_scal +!!$ +!!$ subroutine z_gpu_set_vect(x,val) +!!$ class(psb_z_vect_gpu), intent(inout) :: x +!!$ complex(psb_dpk_), intent(in) :: val(:) +!!$ integer(psb_ipk_) :: nr +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_z_base_vect_type%set_vect(val) +!!$ call x%set_host() +!!$ +!!$ end subroutine z_gpu_set_vect + + + + function z_gpu_dot_v(n,x,y) result(res) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(in) :: n + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: ddot + integer(psb_ipk_) :: info + + res = zzero + ! + ! Note: this is the gpu implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_z_vect + ! + select type(yy => y) + type is (psb_z_base_vect_type) + if (x%is_dev()) call x%sync() + res = ddot(n,x%v,1,yy%v,1) + type is (psb_z_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) + if (info /= 0) then + info = psb_err_internal_error_ + call psb_errpush(info,'z_gpu_dot_v') + end if + + class default + ! y%sync is done in dot_a + call x%sync() + res = y%dot(n,x%v) + end select + + end function z_gpu_dot_v + + function z_gpu_dot_a(n,x,y) result(res) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + complex(psb_dpk_), intent(in) :: y(:) + integer(psb_ipk_), intent(in) :: n + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: ddot + + if (x%is_dev()) call x%sync() + res = ddot(n,y,1,x%v,1) + + end function z_gpu_dot_a + + subroutine z_gpu_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer(psb_ipk_), intent(in) :: m + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_vect_gpu), intent(inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nx, ny + + info = psb_success_ + + select type(xx => x) + type is (psb_z_vect_gpu) + ! Do something different here + if ((beta /= zzero).and.y%is_host())& + & call y%sync() + if (xx%is_host()) call xx%sync() + nx = getMultiVecDeviceSize(xx%deviceVect) + ny = getMultiVecDeviceSize(y%deviceVect) + if ((nx x) + type is (psb_z_base_vect_type) + if (y%is_dev()) call y%sync() + do i=1, n + y%v(i) = y%v(i) * xx%v(i) + end do + call y%set_host() + type is (psb_z_vect_gpu) + ! Do something different here + if (y%is_host()) call y%sync() + if (xx%is_host()) call xx%sync() + info = axyMultiVecDevice(n,zone,xx%deviceVect,y%deviceVect) + call y%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (y%is_dev()) call y%sync() + call y%mlt(xx%v,info) + call y%set_host() + end select + + end subroutine z_gpu_mlt_v + + subroutine z_gpu_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_vect_gpu), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + call y%psb_z_base_vect_type%mlt(x,info) + ! set_host() is invoked in the base method + end subroutine z_gpu_mlt_a + + subroutine z_gpu_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: x(:) + complex(psb_dpk_), intent(in) :: y(:) + class(psb_z_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (z%is_dev()) call z%sync() + call z%psb_z_base_vect_type%mlt(alpha,x,y,beta,info) + ! set_host() is invoked in the base method + end subroutine z_gpu_mlt_a_2 + + subroutine z_gpu_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + class(psb_z_vect_gpu), intent(inout) :: z + integer(psb_ipk_), intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer(psb_ipk_) :: i, n + logical :: conjgx_, conjgy_ + + if (.false.) then + ! These are present just for coherence with the + ! complex versions; they do nothing here. + conjgx_=.false. + if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') + conjgy_=.false. + if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') + end if + + n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) + + ! + ! Need to reconsider BETA in the GPU side + ! of things. + ! + info = 0 + select type(xx => x) + type is (psb_z_vect_gpu) + select type (yy => y) + type is (psb_z_vect_gpu) + if (xx%is_host()) call xx%sync() + if (yy%is_host()) call yy%sync() + if ((beta /= zzero).and.(z%is_host())) call z%sync() + info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& + & yy%deviceVect,beta,z%deviceVect) + call z%set_dev() + class default + if (xx%is_dev()) call xx%sync() + if (yy%is_dev()) call yy%sync() + if ((beta /= zzero).and.(z%is_dev())) call z%sync() + call z%psb_z_base_vect_type%mlt(alpha,xx,yy,beta,info) + call z%set_host() + end select + + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + if ((beta /= zzero).and.(z%is_dev())) call z%sync() + call z%psb_z_base_vect_type%mlt(alpha,x,y,beta,info) + call z%set_host() + end select + end subroutine z_gpu_mlt_v_2 + + subroutine z_gpu_scal(alpha, x) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + complex(psb_dpk_), intent (in) :: alpha + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = scalMultiVecDevice(alpha,x%deviceVect) + call x%set_dev() + end subroutine z_gpu_scal + + + function z_gpu_nrm2(n,x) result(res) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + ! WARNING: this should be changed. + if (x%is_host()) call x%sync() + info = nrm2MultiVecDeviceComplex(res,n,x%deviceVect) + + end function z_gpu_nrm2 + + function z_gpu_amax(n,x) result(res) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = amaxMultiVecDeviceComplex(res,n,x%deviceVect) + + end function z_gpu_amax + + function z_gpu_asum(n,x) result(res) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n + real(psb_dpk_) :: res + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + info = asumMultiVecDeviceComplex(res,n,x%deviceVect) + + end function z_gpu_asum + + subroutine z_gpu_absval1(x) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + if (x%is_host()) call x%sync() + n=x%get_nrows() + info = absMultiVecDevice(n,zone,x%deviceVect) + + end subroutine z_gpu_absval1 + + subroutine z_gpu_absval2(x,y) + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_) :: n + integer(psb_ipk_) :: info + + n=min(x%get_nrows(),y%get_nrows()) + select type (yy=> y) + class is (psb_z_vect_gpu) + if (x%is_host()) call x%sync() + if (yy%is_host()) call yy%sync() + info = absMultiVecDevice(n,zone,x%deviceVect,yy%deviceVect) + class default + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() + call x%psb_z_base_vect_type%absval(y) + end select + end subroutine z_gpu_absval2 + + + subroutine z_gpu_vect_finalize(x) + use psi_serial_mod + use psb_realloc_mod + implicit none + type(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + info = 0 + call x%free(info) + end subroutine z_gpu_vect_finalize + + subroutine z_gpu_ins_v(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + class(psb_i_base_vect_type), intent(inout) :: irl + class(psb_z_base_vect_type), intent(inout) :: val + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i, isz + logical :: done_gpu + + info = 0 + if (psb_errstatus_fatal()) return + + done_gpu = .false. + select type(virl => irl) + class is (psb_i_vect_gpu) + select type(vval => val) + class is (psb_z_vect_gpu) + if (vval%is_host()) call vval%sync() + if (virl%is_host()) call virl%sync() + if (x%is_host()) call x%sync() + info = geinsMultiVecDeviceDoubleComplex(n,virl%deviceVect,& + & vval%deviceVect,dupl,1,x%deviceVect) + call x%set_dev() + done_gpu=.true. + end select + end select + + if (.not.done_gpu) then + if (irl%is_dev()) call irl%sync() + if (val%is_dev()) call val%sync() + call x%ins(n,irl%v,val%v,dupl,info) + end if + + if (info /= 0) then + call psb_errpush(info,'gpu_vect_ins') + return + end if + + end subroutine z_gpu_ins_v + + subroutine z_gpu_ins_a(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_z_vect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(in) :: n, dupl + integer(psb_ipk_), intent(in) :: irl(:) + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i + + info = 0 + if (x%is_dev()) call x%sync() + call x%psb_z_base_vect_type%ins(n,irl,val,dupl,info) + call x%set_host() + + end subroutine z_gpu_ins_a + +#endif + +end module psb_z_gpu_vect_mod + + +! +! Multivectors +! + + + +module psb_z_gpu_multivect_mod + use iso_c_binding + use psb_const_mod + use psb_error_mod + use psb_z_multivect_mod + use psb_z_base_multivect_mod + + use psb_i_multivect_mod +#ifdef HAVE_SPGPU + use psb_i_gpu_multivect_mod + use psb_z_vectordev_mod +#endif + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_z_base_multivect_type) :: psb_z_multivect_gpu +#ifdef HAVE_SPGPU + + integer(psb_ipk_) :: state = is_host, m_nrows=0, m_ncols=0 + type(c_ptr) :: deviceVect = c_null_ptr + real(c_double), allocatable :: buffer(:,:) + type(c_ptr) :: dt_buf = c_null_ptr + contains + procedure, pass(x) :: get_nrows => z_gpu_multi_get_nrows + procedure, pass(x) :: get_ncols => z_gpu_multi_get_ncols + procedure, nopass :: get_fmt => z_gpu_multi_get_fmt +!!$ procedure, pass(x) :: dot_v => z_gpu_multi_dot_v +!!$ procedure, pass(x) :: dot_a => z_gpu_multi_dot_a +!!$ procedure, pass(y) :: axpby_v => z_gpu_multi_axpby_v +!!$ procedure, pass(y) :: axpby_a => z_gpu_multi_axpby_a +!!$ procedure, pass(y) :: mlt_v => z_gpu_multi_mlt_v +!!$ procedure, pass(y) :: mlt_a => z_gpu_multi_mlt_a +!!$ procedure, pass(z) :: mlt_a_2 => z_gpu_multi_mlt_a_2 +!!$ procedure, pass(z) :: mlt_v_2 => z_gpu_multi_mlt_v_2 +!!$ procedure, pass(x) :: scal => z_gpu_multi_scal +!!$ procedure, pass(x) :: nrm2 => z_gpu_multi_nrm2 +!!$ procedure, pass(x) :: amax => z_gpu_multi_amax +!!$ procedure, pass(x) :: asum => z_gpu_multi_asum + procedure, pass(x) :: all => z_gpu_multi_all + procedure, pass(x) :: zero => z_gpu_multi_zero + procedure, pass(x) :: asb => z_gpu_multi_asb + procedure, pass(x) :: sync => z_gpu_multi_sync + procedure, pass(x) :: sync_space => z_gpu_multi_sync_space + procedure, pass(x) :: bld_x => z_gpu_multi_bld_x + procedure, pass(x) :: bld_n => z_gpu_multi_bld_n + procedure, pass(x) :: free => z_gpu_multi_free + procedure, pass(x) :: ins => z_gpu_multi_ins + procedure, pass(x) :: is_host => z_gpu_multi_is_host + procedure, pass(x) :: is_dev => z_gpu_multi_is_dev + procedure, pass(x) :: is_sync => z_gpu_multi_is_sync + procedure, pass(x) :: set_host => z_gpu_multi_set_host + procedure, pass(x) :: set_dev => z_gpu_multi_set_dev + procedure, pass(x) :: set_sync => z_gpu_multi_set_sync + procedure, pass(x) :: set_scal => z_gpu_multi_set_scal + procedure, pass(x) :: set_vect => z_gpu_multi_set_vect +!!$ procedure, pass(x) :: gthzv_x => z_gpu_multi_gthzv_x +!!$ procedure, pass(y) :: sctb => z_gpu_multi_sctb +!!$ procedure, pass(y) :: sctb_x => z_gpu_multi_sctb_x + final :: z_gpu_multi_vect_finalize +#endif + end type psb_z_multivect_gpu + + public :: psb_z_multivect_gpu + private :: constructor + interface psb_z_multivect_gpu + module procedure constructor + end interface + +contains + + function constructor(x) result(this) + complex(psb_dpk_) :: x(:,:) + type(psb_z_multivect_gpu) :: this + integer(psb_ipk_) :: info + + this%v = x + call this%asb(size(x,1),size(x,2),info) + + end function constructor + +#ifdef HAVE_SPGPU + +!!$ subroutine z_gpu_multi_gthzv_x(i,n,idx,x,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i,n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ complex(psb_dpk_) :: y(:) +!!$ class(psb_z_multivect_gpu) :: x +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (x%is_host()) call x%sync() +!!$ +!!$ if (allocated(x%buffer)) then +!!$ if (size(x%buffer) < n) then +!!$ call inner_unregister(x%buffer) +!!$ deallocate(x%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(x%buffer)) then +!!$ allocate(x%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(x%buffer,x%dt_buf) +!!$ endif +!!$ info = igathMultiVecDeviceDouble(x%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, x%dt_buf, 1) +!!$ call psb_cudaSync() +!!$ y(1:n) = x%buffer(1:n) +!!$ +!!$ class default +!!$ call x%gth(n,ii%v(i:),y) +!!$ end select +!!$ +!!$ +!!$ end subroutine z_gpu_multi_gthzv_x +!!$ +!!$ +!!$ +!!$ subroutine z_gpu_multi_sctb(n,idx,x,beta,y) +!!$ implicit none +!!$ !use psb_const_mod +!!$ integer(psb_ipk_) :: n, idx(:) +!!$ complex(psb_dpk_) :: beta, x(:) +!!$ class(psb_z_multivect_gpu) :: y +!!$ integer(psb_ipk_) :: info +!!$ +!!$ if (n == 0) return +!!$ +!!$ if (y%is_dev()) call y%sync() +!!$ +!!$ call y%psb_z_base_multivect_type%sctb(n,idx,x,beta) +!!$ call y%set_host() +!!$ +!!$ end subroutine z_gpu_multi_sctb +!!$ +!!$ subroutine z_gpu_multi_sctb_x(i,n,idx,x,beta,y) +!!$ use psi_serial_mod +!!$ integer(psb_ipk_) :: i, n +!!$ class(psb_i_base_multivect_type) :: idx +!!$ complex(psb_dpk_) :: beta, x(:) +!!$ class(psb_z_multivect_gpu) :: y +!!$ +!!$ select type(ii=> idx) +!!$ class is (psb_i_vect_gpu) +!!$ if (ii%is_host()) call ii%sync() +!!$ if (y%is_host()) call y%sync() +!!$ +!!$ if (allocated(y%buffer)) then +!!$ if (size(y%buffer) < n) then +!!$ call inner_unregister(y%buffer) +!!$ deallocate(y%buffer, stat=info) +!!$ end if +!!$ end if +!!$ +!!$ if (.not.allocated(y%buffer)) then +!!$ allocate(y%buffer(n),stat=info) +!!$ if (info == 0) info = inner_register(y%buffer,y%dt_buf) +!!$ endif +!!$ y%buffer(1:n) = x(1:n) +!!$ info = iscatMultiVecDeviceDouble(y%deviceVect,& +!!$ & 0, i, n, ii%deviceVect, y%dt_buf, 1,beta) +!!$ +!!$ call y%set_dev() +!!$ call psb_cudaSync() +!!$ +!!$ class default +!!$ call y%sct(n,ii%v(i:),x,beta) +!!$ end select +!!$ +!!$ end subroutine z_gpu_multi_sctb_x + + + subroutine z_gpu_multi_bld_x(x,this) + use psb_base_mod + complex(psb_dpk_), intent(in) :: this(:,:) + class(psb_z_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info, m, n + + m=size(this,1) + n=size(this,2) + x%m_nrows = m + x%m_ncols = n + call psb_realloc(m,n,x%v,info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'z_gpu_multi_bld_x',& + & i_err=(/size(this,1),size(this,2),izero,izero,izero,izero/)) + end if + x%v(1:m,1:n) = this(1:m,1:n) + call x%set_host() + call x%sync() + + end subroutine z_gpu_multi_bld_x + + subroutine z_gpu_multi_bld_n(x,m,n) + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_multivect_gpu), intent(inout) :: x + integer(psb_ipk_) :: info + + call x%all(m,n,info) + if (info /= 0) then + call psb_errpush(info,'z_gpu_multi_bld_n',i_err=(/m,n,n,n,n/)) + end if + + end subroutine z_gpu_multi_bld_n + + + subroutine z_gpu_multi_set_host(x) + implicit none + class(psb_z_multivect_gpu), intent(inout) :: x + + x%state = is_host + end subroutine z_gpu_multi_set_host + + subroutine z_gpu_multi_set_dev(x) + implicit none + class(psb_z_multivect_gpu), intent(inout) :: x + + x%state = is_dev + end subroutine z_gpu_multi_set_dev + + subroutine z_gpu_multi_set_sync(x) + implicit none + class(psb_z_multivect_gpu), intent(inout) :: x + + x%state = is_sync + end subroutine z_gpu_multi_set_sync + + function z_gpu_multi_is_dev(x) result(res) + implicit none + class(psb_z_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_dev) + end function z_gpu_multi_is_dev + + function z_gpu_multi_is_host(x) result(res) + implicit none + class(psb_z_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_host) + end function z_gpu_multi_is_host + + function z_gpu_multi_is_sync(x) result(res) + implicit none + class(psb_z_multivect_gpu), intent(in) :: x + logical :: res + + res = (x%state == is_sync) + end function z_gpu_multi_is_sync + + + function z_gpu_multi_get_nrows(x) result(res) + implicit none + class(psb_z_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_nrows + + end function z_gpu_multi_get_nrows + + function z_gpu_multi_get_ncols(x) result(res) + implicit none + class(psb_z_multivect_gpu), intent(in) :: x + integer(psb_ipk_) :: res + + res = x%m_ncols + + end function z_gpu_multi_get_ncols + + function z_gpu_multi_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'zGPU' + end function z_gpu_multi_get_fmt + +!!$ function z_gpu_multi_dot_v(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ class(psb_z_base_multivect_type), intent(inout) :: y +!!$ integer(psb_ipk_), intent(in) :: n +!!$ complex(psb_dpk_) :: res +!!$ complex(psb_dpk_), external :: ddot +!!$ integer(psb_ipk_) :: info +!!$ +!!$ res = dzero +!!$ ! +!!$ ! Note: this is the gpu implementation. +!!$ ! When we get here, we are sure that X is of +!!$ ! TYPE psb_z_vect +!!$ ! +!!$ select type(yy => y) +!!$ type is (psb_z_base_multivect_type) +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,x%v,1,yy%v,1) +!!$ type is (psb_z_multivect_gpu) +!!$ if (x%is_host()) call x%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ info = dotMultiVecDevice(res,n,x%deviceVect,yy%deviceVect) +!!$ if (info /= 0) then +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,'z_gpu_multi_dot_v') +!!$ end if +!!$ +!!$ class default +!!$ ! y%sync is done in dot_a +!!$ call x%sync() +!!$ res = y%dot(n,x%v) +!!$ end select +!!$ +!!$ end function z_gpu_multi_dot_v +!!$ +!!$ function z_gpu_multi_dot_a(n,x,y) result(res) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ complex(psb_dpk_), intent(in) :: y(:) +!!$ integer(psb_ipk_), intent(in) :: n +!!$ complex(psb_dpk_) :: res +!!$ complex(psb_dpk_), external :: ddot +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = ddot(n,y,1,x%v,1) +!!$ +!!$ end function z_gpu_multi_dot_a +!!$ +!!$ subroutine z_gpu_multi_axpby_v(m,alpha, x, beta, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ integer(psb_ipk_), intent(in) :: m +!!$ class(psb_z_base_multivect_type), intent(inout) :: x +!!$ class(psb_z_multivect_gpu), intent(inout) :: y +!!$ complex(psb_dpk_), intent (in) :: alpha, beta +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: nx, ny +!!$ +!!$ info = psb_success_ +!!$ +!!$ select type(xx => x) +!!$ type is (psb_z_base_multivect_type) +!!$ if ((beta /= dzero).and.(y%is_dev()))& +!!$ & call y%sync() +!!$ call psb_geaxpby(m,alpha,xx%v,beta,y%v,info) +!!$ call y%set_host() +!!$ type is (psb_z_multivect_gpu) +!!$ ! Do something different here +!!$ if ((beta /= dzero).and.y%is_host())& +!!$ & call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ nx = getMultiVecDeviceSize(xx%deviceVect) +!!$ ny = getMultiVecDeviceSize(y%deviceVect) +!!$ if ((nx x) +!!$ type is (psb_z_base_multivect_type) +!!$ if (y%is_dev()) call y%sync() +!!$ do i=1, n +!!$ y%v(i) = y%v(i) * xx%v(i) +!!$ end do +!!$ call y%set_host() +!!$ type is (psb_z_multivect_gpu) +!!$ ! Do something different here +!!$ if (y%is_host()) call y%sync() +!!$ if (xx%is_host()) call xx%sync() +!!$ info = axyMultiVecDevice(n,done,xx%deviceVect,y%deviceVect) +!!$ call y%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call y%mlt(xx%v,info) +!!$ call y%set_host() +!!$ end select +!!$ +!!$ end subroutine z_gpu_multi_mlt_v +!!$ +!!$ subroutine z_gpu_multi_mlt_a(x, y, info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ complex(psb_dpk_), intent(in) :: x(:) +!!$ class(psb_z_multivect_gpu), intent(inout) :: y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ call y%sync() +!!$ call y%psb_z_base_multivect_type%mlt(x,info) +!!$ call y%set_host() +!!$ end subroutine z_gpu_multi_mlt_a +!!$ +!!$ subroutine z_gpu_multi_mlt_a_2(alpha,x,y,beta,z,info) +!!$ use psi_serial_mod +!!$ implicit none +!!$ complex(psb_dpk_), intent(in) :: alpha,beta +!!$ complex(psb_dpk_), intent(in) :: x(:) +!!$ complex(psb_dpk_), intent(in) :: y(:) +!!$ class(psb_z_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_) :: i, n +!!$ +!!$ info = 0 +!!$ if (z%is_dev()) call z%sync() +!!$ call z%psb_z_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end subroutine z_gpu_multi_mlt_a_2 +!!$ +!!$ subroutine z_gpu_multi_mlt_v_2(alpha,x,y, beta,z,info,conjgx,conjgy) +!!$ use psi_serial_mod +!!$ use psb_string_mod +!!$ implicit none +!!$ complex(psb_dpk_), intent(in) :: alpha,beta +!!$ class(psb_z_base_multivect_type), intent(inout) :: x +!!$ class(psb_z_base_multivect_type), intent(inout) :: y +!!$ class(psb_z_multivect_gpu), intent(inout) :: z +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character(len=1), intent(in), optional :: conjgx, conjgy +!!$ integer(psb_ipk_) :: i, n +!!$ logical :: conjgx_, conjgy_ +!!$ +!!$ if (.false.) then +!!$ ! These are present just for coherence with the +!!$ ! complex versions; they do nothing here. +!!$ conjgx_=.false. +!!$ if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C') +!!$ conjgy_=.false. +!!$ if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C') +!!$ end if +!!$ +!!$ n = min(x%get_nrows(),y%get_nrows(),z%get_nrows()) +!!$ +!!$ ! +!!$ ! Need to reconsider BETA in the GPU side +!!$ ! of things. +!!$ ! +!!$ info = 0 +!!$ select type(xx => x) +!!$ type is (psb_z_multivect_gpu) +!!$ select type (yy => y) +!!$ type is (psb_z_multivect_gpu) +!!$ if (xx%is_host()) call xx%sync() +!!$ if (yy%is_host()) call yy%sync() +!!$ ! Z state is irrelevant: it will be done on the GPU. +!!$ info = axybzMultiVecDevice(n,alpha,xx%deviceVect,& +!!$ & yy%deviceVect,beta,z%deviceVect) +!!$ call z%set_dev() +!!$ class default +!!$ call xx%sync() +!!$ call yy%sync() +!!$ call z%psb_z_base_multivect_type%mlt(alpha,xx,yy,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ +!!$ class default +!!$ call x%sync() +!!$ call y%sync() +!!$ call z%psb_z_base_multivect_type%mlt(alpha,x,y,beta,info) +!!$ call z%set_host() +!!$ end select +!!$ end subroutine z_gpu_multi_mlt_v_2 + + + subroutine z_gpu_multi_set_scal(x,val) + class(psb_z_multivect_gpu), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val + + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_z_base_multivect_type%set_scal(val) + call x%set_host() + end subroutine z_gpu_multi_set_scal + + subroutine z_gpu_multi_set_vect(x,val) + class(psb_z_multivect_gpu), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val(:,:) + integer(psb_ipk_) :: nr + integer(psb_ipk_) :: info + + if (x%is_dev()) call x%sync() + call x%psb_z_base_multivect_type%set_vect(val) + call x%set_host() + + end subroutine z_gpu_multi_set_vect + + + +!!$ subroutine z_gpu_multi_scal(alpha, x) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ complex(psb_dpk_), intent (in) :: alpha +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ call x%psb_z_base_multivect_type%scal(alpha) +!!$ call x%set_host() +!!$ end subroutine z_gpu_multi_scal +!!$ +!!$ +!!$ function z_gpu_multi_nrm2(n,x) result(res) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ integer(psb_ipk_) :: info +!!$ ! WARNING: this should be changed. +!!$ if (x%is_host()) call x%sync() +!!$ info = nrm2MultiVecDevice(res,n,x%deviceVect) +!!$ +!!$ end function z_gpu_multi_nrm2 +!!$ +!!$ function z_gpu_multi_amax(n,x) result(res) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = maxval(abs(x%v(1:n))) +!!$ +!!$ end function z_gpu_multi_amax +!!$ +!!$ function z_gpu_multi_asum(n,x) result(res) +!!$ implicit none +!!$ class(psb_z_multivect_gpu), intent(inout) :: x +!!$ integer(psb_ipk_), intent(in) :: n +!!$ real(psb_dpk_) :: res +!!$ +!!$ if (x%is_dev()) call x%sync() +!!$ res = sum(abs(x%v(1:n))) +!!$ +!!$ end function z_gpu_multi_asum + + subroutine z_gpu_multi_all(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_multivect_gpu), intent(out) :: x + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(m,n,x%v,info,pad=zzero) + x%m_nrows = m + x%m_ncols = n + if (info == 0) call x%set_host() + if (info == 0) call x%sync_space(info) + if (info /= 0) then + info=psb_err_alloc_request_ + call psb_errpush(info,'z_gpu_multi_all',& + & i_err=(/m,n,n,n,n/)) + end if + end subroutine z_gpu_multi_all + + subroutine z_gpu_multi_zero(x) + use psi_serial_mod + implicit none + class(psb_z_multivect_gpu), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + call x%set_host() + end subroutine z_gpu_multi_zero + + subroutine z_gpu_multi_asb(m,n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_multivect_gpu), intent(inout) :: x + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: nd, nc + + + x%m_nrows = m + x%m_ncols = n + if (x%is_host()) then + call x%psb_z_base_multivect_type%asb(m,n,info) + if (info == psb_success_) call x%sync_space(info) + else if (x%is_dev()) then + nd = getMultiVecDevicePitch(x%deviceVect) + nc = getMultiVecDeviceCount(x%deviceVect) + if ((nd < m).or.(nc z_hdiag_get_fmt + ! procedure, pass(a) :: sizeof => z_hdiag_sizeof + procedure, pass(a) :: vect_mv => psb_z_hdiag_vect_mv + ! procedure, pass(a) :: csmm => psb_z_hdiag_csmm + procedure, pass(a) :: csmv => psb_z_hdiag_csmv + ! procedure, pass(a) :: in_vect_sv => psb_z_hdiag_inner_vect_sv + ! procedure, pass(a) :: scals => psb_z_hdiag_scals + ! procedure, pass(a) :: scalv => psb_z_hdiag_scal + ! procedure, pass(a) :: reallocate_nz => psb_z_hdiag_reallocate_nz + ! procedure, pass(a) :: allocate_mnnz => psb_z_hdiag_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_hdiag_from_coo + ! procedure, pass(a) :: cp_from_fmt => psb_z_cp_hdiag_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_hdiag_from_coo + ! procedure, pass(a) :: mv_from_fmt => psb_z_mv_hdiag_from_fmt + procedure, pass(a) :: free => z_hdiag_free + procedure, pass(a) :: mold => psb_z_hdiag_mold + procedure, pass(a) :: to_gpu => psb_z_hdiag_to_gpu + final :: z_hdiag_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_hdiag_mold +#endif + end type psb_z_hdiag_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_hdiag_get_nzeros, z_hdiag_free, z_hdiag_get_fmt, & + & z_hdiag_get_size, z_hdiag_sizeof, z_hdiag_get_nz_row + + + interface + subroutine psb_z_hdiag_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hdiag_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hdiag_vect_mv + end interface + +!!$ interface +!!$ subroutine psb_z_hdiag_inner_vect_sv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_ipk_, psb_z_hdiag_sparse_mat, psb_dpk_, psb_z_base_vect_type +!!$ class(psb_z_hdiag_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta +!!$ class(psb_z_base_vect_type), intent(inout) :: x, y +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_hdiag_inner_vect_sv +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdiag_reallocate_nz(nz,a) +!!$ import :: psb_z_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_z_hdiag_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdiag_allocate_mnnz(m,n,a,nz) +!!$ import :: psb_z_hdiag_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: m,n +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ integer(psb_ipk_), intent(in), optional :: nz +!!$ end subroutine psb_z_hdiag_allocate_mnnz +!!$ end interface + + interface + subroutine psb_z_hdiag_mold(a,b,info) + import :: psb_z_hdiag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hdiag_mold + end interface + + interface + subroutine psb_z_hdiag_to_gpu(a,info) + import :: psb_z_hdiag_sparse_mat, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hdiag_to_gpu + end interface + + interface + subroutine psb_z_cp_hdiag_from_coo(a,b,info) + import :: psb_z_hdiag_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hdiag_from_coo + end interface + +!!$ interface +!!$ subroutine psb_z_cp_hdiag_from_fmt(a,b,info) +!!$ import :: psb_z_hdiag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_z_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_cp_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_z_mv_hdiag_from_coo(a,b,info) + import :: psb_z_hdiag_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hdiag_from_coo + end interface + +!!$ +!!$ interface +!!$ subroutine psb_z_mv_hdiag_from_fmt(a,b,info) +!!$ import :: psb_z_hdiag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ class(psb_z_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_mv_hdiag_from_fmt +!!$ end interface +!!$ + interface + subroutine psb_z_hdiag_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hdiag_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hdiag_csmv + end interface + +!!$ interface +!!$ subroutine psb_z_hdiag_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdiag_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_hdiag_csmm +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdiag_scal(d,a,info, side) +!!$ import :: psb_z_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_z_hdiag_scal +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdiag_scals(d,a,info) +!!$ import :: psb_z_hdiag_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdiag_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_hdiag_scals +!!$ end interface +!!$ + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + function z_hdiag_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIAG' + end function z_hdiag_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_hdiag_free(a) + use hdiagdev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_z_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_hdia_sparse_mat%free() + + return + + end subroutine z_hdiag_free + + subroutine z_hdiag_finalize(a) + use hdiagdev_mod + implicit none + type(psb_z_hdiag_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHdiagDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_hdia_sparse_mat%free() + + return + end subroutine z_hdiag_finalize + +#else + + interface + subroutine psb_z_hdiag_mold(a,b,info) + import :: psb_z_hdiag_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hdiag_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hdiag_mold + end interface + +#endif + +end module psb_z_hdiag_mat_mod diff --git a/gpu/psb_z_hlg_mat_mod.F90 b/gpu/psb_z_hlg_mat_mod.F90 new file mode 100644 index 000000000..09d490b3d --- /dev/null +++ b/gpu/psb_z_hlg_mat_mod.F90 @@ -0,0 +1,398 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_hlg_mat_mod + + use iso_c_binding + use psb_z_mat_mod + use psb_z_hll_mat_mod + + + integer(psb_ipk_), parameter, private :: is_host = -1 + integer(psb_ipk_), parameter, private :: is_sync = 0 + integer(psb_ipk_), parameter, private :: is_dev = 1 + + type, extends(psb_z_hll_sparse_mat) :: psb_z_hlg_sparse_mat + ! + ! ITPACK/HLL format, extended. + ! We are adding here the routines to create a copy of the data + ! into the GPU. + ! If HAVE_SPGPU is undefined this is just + ! a copy of HLL, indistinguishable. + ! +#ifdef HAVE_SPGPU + type(c_ptr) :: deviceMat = c_null_ptr + integer :: devstate = is_host + + contains + procedure, nopass :: get_fmt => z_hlg_get_fmt + procedure, pass(a) :: sizeof => z_hlg_sizeof + procedure, pass(a) :: vect_mv => psb_z_hlg_vect_mv + procedure, pass(a) :: csmm => psb_z_hlg_csmm + procedure, pass(a) :: csmv => psb_z_hlg_csmv + procedure, pass(a) :: in_vect_sv => psb_z_hlg_inner_vect_sv + procedure, pass(a) :: scals => psb_z_hlg_scals + procedure, pass(a) :: scalv => psb_z_hlg_scal + procedure, pass(a) :: reallocate_nz => psb_z_hlg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_hlg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_hlg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_z_cp_hlg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_hlg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_z_mv_hlg_from_fmt + procedure, pass(a) :: free => z_hlg_free + procedure, pass(a) :: mold => psb_z_hlg_mold + procedure, pass(a) :: is_host => z_hlg_is_host + procedure, pass(a) :: is_dev => z_hlg_is_dev + procedure, pass(a) :: is_sync => z_hlg_is_sync + procedure, pass(a) :: set_host => z_hlg_set_host + procedure, pass(a) :: set_dev => z_hlg_set_dev + procedure, pass(a) :: set_sync => z_hlg_set_sync + procedure, pass(a) :: sync => z_hlg_sync + procedure, pass(a) :: from_gpu => psb_z_hlg_from_gpu + procedure, pass(a) :: to_gpu => psb_z_hlg_to_gpu + final :: z_hlg_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_hlg_mold +#endif + end type psb_z_hlg_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_hlg_get_nzeros, z_hlg_free, z_hlg_get_fmt, & + & z_hlg_get_size, z_hlg_sizeof, z_hlg_get_nz_row + + + interface + subroutine psb_z_hlg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hlg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hlg_vect_mv + end interface + + interface + subroutine psb_z_hlg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_ipk_, psb_z_hlg_sparse_mat, psb_dpk_, psb_z_base_vect_type + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hlg_inner_vect_sv + end interface + + interface + subroutine psb_z_hlg_reallocate_nz(nz,a) + import :: psb_z_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hlg_sparse_mat), intent(inout) :: a + end subroutine psb_z_hlg_reallocate_nz + end interface + + interface + subroutine psb_z_hlg_allocate_mnnz(m,n,a,nz) + import :: psb_z_hlg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_hlg_allocate_mnnz + end interface + + interface + subroutine psb_z_hlg_mold(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hlg_mold + end interface + + interface + subroutine psb_z_hlg_from_gpu(a,info) + import :: psb_z_hlg_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hlg_from_gpu + end interface + + interface + subroutine psb_z_hlg_to_gpu(a,info, nzrm) + import :: psb_z_hlg_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_z_hlg_to_gpu + end interface + + interface + subroutine psb_z_cp_hlg_from_coo(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hlg_from_coo + end interface + + interface + subroutine psb_z_cp_hlg_from_fmt(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hlg_from_fmt + end interface + + interface + subroutine psb_z_mv_hlg_from_coo(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hlg_from_coo + end interface + + + interface + subroutine psb_z_mv_hlg_from_fmt(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hlg_from_fmt + end interface + + interface + subroutine psb_z_hlg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hlg_csmv + end interface + interface + subroutine psb_z_hlg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hlg_csmm + end interface + + interface + subroutine psb_z_hlg_scal(d,a,info, side) + import :: psb_z_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_hlg_scal + end interface + + interface + subroutine psb_z_hlg_scals(d,a,info) + import :: psb_z_hlg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hlg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_hlg_sizeof(a) result(res) + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%hkoffs) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function z_hlg_sizeof + + function z_hlg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLG' + end function z_hlg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_hlg_free(a) + use hlldev_mod + implicit none + integer(psb_ipk_) :: info + class(psb_z_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + call a%psb_z_hll_sparse_mat%free() + + return + + end subroutine z_hlg_free + + + subroutine z_hlg_sync(a) + implicit none + class(psb_z_hlg_sparse_mat), target, intent(in) :: a + class(psb_z_hlg_sparse_mat), pointer :: tmpa + integer(psb_ipk_) :: info + + tmpa => a + if (tmpa%is_host()) then + call tmpa%to_gpu(info) + else if (tmpa%is_dev()) then + call tmpa%from_gpu(info) + end if + call tmpa%set_sync() + return + + end subroutine z_hlg_sync + + subroutine z_hlg_set_host(a) + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_host + end subroutine z_hlg_set_host + + subroutine z_hlg_set_dev(a) + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_dev + end subroutine z_hlg_set_dev + + subroutine z_hlg_set_sync(a) + implicit none + class(psb_z_hlg_sparse_mat), intent(inout) :: a + + a%devstate = is_sync + end subroutine z_hlg_set_sync + + function z_hlg_is_dev(a) result(res) + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_dev) + end function z_hlg_is_dev + + function z_hlg_is_host(a) result(res) + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_host) + end function z_hlg_is_host + + function z_hlg_is_sync(a) result(res) + implicit none + class(psb_z_hlg_sparse_mat), intent(in) :: a + logical :: res + + res = (a%devstate == is_sync) + end function z_hlg_is_sync + + + subroutine z_hlg_finalize(a) + use hlldev_mod + implicit none + type(psb_z_hlg_sparse_mat), intent(inout) :: a + + if (c_associated(a%deviceMat)) & + & call freeHllDevice(a%deviceMat) + a%deviceMat = c_null_ptr + + return + end subroutine z_hlg_finalize + +#else + + interface + subroutine psb_z_hlg_mold(a,b,info) + import :: psb_z_hlg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hlg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hlg_mold + end interface + +#endif + +end module psb_z_hlg_mat_mod diff --git a/gpu/psb_z_hybg_mat_mod.F90 b/gpu/psb_z_hybg_mat_mod.F90 new file mode 100644 index 000000000..465677e38 --- /dev/null +++ b/gpu/psb_z_hybg_mat_mod.F90 @@ -0,0 +1,306 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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. +! + +#if CUDA_SHORT_VERSION <= 10 + +module psb_z_hybg_mat_mod + + use iso_c_binding + use psb_z_mat_mod + use cusparse_mod + + type, extends(psb_z_csr_sparse_mat) :: psb_z_hybg_sparse_mat + ! + ! HYBG. An interface to the cuSPARSE HYB + ! On the CPU side we keep a CSR storage. + ! + ! + ! + ! +#ifdef HAVE_SPGPU + type(z_Hmat) :: deviceMat + + contains + procedure, nopass :: get_fmt => z_hybg_get_fmt + procedure, pass(a) :: sizeof => z_hybg_sizeof + procedure, pass(a) :: vect_mv => psb_z_hybg_vect_mv + procedure, pass(a) :: in_vect_sv => psb_z_hybg_inner_vect_sv + procedure, pass(a) :: csmm => psb_z_hybg_csmm + procedure, pass(a) :: csmv => psb_z_hybg_csmv + procedure, pass(a) :: scals => psb_z_hybg_scals + procedure, pass(a) :: scalv => psb_z_hybg_scal + procedure, pass(a) :: reallocate_nz => psb_z_hybg_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_hybg_allocate_mnnz + ! Note: we do *not* need the TO methods, because the parent type + ! methods will work. + procedure, pass(a) :: cp_from_coo => psb_z_cp_hybg_from_coo + procedure, pass(a) :: cp_from_fmt => psb_z_cp_hybg_from_fmt + procedure, pass(a) :: mv_from_coo => psb_z_mv_hybg_from_coo + procedure, pass(a) :: mv_from_fmt => psb_z_mv_hybg_from_fmt + procedure, pass(a) :: free => z_hybg_free + procedure, pass(a) :: mold => psb_z_hybg_mold + procedure, pass(a) :: to_gpu => psb_z_hybg_to_gpu + final :: z_hybg_finalize +#else + contains + procedure, pass(a) :: mold => psb_z_hybg_mold +#endif + end type psb_z_hybg_sparse_mat + +#ifdef HAVE_SPGPU + private :: z_hybg_get_nzeros, z_hybg_free, z_hybg_get_fmt, & + & z_hybg_get_size, z_hybg_sizeof, z_hybg_get_nz_row + + + interface + subroutine psb_z_hybg_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hybg_inner_vect_sv + end interface + + interface + subroutine psb_z_hybg_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_z_base_vect_type, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hybg_vect_mv + end interface + + interface + subroutine psb_z_hybg_reallocate_nz(nz,a) + import :: psb_z_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hybg_sparse_mat), intent(inout) :: a + end subroutine psb_z_hybg_reallocate_nz + end interface + + interface + subroutine psb_z_hybg_allocate_mnnz(m,n,a,nz) + import :: psb_z_hybg_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_hybg_allocate_mnnz + end interface + + interface + subroutine psb_z_hybg_mold(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hybg_mold + end interface + + interface + subroutine psb_z_hybg_to_gpu(a,info, nzrm) + import :: psb_z_hybg_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: nzrm + end subroutine psb_z_hybg_to_gpu + end interface + + interface + subroutine psb_z_cp_hybg_from_coo(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hybg_from_coo + end interface + + interface + subroutine psb_z_cp_hybg_from_fmt(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hybg_from_fmt + end interface + + interface + subroutine psb_z_mv_hybg_from_coo(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hybg_from_coo + end interface + + interface + subroutine psb_z_mv_hybg_from_fmt(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hybg_from_fmt + end interface + + interface + subroutine psb_z_hybg_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hybg_csmv + end interface + interface + subroutine psb_z_hybg_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hybg_csmm + end interface + + interface + subroutine psb_z_hybg_scal(d,a,info,side) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_hybg_scal + end interface + + interface + subroutine psb_z_hybg_scals(d,a,info) + import :: psb_z_hybg_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hybg_scals + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_hybg_sizeof(a) result(res) + implicit none + class(psb_z_hybg_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irp) + res = res + psb_sizeof_ip * size(a%ja) + ! Should we account for the shadow data structure + ! on the GPU device side? + ! res = 2*res + + end function z_hybg_sizeof + + function z_hybg_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HYBG' + end function z_hybg_get_fmt + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_hybg_free(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + class(psb_z_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + call a%psb_z_csr_sparse_mat%free() + + return + + end subroutine z_hybg_free + + subroutine z_hybg_finalize(a) + use cusparse_mod + implicit none + integer(psb_ipk_) :: info + type(psb_z_hybg_sparse_mat), intent(inout) :: a + + info = HYBGDeviceFree(a%deviceMat) + + return + end subroutine z_hybg_finalize + +#else + + interface + subroutine psb_z_hybg_mold(a,b,info) + import :: psb_z_hybg_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hybg_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hybg_mold + end interface + +#endif + +end module psb_z_hybg_mat_mod +#endif diff --git a/gpu/psb_z_vectordev_mod.F90 b/gpu/psb_z_vectordev_mod.F90 new file mode 100644 index 000000000..58c43a43c --- /dev/null +++ b/gpu/psb_z_vectordev_mod.F90 @@ -0,0 +1,390 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 psb_z_vectordev_mod + + use psb_base_vectordev_mod + +#ifdef HAVE_SPGPU + + interface registerMapped + function registerMappedDoubleComplex(buf,d_p,n,dummy) & + & result(res) bind(c,name='registerMappedDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: buf + type(c_ptr) :: d_p + integer(c_int),value :: n + complex(c_double_complex), value :: dummy + end function registerMappedDoubleComplex + end interface + + interface writeMultiVecDevice + function writeMultiVecDeviceDoubleComplex(deviceVec,hostVec) & + & result(res) bind(c,name='writeMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + complex(c_double_complex) :: hostVec(*) + end function writeMultiVecDeviceDoubleComplex + function writeMultiVecDeviceDoubleComplexR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='writeMultiVecDeviceDoubleComplexR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + complex(c_double_complex) :: hostVec(ld,*) + end function writeMultiVecDeviceDoubleComplexR2 + end interface + + interface readMultiVecDevice + function readMultiVecDeviceDoubleComplex(deviceVec,hostVec) & + & result(res) bind(c,name='readMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + complex(c_double_complex) :: hostVec(*) + end function readMultiVecDeviceDoubleComplex + function readMultiVecDeviceDoubleComplexR2(deviceVec,hostVec,ld) & + & result(res) bind(c,name='readMultiVecDeviceDoubleComplexR2') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int), value :: ld + complex(c_double_complex) :: hostVec(ld,*) + end function readMultiVecDeviceDoubleComplexR2 + end interface + + interface allocateDoubleComplex + function allocateDoubleComplex(didx,n) & + & result(res) bind(c,name='allocateDoubleComplex') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: n + integer(c_int) :: res + end function allocateDoubleComplex + function allocateMultiDoubleComplex(didx,m,n) & + & result(res) bind(c,name='allocateMultiDoubleComplex') + use iso_c_binding + type(c_ptr) :: didx + integer(c_int),value :: m,n + integer(c_int) :: res + end function allocateMultiDoubleComplex + end interface + + interface writeDoubleComplex + function writeDoubleComplex(didx,hidx,n) & + & result(res) bind(c,name='writeDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(*) + integer(c_int),value :: n + end function writeDoubleComplex + function writeDoubleComplexFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='writeDoubleComplexFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function writeDoubleComplexFirst + function writeMultiDoubleComplex(didx,hidx,m,n) & + & result(res) bind(c,name='writeMultiDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(m,*) + integer(c_int),value :: m,n + end function writeMultiDoubleComplex + end interface + + interface readDoubleComplex + function readDoubleComplex(didx,hidx,n) & + & result(res) bind(c,name='readDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(*) + integer(c_int),value :: n + end function readDoubleComplex + function readDoubleComplexFirst(first,didx,hidx,n,IndexBase) & + & result(res) bind(c,name='readDoubleComplexFirst') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(*) + integer(c_int),value :: n, first, IndexBase + end function readDoubleComplexFirst + function readMultiDoubleComplex(didx,hidx,m,n) & + & result(res) bind(c,name='readMultiDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: didx + complex(c_double_complex) :: hidx(m,*) + integer(c_int),value :: m,n + end function readMultiDoubleComplex + end interface + + interface + subroutine freeDoubleComplex(didx) & + & bind(c,name='freeDoubleComplex') + use iso_c_binding + type(c_ptr), value :: didx + end subroutine freeDoubleComplex + end interface + + + interface setScalDevice + function setScalMultiVecDeviceDoubleComplex(val, first, last, & + & indexBase, deviceVecX) result(res) & + & bind(c,name='setscalMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: first,last,indexbase + complex(c_double_complex), value :: val + type(c_ptr), value :: deviceVecX + end function setScalMultiVecDeviceDoubleComplex + end interface + + interface + function geinsMultiVecDeviceDoubleComplex(n,deviceVecIrl,deviceVecVal,& + & dupl,indexbase,deviceVecX) & + & result(res) bind(c,name='geinsMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n, dupl,indexbase + type(c_ptr), value :: deviceVecIrl, deviceVecVal, deviceVecX + end function geinsMultiVecDeviceDoubleComplex + end interface + + ! New gather functions + + interface + function igathMultiVecDeviceDoubleComplex(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceDoubleComplex + end interface + + interface + function igathMultiVecDeviceDoubleComplexVecIdx(deviceVec, vectorId, n, first, idx, & + & hfirst, hostVec, indexBase) & + & result(res) bind(c,name='igathMultiVecDeviceDoubleComplexVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value:: vectorId + integer(c_int),value:: first, n, hfirst + type(c_ptr),value :: idx + type(c_ptr),value :: hostVec + integer(c_int),value:: indexBase + end function igathMultiVecDeviceDoubleComplexVecIdx + end interface + + interface + function iscatMultiVecDeviceDoubleComplex(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + complex(c_double_complex),value :: beta + end function iscatMultiVecDeviceDoubleComplex + end interface + + interface + function iscatMultiVecDeviceDoubleComplexVecIdx(deviceVec, vectorId, & + & first, n, idx, hfirst, hostVec, indexBase, beta) & + & result(res) bind(c,name='iscatMultiVecDeviceDoubleComplexVecIdx') + use iso_c_binding + integer(c_int) :: res + type(c_ptr), value :: deviceVec + integer(c_int),value :: vectorId + integer(c_int),value :: first, n, hfirst + type(c_ptr), value :: idx + type(c_ptr), value :: hostVec + integer(c_int),value :: indexBase + complex(c_double_complex),value :: beta + end function iscatMultiVecDeviceDoubleComplexVecIdx + end interface + + + interface scalMultiVecDevice + function scalMultiVecDeviceDoubleComplex(alpha,deviceVecA) & + & result(val) bind(c,name='scalMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + complex(c_double_complex), value :: alpha + type(c_ptr), value :: deviceVecA + end function scalMultiVecDeviceDoubleComplex + end interface + + interface dotMultiVecDevice + function dotMultiVecDeviceDoubleComplex(res, n,deviceVecA,deviceVecB) & + & result(val) bind(c,name='dotMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + complex(c_double_complex) :: res + type(c_ptr), value :: deviceVecA, deviceVecB + end function dotMultiVecDeviceDoubleComplex + end interface + + interface nrm2MultiVecDeviceComplex + function nrm2MultiVecDeviceDoubleComplex(res,n,deviceVecA) & + & result(val) bind(c,name='nrm2MultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function nrm2MultiVecDeviceDoubleComplex + end interface + + interface amaxMultiVecDeviceComplex + function amaxMultiVecDeviceDoubleComplex(res,n,deviceVecA) & + & result(val) bind(c,name='amaxMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function amaxMultiVecDeviceDoubleComplex + end interface + + interface asumMultiVecDeviceComplex + function asumMultiVecDeviceDoubleComplex(res,n,deviceVecA) & + & result(val) bind(c,name='asumMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: val + integer(c_int), value :: n + real(c_double) :: res + type(c_ptr), value :: deviceVecA + end function asumMultiVecDeviceDoubleComplex + end interface + + + interface axpbyMultiVecDevice + function axpbyMultiVecDeviceDoubleComplex(n,alpha,deviceVecA,beta,deviceVecB) & + & result(res) bind(c,name='axpbyMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_double_complex), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB + end function axpbyMultiVecDeviceDoubleComplex + end interface + + interface axyMultiVecDevice + function axyMultiVecDeviceDoubleComplex(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='axyMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_double_complex), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function axyMultiVecDeviceDoubleComplex + end interface + + interface axybzMultiVecDevice + function axybzMultiVecDeviceDoubleComplex(n,alpha,deviceVecA,deviceVecB,beta,deviceVecZ) & + & result(res) bind(c,name='axybzMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_double_complex), value :: alpha, beta + type(c_ptr), value :: deviceVecA, deviceVecB,deviceVecZ + end function axybzMultiVecDeviceDoubleComplex + end interface + + + interface absMultiVecDevice + function absMultiVecDeviceDoubleComplex(n,alpha,deviceVecA) & + & result(res) bind(c,name='absMultiVecDeviceDoubleComplex') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_double_complex), value :: alpha + type(c_ptr), value :: deviceVecA + end function absMultiVecDeviceDoubleComplex + function absMultiVecDeviceDoubleComplex2(n,alpha,deviceVecA,deviceVecB) & + & result(res) bind(c,name='absMultiVecDeviceDoubleComplex2') + use iso_c_binding + integer(c_int) :: res + integer(c_int), value :: n + complex(c_double_complex), value :: alpha + type(c_ptr), value :: deviceVecA, deviceVecB + end function absMultiVecDeviceDoubleComplex2 + end interface + + interface inner_register + module procedure inner_registerDoubleComplex + end interface + + interface inner_unregister + module procedure inner_unregisterDoubleComplex + end interface + +contains + + + function inner_registerDoubleComplex(buffer,dval) result(res) + complex(c_double_complex), allocatable, target :: buffer(:) + type(c_ptr) :: dval + integer(c_int) :: res + complex(c_double_complex) :: dummy + res = registerMapped(c_loc(buffer),dval,size(buffer), dummy) + end function inner_registerDoubleComplex + + subroutine inner_unregisterDoubleComplex(buffer) + complex(c_double_complex), allocatable, target :: buffer(:) + + call unregisterMapped(c_loc(buffer)) + end subroutine inner_unregisterDoubleComplex + +#endif + +end module psb_z_vectordev_mod diff --git a/gpu/s_cusparse_mod.F90 b/gpu/s_cusparse_mod.F90 new file mode 100644 index 000000000..6e628fa19 --- /dev/null +++ b/gpu/s_cusparse_mod.F90 @@ -0,0 +1,305 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 s_cusparse_mod + use base_cusparse_mod + + type, bind(c) :: s_Cmat + type(c_ptr) :: Mat = c_null_ptr + end type s_Cmat + +#if CUDA_SHORT_VERSION <= 10 + type, bind(c) :: s_Hmat + type(c_ptr) :: Mat = c_null_ptr + end type s_Hmat +#endif + + +#if defined(HAVE_CUDA) && defined(HAVE_SPGPU) + + interface CSRGDeviceFree + function s_CSRGDeviceFree(Mat) & + & bind(c,name="s_CSRGDeviceFree") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int) :: res + end function s_CSRGDeviceFree + end interface + + interface CSRGDeviceSetMatType + function s_CSRGDeviceSetMatType(Mat,type) & + & bind(c,name="s_CSRGDeviceSetMatType") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_CSRGDeviceSetMatType + end interface + + interface CSRGDeviceSetMatFillMode + function s_CSRGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="s_CSRGDeviceSetMatFillMode") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_CSRGDeviceSetMatFillMode + end interface + + interface CSRGDeviceSetMatDiagType + function s_CSRGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="s_CSRGDeviceSetMatDiagType") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_CSRGDeviceSetMatDiagType + end interface + + interface CSRGDeviceSetMatIndexBase + function s_CSRGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="s_CSRGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_CSRGDeviceSetMatIndexBase + end interface + + interface CSRGDeviceCsrsmAnalysis + function s_CSRGDeviceCsrsmAnalysis(Mat) & + & bind(c,name="s_CSRGDeviceCsrsmAnalysis") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int) :: res + end function s_CSRGDeviceCsrsmAnalysis + end interface + + interface CSRGDeviceAlloc + function s_CSRGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="s_CSRGDeviceAlloc") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function s_CSRGDeviceAlloc + end interface + + interface CSRGDeviceGetParms + function s_CSRGDeviceGetParms(Mat,nr,nc,nz) & + & bind(c,name="s_CSRGDeviceGetParms") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int) :: nr, nc, nz + integer(c_int) :: res + end function s_CSRGDeviceGetParms + end interface + + interface spsvCSRGDevice + function s_spsvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="s_spsvCSRGDevice") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_float), value :: alpha,beta + integer(c_int) :: res + end function s_spsvCSRGDevice + end interface + + interface spmvCSRGDevice + function s_spmvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="s_spmvCSRGDevice") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_float), value :: alpha,beta + integer(c_int) :: res + end function s_spmvCSRGDevice + end interface + + interface CSRGHost2Device + function s_CSRGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="s_CSRGHost2Device") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_float) :: val(*) + integer(c_int) :: res + end function s_CSRGHost2Device + end interface + + interface CSRGDevice2Host + function s_CSRGDevice2Host(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="s_CSRGDevice2Host") result(res) + use iso_c_binding + import s_Cmat + type(s_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_float) :: val(*) + integer(c_int) :: res + end function s_CSRGDevice2Host + end interface + +#if CUDA_SHORT_VERSION <= 10 + interface HYBGDeviceAlloc + function s_HYBGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="s_HYBGDeviceAlloc") result(res) + use iso_c_binding + import s_hmat + type(s_Hmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function s_HYBGDeviceAlloc + end interface + + interface HYBGDeviceFree + function s_HYBGDeviceFree(Mat) & + & bind(c,name="s_HYBGDeviceFree") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int) :: res + end function s_HYBGDeviceFree + end interface + + interface HYBGDeviceSetMatType + function s_HYBGDeviceSetMatType(Mat,type) & + & bind(c,name="s_HYBGDeviceSetMatType") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_HYBGDeviceSetMatType + end interface + + interface HYBGDeviceSetMatFillMode + function s_HYBGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="s_HYBGDeviceSetMatFillMode") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_HYBGDeviceSetMatFillMode + end interface + + interface HYBGDeviceSetMatDiagType + function s_HYBGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="s_HYBGDeviceSetMatDiagType") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_HYBGDeviceSetMatDiagType + end interface + + interface HYBGDeviceSetMatIndexBase + function s_HYBGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="s_HYBGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function s_HYBGDeviceSetMatIndexBase + end interface + + interface HYBGDeviceHybsmAnalysis + function s_HYBGDeviceHybsmAnalysis(Mat) & + & bind(c,name="s_HYBGDeviceHybsmAnalysis") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int) :: res + end function s_HYBGDeviceHybsmAnalysis + end interface + + interface spsvHYBGDevice + function s_spsvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="s_spsvHYBGDevice") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_float), value :: alpha,beta + integer(c_int) :: res + end function s_spsvHYBGDevice + end interface + + interface spmvHYBGDevice + function s_spmvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="s_spmvHYBGDevice") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + real(c_float), value :: alpha,beta + integer(c_int) :: res + end function s_spmvHYBGDevice + end interface + + interface HYBGHost2Device + function s_HYBGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="s_HYBGHost2Device") result(res) + use iso_c_binding + import s_Hmat + type(s_Hmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + real(c_float) :: val(*) + integer(c_int) :: res + end function s_HYBGHost2Device + end interface +#endif + +#endif + +end module s_cusparse_mod diff --git a/gpu/scusparse.c b/gpu/scusparse.c new file mode 100644 index 000000000..70a0cbd72 --- /dev/null +++ b/gpu/scusparse.c @@ -0,0 +1,95 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 + +#ifdef HAVE_SPGPU +#include +#include +#include "cintrf.h" +#include "fcusparse.h" + +/* Single precision real */ +#define TYPE float +#define CUSPARSE_BASE_TYPE CUDA_R_32F +#define T_CSRGDeviceMat s_CSRGDeviceMat +#define T_Cmat s_Cmat +#define T_spmvCSRGDevice s_spmvCSRGDevice +#define T_spsvCSRGDevice s_spsvCSRGDevice +#define T_CSRGDeviceAlloc s_CSRGDeviceAlloc +#define T_CSRGDeviceFree s_CSRGDeviceFree +#define T_CSRGHost2Device s_CSRGHost2Device +#define T_CSRGDevice2Host s_CSRGDevice2Host +#define T_CSRGDeviceSetMatFillMode s_CSRGDeviceSetMatFillMode +#define T_CSRGDeviceSetMatDiagType s_CSRGDeviceSetMatDiagType +#define T_CSRGDeviceGetParms s_CSRGDeviceGetParms + +#if CUDA_SHORT_VERSION <= 10 +#define T_CSRGDeviceSetMatType s_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase s_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsmAnalysis s_CSRGDeviceCsrsmAnalysis +#define cusparseTcsrmv cusparseScsrmv +#define cusparseTcsrsv_solve cusparseScsrsv_solve +#define cusparseTcsrsv_analysis cusparseScsrsv_analysis + +#define T_HYBGDeviceMat s_HYBGDeviceMat +#define T_Hmat s_Hmat +#define T_HYBGDeviceFree s_HYBGDeviceFree +#define T_spmvHYBGDevice s_spmvHYBGDevice +#define T_HYBGDeviceAlloc s_HYBGDeviceAlloc +#define T_HYBGDeviceSetMatDiagType s_HYBGDeviceSetMatDiagType +#define T_HYBGDeviceSetMatIndexBase s_HYBGDeviceSetMatIndexBase +#define T_HYBGDeviceSetMatType s_HYBGDeviceSetMatType +#define T_HYBGDeviceSetMatFillMode s_HYBGDeviceSetMatFillMode +#define T_HYBGDeviceHybsmAnalysis s_HYBGDeviceHybsmAnalysis +#define T_spsvHYBGDevice s_spsvHYBGDevice +#define T_HYBGHost2Device s_HYBGHost2Device +#define cusparseThybmv cusparseShybmv +#define cusparseThybsv_solve cusparseShybsv_solve +#define cusparseThybsv_analysis cusparseShybsv_analysis +#define cusparseTcsr2hyb cusparseScsr2hyb + + +#elif CUDA_VERSION < 11030 + +#define T_CSRGDeviceSetMatType s_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase s_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsv2Analysis s_CSRGDeviceCsrsv2Analysis +#define cusparseTcsrsv2_bufferSize cusparseScsrsv2_bufferSize +#define cusparseTcsrsv2_analysis cusparseScsrsv2_analysis +#define cusparseTcsrsv2_solve cusparseScsrsv2_solve +#endif + +#include "fcusparse_fct.h" + +#endif diff --git a/gpu/svectordev.c b/gpu/svectordev.c new file mode 100644 index 000000000..d193a4d8c --- /dev/null +++ b/gpu/svectordev.c @@ -0,0 +1,304 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +//#include "utils.h" +//#include "common.h" +#include "svectordev.h" + + +int registerMappedFloat(void *buff, void **d_p, int n, float dummy) +{ + return registerMappedMemory(buff,d_p,n*sizeof(float)); +} + +int writeMultiVecDeviceFloat(void* deviceVec, float* hostVec) +{ int i; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + // Ex updateFromHost vector function + i = writeRemoteBuffer((void*) hostVec, (void *)devVec->v_, devVec->pitch_*devVec->count_*sizeof(float)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocMultiVecDevice",i); + } + return(i); +} + +int writeMultiVecDeviceFloatR2(void* deviceVec, float* hostVec, int ld) +{ int i; + i = writeMultiVecDeviceFloat(deviceVec, (void *) hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeMultiVecDeviceFloatR2",i); + } + return(i); +} + +int readMultiVecDeviceFloat(void* deviceVec, float* hostVec) +{ int i,j; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = readRemoteBuffer((void *) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(float)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceFloat",i); + } + return(i); +} + +int readMultiVecDeviceFloatR2(void* deviceVec, float* hostVec, int ld) +{ int i; + i = readMultiVecDeviceFloat(deviceVec, hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceFloatR2",i); + } + return(i); +} + +int setscalMultiVecDeviceFloat(float val, int first, int last, + int indexBase, void* devMultiVecX) +{ int i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuSsetscal(handle, first, last, indexBase, val, (float *) devVecX->v_); + + return(i); +} + +int geinsMultiVecDeviceFloat(int n, void* devMultiVecIrl, void* devMultiVecVal, + int dupl, int indexBase, void* devMultiVecX) +{ int j=0, i=0,nmin=0,nmax=0; + int pitch = 0; + float beta; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecIrl = (struct MultiVectDevice *) devMultiVecIrl; + struct MultiVectDevice *devVecVal = (struct MultiVectDevice *) devMultiVecVal; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecIrl->pitch_; + if ((n > devVecIrl->size_) || (n>devVecVal->size_ )) + return SPGPU_UNSUPPORTED; + + //fprintf(stderr,"geins: %d %d %p %p %p\n",dupl,n,devVecIrl->v_,devVecVal->v_,devVecX->v_); + + if (dupl == INS_OVERWRITE) + beta = 0.0; + else if (dupl == INS_ADD) + beta = 1.0; + else + beta = 0.0; + + spgpuSscat(handle, (float *) devVecX->v_, n, (float*)devVecVal->v_, + (int*)devVecIrl->v_, indexBase, beta); + + return(i); +} + + +int igathMultiVecDeviceFloatVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + + i= igathMultiVecDeviceFloat(deviceVec, vectorId, n, + first, (void*) devIdx->v_, hfirst, host_values, indexBase); + return(i); +} + +int igathMultiVecDeviceFloat(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, int indexBase) +{ + int i, *idx =(int *) indexes;; + float *hv = (float *) host_values;; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + i=0; + hv = &(hv[hfirst-indexBase]); + idx = &(idx[first-indexBase]); + spgpuSgath(handle,hv, n, idx,indexBase, (float *) devVec->v_+vectorId*devVec->pitch_); + return(i); +} + +int iscatMultiVecDeviceFloatVecIdx(void* deviceVec, int vectorId, int n, int first, void *deviceIdx, + int hfirst, void* host_values, int indexBase, float beta) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + i= iscatMultiVecDeviceFloat(deviceVec, vectorId, n, first, + (void*) devIdx->v_, hfirst,host_values, indexBase, beta); + return(i); +} + +int iscatMultiVecDeviceFloat(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, float beta) +{ int i=0; + float *hv = (float *) host_values; + int *idx=(int *) indexes; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + idx = &(idx[first-indexBase]); + hv = &(hv[hfirst-indexBase]); + spgpuSscat(handle, (float *) devVec->v_, n, hv, idx, indexBase, beta); + return SPGPU_SUCCESS; + +} + + +int nrm2MultiVecDeviceFloat(float* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuSmnrm2(handle, y_res, n,(float *)devVecA->v_, devVecA->count_, devVecA->pitch_); + return(i); +} + +int amaxMultiVecDeviceFloat(float* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuSmamax(handle, y_res, n,(float *)devVecA->v_, devVecA->count_, devVecA->pitch_); + return(i); +} + +int asumMultiVecDeviceFloat(float* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuSmasum(handle, y_res, n,(float *)devVecA->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int scalMultiVecDeviceFloat(float alpha, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + // Note: inner kernel can handle aliased input/output + spgpuSscal(handle, (float *)devVecA->v_, devVecA->pitch_, + alpha, (float *)devVecA->v_); + return(i); +} + +int dotMultiVecDeviceFloat(float* y_res, int n, void* devMultiVecA, void* devMultiVecB) +{int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) devMultiVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuSmdot(handle, y_res, n, (float*)devVecA->v_, (float*)devVecB->v_,devVecA->count_,devVecB->pitch_); + return(i); +} + +int axpbyMultiVecDeviceFloat(int n,float alpha, void* devMultiVecX, + float beta, void* devMultiVecY) +{ int j=0, i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecY = (struct MultiVectDevice *) devMultiVecY; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecY->pitch_; + if ((n > devVecY->size_) || (n>devVecX->size_ )) + return SPGPU_UNSUPPORTED; + + for(j=0;jcount_;j++) + spgpuSaxpby(handle,(float*)devVecY->v_+pitch*j, n, beta, + (float*)devVecY->v_+pitch*j, alpha,(float*) devVecX->v_+pitch*j); + return(i); +} + +int axyMultiVecDeviceFloat(int n, float alpha, void *deviceVecA, void *deviceVecB) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuSmaxy(handle, (float*)devVecB->v_, n, alpha, (float*)devVecA->v_, + (float*)devVecB->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int axybzMultiVecDeviceFloat(int n, float alpha, void *deviceVecA, + void *deviceVecB, float beta, void *deviceVecZ) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + struct MultiVectDevice *devVecZ = (struct MultiVectDevice *) deviceVecZ; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ ) || (n>devVecZ->size_ )) + return SPGPU_UNSUPPORTED; + spgpuSmaxypbz(handle, (float*)devVecZ->v_, n, beta, (float*)devVecZ->v_, + alpha, (float*) devVecA->v_, (float*) devVecB->v_, + devVecB->count_, devVecB->pitch_); + return(i); +} + +int absMultiVecDeviceFloat2(int n, float alpha, void *deviceVecA, + void *deviceVecB) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuSabs(handle, (float*)devVecB->v_, n, alpha, (float*)devVecA->v_); + + return(i); +} + +int absMultiVecDeviceFloat(int n, float alpha, void *deviceVecA) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + spgpuHandle_t handle=psb_gpuGetHandle(); + if (n > devVecA->size_) + return SPGPU_UNSUPPORTED; + + spgpuSabs(handle, (float*)devVecA->v_, n, alpha, (float*)devVecA->v_); + + return(i); +} + +#endif + diff --git a/gpu/svectordev.h b/gpu/svectordev.h new file mode 100644 index 000000000..1fd4fd114 --- /dev/null +++ b/gpu/svectordev.h @@ -0,0 +1,78 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +int registerMappedFloat(void *, void **, int, float); +int writeMultiVecDeviceFloat(void* deviceMultiVec, float* hostMultiVec); +int writeMultiVecDeviceFloatR2(void* deviceMultiVec, float* hostMultiVec, int ld); +int readMultiVecDeviceFloat(void* deviceMultiVec, float* hostMultiVec); +int readMultiVecDeviceFloatR2(void* deviceMultiVec, float* hostMultiVec, int ld); + +int setscalMultiVecDeviceFloat(float val, int first, int last, + int indexBase, void* devVecX); + +int geinsMultiVecDeviceFloat(int n, void* devVecIrl, void* devVecVal, + int dupl, int indexBase, void* devVecX); + +int igathMultiVecDeviceFloatVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase); +int igathMultiVecDeviceFloat(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, void* host_values, + int indexBase); +int iscatMultiVecDeviceFloatVecIdx(void* deviceVec, int vectorId, int n, int first, + void *deviceIdx, int hfirst, void* host_values, + int indexBase, float beta); +int iscatMultiVecDeviceFloat(void* deviceVec, int vectorId, int n, int first, void *indexes, + int hfirst, void* host_values, int indexBase, float beta); + +int scalMultiVecDeviceFloat(float alpha, void* devMultiVecA); +int nrm2MultiVecDeviceFloat(float* y_res, int n, void* devVecA); +int amaxMultiVecDeviceFloat(float* y_res, int n, void* devVecA); +int asumMultiVecDeviceFloat(float* y_res, int n, void* devVecA); +int dotMultiVecDeviceFloat(float* y_res, int n, void* devVecA, void* devVecB); + +int axpbyMultiVecDeviceFloat(int n, float alpha, void* devVecX, float beta, void* devVecY); +int axyMultiVecDeviceFloat(int n, float alpha, void *deviceVecA, void *deviceVecB); +int axybzMultiVecDeviceFloat(int n, float alpha, void *deviceVecA, + void *deviceVecB, float beta, void *deviceVecZ); +int absMultiVecDeviceFloat(int n, float alpha, void *deviceVecA); +int absMultiVecDeviceFloat2(int n, float alpha, void *deviceVecA, void *deviceVecB); + + +#endif diff --git a/gpu/vectordev.c b/gpu/vectordev.c new file mode 100644 index 000000000..2b22a8a62 --- /dev/null +++ b/gpu/vectordev.c @@ -0,0 +1,198 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +#include "cuComplex.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +//new +MultiVectorDeviceParams getMultiVectorDeviceParams(unsigned int count, unsigned int size, + unsigned int elementType) +{ + struct MultiVectorDeviceParams params; + + if (count == 1) + params.pitch = size; + else + if (elementType == SPGPU_TYPE_INT) + { + //fprintf(stderr,"Getting parms for a DOUBLE vector\n"); + params.pitch = (((size*sizeof(int) + 255)/256)*256)/sizeof(int); + } + else if (elementType == SPGPU_TYPE_DOUBLE) + { + //fprintf(stderr,"Getting parms for a DOUBLE vector\n"); + params.pitch = (((size*sizeof(double) + 255)/256)*256)/sizeof(double); + } + else if (elementType == SPGPU_TYPE_FLOAT) + { + params.pitch = (((size*sizeof(float) + 255)/256)*256)/sizeof(float); + } + else if (elementType == SPGPU_TYPE_COMPLEX_FLOAT) + { + params.pitch = (((size*sizeof(cuFloatComplex) + 255)/256)*256)/sizeof(cuFloatComplex); + } + else if (elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + { + params.pitch = (((size*sizeof(cuDoubleComplex) + 255)/256)*256)/sizeof(cuDoubleComplex); + } + else + params.pitch = 0; + + params.elementType = elementType; + + params.count = count; + params.size = size; + + return params; + +} +//new +int allocMultiVecDevice(void ** remoteMultiVec, struct MultiVectorDeviceParams *params) +{ + if (params->pitch == 0) + return SPGPU_UNSUPPORTED; // Unsupported params + + struct MultiVectDevice *tmp = (struct MultiVectDevice *)malloc(sizeof(struct MultiVectDevice)); + *remoteMultiVec = (void *)tmp; + tmp->size_ = params->size; + tmp->count_ = params->count; + + if (params->elementType == SPGPU_TYPE_INT) + { + if (params->count == 1) + tmp->pitch_ = params->size; + else + tmp->pitch_ = (((params->size*sizeof(int) + 255)/256)*256)/sizeof(int); + //fprintf(stderr,"Allocating an INT vector %ld\n",tmp->pitch_*tmp->count_*sizeof(double)); + + return allocRemoteBuffer((void **)&(tmp->v_), tmp->pitch_*params->count*sizeof(int)); + } + else if (params->elementType == SPGPU_TYPE_FLOAT) + { + if (params->count == 1) + tmp->pitch_ = params->size; + else + tmp->pitch_ = (((params->size*sizeof(float) + 255)/256)*256)/sizeof(float); + + return allocRemoteBuffer((void **)&(tmp->v_), tmp->pitch_*params->count*sizeof(float)); + } + else if (params->elementType == SPGPU_TYPE_DOUBLE) + { + + if (params->count == 1) + tmp->pitch_ = params->size; + else + tmp->pitch_ = (int)(((params->size*sizeof(double) + 255)/256)*256)/sizeof(double); + //fprintf(stderr,"Allocating a DOUBLE vector %ld\n",tmp->pitch_*tmp->count_*sizeof(double)); + + return allocRemoteBuffer((void **)&(tmp->v_), tmp->pitch_*tmp->count_*sizeof(double)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_FLOAT) + { + if (params->count == 1) + tmp->pitch_ = params->size; + else + tmp->pitch_ = (int)(((params->size*sizeof(cuFloatComplex) + 255)/256)*256)/sizeof(cuFloatComplex); + return allocRemoteBuffer((void **)&(tmp->v_), tmp->pitch_*tmp->count_*sizeof(cuFloatComplex)); + } + else if (params->elementType == SPGPU_TYPE_COMPLEX_DOUBLE) + { + if (params->count == 1) + tmp->pitch_ = params->size; + else + tmp->pitch_ = (int)(((params->size*sizeof(cuDoubleComplex) + 255)/256)*256)/sizeof(cuDoubleComplex); + return allocRemoteBuffer((void **)&(tmp->v_), tmp->pitch_*tmp->count_*sizeof(cuDoubleComplex)); + } + else + return SPGPU_UNSUPPORTED; // Unsupported params + return SPGPU_SUCCESS; // Success +} + + +int unregisterMapped(void *buff) +{ + return unregisterMappedMemory(buff); +} + +void freeMultiVecDevice(void* deviceVec) +{ + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + // fprintf(stderr,"freeMultiVecDevice\n"); + if (devVec != NULL) { + //fprintf(stderr,"Before freeMultiVecDevice% ld\n",devVec->pitch_*devVec->count_*sizeof(double)); + freeRemoteBuffer(devVec->v_); + free(deviceVec); + } +} + +int FallocMultiVecDevice(void** deviceMultiVec, unsigned int count, + unsigned int size, unsigned int elementType) +{ int i; + struct MultiVectorDeviceParams p; + + p = getMultiVectorDeviceParams(count, size, elementType); + i = allocMultiVecDevice(deviceMultiVec, &p); + //cudaSync(); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d, %d %d \n","FallocMultiVecDevice",i, count, size); + } + return(i); +} + +int getMultiVecDeviceSize(void* deviceVec) +{ int i; + struct MultiVectDevice *dev = (struct MultiVectDevice *) deviceVec; + i = dev->size_; + return(i); +} + +int getMultiVecDeviceCount(void* deviceVec) +{ int i; + struct MultiVectDevice *dev = (struct MultiVectDevice *) deviceVec; + i = dev->count_; + return(i); +} + +int getMultiVecDevicePitch(void* deviceVec) +{ int i; + struct MultiVectDevice *dev = (struct MultiVectDevice *) deviceVec; + i = dev->pitch_; + return(i); +} + +#endif + diff --git a/gpu/vectordev.h b/gpu/vectordev.h new file mode 100644 index 000000000..9739c01b0 --- /dev/null +++ b/gpu/vectordev.h @@ -0,0 +1,90 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include "cuda_runtime.h" +//#include "common.h" +#include "cintrf.h" +#include + +struct MultiVectDevice +{ + // number of vectors + int count_; + + //number of elements for a single vector + int size_; + + //pithc in number of elements + int pitch_; + + // Vectors in device memory (single allocation) + void *v_; +}; + +typedef struct MultiVectorDeviceParams +{ + // number on vectors + unsigned int count; //1 for a simple vector + + // The resulting allocation will be pitch*s*(size of the elementType) + unsigned int elementType; + + // Pitch (in number of elements) + unsigned int pitch; + + // Size of a single vector (in number of elements). + unsigned int size; +} MultiVectorDeviceParams; + + +#define INS_OVERWRITE 0 +#define INS_ADD 1 + + +int unregisterMapped(void *); + +MultiVectorDeviceParams getMultiVectorDeviceParams(unsigned int count, + unsigned int size, + unsigned int elementType); + +int FallocMultiVecDevice(void** deviceMultiVec, unsigned count, + unsigned int size, unsigned int elementType); +void freeMultiVecDevice(void* deviceVec); +int allocMultiVecDevice(void ** remoteMultiVec, struct MultiVectorDeviceParams *params); +int getMultiVecDeviceSize(void* deviceVec); +int getMultiVecDeviceCount(void* deviceVec); +int getMultiVecDevicePitch(void* deviceVec); + +#endif diff --git a/gpu/z_cusparse_mod.F90 b/gpu/z_cusparse_mod.F90 new file mode 100644 index 000000000..020f1de58 --- /dev/null +++ b/gpu/z_cusparse_mod.F90 @@ -0,0 +1,305 @@ +! Parallel Sparse BLAS GPU plugin +! (C) Copyright 2013 +! +! Salvatore Filippone +! Alessandro Fanfarillo +! +! 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. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific 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 PSBLAS GROUP OR ITS 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 z_cusparse_mod + use base_cusparse_mod + + type, bind(c) :: z_Cmat + type(c_ptr) :: Mat = c_null_ptr + end type z_Cmat + +#if CUDA_SHORT_VERSION <= 10 + type, bind(c) :: z_Hmat + type(c_ptr) :: Mat = c_null_ptr + end type z_Hmat +#endif + + +#if defined(HAVE_CUDA) && defined(HAVE_SPGPU) + + interface CSRGDeviceFree + function z_CSRGDeviceFree(Mat) & + & bind(c,name="z_CSRGDeviceFree") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int) :: res + end function z_CSRGDeviceFree + end interface + + interface CSRGDeviceSetMatType + function z_CSRGDeviceSetMatType(Mat,type) & + & bind(c,name="z_CSRGDeviceSetMatType") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_CSRGDeviceSetMatType + end interface + + interface CSRGDeviceSetMatFillMode + function z_CSRGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="z_CSRGDeviceSetMatFillMode") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_CSRGDeviceSetMatFillMode + end interface + + interface CSRGDeviceSetMatDiagType + function z_CSRGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="z_CSRGDeviceSetMatDiagType") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_CSRGDeviceSetMatDiagType + end interface + + interface CSRGDeviceSetMatIndexBase + function z_CSRGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="z_CSRGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_CSRGDeviceSetMatIndexBase + end interface + + interface CSRGDeviceCsrsmAnalysis + function z_CSRGDeviceCsrsmAnalysis(Mat) & + & bind(c,name="z_CSRGDeviceCsrsmAnalysis") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int) :: res + end function z_CSRGDeviceCsrsmAnalysis + end interface + + interface CSRGDeviceAlloc + function z_CSRGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="z_CSRGDeviceAlloc") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function z_CSRGDeviceAlloc + end interface + + interface CSRGDeviceGetParms + function z_CSRGDeviceGetParms(Mat,nr,nc,nz) & + & bind(c,name="z_CSRGDeviceGetParms") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int) :: nr, nc, nz + integer(c_int) :: res + end function z_CSRGDeviceGetParms + end interface + + interface spsvCSRGDevice + function z_spsvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="z_spsvCSRGDevice") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_double_complex), value :: alpha,beta + integer(c_int) :: res + end function z_spsvCSRGDevice + end interface + + interface spmvCSRGDevice + function z_spmvCSRGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="z_spmvCSRGDevice") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_double_complex), value :: alpha,beta + integer(c_int) :: res + end function z_spmvCSRGDevice + end interface + + interface CSRGHost2Device + function z_CSRGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="z_CSRGHost2Device") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_double_complex) :: val(*) + integer(c_int) :: res + end function z_CSRGHost2Device + end interface + + interface CSRGDevice2Host + function z_CSRGDevice2Host(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="z_CSRGDevice2Host") result(res) + use iso_c_binding + import z_Cmat + type(z_Cmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_double_complex) :: val(*) + integer(c_int) :: res + end function z_CSRGDevice2Host + end interface + +#if CUDA_SHORT_VERSION <= 10 + interface HYBGDeviceAlloc + function z_HYBGDeviceAlloc(Mat,nr,nc,nz) & + & bind(c,name="z_HYBGDeviceAlloc") result(res) + use iso_c_binding + import z_hmat + type(z_Hmat) :: Mat + integer(c_int), value :: nr, nc, nz + integer(c_int) :: res + end function z_HYBGDeviceAlloc + end interface + + interface HYBGDeviceFree + function z_HYBGDeviceFree(Mat) & + & bind(c,name="z_HYBGDeviceFree") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int) :: res + end function z_HYBGDeviceFree + end interface + + interface HYBGDeviceSetMatType + function z_HYBGDeviceSetMatType(Mat,type) & + & bind(c,name="z_HYBGDeviceSetMatType") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_HYBGDeviceSetMatType + end interface + + interface HYBGDeviceSetMatFillMode + function z_HYBGDeviceSetMatFillMode(Mat,type) & + & bind(c,name="z_HYBGDeviceSetMatFillMode") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_HYBGDeviceSetMatFillMode + end interface + + interface HYBGDeviceSetMatDiagType + function z_HYBGDeviceSetMatDiagType(Mat,type) & + & bind(c,name="z_HYBGDeviceSetMatDiagType") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_HYBGDeviceSetMatDiagType + end interface + + interface HYBGDeviceSetMatIndexBase + function z_HYBGDeviceSetMatIndexBase(Mat,type) & + & bind(c,name="z_HYBGDeviceSetMatIndexBase") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int),value :: type + integer(c_int) :: res + end function z_HYBGDeviceSetMatIndexBase + end interface + + interface HYBGDeviceHybsmAnalysis + function z_HYBGDeviceHybsmAnalysis(Mat) & + & bind(c,name="z_HYBGDeviceHybsmAnalysis") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int) :: res + end function z_HYBGDeviceHybsmAnalysis + end interface + + interface spsvHYBGDevice + function z_spsvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="z_spsvHYBGDevice") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_double_complex), value :: alpha,beta + integer(c_int) :: res + end function z_spsvHYBGDevice + end interface + + interface spmvHYBGDevice + function z_spmvHYBGDevice(Mat,alpha,x,beta,y) & + & bind(c,name="z_spmvHYBGDevice") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + type(c_ptr), value :: x + type(c_ptr), value :: y + complex(c_double_complex), value :: alpha,beta + integer(c_int) :: res + end function z_spmvHYBGDevice + end interface + + interface HYBGHost2Device + function z_HYBGHost2Device(Mat,m,n,nz,irp,ja,val) & + & bind(c,name="z_HYBGHost2Device") result(res) + use iso_c_binding + import z_Hmat + type(z_Hmat) :: Mat + integer(c_int), value :: m,n,nz + integer(c_int) :: irp(*), ja(*) + complex(c_double_complex) :: val(*) + integer(c_int) :: res + end function z_HYBGHost2Device + end interface +#endif + +#endif + +end module z_cusparse_mod diff --git a/gpu/zcusparse.c b/gpu/zcusparse.c new file mode 100644 index 000000000..3991359ae --- /dev/null +++ b/gpu/zcusparse.c @@ -0,0 +1,94 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 + +#ifdef HAVE_SPGPU +#include +#include +#include "cintrf.h" +#include "fcusparse.h" + +/* Double precision complex */ +#define TYPE double complex +#define CUSPARSE_BASE_TYPE CUDA_C_64F +#define T_CSRGDeviceMat z_CSRGDeviceMat +#define T_Cmat z_Cmat +#define T_spmvCSRGDevice z_spmvCSRGDevice +#define T_spsvCSRGDevice z_spsvCSRGDevice +#define T_CSRGDeviceAlloc z_CSRGDeviceAlloc +#define T_CSRGDeviceFree z_CSRGDeviceFree +#define T_CSRGHost2Device z_CSRGHost2Device +#define T_CSRGDevice2Host z_CSRGDevice2Host +#define T_CSRGDeviceSetMatFillMode z_CSRGDeviceSetMatFillMode +#define T_CSRGDeviceSetMatDiagType z_CSRGDeviceSetMatDiagType +#define T_CSRGDeviceGetParms z_CSRGDeviceGetParms + +#if CUDA_SHORT_VERSION <= 10 +#define T_CSRGDeviceSetMatType z_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase z_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsmAnalysis z_CSRGDeviceCsrsmAnalysis +#define cusparseTcsrmv cusparseZcsrmv +#define cusparseTcsrsv_solve cusparseZcsrsv_solve +#define cusparseTcsrsv_analysis cusparseZcsrsv_analysis +#define T_HYBGDeviceMat z_HYBGDeviceMat +#define T_Hmat z_Hmat +#define T_HYBGDeviceFree z_HYBGDeviceFree +#define T_spmvHYBGDevice z_spmvHYBGDevice +#define T_HYBGDeviceAlloc z_HYBGDeviceAlloc +#define T_HYBGDeviceSetMatDiagType z_HYBGDeviceSetMatDiagType +#define T_HYBGDeviceSetMatIndexBase z_HYBGDeviceSetMatIndexBase +#define T_HYBGDeviceSetMatType z_HYBGDeviceSetMatType +#define T_HYBGDeviceSetMatFillMode z_HYBGDeviceSetMatFillMode +#define T_HYBGDeviceHybsmAnalysis z_HYBGDeviceHybsmAnalysis +#define T_spsvHYBGDevice z_spsvHYBGDevice +#define T_HYBGHost2Device z_HYBGHost2Device +#define cusparseThybmv cusparseZhybmv +#define cusparseThybsv_solve cusparseZhybsv_solve +#define cusparseThybsv_analysis cusparseZhybsv_analysis +#define cusparseTcsr2hyb cusparseZcsr2hyb + +#elif CUDA_VERSION < 11030 + +#define T_CSRGDeviceSetMatType z_CSRGDeviceSetMatType +#define T_CSRGDeviceSetMatIndexBase z_CSRGDeviceSetMatIndexBase +#define T_CSRGDeviceCsrsv2Analysis z_CSRGDeviceCsrsv2Analysis +#define cusparseTcsrsv2_bufferSize cusparseZcsrsv2_bufferSize +#define cusparseTcsrsv2_analysis cusparseZcsrsv2_analysis +#define cusparseTcsrsv2_solve cusparseZcsrsv2_solve +#endif + +#include "fcusparse_fct.h" + + +#endif diff --git a/gpu/zvectordev.c b/gpu/zvectordev.c new file mode 100644 index 000000000..c245719f8 --- /dev/null +++ b/gpu/zvectordev.c @@ -0,0 +1,321 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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 +#if defined(HAVE_SPGPU) +//#include "utils.h" +//#include "common.h" +#include "zvectordev.h" + + +int registerMappedDoubleComplex(void *buff, void **d_p, int n, cuDoubleComplex dummy) +{ + return registerMappedMemory(buff,d_p,n*sizeof(cuDoubleComplex)); +} + +int writeMultiVecDeviceDoubleComplex(void* deviceVec, cuDoubleComplex* hostVec) +{ int i; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + // Ex updateFromHost vector function + i = writeRemoteBuffer((void*) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(cuDoubleComplex)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","FallocMultiVecDevice",i); + } + return(i); +} + +int writeMultiVecDeviceDoubleComplexR2(void* deviceVec, cuDoubleComplex* hostVec, int ld) +{ int i; + i = writeMultiVecDeviceDoubleComplex(deviceVec, (void *) hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","writeMultiVecDeviceDoubleComplexR2",i); + } + return(i); +} + +int readMultiVecDeviceDoubleComplex(void* deviceVec, cuDoubleComplex* hostVec) +{ int i,j; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + i = readRemoteBuffer((void *) hostVec, (void *)devVec->v_, + devVec->pitch_*devVec->count_*sizeof(cuDoubleComplex)); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceDoubleComplex",i); + } + return(i); +} + +int readMultiVecDeviceDoubleComplexR2(void* deviceVec, cuDoubleComplex* hostVec, int ld) +{ int i; + i = readMultiVecDeviceDoubleComplex(deviceVec, hostVec); + if (i != 0) { + fprintf(stderr,"From routine : %s : %d \n","readMultiVecDeviceDoubleComplexR2",i); + } + return(i); +} + +int setscalMultiVecDeviceDoubleComplex(cuDoubleComplex val, int first, int last, + int indexBase, void* devMultiVecX) +{ int i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuZsetscal(handle, first, last, indexBase, val, (cuDoubleComplex *) devVecX->v_); + + return(i); +} + +int geinsMultiVecDeviceDoubleComplex(int n, void* devMultiVecIrl, void* devMultiVecVal, + int dupl, int indexBase, void* devMultiVecX) +{ int j=0, i=0,nmin=0,nmax=0; + int pitch = 0; + cuDoubleComplex beta; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecIrl = (struct MultiVectDevice *) devMultiVecIrl; + struct MultiVectDevice *devVecVal = (struct MultiVectDevice *) devMultiVecVal; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecIrl->pitch_; + if ((n > devVecIrl->size_) || (n>devVecVal->size_ )) + return SPGPU_UNSUPPORTED; + + //fprintf(stderr,"geins: %d %d %p %p %p\n",dupl,n,devVecIrl->v_,devVecVal->v_,devVecX->v_); + if (dupl == INS_OVERWRITE) + beta = make_cuDoubleComplex(0.0, 0.0); + else if (dupl == INS_ADD) + beta = make_cuDoubleComplex(1.0, 0.0); + else + beta = make_cuDoubleComplex(0.0, 0.0); + + spgpuZscat(handle, (cuDoubleComplex *) devVecX->v_, n, (cuDoubleComplex*)devVecVal->v_, + (int*)devVecIrl->v_, indexBase, beta); + + return(i); +} + + +int igathMultiVecDeviceDoubleComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + + i= igathMultiVecDeviceDoubleComplex(deviceVec, vectorId, n, + first, (void*) devIdx->v_, + hfirst, host_values, indexBase); + return(i); +} + +int igathMultiVecDeviceDoubleComplex(void* deviceVec, int vectorId, int n, + int first, void* indexes, int hfirst, + void* host_values, int indexBase) +{ + int i, *idx =(int *) indexes;; + cuDoubleComplex *hv = (cuDoubleComplex *) host_values;; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + i=0; + hv = &(hv[hfirst-indexBase]); + idx = &(idx[first-indexBase]); + spgpuZgath(handle,hv, n, idx,indexBase, + (cuDoubleComplex *) devVec->v_+vectorId*devVec->pitch_); + return(i); +} + +int iscatMultiVecDeviceDoubleComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void *deviceIdx, + int hfirst, void* host_values, + int indexBase, cuDoubleComplex beta) +{ + int i, *idx; + struct MultiVectDevice *devIdx = (struct MultiVectDevice *) deviceIdx; + i= iscatMultiVecDeviceDoubleComplex(deviceVec, vectorId, n, first, + (void*) devIdx->v_, hfirst,host_values, indexBase, beta); + return(i); +} + +int iscatMultiVecDeviceDoubleComplex(void* deviceVec, int vectorId, int n, + int first, void *indexes, + int hfirst, void* host_values, + int indexBase, cuDoubleComplex beta) +{ int i=0; + cuDoubleComplex *hv = (cuDoubleComplex *) host_values; + int *idx=(int *) indexes; + struct MultiVectDevice *devVec = (struct MultiVectDevice *) deviceVec; + spgpuHandle_t handle=psb_gpuGetHandle(); + + idx = &(idx[first-indexBase]); + hv = &(hv[hfirst-indexBase]); + spgpuZscat(handle, (cuDoubleComplex *) devVec->v_, n, hv, idx, indexBase, beta); + return SPGPU_SUCCESS; + +} + + +int nrm2MultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuZmnrm2(handle, y_res, n,(cuDoubleComplex *)devVecA->v_, devVecA->count_, devVecA->pitch_); + return(i); +} + +int amaxMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuZmamax(handle, y_res, n,(cuDoubleComplex *)devVecA->v_, + devVecA->count_, devVecA->pitch_); + return(i); +} + +int asumMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + + spgpuZmasum(handle, y_res, n,(cuDoubleComplex *)devVecA->v_, + devVecA->count_, devVecA->pitch_); + + return(i); +} + +int scalMultiVecDeviceDoubleComplex(cuDoubleComplex alpha, void* devMultiVecA) +{ int i=0; + spgpuHandle_t handle=psb_gpuGetHandle(); + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + // Note: inner kernel can handle aliased input/output + spgpuZscal(handle, (cuDoubleComplex *)devVecA->v_, devVecA->pitch_, + alpha, (cuDoubleComplex *)devVecA->v_); + return(i); +} + +int dotMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devMultiVecA, void* devMultiVecB) +{int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) devMultiVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) devMultiVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + + spgpuZmdot(handle, y_res, n, (cuDoubleComplex*)devVecA->v_, + (cuDoubleComplex*)devVecB->v_,devVecA->count_,devVecB->pitch_); + return(i); +} + +int axpbyMultiVecDeviceDoubleComplex(int n,cuDoubleComplex alpha, void* devMultiVecX, + cuDoubleComplex beta, void* devMultiVecY) +{ int j=0, i=0; + int pitch = 0; + struct MultiVectDevice *devVecX = (struct MultiVectDevice *) devMultiVecX; + struct MultiVectDevice *devVecY = (struct MultiVectDevice *) devMultiVecY; + spgpuHandle_t handle=psb_gpuGetHandle(); + pitch = devVecY->pitch_; + if ((n > devVecY->size_) || (n>devVecX->size_ )) + return SPGPU_UNSUPPORTED; + + for(j=0;jcount_;j++) + spgpuZaxpby(handle,(cuDoubleComplex*)devVecY->v_+pitch*j, n, beta, + (cuDoubleComplex*)devVecY->v_+pitch*j, alpha, + (cuDoubleComplex*) devVecX->v_+pitch*j); + return(i); +} + +int axyMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, + void *deviceVecA, void *deviceVecB) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + spgpuHandle_t handle=psb_gpuGetHandle(); + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuZmaxy(handle, (cuDoubleComplex*)devVecB->v_, n, alpha, + (cuDoubleComplex*)devVecA->v_, + (cuDoubleComplex*)devVecB->v_, devVecA->count_, devVecA->pitch_); + + return(i); +} + +int axybzMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, void *deviceVecA, + void *deviceVecB, cuDoubleComplex beta, void *deviceVecZ) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + struct MultiVectDevice *devVecZ = (struct MultiVectDevice *) deviceVecZ; + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ ) || (n>devVecZ->size_ )) + return SPGPU_UNSUPPORTED; + spgpuZmaxypbz(handle, (cuDoubleComplex*)devVecZ->v_, n, beta, + (cuDoubleComplex*)devVecZ->v_, + alpha, (cuDoubleComplex*) devVecA->v_, (cuDoubleComplex*) devVecB->v_, + devVecB->count_, devVecB->pitch_); + return(i); +} + + +int absMultiVecDeviceDoubleComplex2(int n, cuDoubleComplex alpha, void *deviceVecA, + void *deviceVecB) +{ int i=0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + struct MultiVectDevice *devVecB = (struct MultiVectDevice *) deviceVecB; + + spgpuHandle_t handle=psb_gpuGetHandle(); + + if ((n > devVecA->size_) || (n>devVecB->size_ )) + return SPGPU_UNSUPPORTED; + + spgpuZabs(handle, (cuDoubleComplex*)devVecB->v_, n, + alpha, (cuDoubleComplex*)devVecA->v_); + + return(i); +} + +int absMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, void *deviceVecA) +{ int i = 0; + struct MultiVectDevice *devVecA = (struct MultiVectDevice *) deviceVecA; + spgpuHandle_t handle=psb_gpuGetHandle(); + if (n > devVecA->size_) + return SPGPU_UNSUPPORTED; + + spgpuZabs(handle, (cuDoubleComplex*)devVecA->v_, n, + alpha, (cuDoubleComplex*)devVecA->v_); + + return(i); +} + +#endif + diff --git a/gpu/zvectordev.h b/gpu/zvectordev.h new file mode 100644 index 000000000..ca3c966e6 --- /dev/null +++ b/gpu/zvectordev.h @@ -0,0 +1,91 @@ + /* Parallel Sparse BLAS GPU plugin */ + /* (C) Copyright 2013 */ + + /* Salvatore Filippone */ + /* Alessandro Fanfarillo */ + + /* 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. The name of the PSBLAS group or the names of its contributors may */ + /* not be used to endorse or promote products derived from this */ + /* software without specific 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 PSBLAS GROUP OR ITS 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. */ + + + +#pragma once +#if defined(HAVE_SPGPU) +//#include "utils.h" +#include +#include "cuComplex.h" +#include "vectordev.h" +#include "cuda_runtime.h" +#include "core.h" + +int registerMappedDoubleComplex(void *, void **, int, cuDoubleComplex); +int writeMultiVecDeviceDoubleComplex(void* deviceMultiVec, cuDoubleComplex* hostMultiVec); +int writeMultiVecDeviceDoubleComplexR2(void* deviceMultiVec, + cuDoubleComplex* hostMultiVec, int ld); +int readMultiVecDeviceDoubleComplex(void* deviceMultiVec, cuDoubleComplex* hostMultiVec); +int readMultiVecDeviceDoubleComplexR2(void* deviceMultiVec, + cuDoubleComplex* hostMultiVec, int ld); +int setscalMultiVecDeviceDoubleComplex(cuDoubleComplex val, int first, int last, + int indexBase, void* devVecX); + +int geinsMultiVecDeviceDoubleComplex(int n, void* devVecIrl, void* devVecVal, + int dupl, int indexBase, void* devVecX); + +int igathMultiVecDeviceDoubleComplexVecIdx(void* deviceVec, int vectorId, int n, + int first, void* deviceIdx, int hfirst, + void* host_values, int indexBase); +int igathMultiVecDeviceDoubleComplex(void* deviceVec, int vectorId, int n, + int first, void* indexes, + int hfirst, void* host_values, + int indexBase); +int iscatMultiVecDeviceDoubleComplexVecIdx(void* deviceVec, int vectorId, + int n, int first, + void *deviceIdx, int hfirst, + void* host_values, + int indexBase, cuDoubleComplex beta); +int iscatMultiVecDeviceDoubleComplex(void* deviceVec, int vectorId, int n, + int first, void *indexes, + int hfirst, void* host_values, + int indexBase, cuDoubleComplex beta); + +int scalMultiVecDeviceDoubleComplex(cuDoubleComplex alpha, void* devMultiVecA); +int nrm2MultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devVecA); +int amaxMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devVecA); +int asumMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, void* devVecA); +int dotMultiVecDeviceDoubleComplex(cuDoubleComplex* y_res, int n, + void* devVecA, void* devVecB); + +int axpbyMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, void* devVecX, + cuDoubleComplex beta, void* devVecY); +int axyMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, + void *deviceVecA, void *deviceVecB); +int axybzMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, void *deviceVecA, + void *deviceVecB, cuDoubleComplex beta, + void *deviceVecZ); +int absMultiVecDeviceDoubleComplex(int n, cuDoubleComplex alpha, void *deviceVecA); +int absMultiVecDeviceDoubleComplex2(int n, cuDoubleComplex alpha, + void *deviceVecA, void *deviceVecB); + + +#endif