diff --git a/nonclass.cc b/nonclass.cc index e479412..e004de6 100644 --- a/nonclass.cc +++ b/nonclass.cc @@ -266,60 +266,77 @@ linear_solve_do(a,&B[0],1,a.nrows(),det,n); // Roman, complex version of linear_solve() -extern "C" void FORNAME(zgesv)(const int *N, const int *NRHS, double *A, const int *LDA, - int *IPIV, double *B, const int *LDB, int *INFO); +extern "C" void FORNAME(zgesv)(const FINT *N, const FINT *NRHS, std::complex *A, const FINT *LDA, + FINT *IPIV, std::complex *B, const FINT *LDB, FINT *INFO); -void linear_solve(NRMat< std::complex > &A, NRMat< std::complex > *B, std::complex *det, int n) +// A will be overwritten, B will contain the solutions, A is nxn, B is rhs x n +// Fortran zgesv sees the row-major A transposed, so A is transposed in place before and after, like in clapack_dgesv in noncblas.cc +static void linear_solve_do(NRMat > &A, std::complex *B, const int nrhs, const int ldb, std::complex *det, int n) { - int r, *ipiv; + FINT r, *ipiv; int iswap=0; - if (A.nrows() != A.ncols()) laerror("linear_solve() call for non-square matrix"); - if (B && A.nrows() != B->ncols()) laerror("incompatible matrices in linear_solve()"); - A.copyonwrite(); - if (B) B->copyonwrite(); - ipiv = new int[A.nrows()]; - n = A.nrows(); - int nrhs = B ? B->nrows() : 0; - int lda = A.ncols(); - int ldb = B ? B->ncols() : A.nrows(); - FORNAME(zgesv)(&n, &nrhs, (double *)A[0], &lda, ipiv, - B ? (double *)(*B)[0] : (double *)0, &ldb, &r); - if (r < 0) { - delete[] ipiv; - laerror("illegal argument in lapack_gesv"); - } - if (det && r==0) { - *det = A[0][0]; - for (int i=1; i *a= &A(0,0); + for(int i=1; i t=a[j*lda+i]; a[j*lda+i]=a[i*lda+j]; a[i*lda+j]=t;} + const FINT ntmp=n; + const FINT nrhstmp=nrhs; + const FINT ldatmp=lda; + const FINT ldbtmp=ldb; + FORNAME(zgesv)(&ntmp, &nrhstmp, a, &ldatmp, ipiv, B, &ldbtmp, &r); + for(int i=1; i t=a[j*lda+i]; a[j*lda+i]=a[i*lda+j]; a[i*lda+j]=t;} + if (r < 0) { + delete[] ipiv; + laerror("illegal argument in lapack_gesv"); + } + if (det && r==0) { + *det = 1.; + //take into account some numerical instabilities in zgesv for singular matrices + for (int i=0; i t=A[i][i]; if(!std::isfinite(t.real()) || !std::isfinite(t.imag()) || std::abs(t) < EPSDET ) {*det=0.; break;} else *det *=t;} + //find out whether ipiv are numbered from 0 or from 1 int shift=1; - for (int i=0; in) - { - std::cout <<"IPIV["<n) + { + std::cout <<"IPIV["<0 && B) laerror("singular matrix in zgesv"); + delete [] ipiv; + if (r>0 && B) laerror("singular matrix in zgesv"); +} + +void linear_solve(NRMat< std::complex > &A, NRMat< std::complex > *B, std::complex *det, int n) +{ +if(n<=0) n=A.nrows(); //default - whole matrix +if (n==A.nrows() && B && A.nrows() != B->ncols() || B && n>B->ncols() ||n>A.nrows()) laerror("incompatible matrices in linear_solve()"); +if(B) B->copyonwrite(); +linear_solve_do(A,B?(*B)[0]:NULL,B?B->nrows() : 0, B?B->ncols():A.nrows(), det,n); +} + +void linear_solve(NRMat< std::complex > &A, NRVec< std::complex > &B, std::complex *det, int n) +{ +if(n<=0) n=A.nrows(); //default - whole matrix +if(n==A.nrows() && A.nrows() != B.size() || n>B.size()||n>A.nrows() ) laerror("incompatible matrices in linear_solve()"); +B.copyonwrite(); +linear_solve_do(A,&B[0],1,A.nrows(),det,n); } diff --git a/nonclass.h b/nonclass.h index 21d15cf..e03d4d1 100644 --- a/nonclass.h +++ b/nonclass.h @@ -154,8 +154,8 @@ extern T trace2(const NRSMat &a, const NRMat &b, const bool diagscaled=0); extern T trace2(const NRMat &a, const NRSMat &b, const bool diagscaled=0);\ extern void linear_solve(NRMat &a, NRMat *b, T *det=0,int n=0); /*solve Ax^T=b^T (b is nrhs x n) */ \ extern void linear_solve(NRSMat &a, NRMat *b, T *det=0, int n=0); /*solve Ax^T=b^T (b is nrhs x n) */\ -extern void linear_solve(NRMat &a, NRVec &b, double *det=0, int n=0); \ -extern void linear_solve(NRSMat &a, NRVec &b, double *det=0, int n=0); \ +extern void linear_solve(NRMat &a, NRVec &b, T *det=0, int n=0); \ +extern void linear_solve(NRSMat &a, NRVec &b, T *det=0, int n=0); \ extern void diagonalize(NRMat &a, NRVec::normtype> &w, const bool eivec=1, const bool corder=1, int n=0, NRMat *b=NULL, const int itype=1); \ extern void diagonalize(NRSMat &a, NRVec::normtype> &w, NRMat *v, const bool corder=1, int n=0, NRSMat *b=NULL, const int itype=1);\ extern void singular_decomposition(NRMat &a, NRMat *u, NRVec::normtype> &s, NRMat *v, const bool vnotdagger=0, int m=0, int n=0); \ @@ -285,6 +285,7 @@ const NRMat calcsvdinverse(NRMat a, double thr=0, bool do_absadjoint=false for(int i=0; i