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() ); }