diff options
Diffstat (limited to 'SRC/sgemlq.f')
| -rw-r--r-- | SRC/sgemlq.f | 110 |
1 files changed, 61 insertions, 49 deletions
diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index a9cd54bd..42306ae4 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -3,22 +3,23 @@ * =========== * * SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, -* $ TSIZE, C, LDC, WORK, LWORK, INFO ) +* $ TSIZE, C, LDC, WORK, LWORK, INFO ) * * * .. Scalar Arguments .. -* CHARACTER SIDE, TRANS -* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC +* CHARACTER SIDE, TRANS +* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC * .. * .. Array Arguments .. -* REAL A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) +* REAL A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) +* .. +* *> \par Purpose: * ============= *> *> \verbatim *> -*> SGEMLQ overwrites the general real M-by-N matrix C with -*> +*> SGEMLQ overwrites the general real M-by-N matrix C with *> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q @@ -26,20 +27,26 @@ *> where Q is a real orthogonal matrix defined as the product *> of blocked elementary reflectors computed by short wide LQ *> factorization (SGELQ) +*> *> \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 @@ -49,7 +56,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The number of columns of the matrix C. N >= M. +*> The number of columns of the matrix C. N >= 0. *> \endverbatim *> *> \param[in] K @@ -57,28 +64,28 @@ *> K is INTEGER *> The number of elementary reflectors whose product defines *> the matrix Q. -*> M >= K >= 0; -*> +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] A *> \verbatim -*> A is REAL array, dimension (LDA,K) -*> Part of the data structure to represent Q as returned by ZGELQ. +*> A is REAL array, dimension +*> (LDA,M) if SIDE = 'L', +*> (LDA,N) if SIDE = 'R' +*> Part of the data structure to represent Q as returned by DGELQ. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. -*> If SIDE = 'L', LDA >= max(1,M); -*> if SIDE = 'R', LDA >= max(1,N). +*> The leading dimension of the array A. LDA >= max(1,K). *> \endverbatim *> *> \param[in] T *> \verbatim *> T is REAL array, dimension (MAX(5,TSIZE)). -*> Part of the data structure to represent Q as returned by ZGELQ. +*> Part of the data structure to represent Q as returned by SGELQ. *> \endverbatim *> *> \param[in] TSIZE @@ -88,19 +95,23 @@ *> \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 or Q**T*C or 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 *> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER @@ -140,47 +151,49 @@ *> *> T(2): row block size (MB) *> T(3): column block size (NB) -*> T(4:TSIZE): data structure needed for Q, computed by -*> LASWLQ or GELQT +*> T(6:TSIZE): data structure needed for Q, computed by +*> SLASWLQ or SGELQT *> *> Depending on the matrix dimensions M and N, and row and column -*> block sizes MB and NB returned by ILAENV, GELQ will use either -*> LASWLQ (if the matrix is wide-and-short) or GELQT to compute +*> block sizes MB and NB returned by ILAENV, SGELQ will use either +*> SLASWLQ (if the matrix is wide-and-short) or SGELQT to compute *> the LQ factorization. -*> This version of GEMLQ will use either LAMSWLQ or GEMLQT to +*> This version of SGEMLQ will use either SLAMSWLQ or SGEMLQT to *> multiply matrix Q by another matrix. -*> Further Details in LAMSWLQ or GEMLQT. +*> Further Details in SLAMSWLQ or SGEMLQT. *> \endverbatim *> * ===================================================================== SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, - $ C, LDC, WORK, LWORK, INFO ) + $ C, LDC, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* November 2016 * * .. Scalar Arguments .. - CHARACTER SIDE, TRANS - INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC + CHARACTER SIDE, TRANS + INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC * .. * .. Array Arguments .. - REAL A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) + REAL A( LDA, * ), T( * ), C( LDC, * ), WORK( * ) * .. * * ===================================================================== * * .. * .. Local Scalars .. - LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, MB, NB, LW, NBLCKS, MN + LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY + INTEGER MB, NB, LW, NBLCKS, MN * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME +* .. * .. External Subroutines .. EXTERNAL SLAMSWLQ, SGEMLQT, XERBLA +* .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -188,15 +201,15 @@ * * Test the input arguments * - LQUERY = LWORK.LT.0 + LQUERY = LWORK.EQ.-1 NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'T' ) LEFT = LSAME( SIDE, 'L' ) RIGHT = LSAME( SIDE, 'R' ) * - MB = INT(T(2)) - NB = INT(T(3)) - IF ( LEFT ) THEN + MB = INT( T( 2 ) ) + NB = INT( T( 3 ) ) + IF( LEFT ) THEN LW = N * MB MN = M ELSE @@ -204,7 +217,7 @@ MN = N END IF * - IF ( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN + IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN NBLCKS = ( MN - K ) / ( NB - K ) ELSE @@ -216,34 +229,33 @@ * INFO = 0 IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN - INFO = -1 + INFO = -1 ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN - INFO = -2 + INFO = -2 ELSE IF( M.LT.0 ) THEN INFO = -3 - ELSE IF( N.LT.0) THEN + ELSE IF( N.LT.0 ) THEN INFO = -4 - ELSE IF( K.LT.0 ) THEN + ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN INFO = -5 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -7 - ELSE IF( TSIZE.LT.MAX( 1, MB*K*NBLCKS + 5 ) - $ .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( TSIZE.LT.5 ) THEN INFO = -9 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -11 - ELSE IF(( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN + ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN INFO = -13 END IF * - IF( INFO.EQ.0 ) THEN - WORK(1) = REAL(LW) + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = REAL( LW ) END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SGEMLQ', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN + ELSE IF( LQUERY ) THEN RETURN END IF * @@ -256,13 +268,13 @@ IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K ) $ .OR. ( NB.LE.K ) .OR. ( NB.GE.MAX( M, N, K ) ) ) THEN CALL SGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T(4), MB, C, LDC, WORK, INFO) + $ T( 6 ), MB, C, LDC, WORK, INFO ) ELSE - CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T(4), - $ MB, C, LDC, WORK, LWORK, INFO ) + CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ), + $ MB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK(1) = REAL(LW) + WORK( 1 ) = REAL( LW ) * RETURN * |