*> \brief \b SGEMQRT * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download SGEMQRT + dependencies *> *> [TGZ] *> *> [ZIP] *> *> [TXT] *> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, * C, LDC, WORK, INFO ) * * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDC, M, N, NB, LDT * .. * .. Array Arguments .. * REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SGEMQRT overwrites the general real M-by-N matrix C with *> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q C C Q *> TRANS = 'T': Q**T C C Q**T *> *> where Q is a real orthogonal matrix defined as the product of K *> elementary reflectors: *> *> Q = H(1) H(2) . . . H(K) = I - V T V**T *> *> generated using the compact WY representation as returned by SGEQRT. *> *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. *> \endverbatim * * Arguments: * ========== * *> \param[in] SIDE *> \verbatim *> SIDE is CHARACTER*1 *> = 'L': apply Q or Q**T from the Left; *> = 'R': apply Q or Q**T from the Right. *> \endverbatim *> *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 *> = 'N': No transpose, apply Q; *> = 'T': Transpose, apply Q**T. *> \endverbatim *> *> \param[in] M *> \verbatim *> M is INTEGER *> The number of rows of the matrix C. M >= 0. *> \endverbatim *> *> \param[in] N *> \verbatim *> N is INTEGER *> The number of columns of the matrix C. N >= 0. *> \endverbatim *> *> \param[in] K *> \verbatim *> K is INTEGER *> The number of elementary reflectors whose product defines *> the matrix Q. *> If SIDE = 'L', M >= K >= 0; *> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER *> The block size used for the storage of T. K >= NB >= 1. *> This must be the same value of NB used to generate T *> in CGEQRT. *> \endverbatim *> *> \param[in] V *> \verbatim *> V is REAL array, dimension (LDV,K) *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> CGEQRT in the first K columns of its array argument A. *> \endverbatim *> *> \param[in] LDV *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V. *> If SIDE = 'L', LDA >= max(1,M); *> if SIDE = 'R', LDA >= max(1,N). *> \endverbatim *> *> \param[in] T *> \verbatim *> T is REAL array, dimension (LDT,K) *> The upper triangular factors of the block reflectors *> as returned by CGEQRT, stored as a NB-by-N matrix. *> \endverbatim *> *> \param[in] LDT *> \verbatim *> LDT is INTEGER *> The leading dimension of the array T. LDT >= NB. *> \endverbatim *> *> \param[in,out] C *> \verbatim *> C is REAL array, dimension (LDC,N) *> On entry, the M-by-N matrix C. *> On exit, C is overwritten by Q C, Q**T C, C Q**T or C Q. *> \endverbatim *> *> \param[in] LDC *> \verbatim *> LDC is INTEGER *> The leading dimension of the array C. LDC >= max(1,M). *> \endverbatim *> *> \param[out] WORK *> \verbatim *> WORK is REAL array. The dimension of WORK is *> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \ingroup realGEcomputational * * ===================================================================== SUBROUTINE SGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, $ C, LDC, WORK, INFO ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER INFO, K, LDV, LDC, M, N, NB, LDT * .. * .. Array Arguments .. REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN INTEGER I, IB, LDWORK, KF, Q * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL XERBLA, SLARFB * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * .. Test the input arguments .. * INFO = 0 LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'T' ) NOTRAN = LSAME( TRANS, 'N' ) * IF( LEFT ) THEN LDWORK = MAX( 1, N ) Q = M ELSE IF ( RIGHT ) THEN LDWORK = MAX( 1, M ) Q = N END IF IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN INFO = -2 ELSE IF( M.LT.0 ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN INFO = -5 ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0)) THEN INFO = -6 ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN INFO = -8 ELSE IF( LDT.LT.NB ) THEN INFO = -10 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -12 END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SGEMQRT', -INFO ) RETURN END IF * * .. Quick return if possible .. * IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN * IF( LEFT .AND. TRAN ) THEN * DO I = 1, K, NB IB = MIN( NB, K-I+1 ) CALL SLARFB( 'L', 'T', 'F', 'C', M-I+1, N, IB, $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * ELSE IF( RIGHT .AND. NOTRAN ) THEN * DO I = 1, K, NB IB = MIN( NB, K-I+1 ) CALL SLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB, $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * ELSE IF( LEFT .AND. NOTRAN ) THEN * KF = ((K-1)/NB)*NB+1 DO I = KF, 1, -NB IB = MIN( NB, K-I+1 ) CALL SLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB, $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * ELSE IF( RIGHT .AND. TRAN ) THEN * KF = ((K-1)/NB)*NB+1 DO I = KF, 1, -NB IB = MIN( NB, K-I+1 ) CALL SLARFB( 'R', 'T', 'F', 'C', M, N-I+1, IB, $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * END IF * RETURN * * End of SGEMQRT * END