diff --git a/config/configure.ac b/config/configure.ac index 37a8129a2e..4ce46a4491 100644 --- a/config/configure.ac +++ b/config/configure.ac @@ -233,6 +233,7 @@ m4_include([config/m4/iotk.m4]) m4_include([config/m4/etsf_io.m4]) m4_include([config/m4/scalapack.m4]) m4_include([config/m4/petsc_slepc.m4]) +m4_include([config/m4/magma.m4]) # AC_LANG_PUSH(Fortran) # ============================================================================ @@ -279,6 +280,9 @@ ACX_LIBXC # CUDA AC_HAVE_CUDA # ============================================================================ +# MAGMA +AC_MAGMA_SETUP +# ============================================================================ # Prepare the REPORT file variables ACX_REPORT() # ============================================================================ diff --git a/config/m4/acx_report.m4 b/config/m4/acx_report.m4 index c0f0e360f7..bbf780fb79 100644 --- a/config/m4/acx_report.m4 +++ b/config/m4/acx_report.m4 @@ -133,6 +133,14 @@ if test "$internal_libxc" = "yes" ; then if test "$compile_libxc" = "no" ; then LIBXC_check="I"; fi fi # +MAGMA_check="-" +if test "$internal_magma" = "yes" ; then + if test "$compile_magma" = "yes" ; then SLEPC_check="C"; fi + if test "$compile_magma" = "no" ; then SLEPC_check="I"; fi +elif test "$enable_magma" = "yes" ; then + MAGMA_check="E" +fi +# YDB_check="-"; if test "$enable_ydb" = "yes" ; then YDB_check="X"; fi YPY_check="-"; @@ -224,6 +232,7 @@ AC_SUBST(YDB_check) AC_SUBST(YPY_check) # AC_SUBST(LIBXC_check) +AC_SUBST(MAGMA_check) AC_SUBST(MPI_check) AC_SUBST(MPI_info) # diff --git a/config/m4/magma.m4 b/config/m4/magma.m4 new file mode 100644 index 0000000000..a95275e23b --- /dev/null +++ b/config/m4/magma.m4 @@ -0,0 +1,164 @@ +# +# Copyright (C) 2000-2022 the YAMBO team +# http://www.yambo-code.org +# +# Authors (see AUTHORS file for details): AM +# +# This file is distributed under the terms of the GNU +# General Public License. You can redistribute it and/or +# modify it under the terms of the GNU General Public +# License as published by the Free Software Foundation; +# either version 2, or (at your option) any later version. +# +# This program is distributed in the hope that it will +# be useful, but WITHOUT ANY WARRANTY; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public +# License along with this program; if not, write to the Free +# Software Foundation, Inc., 59 Temple Place - Suite 330,Boston, +# MA 02111-1307, USA or visit http://www.gnu.org/copyleft/gpl.txt. +# +AC_DEFUN([AC_MAGMA_SETUP],[ +# +AC_ARG_ENABLE(magma_linalg, AS_HELP_STRING([--enable-magma-linalg],[Enable suport for the diagonalization of BSE using MAGMA. Default is no])) +# +AC_ARG_WITH(magma_libs,AS_HELP_STRING([--with-magma-libs=],[Use Magma libraries ],[32])) +AC_ARG_WITH(magma_incs,AS_HELP_STRING([--with-magma-incs=],[Use Magma includes ],[32])) +AC_ARG_WITH(magma_path, AS_HELP_STRING([--with-magma-path=],[Path to the Magma install directory],[32]),[],[]) +AC_ARG_WITH(magma_libdir,AS_HELP_STRING([--with-magma-libdir=],[Path to the Magma lib directory],[32])) +AC_ARG_WITH(magma_includedir,AS_HELP_STRING([--with-magma-includedir=],[Path to the Magma include directory],[32])) + +# +def_magma="" +magma="no" +enable_magma="no" +internal_magma="no" +compile_magma="no" +# +if test x"$enable_magma_linalg" = "xyes"; then + enable_magma="yes"; +fi +# +# MAGMA global options +# +if test x"$with_magma_libs" = "xyes" ; then + enable_magma="yes" ; + with_magma_libs=""; +elif test x"$with_magma_libs" = "xno" ; then + enable_magma="no" ; + with_magma_libs=""; +fi +# +if test x"$with_magma_libdir" != "x" ; then enable_magma="yes" ; fi +if test x"$with_magma_path" != "x" ; then enable_magma="yes" ; fi +if test x"$with_magma_libs" != "x" ; then enable_magma="yes" ; fi +# +# Set MAGMA LIBS and FLAGS from INPUT +# +if test -d "$with_magma_path" || test -d "$with_magma_libdir" || test x"$with_magma_libs" != "x" ; then + # + # external magma + # + if test x"$with_magma_libs" != "x" ; then AC_MSG_CHECKING([for Magma using $with_magma_libs]) ; + elif test -d "$with_magma_libdir" ; then AC_MSG_CHECKING([for Magma in $with_magma_libdir]) ; + elif test -d "$with_magma_path" ; then AC_MSG_CHECKING([for Magma in $with_magma_path]) ; + fi + # + if test -d "$with_magma_path" ; then + try_magma_libdir="$with_magma_path/lib" ; + try_magma_incdir="$with_magma_path/include" ; + fi + # + if test -d "$with_magma_libdir" ; then try_magma_libdir="$with_magma_libdir" ; fi + if test -d "$with_magma_includedir" ; then try_magma_incdir="$with_magma_includedir" ; fi + # + try_MAGMA_INCS="$IFLAG$try_magma_incdir" ; + try_MAGMA_LIBS="-L$try_magma_libdir -lmagma" ; + # + if test x"$with_magma_libs" != "x" ; then try_MAGMA_LIBS="$with_magma_libs" ; fi + if test x"$with_magma_incs" != "x" ; then try_MAGMA_INCS="$with_magma_incs" ; fi + # + if test -z "$try_MAGMA_LIBS" ; then AC_MSG_ERROR([No libs specified]) ; fi + if test -z "$try_MAGMA_INCS" ; then AC_MSG_ERROR([No include-dir specified]) ; fi + # + AC_LANG([Fortran]) + # + save_fcflags="$FCFLAGS" ; + save_libs="$LIBS" ; + # + FCFLAGS="$try_MAGMA_INCS $save_fcflags"; + LIBS="$try_MAGMA_LIBS $save_libs"; + # + AC_COMPILE_IFELSE(AC_LANG_PROGRAM([], [ +use magma +implicit none +integer :: lda +!magma_devptr_t :: dA]), + [magma=yes], [magma=no]); + # + if test "x$magma" = "xyes"; then + AC_MSG_RESULT([yes]) ; + MAGMA_INCS="$try_MAGMA_INCS" ; + MAGMA_LIBS="$try_MAGMA_LIBS" ; + compile_magma="no"; + internal_magma="no"; + def_magma="-D_MAGMA" + else + AC_MSG_RESULT([no]) ; + # + fi + # + FCFLAGS="$save_fcflags" ; + LIBS="$save_libs" ; + # +fi +# +# TO BE FIXED: needs internal compilation support and paths have to be corrected with GPU_SUPPORT folder +if test "x$enable_magma" = "xyes" && test "x$magma" = "xno" ; then + # + # internal magma + # + AC_MSG_CHECKING([for internal Magma library]) + # + internal_magma="yes" + # + if test "x$lapack_shared" = "x1" ; then + #MAGMA_LIBS="${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.so" ; + MAGMA_LIBS="" ; + else + #MAGMA_LIBS="${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.a" ; + MAGMA_LIBS="" ; + fi + #MAGMA_INCS="${IFLAG}${extlibs_path}/${FCKIND}/${FC}/include" ; + MAGMA_INCS="" ; + # + magma=yes + def_magma="-D_MAGMA" + if test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.a" ; then + compile_magma="no" ; + AC_MSG_RESULT([already compiled]) ; + elif test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.so" ; then + compile_magma="no" ; + AC_MSG_RESULT([already compiled]) ; + else + #compile_magma="yes" ; + #AC_MSG_RESULT([to be compiled]) ; + AC_MSG_RESULT([Compatible external Magma not found/specified. Internal compilation not available yet.]) ; + compile_magma="no" + def_magma="" + enable_magma="no" + fi + # +fi +# +AC_SUBST(MAGMA_LIBS) +AC_SUBST(MAGMA_INCS) +AC_SUBST(def_magma) +AC_SUBST(enable_magma) +AC_SUBST(compile_magma) +AC_SUBST(internal_magma) +# +]) diff --git a/config/mk/global/defs.mk.in b/config/mk/global/defs.mk.in index a52547b2b6..c83c40d5ec 100644 --- a/config/mk/global/defs.mk.in +++ b/config/mk/global/defs.mk.in @@ -13,7 +13,8 @@ netcdf = @def_netcdf@ scalapack = @def_scalapack@ slepc = @def_slepc@ fft = @def_fft@ -xcpp = @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_memory_profile@ @def_uspp@ @def_cuda@ @def_yaml@ +magma = @def_magma@ +xcpp = @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_memory_profile@ @def_uspp@ @def_cuda@ @def_yaml@ @def_magma@ p2ycpp = @PW_CPP@ keep_objs = @enable_keep_objects@ do_blacs = @compile_blacs@ @@ -33,6 +34,7 @@ do_e2y = @compile_e2y@ do_libxc = @compile_libxc@ do_petsc = @compile_petsc@ do_slepc = @compile_slepc@ +do_magma = @compile_magma@ shell = @SHELL@ package_bugreport = @PACKAGE_BUGREPORT@ prefix = @prefix@ diff --git a/config/report.in b/config/report.in index 038899184a..98d9a02d60 100644 --- a/config/report.in +++ b/config/report.in @@ -70,8 +70,10 @@ # @FFT_INCS_R@ # [@PETSC_check@] PETSC : @PETSC_LIBS_R@ # @PETSC_INCS_R@ -# [@SLEPC_check@] SLEPC : @SLEPC_LIBS_R@ +# [@SLEPC_check@] SLEPC : @SLEPC_LIBS_R@ # @SLEPC_INCS_R@ +# [@MAGMA_check@] MAGMA : @MAGMA_LIBS@ +# @MAGMA_INCS@ # # > OTHERs # @@ -85,8 +87,8 @@ # FC kind = @FCKIND@ @FCVERSION@ # MPI kind= @MPIKIND@ # -# [ CPP ] @CPP@ @CPPFLAGS_yambo@ @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_uspp@ @def_cuda@ @def_yaml@ @PW_CPP@ -# [ FPP ] @FPP@ @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_uspp@ @def_cuda@ @def_yaml@ +# [ CPP ] @CPP@ @CPPFLAGS_yambo@ @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_uspp@ @def_cuda@ @def_yaml@ @PW_CPP@ @def_magma@ +# [ FPP ] @FPP@ @def_netcdf@ @def_mpi@ @def_fft@ @def_slepc@ @def_scalapack@ @def_compiler@ @def_dp@ @def_openmp@ @def_time_profile@ @def_uspp@ @def_cuda@ @def_yaml@ @def_magma@ # [ CC ] @CC@ @CFLAGS@ # [ FC ] @FC@ @FCFLAGS@ @OPENMPLIBS@ @CUDA_FLAGS@ # [ FCUF] @FCUFLAGS@ @CUDA_FLAGS@ diff --git a/config/setup.in b/config/setup.in index 4b7aea716d..aeff509076 100644 --- a/config/setup.in +++ b/config/setup.in @@ -90,6 +90,8 @@ lfutile = @FUTILE_LIBS@ ifutile = @FUTILE_INCS@ letsf = @ETSF_LIBS@ ietsf = @ETSF_INCS@ +lmagma = @MAGMA_LIBS@ +imagma = @MAGMA_INCS@ idriver = @DRIVER_INCS@ # # VPATH diff --git a/configure b/configure index cac64da731..15e9dcfdea 100755 --- a/configure +++ b/configure @@ -689,6 +689,7 @@ IOTK_INCS_R IOTK_LIBS_R MPI_info MPI_check +MAGMA_check LIBXC_check YPY_check YDB_check @@ -717,6 +718,12 @@ MEM_profile_check TIME_profile_check KEEP_OBJS_check DP_check +internal_magma +compile_magma +enable_magma +def_magma +MAGMA_INCS +MAGMA_LIBS CUDA_FLAGS def_cuda internal_libxc @@ -1040,6 +1047,12 @@ with_libxc_libdir with_libxc_includedir enable_cuda enable_nvtx +enable_magma_linalg +with_magma_libs +with_magma_incs +with_magma_path +with_magma_libdir +with_magma_includedir ' ac_precious_vars='build_alias host_alias @@ -1724,6 +1737,8 @@ Optional Features: --enable-etsf-io Activate the ETSF_IO support --enable-cuda= Enable CUDA support --enable-nvtx= Enable NVTX support + --enable-magma-linalg Enable suport for the diagonalization of BSE using + MAGMA. Default is no Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] @@ -1796,6 +1811,12 @@ Optional Packages: --with-libxc-libdir= Path to the libxc lib directory --with-libxc-includedir= Path to the libxc include directory + --with-magma-libs= Use Magma libraries + --with-magma-incs= Use Magma includes + --with-magma-path= Path to the Magma install directory + --with-magma-libdir= Path to the Magma lib directory + --with-magma-includedir= + Path to the Magma include directory Some influential environment variables: CC C compiler command @@ -10281,6 +10302,31 @@ url_ydb=https://github.com/yambo-code/ydb.git # +# +# Copyright (C) 2000-2022 the YAMBO team +# http://www.yambo-code.org +# +# Authors (see AUTHORS file for details): AM +# +# This file is distributed under the terms of the GNU +# General Public License. You can redistribute it and/or +# modify it under the terms of the GNU General Public +# License as published by the Free Software Foundation; +# either version 2, or (at your option) any later version. +# +# This program is distributed in the hope that it will +# be useful, but WITHOUT ANY WARRANTY; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public +# License along with this program; if not, write to the Free +# Software Foundation, Inc., 59 Temple Place - Suite 330,Boston, +# MA 02111-1307, USA or visit http://www.gnu.org/copyleft/gpl.txt. +# + + # ac_ext=${ac_fc_srcext-f} ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' @@ -15516,6 +15562,200 @@ fi # +# + +# ============================================================================ +# MAGMA + +# +# Check whether --enable-magma_linalg was given. +if test "${enable_magma_linalg+set}" = set; then : + enableval=$enable_magma_linalg; +fi + +# + +# Check whether --with-magma_libs was given. +if test "${with_magma_libs+set}" = set; then : + withval=$with_magma_libs; +fi + + +# Check whether --with-magma_incs was given. +if test "${with_magma_incs+set}" = set; then : + withval=$with_magma_incs; +fi + + +# Check whether --with-magma_path was given. +if test "${with_magma_path+set}" = set; then : + withval=$with_magma_path; +fi + + +# Check whether --with-magma_libdir was given. +if test "${with_magma_libdir+set}" = set; then : + withval=$with_magma_libdir; +fi + + +# Check whether --with-magma_includedir was given. +if test "${with_magma_includedir+set}" = set; then : + withval=$with_magma_includedir; +fi + + +# +def_magma="" +magma="no" +enable_magma="no" +internal_magma="no" +compile_magma="no" +# +if test x"$enable_magma_linalg" = "xyes"; then + enable_magma="yes"; +fi +# +# MAGMA global options +# +if test x"$with_magma_libs" = "xyes" ; then + enable_magma="yes" ; + with_magma_libs=""; +elif test x"$with_magma_libs" = "xno" ; then + enable_magma="no" ; + with_magma_libs=""; +fi +# +if test x"$with_magma_libdir" != "x" ; then enable_magma="yes" ; fi +if test x"$with_magma_path" != "x" ; then enable_magma="yes" ; fi +if test x"$with_magma_libs" != "x" ; then enable_magma="yes" ; fi +# +# Set MAGMA LIBS and FLAGS from INPUT +# +if test -d "$with_magma_path" || test -d "$with_magma_libdir" || test x"$with_magma_libs" != "x" ; then + # + # external magma + # + if test x"$with_magma_libs" != "x" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Magma using $with_magma_libs" >&5 +$as_echo_n "checking for Magma using $with_magma_libs... " >&6; } ; + elif test -d "$with_magma_libdir" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Magma in $with_magma_libdir" >&5 +$as_echo_n "checking for Magma in $with_magma_libdir... " >&6; } ; + elif test -d "$with_magma_path" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Magma in $with_magma_path" >&5 +$as_echo_n "checking for Magma in $with_magma_path... " >&6; } ; + fi + # + if test -d "$with_magma_path" ; then + try_magma_libdir="$with_magma_path/lib" ; + try_magma_incdir="$with_magma_path/include" ; + fi + # + if test -d "$with_magma_libdir" ; then try_magma_libdir="$with_magma_libdir" ; fi + if test -d "$with_magma_includedir" ; then try_magma_incdir="$with_magma_includedir" ; fi + # + try_MAGMA_INCS="$IFLAG$try_magma_incdir" ; + try_MAGMA_LIBS="-L$try_magma_libdir -lmagma" ; + # + if test x"$with_magma_libs" != "x" ; then try_MAGMA_LIBS="$with_magma_libs" ; fi + if test x"$with_magma_incs" != "x" ; then try_MAGMA_INCS="$with_magma_incs" ; fi + # + if test -z "$try_MAGMA_LIBS" ; then as_fn_error $? "No libs specified" "$LINENO" 5 ; fi + if test -z "$try_MAGMA_INCS" ; then as_fn_error $? "No include-dir specified" "$LINENO" 5 ; fi + # + ac_ext=${ac_fc_srcext-f} +ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' +ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_fc_compiler_gnu + + # + save_fcflags="$FCFLAGS" ; + save_libs="$LIBS" ; + # + FCFLAGS="$try_MAGMA_INCS $save_fcflags"; + LIBS="$try_MAGMA_LIBS $save_libs"; + # + cat > conftest.$ac_ext <<_ACEOF + program main + +use magma +implicit none +integer :: lda +!magma_devptr_t :: dA + end +_ACEOF +if ac_fn_fc_try_compile "$LINENO"; then : + magma=yes +else + magma=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext; + # + if test "x$magma" = "xyes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } ; + MAGMA_INCS="$try_MAGMA_INCS" ; + MAGMA_LIBS="$try_MAGMA_LIBS" ; + compile_magma="no"; + internal_magma="no"; + def_magma="-D_MAGMA" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } ; + # + fi + # + FCFLAGS="$save_fcflags" ; + LIBS="$save_libs" ; + # +fi +# +# TO BE FIXED: needs internal compilation support and paths have to be corrected with GPU_SUPPORT folder +if test "x$enable_magma" = "xyes" && test "x$magma" = "xno" ; then + # + # internal magma + # + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for internal Magma library" >&5 +$as_echo_n "checking for internal Magma library... " >&6; } + # + internal_magma="yes" + # + if test "x$lapack_shared" = "x1" ; then + #MAGMA_LIBS="${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.so" ; + MAGMA_LIBS="" ; + else + #MAGMA_LIBS="${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.a" ; + MAGMA_LIBS="" ; + fi + #MAGMA_INCS="${IFLAG}${extlibs_path}/${FCKIND}/${FC}/include" ; + MAGMA_INCS="" ; + # + magma=yes + def_magma="-D_MAGMA" + if test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.a" ; then + compile_magma="no" ; + { $as_echo "$as_me:${as_lineno-$LINENO}: result: already compiled" >&5 +$as_echo "already compiled" >&6; } ; + elif test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.so" ; then + compile_magma="no" ; + { $as_echo "$as_me:${as_lineno-$LINENO}: result: already compiled" >&5 +$as_echo "already compiled" >&6; } ; + else + #compile_magma="yes" ; + #AC_MSG_RESULT([to be compiled]) ; + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Compatible external Magma not found/specified. Internal compilation not available yet." >&5 +$as_echo "Compatible external Magma not found/specified. Internal compilation not available yet." >&6; } ; + compile_magma="no" + def_magma="" + enable_magma="no" + fi + # +fi +# + + + + + + # # ============================================================================ @@ -15647,6 +15887,14 @@ if test "$internal_libxc" = "yes" ; then if test "$compile_libxc" = "no" ; then LIBXC_check="I"; fi fi # +MAGMA_check="-" +if test "$internal_magma" = "yes" ; then + if test "$compile_magma" = "yes" ; then SLEPC_check="C"; fi + if test "$compile_magma" = "no" ; then SLEPC_check="I"; fi +elif test "$enable_magma" = "yes" ; then + MAGMA_check="E" +fi +# YDB_check="-"; if test "$enable_ydb" = "yes" ; then YDB_check="X"; fi YPY_check="-"; @@ -16158,6 +16406,7 @@ LAPACK_PETSC_INCS_R=$STRIPE # + # ============================================================================ # Compilation dir diff --git a/include/driver/version.h b/include/driver/version.h new file mode 100644 index 0000000000..6a7fb9fa46 --- /dev/null +++ b/include/driver/version.h @@ -0,0 +1,30 @@ +/* + Copyright (C) 2000-2022 the YAMBO team + http://www.yambo-code.org + + Authors (see AUTHORS file for details): AM + + This file is distributed under the terms of the GNU + General Public License. You can redistribute it and/or + modify it under the terms of the GNU General Public + License as published by the Free Software Foundation; + either version 2, or (at your option) any later version. + + This program is distributed in the hope that it will + be useful, but WITHOUT ANY WARRANTY; without even the + implied warranty of MERCHANTABILITY or FITNESS FOR A + PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public + License along with this program; if not, write to the Free + Software Foundation, Inc., 59 Temple Place - Suite 330,Boston, + MA 02111-1307, USA or visit http://www.gnu.org/copyleft/gpl.txt. +*/ + +#define YAMBO_VERSION 5 +#define YAMBO_SUBVERSION 1 +#define YAMBO_PATCHLEVEL 0 +#define YAMBO_REVISION 22124 +#define YAMBO_HASH "407f3a474" + diff --git a/sbin/compilation/libraries.sh b/sbin/compilation/libraries.sh index 4464ccdd9f..03a3aa4a72 100755 --- a/sbin/compilation/libraries.sh +++ b/sbin/compilation/libraries.sh @@ -17,7 +17,7 @@ do done # llocal="-lqe_pseudo -lmath77 -lslatec -llocal" -lPLA="\$(lscalapack) \$(lblacs) \$(llapack) \$(lblas)" +lPLA="\$(lscalapack) \$(lblacs) \$(lmagma) \$(llapack) \$(lblas)" lSL="\$(lslepc) \$(lpetsc)" lIO="\$(liotk) \$(letsf) \$(lpnetcdf) \$(lnetcdff) \$(lnetcdf) \$(lhdf5)" lextlibs="\$(llibxc) \$(lfft) \$(lfutile) \$(lyaml)" diff --git a/src/modules/.objects b/src/modules/.objects index 1ce4a1a980..45cdac2089 100644 --- a/src/modules/.objects +++ b/src/modules/.objects @@ -19,14 +19,18 @@ NL_objects = mod_fields.o mod_electric.o mod_nl_optics.o mod_NL_interfaces #if defined _ELPH ELPH_objects = mod_ELPH_intfcs.o mod_ELPH.o #endif +#if defined _MAGMA +MAGMA_objects = mod_magma2_common.o mod_magma2_sfortran.o mod_magma2_dfortran.o \ + mod_magma2_cfortran.o mod_magma2_zfortran.o mod_magma2.o +#endif #if defined _io_lib objs = mod_pars.o mod_stderr.o mod_parallel.o mod_parallel_interface.o \ mod_com_interfcs.o mod_descriptors.o mod_com.o mod_IO.o mod_IO_interfaces.o #else DEV_objects = mod_cusolverdn_y.o mod_cuda.o -objs = mod_pars.o mod_units.o mod_lexical_sort.o mod_stderr.o mod_memory.o mod_openmp.o mod_parallel.o mod_parallel_interface.o mod_matrix.o mod_SLK.o \ - mod_linear_algebra.o mod_wrapper.o mod_wrapper_omp.o mod_drivers.o mod_FFT.o\ - mod_LIVE_t.o mod_logo.o mod_cutoff_ws.o \ +objs = mod_pars.o mod_units.o mod_lexical_sort.o mod_stderr.o mod_memory.o mod_openmp.o mod_parallel.o mod_parallel_interface.o \ + mod_matrix.o mod_SLK.o $(MAGMA_objects) mod_linear_algebra.o mod_wrapper.o mod_wrapper_omp.o \ + mod_drivers.o mod_FFT.o mod_LIVE_t.o mod_logo.o mod_cutoff_ws.o \ mod_descriptors.o mod_com.o mod_com_interfcs.o mod_timing.o mod_R_lattice.o mod_electrons.o mod_wave_func.o mod_OUTPUT.o \ mod_xc_functionals.o mod_global_XC.o \ mod_matrix_operate.o mod_D_lattice.o mod_frequency.o \ @@ -35,6 +39,7 @@ objs = mod_pars.o mod_units.o mod_lexical_sort.o mod_stderr.o mod_memory.o mod_o mod_QP.o mod_MPA.o mod_collision_el.o \ mod_BS.o mod_BS_solvers.o mod_QP_CTL.o mod_TDDFT.o mod_ACFDT.o mod_MAGNONS.o mod_DICHROISM.o mod_PHOTOLUM.o \ mod_IO.o mod_IO_interfaces.o mod_COLL_interfaces.o $(ELPH_objects) mod_POL_FIT.o $(RT_objects_pre) \ - mod_hamiltonian.o $(COMMON_objects) $(SC_objects) $(RT_objects_post) $(RT_objects_iterative) $(MAGNETIC_objects) $(NL_objects) $(ELECTRIC_objects) \ + mod_hamiltonian.o $(COMMON_objects) $(SC_objects) $(RT_objects_post) $(RT_objects_iterative) $(MAGNETIC_objects) \ + $(NL_objects) $(ELECTRIC_objects) \ mod_debug.o mod_interfaces.o mod_interpolate_tools.o mod_interpolate.o SET_logicals.o SET_defaults.o $(DEV_objects) #endif diff --git a/src/modules/mod_linear_algebra.F b/src/modules/mod_linear_algebra.F index 1c29158cd0..f2db9b22ea 100644 --- a/src/modules/mod_linear_algebra.F +++ b/src/modules/mod_linear_algebra.F @@ -7,7 +7,15 @@ ! module linear_algebra ! - use pars, ONLY:SP,schlen + use iso_c_binding + use pars, ONLY: SP,schlen +#ifdef _MAGMA + use magma2, ONLY: magma_init,magma_queue_create, & +& magma_cgeev_m,magma_zgeev_m,MagmaVec +#endif +#ifdef _OPENMP + use omp_lib +#endif ! #include #include @@ -23,6 +31,11 @@ module linear_algebra integer, parameter :: MAT_MUL=9 integer, parameter :: min_cpu_block_size=50 ! + ! magma vars + ! + type(c_ptr) :: magma_queue !! magma_queue_t + logical :: magma_init_done = .false. + ! ! Common Work Space ! type LALGEBRA_WS @@ -109,6 +122,15 @@ subroutine LINEAR_ALGEBRA_error(calling_subr,message_) call error( trim( STRING_pack('LINEAR ALGEBRA driver [',trim(calling_subr),']',trim(message_)) )) end subroutine ! + subroutine magma_setup() +#ifdef _MAGMA + call magma_init() + call magma_queue_create( 0, magma_queue ) + magma_init_done=.true. +#endif + return + end subroutine + ! !============================ ! SINGLE VALUE DECOMPOSITION !============================ @@ -176,9 +198,9 @@ subroutine heev(msize,M,E_real,work,lwork,rwk,ifail) complex(SP),intent(inout) :: M(msize,*) ! #if defined _DOUBLE - call ZHEEV('V','U',msize,M,msize,E_real,work,lwork,rwk,ifail) + call ZHEEV('V','U',msize,M,msize,E_real,work,lwork,rwk,ifail) #else - call CHEEV('V','U',msize,M,msize,E_real,work,lwork,rwk,ifail) + call CHEEV('V','U',msize,M,msize,E_real,work,lwork,rwk,ifail) #endif ! end subroutine heev @@ -191,10 +213,43 @@ subroutine geev(msize,M,E_cmpl,V_left,V_right,work,lwork,rwk,ifail) complex(SP),intent(out) :: E_cmpl(*),V_left(msize,*),V_right(msize,*),work(*) complex(SP),intent(inout) :: M(msize,*) ! -#if defined _DOUBLE - call ZGEEV('V','V',msize,M,msize,E_cmpl,V_left,msize,V_right,msize,work,lwork,rwk,ifail) + integer :: nthreads + ! + ! + ! use magma (if available) + ! +#if defined _MAGMA + ! + if (.not.magma_init_done) call magma_setup() + ! +# if defined _OPENMP + ! thread safety + nthreads=omp_get_max_threads() + call omp_set_num_threads(1) +# endif + ! +# if defined _DOUBLE + call magma_zgeev_m(MagmaVec,MagmaVec, msize,M,msize,E_cmpl,V_left,msize,V_right,msize,& +& work,lwork,rwk,ifail) +# else + call magma_cgeev_m(MagmaVec,MagmaVec, msize,M,msize,E_cmpl,V_left,msize,V_right,msize,& +& work,lwork,rwk,ifail) +# endif + ! +# if defined _OPENMP + call omp_set_num_threads(nthreads) +# endif + ! #else - call CGEEV('V','V',msize,M,msize,E_cmpl,V_left,msize,V_right,msize,work,lwork,rwk,ifail) + ! + ! use lapack + ! +# if defined _DOUBLE + call ZGEEV('V','V',msize,M,msize,E_cmpl,V_left,msize,V_right,msize,work,lwork,rwk,ifail) +# else + call CGEEV('V','V',msize,M,msize,E_cmpl,V_left,msize,V_right,msize,work,lwork,rwk,ifail) +# endif + ! #endif ! end subroutine geev diff --git a/src/modules/mod_magma2.F b/src/modules/mod_magma2.F new file mode 100644 index 0000000000..bcf771ab29 --- /dev/null +++ b/src/modules/mod_magma2.F @@ -0,0 +1,279 @@ +! +! -- MAGMA (version 2.7.1) -- +! Univ. of Tennessee, Knoxville +! Univ. of California, Berkeley +! Univ. of Colorado, Denver +! @date February 2023 +! + +module magma2 + +use iso_c_binding + +use magma2_common +use magma2_sfortran +use magma2_dfortran +use magma2_cfortran +use magma2_zfortran + +implicit none + +!! ============================================================================= +!! Parameter constants from magma_types.h +integer(c_int), parameter :: & + MagmaFalse = 0, & + MagmaTrue = 1, & + + MagmaRowMajor = 101, & + MagmaColMajor = 102, & + + MagmaNoTrans = 111, & + MagmaTrans = 112, & + MagmaConjTrans = 113, & + + MagmaUpper = 121, & + MagmaLower = 122, & + MagmaGeneral = 123, & + MagmaFull = 123, & !! deprecated, use MagmaGeneral + + MagmaNonUnit = 131, & + MagmaUnit = 132, & + + MagmaLeft = 141, & + MagmaRight = 142, & + MagmaBothSides = 143, & + + MagmaNoVec = 301, & !/* geev, syev, gesvd */ + MagmaVec = 302, & !/* geev, syev */ + MagmaIVec = 303, & !/* stedc */ + MagmaAllVec = 304, & !/* gesvd, trevc */ + MagmaSomeVec = 305, & !/* gesvd, trevc */ + MagmaOverwriteVec = 306, & !/* gesvd */ + MagmaBacktransVec = 307 !/* trevc */ +!! todo all the rest + + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! initialize + subroutine magma_init() & + bind(C, name="magma_init") + use iso_c_binding + end subroutine + + subroutine magma_finalize() & + bind(C, name="magma_finalize") + use iso_c_binding + end subroutine + + !! ------------------------------------------------------------------------- + !! version + subroutine magma_version( major, minor, micro ) & + bind(C, name="magma_version") + use iso_c_binding + integer(c_int), target :: major, minor, micro + end subroutine + + subroutine magma_print_environment() & + bind(C, name="magma_print_environment") + use iso_c_binding + end subroutine + + !! ------------------------------------------------------------------------- + !! timing + real(c_double) function magma_wtime() & + bind(C, name="magma_wtime") + use iso_c_binding + end function + + real(c_double) function magma_sync_wtime( queue ) & + bind(C, name="magma_wtime") + use iso_c_binding + type(c_ptr), value :: queue + end function + + !! ------------------------------------------------------------------------- + !! device support + integer(c_int) function magma_num_gpus() & + bind(C, name="magma_num_gpus") + use iso_c_binding + end function + + integer(c_int) function magma_get_device_arch() & + bind(C, name="magma_getdevice_arch") + use iso_c_binding + end function + + subroutine magma_get_device( dev ) & + bind(C, name="magma_getdevice") + use iso_c_binding + integer(c_int), target :: dev + end subroutine + + subroutine magma_set_device( dev ) & + bind(C, name="magma_setdevice") + use iso_c_binding + integer(c_int), value :: dev + end subroutine + + integer(c_size_t) function magma_mem_size( queue ) & + bind(C, name="magma_mem_size") + use iso_c_binding + type(c_ptr), value :: queue + end function + + !! ------------------------------------------------------------------------- + !! queue support + subroutine magma_queue_create_internal( dev, queue_ptr, func, file, line ) & + bind(C, name="magma_queue_create_internal") + use iso_c_binding + integer(c_int), value :: dev + type(c_ptr), target :: queue_ptr !! queue_t* + character(c_char) :: func, file + integer(c_int), value :: line + end subroutine + + subroutine magma_queue_destroy_internal( queue, func, file, line ) & + bind(C, name="magma_queue_destroy_internal") + use iso_c_binding + type(c_ptr), value :: queue !! queue_t + character(c_char) :: func, file + integer(c_int), value :: line + end subroutine + + subroutine magma_queue_sync_internal( queue, func, file, line ) & + bind(C, name="magma_queue_sync_internal") + use iso_c_binding + type(c_ptr), value :: queue !! queue_t + character(c_char) :: func, file + integer(c_int), value :: line + end subroutine + + integer(c_int) function magma_queue_get_device( queue ) & + bind(C, name="magma_queue_get_device") + use iso_c_binding + type(c_ptr), value :: queue !! queue_t + end function + + !! ------------------------------------------------------------------------- + !! offsets pointers -- 1D vectors with inc + !! see offset.c + type(c_ptr) function magma_soffset_1d( ptr, inc, i ) & + bind(C, name="magma_soffset_1d") + use iso_c_binding + type(c_ptr), value :: ptr + integer(c_int), value :: inc, i + end function + + type(c_ptr) function magma_doffset_1d( ptr, inc, i ) & + bind(C, name="magma_doffset_1d") + use iso_c_binding + type(c_ptr), value :: ptr + integer(c_int), value :: inc, i + end function + + type(c_ptr) function magma_coffset_1d( ptr, inc, i ) & + bind(C, name="magma_coffset_1d") + use iso_c_binding + type(c_ptr), value :: ptr + integer(c_int), value :: inc, i + end function + + type(c_ptr) function magma_zoffset_1d( ptr, inc, i ) & + bind(C, name="magma_zoffset_1d") + use iso_c_binding + type(c_ptr), value :: ptr + integer(c_int), value :: inc, i + end function + + type(c_ptr) function magma_ioffset_1d( ptr, inc, i ) & + bind(C, name="magma_ioffset_1d") + use iso_c_binding + type(c_ptr), value :: ptr + integer(c_int), value :: inc, i + end function + + !! ------------------------------------------------------------------------- + !! offsets pointers -- 2D matrices with lda + !! see offset.c + type(c_ptr) function magma_soffset_2d( ptr, lda, i, j ) & + bind(C, name="magma_soffset_2d") + use iso_c_binding + type(c_ptr), value:: ptr + integer(c_int), value :: lda, i, j + end function + + type(c_ptr) function magma_doffset_2d( ptr, lda, i, j ) & + bind(C, name="magma_doffset_2d") + use iso_c_binding + type(c_ptr), value:: ptr + integer(c_int), value :: lda, i, j + end function + + type(c_ptr) function magma_coffset_2d( ptr, lda, i, j ) & + bind(C, name="magma_coffset_2d") + use iso_c_binding + type(c_ptr), value:: ptr + integer(c_int), value :: lda, i, j + end function + + type(c_ptr) function magma_zoffset_2d( ptr, lda, i, j ) & + bind(C, name="magma_zoffset_2d") + use iso_c_binding + type(c_ptr), value:: ptr + integer(c_int), value :: lda, i, j + end function + + type(c_ptr) function magma_ioffset_2d( ptr, lda, i, j ) & + bind(C, name="magma_ioffset_2d") + use iso_c_binding + type(c_ptr), value:: ptr + integer(c_int), value :: lda, i, j + end function + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! queue support + subroutine magma_queue_create( dev, queue_ptr ) + use iso_c_binding + integer(c_int), value :: dev + type(c_ptr), target :: queue_ptr !! queue_t* + + call magma_queue_create_internal( & + dev, queue_ptr, & + "magma_queue_create" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_queue_destroy( queue ) + use iso_c_binding + type(c_ptr), value :: queue !! queue_t + + call magma_queue_destroy_internal( & + queue, & + "magma_queue_destroy" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_queue_sync( queue ) + use iso_c_binding + type(c_ptr), value :: queue !! queue_t + + call magma_queue_sync_internal( & + queue, & + "magma_queue_sync" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module diff --git a/src/modules/mod_magma2_cfortran.F b/src/modules/mod_magma2_cfortran.F new file mode 100644 index 0000000000..8a25568acf --- /dev/null +++ b/src/modules/mod_magma2_cfortran.F @@ -0,0 +1,230 @@ +!! @generated from magma2_zfortran.F90, fortran z -> c, Sat Apr 22 18:54:26 2023 + +module magma2_cfortran + +use magma2_common +implicit none + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! CPU interfaces (matrix in CPU memory) + subroutine magma_cgetrf( m, n, A, lda, ipiv, info ) & + bind(C, name="magma_cgetrf") + use iso_c_binding + integer(c_int), value :: m, n, lda + complex(c_float_complex), target :: A(lda,*) + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cpotrf( uplo, n, A, lda, info ) & + bind(C, name="magma_cpotrf") + use iso_c_binding + integer(c_int), value :: uplo + integer(c_int), value :: n, lda + complex(c_float_complex), target :: A(lda,*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cgeev( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_cgeev") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + complex(c_float_complex), target :: A(lda,*) + complex(c_float_complex), target :: w(*) + complex(c_float_complex), target :: VR(ldvr,*), VL(ldvl,*) + complex(c_float_complex), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cgeev_m( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_cgeev_m") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + complex(c_float_complex), target :: A(lda,*) + complex(c_float_complex), target :: w(*) + complex(c_float_complex), target :: VR(ldvr,*), VL(ldvl,*) + complex(c_float_complex), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cheevd_m( ngpu, jobz, uplo, n, A, lda, w, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_cheevd_m") + use iso_c_binding + integer(c_int), value :: ngpu + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, lda, lwork, lrwork, liwork + complex(c_float_complex), target :: A(lda,*) + real(c_float), target :: w(*) + complex(c_float_complex), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! ------------------------------------------------------------------------- + !! GPU interfaces (matrix in GPU memory) + subroutine magma_cgetrf_gpu( m, n, dA, lda, ipiv, info ) & + bind(C, name="magma_cgetrf_gpu") + use iso_c_binding + integer(c_int), value :: m, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cpotrf_gpu( uplo, n, dA, lda, info ) & + bind(C, name="magma_cpotrf_gpu") + use iso_c_binding + integer(c_int), value :: uplo, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_cheevd_gpu( jobz, uplo, n, dA, ldda, w, wA, ldwa, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_cheevd_gpu") + use iso_c_binding + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, ldda, ldwa, lwork, lrwork, liwork + type(c_ptr), value :: dA !! double complex** + real(c_float), target :: w(*) + complex(c_float_complex), target :: wA(*) + complex(c_float_complex), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! batched GPU interfaces (all arrays in GPU memory) + subroutine magma_cgetrf_batched( & + m, n, dA_array, lda, ipiv_array, info_array, batchcount, queue ) & + bind(C, name="magma_cgetrf_batched") + use iso_c_binding + integer(c_int), value :: m, n, lda, batchcount + type(c_ptr), value :: dA_array !! double_complex** + type(c_ptr), value :: ipiv_array !! int** + type(c_ptr), value :: info_array !! int* + type(c_ptr), value :: queue + end subroutine + + !! ------------------------------------------------------------------------- + !! BLAS (matrices in GPU memory) + subroutine magma_caxpy( & + n, & + alpha, dx, incx, & + dy, incy, & + queue ) & + bind(C, name="magma_caxpy") + use iso_c_binding + integer(c_int), value :: n, incx, incy + complex(c_float_complex), value :: alpha + type(c_ptr), value :: dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_cgemv( & + transA, m, n, & + alpha, dA, lda, & + dx, incx, & + beta, dy, incy, & + queue ) & + bind(C, name="magma_cgemv") + use iso_c_binding + integer(c_int), value :: transA, m, n, lda, incx, incy + complex(c_float_complex), value :: alpha, beta + type(c_ptr), value :: dA, dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_cgemm( & + transA, transB, m, n, k, & + alpha, dA, lda, & + dB, ldb, & + beta, dC, ldc, & + queue ) & + bind(C, name="magma_cgemm") + use iso_c_binding + integer(c_int), value :: transA, transB, m, n, k, lda, ldb, ldc + complex(c_float_complex), value :: alpha, beta + type(c_ptr), value :: dA, dB, dC + type(c_ptr), value :: queue !! queue_t + end subroutine + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! malloc wrappers + integer(c_int) function magma_cmalloc( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_cmalloc = magma_malloc( ptr, n*sizeof_complex ) + end function + + integer(c_int) function magma_cmalloc_cpu( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_cmalloc_cpu = magma_malloc_cpu( ptr, n*sizeof_complex ) + end function + + integer(c_int) function magma_cmalloc_pinned( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_cmalloc_pinned = magma_malloc_pinned( ptr, n*sizeof_complex ) + end function + + !! ------------------------------------------------------------------------- + !! set/get wrappers + subroutine magma_csetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + complex(c_float_complex), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_complex), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_csetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_cgetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + complex(c_float_complex), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_complex), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_cgetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module diff --git a/src/modules/mod_magma2_common.F b/src/modules/mod_magma2_common.F new file mode 100644 index 0000000000..ac18317b87 --- /dev/null +++ b/src/modules/mod_magma2_common.F @@ -0,0 +1,378 @@ +module magma2_common + +use iso_c_binding +implicit none + +!! ===================================================================== +!! Parameter constants +real(c_float), parameter :: sdummy = 0 +real(c_double), parameter :: ddummy = 0 +complex(c_float_complex), parameter :: cdummy = 0 +complex(c_double_complex), parameter :: zdummy = 0 +integer(c_int), parameter :: idummy = 0 +type(c_ptr), parameter :: ptr_dummy = c_null_ptr + +!! Intel ifort chokes on c_sizeof here, so use extension sizeof +!! see https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/495001 +integer(c_size_t), parameter :: & + sizeof_real = sizeof(sdummy), & + sizeof_double = sizeof(ddummy), & + sizeof_complex = sizeof(cdummy), & + sizeof_complex16 = sizeof(zdummy), & + sizeof_int = sizeof(idummy), & + sizeof_ptr = sizeof(ptr_dummy) + + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! magma_malloc (GPU memory) + integer(c_int) function magma_malloc( ptr, bytes ) & + bind(C, name="magma_malloc") + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: bytes + end function + + !! todo imalloc + + integer(c_int) function magma_free_internal( ptr, func, file, line ) & + bind(C, name="magma_free_internal") + use iso_c_binding + type(c_ptr), value :: ptr !! void* + character(c_char) :: func, file + integer(c_int), value :: line + end function + + !! ------------------------------------------------------------------------- + !! magma_malloc_cpu (CPU main memory) + !! these are aligned to 32-byte boundary + integer(c_int) function magma_malloc_cpu( ptr, bytes ) & + bind(C, name="magma_malloc_cpu") + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: bytes + end function + + !! todo imalloc_cpu + + integer(c_int) function magma_free_cpu( ptr ) & + bind(C, name="magma_free_cpu") + use iso_c_binding + type(c_ptr), value :: ptr !! void* + end function + + !! ------------------------------------------------------------------------- + !! magma_malloc_pinned (pinned CPU main memory) + integer(c_int) function magma_malloc_pinned( ptr, bytes ) & + bind(C, name="magma_malloc_pinned") + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: bytes + end function + + !! todo imalloc_pinned + + integer(c_int) function magma_free_pinned_internal( ptr, func, file, line ) & + bind(C, name="magma_free_pinned_internal") + use iso_c_binding + type(c_ptr), value :: ptr !! void* + character(c_char), value :: func, file + integer(c_int), value :: line + end function + + !! ------------------------------------------------------------------------- + !! set/get + subroutine magma_setmatrix_internal( & + m, n, elemsize, hA_src, lda, dB_dst, ldb, queue, func, file, line ) & + bind(C, name="magma_setmatrix_internal") + use iso_c_binding + integer(c_int), value :: m, n, elemsize, lda, ldb + type(c_ptr), value :: hA_src + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + character(c_char), value :: func, file + integer(c_int), value :: line + end subroutine + + subroutine magma_getmatrix_internal( & + m, n, elemsize, dA_src, lda, hB_dst, ldb, queue, func, file, line ) & + bind(C, name="magma_getmatrix_internal") + use iso_c_binding + integer(c_int), value :: m, n, elemsize, lda, ldb + type(c_ptr), value :: dA_src + type(c_ptr), value :: hB_dst + type(c_ptr), value :: queue + character(c_char), value :: func, file + integer(c_int), value :: line + end subroutine + + subroutine magma_setvector_internal( & + n, elemsize, hx_src, incx, dy_dst, incy, queue, func, file, line ) & + bind(C, name="magma_setvector_internal") + use iso_c_binding + integer(c_int), value :: n, elemsize, incx, incy + type(c_ptr), value :: hx_src + type(c_ptr), value :: dy_dst + type(c_ptr), value :: queue + character(c_char), value :: func, file + integer(c_int), value :: line + end subroutine + + subroutine magma_getvector_internal( & + n, elemsize, dx_src, incx, hy_dst, incy, queue, func, file, line ) & + bind(C, name="magma_getvector_internal") + use iso_c_binding + integer(c_int), value :: n, elemsize, incx, incy + type(c_ptr), value :: dx_src + type(c_ptr), value :: hy_dst + type(c_ptr), value :: queue + character(c_char), value :: func, file + integer(c_int), value :: line + end subroutine + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! malloc wrappers + integer(c_int) function magma_imalloc( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_imalloc = magma_malloc( ptr, n*sizeof_int ) + end function + + integer(c_int) function magma_imalloc_cpu( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_imalloc_cpu = magma_malloc_cpu( ptr, n*sizeof_int ) + end function + + integer(c_int) function magma_imalloc_pinned( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_imalloc_pinned = magma_malloc_pinned( ptr, n*sizeof_int ) + end function + + !! ------------------------------------------------------------------------- + !! magma_free wrappers + integer(c_int) function magma_free( ptr ) + type(c_ptr) :: ptr + + magma_free = magma_free_internal( & + ptr, & + "magma_free" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end function + + integer(c_int) function magma_free_pinned( ptr ) + type(c_ptr) :: ptr + + magma_free_pinned = magma_free_internal( & + ptr, & + "magma_free_pinned" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end function + + !! ------------------------------------------------------------------------- + !! set/get wrappers + subroutine magma_setmatrix( & + m, n, elemsize, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, elemsize, lda, ldb + type(c_ptr), value :: hA_src + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, elemsize, hA_src, lda, dB_dst, ldb, queue, & + "magma_setmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_getmatrix( & + m, n, elemsize, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, elemsize, lda, ldb + type(c_ptr), value :: dA_src + type(c_ptr), value :: hB_dst + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, elemsize, dA_src, lda, hB_dst, ldb, queue, & + "magma_getmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_setvector( & + n, elemsize, hx_src, incx, dy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, elemsize, incx, incy + type(c_ptr), value :: hx_src + type(c_ptr), value :: dy_dst + type(c_ptr), value :: queue + + call magma_setvector_internal( & + n, elemsize, hx_src, incx, dy_dst, incy, queue, & + "magma_setvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_getvector( & + n, elemsize, dx_src, incx, hy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, elemsize, incx, incy + type(c_ptr), value :: dx_src + type(c_ptr), value :: hy_dst + type(c_ptr), value :: queue + + call magma_getvector_internal( & + n, elemsize, dx_src, incx, hy_dst, incy, queue, & + "magma_getvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + !! ------------------------------------------------------------------------- + !! set/get wrappers + !! matrices & vectors of integers + subroutine magma_isetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + integer(c_int), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_int), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_isetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_igetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + integer(c_int), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_int), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_igetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_isetvector( & + n, hx_src, incx, dy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, incx, incy + integer(c_int), target :: hx_src(*) + type(c_ptr), value :: dy_dst + type(c_ptr), value :: queue + + call magma_setvector_internal( & + n, int(sizeof_int), c_loc(hx_src), incx, dy_dst, incy, queue, & + "magma_isetvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_igetvector( & + n, dx_src, incx, hy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, incx, incy + type(c_ptr), value :: dx_src + integer(c_int), target :: hy_dst(*) + type(c_ptr), value :: queue + + call magma_getvector_internal( & + n, int(sizeof_int), dx_src, incx, c_loc(hy_dst), incy, queue, & + "magma_igetvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + !! ------------------------------------------------------------------------- + !! set/get wrappers + !! matrices & vectors of c_ptr pointers + subroutine magma_psetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_ptr), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_psetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_pgetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + type(c_ptr), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_ptr), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_pgetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_psetvector( & + n, hx_src, incx, dy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, incx, incy + type(c_ptr), target :: hx_src(*) + type(c_ptr), value :: dy_dst + type(c_ptr), value :: queue + + call magma_setvector_internal( & + n, int(sizeof_ptr), c_loc(hx_src), incx, dy_dst, incy, queue, & + "magma_psetvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_pgetvector( & + n, dx_src, incx, hy_dst, incy, queue ) + use iso_c_binding + integer(c_int), value :: n, incx, incy + type(c_ptr), value :: dx_src + type(c_ptr), target :: hy_dst(*) + type(c_ptr), value :: queue + + call magma_getvector_internal( & + n, int(sizeof_ptr), dx_src, incx, c_loc(hy_dst), incy, queue, & + "magma_pgetvector" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module diff --git a/src/modules/mod_magma2_dfortran.F b/src/modules/mod_magma2_dfortran.F new file mode 100644 index 0000000000..e85b83b368 --- /dev/null +++ b/src/modules/mod_magma2_dfortran.F @@ -0,0 +1,230 @@ +!! @generated from magma2_zfortran.F90, fortran z -> d, Sat Apr 22 18:54:26 2023 + +module magma2_dfortran + +use magma2_common +implicit none + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! CPU interfaces (matrix in CPU memory) + subroutine magma_dgetrf( m, n, A, lda, ipiv, info ) & + bind(C, name="magma_dgetrf") + use iso_c_binding + integer(c_int), value :: m, n, lda + real(c_double), target :: A(lda,*) + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dpotrf( uplo, n, A, lda, info ) & + bind(C, name="magma_dpotrf") + use iso_c_binding + integer(c_int), value :: uplo + integer(c_int), value :: n, lda + real(c_double), target :: A(lda,*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dgeev( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_dgeev") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + real(c_double), target :: A(lda,*) + real(c_double), target :: w(*) + real(c_double), target :: VR(ldvr,*), VL(ldvl,*) + real(c_double), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dgeev_m( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_dgeev_m") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + real(c_double), target :: A(lda,*) + real(c_double), target :: w(*) + real(c_double), target :: VR(ldvr,*), VL(ldvl,*) + real(c_double), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dsyevd_m( ngpu, jobz, uplo, n, A, lda, w, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_dsyevd_m") + use iso_c_binding + integer(c_int), value :: ngpu + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, lda, lwork, lrwork, liwork + real(c_double), target :: A(lda,*) + real(c_double), target :: w(*) + real(c_double), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! ------------------------------------------------------------------------- + !! GPU interfaces (matrix in GPU memory) + subroutine magma_dgetrf_gpu( m, n, dA, lda, ipiv, info ) & + bind(C, name="magma_dgetrf_gpu") + use iso_c_binding + integer(c_int), value :: m, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dpotrf_gpu( uplo, n, dA, lda, info ) & + bind(C, name="magma_dpotrf_gpu") + use iso_c_binding + integer(c_int), value :: uplo, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_dsyevd_gpu( jobz, uplo, n, dA, ldda, w, wA, ldwa, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_dsyevd_gpu") + use iso_c_binding + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, ldda, ldwa, lwork, lrwork, liwork + type(c_ptr), value :: dA !! double real** + real(c_double), target :: w(*) + real(c_double), target :: wA(*) + real(c_double), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! batched GPU interfaces (all arrays in GPU memory) + subroutine magma_dgetrf_batched( & + m, n, dA_array, lda, ipiv_array, info_array, batchcount, queue ) & + bind(C, name="magma_dgetrf_batched") + use iso_c_binding + integer(c_int), value :: m, n, lda, batchcount + type(c_ptr), value :: dA_array !! double_real** + type(c_ptr), value :: ipiv_array !! int** + type(c_ptr), value :: info_array !! int* + type(c_ptr), value :: queue + end subroutine + + !! ------------------------------------------------------------------------- + !! BLAS (matrices in GPU memory) + subroutine magma_daxpy( & + n, & + alpha, dx, incx, & + dy, incy, & + queue ) & + bind(C, name="magma_daxpy") + use iso_c_binding + integer(c_int), value :: n, incx, incy + real(c_double), value :: alpha + type(c_ptr), value :: dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_dgemv( & + transA, m, n, & + alpha, dA, lda, & + dx, incx, & + beta, dy, incy, & + queue ) & + bind(C, name="magma_dgemv") + use iso_c_binding + integer(c_int), value :: transA, m, n, lda, incx, incy + real(c_double), value :: alpha, beta + type(c_ptr), value :: dA, dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_dgemm( & + transA, transB, m, n, k, & + alpha, dA, lda, & + dB, ldb, & + beta, dC, ldc, & + queue ) & + bind(C, name="magma_dgemm") + use iso_c_binding + integer(c_int), value :: transA, transB, m, n, k, lda, ldb, ldc + real(c_double), value :: alpha, beta + type(c_ptr), value :: dA, dB, dC + type(c_ptr), value :: queue !! queue_t + end subroutine + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! malloc wrappers + integer(c_int) function magma_dmalloc( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_dmalloc = magma_malloc( ptr, n*sizeof_double ) + end function + + integer(c_int) function magma_dmalloc_cpu( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_dmalloc_cpu = magma_malloc_cpu( ptr, n*sizeof_double ) + end function + + integer(c_int) function magma_dmalloc_pinned( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_dmalloc_pinned = magma_malloc_pinned( ptr, n*sizeof_double ) + end function + + !! ------------------------------------------------------------------------- + !! set/get wrappers + subroutine magma_dsetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + real(c_double), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_double), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_dsetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_dgetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + real(c_double), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_double), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_dgetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module diff --git a/src/modules/mod_magma2_sfortran.F b/src/modules/mod_magma2_sfortran.F new file mode 100644 index 0000000000..b5c45a41c3 --- /dev/null +++ b/src/modules/mod_magma2_sfortran.F @@ -0,0 +1,230 @@ +!! @generated from magma2_zfortran.F90, fortran z -> s, Sat Apr 22 18:54:26 2023 + +module magma2_sfortran + +use magma2_common +implicit none + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! CPU interfaces (matrix in CPU memory) + subroutine magma_sgetrf( m, n, A, lda, ipiv, info ) & + bind(C, name="magma_sgetrf") + use iso_c_binding + integer(c_int), value :: m, n, lda + real(c_float), target :: A(lda,*) + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_spotrf( uplo, n, A, lda, info ) & + bind(C, name="magma_spotrf") + use iso_c_binding + integer(c_int), value :: uplo + integer(c_int), value :: n, lda + real(c_float), target :: A(lda,*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_sgeev( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_sgeev") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + real(c_float), target :: A(lda,*) + real(c_float), target :: w(*) + real(c_float), target :: VR(ldvr,*), VL(ldvl,*) + real(c_float), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_sgeev_m( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_sgeev_m") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + real(c_float), target :: A(lda,*) + real(c_float), target :: w(*) + real(c_float), target :: VR(ldvr,*), VL(ldvl,*) + real(c_float), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_ssyevd_m( ngpu, jobz, uplo, n, A, lda, w, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_ssyevd_m") + use iso_c_binding + integer(c_int), value :: ngpu + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, lda, lwork, lrwork, liwork + real(c_float), target :: A(lda,*) + real(c_float), target :: w(*) + real(c_float), target :: work(*) + real(c_float), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! ------------------------------------------------------------------------- + !! GPU interfaces (matrix in GPU memory) + subroutine magma_sgetrf_gpu( m, n, dA, lda, ipiv, info ) & + bind(C, name="magma_sgetrf_gpu") + use iso_c_binding + integer(c_int), value :: m, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_spotrf_gpu( uplo, n, dA, lda, info ) & + bind(C, name="magma_spotrf_gpu") + use iso_c_binding + integer(c_int), value :: uplo, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_ssyevd_gpu( jobz, uplo, n, dA, ldda, w, wA, ldwa, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_ssyevd_gpu") + use iso_c_binding + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, ldda, ldwa, lwork, lrwork, liwork + type(c_ptr), value :: dA !! double real** + real(c_double), target :: w(*) + real(c_float), target :: wA(*) + real(c_float), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! batched GPU interfaces (all arrays in GPU memory) + subroutine magma_sgetrf_batched( & + m, n, dA_array, lda, ipiv_array, info_array, batchcount, queue ) & + bind(C, name="magma_sgetrf_batched") + use iso_c_binding + integer(c_int), value :: m, n, lda, batchcount + type(c_ptr), value :: dA_array !! double_real** + type(c_ptr), value :: ipiv_array !! int** + type(c_ptr), value :: info_array !! int* + type(c_ptr), value :: queue + end subroutine + + !! ------------------------------------------------------------------------- + !! BLAS (matrices in GPU memory) + subroutine magma_saxpy( & + n, & + alpha, dx, incx, & + dy, incy, & + queue ) & + bind(C, name="magma_saxpy") + use iso_c_binding + integer(c_int), value :: n, incx, incy + real(c_float), value :: alpha + type(c_ptr), value :: dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_sgemv( & + transA, m, n, & + alpha, dA, lda, & + dx, incx, & + beta, dy, incy, & + queue ) & + bind(C, name="magma_sgemv") + use iso_c_binding + integer(c_int), value :: transA, m, n, lda, incx, incy + real(c_float), value :: alpha, beta + type(c_ptr), value :: dA, dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_sgemm( & + transA, transB, m, n, k, & + alpha, dA, lda, & + dB, ldb, & + beta, dC, ldc, & + queue ) & + bind(C, name="magma_sgemm") + use iso_c_binding + integer(c_int), value :: transA, transB, m, n, k, lda, ldb, ldc + real(c_float), value :: alpha, beta + type(c_ptr), value :: dA, dB, dC + type(c_ptr), value :: queue !! queue_t + end subroutine + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! malloc wrappers + integer(c_int) function magma_smalloc( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_smalloc = magma_malloc( ptr, n*sizeof_real ) + end function + + integer(c_int) function magma_smalloc_cpu( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_smalloc_cpu = magma_malloc_cpu( ptr, n*sizeof_real ) + end function + + integer(c_int) function magma_smalloc_pinned( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_smalloc_pinned = magma_malloc_pinned( ptr, n*sizeof_real ) + end function + + !! ------------------------------------------------------------------------- + !! set/get wrappers + subroutine magma_ssetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + real(c_float), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_real), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_ssetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_sgetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + real(c_float), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_real), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_sgetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module diff --git a/src/modules/mod_magma2_zfortran.F b/src/modules/mod_magma2_zfortran.F new file mode 100644 index 0000000000..8066052bee --- /dev/null +++ b/src/modules/mod_magma2_zfortran.F @@ -0,0 +1,230 @@ +!! @precisions fortran z -> s d c + +module magma2_zfortran + +use magma2_common +implicit none + +!! ============================================================================= +!! Fortran interfaces to C functions +interface + + !! ------------------------------------------------------------------------- + !! CPU interfaces (matrix in CPU memory) + subroutine magma_zgetrf( m, n, A, lda, ipiv, info ) & + bind(C, name="magma_zgetrf") + use iso_c_binding + integer(c_int), value :: m, n, lda + complex(c_double_complex), target :: A(lda,*) + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zpotrf( uplo, n, A, lda, info ) & + bind(C, name="magma_zpotrf") + use iso_c_binding + integer(c_int), value :: uplo + integer(c_int), value :: n, lda + complex(c_double_complex), target :: A(lda,*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zgeev( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_zgeev") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + complex(c_double_complex), target :: A(lda,*) + complex(c_double_complex), target :: w(*) + complex(c_double_complex), target :: VR(ldvr,*), VL(ldvl,*) + complex(c_double_complex), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zgeev_m( jobvl, jobvr, n, A, lda, w, VL, ldvl, VR, ldvr, & + work, lwork, rwork, info) & + bind(C, name="magma_zgeev_m") + use iso_c_binding + integer(c_int), value :: jobvl, jobvr + integer(c_int), value :: n, lda, ldvl, ldvr, lwork + complex(c_double_complex), target :: A(lda,*) + complex(c_double_complex), target :: w(*) + complex(c_double_complex), target :: VR(ldvr,*), VL(ldvl,*) + complex(c_double_complex), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zheevd_m( ngpu, jobz, uplo, n, A, lda, w, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_zheevd_m") + use iso_c_binding + integer(c_int), value :: ngpu + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, lda, lwork, lrwork, liwork + complex(c_double_complex), target :: A(lda,*) + real(c_double), target :: w(*) + complex(c_double_complex), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! ------------------------------------------------------------------------- + !! GPU interfaces (matrix in GPU memory) + subroutine magma_zgetrf_gpu( m, n, dA, lda, ipiv, info ) & + bind(C, name="magma_zgetrf_gpu") + use iso_c_binding + integer(c_int), value :: m, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: ipiv(*) + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zpotrf_gpu( uplo, n, dA, lda, info ) & + bind(C, name="magma_zpotrf_gpu") + use iso_c_binding + integer(c_int), value :: uplo, n, lda + type(c_ptr), value :: dA + integer(c_int), target :: info !! int* + end subroutine + + subroutine magma_zheevd_gpu( jobz, uplo, n, dA, ldda, w, wA, ldwa, work, lwork, & + rwork, lrwork, iwork, liwork, info) & + bind(C, name="magma_zheevd_gpu") + use iso_c_binding + integer(c_int), value :: jobz, uplo + integer(c_int), value :: n, ldda, ldwa, lwork, lrwork, liwork + type(c_ptr), value :: dA !! double complex** + real(c_double), target :: w(*) + complex(c_double_complex), target :: wA(*) + complex(c_double_complex), target :: work(*) + real(c_double), target :: rwork(*) + integer(c_int), target :: iwork(*) + integer(c_int), target :: info !! int* + end subroutine + + !! ------------------------------------------------------------------------- + !! batched GPU interfaces (all arrays in GPU memory) + subroutine magma_zgetrf_batched( & + m, n, dA_array, lda, ipiv_array, info_array, batchcount, queue ) & + bind(C, name="magma_zgetrf_batched") + use iso_c_binding + integer(c_int), value :: m, n, lda, batchcount + type(c_ptr), value :: dA_array !! double_complex** + type(c_ptr), value :: ipiv_array !! int** + type(c_ptr), value :: info_array !! int* + type(c_ptr), value :: queue + end subroutine + + !! ------------------------------------------------------------------------- + !! BLAS (matrices in GPU memory) + subroutine magma_zaxpy( & + n, & + alpha, dx, incx, & + dy, incy, & + queue ) & + bind(C, name="magma_zaxpy") + use iso_c_binding + integer(c_int), value :: n, incx, incy + complex(c_double_complex), value :: alpha + type(c_ptr), value :: dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_zgemv( & + transA, m, n, & + alpha, dA, lda, & + dx, incx, & + beta, dy, incy, & + queue ) & + bind(C, name="magma_zgemv") + use iso_c_binding + integer(c_int), value :: transA, m, n, lda, incx, incy + complex(c_double_complex), value :: alpha, beta + type(c_ptr), value :: dA, dx, dy + type(c_ptr), value :: queue !! queue_t + end subroutine + + subroutine magma_zgemm( & + transA, transB, m, n, k, & + alpha, dA, lda, & + dB, ldb, & + beta, dC, ldc, & + queue ) & + bind(C, name="magma_zgemm") + use iso_c_binding + integer(c_int), value :: transA, transB, m, n, k, lda, ldb, ldc + complex(c_double_complex), value :: alpha, beta + type(c_ptr), value :: dA, dB, dC + type(c_ptr), value :: queue !! queue_t + end subroutine + +end interface + +!! ============================================================================= +!! Fortran routines & functions +contains + + !! ------------------------------------------------------------------------- + !! malloc wrappers + integer(c_int) function magma_zmalloc( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_zmalloc = magma_malloc( ptr, n*sizeof_complex16 ) + end function + + integer(c_int) function magma_zmalloc_cpu( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_zmalloc_cpu = magma_malloc_cpu( ptr, n*sizeof_complex16 ) + end function + + integer(c_int) function magma_zmalloc_pinned( ptr, n ) + use iso_c_binding + type(c_ptr), target :: ptr !! void** + integer(c_size_t), value :: n + + magma_zmalloc_pinned = magma_malloc_pinned( ptr, n*sizeof_complex16 ) + end function + + !! ------------------------------------------------------------------------- + !! set/get wrappers + subroutine magma_zsetmatrix( & + m, n, hA_src, lda, dB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + complex(c_double_complex), target :: hA_src(lda,*) + type(c_ptr), value :: dB_dst + type(c_ptr), value :: queue + + call magma_setmatrix_internal( & + m, n, int(sizeof_complex16), c_loc(hA_src), lda, dB_dst, ldb, queue, & + "magma_zsetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + + subroutine magma_zgetmatrix( & + m, n, dA_src, lda, hB_dst, ldb, queue ) + use iso_c_binding + integer(c_int), value :: m, n, lda, ldb + type(c_ptr), value :: dA_src + complex(c_double_complex), target :: hB_dst(ldb,*) + type(c_ptr), value :: queue + + call magma_getmatrix_internal( & + m, n, int(sizeof_complex16), dA_src, lda, c_loc(hB_dst), ldb, queue, & + "magma_zgetmatrix" // c_null_char, & + __FILE__ // c_null_char, & + __LINE__ ) + end subroutine + +end module