diff --git a/config/configure.ac b/config/configure.ac index b12941d225..310eda0d37 100644 --- a/config/configure.ac +++ b/config/configure.ac @@ -254,6 +254,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]) m4_include([config/m4/libcuda.m4]) m4_include([config/m4/device_xlib.m4]) # @@ -305,6 +306,9 @@ AC_SET_GPU # Device XLIB ACX_DEVXLIB # ============================================================================ +# 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 7dcd164b21..d5a59c7b85 100644 --- a/config/m4/acx_report.m4 +++ b/config/m4/acx_report.m4 @@ -141,6 +141,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 MAGMA_check="C"; fi + if test "$compile_magma" = "no" ; then MAGMA_check="I"; fi +elif test "$enable_magma" = "yes" ; then + MAGMA_check="E" +fi +# DEVXLIB_check="E" if test "$internal_devxlib" = "yes" ; then if test "$compile_devxlib" = "yes"; then DEVXLIB_check="C"; fi @@ -229,6 +237,7 @@ AC_SUBST(YDB_check) AC_SUBST(YPY_check) # AC_SUBST(LIBXC_check) +AC_SUBST(MAGMA_check) AC_SUBST(DEVXLIB_check) AC_SUBST(LIBCUDA_check) AC_SUBST(MPI_check) @@ -313,6 +322,13 @@ SCALAPACK_INCS_R=$STRIPE AC_SUBST(SCALAPACK_LIBS_R) AC_SUBST(SCALAPACK_INCS_R) # +ACX_STRIPE_SUBPATH($MAGMA_LIBS,"LIB") +MAGMA_LIBS_R=$STRIPE +ACX_STRIPE_SUBPATH($MAGMA_INCS,"INC") +MAGMA_INCS_R=$STRIPE +AC_SUBST(MAGMA_LIBS_R) +AC_SUBST(MAGMA_INCS_R) +# ACX_STRIPE_SUBPATH($BLACS_LIBS,"LIB") BLACS_LIBS_R=$STRIPE ACX_STRIPE_SUBPATH($BLACS_INCS,"INC") @@ -334,6 +350,13 @@ SLEPC_INCS_R=$STRIPE AC_SUBST(SLEPC_LIBS_R) AC_SUBST(SLEPC_INCS_R) # +ACX_STRIPE_SUBPATH($MAGMA_LIBS,"LIB") +MAGMA_LIBS_R=$STRIPE +ACX_STRIPE_SUBPATH($MAGMA_INCS,"INC") +MAGMA_INCS_R=$STRIPE +AC_SUBST(MAGMA_LIBS_R) +AC_SUBST(MAGMA_INCS_R) +# ACX_STRIPE_SUBPATH($LIBXC_LIBS,"LIB") LIBXC_LIBS_R=$STRIPE ACX_STRIPE_SUBPATH($LIBXC_INCS,"INC") diff --git a/config/m4/magma.m4 b/config/m4/magma.m4 new file mode 100644 index 0000000000..b7b02b413e --- /dev/null +++ b/config/m4/magma.m4 @@ -0,0 +1,182 @@ +# +# 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" +compile_magma_fmodules="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" ; + compile_magma_fmodules="yes" ; + with_magma_libs=""; +elif test x"$with_magma_libs" = "xno" ; then + enable_magma="no" ; + compile_magma_fmodules="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" ; + #fi + MAGMA_INCS="${IFLAG}${extlibs_path}/${FCKIND}/${FC}/include" ; + # + magma=yes + def_magma="-D_MAGMA" + if test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.a" ; then + compile_magma="no" ; + compile_magma_fmodules="no" ; + AC_MSG_RESULT([already compiled]) ; + elif test -e "${extlibs_path}/${FCKIND}/${FC}/lib/libmagma.so" ; then + compile_magma="no" ; + compile_magma_fmodules="no" ; + AC_MSG_RESULT([already compiled]) ; + else + compile_magma="yes" ; + compile_magma_fmodules="no" ; + AC_MSG_RESULT([Compatible external Magma not found/specified. To be compiled.]) ; + fi + # +fi +# +# Check if fortran modules are available +# +if test -e "$MAGMA_INCS/mod_magma2_common.F" ; then compile_magma_fmodules="no" ; fi +# +# switch off internal magma compilation +# +deactivate_internal=no +if test "x$compile_magma" = "xyes" && test "x$internal_magma" = "xyes" && test "x$deactivate_internal" = "xyes" ; then + AC_MSG_RESULT([Internal Magma compilation not available yet. Deactivating it.]) ; + compile_magma="no" + def_magma="" + enable_magma="no" + MAGMA_INCS="" ; + MAGMA_LIBS="" ; +fi +# +AC_SUBST(MAGMA_LIBS) +AC_SUBST(MAGMA_INCS) +AC_SUBST(def_magma) +AC_SUBST(enable_magma) +AC_SUBST(compile_magma) +AC_SUBST(compile_magma_fmodules) +AC_SUBST(internal_magma) +# +]) diff --git a/config/m4/netcdf_f90.m4 b/config/m4/netcdf_f90.m4 index 1b58868a3c..7e1cb7b1cd 100644 --- a/config/m4/netcdf_f90.m4 +++ b/config/m4/netcdf_f90.m4 @@ -103,9 +103,9 @@ if test -d "$with_netcdf_path" || test -d "$with_netcdf_libdir" ; then fi # try_NETCDF_LIBS="-L$try_netcdf_libdir -lnetcdf" ; - if test -r $try_netcdff_libdir/libnetcdff.a ; then + if test -r $try_netcdff_libdir/libnetcdff.a || test -r $try_netcdff_libdir/libnetcdff.so ; then try_NETCDFF_LIBS="-L$try_netcdff_libdir -lnetcdff" ; - elif test -r $try_netcdf_libdir/libnetcdff.a ; then + elif test -r $try_netcdf_libdir/libnetcdff.a || test -r $try_netcdf_libdir/libnetcdff.so ; then try_NETCDFF_LIBS="-L$try_netcdf_libdir -lnetcdff" ; fi # diff --git a/config/mk/global/actions/compile_external_libraries.mk b/config/mk/global/actions/compile_external_libraries.mk index 5162d67c71..5cc19b8021 100644 --- a/config/mk/global/actions/compile_external_libraries.mk +++ b/config/mk/global/actions/compile_external_libraries.mk @@ -39,6 +39,8 @@ blacs: scalapack @if test "$(do_blacs)" = yes ; then LIBS="blacs" ; BASE="lib"; $(MAKE) $(MAKEFLAGS) blacs-dl; $(mk_external_lib); fi scalapack: lapack @if test "$(do_slk)" = yes ; then LIBS="scalapack" ; BASE="lib"; $(MAKE) $(MAKEFLAGS) scalapack-dl ; $(mk_external_lib); fi +magma: lapack + @if test "$(do_magma)" = yes ; then LIBS="magma" ; BASE="lib"; $(MAKE) $(MAKEFLAGS) magma-dl ; $(mk_external_lib); fi petsc: @if test "$(do_petsc)" = yes ; then LIBS="petsc" ; BASE="lib"; $(MAKE) $(MAKEFLAGS) petsc-dl; $(mk_external_lib); fi slepc: petsc diff --git a/config/mk/global/actions/compile_internal_libraries.mk b/config/mk/global/actions/compile_internal_libraries.mk index 7a6e35f5a4..7b7276411a 100644 --- a/config/mk/global/actions/compile_internal_libraries.mk +++ b/config/mk/global/actions/compile_internal_libraries.mk @@ -3,7 +3,7 @@ # # Copyright (C) 2020 The Yambo Team # -# Authors (see AUTHORS file for details): AM +# Authors (see AUTHORS file for details): AM DS # qe_pseudo: @+LIBS="qe_pseudo"; BASE="lib" ; ADF="$(STAMP_DBLE)"; LAB=""; $(todo_lib); $(mk_lib) @@ -13,3 +13,5 @@ math77: @+LIBS="math77"; BASE="lib" ; ADF="$(STAMP_DBLE)"; LAB=""; $(todo_lib); $(mk_lib) local: @+LIBS="local" ; BASE="lib" ; ADF="$(STAMP_DBLE)"; LAB=""; $(todo_lib); $(mk_lib) +magma_fmodules: + @+LIBS="magma_fmodules"; BASE="lib" ; ADF="$(STAMP_DBLE)"; LAB=""; $(todo_lib); $(mk_lib) diff --git a/config/mk/global/actions/download_external_libraries.mk b/config/mk/global/actions/download_external_libraries.mk index 9551f740e6..d55f4c5032 100644 --- a/config/mk/global/actions/download_external_libraries.mk +++ b/config/mk/global/actions/download_external_libraries.mk @@ -35,6 +35,8 @@ blacs-dl: @LIB2DO="blacs"; $(get_external_libraries) scalapack-dl: @LIB2DO="scalapack"; $(get_external_libraries) +magma-dl: + @LIB2DO="magma"; $(get_external_libraries) petsc-dl: @LIB2DO="petsc"; $(get_external_libraries) slepc-dl: diff --git a/config/mk/global/defs.mk.in b/config/mk/global/defs.mk.in index ffd366f36c..573bacb4d6 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_gpu@ @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_gpu@ @def_yaml@ @def_magma@ p2ycpp = @PW_CPP@ keep_objs = @enable_keep_objects@ do_blacs = @compile_blacs@ @@ -33,6 +34,8 @@ do_libxc = @compile_libxc@ do_devxlib = @compile_devxlib@ do_petsc = @compile_petsc@ do_slepc = @compile_slepc@ +do_magma = @compile_magma@ +do_magma_fmodules = @compile_magma_fmodules@ shell = @SHELL@ package_bugreport = @PACKAGE_BUGREPORT@ prefix = @prefix@ diff --git a/config/mk/global/libraries.mk b/config/mk/global/libraries.mk index c428e0dcea..428babb031 100644 --- a/config/mk/global/libraries.mk +++ b/config/mk/global/libraries.mk @@ -12,7 +12,11 @@ ifeq ($(wildcard config/mk/global/defs.mk),config/mk/global/defs.mk) endif include lib/archive/package.list # -INT_LIBS = qe_pseudo slatec math77 local +ifeq ($(do_magma_fmodules),yes) + INT_LIBS = qe_pseudo slatec math77 local magma_fmodules +else + INT_LIBS = qe_pseudo slatec math77 local +endif YAMBO_INT_LIBS= Yio YLIBIO = modules Yio YLIBIO_LD = $(YLIBIO) diff --git a/config/report.in b/config/report.in index df0f292e8d..247d609003 100644 --- a/config/report.in +++ b/config/report.in @@ -65,6 +65,8 @@ # @PETSC_INCS_R@ # [@SLEPC_check@] SLEPC : @SLEPC_LIBS_R@ # @SLEPC_INCS_R@ +# [@MAGMA_check@] MAGMA : @MAGMA_LIBS_R@ +# @MAGMA_INCS_R@ (fortran modules to be compiled: @compile_magma_fmodules@) # # > OTHERs: @DEVXLIB_info@ # @@ -82,8 +84,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_gpu@ @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_gpu@ @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_gpu@ @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_gpu@ @def_yaml@ @def_magma@ # [ CC ] @CC@ @CFLAGS@ # [ FC ] @FC@ @FCFLAGS@ @OPENMPLIBS@ @GPU_FLAGS@ # [ FCUF] @FCUFLAGS@ @GPU_FLAGS@ diff --git a/config/setup.in b/config/setup.in index 8ae2e922fa..a19305e3a1 100644 --- a/config/setup.in +++ b/config/setup.in @@ -99,6 +99,8 @@ lfutile = @FUTILE_LIBS@ ifutile = @FUTILE_INCS@ letsf = @ETSF_LIBS@ ietsf = @ETSF_INCS@ +lmagma = @MAGMA_LIBS@ +imagma = @MAGMA_INCS@ mpipath = @MPI_PATH@ # # VPATH diff --git a/configure b/configure index 6dccddef76..71b154c982 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 Yambo 5.3.0 r.23897 h.1ec507d413. +# Generated by GNU Autoconf 2.71 for Yambo 5.3.0 r.23900 h.e51825f30d. # # Report bugs to . # @@ -610,8 +610,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='Yambo' PACKAGE_TARNAME='yambo' -PACKAGE_VERSION='5.3.0 r.23897 h.1ec507d413' -PACKAGE_STRING='Yambo 5.3.0 r.23897 h.1ec507d413' +PACKAGE_VERSION='5.3.0 r.23900 h.e51825f30d' +PACKAGE_STRING='Yambo 5.3.0 r.23900 h.e51825f30d' PACKAGE_BUGREPORT='yambo@yambo-code.org' PACKAGE_URL='' @@ -1659,7 +1659,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 Yambo 5.3.0 r.23897 h.1ec507d413 to adapt to many kinds of systems. +\`configure' configures Yambo 5.3.0 r.23900 h.e51825f30d to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1725,7 +1725,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of Yambo 5.3.0 r.23897 h.1ec507d413:";; + short | recursive ) echo "Configuration of Yambo 5.3.0 r.23900 h.e51825f30d:";; esac cat <<\_ACEOF @@ -1967,7 +1967,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -Yambo configure 5.3.0 r.23897 h.1ec507d413 +Yambo configure 5.3.0 r.23900 h.e51825f30d generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc. @@ -2596,7 +2596,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 Yambo $as_me 5.3.0 r.23897 h.1ec507d413, which was +It was created by Yambo $as_me 5.3.0 r.23900 h.e51825f30d, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw @@ -3354,8 +3354,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu SVERSION="5" SSUBVERSION="3" SPATCHLEVEL="0" -SREVISION="23897" -SHASH="1ec507d413" +SREVISION="23900" +SHASH="e51825f30d" @@ -14555,9 +14555,9 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu fi # try_NETCDF_LIBS="-L$try_netcdf_libdir -lnetcdf" ; - if test -r $try_netcdff_libdir/libnetcdff.a ; then + if test -r $try_netcdff_libdir/libnetcdff.a || test -r $try_netcdff_libdir/libnetcdff.so ; then try_NETCDFF_LIBS="-L$try_netcdff_libdir -lnetcdff" ; - elif test -r $try_netcdf_libdir/libnetcdff.a ; then + elif test -r $try_netcdf_libdir/libnetcdff.a || test -r $try_netcdf_libdir/libnetcdff.so ; then try_NETCDFF_LIBS="-L$try_netcdf_libdir -lnetcdff" ; fi # @@ -17784,7 +17784,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 Yambo $as_me 5.3.0 r.23897 h.1ec507d413, which was +This file was extended by Yambo $as_me 5.3.0 r.23900 h.e51825f30d, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -17848,7 +17848,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="\\ -Yambo config.status 5.3.0 r.23897 h.1ec507d413 +Yambo config.status 5.3.0 r.23900 h.e51825f30d configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\" diff --git a/include/version/version.m4 b/include/version/version.m4 index fdea3f1735..dc93105999 100644 --- a/include/version/version.m4 +++ b/include/version/version.m4 @@ -1,9 +1,9 @@ -AC_INIT(Yambo, 5.3.0 r.23897 h.1ec507d413, yambo@yambo-code.org) +AC_INIT(Yambo, 5.3.0 r.23900 h.e51825f30d, yambo@yambo-code.org) SVERSION="5" SSUBVERSION="3" SPATCHLEVEL="0" -SREVISION="23897" -SHASH="1ec507d413" +SREVISION="23900" +SHASH="e51825f30d" AC_SUBST(SVERSION) AC_SUBST(SSUBVERSION) AC_SUBST(SPATCHLEVEL) diff --git a/lib/archive/Makefile.loc b/lib/archive/Makefile.loc index cd88054321..6b9c18d85e 100644 --- a/lib/archive/Makefile.loc +++ b/lib/archive/Makefile.loc @@ -41,6 +41,8 @@ blacs: @+URL="$(url_blacs)" ; LIB="$(pkgname_blacs)"; $(getsrc) scalapack: @+URL="$(url_scalapack)"; LIB="$(pkgname_scalapack)"; $(getsrc) +magma: + @+URL="$(url_magma)" ; LIB="$(pkgname_magma)"; $(getsrc) petsc: @+URL="$(url_petsc)" ; LIB="$(pkgname_petsc)"; GBRANCH="$(branch_petsc)" ; GIT="$(git_petsc)" ; $(call getsrc_git,"petsc"); slepc: @@ -69,6 +71,7 @@ clean_tgz: if test -s $(tarball_etsf_io) && test "$(keep_etsf_io)" != "yes" ; then rm $(tarball_etsf_io) ; fi ; \ if test -s $(tarball_lapack) && test "$(keep_lapack)" != "yes" ; then rm $(tarball_lapack) ; fi ; \ if test -s $(tarball_scalapack)&& test "$(keep_scalapack)" != "yes" ; then rm $(tarball_scalapack) ; fi ; \ + if test -s $(tarball_magma) && test "$(keep_magma)" != "yes" ; then rm $(tarball_magma) ; fi ; \ if test -s $(tarball_blacs) && test "$(keep_blacs)" != "yes" ; then rm $(tarball_blacs) ; fi ; \ if test -s $(tarball_petsc) && test "$(keep_petsc)" != "yes" ; then rm $(tarball_petsc) ; fi ; \ if test -s $(tarball_slepc) && test "$(keep_slepc)" != "yes" ; then rm $(tarball_slepc) ; fi ; \ diff --git a/lib/archive/package.list b/lib/archive/package.list index ac1acbb482..11e4b91392 100644 --- a/lib/archive/package.list +++ b/lib/archive/package.list @@ -13,6 +13,7 @@ keep_libxc=no keep_lapack=no keep_blacs=no keep_scalapack=no +keep_magma=no keep_petsc=no keep_slepc=no keep_fftw=no @@ -33,6 +34,7 @@ version_libxc=5.2.3 version_lapack=3.12.0 version_blacs=missing version_scalapack=2.2.1 +version_magma=2.8.0 version_slepc=3.22.0 version_petsc=3.22.0 version_fftw=3.3.10 @@ -52,6 +54,7 @@ pkgname_libxc=libxc-$(version_libxc) pkgname_lapack=lapack-$(version_lapack) pkgname_blacs=blacs pkgname_scalapack=scalapack-$(version_scalapack) +pkgname_magma=magma-$(version_magma) pkgname_slepc=slepc-$(version_slepc) pkgname_petsc=petsc-$(version_petsc) pkgname_fftw=fftw-$(version_fftw) @@ -70,6 +73,7 @@ tarball_etsf_io=$(pkgname_etsf_io).tar.gz tarball_libxc=$(pkgname_libxc).tar.gz tarball_lapack=v$(version_lapack).tar.gz tarball_scalapack=v$(version_scalapack).tar.gz +tarball_magma=$(pkgname_magma).tar.gz tarball_blacs=$(pkgname_blacs).tar.gz tarball_slepc=slepc-v$(version_slepc).tar.gz tarball_petsc=petsc-v$(version_petsc).tar.gz @@ -99,6 +103,7 @@ url_libxc=https://gitlab.com/libxc/libxc/-/archive/$(version_libxc)/$(tarball_li # External URL's More # url_fftw=https://fftw.org/$(tarball_fftw) +url_magma=https://icl.utk.edu/projectsfiles/magma/downloads/$(tarball_magma) # # Internal URL's # diff --git a/lib/magma/MGmake.inc_lib b/lib/magma/MGmake.inc_lib new file mode 100644 index 0000000000..d1f0d64804 --- /dev/null +++ b/lib/magma/MGmake.inc_lib @@ -0,0 +1,126 @@ +#////////////////////////////////////////////////////////////////////////////// +# -- MAGMA (version 2.8.0) -- +# Univ. of Tennessee, Knoxville +# Univ. of California, Berkeley +# Univ. of Colorado, Denver +# @date March 2024 +#////////////////////////////////////////////////////////////////////////////// + + + +# -------------------- +# configuration + +# should MAGMA be built on CUDA (NVIDIA only) or ROCM (AMD or NVIDIA) +# enter 'cuda' or 'hip' respectively +BACKEND ?= cuda + +# set these to their real paths +CUDADIR ?= $(NVHPC_ROOT)/cuda +ROCM_PATH ?= /opt/rocm + +USE_FORTRAN ?=yes + +# require either hip or cuda +ifeq (,$(findstring $(BACKEND),hip cuda)) + $(error "'BACKEND' should be either 'cuda' or 'hip' (got $(BACKEND))") +endif + +# -------------------- +# programs + +# set compilers +CC ?= gcc +CXX ?= g++ +FORT ?= gfortran +HIPCC ?= hipcc +NVCC ?= nvcc +DEVCC ?= NONE + +# set from 'BACKEND' +ifeq ($(BACKEND),cuda) + DEVCC = $(NVCC) +else ifeq ($(BACKEND),hip) + DEVCC = $(HIPCC) +endif + +# and utilities +ARCH = ar +ARCHFLAGS = cr +RANLIB = ranlib + + +# -------------------- +# flags/settings + +# set our GPU targets +ifeq ($(BACKEND),cuda) + GPU_TARGET = Volta Turing Ampere +else ifeq ($(BACKEND),hip) + GPU_TARGET = gfx900 gfx906 gfx908 +endif + +# Use -fPIC to make shared (.so) and static (.a) library; +# can be commented out if making only static library. +FPIC = -fPIC + +# now, generate our flags +CFLAGS = -O3 $(FPIC) -DNDEBUG -DADD_ -Wall -fopenmp -std=c99 +CXXFLAGS = -O3 $(FPIC) -DNDEBUG -DADD_ -Wall -fopenmp -std=c++11 +FFLAGS = -O3 $(FPIC) -DNDEBUG -DADD_ -Wall -Wno-unused-dummy-argument +F90FLAGS = -O3 $(FPIC) -DNDEBUG -DADD_ -Wall -Wno-unused-dummy-argument -x f95-cpp-input +LDFLAGS = $(FPIC) -fopenmp + +DEVCCFLAGS = -O3 -DNDEBUG -DADD_ + +# DEVCCFLAGS are populated later in `backend-specific` + + +# -------------------- +# libraries + +# gcc with OpenBLAS (includes LAPACK) +LIB += $(lblas) $(llapack) + +# -------------------- +# directories + +# define library directories preferably in your environment, or here. +LIBDIR += -L$(libs_prefix)/$(fc_kind)/${fc}/lib +INC += -I$(libs_prefix)/$(fc_kind)/${fc}/include + + +# -------------------- +# checks + +# check for openblas +#-include make.check-openblas + + +# -------------------- +# backend-specific + +# add appropriate cuda flags +ifeq ($(BACKEND),cuda) + -include make.check-cuda + + DEVCCFLAGS += -Xcompiler "$(FPIC)" -std=c++11 + + # link with cuda specific libraries + INC += -I$(CUDADIR)/include + LIBDIR += -L$(CUDADIR)/lib64 + LIB += -lcublas -lcusparse -lcudart -lcudadevrt +endif + +# add appropriate ROCM flags +ifeq ($(BACKEND),hip) + -include make.check-hip + + DEVCCFLAGS += $(FPIC) -std=c++11 + + INC += -I$(ROCM_PATH)/include + LIBDIR += -L$(ROCM_PATH)/lib + LIB += -lhipblas -lhipsparse +endif + + diff --git a/lib/magma/Makefile.loc b/lib/magma/Makefile.loc new file mode 100644 index 0000000000..78aecaa99d --- /dev/null +++ b/lib/magma/Makefile.loc @@ -0,0 +1,54 @@ +# +#=============================== +# Yambo package +#=============================== +# +include ../../config/setup +include ../archive/package.list +# +LIBNAME=libmagma.a +LIBPATH=$(libs_prefix)/$(fc_kind)/${fc}/ +LIBRARY=$(LIBPATH)/lib/$(LIBNAME) +# +PACKAGE=$(pkgname_magma) +# +include ../config/external_libs_commons.mk +include ../config/external_libs_defs.mk +# +# +all: $(LIBRARY) +# +uncompress: + @$(uncompress) + +configure: uncompress + @if test -d $(PACKAGE) && ! test -f configured.stamp ; then \ + echo "\t[$(PACKAGE)] configuration"; \ + cd $(PACKAGE); \ + cat $(compdir)/config/setup $(srcdir)/lib/magma/MGmake.inc_lib > make.inc ; \ + cp $(srcdir)/lib/magma/Makefile.lib Makefile ; \ + touch ../configured.stamp;\ + fi + +compile: uncompress configure + @$(call compile) + +install: uncompress configure compile + @if ! test -e installed.stamp ; then \ + echo "\t[$(PACKAGE)] installation"; \ + cd $(PACKAGE); cp *.a $(LIBPATH)/lib ; \ + cp include/*.h $(LIBPATH)/include ; \ + cp include/*.mod $(LIBPATH)/include ; \ + touch ../installed.stamp;\ + fi + +$(LIBRARY): uncompress configure compile install +# +# cleaning +# +clean: + @$(call clean_the_lib,clean) + +clean_all: clean + @$(rm_the_lib) +# diff --git a/lib/magma_fmodules/.objects b/lib/magma_fmodules/.objects new file mode 100644 index 0000000000..cfae042a34 --- /dev/null +++ b/lib/magma_fmodules/.objects @@ -0,0 +1,5 @@ +#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 +objs = $(MAGMA_objects) diff --git a/lib/magma_fmodules/mod_magma2.F b/lib/magma_fmodules/mod_magma2.F new file mode 100644 index 0000000000..bcf771ab29 --- /dev/null +++ b/lib/magma_fmodules/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/lib/magma_fmodules/mod_magma2_cfortran.F b/lib/magma_fmodules/mod_magma2_cfortran.F new file mode 100644 index 0000000000..8a25568acf --- /dev/null +++ b/lib/magma_fmodules/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/lib/magma_fmodules/mod_magma2_common.F b/lib/magma_fmodules/mod_magma2_common.F new file mode 100644 index 0000000000..ac18317b87 --- /dev/null +++ b/lib/magma_fmodules/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/lib/magma_fmodules/mod_magma2_dfortran.F b/lib/magma_fmodules/mod_magma2_dfortran.F new file mode 100644 index 0000000000..e85b83b368 --- /dev/null +++ b/lib/magma_fmodules/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/lib/magma_fmodules/mod_magma2_sfortran.F b/lib/magma_fmodules/mod_magma2_sfortran.F new file mode 100644 index 0000000000..b5c45a41c3 --- /dev/null +++ b/lib/magma_fmodules/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/lib/magma_fmodules/mod_magma2_zfortran.F b/lib/magma_fmodules/mod_magma2_zfortran.F new file mode 100644 index 0000000000..8066052bee --- /dev/null +++ b/lib/magma_fmodules/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 diff --git a/lib/qe_pseudo/DOUBLE_project.dep b/lib/qe_pseudo/DOUBLE_project.dep index fbc606fa4d..eb9021637a 100644 --- a/lib/qe_pseudo/DOUBLE_project.dep +++ b/lib/qe_pseudo/DOUBLE_project.dep @@ -39,5 +39,4 @@ us_module.o uspp.o ylmr2.o - objects.o diff --git a/lib/slatec/DOUBLE_project.dep b/lib/slatec/DOUBLE_project.dep index 2049458d1e..b24664a8ce 100644 --- a/lib/slatec/DOUBLE_project.dep +++ b/lib/slatec/DOUBLE_project.dep @@ -1,4 +1,4 @@ - objects.oavint.o + avint.o besi0.o besi0e.o besi1.o diff --git a/sbin/compilation/libraries.sh b/sbin/compilation/libraries.sh index 4d299886e6..e87be8c105 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) \$(lnetcdff) \$(lnetcdf) \$(lhdf5)" lextlibs="\$(llibxc) \$(lfft) \$(lfutile) \$(lyaml) \$(ldevxlib) \$(llapack) \$(lblas) \$(lcudalib)" diff --git a/src/linear_algebra/LINEAR_ALGEBRA_driver.F b/src/linear_algebra/LINEAR_ALGEBRA_driver.F index 7f5153e3bd..7405948b05 100644 --- a/src/linear_algebra/LINEAR_ALGEBRA_driver.F +++ b/src/linear_algebra/LINEAR_ALGEBRA_driver.F @@ -83,7 +83,7 @@ subroutine LINEAR_ALGEBRA_driver(idriver,lib_in,& ! lib_in_use=USE_LK #if defined _SCALAPACK - lib_in_use=USE_SLK + !lib_in_use=USE_SLK #endif if (present(lib_in)) then lib_in_use=lib_in diff --git a/src/linear_algebra/SERIAL_HERMITIAN_diagonalization.F b/src/linear_algebra/SERIAL_HERMITIAN_diagonalization.F index b33bccf04b..b353516d0e 100644 --- a/src/linear_algebra/SERIAL_HERMITIAN_diagonalization.F +++ b/src/linear_algebra/SERIAL_HERMITIAN_diagonalization.F @@ -7,6 +7,7 @@ ! subroutine SERIAL_HERMITIAN_diagonalization(n,M,E) ! + use magma use pars, ONLY:SP use drivers, ONLY:l_nl_optics,l_real_time use linear_algebra, ONLY:LINEAR_ALGEBRA_error,& @@ -19,39 +20,57 @@ subroutine SERIAL_HERMITIAN_diagonalization(n,M,E) real(SP) :: E(n) ! character(64) :: subname="SERIAL_HERMITIAN_diagonalization" - integer :: lwork + integer :: lwork, lrwork, liwork type(LALGEBRA_WS) :: WS ! + ! MAGMA + call magmaf_init() + ! lwork=-1 + lrwork=-1 + liwork=-1 allocate(WS%v_cmplx(1)) + allocate(WS%v_real(1)) + allocate(WS%v_int(1)) ! if(.not.(l_nl_optics.or.l_real_time)) then call timing('SERIAL_HERMITIAN_diagonalization',OPR='start') - YAMBO_ALLOC(WS%v_real,(max(1,3*n-2))) - else - allocate(WS%v_real(max(1,3*n-2))) endif ! + ! Query lwork, lrwork, liwork + ! #if defined _DOUBLE call ZHEEV('V','U',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,WS%i_fail) #else - call CHEEV('V','U',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,WS%i_fail) + call magmaf_cheevd_m(2,'v','u',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,lrwork,WS%v_int,liwork,WS%i_fail) #endif + ! + ! Allocate v_cmplx, v_real, v_int ! lwork=nint(real(WS%v_cmplx(1))) + lrwork=nint(WS%v_real(1)) + liwork=WS%v_int(1) deallocate(WS%v_cmplx) + deallocate(WS%v_real) + deallocate(WS%v_int) ! if(.not.(l_nl_optics.or.l_real_time)) then YAMBO_ALLOC(WS%v_cmplx,(lwork)) + YAMBO_ALLOC(WS%v_real,(lrwork)) + YAMBO_ALLOC(WS%v_int,(liwork)) else allocate(WS%v_cmplx(lwork)) + allocate(WS%v_real(lrwork)) + allocate(WS%v_int(liwork)) endif ! + ! Compute eigenvalues + ! #if defined _DOUBLE call ZHEEV('V','U',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,WS%i_fail) if(WS%i_fail.ne.0) call LINEAR_ALGEBRA_error(subname,'performing ZHEEV') #else - call CHEEV('V','U',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,WS%i_fail) + call magmaf_cheevd_m(2,'v','u',n,M,size(M,1),E,WS%v_cmplx,lwork,WS%v_real,lrwork,WS%v_int,liwork,WS%i_fail) if(WS%i_fail.ne.0) call LINEAR_ALGEBRA_error(subname,'performing CHEEV') #endif ! @@ -61,4 +80,5 @@ subroutine SERIAL_HERMITIAN_diagonalization(n,M,E) call timing('SERIAL_HERMITIAN_diagonalization',OPR='stop') endif ! + call magmaf_finalize() end subroutine diff --git a/src/modules/.objects b/src/modules/.objects index 6857541807..e962a2af5e 100644 --- a/src/modules/.objects +++ b/src/modules/.objects @@ -44,6 +44,7 @@ objs = mod_pars.o mod_units.o mod_lexical_sort.o mod_stderr.o mod_openmp.o mod_m 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 9e7ca9ecaf..ba0f44469a 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 @@ -118,6 +131,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 !============================ @@ -185,14 +207,16 @@ 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 ! subroutine geev(msize,M,E_cmpl,V_left,V_right,work,lwork,rwk,ifail) + ! + use com, ONLY:msg ! integer, intent(in) :: msize,lwork integer, intent(out) :: ifail @@ -200,10 +224,49 @@ 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) then + call msg('sr','Initializing magma library in geev') + call magma_setup() + endif + call msg('sr','SERIAL diagonalization with magma') + ! +# 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) + ! + call msg('sr','SERIAL diagonalization with lapack') + ! + ! 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