*** empty log message ***
This commit is contained in:
parent
2a8913b72b
commit
0a195e1213
44
mat.cc
44
mat.cc
@ -16,6 +16,48 @@ extern ssize_t write(int, const void *, size_t);
|
||||
* Templates first, specializations for BLAS next
|
||||
*/
|
||||
|
||||
|
||||
|
||||
//direct sum
|
||||
template <typename T>
|
||||
const NRMat<T> NRMat<T>::oplus(const NRMat<T> &rhs) const
|
||||
{
|
||||
NRMat<T> r((T)0,nn+rhs.nn,mm+rhs.mm);
|
||||
|
||||
#ifdef oldversion
|
||||
int i,j;
|
||||
for(i=0;i<nn;i++) for(j=0;j<mm;j++) r(i,j)=(*this)(i,j);
|
||||
for(i=0;i<nn;i++) for(j=mm;j<mm+rhs.mm;j++) r(i,j)= (T)0;
|
||||
for(i=nn;i<nn+rhs.nn;i++) for(j=0;j<mm;j++) r(i,j)= (T)0;
|
||||
for(i=nn;i<nn+rhs.nn;i++) for(j=mm;j<mm+rhs.mm;j++) r(i,j)= rhs(i-nn,j-mm);
|
||||
#else
|
||||
r.storesubmatrix(0,0,*this);
|
||||
r.storesubmatrix(nn,mm,rhs);
|
||||
#endif
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
//direct product
|
||||
|
||||
template <typename T>
|
||||
const NRMat<T> NRMat<T>::otimes(const NRMat<T> &rhs) const
|
||||
{
|
||||
NRMat<T> r((T)0,nn*rhs.nn,mm*rhs.mm);
|
||||
|
||||
int i,j,k,l;
|
||||
|
||||
for(i=0;i<nn;i++) for(j=0;j<mm;j++)
|
||||
{
|
||||
T c=(*this)(i,j);
|
||||
for(k=0;k<rhs.mm;k++) for(l=0;l<rhs.mm;l++)
|
||||
r( i*rhs.nn+k , j*rhs.nn+l ) = c *rhs(k,l);
|
||||
}
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
//row of
|
||||
template <typename T>
|
||||
const NRVec<T> NRMat<T>::row(const int i, int l) const
|
||||
@ -251,7 +293,6 @@ int torow=fromrow+rhs.nrows()-1;
|
||||
#ifdef DEBUG
|
||||
if(fromrow <0 ||fromrow >=nn||torow >=nn ||fromcol<0||fromcol>=mm||tocol>=mm) laerror("bad indices in storesubmatrix");
|
||||
#endif
|
||||
int n=torow-fromrow+1;
|
||||
int m=tocol-fromcol+1;
|
||||
for(int i=fromrow; i<=torow; ++i)
|
||||
#ifdef MATPTR
|
||||
@ -1068,7 +1109,6 @@ return divide?NULL:&r[0];
|
||||
|
||||
|
||||
|
||||
//direct sum and product (oplus, otimes) to be done
|
||||
|
||||
|
||||
|
||||
|
@ -109,6 +109,7 @@ FORNAME(zdotc) (dotc,&N,X,&incX,Y,&incY);
|
||||
//enum CBLAS_ORDER {CblasRowMajor=101, CblasColMajor=102 };
|
||||
//enum CBLAS_TRANSPOSE {CblasNoTrans=111, CblasTrans=112, CblasConjTrans=113, AtlasConj=114};
|
||||
|
||||
|
||||
extern "C" void FORNAME(dspmv) (const char *uplo, const int *n, const double *alpha, const double *ap, const double *x, const int *incx, const double *beta, double *y, const int *incy);
|
||||
void cblas_dspmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
const int N, const double alpha, const double *Ap,
|
||||
@ -117,9 +118,10 @@ void cblas_dspmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
{
|
||||
if(Order!=CblasRowMajor) laerror("CblasRowMajor order asserted");
|
||||
if(Uplo!=CblasLower) laerror("CblasLower uplo asserted");
|
||||
FORNAME(dspmv) ("L",&N, &alpha, Ap, X, &incX, &beta, Y, &incY);
|
||||
FORNAME(dspmv) ("U",&N, &alpha, Ap, X, &incX, &beta, Y, &incY);
|
||||
}
|
||||
|
||||
|
||||
extern "C" void FORNAME(zhpmv) (const char *uplo, const int *n, const void *alpha, const void *ap, const void *x, const int *incx, const void *beta, void *y, const int *incy);
|
||||
void cblas_zhpmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
const int N, const void *alpha, const void *Ap,
|
||||
@ -128,7 +130,7 @@ void cblas_zhpmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
|
||||
{
|
||||
if(Order!=CblasRowMajor) laerror("CblasRowMajor order asserted");
|
||||
if(Uplo!=CblasLower) laerror("CblasLower uplo asserted");
|
||||
FORNAME(zhpmv) ("L",&N, alpha, Ap, X, &incX, beta, Y, &incY);
|
||||
FORNAME(zhpmv) ("U",&N, alpha, Ap, X, &incX, beta, Y, &incY);
|
||||
}
|
||||
|
||||
|
||||
|
13
nonclass.cc
13
nonclass.cc
@ -137,9 +137,20 @@ static void linear_solve_do(NRMat<double> &A, double *B, const int nrhs, const i
|
||||
//take into account some numerical instabilities in dgesv for singular matrices
|
||||
for (int i=0; i<n; ++i) {double t=A[i][i]; if(!finite(t) || abs(t) < EPSDET ) {*det=0.; break;} else *det *=t;}
|
||||
//change sign of det by parity of ipiv permutation
|
||||
if(*det) for (int i=0; i<n; ++i) if(i!=ipiv[i]) *det = -(*det);
|
||||
if(*det) for (int i=0; i<n; ++i) if(
|
||||
#ifdef NONCBLAS
|
||||
i+1
|
||||
#else
|
||||
i
|
||||
#endif
|
||||
!=ipiv[i]) *det = -(*det);
|
||||
}
|
||||
if(det && r>0) *det = 0;
|
||||
/*
|
||||
cout <<"ipiv = ";
|
||||
for (int i=0; i<n; ++i) cout <<ipiv[i]<<" ";
|
||||
cout <<endl;
|
||||
*/
|
||||
delete [] ipiv;
|
||||
if (r>0 && B) laerror("singular matrix in lapack_gesv");
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user