Merge pull request #61 from aoymt/fix_ilaenv

fix call to lapack ilaenv

config/gcc.cmake

@@ -3,4 +3,5 @@ set(CMAKE_C_COMPILER "gcc" CACHE STRING "" FORCE)
 set(CMAKE_CXX_COMPILER "g++" CACHE STRING "" FORCE)
 set(CMAKE_C_FLAGS_DEBUG "-g -O0 -Wall  -Wformat -Werror=format-security")
 set(CMAKE_C_FLAGS_RELEASE "-O3 -Wno-unknown-pragmas ")
+set(CMAKE_CXX_FLAGS_RELEASE "-O3 -Wno-unknown-pragmas ")
 set(CMAKE_Fortran_COMPILER "gfortran" CACHE STRING "" FORCE)

src/ltl2inv/CMakeLists.txt

@@ -11,6 +11,6 @@ endif()
 include_directories(../common)
 
 # TODO: Move blalink_gemmt.c to other subprojects?
-add_library(ltl2inv STATIC ltl2inv.cc blalink_gemmt.c ilaenv_lauum.cc)
+add_library(ltl2inv STATIC ltl2inv.cc blalink_gemmt.c ilaenv_lauum.cc ilaenv_wrap.f90)
 target_compile_definitions(ltl2inv PRIVATE -D_CC_IMPL)
 

src/ltl2inv/ilaenv.h

@@ -8,7 +8,10 @@
 extern "C" {
 #endif
 
+/*
 int ilaenv_(const int *ispec, const char *name, const char *opts, const int *n1, const int *n2, const int *n3, const int *n4);
+*/
+int ilaenv_wrap(int ispec, const char *name, const char *opts, int n1, int n2, int n3, int n4);
 
 #ifdef __cplusplus
 }

src/ltl2inv/ilaenv_lauum.cc

@@ -7,6 +7,16 @@
 #include "ilaenv.h"
 #include "ilaenv_lauum.hh"
 
+/*
+ * sloppy version exploits that 
+ * ILAENV(ispec=1, xLAUUM, "", dummy, dummy, dummy, dummy)
+ * returns 64 for x=S,D,C,Z .
+ */
+
+#undef SLOPPY_ILAENV
+// #define SLOPPY_ILAENV
+
+/*
 #define EXPANDMAC(cctype, name) \
 template <> int ilaenv_lauum<cctype>(uplo_t uplo, int n) \
 { \
@@ -15,6 +25,25 @@ template <> int ilaenv_lauum<cctype>(uplo_t uplo, int n) \
     int dummy = 0; \
     return ilaenv_(&ispec, #name, &uplo_, &n, &dummy, &dummy, &dummy); \
 }
+*/
+
+#ifndef SLOPPY_ILAENV
+#define EXPANDMAC(cctype, name) \
+template <> int ilaenv_lauum<cctype>(uplo_t uplo, int n) \
+{ \
+    char uplo_ = uplo2char(uplo); \
+    int ispec = 1; \
+    int dummy = -1; \
+    return ilaenv_wrap(ispec, #name, &uplo_, n, dummy, dummy, dummy); \
+}
+#else
+#define EXPANDMAC(cctype, name) \
+template <> int ilaenv_lauum<cctype>(uplo_t uplo, int n) \
+{ \
+    return 64; \
+}
+#endif
+
 EXPANDMAC( float,    SLAUUM )
 EXPANDMAC( double,   DLAUUM )
 EXPANDMAC( ccscmplx, CLAUUM )

src/ltl2inv/ilaenv_wrap.f90

@@ -0,0 +1,37 @@
+module wrapper
+  use, intrinsic :: iso_c_binding
+  implicit none
+contains
+  function c_charptr_to_f_charptr(ccp) result(result)
+    type(c_ptr),intent(in),value :: ccp
+    character(:,c_char),pointer :: result
+    interface
+       function strlen(p) bind(c)
+         import c_ptr, c_size_t
+         type(c_ptr),value :: p
+         integer(c_size_t) strlen
+       end function strlen
+    end interface
+    result => convert_cptr(ccp,strlen(ccp))
+  contains
+    function convert_cptr(p, len)
+      type(c_ptr),intent(in) :: p
+      integer(c_size_t),intent(in) :: len
+      character(len, c_char),pointer :: convert_cptr
+      call c_f_pointer(p, convert_cptr)
+    end function convert_cptr
+  end function c_charptr_to_f_charptr
+
+  integer function ilaenv_wrap(ispec, name, opts, n1, n2, n3, n4) bind(c, name="ilaenv_wrap")
+    implicit none
+    integer,intent(in),value :: ispec, n1, n2, n3, n4
+    type(c_ptr),intent(in),value :: name, opts
+    character(:,c_char),pointer :: namef, optsf
+    integer ilaenv
+
+    namef => c_charptr_to_f_charptr(name)
+    optsf => c_charptr_to_f_charptr(opts)
+
+    ilaenv_wrap = ILAENV(ispec, namef, optsf, n1, n2, n3, n4)
+  end function ilaenv_wrap
+end module wrapper