From c137eb15faa98d9b7d35a43c8ee4bbff529cc136 Mon Sep 17 00:00:00 2001 From: Angelika Schwarz Date: Sun, 3 Apr 2022 13:03:24 +0100 Subject: [PATCH] Fix leading dimension check * TPMLQT, GEMLQT: Revert check of ldv and correct docs * Add input parameter checks for LASWLQ * LAMSWLQ: Fix mixed up column count of rhs (n) and original matrix (m) --- SRC/cgemlqt.f | 6 ++---- SRC/clamswlq.f | 14 +++++--------- SRC/claswlq.f | 6 +++--- SRC/ctpmlqt.f | 10 +++------- SRC/dgemlqt.f | 6 ++---- SRC/dlamswlq.f | 14 +++++--------- SRC/dlaswlq.f | 6 +++--- SRC/dtpmlqt.f | 10 +++------- SRC/sgemlqt.f | 6 ++---- SRC/slamswlq.f | 14 +++++--------- SRC/slaswlq.f | 6 +++--- SRC/stpmlqt.f | 10 +++------- SRC/zgemlqt.f | 6 ++---- SRC/zlamswlq.f | 14 +++++--------- SRC/zlaswlq.f | 6 +++--- SRC/ztpmlqt.f | 10 +++------- TESTING/LIN/cerrtsqr.f | 31 +++++++++++++++++++++++++++++++ TESTING/LIN/derrtsqr.f | 31 +++++++++++++++++++++++++++++++ TESTING/LIN/serrtsqr.f | 31 +++++++++++++++++++++++++++++++ TESTING/LIN/zerrtsqr.f | 31 +++++++++++++++++++++++++++++++ 20 files changed, 176 insertions(+), 92 deletions(-) diff --git a/SRC/cgemlqt.f b/SRC/cgemlqt.f index 7894cb944d..a4710f1158 100644 --- a/SRC/cgemlqt.f +++ b/SRC/cgemlqt.f @@ -95,9 +95,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', M >= K >= 0; -*> if SIDE = 'R', N >= K >= 0. +*> The leading dimension of the array V. LDV >= max(1,K). *> \endverbatim *> *> \param[in] T @@ -211,7 +209,7 @@ SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, INFO = -5 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN INFO = -6 - ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDV.LT.MAX( 1, K ) ) THEN INFO = -8 ELSE IF( LDT.LT.MB ) THEN INFO = -10 diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index 4d596f1178..1606cc611c 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -56,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 @@ -94,9 +94,7 @@ *> \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 @@ -213,7 +211,7 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + INTEGER I, II, KK, LW, CTR * .. * .. External Functions .. LOGICAL LSAME @@ -232,10 +230,8 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, RIGHT = LSAME( SIDE, 'R' ) IF (LEFT) THEN LW = N * MB - Q = M ELSE LW = M * MB - Q = N END IF * INFO = 0 @@ -247,11 +243,11 @@ SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 - ELSE IF( N.LT.M ) THEN + ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.MB .OR. MB.LT.1) THEN INFO = -6 - ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 ELSE IF( LDT.LT.MAX( 1, MB) ) THEN INFO = -11 diff --git a/SRC/claswlq.f b/SRC/claswlq.f index 37089c2300..63cbd02c6d 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -60,7 +60,7 @@ *> \verbatim *> NB is INTEGER *> The column block size to be used in the blocked QR. -*> NB > M. +*> NB > 0. *> \endverbatim *> *> \param[in,out] A @@ -206,10 +206,10 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN INFO = -3 - ELSE IF( NB.LE.M ) THEN + ELSE IF( NB.LE.0 ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -5 + INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f index 9b3ec02c92..606c1f5db2 100644 --- a/SRC/ctpmlqt.f +++ b/SRC/ctpmlqt.f @@ -88,9 +88,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= K. *> \endverbatim *> *> \param[in] T @@ -217,7 +215,7 @@ SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN - INTEGER I, IB, NB, LB, KF, LDAQ, LDVQ + INTEGER I, IB, NB, LB, KF, LDAQ * .. * .. External Functions .. LOGICAL LSAME @@ -240,10 +238,8 @@ SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, NOTRAN = LSAME( TRANS, 'N' ) * IF ( LEFT ) THEN - LDVQ = MAX( 1, M ) LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN - LDVQ = MAX( 1, N ) LDAQ = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN @@ -260,7 +256,7 @@ SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 - ELSE IF( LDV.LT.LDVQ ) THEN + ELSE IF( LDV.LT.K ) THEN INFO = -9 ELSE IF( LDT.LT.MB ) THEN INFO = -11 diff --git a/SRC/dgemlqt.f b/SRC/dgemlqt.f index ef87ceb08d..081f600fce 100644 --- a/SRC/dgemlqt.f +++ b/SRC/dgemlqt.f @@ -110,9 +110,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= max(1,K). *> \endverbatim *> *> \param[in] T @@ -226,7 +224,7 @@ SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, INFO = -5 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN INFO = -6 - ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDV.LT.MAX( 1, K ) ) THEN INFO = -8 ELSE IF( LDT.LT.MB ) THEN INFO = -10 diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f index 4433ade911..70e78f4b19 100644 --- a/SRC/dlamswlq.f +++ b/SRC/dlamswlq.f @@ -56,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 @@ -94,9 +94,7 @@ *> \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 @@ -213,7 +211,7 @@ SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, CTR, LW, Q + INTEGER I, II, KK, CTR, LW * .. * .. External Functions .. LOGICAL LSAME @@ -232,10 +230,8 @@ SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, RIGHT = LSAME( SIDE, 'R' ) IF (LEFT) THEN LW = N * MB - Q = M ELSE LW = M * MB - Q = N END IF * INFO = 0 @@ -247,11 +243,11 @@ SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 - ELSE IF( N.LT.M ) THEN + ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.MB .OR. MB.LT.1) THEN INFO = -6 - ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 ELSE IF( LDT.LT.MAX( 1, MB) ) THEN INFO = -11 diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index 0d7224eb89..fb8857145f 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -60,7 +60,7 @@ *> \verbatim *> NB is INTEGER *> The column block size to be used in the blocked QR. -*> NB > M. +*> NB > 0. *> \endverbatim *> *> \param[in,out] A @@ -202,10 +202,10 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN INFO = -3 - ELSE IF( NB.LE.M ) THEN + ELSE IF( NB.LT.0 ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -5 + INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f index 7cf6a00532..05f1ed1316 100644 --- a/SRC/dtpmlqt.f +++ b/SRC/dtpmlqt.f @@ -103,9 +103,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= K. *> \endverbatim *> *> \param[in] T @@ -232,7 +230,7 @@ SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN - INTEGER I, IB, NB, LB, KF, LDAQ, LDVQ + INTEGER I, IB, NB, LB, KF, LDAQ * .. * .. External Functions .. LOGICAL LSAME @@ -255,10 +253,8 @@ SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, NOTRAN = LSAME( TRANS, 'N' ) * IF ( LEFT ) THEN - LDVQ = MAX( 1, M ) LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN - LDVQ = MAX( 1, N ) LDAQ = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN @@ -275,7 +271,7 @@ SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 - ELSE IF( LDV.LT.LDVQ ) THEN + ELSE IF( LDV.LT.K ) THEN INFO = -9 ELSE IF( LDT.LT.MB ) THEN INFO = -11 diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f index ec31395289..bb128c824d 100644 --- a/SRC/sgemlqt.f +++ b/SRC/sgemlqt.f @@ -95,9 +95,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= max(1,K). *> \endverbatim *> *> \param[in] T @@ -211,7 +209,7 @@ SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, INFO = -5 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN INFO = -6 - ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDV.LT.MAX( 1, K ) ) THEN INFO = -8 ELSE IF( LDT.LT.MB ) THEN INFO = -10 diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index ed507c6c7b..d4996b1f20 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -56,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 @@ -94,9 +94,7 @@ *> \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 @@ -213,7 +211,7 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + INTEGER I, II, KK, LW, CTR * .. * .. External Functions .. LOGICAL LSAME @@ -232,10 +230,8 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, RIGHT = LSAME( SIDE, 'R' ) IF (LEFT) THEN LW = N * MB - Q = M ELSE LW = M * MB - Q = N END IF * INFO = 0 @@ -247,11 +243,11 @@ SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 - ELSE IF( N.LT.M ) THEN + ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.MB .OR. MB.LT.1) THEN INFO = -6 - ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 ELSE IF( LDT.LT.MAX( 1, MB) ) THEN INFO = -11 diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index 4f56a46eca..bc7cf343d4 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -60,7 +60,7 @@ *> \verbatim *> NB is INTEGER *> The column block size to be used in the blocked QR. -*> NB > M. +*> NB > 0. *> \endverbatim *> *> \param[in,out] A @@ -202,10 +202,10 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN INFO = -3 - ELSE IF( NB.LE.M ) THEN + ELSE IF( NB.LE.0 ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -5 + INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f index d3725cd7b3..6497f42bbe 100644 --- a/SRC/stpmlqt.f +++ b/SRC/stpmlqt.f @@ -103,9 +103,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= K. *> \endverbatim *> *> \param[in] T @@ -232,7 +230,7 @@ SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN - INTEGER I, IB, NB, LB, KF, LDAQ, LDVQ + INTEGER I, IB, NB, LB, KF, LDAQ * .. * .. External Functions .. LOGICAL LSAME @@ -255,10 +253,8 @@ SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, NOTRAN = LSAME( TRANS, 'N' ) * IF ( LEFT ) THEN - LDVQ = MAX( 1, M ) LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN - LDVQ = MAX( 1, N ) LDAQ = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN @@ -275,7 +271,7 @@ SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 - ELSE IF( LDV.LT.LDVQ ) THEN + ELSE IF( LDV.LT.K ) THEN INFO = -9 ELSE IF( LDT.LT.MB ) THEN INFO = -11 diff --git a/SRC/zgemlqt.f b/SRC/zgemlqt.f index a59b157709..06fe4958e5 100644 --- a/SRC/zgemlqt.f +++ b/SRC/zgemlqt.f @@ -110,9 +110,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= max(1,K). *> \endverbatim *> *> \param[in] T @@ -226,7 +224,7 @@ SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, INFO = -5 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN INFO = -6 - ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDV.LT.MAX( 1, K ) ) THEN INFO = -8 ELSE IF( LDT.LT.MB ) THEN INFO = -10 diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f index 44201e3540..4abefa4343 100644 --- a/SRC/zlamswlq.f +++ b/SRC/zlamswlq.f @@ -56,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 @@ -94,9 +94,7 @@ *> \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 @@ -213,7 +211,7 @@ SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR, Q + INTEGER I, II, KK, LW, CTR * .. * .. External Functions .. LOGICAL LSAME @@ -232,10 +230,8 @@ SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, RIGHT = LSAME( SIDE, 'R' ) IF (LEFT) THEN LW = N * MB - Q = M ELSE LW = M * MB - Q = N END IF * INFO = 0 @@ -247,11 +243,11 @@ SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, INFO = -5 ELSE IF( M.LT.K ) THEN INFO = -3 - ELSE IF( N.LT.M ) THEN + ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.MB .OR. MB.LT.1) THEN INFO = -6 - ELSE IF( LDA.LT.MAX( 1, Q ) ) THEN + ELSE IF( LDA.LT.MAX( 1, K ) ) THEN INFO = -9 ELSE IF( LDT.LT.MAX( 1, MB) ) THEN INFO = -11 diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f index 39c974c8df..e4e7033430 100644 --- a/SRC/zlaswlq.f +++ b/SRC/zlaswlq.f @@ -60,7 +60,7 @@ *> \verbatim *> NB is INTEGER *> The column block size to be used in the blocked QR. -*> NB > M. +*> NB > 0. *> \endverbatim *> *> \param[in,out] A @@ -202,10 +202,10 @@ SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN INFO = -3 - ELSE IF( NB.LE.M ) THEN + ELSE IF( NB.LE.0 ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN - INFO = -5 + INFO = -6 ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f index 4b5d7f4853..c63c05bf8e 100644 --- a/SRC/ztpmlqt.f +++ b/SRC/ztpmlqt.f @@ -103,9 +103,7 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V. -*> If SIDE = 'L', LDV >= max(1,M); -*> if SIDE = 'R', LDV >= max(1,N). +*> The leading dimension of the array V. LDV >= K. *> \endverbatim *> *> \param[in] T @@ -232,7 +230,7 @@ SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN - INTEGER I, IB, NB, LB, KF, LDAQ, LDVQ + INTEGER I, IB, NB, LB, KF, LDAQ * .. * .. External Functions .. LOGICAL LSAME @@ -255,10 +253,8 @@ SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, NOTRAN = LSAME( TRANS, 'N' ) * IF ( LEFT ) THEN - LDVQ = MAX( 1, M ) LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN - LDVQ = MAX( 1, N ) LDAQ = MAX( 1, M ) END IF IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN @@ -275,7 +271,7 @@ SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 - ELSE IF( LDV.LT.LDVQ ) THEN + ELSE IF( LDV.LT.K ) THEN INFO = -9 ELSE IF( LDT.LT.MB ) THEN INFO = -11 diff --git a/TESTING/LIN/cerrtsqr.f b/TESTING/LIN/cerrtsqr.f index 5afc61e91b..165c8d6816 100644 --- a/TESTING/LIN/cerrtsqr.f +++ b/TESTING/LIN/cerrtsqr.f @@ -218,6 +218,37 @@ SUBROUTINE CERRTSQR( PATH, NUNIT ) CALL CGELQ( 2, 3, A, 3, TAU, 8, W, 0, INFO ) CALL CHKXER( 'CGELQ', INFOT, NOUT, LERR, OK ) * +* CLASWLQ +* + MB = 1 + NB = 1 + SRNAMT = 'CLASWLQ' + INFOT = 1 + CALL CLASWLQ( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CLASWLQ( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + CALL CLASWLQ( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CLASWLQ( 1, 2, -1, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + CALL CLASWLQ( 1, 1, 2, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CLASWLQ( 1, 2, MB, -1, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL CLASWLQ( 1, 2, MB, NB, A, 0, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL CLASWLQ( 1, 2, MB, NB, A, 1, TAU, 0, W, 1, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL CLASWLQ( 1, 2, MB, NB, A, 1, TAU, 1, W, 0, INFO ) + CALL CHKXER( 'CLASWLQ', INFOT, NOUT, LERR, OK ) +* * CGEMLQ * TAU(1)=1 diff --git a/TESTING/LIN/derrtsqr.f b/TESTING/LIN/derrtsqr.f index 60da20b9f7..f0d345149e 100644 --- a/TESTING/LIN/derrtsqr.f +++ b/TESTING/LIN/derrtsqr.f @@ -220,6 +220,37 @@ SUBROUTINE DERRTSQR( PATH, NUNIT ) CALL DGELQ( 2, 3, A, 3, TAU, 7, W, 0, INFO ) CALL CHKXER( 'DGELQ', INFOT, NOUT, LERR, OK ) * +* DLASWLQ +* + MB = 1 + NB = 1 + SRNAMT = 'DLASWLQ' + INFOT = 1 + CALL DLASWLQ( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DLASWLQ( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + CALL DLASWLQ( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DLASWLQ( 1, 2, -1, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + CALL DLASWLQ( 1, 1, 2, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DLASWLQ( 1, 2, MB, -1, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL DLASWLQ( 1, 2, MB, NB, A, 0, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL DLASWLQ( 1, 2, MB, NB, A, 1, TAU, 0, W, 1, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL DLASWLQ( 1, 2, MB, NB, A, 1, TAU, 1, W, 0, INFO ) + CALL CHKXER( 'DLASWLQ', INFOT, NOUT, LERR, OK ) +* * DGEMLQ * TAU(1)=1 diff --git a/TESTING/LIN/serrtsqr.f b/TESTING/LIN/serrtsqr.f index f9bbca0cbf..7f25f8b08e 100644 --- a/TESTING/LIN/serrtsqr.f +++ b/TESTING/LIN/serrtsqr.f @@ -220,6 +220,37 @@ SUBROUTINE SERRTSQR( PATH, NUNIT ) CALL SGELQ( 2, 3, A, 3, TAU, 7, W, 0, INFO ) CALL CHKXER( 'SGELQ', INFOT, NOUT, LERR, OK ) * +* SLASWLQ +* + MB = 1 + NB = 1 + SRNAMT = 'SLASWLQ' + INFOT = 1 + CALL SLASWLQ( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SLASWLQ( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + CALL SLASWLQ( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SLASWLQ( 1, 2, -1, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + CALL SLASWLQ( 1, 1, 2, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SLASWLQ( 1, 2, MB, -1, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL SLASWLQ( 1, 2, MB, NB, A, 0, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL SLASWLQ( 1, 2, MB, NB, A, 1, TAU, 0, W, 1, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL SLASWLQ( 1, 2, MB, NB, A, 1, TAU, 1, W, 0, INFO ) + CALL CHKXER( 'SLASWLQ', INFOT, NOUT, LERR, OK ) +* * SGEMLQ * TAU(1)=1 diff --git a/TESTING/LIN/zerrtsqr.f b/TESTING/LIN/zerrtsqr.f index 6f18c12f7c..19f73fa7ab 100644 --- a/TESTING/LIN/zerrtsqr.f +++ b/TESTING/LIN/zerrtsqr.f @@ -218,6 +218,37 @@ SUBROUTINE ZERRTSQR( PATH, NUNIT ) CALL ZGELQ( 2, 3, A, 3, TAU, 8, W, 0, INFO ) CALL CHKXER( 'ZGELQ', INFOT, NOUT, LERR, OK ) * +* ZLASWLQ +* + MB = 1 + NB = 1 + SRNAMT = 'ZLASWLQ' + INFOT = 1 + CALL ZLASWLQ( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZLASWLQ( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + CALL ZLASWLQ( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZLASWLQ( 1, 2, -1, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + CALL ZLASWLQ( 1, 1, 2, NB, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZLASWLQ( 1, 2, MB, -1, A, 1, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL ZLASWLQ( 1, 2, MB, NB, A, 0, TAU, 1, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 8 + CALL ZLASWLQ( 1, 2, MB, NB, A, 1, TAU, 0, W, 1, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) + INFOT = 10 + CALL ZLASWLQ( 1, 2, MB, NB, A, 1, TAU, 1, W, 0, INFO ) + CALL CHKXER( 'ZLASWLQ', INFOT, NOUT, LERR, OK ) +* * ZGEMLQ * TAU(1)=1