From 4d96b90c4cfd38cdb51f3dc66a8a644bd87cdbff Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Sat, 27 Jun 2015 09:15:27 +0200 Subject: use slice interface for lapack funcs (wip) --- packages/base/src/Internal/C/lapack-aux.c | 95 ++++++++++++++++--------------- packages/base/src/Internal/C/lapack-aux.h | 32 +++++------ 2 files changed, 64 insertions(+), 63 deletions(-) (limited to 'packages/base/src/Internal/C') diff --git a/packages/base/src/Internal/C/lapack-aux.c b/packages/base/src/Internal/C/lapack-aux.c index cdbaab9..baa0570 100644 --- a/packages/base/src/Internal/C/lapack-aux.c +++ b/packages/base/src/Internal/C/lapack-aux.c @@ -38,6 +38,9 @@ typedef float complex TCF; // #define OK return 0; // #endif + +// printf("%dx%d %d:%d\n",ar,ac,aXr,aXc); + #define TRACEMAT(M) {int q; printf(" %d x %d: ",M##r,M##c); \ for(q=0;q=1 && ar==ac && ar==br,BAD_SIZE); @@ -571,7 +572,7 @@ int linearSolveR_l(KDMAT(a),KDMAT(b),DMAT(x)) { integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer * info); -int linearSolveC_l(KCMAT(a),KCMAT(b),CMAT(x)) { +int linearSolveC_l(KOCMAT(a),KOCMAT(b),OCMAT(x)) { integer n = ar; integer nhrs = bc; REQUIRES(n>=1 && ar==ac && ar==br,BAD_SIZE); @@ -601,7 +602,7 @@ int linearSolveC_l(KCMAT(a),KCMAT(b),CMAT(x)) { doublereal *a, integer *lda, doublereal *b, integer *ldb, integer * info); -int cholSolveR_l(KDMAT(a),KDMAT(b),DMAT(x)) { +int cholSolveR_l(KODMAT(a),KODMAT(b),ODMAT(x)) { integer n = ar; integer nhrs = bc; REQUIRES(n>=1 && ar==ac && ar==br,BAD_SIZE); @@ -623,7 +624,7 @@ int cholSolveR_l(KDMAT(a),KDMAT(b),DMAT(x)) { doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, integer *info); -int cholSolveC_l(KCMAT(a),KCMAT(b),CMAT(x)) { +int cholSolveC_l(KOCMAT(a),KOCMAT(b),OCMAT(x)) { integer n = ar; integer nhrs = bc; REQUIRES(n>=1 && ar==ac && ar==br,BAD_SIZE); @@ -645,7 +646,7 @@ int cholSolveC_l(KCMAT(a),KCMAT(b),CMAT(x)) { nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *work, integer *lwork, integer *info); -int linearSolveLSR_l(KDMAT(a),KDMAT(b),DMAT(x)) { +int linearSolveLSR_l(KODMAT(a),KODMAT(b),ODMAT(x)) { integer m = ar; integer n = ac; integer nrhs = bc; @@ -693,7 +694,7 @@ int linearSolveLSR_l(KDMAT(a),KDMAT(b),DMAT(x)) { nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, doublecomplex *work, integer *lwork, integer *info); -int linearSolveLSC_l(KCMAT(a),KCMAT(b),CMAT(x)) { +int linearSolveLSC_l(KOCMAT(a),KOCMAT(b),OCMAT(x)) { integer m = ar; integer n = ac; integer nrhs = bc; @@ -742,7 +743,7 @@ int linearSolveLSC_l(KCMAT(a),KCMAT(b),CMAT(x)) { s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork, integer *info); -int linearSolveSVDR_l(double rcond,KDMAT(a),KDMAT(b),DMAT(x)) { +int linearSolveSVDR_l(double rcond,KODMAT(a),KODMAT(b),ODMAT(x)) { integer m = ar; integer n = ac; integer nrhs = bc; @@ -801,7 +802,7 @@ int zgelss_(integer *m, integer *n, integer *nhrs, doublecomplex *work, integer* lwork, doublereal* rwork, integer *info); -int linearSolveSVDC_l(double rcond, KCMAT(a),KCMAT(b),CMAT(x)) { +int linearSolveSVDC_l(double rcond, KOCMAT(a),KOCMAT(b),OCMAT(x)) { integer m = ar; integer n = ac; integer nrhs = bc; @@ -859,7 +860,7 @@ int linearSolveSVDC_l(double rcond, KCMAT(a),KCMAT(b),CMAT(x)) { /* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a, integer *lda, integer *info); -int chol_l_H(KCMAT(a),CMAT(l)) { +int chol_l_H(KOCMAT(a),OCMAT(l)) { integer n = ar; REQUIRES(n>=1 && ac == n && lr==n && lc==n,BAD_SIZE); DEBUGMSG("chol_l_H"); @@ -871,9 +872,9 @@ int chol_l_H(KCMAT(a),CMAT(l)) { CHECK(res,res); doublecomplex zero = {0.,0.}; int r,c; - for (r=0; r=1 && ac == n && lr==n && lc==n,BAD_SIZE); DEBUGMSG("chol_l_S"); @@ -894,9 +895,9 @@ int chol_l_S(KDMAT(a),DMAT(l)) { CHECK(res>0,NODEFPOS); CHECK(res,res); int r,c; - for (r=0; r=1 && n==m && ur==n && uc==n && sr==n && sc==n, BAD_SIZE); @@ -1077,7 +1078,7 @@ int schur_l_R(KDMAT(a), DMAT(u), DMAT(s)) { doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork, doublereal *rwork, logical *bwork, integer *info); -int schur_l_C(KCMAT(a), CMAT(u), CMAT(s)) { +int schur_l_C(KOCMAT(a), OCMAT(u), OCMAT(s)) { integer m = ar; integer n = ac; REQUIRES(m>=1 && n==m && ur==n && uc==n && sr==n && sc==n, BAD_SIZE); @@ -1109,7 +1110,7 @@ int schur_l_C(KCMAT(a), CMAT(u), CMAT(s)) { /* Subroutine */ int dgetrf_(integer *m, integer *n, doublereal *a, integer * lda, integer *ipiv, integer *info); -int lu_l_R(KDMAT(a), DVEC(ipiv), DMAT(r)) { +int lu_l_R(KODMAT(a), DVEC(ipiv), ODMAT(r)) { integer m = ar; integer n = ac; integer mn = MIN(m,n); @@ -1135,7 +1136,7 @@ int lu_l_R(KDMAT(a), DVEC(ipiv), DMAT(r)) { /* Subroutine */ int zgetrf_(integer *m, integer *n, doublecomplex *a, integer *lda, integer *ipiv, integer *info); -int lu_l_C(KCMAT(a), DVEC(ipiv), CMAT(r)) { +int lu_l_C(KOCMAT(a), DVEC(ipiv), OCMAT(r)) { integer m = ar; integer n = ac; integer mn = MIN(m,n); @@ -1164,7 +1165,7 @@ int lu_l_C(KCMAT(a), DVEC(ipiv), CMAT(r)) { doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer * ldb, integer *info); -int luS_l_R(KDMAT(a), KDVEC(ipiv), KDMAT(b), DMAT(x)) { +int luS_l_R(KODMAT(a), KDVEC(ipiv), KODMAT(b), ODMAT(x)) { integer m = ar; integer n = ac; integer mrhs = br; @@ -1189,7 +1190,7 @@ int luS_l_R(KDMAT(a), KDVEC(ipiv), KDMAT(b), DMAT(x)) { doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *info); -int luS_l_C(KCMAT(a), KDVEC(ipiv), KCMAT(b), CMAT(x)) { +int luS_l_C(KOCMAT(a), KDVEC(ipiv), KOCMAT(b), OCMAT(x)) { integer m = ar; integer n = ac; integer mrhs = br; @@ -1215,7 +1216,7 @@ void dgemm_(char *, char *, integer *, integer *, integer *, double *, const double *, integer *, const double *, integer *, double *, double *, integer *); -int multiplyR(int ta, int tb, KDMAT(a),KDMAT(b),DMAT(r)) { +int multiplyR(int ta, int tb, KODMAT(a),KODMAT(b),ODMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("dgemm_"); CHECKNANR(a,"NaN multR Input\n") @@ -1237,7 +1238,7 @@ void zgemm_(char *, char *, integer *, integer *, integer *, doublecomplex *, const doublecomplex *, integer *, const doublecomplex *, integer *, doublecomplex *, doublecomplex *, integer *); -int multiplyC(int ta, int tb, KCMAT(a),KCMAT(b),CMAT(r)) { +int multiplyC(int ta, int tb, KOCMAT(a),KOCMAT(b),OCMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("zgemm_"); CHECKNANC(a,"NaN multC Input\n") @@ -1262,7 +1263,7 @@ void sgemm_(char *, char *, integer *, integer *, integer *, float *, const float *, integer *, const float *, integer *, float *, float *, integer *); -int multiplyF(int ta, int tb, KFMAT(a),KFMAT(b),FMAT(r)) { +int multiplyF(int ta, int tb, KOFMAT(a),KOFMAT(b),OFMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("sgemm_"); integer m = ta?ac:ar; @@ -1281,7 +1282,7 @@ void cgemm_(char *, char *, integer *, integer *, integer *, complex *, const complex *, integer *, const complex *, integer *, complex *, complex *, integer *); -int multiplyQ(int ta, int tb, KQMAT(a),KQMAT(b),QMAT(r)) { +int multiplyQ(int ta, int tb, KOQMAT(a),KOQMAT(b),OQMAT(r)) { //REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); DEBUGMSG("cgemm_"); integer m = ta?ac:ar; @@ -1564,13 +1565,13 @@ int remapQ(KOIMAT(i), KOIMAT(j), KOQMAT(m), OQMAT(r)) { //////////////////////////////////////////////////////////////////////////////// -int saveMatrix(char * file, char * format, KDMAT(a)){ +int saveMatrix(char * file, char * format, KODMAT(a)){ FILE * fp; fp = fopen (file, "w"); int r, c; for (r=0;r