/**
* Process observed intensities into sequence space.
* Solves the linear system vec(I_i-N) = A vec(S_i).
* The input is the LU decomposition of the transpose of A.
*/
MAT processNew(const struct structLU AtLU, const MAT N, const MAT intensities, MAT p) {
if (NULL==AtLU.mat || NULL==N || NULL==intensities) {
return NULL;
}
const int ncycle = N->ncol;
const int nelt = NBASE*ncycle;
// Create a new matrix for result if doesn't exist
if(NULL==p) {
p = new_MAT(NBASE,ncycle);
if(NULL==p) {
return NULL;
}
}
// Left-hand of equation. Writen over by solution
for ( int i=0 ; i<nelt ; i++) {
p->x[i] = intensities->xint[i] - N->x[i];
}
// Solve using LAPACK routine
const int inc = 1;
int info = 0;
getrs(LAPACK_TRANS,&nelt,&inc,AtLU.mat->x,&nelt,AtLU.piv,p->x,&nelt,&info);
if(info!=0) {
warnx("getrs in %s returned %d\n",__func__,info);
}
return p;
}
inline MKL_INT lu_solve_factored(MKL_INT n, MKL_INT nrhs, T a[], MKL_INT ipiv[], T b[],
void (*getrs)(const char*, const MKL_INT*, const MKL_INT*, const T*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*))
{
shift_ipiv_up(n, ipiv);
MKL_INT info = 0;
char trans ='N';
getrs(&trans, &n, &nrhs, a, &n, ipiv, b, &n, &info);
shift_ipiv_down(n, ipiv);
return info;
}
VectorType
lu_solve(MatrixType a, const VectorType& y)
{
const size_t n = linalg::size(y);
MatrixType y1(n, 1, 0);
column(y1, 0) = y;
std::vector<int> ipiv(n, 0);
int info = getrf(a, ipiv);
if (info != 0)
{
throw std::runtime_error("getrf failed in lu_solve " +
std::to_string(info));
}
getrs(a, ipiv, y1);
return linalg::column(y1, 0);
}
inline MKL_INT lu_solve(MKL_INT n, MKL_INT nrhs, T a[], T b[],
void (*getrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*, MKL_INT*),
void (*getrs)(const char*, const MKL_INT*, const MKL_INT*, const T*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, MKL_INT*))
{
T* clone = Clone(n, n, a);
MKL_INT* ipiv = new MKL_INT[n];
MKL_INT info = 0;
getrf(&n, &n, clone, &n, ipiv, &info);
if (info != 0)
{
delete[] ipiv;
delete[] clone;
return info;
}
char trans ='N';
getrs(&trans, &n, &nrhs, clone, &n, ipiv, b, &n, &info);
delete[] ipiv;
delete[] clone;
return info;
}
inline
int lu_substitute (MatrA const& a, IVec const& ipiv, MatrB& b) {
return getrs (CblasNoTrans, a, ipiv, b);
}
inline
int getrs (MatrA const& a, IVec const& ipiv, MatrB& b) {
return getrs (CblasNoTrans, a, ipiv, b);
}
inline
int getrs (MatrA const& a, IVec const& ipiv, MatrB& b) {
char const no_transpose = 'N';
return getrs (no_transpose, a, ipiv, b);
}
