diff options
Diffstat (limited to 'packages')
-rw-r--r-- | packages/base/src/Internal/C/lapack-aux.c | 22 | ||||
-rw-r--r-- | packages/base/src/Internal/LAPACK.hs | 20 |
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, | 860 | int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *info); |
861 | integer *lda, integer *info); | ||
862 | 861 | ||
863 | int chol_l_H(KOCMAT(a),OCMAT(l)) { | 862 | int 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 * | 882 | int dpotrf_(char *uplo, integer *n, doublereal *a, integer * lda, integer *info); |
885 | lda, integer *info); | ||
886 | 883 | ||
887 | int chol_l_S(KODMAT(a),ODMAT(l)) { | 884 | int 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 | ||
430 | type TMM t = t ::> t ::> Ok | 430 | foreign import ccall unsafe "chol_l_H" zpotrf :: C ::> Ok |
431 | 431 | foreign import ccall unsafe "chol_l_S" dpotrf :: R ::> Ok | |
432 | foreign import ccall unsafe "chol_l_H" zpotrf :: TMM C | ||
433 | foreign import ccall unsafe "chol_l_S" dpotrf :: TMM R | ||
434 | 432 | ||
435 | cholAux f st a = do | 433 | cholAux 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/. |
443 | cholH :: Matrix (Complex Double) -> Matrix (Complex Double) | 439 | cholH :: Matrix (Complex Double) -> Matrix (Complex Double) |
444 | cholH = unsafePerformIO . cholAux zpotrf "cholH" . fmat | 440 | cholH = 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/. |
447 | cholS :: Matrix Double -> Matrix Double | 443 | cholS :: Matrix Double -> Matrix Double |
448 | cholS = unsafePerformIO . cholAux dpotrf "cholS" . fmat | 444 | cholS = 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). |
451 | mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double)) | 447 | mbCholH :: Matrix (Complex Double) -> Maybe (Matrix (Complex Double)) |
452 | mbCholH = unsafePerformIO . mbCatch . cholAux zpotrf "cholH" . fmat | 448 | mbCholH = 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). |
455 | mbCholS :: Matrix Double -> Maybe (Matrix Double) | 451 | mbCholS :: Matrix Double -> Maybe (Matrix Double) |
456 | mbCholS = unsafePerformIO . mbCatch . cholAux dpotrf "cholS" . fmat | 452 | mbCholS = unsafePerformIO . mbCatch . cholAux dpotrf "cholS" |
457 | 453 | ||
458 | ----------------------------------------------------------------------------------- | 454 | ----------------------------------------------------------------------------------- |
459 | 455 | ||