summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Internal')
-rw-r--r--packages/base/src/Internal/C/lapack-aux.c22
-rw-r--r--packages/base/src/Internal/LAPACK.hs20
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;
39// #endif 39// #endif
40 40
41 41
42// printf("%dx%d %d:%d\n",ar,ac,aXr,aXc); 42#define INFOMAT(M) printf("%dx%d %d:%d\n",M##r,M##c,M##Xr,M##Xc);
43 43
44#define TRACEMAT(M) {int q; printf(" %d x %d: ",M##r,M##c); \ 44#define TRACEMAT(M) {int q; printf(" %d x %d: ",M##r,M##c); \
45 for(q=0;q<M##r*M##c;q++) printf("%.1f ",M##p[q]); printf("\n");} 45 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)) {
857 857
858//////////////////// Cholesky factorization ///////////////////////// 858//////////////////// Cholesky factorization /////////////////////////
859 859
860/* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a, 860int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *info);
861 integer *lda, integer *info);
862 861
863int chol_l_H(KOCMAT(a),OCMAT(l)) { 862int chol_l_H(OCMAT(l)) {
864 integer n = ar; 863 integer n = lr;
865 REQUIRES(n>=1 && ac == n && lr==n && lc==n,BAD_SIZE); 864 REQUIRES(n>=1 && lc == n,BAD_SIZE);
866 DEBUGMSG("chol_l_H"); 865 DEBUGMSG("chol_l_H");
867 memcpy(lp,ap,n*n*sizeof(doublecomplex));
868 char uplo = 'U'; 866 char uplo = 'U';
869 integer res; 867 integer res;
870 zpotrf_ (&uplo,&n,lp,&n,&res); 868 zpotrf_ (&uplo,&n,lp,&n,&res);
@@ -881,14 +879,12 @@ int chol_l_H(KOCMAT(a),OCMAT(l)) {
881} 879}
882 880
883 881
884/* Subroutine */ int dpotrf_(char *uplo, integer *n, doublereal *a, integer * 882int dpotrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info);
885 lda, integer *info);
886 883
887int chol_l_S(KODMAT(a),ODMAT(l)) { 884int chol_l_S(ODMAT(l)) {
888 integer n = ar; 885 integer n = lr;
889 REQUIRES(n>=1 && ac == n && lr==n && lc==n,BAD_SIZE); 886 REQUIRES(n>=1 && lc == n,BAD_SIZE);
890 DEBUGMSG("chol_l_S"); 887 DEBUGMSG("chol_l_S");
891 memcpy(lp,ap,n*n*sizeof(double));
892 char uplo = 'U'; 888 char uplo = 'U';
893 integer res; 889 integer res;
894 dpotrf_ (&uplo,&n,lp,&n,&res); 890 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)
427 427
428----------------------------------------------------------------------------------- 428-----------------------------------------------------------------------------------
429 429
430type TMM t = t ::> t ::> Ok 430foreign import ccall unsafe "chol_l_H" zpotrf :: C ::> Ok
431 431foreign import ccall unsafe "chol_l_S" dpotrf :: R ::> Ok
432foreign import ccall unsafe "chol_l_H" zpotrf :: TMM C
433foreign import ccall unsafe "chol_l_S" dpotrf :: TMM R
434 432
435cholAux f st a = do 433cholAux f st a = do
436 r <- createMatrix ColumnMajor n n 434 r <- copy ColumnMajor a
437 f # a # r #| st 435 f # r #| st
438 return r 436 return r
439 where
440 n = rows a
441 437
442-- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/. 438-- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/.
443cholH :: Matrix (Complex Double) -> Matrix (Complex Double) 439cholH :: Matrix (Complex Double) -> Matrix (Complex Double)
444cholH = unsafePerformIO . cholAux zpotrf "cholH" . fmat 440cholH = unsafePerformIO . cholAux zpotrf "cholH"
445 441
446-- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/. 442-- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/.
447cholS :: Matrix Double -> Matrix Double 443cholS :: Matrix Double -> Matrix Double
448cholS = unsafePerformIO . cholAux dpotrf "cholS" . fmat 444cholS = unsafePerformIO . cholAux dpotrf "cholS"
449 445
450-- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/ ('Maybe' version). 446-- | Cholesky factorization of a complex Hermitian positive definite matrix, using LAPACK's /zpotrf/ ('Maybe' version).
451mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double)) 447mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double))
452mbCholH = unsafePerformIO . mbCatch . cholAux zpotrf "cholH" . fmat 448mbCholH = unsafePerformIO . mbCatch . cholAux zpotrf "cholH"
453 449
454-- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/ ('Maybe' version). 450-- | Cholesky factorization of a real symmetric positive definite matrix, using LAPACK's /dpotrf/ ('Maybe' version).
455mbCholS :: Matrix Double -> Maybe (Matrix Double) 451mbCholS :: Matrix Double -> Maybe (Matrix Double)
456mbCholS = unsafePerformIO . mbCatch . cholAux dpotrf "cholS" . fmat 452mbCholS = unsafePerformIO . mbCatch . cholAux dpotrf "cholS"
457 453
458----------------------------------------------------------------------------------- 454-----------------------------------------------------------------------------------
459 455