pass copied slice to lapack (chol)

2 files changed, 17 insertions, 25 deletions

diff --git a/packages/base/src/Internal/C/lapack-aux.c b/packages/base/src/Internal/C/lapack-aux.c
index baa0570..ab78dac 100644
--- a/packages/base/src/Internal/C/lapack-aux.c
+++ b/packages/base/src/Internal/C/lapack-aux.c
@@ -39,7 +39,7 @@ typedef float  complex TCF;
 // #endif
 
 
-// printf("%dx%d %d:%d\n",ar,ac,aXr,aXc);
+#define INFOMAT(M) printf("%dx%d %d:%d\n",M##r,M##c,M##Xr,M##Xc);
 
 #define TRACEMAT(M) {int q; printf(" %d x %d: ",M##r,M##c); \
                      for(q=0;q<M##r*M##c;q++) printf("%.1f ",M##p[q]); printf("\n");}
@@ -857,14 +857,12 @@ int linearSolveSVDC_l(double rcond, KOCMAT(a),KOCMAT(b),OCMAT(x)) {
 
 //////////////////// Cholesky factorization /////////////////////////
 
-/* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a,
-        integer *lda, integer *info);
+int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *info);
 
-int chol_l_H(KOCMAT(a),OCMAT(l)) {
-    integer n = ar;
-    REQUIRES(n>=1 && ac == n && lr==n && lc==n,BAD_SIZE);
+int chol_l_H(OCMAT(l)) {
+    integer n = lr;
+    REQUIRES(n>=1 && lc == n,BAD_SIZE);
     DEBUGMSG("chol_l_H");
-    memcpy(lp,ap,n*n*sizeof(doublecomplex));
     char uplo = 'U';
     integer res;
     zpotrf_ (&uplo,&n,lp,&n,&res);
@@ -881,14 +879,12 @@ int chol_l_H(KOCMAT(a),OCMAT(l)) {
 }
 
 
-/* Subroutine */ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *
-        lda, integer *info);
+int dpotrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info);
 
-int chol_l_S(KODMAT(a),ODMAT(l)) {
-    integer n = ar;
-    REQUIRES(n>=1 && ac == n && lr==n && lc==n,BAD_SIZE);
+int chol_l_S(ODMAT(l)) {
+    integer n = lr;
+    REQUIRES(n>=1 && lc == n,BAD_SIZE);
     DEBUGMSG("chol_l_S");
-    memcpy(lp,ap,n*n*sizeof(double));
     char uplo = 'U';
     integer res;
     dpotrf_ (&uplo,&n,lp,&n,&res);
diff --git a/packages/base/src/Internal/LAPACK.hs b/packages/base/src/Internal/LAPACK.hs
index 2c7148b..ce00c16 100644
--- a/packages/base/src/Internal/LAPACK.hs
+++ b/packages/base/src/Internal/LAPACK.hs
@@ -427,33 +427,29 @@ linearSolveSVDC Nothing a b = linearSolveSVDC (Just (-1)) (fmat a) (fmat b)
 
 -----------------------------------------------------------------------------------
 
-type TMM t = t ::> t ::> Ok
-
-foreign import ccall unsafe "chol_l_H" zpotrf :: TMM C
-foreign import ccall unsafe "chol_l_S" dpotrf :: TMM R
+foreign import ccall unsafe "chol_l_H" zpotrf :: C ::> Ok
+foreign import ccall unsafe "chol_l_S" dpotrf :: R ::> Ok
 
 cholAux f st a = do
-    r <- createMatrix ColumnMajor n n
-    f # a # r #| st
+    r <- copy ColumnMajor a
+    f # r #| st
     return r
-  where
-    n = rows a
 
 -- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/.
 cholH :: Matrix (Complex Double) -> Matrix (Complex Double)
-cholH = unsafePerformIO . cholAux zpotrf "cholH" . fmat
+cholH = unsafePerformIO . cholAux zpotrf "cholH"
 
 -- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/.
 cholS :: Matrix Double -> Matrix Double
-cholS =  unsafePerformIO . cholAux dpotrf "cholS" . fmat
+cholS =  unsafePerformIO . cholAux dpotrf "cholS"
 
 -- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/ ('Maybe' version).
 mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double))
-mbCholH = unsafePerformIO . mbCatch . cholAux zpotrf "cholH" . fmat
+mbCholH = unsafePerformIO . mbCatch . cholAux zpotrf "cholH"
 
 -- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/  ('Maybe' version).
 mbCholS :: Matrix Double -> Maybe (Matrix Double)
-mbCholS =  unsafePerformIO . mbCatch . cholAux dpotrf "cholS" . fmat
+mbCholS =  unsafePerformIO . mbCatch . cholAux dpotrf "cholS"
 
 -----------------------------------------------------------------------------------