inline
int geqrf (A& a, Tau& tau, detail::workspace1<Work> workspace ) {
typedef typename A::value_type value_type ;
const int n = traits::matrix_size2 (a);
traits::detail::array<value_type> work(std::max(1, n));
return geqrf( a, tau, workspace.w_ );
}
inline MKL_INT qr_factor(MKL_INT m, MKL_INT n, T r[], T tau[], T q[], T work[], MKL_INT len,
void (*geqrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, T*, T*, const MKL_INT*, MKL_INT*),
void (*orgqr)(const MKL_INT*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, const T*, T*, const MKL_INT*, MKL_INT*))
{
MKL_INT info = 0;
geqrf(&m, &n, r, &m, tau, work, &len, &info);
for (MKL_INT i = 0; i < m; ++i)
{
for (MKL_INT j = 0; j < m && j < n; ++j)
{
if (i > j)
{
q[j * m + i] = r[j * m + i];
}
}
}
//compute the q elements explicitly
if (m <= n)
{
orgqr(&m, &m, &m, q, &m, tau, work, &len, &info);
}
else
{
orgqr(&m, &m, &n, q, &m, tau, work, &len, &info);
}
return info;
}
void TNqrsolve(double **aIn, double *bIn, double *xOut, int msize, double &det, int &info){
double *a;
a = qr_ctof(aIn, msize, msize);
double **Atemp = new double *[msize];
for(int i = 0 ; i <msize; i++){
Atemp[i] = new double[msize];
}
double *b = new double[msize];
for(int i =0 ; i < msize; i++){
b[i]=bIn[i];
}
double* tau = new double[msize];
int tempinfo=0;
tempinfo=geqrf(msize, msize, a, msize, tau);
if(tempinfo != 0)info=tempinfo;
qr_ftoc(a, Atemp, msize, msize);
det=0;
for(int i =0; i < msize; i++){
det += log(fabs(Atemp[i][i]));
}
tempinfo=0;
tempinfo=ormqr('L', 'T', msize, 1, msize, a, msize, tau, b, msize);
if(tempinfo != 0)info=tempinfo;
tempinfo=0;
tempinfo=trtrs('U', 'N', 'N', msize, 1, a, msize, b, msize);
if(tempinfo != 0)info=tempinfo;
for(int i =0; i < msize; i++){
xOut[i] = b[i];
}
//tempinfo = trrfs('U', 'N', 'N', msize, 1, a, msize, bIn, msize, xOut, msize);
delete[] a;
delete[] tau;
delete[] b;
for(int i = 0 ; i <msize; i++){
delete[] Atemp[i];
}
delete[] Atemp;
}
inline MKL_INT qr_thin_factor(MKL_INT m, MKL_INT n, T q[], T tau[], T r[], T work[], MKL_INT len,
void (*geqrf)(const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, T*, T*, const MKL_INT*, MKL_INT*),
void (*orgqr)(const MKL_INT*, const MKL_INT*, const MKL_INT*, T*, const MKL_INT*, const T*, T*, const MKL_INT*, MKL_INT*))
{
MKL_INT info = 0;
geqrf(&m, &n, q, &m, tau, work, &len, &info);
for (MKL_INT i = 0; i < n; ++i)
{
for (MKL_INT j = 0; j < n; ++j)
{
if (i <= j)
{
r[j * n + i] = q[j * m + i];
}
}
}
orgqr(&m, &n, &n, q, &m, tau, work, &len, &info);
return info;
}
inline
int geqrf (A& a, Tau& tau) {
return geqrf( a, tau, optimal_workspace() );
}
