[Getfem-commits] [getfem-commits] branch master updated: Fix regression from previous commit due to incompatible ABI between GNU and Intel BLAS

[Konstantinos Poulios]

This is an automated email from the git hooks/post-receive script.

logari81 pushed a commit to branch master
in repository getfem.

The following commit(s) were added to refs/heads/master by this push:
     new 17dd4ee3 Fix regression from previous commit due to incompatible ABI 
between GNU and Intel BLAS
17dd4ee3 is described below

commit 17dd4ee38d0878f3c2451f355b2c1f8e8b88f278
Author: Konstantinos Poulios <logari81@gmail.com>
AuthorDate: Tue Mar 26 12:46:29 2024 +0100

    Fix regression from previous commit due to incompatible ABI between GNU and 
Intel BLAS
    
      - autoconf detects if BLAS fortran functions return complex reals by
        value or as argument, and sets the GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT
        macro if necessary
      - detection in CMake still needs to be implemented, until then the user
        has to define GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT at configure time
        manually, if necessary
      - BLAS ABI should not be changed after gmm has been configured, if the
        user wants to switch to a BLAS with a different ABI nevertheless,
        the only option is to edit the gmm_arch_config.h file manually
---
 cmake/gmm_arch_config.h.in   |  3 +++
 configure.ac                 | 26 ++++++++++++++++++++++++++
 src/gmm/gmm_arch_config.h.in |  3 +++
 src/gmm/gmm_blas_interface.h | 15 +++++++++++----
 4 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/cmake/gmm_arch_config.h.in b/cmake/gmm_arch_config.h.in
index 50f47daa..dff9b566 100644
--- a/cmake/gmm_arch_config.h.in
+++ b/cmake/gmm_arch_config.h.in
@@ -22,5 +22,8 @@
 /* Use blas with 64 bits integers */
 #cmakedefine GMM_USE_BLAS64_INTERFACE
 
+/* defined if the BLAS fortran ABI does not return complex values directly 
(e.g. Intel's MKL) */
+#cmakedefine GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT
+
 /* GMM version */
 #define GMM_VERSION "@GMM_VERSION@"
diff --git a/configure.ac b/configure.ac
index 6f7d6c82..ea077f22 100644
--- a/configure.ac
+++ b/configure.ac
@@ -688,6 +688,32 @@ if test x$useblas64support = xYES; then
   AC_DEFINE(GMM_USE_BLAS64_INTERFACE,,[Use blas with 64 bits integers])
 fi
 
+# check fortran ABI with regard to complex function in BLAS
+# by defult assume a fortran ABI where complex real/double functions return by 
value
+  AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <complex>
+#if defined(GMM_USE_BLAS64_INTERFACE)
+  #define INT long
+#else
+  #define INT int
+#endif
+extern "C" {
+void cdotu_(std::complex<float>*, const INT*, const std::complex<float>*, 
const INT*,
+            const std::complex<float>*, const INT*);
+}
+int main() {
+    const INT one=1;
+    std::complex<float> x(1.,2.), y(1.,-2.), result;
+    cdotu_(&result, &one, &x, &one, &y, &one);
+    return (fabs(result.real()-5.) < 1e-8) ? 0 : 1;
+}
+  ]])],[ acx_blas_fortan_abi=Intel ], [ acx_blas_fortan_abi=GNU ], [])
+
+if test x$acx_blas_fortan_abi = xIntel; then
+  echo "BLAS found to have the Intel fortran ABI, i.e. returning complex 
function value by argument";
+  AC_DEFINE(GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT,,[defined if the BLAS fortran 
ABI does not return complex values directly (e.g. Intel's MKL)])
+fi
+
 dnl ------------------------------LAPACK TEST--------------------------------
 
 if test x"$acx_blas_ok" = xyes; then
diff --git a/src/gmm/gmm_arch_config.h.in b/src/gmm/gmm_arch_config.h.in
index 0d46b9ab..ed5bb8fa 100644
--- a/src/gmm/gmm_arch_config.h.in
+++ b/src/gmm/gmm_arch_config.h.in
@@ -21,5 +21,8 @@
 /* Use blas with 64 bits integers */
 #undef GMM_USE_BLAS64_INTERFACE
 
+/* defined if the BLAS fortran ABI does not return complex values directly 
(e.g. Intel's MKL) */
+#undef GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT
+
 /* GMM version */
 #undef GMM_VERSION
diff --git a/src/gmm/gmm_blas_interface.h b/src/gmm/gmm_blas_interface.h
index 44f99ae3..cab18d7d 100644
--- a/src/gmm/gmm_blas_interface.h
+++ b/src/gmm/gmm_blas_interface.h
@@ -152,6 +152,13 @@ namespace gmm {
 # define BLAS_C std::complex<float>
 # define BLAS_Z std::complex<double>
 
+// Hack due to BLAS ABI mess
+#if defined(GMM_BLAS_RETURN_COMPLEX_AS_ARGUMENT)
+# define BLAS_CPLX_FUNC_CALL(blasname, res, ...) blasname(&res, __VA_ARGS__)
+#else
+# define BLAS_CPLX_FUNC_CALL(blasname, res, ...) res = blasname(__VA_ARGS__)
+#endif
+
   /* ********************************************************************* */
   /* BLAS functions used.                                                  */
   /* ********************************************************************* */
@@ -252,7 +259,7 @@ namespace gmm {
     GMMLAPACK_TRACE(msg);                                                  \
     base_type res;                                                         \
     BLAS_INT inc(1), n(BLAS_INT(vect_size(y)));                            \
-    blas_name(&res, &n, &y[0], &inc, &x[0], &inc);                         \
+    BLAS_CPLX_FUNC_CALL(blas_name, res, &n, &y[0], &inc, &x[0], &inc);     \
     return res;                                                            \
   }                                                                        \
   inline base_type funcname                                                \
@@ -262,7 +269,7 @@ namespace gmm {
     const std::vector<base_type> &x = *(linalg_origin(x_));                \
     base_type res, a(x_.r);                                                \
     BLAS_INT inc(1), n(BLAS_INT(vect_size(y)));                            \
-    blas_name(&res, &n, &y[0], &inc, &x[0], &inc);                         \
+    BLAS_CPLX_FUNC_CALL(blas_name, res, &n, &y[0], &inc, &x[0], &inc);     \
     return a*res;                                                          \
   }                                                                        \
   inline base_type funcname                                                \
@@ -272,7 +279,7 @@ namespace gmm {
     const std::vector<base_type> &y = *(linalg_origin(y_));                \
     base_type res, b(bdef);                                                \
     BLAS_INT inc(1), n(BLAS_INT(vect_size(y)));                            \
-    blas_name(&res, &n, &y[0], &inc, &x[0], &inc);                         \
+    BLAS_CPLX_FUNC_CALL(blas_name, res, &n, &y[0], &inc, &x[0], &inc);     \
     return b*res;                                                          \
   }                                                                        \
   inline base_type funcname                                                \
@@ -283,7 +290,7 @@ namespace gmm {
     const std::vector<base_type> &y = *(linalg_origin(y_));                \
     base_type res, a(x_.r), b(bdef);                                       \
     BLAS_INT inc(1), n(BLAS_INT(vect_size(y)));                            \
-    blas_name(&res, &n, &y[0], &inc, &x[0], &inc);                         \
+    BLAS_CPLX_FUNC_CALL(blas_name, res, &n, &y[0], &inc, &x[0], &inc);     \
     return a*b*res;                                                        \
   }