int CORE_dormqr(PLASMA_enum side, PLASMA_enum trans, int M, int N, int K, int IB, const double *A, int LDA, const double *T, int LDT, double *C, int LDC, double *WORK, int LDWORK) { int i, kb; int i1, i3; int nq, nw; int ic = 0; int jc = 0; int ni = N; int mi = M; /* Check input arguments */ if ((side != PlasmaLeft) && (side != PlasmaRight)) { coreblas_error(1, "Illegal value of side"); return -1; } /* * NQ is the order of Q and NW is the minimum dimension of WORK */ if (side == PlasmaLeft) { nq = M; nw = N; } else { nq = N; nw = M; } if ((trans != PlasmaNoTrans) && (trans != PlasmaTrans)) { coreblas_error(2, "Illegal value of trans"); return -2; } if (M < 0) { coreblas_error(3, "Illegal value of M"); return -3; } if (N < 0) { coreblas_error(4, "Illegal value of N"); return -4; } if ((K < 0) || (K > nq)) { coreblas_error(5, "Illegal value of K"); return -5; } if ((IB < 0) || ( (IB == 0) && ((M > 0) && (N > 0)) )) { coreblas_error(6, "Illegal value of IB"); return -6; } if ((LDA < max(1,nq)) && (nq > 0)) { coreblas_error(8, "Illegal value of LDA"); return -8; } if ((LDC < max(1,M)) && (M > 0)) { coreblas_error(12, "Illegal value of LDC"); return -12; } if ((LDWORK < max(1,nw)) && (nw > 0)) { coreblas_error(14, "Illegal value of LDWORK"); return -14; } /* Quick return */ if ((M == 0) || (N == 0) || (K == 0)) return PLASMA_SUCCESS; if (((side == PlasmaLeft) && (trans != PlasmaNoTrans)) || ((side == PlasmaRight) && (trans == PlasmaNoTrans))) { i1 = 0; i3 = IB; } else { i1 = ( ( K-1 ) / IB )*IB; i3 = -IB; } for(i = i1; (i >- 1) && (i < K); i+=i3 ) { kb = min(IB, K-i); if (side == PlasmaLeft) { /* * H or H' is applied to C(i:m,1:n) */ mi = M - i; ic = i; } else { /* * H or H' is applied to C(1:m,i:n) */ ni = N - i; jc = i; } /* * Apply H or H' */ LAPACKE_dlarfb_work(LAPACK_COL_MAJOR, lapack_const(side), lapack_const(trans), lapack_const(PlasmaForward), lapack_const(PlasmaColumnwise), mi, ni, kb, &A[LDA*i+i], LDA, &T[LDT*i], LDT, &C[LDC*jc+ic], LDC, WORK, LDWORK); } return PLASMA_SUCCESS; }
int CORE_dgeqrt(int M, int N, int IB, double *A, int LDA, double *T, int LDT, double *TAU, double *WORK) { int i, k, sb; int iinfo = 0; /* Check input arguments */ if (M < 0) { coreblas_error(1, "Illegal value of M"); return -1; } if (N < 0) { coreblas_error(2, "Illegal value of N"); return -2; } if ((IB < 0) || ( (IB == 0) && ((M > 0) && (N > 0)) )) { coreblas_error(3, "Illegal value of IB"); return -3; } if ((LDA < max(1,M)) && (M > 0)) { coreblas_error(5, "Illegal value of LDA"); return -5; } if ((LDT < max(1,IB)) && (IB > 0)) { coreblas_error(7, "Illegal value of LDT"); return -7; } /* Quick return */ if ((M == 0) || (N == 0) || (IB == 0)) return PLASMA_SUCCESS; k = min(M, N); for(i = 0; i < k; i += IB) { sb = min(IB, k-i); iinfo = LAPACKE_dgeqr2_work(LAPACK_COL_MAJOR, M-i, sb, &A[LDA*i+i], LDA, &TAU[i], WORK); LAPACKE_dlarft_work(LAPACK_COL_MAJOR, lapack_const(PlasmaForward), lapack_const(PlasmaColumnwise), M-i, sb, &A[LDA*i+i], LDA, &TAU[i], &T[LDT*i], LDT); if (N > i+sb) { LAPACKE_dlarfb_work( LAPACK_COL_MAJOR, lapack_const(PlasmaLeft), lapack_const(PlasmaTrans), lapack_const(PlasmaForward), lapack_const(PlasmaColumnwise), M-i, N-i-sb, sb, &A[LDA*i+i], LDA, &T[LDT*i], LDT, &A[LDA*(i+sb)+i], LDA, WORK, N-i-sb); } } return PLASMA_SUCCESS; }