diff options
Diffstat (limited to 'SRC/zgemlq.f')
-rw-r--r-- | SRC/zgemlq.f | 103 |
1 files changed, 57 insertions, 46 deletions
diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f index f02d7b1a..5602d872 100644 --- a/SRC/zgemlq.f +++ b/SRC/zgemlq.f @@ -3,22 +3,21 @@ * =========== * * SUBROUTINE ZGEMLQ( 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 .. -* COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) +* COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) *> \par Purpose: * ============= *> *> \verbatim *> -*> ZGEMLQ overwrites the general real M-by-N matrix C with -*> +*> ZGEMLQ overwrites the general real M-by-N matrix C with *> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q @@ -26,20 +25,26 @@ *> where Q is a complex unitary matrix defined as the product *> of blocked elementary reflectors computed by short wide *> LQ factorization (ZGELQ) +*> *> \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 +54,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,22 +62,23 @@ *> 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 COMPLEX*16 array, dimension (LDA,K) +*> A is COMPLEX*16 array, dimension +*> (LDA,M) if SIDE = 'L', +*> (LDA,N) if SIDE = 'R' *> Part of the data structure to represent Q as returned by ZGELQ. *> \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 @@ -88,19 +94,23 @@ *> \endverbatim *> *> \param[in,out] C +*> \verbatim *> C is COMPLEX*16 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) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> *> \endverbatim +*> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER @@ -140,47 +150,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 +*> ZLASWLQ or ZGELQT *> *> 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, ZGELQ will use either +*> ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute *> the LQ factorization. -*> This version of GEMLQ will use either LAMSWLQ or GEMLQT to +*> This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to *> multiply matrix Q by another matrix. -*> Further Details in LAMSWLQ or GEMLQT. +*> Further Details in ZLAMSWLQ or ZGEMLQT. *> \endverbatim *> * ===================================================================== SUBROUTINE ZGEMLQ( 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 .. - COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * ) + COMPLEX*16 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 ZLAMSWLQ, ZGEMLQT, XERBLA +* .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -188,15 +200,15 @@ * * Test the input arguments * - LQUERY = LWORK.LT.0 + LQUERY = LWORK.EQ.-1 NOTRAN = LSAME( TRANS, 'N' ) TRAN = LSAME( TRANS, 'C' ) 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 +216,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 +228,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) = LW + IF( INFO.EQ.0 ) THEN + WORK( 1 ) = LW END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGEMLQ', -INFO ) RETURN - ELSE IF ( LQUERY ) THEN + ELSE IF( LQUERY ) THEN RETURN END IF * @@ -256,13 +267,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 ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T(4), MB, C, LDC, WORK, INFO) + $ T( 6 ), MB, C, LDC, WORK, INFO ) ELSE - CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T(4), - $ MB, C, LDC, WORK, LWORK, INFO ) + CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ), + $ MB, C, LDC, WORK, LWORK, INFO ) END IF * - WORK(1) = LW + WORK( 1 ) = LW * RETURN * |