summaryrefslogtreecommitdiff
path: root/SRC
diff options
context:
space:
mode:
authorlangou <julien.langou@ucdenver.edu>2016-12-16 09:28:47 +0100
committerGitHub <noreply@github.com>2016-12-16 09:28:47 +0100
commitc83c6cdf3e9f86625611cfc332831b4a4b6da9e4 (patch)
tree5c00daefdb88c62ae900d8a307e74d1f264eda47 /SRC
parent0c852a609795bd0b962f28b534052492e319afff (diff)
parentc695e9434398eda74936b25243927e2057ee35bd (diff)
downloadlapack-c83c6cdf3e9f86625611cfc332831b4a4b6da9e4.tar.gz
lapack-c83c6cdf3e9f86625611cfc332831b4a4b6da9e4.tar.bz2
lapack-c83c6cdf3e9f86625611cfc332831b4a4b6da9e4.zip
Merge pull request #101 from karturov/master
TS QR: changed API, added LAPACKE interfaces and fixes.
Diffstat (limited to 'SRC')
-rw-r--r--SRC/cgelq.f269
-rw-r--r--SRC/cgemlq.f196
-rw-r--r--SRC/cgemqr.f201
-rw-r--r--SRC/cgeqr.f267
-rw-r--r--SRC/cgetsls.f212
-rw-r--r--SRC/clamswlq.f14
-rw-r--r--SRC/clamtsqr.f27
-rw-r--r--SRC/dgelq.f259
-rw-r--r--SRC/dgemlq.f186
-rw-r--r--SRC/dgemqr.f203
-rw-r--r--SRC/dgeqr.f268
-rw-r--r--SRC/dgetsls.f163
-rw-r--r--SRC/dlamswlq.f14
-rw-r--r--SRC/dlamtsqr.f15
-rw-r--r--SRC/sgelq.f268
-rw-r--r--SRC/sgemlq.f192
-rw-r--r--SRC/sgemqr.f206
-rw-r--r--SRC/sgeqr.f268
-rw-r--r--SRC/sgetsls.f178
-rw-r--r--SRC/slamswlq.f14
-rw-r--r--SRC/slamtsqr.f18
-rw-r--r--SRC/zgelq.f258
-rw-r--r--SRC/zgemlq.f193
-rw-r--r--SRC/zgemqr.f203
-rw-r--r--SRC/zgeqr.f270
-rw-r--r--SRC/zgetsls.f205
-rw-r--r--SRC/zlamswlq.f14
-rw-r--r--SRC/zlamtsqr.f18
28 files changed, 2594 insertions, 2005 deletions
diff --git a/SRC/cgelq.f b/SRC/cgelq.f
index c6c962d7..497851f5 100644
--- a/SRC/cgelq.f
+++ b/SRC/cgelq.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* COMPLEX A( LDA, * ), WORK1( * ), WORK2( * )
+* COMPLEX A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> CGELQ computes an LQ factorization of an M-by-N matrix A,
-*> using CLASWLQ when A is short and wide
-*> (N sufficiently greater than M), and otherwise CGELQT:
-*> A = L * Q .
+*> CGELQ computes a LQ factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,8 +42,8 @@
*> On exit, the elements on and below the diagonal of the array
*> contain the M-by-min(M,N) lower trapezoidal matrix L
*> (L is lower triangular if M <= N);
-*> the elements above the diagonal are the rows of
-*> blocked V representing Q (see Further Details).
+*> the elements above the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -56,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> CLASWLQ or CGELQT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): horizontal block size
-*> WORK1(5): vertical block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> CLASWLQ or CGELQT
+*> T is COMPLEX array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
-*> \param[in] LWORK2
+*>
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -114,105 +113,137 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any LQ factorization algorithm they wish. The triangular
+*> (trapezoidal) L has to be stored in the lower part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> CLASWLQ or CGELQT
+*>
*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> block sizes MB and NB returned by ILAENV, CGELQ will use either
+*> CLASWLQ (if the matrix is short-and-wide) or CGELQT to compute
+*> the LQ factorization.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- COMPLEX A( LDA, * ), WORK1( * ), WORK2( * )
+ COMPLEX A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL CGELQT, CLASWLQ, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'CGELQ ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'CGELQ ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'CGELQ ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'CGELQ ', ' ', M, N, 2, -1 )
ELSE
MB = 1
NB = N
END IF
- IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
- IF( NB.GT.N.OR.NB.LE.M) NB = N
- MINLW1 = M + 5
- IF ((NB.GT.M).AND.(N.GT.M)) THEN
- IF(MOD(N-M, NB-M).EQ.0) THEN
- NBLCKS = (N-M)/(NB-M)
+ IF( MB.GT.MIN( M, N ) .OR. MB.LT.1 ) MB = 1
+ IF( NB.GT.N .OR. NB.LE.M ) NB = N
+ MINTSZ = M + 5
+ IF( NB.GT.M .AND. N.GT.M ) THEN
+ IF( MOD( N - M, NB - M ).EQ.0 ) THEN
+ NBLCKS = ( N - M ) / ( NB - M )
ELSE
- NBLCKS = (N-M)/(NB-M) + 1
+ NBLCKS = ( N - M ) / ( NB - M ) + 1
END IF
ELSE
NBLCKS = 1
END IF
-* Determine if the workspace size satisfies minimum size
+*
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
- $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = 1
+ IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
+ $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ MB = 1
+ NB = N
END IF
- IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = N
- END IF
- IF (LWORK2.LT.MB*M) THEN
- LMINWS = .TRUE.
- MB = 1
+ IF( LWORK.LT.MB*M ) THEN
+ LMINWS = .TRUE.
+ MB = 1
END IF
END IF
*
@@ -222,44 +253,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 )
- $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS) ) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = MB*M*NBLCKS+5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = MB * M
- WORK2(2) = M
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = MB*M*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, MB*M )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGELQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The LQ Decomposition
*
- IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
- CALL CGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+ IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
+ CALL CGELQT( M, N, MB, A, LDA, T( 6 ), MB, WORK, INFO )
ELSE
- CALL CLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2,
- $ LWORK2, INFO)
+ CALL CLASWLQ( M, N, MB, NB, A, LDA, T( 6 ), MB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, MB*M )
+*
RETURN
*
* End of CGELQ
diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f
index 1a551ca3..59df3ddf 100644
--- a/SRC/cgemlq.f
+++ b/SRC/cgemlq.f
@@ -2,17 +2,18 @@
* Definition:
* ===========
*
-* SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* COMPLEX A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* COMPLEX A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
@@ -20,27 +21,32 @@
*>
*> CGEMLQ overwrites the general real M-by-N matrix C with
*>
+*> SIDE = 'L' SIDE = 'R'
+*> TRANS = 'N': Q * C C * Q
+*> TRANS = 'C': Q**H * C C * Q**H
+*> where Q is a complex unitary matrix defined as the product
+*> of blocked elementary reflectors computed by short wide
+*> LQ factorization (CGELQ)
*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*> where Q is a complex orthogonal matrix defined as the product
-*> of blocked elementary reflectors computed by short wide LQ
-*> factorization (DGELQ)
*> \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
@@ -50,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
@@ -58,61 +64,64 @@
*> 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,out] A
+*> \param[in] A
*> \verbatim
-*> A is COMPLEX array, dimension (LDA,K)
-*> The i-th row must contain the vector which defines the blocked
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> A is COMPLEX array, dimension
+*> (LDA,M) if SIDE = 'L',
+*> (LDA,N) if SIDE = 'R'
+*> Part of the data structure to represent Q as returned by CGELQ.
*> \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] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) is
-*> returned by GEQR.
+*> T is COMPLEX array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by CGELQ.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is COMPLEX 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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -128,53 +137,63 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> CLASWQR or CGELQT
+*>
*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> block sizes MB and NB returned by ILAENV, CGELQ will use either
+*> CLASWLQ (if the matrix is wide-and-short) or CGELQT to compute
+*> the LQ factorization.
+*> This version of CGEMLQ will use either CLAMSWLQ or CGEMLQT to
+*> multiply matrix Q by another matrix.
+*> Further Details in CLAMSWLQ or CGEMLQT.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- COMPLEX A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+ COMPLEX 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 CLAMSWLQ, CGEMLQT, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -182,26 +201,27 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF (LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * MB
MN = M
ELSE
LW = M * MB
MN = N
END IF
- IF ((NB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, NB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(NB-K)
+*
+ IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
+ NBLCKS = ( MN - K ) / ( NB - K )
ELSE
- NBLCKS = (MN-K)/(NB-K) + 1
+ NBLCKS = ( MN - K ) / ( NB - K ) + 1
END IF
ELSE
NBLCKS = 1
@@ -209,51 +229,53 @@
*
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( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = REAL( LW )
END IF
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEMLQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
+ ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
- $ (NB.GE.MAX(M,N,K))) THEN
+ 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 CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
- $ WORK1(6), MB, C, LDC, WORK2, INFO)
+ $ T( 6 ), MB, C, LDC, WORK, INFO )
ELSE
- CALL CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ MB, C, LDC, WORK2, LWORK2, INFO )
+ CALL CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = REAL( LW )
+*
RETURN
*
* End of CGEMLQ
diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f
index 51d38b85..a5420553 100644
--- a/SRC/cgemqr.f
+++ b/SRC/cgemqr.f
@@ -2,45 +2,52 @@
* Definition:
* ===========
*
-* SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* COMPLEX A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* COMPLEX A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> CGEMQR overwrites the general real M-by-N matrix C with
-*>
+*> CGEMQR 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 complex orthogonal matrix defined as the product
-*> of blocked elementary reflectors computed by tall skinny
-*> QR factorization (CGEQR)
+*> TRANS = 'T': Q**H * C C * Q**H
+*>
+*> where Q is a complex unitary matrix defined as the product
+*> of blocked elementary reflectors computed by tall skinny
+*> QR factorization (CGEQR)
+*>
*> \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
@@ -50,7 +57,7 @@
*> \param[in] N
*> \verbatim
*> N is INTEGER
-*> The number of columns of the matrix C. M >= N >= 0.
+*> The number of columns of the matrix C. N >= 0.
*> \endverbatim
*>
*> \param[in] K
@@ -58,17 +65,14 @@
*> K is INTEGER
*> The number of elementary reflectors whose product defines
*> the matrix Q.
-*> N >= K >= 0;
-*>
+*> If SIDE = 'L', M >= K >= 0;
+*> if SIDE = 'R', N >= K >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> blockedelementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGETSQR in the first k columns of
-*> its array argument A.
+*> Part of the data structure to represent Q as returned by CGEQR.
*> \endverbatim
*>
*> \param[in] LDA
@@ -79,42 +83,46 @@
*> if SIDE = 'R', LDA >= max(1,N).
*> \endverbatim
*>
-*> \param[in] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) as
-*> it is returned by GEQR.
+*> T is COMPLEX array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by CGEQR.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is COMPLEX 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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -130,54 +138,64 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> CLATSQR or CGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, CGEQR will use either
+*> CLATSQR (if the matrix is tall-and-skinny) or CGEQRT to compute
+*> the QR factorization.
+*> This version of CGEMQR will use either CLAMTSQR or CGEMQRT to
+*> multiply matrix Q by another matrix.
+*> Further Details in CLAMTSQR or CGEMQRT.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- COMPLEX A( LDA, * ), WORK1( * ), C(LDC, * ),
- $ WORK2( * )
+ COMPLEX A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER MB, NB, I, II, KK, LW, NBLCKS, MN
+ LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+ INTEGER MB, NB, LW, NBLCKS, MN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
+* ..
* .. External Subroutines ..
EXTERNAL CGEMQRT, CLAMTSQR, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -185,82 +203,81 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF(LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * NB
MN = M
- ELSE IF(RIGHT) THEN
+ ELSE
LW = MB * NB
MN = N
END IF
*
- IF ((MB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, MB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(MB-K)
- ELSE
- NBLCKS = (MN-K)/(MB-K) + 1
- END IF
+ IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
+ NBLCKS = ( MN - K ) / ( MB - K )
+ ELSE
+ NBLCKS = ( MN - K ) / ( MB - K ) + 1
+ END IF
ELSE
NBLCKS = 1
END IF
*
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
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
+ ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
INFO = -7
- ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
-* Determine the block size if it is tall skinny or short and wide
-*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LW
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEMQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
- $ (MB.GE.MAX(M,N,K))) THEN
- CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
- $ WORK1(6), NB, C, LDC, WORK2, INFO)
+ IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
+ $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
+ CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, INFO )
ELSE
- CALL CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ NB, C, LDC, WORK2, LWORK2, INFO )
+ CALL CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
+*
RETURN
*
* End of CGEMQR
diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f
index 330fda5c..e336a916 100644
--- a/SRC/cgeqr.f
+++ b/SRC/cgeqr.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* COMPLEX A( LDA, * ), WORK1( * ), WORK2( * )
+* COMPLEX A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> CGEQR computes a QR factorization of an M-by-N matrix A,
-*> using CLATSQR when A is tall and skinny
-*> (M sufficiently greater than N), and otherwise CGEQRT:
-*> A = Q * R .
+*> CGEQR computes a QR factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,7 +42,8 @@
*> On exit, the elements on and above the diagonal of the array
*> contain the min(M,N)-by-N upper trapezoidal matrix R
*> (R is upper triangular if M >= N);
-*> the elements below the diagonal represent Q (see Further Details).
+*> the elements below the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -55,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> CLATSQR or CGEQRT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): row block size
-*> WORK1(5): column block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> CLATSQR or CGEQRT
+*> T is COMPLEX array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
+*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
-*> \param[in] LWORK2
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -113,106 +113,138 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
+*>
+*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any QR factorization algorithm they wish. The triangular
+*> (trapezoidal) R has to be stored in the upper part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> CLATSQR or CGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, CGEQR will use either
+*> CLATSQR (if the matrix is tall-and-skinny) or CGEQRT to compute
+*> the QR factorization.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- COMPLEX A( LDA, * ), WORK1( * ), WORK2( * )
+ COMPLEX A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL CLATSQR, CGEQRT, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'CGEQR ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'CGEQR ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'CGEQR ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'CGEQR ', ' ', M, N, 2, -1 )
ELSE
MB = M
NB = 1
END IF
- IF( MB.GT.M.OR.MB.LE.N) MB = M
- IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
- MINLW1 = N + 5
- IF ((MB.GT.N).AND.(M.GT.N)) THEN
- IF(MOD(M-N, MB-N).EQ.0) THEN
- NBLCKS = (M-N)/(MB-N)
+ IF( MB.GT.M .OR. MB.LE.N ) MB = M
+ IF( NB.GT.MIN( M, N ) .OR. NB.LT.1 ) NB = 1
+ MINTSZ = N + 5
+ IF( MB.GT.N .AND. M.GT.N ) THEN
+ IF( MOD( M - N, MB - N ).EQ.0 ) THEN
+ NBLCKS = ( M - N ) / ( MB - N )
ELSE
- NBLCKS = (M-N)/(MB-N) + 1
+ NBLCKS = ( M - N ) / ( MB - N ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5)
- $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = 1
- END IF
- IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = M
+ IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N )
+ $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ NB = 1
+ MB = M
END IF
- IF (LWORK2.LT.NB*N) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( LWORK.LT.NB*N ) THEN
+ LMINWS = .TRUE.
+ NB = 1
END IF
END IF
*
@@ -222,45 +254,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 )
- $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS)) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = NB * N * NBLCKS + 5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = NB * N
- WORK2(2) = N
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = NB*N*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, NB*N )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CGEQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The QR Decomposition
*
- IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
- CALL CGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
- RETURN
+ IF( ( M.LE.N ) .OR. ( MB.LE.N ) .OR. ( MB.GE.M ) ) THEN
+ CALL CGEQRT( M, N, NB, A, LDA, T( 6 ), NB, WORK, INFO )
ELSE
- CALL CLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2,
- $ LWORK2, INFO)
+ CALL CLATSQR( M, N, MB, NB, A, LDA, T( 6 ), NB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, NB*N )
+*
RETURN
*
* End of CGEQR
diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f
index af5bd2cb..1ba3045e 100644
--- a/SRC/cgetsls.f
+++ b/SRC/cgetsls.f
@@ -1,16 +1,15 @@
* Definition:
* ===========
*
-* SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
-* $ , WORK, LWORK, INFO )
-
+* SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+* $ WORK, LWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
-* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
+* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
* ..
*
*
@@ -19,10 +18,11 @@
*>
*> \verbatim
*>
-*> CGETSLS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a tall skinny
-*> QR or short wide LQfactorization of A. It is assumed that A has
-*> full rank.
+*> CGETSLS solves overdetermined or underdetermined complex linear systems
+*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ
+*> factorization of A. It is assumed that A has full rank.
+*>
+*>
*>
*> The following options are provided:
*>
@@ -80,10 +80,8 @@
*> A is COMPLEX array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
*> On exit,
-*> if M >= N, A is overwritten by details of its QR
-*> factorization as returned by DGEQRF;
-*> if M < N, A is overwritten by details of its LQ
-*> factorization as returned by DGELQF.
+*> A is overwritten by details of its QR or LQ
+*> factorization as returned by CGEQR or CGELQ.
*> \endverbatim
*>
*> \param[in] LDA
@@ -97,21 +95,17 @@
*> B is COMPLEX array, dimension (LDB,NRHS)
*> On entry, the matrix B of right hand side vectors, stored
*> columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
-*> if TRANS = 'T'.
+*> if TRANS = 'C'.
*> On exit, if INFO = 0, B is overwritten by the solution
*> vectors, stored columnwise:
*> if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
-*> squares solution vectors; the residual sum of squares for the
-*> solution in each column is given by the sum of squares of
-*> elements N+1 to M in that column;
+*> squares solution vectors.
*> if TRANS = 'N' and m < n, rows 1 to N of B contain the
*> minimum norm solution vectors;
-*> if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*> if TRANS = 'C' and m >= n, rows 1 to M of B contain the
*> minimum norm solution vectors;
-*> if TRANS = 'T' and m < n, rows 1 to M of B contain the
-*> least squares solution vectors; the residual sum of squares
-*> for the solution in each column is given by the sum of
-*> squares of elements M+1 to N in that column.
+*> if TRANS = 'C' and m < n, rows 1 to M of B contain the
+*> least squares solution vectors.
*> \endverbatim
*>
*> \param[in] LDB
@@ -122,23 +116,21 @@
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
-*> LWORK >= max( 1, MN + max( MN, NRHS ) ).
-*> For optimal performance,
-*> LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
-*> where MN = min(M,N) and NB is the optimum block size.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
+*> If LWORK = -1 or -2, then a workspace query is assumed.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -160,20 +152,22 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date November 2016
+*
+*> \ingroup complexGEsolve
*
* =====================================================================
- SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
- $ , WORK, LWORK, INFO )
+ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+ $ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.4.0) --
+* -- LAPACK driver 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 2011
+* November 2016
*
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+ INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
@@ -183,17 +177,18 @@
* =====================================================================
*
* .. Parameters ..
- REAL ZERO, ONE
+ REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
- COMPLEX CZERO
+ COMPLEX CZERO
PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
* ..
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
- INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2,
- $ INFO2, NB
+ INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
+ $ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
+ $ WSIZEO, WSIZEM, INFO2
REAL ANRM, BIGNUM, BNRM, SMLNUM
+ COMPLEX TQ( 5 ), WORKQ
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -206,19 +201,19 @@
$ CTRTRS, XERBLA, CGELQ, CGEMLQ
* ..
* .. Intrinsic Functions ..
- INTRINSIC REAL, MAX, MIN
+ INTRINSIC REAL, MAX, MIN, INT
* ..
* .. Executable Statements ..
*
* Test the input arguments.
*
- INFO=0
+ INFO = 0
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
- MNK = MAX(MINMN,NRHS)
+ MNK = MAX( MINMN, NRHS )
TRAN = LSAME( TRANS, 'C' )
*
- LQUERY = ( LWORK.EQ.-1 )
+ LQUERY = ( LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'C' ) ) ) THEN
INFO = -1
@@ -234,60 +229,71 @@
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
+ IF( INFO.EQ.0 ) THEN
*
* Determine the block size and minimum LWORK
*
- IF ( M.GE.N ) THEN
- CALL CGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- ELSE
- CALL CGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- END IF
+ IF( M.GE.N ) THEN
+ CALL CGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL CGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZM, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
+ ELSE
+ CALL CGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL CGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
+ END IF
*
- IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
- INFO=-10
+ IF( ( LWORK.LT.WSIZEM ).AND.( .NOT.LQUERY ) ) THEN
+ INFO = -10
END IF
+*
END IF
*
IF( INFO.NE.0 ) THEN
- CALL XERBLA( 'DGETSLS', -INFO )
+ CALL XERBLA( 'CGETSLS', -INFO )
WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
RETURN
- ELSE IF (LQUERY) THEN
- WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
+ END IF
+ IF( LQUERY ) THEN
+ IF( LWORK.EQ.-1 ) WORK( 1 ) = REAL( WSIZEO )
+ IF( LWORK.EQ.-2 ) WORK( 1 ) = REAL( WSIZEM )
RETURN
END IF
- IF(LWORK.LT.WSIZEO) THEN
- LW1=INT(WORK(3))
- LW2=MAX(LW,INT(WORK(6)))
+ IF( LWORK.LT.WSIZEO ) THEN
+ LW1 = TSZM
+ LW2 = LWM
ELSE
- LW1=INT(WORK(2))
- LW2=MAX(LW,INT(WORK(6)))
+ LW1 = TSZO
+ LW2 = LWO
END IF
*
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
CALL CLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
- $ B, LDB )
+ $ B, LDB )
RETURN
END IF
*
@@ -343,26 +349,27 @@
IBSCL = 2
END IF
*
- IF ( M.GE.N) THEN
+ IF ( M.GE.N ) THEN
*
* compute QR factorization of A
*
- CALL CGEQR( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
- IF (.NOT.TRAN) THEN
+ CALL CGEQR( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
+ IF ( .NOT.TRAN ) THEN
*
* Least-Squares Problem min || A * X - B ||
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
CALL CGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
- $ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
+ $ INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL CTRTRS( 'U', 'N', 'N', N, NRHS,
- $ A, LDA, B, LDB, INFO )
- IF(INFO.GT.0) THEN
+ $ A, LDA, B, LDB, INFO )
+ IF( INFO.GT.0 ) THEN
RETURN
END IF
SCLLEN = N
@@ -390,7 +397,7 @@
* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
*
CALL CGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
SCLLEN = M
@@ -401,8 +408,8 @@
*
* Compute LQ factorization of A
*
- CALL CGELQ( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
+ CALL CGELQ( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
*
* workspace at least M, optimally M*NB.
*
@@ -430,7 +437,7 @@
* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
*
CALL CGEMLQ( 'L', 'C', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -444,7 +451,7 @@
* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
*
CALL CGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -468,24 +475,23 @@
*
IF( IASCL.EQ.1 ) THEN
CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
ELSE IF( IASCL.EQ.2 ) THEN
CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
END IF
IF( IBSCL.EQ.1 ) THEN
- CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
ELSE IF( IBSCL.EQ.2 ) THEN
- CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
END IF
*
50 CONTINUE
- WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
+ WORK( 1 ) = REAL( TSZO + LWO )
RETURN
*
-* End of CGETSLS
+* End of ZGETSLS
*
END
diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f
index 9e3338e2..f89d417b 100644
--- a/SRC/clamswlq.f
+++ b/SRC/clamswlq.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -115,18 +120,23 @@
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is COMPLEX 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 array, dimension (MAX(1,LWORK))
-*>
*> \endverbatim
+*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
@@ -137,8 +147,8 @@
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
-*>
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f
index 387e1fe1..aa2740f0 100644
--- a/SRC/clamtsqr.f
+++ b/SRC/clamtsqr.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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;
*> = 'C': Conjugate Transpose, apply Q**C.
+*> \endverbatim
+*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
@@ -109,12 +114,17 @@
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is COMPLEX 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
@@ -247,14 +257,13 @@
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
INFO = -15
END IF
- IF( INFO.EQ.0) THEN
*
* Determine the block size if it is tall skinny or short and wide
*
IF( INFO.EQ.0) THEN
WORK(1) = LW
END IF
- END IF
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLAMTSQR', -INFO )
RETURN
@@ -354,10 +363,10 @@
*
* Multiply Q to the current block of C (1:M,I:I+MB)
*
- CTR = CTR - 1
- CALL CTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
- $ T(1,CTR*K+1), LDT, C(1,1), LDC,
- $ C(1,I), LDC, WORK, INFO )
+ CTR = CTR - 1
+ CALL CTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
+ $ T(1,CTR*K+1), LDT, C(1,1), LDC,
+ $ C(1,I), LDC, WORK, INFO )
END DO
*
* Multiply Q to the first block of C (1:M,1:MB)
@@ -397,11 +406,7 @@
*
END IF
*
- IF(LEFT) THEN
- WORK(1)= N * NB
- ELSE IF(RIGHT) THEN
- WORK(1)= MB * NB
- END IF
+ WORK(1) = LW
RETURN
*
* End of CLAMTSQR
diff --git a/SRC/dgelq.f b/SRC/dgelq.f
index d73f7454..a9af9006 100644
--- a/SRC/dgelq.f
+++ b/SRC/dgelq.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * )
+* DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> DGELQ computes an LQ factorization of an M-by-N matrix A,
-*> using DLASWLQ when A is short and wide
-*> (N sufficiently greater than M), and otherwise DGELQT:
-*> A = L * Q .
+*> DGELQ computes a LQ factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,8 +42,8 @@
*> On exit, the elements on and below the diagonal of the array
*> contain the M-by-min(M,N) lower trapezoidal matrix L
*> (L is lower triangular if M <= N);
-*> the elements above the diagonal are the rows of
-*> blocked V representing Q (see Further Details).
+*> the elements above the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -56,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> DLASWLQ or DGELQT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): horizontal block size
-*> WORK1(5): vertical block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> DLASWLQ or DGELQT
+*> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
-*> \param[in] LWORK2
+*>
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -114,105 +113,135 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
-*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any LQ factorization algorithm they wish. The triangular
+*> (trapezoidal) L has to be stored in the lower part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
*> \endverbatim
*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> DLASWLQ or DGELQT
+*>
+*> Depending on the matrix dimensions M and N, and row and column
+*> block sizes MB and NB returned by ILAENV, DGELQ will use either
+*> DLASWLQ (if the matrix is short-and-wide) or DGELQT to compute
+*> the LQ factorization.
+*> \endverbatim
*>
* =====================================================================
- SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * )
+ DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL DGELQT, DLASWLQ, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'DGELQ ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'DGELQ ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'DGELQ ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'DGELQ ', ' ', M, N, 2, -1 )
ELSE
MB = 1
NB = N
END IF
- IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
- IF( NB.GT.N.OR.NB.LE.M) NB = N
- MINLW1 = M + 5
- IF ((NB.GT.M).AND.(N.GT.M)) THEN
- IF(MOD(N-M, NB-M).EQ.0) THEN
- NBLCKS = (N-M)/(NB-M)
+ IF( MB.GT.MIN( M, N ) .OR. MB.LT.1 ) MB = 1
+ IF( NB.GT.N .OR. NB.LE.M ) NB = N
+ MINTSZ = M + 5
+ IF ( NB.GT.M .AND. N.GT.M ) THEN
+ IF( MOD( N - M, NB - M ).EQ.0 ) THEN
+ NBLCKS = ( N - M ) / ( NB - M )
ELSE
- NBLCKS = (N-M)/(NB-M) + 1
+ NBLCKS = ( N - M ) / ( NB - M ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
- $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+ IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
+ $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
LMINWS = .TRUE.
MB = 1
- END IF
- IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
NB = N
END IF
- IF (LWORK2.LT.MB*M) THEN
+ IF( LWORK.LT.MB*M ) THEN
LMINWS = .TRUE.
MB = 1
END IF
@@ -224,44 +253,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 )
- $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS) ) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = MB*M*NBLCKS+5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = MB * M
- WORK2(2) = M
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = MB*M*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, MB*M )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGELQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The LQ Decomposition
*
- IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
- CALL DGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+ IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
+ CALL DGELQT( M, N, MB, A, LDA, T( 6 ), MB, WORK, INFO )
ELSE
- CALL DLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2,
- $ LWORK2, INFO)
+ CALL DLASWLQ( M, N, MB, NB, A, LDA, T( 6 ), MB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, MB*M )
+*
RETURN
*
* End of DGELQ
diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f
index 7bdf97a1..203ca7ec 100644
--- a/SRC/dgemlq.f
+++ b/SRC/dgemlq.f
@@ -2,17 +2,18 @@
* Definition:
* ===========
*
-* SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* DOUBLE A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* DOUBLE PRECISION A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
@@ -20,27 +21,32 @@
*>
*> DGEMLQ 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 blocked elementary reflectors computed by short wide LQ
*> factorization (DGELQ)
+*>
*> \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
@@ -50,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
@@ -58,61 +64,65 @@
*> 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,out] A
+*> \param[in] A
*> \verbatim
-*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th row must contain the vector which defines the blocked
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> A is DOUBLE PRECISION 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] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) is
-*> returned by GEQR.
+*> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by DGELQ.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is DOUBLE PRECISION 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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -128,53 +138,63 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> DLASWLQ or DGELQT
+*>
*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> block sizes MB and NB returned by ILAENV, DGELQ will use either
+*> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute
+*> the LQ factorization.
+*> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to
+*> multiply matrix Q by another matrix.
+*> Further Details in DLAMSWLQ or DGEMLQT.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+ DOUBLE PRECISION 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 DTPMLQT, DGEMLQT, XERBLA
+ EXTERNAL DLAMSWLQ, DGEMLQT, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -182,26 +202,27 @@
*
* Test the input arguments
*
- LQUERY = (LWORK2.LT.0)
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF (LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * MB
MN = M
ELSE
LW = M * MB
MN = N
END IF
- IF ((NB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, NB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(NB-K)
+*
+ IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
+ NBLCKS = ( MN - K ) / ( NB - K )
ELSE
- NBLCKS = (MN-K)/(NB-K) + 1
+ NBLCKS = ( MN - K ) / ( NB - K ) + 1
END IF
ELSE
NBLCKS = 1
@@ -209,51 +230,52 @@
*
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( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LW
END IF
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEMLQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
+ ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
- $ (NB.GE.MAX(M,N,K))) THEN
+ 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 DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
- $ WORK1(6), MB, C, LDC, WORK2, INFO)
+ $ T( 6 ), MB, C, LDC, WORK, INFO )
ELSE
- CALL DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ MB, C, LDC, WORK2, LWORK2, INFO )
+ CALL DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
*
RETURN
*
diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f
index f47e6a87..6032be6d 100644
--- a/SRC/dgemqr.f
+++ b/SRC/dgemqr.f
@@ -2,48 +2,52 @@
* Definition:
* ===========
*
-* SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
-* ..
-*
+* DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
+* ..
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> DGEMQR overwrites the general real M-by-N matrix C with
-*>
+*> DGEMQR 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 blocked elementary reflectors computed by tall skinny
-*> QR factorization (DGEQR)
+*>
+*> where Q is a real orthogonal matrix defined as the product
+*> of blocked elementary reflectors computed by tall skinny
+*> QR factorization (DGEQR)
+*>
*> \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
@@ -53,7 +57,7 @@
*> \param[in] N
*> \verbatim
*> N is INTEGER
-*> The number of columns of the matrix C. M >= N >= 0.
+*> The number of columns of the matrix C. N >= 0.
*> \endverbatim
*>
*> \param[in] K
@@ -61,17 +65,14 @@
*> K is INTEGER
*> The number of elementary reflectors whose product defines
*> the matrix Q.
-*> N >= K >= 0;
-*>
+*> If SIDE = 'L', M >= K >= 0;
+*> if SIDE = 'R', N >= K >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> blockedelementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGETSQR in the first k columns of
-*> its array argument A.
+*> Part of the data structure to represent Q as returned by DGEQR.
*> \endverbatim
*>
*> \param[in] LDA
@@ -82,42 +83,46 @@
*> if SIDE = 'R', LDA >= max(1,N).
*> \endverbatim
*>
-*> \param[in] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) as
-*> it is returned by GEQR.
+*> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by DGEQR.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is DOUBLE PRECISION 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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -133,54 +138,64 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> DLATSQR or DGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, DGEQR will use either
+*> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
+*> the QR factorization.
+*> This version of DGEMQR will use either DLAMTSQR or DGEMQRT to
+*> multiply matrix Q by another matrix.
+*> Further Details in DLATMSQR or DGEMQRT.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK1( * ), C(LDC, * ),
- $ WORK2( * )
+ DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER MB, NB, I, II, KK, LW, NBLCKS, MN
+ LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+ INTEGER MB, NB, LW, NBLCKS, MN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
+* ..
* .. External Subroutines ..
- EXTERNAL DGEMQRT, DTPMQRT, XERBLA
+ EXTERNAL DGEMQRT, DLAMTSQR, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -188,82 +203,80 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF(LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * NB
MN = M
- ELSE IF(RIGHT) THEN
+ ELSE
LW = MB * NB
MN = N
END IF
*
- IF ((MB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, MB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(MB-K)
- ELSE
- NBLCKS = (MN-K)/(MB-K) + 1
- END IF
+ IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
+ NBLCKS = ( MN - K ) / ( MB - K )
+ ELSE
+ NBLCKS = ( MN - K ) / ( MB - K ) + 1
+ END IF
ELSE
NBLCKS = 1
END IF
*
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
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
+ ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
INFO = -7
- ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
- ELSE IF( LDC.LT.MAX( 1, M ).AND.MIN(M,N,K).NE.0 ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
-* Determine the block size if it is tall skinny or short and wide
-*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LW
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEMQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
- $ (MB.GE.MAX(M,N,K))) THEN
- CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
- $ WORK1(6), NB, C, LDC, WORK2, INFO)
+ IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
+ $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
+ CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, INFO )
ELSE
- CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ NB, C, LDC, WORK2, LWORK2, INFO )
+ CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
*
RETURN
*
diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f
index da0fc4ad..5212c69e 100644
--- a/SRC/dgeqr.f
+++ b/SRC/dgeqr.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * )
+* DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> DGEQR computes a QR factorization of an M-by-N matrix A,
-*> using DLATSQR when A is tall and skinny
-*> (M sufficiently greater than N), and otherwise DGEQRT:
-*> A = Q * R .
+*> DGEQR computes a QR factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,7 +42,8 @@
*> On exit, the elements on and above the diagonal of the array
*> contain the min(M,N)-by-N upper trapezoidal matrix R
*> (R is upper triangular if M >= N);
-*> the elements below the diagonal represent Q (see Further Details).
+*> the elements below the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -55,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> DLATSQR or DGEQRT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): row block size
-*> WORK1(5): column block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> DLATSQR or DGEQRT
+*> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
+*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
-*> \param[in] LWORK2
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -113,106 +113,138 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any QR factorization algorithm they wish. The triangular
+*> (trapezoidal) R has to be stored in the upper part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> DLATSQR or DGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, DGEQR will use either
+*> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
+*> the QR factorization.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * )
+ DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL DLATSQR, DGEQRT, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'DGEQR ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'DGEQR ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'DGEQR ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'DGEQR ', ' ', M, N, 2, -1 )
ELSE
MB = M
NB = 1
END IF
- IF( MB.GT.M.OR.MB.LE.N) MB = M
- IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
- MINLW1 = N + 5
- IF ((MB.GT.N).AND.(M.GT.N)) THEN
- IF(MOD(M-N, MB-N).EQ.0) THEN
- NBLCKS = (M-N)/(MB-N)
+ IF( MB.GT.M .OR. MB.LE.N ) MB = M
+ IF( NB.GT.MIN( M, N ) .OR. NB.LT.1 ) NB = 1
+ MINTSZ = N + 5
+ IF( MB.GT.N .AND. M.GT.N ) THEN
+ IF( MOD( M - N, MB - N ).EQ.0 ) THEN
+ NBLCKS = ( M - N ) / ( MB - N )
ELSE
- NBLCKS = (M-N)/(MB-N) + 1
+ NBLCKS = ( M - N ) / ( MB - N ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5)
- $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N )
+ $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ NB = 1
+ MB = M
END IF
- IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = M
- END IF
- IF (LWORK2.LT.NB*N) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( LWORK.LT.NB*N ) THEN
+ LMINWS = .TRUE.
+ NB = 1
END IF
END IF
*
@@ -222,44 +254,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 )
- $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS)) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
-
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = NB * N * NBLCKS + 5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = NB * N
- WORK2(2) = N
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = NB*N*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, NB*N )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGEQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The QR Decomposition
*
- IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
- CALL DGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+ IF( ( M.LE.N ) .OR. ( MB.LE.N ) .OR. ( MB.GE.M ) ) THEN
+ CALL DGEQRT( M, N, NB, A, LDA, T( 6 ), NB, WORK, INFO )
ELSE
- CALL DLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2,
- $ LWORK2, INFO)
+ CALL DLATSQR( M, N, MB, NB, A, LDA, T( 6 ), NB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, NB*N )
+*
RETURN
*
* End of DGEQR
diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f
index f2a7b3a7..13a8fd19 100644
--- a/SRC/dgetsls.f
+++ b/SRC/dgetsls.f
@@ -29,16 +29,21 @@
*> 1. If TRANS = 'N' and m >= n: find the least squares solution of
*> an overdetermined system, i.e., solve the least squares problem
*> minimize || B - A*X ||.
-
+*>
*> 2. If TRANS = 'N' and m < n: find the minimum norm solution of
*> an underdetermined system A * X = B.
-
+*>
*> 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
*> an undetermined system A**T * X = B.
-
+*>
*> 4. If TRANS = 'T' and m < n: find the least squares solution of
*> an overdetermined system, i.e., solve the least squares problem
*> minimize || B - A**T * X ||.
+*>
+*> Several right hand side vectors b and solution vectors x can be
+*> handled in a single call; they are stored as the columns of the
+*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+*> matrix X.
*> \endverbatim
*
* Arguments:
@@ -76,7 +81,7 @@
*> On entry, the M-by-N matrix A.
*> On exit,
*> A is overwritten by details of its QR or LQ
-*> factorization as returned by DGETSQR.
+*> factorization as returned by DGEQR or DGELQ.
*> \endverbatim
*>
*> \param[in] LDA
@@ -111,18 +116,21 @@
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (MAX(12,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK,
-*> and WORK(2) returns the minimum LWORK.
+*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
-*> IF LWORK=-1, workspace query is assumed, and
-*> WORK(1) returns the optimal LWORK,
-*> and WORK(2) returns the minimum LWORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -144,18 +152,18 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date November 2016
*
*> \ingroup doubleGEsolve
*
* =====================================================================
SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
- $ WORK, LWORK, INFO )
+ $ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.4.0) --
+* -- LAPACK driver 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 2011
+* November 2016
*
* .. Scalar Arguments ..
CHARACTER TRANS
@@ -174,10 +182,10 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
- INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2,
- $ INFO2
- DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
+ INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
+ $ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
+ $ WSIZEO, WSIZEM, INFO2
+ DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -190,19 +198,19 @@
$ DTRTRS, XERBLA, DGELQ, DGEMLQ
* ..
* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
+ INTRINSIC DBLE, MAX, MIN, INT
* ..
* .. Executable Statements ..
*
* Test the input arguments.
*
- INFO=0
+ INFO = 0
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
- MNK = MAX(MINMN,NRHS)
+ MNK = MAX( MINMN, NRHS )
TRAN = LSAME( TRANS, 'T' )
*
- LQUERY = ( LWORK.EQ.-1 )
+ LQUERY = ( LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'T' ) ) ) THEN
INFO = -1
@@ -218,56 +226,71 @@
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
+ IF( INFO.EQ.0 ) THEN
*
* Determine the block size and minimum LWORK
*
- IF ( M.GE.N ) THEN
- CALL DGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- LW = INT(WORK(6))
- CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+ IF( M.GE.N ) THEN
+ CALL DGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL DGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZM, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
ELSE
- CALL DGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- LW = INT(WORK(6))
- CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+ CALL DGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL DGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
END IF
*
- IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
- INFO=-10
+ IF( ( LWORK.LT.WSIZEM ).AND.( .NOT.LQUERY ) ) THEN
+ INFO = -10
END IF
+*
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DGETSLS', -INFO )
WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
RETURN
- ELSE IF (LQUERY) THEN
- WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
+ END IF
+ IF( LQUERY ) THEN
+ IF( LWORK.EQ.-1 ) WORK( 1 ) = REAL( WSIZEO )
+ IF( LWORK.EQ.-2 ) WORK( 1 ) = REAL( WSIZEM )
RETURN
END IF
- IF(LWORK.LT.WSIZEO) THEN
- LW1=INT(WORK(3))
- LW2=MAX(LW,INT(WORK(6)))
+ IF( LWORK.LT.WSIZEO ) THEN
+ LW1 = TSZM
+ LW2 = LWM
ELSE
- LW1=INT(WORK(2))
- LW2=MAX(LW,INT(WORK(6)))
+ LW1 = TSZO
+ LW2 = LWO
END IF
*
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
CALL DLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO,
- $ B, LDB )
+ $ B, LDB )
RETURN
END IF
*
@@ -323,26 +346,27 @@
IBSCL = 2
END IF
*
- IF ( M.GE.N) THEN
+ IF ( M.GE.N ) THEN
*
* compute QR factorization of A
*
- CALL DGEQR( M, N, A, LDA, WORK(LW2+1), LW1,
- $ WORK(1), LW2, INFO )
- IF (.NOT.TRAN) THEN
+ CALL DGEQR( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
+ IF ( .NOT.TRAN ) THEN
*
* Least-Squares Problem min || A * X - B ||
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
CALL DGEMQR( 'L' , 'T', M, NRHS, N, A, LDA,
- $ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
+ $ INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL DTRTRS( 'U', 'N', 'N', N, NRHS,
- $ A, LDA, B, LDB, INFO )
- IF(INFO.GT.0) THEN
+ $ A, LDA, B, LDB, INFO )
+ IF( INFO.GT.0 ) THEN
RETURN
END IF
SCLLEN = N
@@ -370,7 +394,7 @@
* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
*
CALL DGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
SCLLEN = M
@@ -381,8 +405,8 @@
*
* Compute LQ factorization of A
*
- CALL DGELQ( M, N, A, LDA, WORK(LW2+1), LW1,
- $ WORK(1), LW2, INFO )
+ CALL DGELQ( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
*
* workspace at least M, optimally M*NB.
*
@@ -410,7 +434,7 @@
* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
*
CALL DGEMLQ( 'L', 'T', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -424,7 +448,7 @@
* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
*
CALL DGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -448,22 +472,21 @@
*
IF( IASCL.EQ.1 ) THEN
CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
ELSE IF( IASCL.EQ.2 ) THEN
CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
END IF
IF( IBSCL.EQ.1 ) THEN
- CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
ELSE IF( IBSCL.EQ.2 ) THEN
- CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
END IF
*
50 CONTINUE
- WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
+ WORK( 1 ) = DBLE( TSZO + LWO )
RETURN
*
* End of DGETSLS
diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f
index 3bf0e798..6eed0389 100644
--- a/SRC/dlamswlq.f
+++ b/SRC/dlamswlq.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -115,18 +120,23 @@
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is DOUBLE PRECISION 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) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
-*>
*> \endverbatim
+*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
@@ -137,8 +147,8 @@
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
-*>
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f
index a4f5a025..59d4ae55 100644
--- a/SRC/dlamtsqr.f
+++ b/SRC/dlamtsqr.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -109,12 +114,17 @@
*> \endverbatim
*>
*> \param[in,out] C
+*> \verbatim
*> C is DOUBLE PRECISION 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
@@ -253,6 +263,7 @@
IF( INFO.EQ.0) THEN
WORK(1) = LW
END IF
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DLAMTSQR', -INFO )
RETURN
@@ -352,8 +363,8 @@
*
* Multiply Q to the current block of C (1:M,I:I+MB)
*
- CTR = CTR - 1
- CALL DTPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
+ CTR = CTR - 1
+ CALL DTPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
$ T(1,CTR*K+1), LDT, C(1,1), LDC,
$ C(1,I), LDC, WORK, INFO )
*
diff --git a/SRC/sgelq.f b/SRC/sgelq.f
index 8a759834..1ae47d15 100644
--- a/SRC/sgelq.f
+++ b/SRC/sgelq.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* REAL A( LDA, * ), WORK1( * ), WORK2( * )
+* REAL A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> SGELQ computes an LQ factorization of an M-by-N matrix A,
-*> using SLASWLQ when A is short and wide
-*> (N sufficiently greater than M), and otherwise SGELQT:
-*> A = L * Q .
+*> SGELQ computes a LQ factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,8 +42,8 @@
*> On exit, the elements on and below the diagonal of the array
*> contain the M-by-min(M,N) lower trapezoidal matrix L
*> (L is lower triangular if M <= N);
-*> the elements above the diagonal are the rows of
-*> blocked V representing Q (see Further Details).
+*> the elements above the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -56,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is REAL array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> SLASWLQ or SGELQT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): horizontal block size
-*> WORK1(5): vertical block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> SLASWLQ or SGELQT
+*> T is REAL array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) REAL array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) REAL array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
-*> \param[in] LWORK2
+*>
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -114,107 +113,137 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
-*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any LQ factorization algorithm they wish. The triangular
+*> (trapezoidal) L has to be stored in the lower part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
*> \endverbatim
*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> 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, SGELQ will use either
+*> SLASWLQ (if the matrix is short-and-wide) or SGELQT to compute
+*> the LQ factorization.
+*> \endverbatim
*>
* =====================================================================
- SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), WORK1( * ), WORK2( * )
+ REAL A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL SGELQT, SLASWLQ, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'SGELQ ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'SGELQ ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'SGELQ ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'SGELQ ', ' ', M, N, 2, -1 )
ELSE
MB = 1
NB = N
END IF
- IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
- IF( NB.GT.N.OR.NB.LE.M) NB = N
- MINLW1 = M + 5
- IF ((NB.GT.M).AND.(N.GT.M)) THEN
- IF(MOD(N-M, NB-M).EQ.0) THEN
- NBLCKS = (N-M)/(NB-M)
+ IF( MB.GT.MIN( M, N ) .OR. MB.LT.1 ) MB = 1
+ IF( NB.GT.N .OR. NB.LE.M ) NB = N
+ MINTSZ = M + 5
+ IF ( NB.GT.M .AND. N.GT.M ) THEN
+ IF( MOD( N - M, NB - M ).EQ.0 ) THEN
+ NBLCKS = ( N - M ) / ( NB - M )
ELSE
- NBLCKS = (N-M)/(NB-M) + 1
+ NBLCKS = ( N - M ) / ( NB - M ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
- $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = 1
- END IF
- IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = N
+ IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
+ $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ MB = 1
+ NB = N
END IF
- IF (LWORK2.LT.MB*M) THEN
- LMINWS = .TRUE.
- MB = 1
+ IF( LWORK.LT.MB*M ) THEN
+ LMINWS = .TRUE.
+ MB = 1
END IF
END IF
*
@@ -224,44 +253,51 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 )
- $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS) ) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = MB*M*NBLCKS+5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = MB * M
- WORK2(2) = M
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = MB*M*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, MB*M )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGELQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The LQ Decomposition
*
- IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
- CALL SGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+ IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
+ CALL SGELQT( M, N, MB, A, LDA, T( 6 ), MB, WORK, INFO )
ELSE
- CALL SLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2,
- $ LWORK2, INFO)
+ CALL SLASWLQ( M, N, MB, NB, A, LDA, T( 6 ), MB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, MB*M )
RETURN
*
* End of SGELQ
diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f
index 14a37a4d..42306ae4 100644
--- a/SRC/sgemlq.f
+++ b/SRC/sgemlq.f
@@ -2,45 +2,51 @@
* Definition:
* ===========
*
-* SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* REAL A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* REAL A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> DGEMLQ 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
*> TRANS = 'T': Q**T * C C * Q**T
*> where Q is a real orthogonal matrix defined as the product
*> of blocked elementary reflectors computed by short wide LQ
-*> factorization (DGELQ)
+*> 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
@@ -50,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
@@ -58,61 +64,64 @@
*> 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,out] A
+*> \param[in] A
*> \verbatim
-*> A is REAL array, dimension (LDA,K)
-*> The i-th row must contain the vector which defines the blocked
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> 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] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is REAL array, dimension (MAX(1,LWORK1)) is
-*> returned by GEQR.
+*> T is REAL array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by SGELQ.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) REAL array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) REAL array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -128,53 +137,63 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> 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 SGEMLQ will use either SLAMSWLQ or SGEMLQT to
+*> multiply matrix Q by another matrix.
+*> Further Details in SLAMSWLQ or SGEMLQT.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+ 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 STPMLQT, SGEMLQT, XERBLA
+ EXTERNAL SLAMSWLQ, SGEMLQT, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -182,26 +201,27 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF (LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * MB
MN = M
ELSE
LW = M * MB
MN = N
END IF
- IF ((NB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, NB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(NB-K)
+*
+ IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
+ NBLCKS = ( MN - K ) / ( NB - K )
ELSE
- NBLCKS = (MN-K)/(NB-K) + 1
+ NBLCKS = ( MN - K ) / ( NB - K ) + 1
END IF
ELSE
NBLCKS = 1
@@ -209,51 +229,53 @@
*
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( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
- IF( INFO.EQ.0) THEN
- WORK2(1) = 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
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
- $ (NB.GE.MAX(M,N,K))) THEN
+ 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,
- $ WORK1(6), MB, C, LDC, WORK2, INFO)
+ $ T( 6 ), MB, C, LDC, WORK, INFO )
ELSE
- CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ MB, C, LDC, WORK2, LWORK2, INFO )
+ CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = REAL( LW )
+*
RETURN
*
* End of SGEMLQ
diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f
index cda7990c..6bf3a1bd 100644
--- a/SRC/sgemqr.f
+++ b/SRC/sgemqr.f
@@ -2,45 +2,52 @@
* Definition:
* ===========
*
-* SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* REAL A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* REAL A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> SGEMQR overwrites the general real M-by-N matrix C with
-*>
+*> SGEMQR 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 blocked elementary reflectors computed by tall skinny
-*> QR factorization (DGEQR)
+*> 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 blocked elementary reflectors computed by tall skinny
+*> QR factorization (SGEQR)
+*>
*> \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
@@ -50,7 +57,7 @@
*> \param[in] N
*> \verbatim
*> N is INTEGER
-*> The number of columns of the matrix C. M >= N >= 0.
+*> The number of columns of the matrix C. N >= 0.
*> \endverbatim
*>
*> \param[in] K
@@ -58,17 +65,14 @@
*> K is INTEGER
*> The number of elementary reflectors whose product defines
*> the matrix Q.
-*> N >= K >= 0;
-*>
+*> If SIDE = 'L', M >= K >= 0;
+*> if SIDE = 'R', N >= K >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> blockedelementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGETSQR in the first k columns of
-*> its array argument A.
+*> Part of the data structure to represent Q as returned by SGEQR.
*> \endverbatim
*>
*> \param[in] LDA
@@ -79,42 +83,46 @@
*> if SIDE = 'R', LDA >= max(1,N).
*> \endverbatim
*>
-*> \param[in] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is REAL array, dimension (MAX(1,LWORK1)) as
-*> it is returned by GEQR.
+*> T is REAL array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by SGEQR.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) REAL array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) REAL array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -130,54 +138,64 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> SLATSQR or SGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, SGEQR will use either
+*> SLATSQR (if the matrix is tall-and-skinny) or SGEQRT to compute
+*> the QR factorization.
+*> This version of SGEMQR will use either SLAMTSQR or SGEMQRT to
+*> multiply matrix Q by another matrix.
+*> Further Details in SLAMTSQR or SGEMQRT.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), WORK1( * ), C(LDC, * ),
- $ WORK2( * )
+ REAL A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER MB, NB, I, II, KK, LW, NBLCKS, MN
+ LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+ INTEGER MB, NB, LW, NBLCKS, MN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
+* ..
* .. External Subroutines ..
- EXTERNAL SGEMQRT, STPMQRT, XERBLA
+ EXTERNAL SGEMQRT, SLAMTSQR, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -185,82 +203,80 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'T' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF(LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * NB
MN = M
- ELSE IF(RIGHT) THEN
+ ELSE
LW = MB * NB
MN = N
END IF
*
- IF ((MB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, MB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(MB-K)
- ELSE
- NBLCKS = (MN-K)/(MB-K) + 1
- END IF
+ IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
+ NBLCKS = ( MN - K ) / ( MB - K )
+ ELSE
+ NBLCKS = ( MN - K ) / ( MB - K ) + 1
+ END IF
ELSE
NBLCKS = 1
END IF
*
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
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
+ ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
INFO = -7
- ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
- ELSE IF( LDC.LT.MAX( 1, M ).AND.MIN(M,N,K).NE.0 ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
-* Determine the block size if it is tall skinny or short and wide
-*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LW
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEMQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
- $ (MB.GE.MAX(M,N,K))) THEN
- CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
- $ WORK1(6), NB, C, LDC, WORK2, INFO)
+ IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
+ $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
+ CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, INFO )
ELSE
- CALL SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ NB, C, LDC, WORK2, LWORK2, INFO )
+ CALL SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
*
RETURN
*
diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f
index 41e04622..3f561a45 100644
--- a/SRC/sgeqr.f
+++ b/SRC/sgeqr.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* REAL A( LDA, * ), WORK1( * ), WORK2( * )
+* REAL A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> SGEQR computes a QR factorization of an M-by-N matrix A,
-*> using SLATSQR when A is tall and skinny
-*> (M sufficiently greater than N), and otherwise SGEQRT:
-*> A = Q * R .
+*> SGEQR computes a QR factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,7 +42,8 @@
*> On exit, the elements on and above the diagonal of the array
*> contain the min(M,N)-by-N upper trapezoidal matrix R
*> (R is upper triangular if M >= N);
-*> the elements below the diagonal represent Q (see Further Details).
+*> the elements below the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -55,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is REAL array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> DLATSQR or DGEQRT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): row block size
-*> WORK1(5): column block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> SLATSQR or SGEQRT
+*> T is REAL array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) REAL array, dimension (MAX(1,LWORK2))
+*> (workspace) REAL array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
-*> \param[in] LWORK2
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -113,106 +113,138 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any QR factorization algorithm they wish. The triangular
+*> (trapezoidal) R has to be stored in the upper part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> SLATSQR or SGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, SGEQR will use either
+*> SLATSQR (if the matrix is tall-and-skinny) or SGEQRT to compute
+*> the QR factorization.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- REAL A( LDA, * ), WORK1( * ), WORK2( * )
+ REAL A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL SLATSQR, SGEQRT, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'SGEQR ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'SGEQR ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'SGEQR ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'SGEQR ', ' ', M, N, 2, -1 )
ELSE
MB = M
NB = 1
END IF
- IF( MB.GT.M.OR.MB.LE.N) MB = M
- IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
- MINLW1 = N + 5
- IF ((MB.GT.N).AND.(M.GT.N)) THEN
- IF(MOD(M-N, MB-N).EQ.0) THEN
- NBLCKS = (M-N)/(MB-N)
+ IF( MB.GT.M .OR. MB.LE.N ) MB = M
+ IF( NB.GT.MIN( M, N ) .OR. NB.LT.1 ) NB = 1
+ MINTSZ = N + 5
+ IF ( MB.GT.N .AND. M.GT.N ) THEN
+ IF( MOD( M - N, MB - N ).EQ.0 ) THEN
+ NBLCKS = ( M - N ) / ( MB - N )
ELSE
- NBLCKS = (M-N)/(MB-N) + 1
+ NBLCKS = ( M - N ) / ( MB - N ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5)
- $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N )
+ $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ NB = 1
+ MB = M
END IF
- IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = M
- END IF
- IF (LWORK2.LT.NB*N) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( LWORK.LT.NB*N ) THEN
+ LMINWS = .TRUE.
+ NB = 1
END IF
END IF
*
@@ -222,44 +254,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 )
- $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS)) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
-
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = NB * N * NBLCKS + 5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = NB * N
- WORK2(2) = N
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = NB*N*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, NB*N )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGEQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The QR Decomposition
*
- IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
- CALL SGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+ IF( ( M.LE.N ) .OR. ( MB.LE.N ) .OR. ( MB.GE.M ) ) THEN
+ CALL SGEQRT( M, N, NB, A, LDA, T( 6 ), NB, WORK, INFO )
ELSE
- CALL SLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2,
- $ LWORK2, INFO)
+ CALL SLATSQR( M, N, MB, NB, A, LDA, T( 6 ), NB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, NB*N )
+*
RETURN
*
* End of SGEQR
diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f
index b7bcd0f0..1dbfb305 100644
--- a/SRC/sgetsls.f
+++ b/SRC/sgetsls.f
@@ -1,16 +1,15 @@
* Definition:
* ===========
*
-* SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
-* $ , WORK, LWORK, INFO )
-
+* SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+* $ WORK, LWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
-* REAL A( LDA, * ), B( LDB, * ), WORK( * )
+* REAL A( LDA, * ), B( LDB, * ), WORK( * )
* ..
*
*
@@ -30,16 +29,21 @@
*> 1. If TRANS = 'N' and m >= n: find the least squares solution of
*> an overdetermined system, i.e., solve the least squares problem
*> minimize || B - A*X ||.
-
+*>
*> 2. If TRANS = 'N' and m < n: find the minimum norm solution of
*> an underdetermined system A * X = B.
-
+*>
*> 3. If TRANS = 'T' and m >= n: find the minimum norm solution of
*> an undetermined system A**T * X = B.
-
+*>
*> 4. If TRANS = 'T' and m < n: find the least squares solution of
*> an overdetermined system, i.e., solve the least squares problem
*> minimize || B - A**T * X ||.
+*>
+*> Several right hand side vectors b and solution vectors x can be
+*> handled in a single call; they are stored as the columns of the
+*> M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+*> matrix X.
*> \endverbatim
*
* Arguments:
@@ -77,7 +81,7 @@
*> On entry, the M-by-N matrix A.
*> On exit,
*> A is overwritten by details of its QR or LQ
-*> factorization as returned by DGETSQR.
+*> factorization as returned by SGEQR or SGELQ.
*> \endverbatim
*>
*> \param[in] LDA
@@ -112,18 +116,21 @@
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK,
-*> and WORK(2) returns the minimum LWORK.
+*> (workspace) REAL array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
-*> IF LWORK=-1, workspace query is assumed, and
-*> WORK(1) returns the optimal LWORK,
-*> and WORK(2) returns the minimum LWORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -145,22 +152,22 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date November 2016
*
*> \ingroup doubleGEsolve
*
* =====================================================================
- SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
- $ , WORK, LWORK, INFO )
+ SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+ $ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.4.0) --
+* -- LAPACK driver 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 2011
+* November 2016
*
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+ INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
REAL A( LDA, * ), B( LDB, * ), WORK( * )
@@ -175,10 +182,10 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
- INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2,
- $ NB
- REAL ANRM, BIGNUM, BNRM, SMLNUM
+ INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
+ $ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
+ $ WSIZEO, WSIZEM, INFO2
+ REAL ANRM, BIGNUM, BNRM, SMLNUM, TQ( 5 ), WORKQ
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -191,19 +198,19 @@
$ STRTRS, XERBLA, SGELQ, SGEMLQ
* ..
* .. Intrinsic Functions ..
- INTRINSIC REAL, MAX, MIN
+ INTRINSIC REAL, MAX, MIN, INT
* ..
* .. Executable Statements ..
*
* Test the input arguments.
*
- INFO=0
+ INFO = 0
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
- MNK = MAX(MINMN,NRHS)
+ MNK = MAX( MINMN, NRHS )
TRAN = LSAME( TRANS, 'T' )
*
- LQUERY = ( LWORK.EQ.-1 )
+ LQUERY = ( LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'T' ) ) ) THEN
INFO = -1
@@ -219,60 +226,71 @@
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
+ IF( INFO.EQ.0 ) THEN
*
* Determine the block size and minimum LWORK
*
- IF ( M.GE.N ) THEN
- CALL SGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+ IF( M.GE.N ) THEN
+ CALL SGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL SGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZM, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
ELSE
- CALL SGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+ CALL SGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL SGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
END IF
*
- IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
- INFO=-10
+ IF( ( LWORK.LT.WSIZEM ).AND.( .NOT.LQUERY ) ) THEN
+ INFO = -10
END IF
+*
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SGETSLS', -INFO )
WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
RETURN
- ELSE IF (LQUERY) THEN
- WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
+ END IF
+ IF( LQUERY ) THEN
+ IF( LWORK.EQ.-1 ) WORK( 1 ) = REAL( WSIZEO )
+ IF( LWORK.EQ.-2 ) WORK( 1 ) = REAL( WSIZEM )
RETURN
END IF
- IF(LWORK.LT.WSIZEO) THEN
- LW1=INT(WORK(3))
- LW2=MAX(LW,INT(WORK(6)))
+ IF( LWORK.LT.WSIZEO ) THEN
+ LW1 = TSZM
+ LW2 = LWM
ELSE
- LW1=INT(WORK(2))
- LW2=MAX(LW,INT(WORK(6)))
+ LW1 = TSZO
+ LW2 = LWO
END IF
*
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
CALL SLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO,
- $ B, LDB )
+ $ B, LDB )
RETURN
END IF
*
@@ -328,26 +346,27 @@
IBSCL = 2
END IF
*
- IF ( M.GE.N) THEN
+ IF ( M.GE.N ) THEN
*
* compute QR factorization of A
*
- CALL SGEQR( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
- IF (.NOT.TRAN) THEN
+ CALL SGEQR( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
+ IF ( .NOT.TRAN ) THEN
*
* Least-Squares Problem min || A * X - B ||
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
CALL SGEMQR( 'L' , 'T', M, NRHS, N, A, LDA,
- $ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
+ $ INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL STRTRS( 'U', 'N', 'N', N, NRHS,
- $ A, LDA, B, LDB, INFO )
- IF(INFO.GT.0) THEN
+ $ A, LDA, B, LDB, INFO )
+ IF( INFO.GT.0 ) THEN
RETURN
END IF
SCLLEN = N
@@ -375,7 +394,7 @@
* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
*
CALL SGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
SCLLEN = M
@@ -386,8 +405,8 @@
*
* Compute LQ factorization of A
*
- CALL SGELQ( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
+ CALL SGELQ( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
*
* workspace at least M, optimally M*NB.
*
@@ -415,7 +434,7 @@
* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
*
CALL SGEMLQ( 'L', 'T', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -429,7 +448,7 @@
* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
*
CALL SGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -453,22 +472,21 @@
*
IF( IASCL.EQ.1 ) THEN
CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
ELSE IF( IASCL.EQ.2 ) THEN
CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
END IF
IF( IBSCL.EQ.1 ) THEN
- CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
ELSE IF( IBSCL.EQ.2 ) THEN
- CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
END IF
*
50 CONTINUE
- WORK( 1 ) = REAL( WSIZEO )
- WORK( 2 ) = REAL( WSIZEM )
+ WORK( 1 ) = REAL( TSZO + LWO )
RETURN
*
* End of SGETSLS
diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f
index f8719139..fc30556b 100644
--- a/SRC/slamswlq.f
+++ b/SRC/slamswlq.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -115,18 +120,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
@@ -137,8 +147,8 @@
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
-*>
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f
index 69d6c327..f3e176db 100644
--- a/SRC/slamtsqr.f
+++ b/SRC/slamtsqr.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -109,12 +114,17 @@
*> \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
@@ -247,14 +257,13 @@
ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
INFO = -15
END IF
- IF( INFO.EQ.0) THEN
*
* Determine the block size if it is tall skinny or short and wide
*
IF( INFO.EQ.0) THEN
WORK(1) = LW
END IF
- END IF
+*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'SLAMTSQR', -INFO )
RETURN
@@ -354,10 +363,11 @@
*
* Multiply Q to the current block of C (1:M,I:I+MB)
*
- CTR = CTR - 1
- CALL STPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
+ CTR = CTR - 1
+ CALL STPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
$ T(1, CTR * K + 1), LDT, C(1,1), LDC,
$ C(1,I), LDC, WORK, INFO )
+*
END DO
*
* Multiply Q to the first block of C (1:M,1:MB)
diff --git a/SRC/zgelq.f b/SRC/zgelq.f
index 33125b3d..73d54771 100644
--- a/SRC/zgelq.f
+++ b/SRC/zgelq.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * )
+* COMPLEX*16 A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> ZGELQ computes an LQ factorization of an M-by-N matrix A,
-*> using ZLASWLQ when A is short and wide
-*> (N sufficiently greater than M), and otherwise ZGELQT:
-*> A = L * Q .
+*> ZGELQ computes a LQ factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,8 +42,8 @@
*> On exit, the elements on and below the diagonal of the array
*> contain the M-by-min(M,N) lower trapezoidal matrix L
*> (L is lower triangular if M <= N);
-*> the elements above the diagonal are the rows of
-*> blocked V representing Q (see Further Details).
+*> the elements above the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -56,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> ZLASWLQ or ZGELQT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): horizontal block size
-*> WORK1(5): vertical block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> ZLASWLQ or ZGELQT
+*> T is COMPLEX*16 array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
-*> \param[in] LWORK2
+*>
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -114,104 +113,135 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any LQ factorization algorithm they wish. The triangular
+*> (trapezoidal) L has to be stored in the lower part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
+*>
+*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> block sizes MB and NB returned by ILAENV, ZGELQ will use either
+*> ZLASWLQ (if the matrix is short-and-wide) or ZGELQT to compute
+*> the LQ factorization.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE ZGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * )
+ COMPLEX*16 A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
+* ..
+* .. External Subroutines ..
EXTERNAL ZGELQT, ZLASWLQ, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 2, -1)
+ IF( MIN( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 2, -1 )
ELSE
MB = 1
NB = N
END IF
- IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
- IF( NB.GT.N.OR.NB.LE.M) NB = N
- MINLW1 = M + 5
- IF ((NB.GT.M).AND.(N.GT.M)) THEN
- IF(MOD(N-M, NB-M).EQ.0) THEN
- NBLCKS = (N-M)/(NB-M)
+ IF( MB.GT.MIN( M, N ) .OR. MB.LT.1 ) MB = 1
+ IF( NB.GT.N .OR. NB.LE.M ) NB = N
+ MINTSZ = M + 5
+ IF ( NB.GT.M .AND. N.GT.M ) THEN
+ IF( MOD( N - M, NB - M ).EQ.0 ) THEN
+ NBLCKS = ( N - M ) / ( NB - M )
ELSE
- NBLCKS = (N-M)/(NB-M) + 1
+ NBLCKS = ( N - M ) / ( NB - M ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
- $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+ IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
+ $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
LMINWS = .TRUE.
MB = 1
- END IF
- IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
- LMINWS = .TRUE.
NB = N
END IF
- IF (LWORK2.LT.MB*M) THEN
+ IF( LWORK.LT.MB*M ) THEN
LMINWS = .TRUE.
MB = 1
END IF
@@ -223,44 +253,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 )
- $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS) ) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = MB*M*NBLCKS+5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = MB * M
- WORK2(2) = M
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = MB*M*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, MB*M )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGELQ', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The LQ Decomposition
*
- IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
- CALL ZGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+ IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
+ CALL ZGELQT( M, N, MB, A, LDA, T( 6 ), MB, WORK, INFO )
ELSE
- CALL ZLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2,
- $ LWORK2, INFO)
+ CALL ZLASWLQ( M, N, MB, NB, A, LDA, T( 6 ), MB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, MB*M )
+*
RETURN
*
* End of ZGELQ
diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f
index 10d3a5e4..5602d872 100644
--- a/SRC/zgemlq.f
+++ b/SRC/zgemlq.f
@@ -2,17 +2,16 @@
* Definition:
* ===========
*
-* SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* COMPLEX*16 A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
*> \par Purpose:
* =============
*>
@@ -20,27 +19,32 @@
*>
*> ZGEMLQ overwrites the general real M-by-N matrix C with
*>
+*> SIDE = 'L' SIDE = 'R'
+*> TRANS = 'N': Q * C C * Q
+*> TRANS = 'C': Q**H * C C * Q**H
+*> where Q is a complex unitary matrix defined as the product
+*> of blocked elementary reflectors computed by short wide
+*> LQ factorization (ZGELQ)
*>
-*> SIDE = 'L' SIDE = 'R'
-*> TRANS = 'N': Q * C C * Q
-*> TRANS = 'T': Q**T * C C * Q**T
-*> where Q is a complex orthogonal matrix defined as the product
-*> of blocked elementary reflectors computed by short wide LQ
-*> factorization (DGELQ)
*> \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
@@ -50,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
@@ -58,61 +62,65 @@
*> 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,out] A
+*> \param[in] A
*> \verbatim
-*> A is COMPLEX*16 array, dimension (LDA,K)
-*> The i-th row must contain the vector which defines the blocked
-*> elementary reflector H(i), for i = 1,2,...,k, as returned by
-*> DLASWLQ in the first k rows of its array argument A.
+*> 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] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) is
-*> returned by GEQR.
+*> T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by ZGELQ.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -128,53 +136,63 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> 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 short-and-wide) or GELQT to compute
-*> the LQ decomposition.
-*> The output of LASWLQ or GELQT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LASWLQ or GELQT was used is the same as used below in
-*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LASWLQ or GELQT.
+*> 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 ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to
+*> multiply matrix Q by another matrix.
+*> Further Details in ZLAMSWLQ or ZGEMLQT.
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+ 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
* ..
@@ -182,26 +200,27 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF (LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * MB
MN = M
ELSE
LW = M * MB
MN = N
END IF
- IF ((NB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, NB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(NB-K)
+*
+ IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
+ NBLCKS = ( MN - K ) / ( NB - K )
ELSE
- NBLCKS = (MN-K)/(NB-K) + 1
+ NBLCKS = ( MN - K ) / ( NB - K ) + 1
END IF
ELSE
NBLCKS = 1
@@ -209,51 +228,53 @@
*
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( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
- IF( INFO.EQ.0) THEN
- WORK2(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
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
- $ (NB.GE.MAX(M,N,K))) THEN
+ 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,
- $ WORK1(6), MB, C, LDC, WORK2, INFO)
+ $ T( 6 ), MB, C, LDC, WORK, INFO )
ELSE
- CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ MB, C, LDC, WORK2, LWORK2, INFO )
+ CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ MB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
+*
RETURN
*
* End of ZGEMLQ
diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f
index 3141067f..ed67b45f 100644
--- a/SRC/zgemqr.f
+++ b/SRC/zgemqr.f
@@ -2,45 +2,52 @@
* Definition:
* ===========
*
-* SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,
-* $ LWORK1, C, LDC, WORK2, LWORK2, INFO )
+* SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
+* $ TSIZE, C, LDC, WORK, LWORK, INFO )
*
*
* .. Scalar Arguments ..
-* CHARACTER SIDE, TRANS
-* INTEGER INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+* CHARACTER SIDE, TRANS
+* INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * ), WORK1( * ), C(LDC, * ),
-* $ WORK2( * )
+* COMPLEX*16 A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
+* ..
+*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> ZGEMQR overwrites the general real M-by-N matrix C with
-*>
+*> ZGEMQR 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 complex orthogonal matrix defined as the product
-*> of blocked elementary reflectors computed by tall skinny
-*> QR factorization (ZGEQR)
+*> TRANS = 'T': Q**H * C C * Q**H
+*>
+*> where Q is a complex unitary matrix defined as the product
+*> of blocked elementary reflectors computed by tall skinny
+*> QR factorization (ZGEQR)
+*>
*> \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
@@ -50,7 +57,7 @@
*> \param[in] N
*> \verbatim
*> N is INTEGER
-*> The number of columns of the matrix C. M >= N >= 0.
+*> The number of columns of the matrix C. N >= 0.
*> \endverbatim
*>
*> \param[in] K
@@ -58,17 +65,14 @@
*> K is INTEGER
*> The number of elementary reflectors whose product defines
*> the matrix Q.
-*> N >= K >= 0;
-*>
+*> If SIDE = 'L', M >= K >= 0;
+*> if SIDE = 'R', N >= K >= 0.
*> \endverbatim
*>
-*> \param[in,out] A
+*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,K)
-*> The i-th column must contain the vector which defines the
-*> blockedelementary reflector H(i), for i = 1,2,...,k, as
-*> returned by DGETSQR in the first k columns of
-*> its array argument A.
+*> Part of the data structure to represent Q as returned by ZGEQR.
*> \endverbatim
*>
*> \param[in] LDA
@@ -79,42 +83,46 @@
*> if SIDE = 'R', LDA >= max(1,N).
*> \endverbatim
*>
-*> \param[in] WORK1
+*> \param[in] T
*> \verbatim
-*> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) as
-*> it is returned by GEQR.
+*> T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
+*> Part of the data structure to represent Q as returned by ZGEQR.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
+*> TSIZE is INTEGER
+*> The dimension of the array T. TSIZE >= 5.
*> \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] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
-*>
+*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
*> \endverbatim
-*> \param[in] LWORK2
-*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK2 array, returns
-*> this value as the third entry of the WORK2 array (WORK2(1)),
-*> and no error message related to LWORK2 is issued by XERBLA.
*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1, then a workspace query is assumed. The routine
+*> only calculates the size of the WORK array, returns this
+*> value as WORK(1), and no error message related to WORK
+*> is issued by XERBLA.
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
@@ -130,54 +138,64 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> ZLATSQR or ZGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, ZGEQR will use either
+*> ZLATSQR (if the matrix is tall-and-skinny) or ZGEQRT to compute
+*> the QR factorization.
+*> This version of ZGEMQR will use either ZLAMTSQR or ZGEMQRT to
+*> multiply matrix Q by another matrix.
+*> Further Details in ZLAMTSQR or ZGEMQRT.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,
- $ C, LDC, WORK2, LWORK2, INFO )
+ SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
+ $ 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, LWORK1, LWORK2, LDC
+ CHARACTER SIDE, TRANS
+ INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
* ..
* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), WORK1( * ), C(LDC, * ),
- $ WORK2( * )
+ COMPLEX*16 A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
- INTEGER MB, NB, I, II, KK, LW, NBLCKS, MN
+ LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+ INTEGER MB, NB, LW, NBLCKS, MN
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
+* ..
* .. External Subroutines ..
EXTERNAL ZGEMQRT, ZLAMTSQR, XERBLA
+* ..
* .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, MOD
* ..
@@ -185,84 +203,83 @@
*
* Test the input arguments
*
- LQUERY = LWORK2.LT.0
+ LQUERY = LWORK.EQ.-1
NOTRAN = LSAME( TRANS, 'N' )
TRAN = LSAME( TRANS, 'C' )
LEFT = LSAME( SIDE, 'L' )
RIGHT = LSAME( SIDE, 'R' )
*
- MB = INT(WORK1(4))
- NB = INT(WORK1(5))
- IF(LEFT) THEN
+ MB = INT( T( 2 ) )
+ NB = INT( T( 3 ) )
+ IF( LEFT ) THEN
LW = N * NB
MN = M
- ELSE IF(RIGHT) THEN
+ ELSE
LW = MB * NB
MN = N
END IF
*
- IF ((MB.GT.K).AND.(MN.GT.K)) THEN
- IF(MOD(MN-K, MB-K).EQ.0) THEN
- NBLCKS = (MN-K)/(MB-K)
- ELSE
- NBLCKS = (MN-K)/(MB-K) + 1
- END IF
+ IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
+ IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
+ NBLCKS = ( MN - K ) / ( MB - K )
+ ELSE
+ NBLCKS = ( MN - K ) / ( MB - K ) + 1
+ END IF
ELSE
NBLCKS = 1
END IF
*
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
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
+ ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
INFO = -7
- ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+ ELSE IF( TSIZE.LT.5 ) THEN
INFO = -9
ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
- INFO = -11
- ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+ INFO = -11
+ ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
INFO = -13
END IF
*
-* Determine the block size if it is tall skinny or short and wide
-*
- IF( INFO.EQ.0) THEN
- WORK2(1) = LW
+ IF( INFO.EQ.0 ) THEN
+ WORK( 1 ) = LW
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEMQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N,K).EQ.0 ) THEN
+ IF( MIN( M, N, K ).EQ.0 ) THEN
RETURN
END IF
*
- IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
- $ (MB.GE.MAX(M,N,K))) THEN
- CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA,
- $ WORK1(6), NB, C, LDC, WORK2, INFO)
+ IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
+ $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
+ CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, INFO )
ELSE
- CALL ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
- $ NB, C, LDC, WORK2, LWORK2, INFO )
+ CALL ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
+ $ NB, C, LDC, WORK, LWORK, INFO )
END IF
*
- WORK2(1) = LW
+ WORK( 1 ) = LW
+*
RETURN
*
-* End of DGEMQR
+* End of ZGEMQR
*
END
diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f
index 10fab97f..a38e47b5 100644
--- a/SRC/zgeqr.f
+++ b/SRC/zgeqr.f
@@ -2,14 +2,14 @@
* Definition:
* ===========
*
-* SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
-* INFO)
+* SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
+* INFO )
*
* .. Scalar Arguments ..
-* INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+* INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * )
+* COMPLEX*16 A( LDA, * ), T( * ), WORK( * )
* ..
*
*
@@ -17,11 +17,7 @@
* =============
*>
*> \verbatim
-*>
-*> ZGEQR computes a QR factorization of an M-by-N matrix A,
-*> using ZLATSQR when A is tall and skinny
-*> (M sufficiently greater than N), and otherwise ZGEQRT:
-*> A = Q * R .
+*> ZGEQR computes a QR factorization of an M-by-N matrix A.
*> \endverbatim
*
* Arguments:
@@ -46,7 +42,8 @@
*> On exit, the elements on and above the diagonal of the array
*> contain the min(M,N)-by-N upper trapezoidal matrix R
*> (R is upper triangular if M >= N);
-*> the elements below the diagonal represent Q (see Further Details).
+*> the elements below the diagonal are used to store part of the
+*> data structure to represent Q.
*> \endverbatim
*>
*> \param[in] LDA
@@ -55,47 +52,50 @@
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*>
-*> \param[out] WORK1
+*> \param[out] T
*> \verbatim
-*> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1))
-*> WORK1 contains part of the data structure used to store Q.
-*> WORK1(1): algorithm type = 1, to indicate output from
-*> ZLATSQR or ZGEQRT
-*> WORK1(2): optimum size of WORK1
-*> WORK1(3): minimum size of WORK1
-*> WORK1(4): row block size
-*> WORK1(5): column block size
-*> WORK1(6:LWORK1): data structure needed for Q, computed by
-*> CLATSQR or CGEQRT
+*> T is COMPLEX*16 array, dimension (MAX(5,TSIZE))
+*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
+*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
+*> Remaining T contains part of the data structure used to represent Q.
+*> If one wants to apply or construct Q, then one needs to keep T
+*> (in addition to A) and pass it to further subroutines.
*> \endverbatim
*>
-*> \param[in] LWORK1
+*> \param[in] TSIZE
*> \verbatim
-*> LWORK1 is INTEGER
-*> The dimension of the array WORK1.
-*> If LWORK1 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK1 and
-*> returns this value in WORK1(2), and calculates the minimum
-*> size of WORK1 and returns this value in WORK1(3).
-*> No error message related to LWORK1 is issued by XERBLA when
-*> LWORK1 = -1.
+*> TSIZE is INTEGER
+*> If TSIZE >= 5, the dimension of the array T.
+*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If TSIZE = -1, the routine calculates optimal size of T for the
+*> optimum performance and returns this value in T(1).
+*> If TSIZE = -2, the routine calculates minimal size of T and
+*> returns this value in T(1).
*> \endverbatim
*>
-*> \param[out] WORK2
+*> \param[out] WORK
*> \verbatim
-*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
+*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
-*> \param[in] LWORK2
+*> \param[in] LWORK
*> \verbatim
-*> LWORK2 is INTEGER
-*> The dimension of the array WORK2.
-*> If LWORK2 = -1, then a query is assumed. In this case the
-*> routine calculates the optimal size of WORK2 and
-*> returns this value in WORK2(1), and calculates the minimum
-*> size of WORK2 and returns this value in WORK2(2).
-*> No error message related to LWORK2 is issued by XERBLA when
-*> LWORK2 = -1.
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
+*> only calculates the sizes of the T and WORK arrays, returns these
+*> values as the first entries of the T and WORK arrays, and no error
+*> message related to T or WORK is issued by XERBLA.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -113,106 +113,138 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \par Further Details:
-* =====================
+*> \par Further Details
+* ====================
+*>
+*> \verbatim
+*>
+*> The goal of the interface is to give maximum freedom to the developers for
+*> creating any QR factorization algorithm they wish. The triangular
+*> (trapezoidal) R has to be stored in the upper part of A. The lower part of A
+*> and the array T can be used to store any relevant information for applying or
+*> constructing the Q factor. The WORK array can safely be discarded after exit.
+*>
+*> Caution: One should not expect the sizes of T and WORK to be the same from one
+*> LAPACK implementation to the other, or even from one execution to the other.
+*> A workspace query (for T and WORK) is needed at each execution. However,
+*> for a given execution, the size of T and WORK are fixed and will not change
+*> from one query to the next.
+*>
+*> \endverbatim
+*>
+*> \par Further Details particular to this LAPACK implementation:
+* ==============================================================
*>
*> \verbatim
+*>
+*> These details are particular for this LAPACK implementation. Users should not
+*> take them for granted. These details may change in the future, and are unlikely not
+*> true for another LAPACK implementation. These details are relevant if one wants
+*> to try to understand the code. They are not part of the interface.
+*>
+*> In this version,
+*>
+*> T(2): row block size (MB)
+*> T(3): column block size (NB)
+*> T(6:TSIZE): data structure needed for Q, computed by
+*> ZLATSQR or ZGEQRT
+*>
*> Depending on the matrix dimensions M and N, and row and column
-*> block sizes MB and NB returned by ILAENV, GEQR will use either
-*> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
-*> the QR decomposition.
-*> The output of LATSQR or GEQRT representing Q is stored in A and in
-*> array WORK1(6:LWORK1) for later use.
-*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB
-*> which are needed to interpret A and WORK1(6:LWORK1) for later use.
-*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and
-*> decide whether LATSQR or GEQRT was used is the same as used below in
-*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see
-*> Further Details in LATSQR or GEQRT.
+*> block sizes MB and NB returned by ILAENV, ZGEQR will use either
+*> ZLATSQR (if the matrix is tall-and-skinny) or ZGEQRT to compute
+*> the QR factorization.
+*>
*> \endverbatim
*>
* =====================================================================
- SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
- $ INFO)
+ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, 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 ..
- INTEGER INFO, LDA, M, N, LWORK1, LWORK2
+ INTEGER INFO, LDA, M, N, TSIZE, LWORK
* ..
* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * )
+ COMPLEX*16 A( LDA, * ), T( * ), WORK( * )
* ..
*
* =====================================================================
*
* ..
* .. Local Scalars ..
- LOGICAL LQUERY, LMINWS
- INTEGER MB, NB, I, II, KK, MINLW1, NBLCKS
+ LOGICAL LQUERY, LMINWS, MINT, MINW
+ INTEGER MB, NB, MINTSZ, NBLCKS
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
-* .. EXTERNAL SUBROUTINES ..
- EXTERNAL ZLATSQR, ZGEQRT, XERBLA
-* .. INTRINSIC FUNCTIONS ..
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLATSQR, ZGEQRT, XERBLA
+* ..
+* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, MOD
* ..
-* .. EXTERNAL FUNCTIONS ..
+* .. External Functions ..
INTEGER ILAENV
EXTERNAL ILAENV
* ..
-* .. EXECUTABLE STATEMENTS ..
+* .. Executable Statements ..
*
-* TEST THE INPUT ARGUMENTS
+* Test the input arguments
*
INFO = 0
*
- LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+ LQUERY = ( TSIZE.EQ.-1 .OR. TSIZE.EQ.-2 .OR.
+ $ LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
+*
+ MINT = .FALSE.
+ MINW = .FALSE.
+ IF( TSIZE.EQ.-2 .OR. LWORK.EQ.-2 ) THEN
+ IF( TSIZE.NE.-1 ) MINT = .TRUE.
+ IF( LWORK.NE.-1 ) MINW = .TRUE.
+ END IF
*
* Determine the block size
*
- IF ( MIN(M,N).GT.0 ) THEN
- MB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 1, -1)
- NB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 2, -1)
+ IF( MIN ( M, N ).GT.0 ) THEN
+ MB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 1, -1 )
+ NB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 2, -1 )
ELSE
MB = M
NB = 1
END IF
- IF( MB.GT.M.OR.MB.LE.N) MB = M
- IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
- MINLW1 = N + 5
- IF ((MB.GT.N).AND.(M.GT.N)) THEN
- IF(MOD(M-N, MB-N).EQ.0) THEN
- NBLCKS = (M-N)/(MB-N)
+ IF( MB.GT.M .OR. MB.LE.N ) MB = M
+ IF( NB.GT.MIN( M, N ) .OR. NB.LT.1 ) NB = 1
+ MINTSZ = N + 5
+ IF( MB.GT.N .AND. M.GT.N ) THEN
+ IF( MOD( M - N, MB - N ).EQ.0 ) THEN
+ NBLCKS = ( M - N ) / ( MB - N )
ELSE
- NBLCKS = (M-N)/(MB-N) + 1
+ NBLCKS = ( M - N ) / ( MB - N ) + 1
END IF
ELSE
NBLCKS = 1
END IF
*
-* Determine if the workspace size satisfies minimum size
+* Determine if the workspace size satisfies minimal size
*
LMINWS = .FALSE.
- IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5)
- $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5)
- $ .AND.(.NOT.LQUERY)) THEN
- IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- NB = 1
- END IF
- IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
- LMINWS = .TRUE.
- MB = M
+ IF( ( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) .OR. LWORK.LT.NB*N )
+ $ .AND. ( LWORK.GE.N ) .AND. ( TSIZE.GE.MINTSZ )
+ $ .AND. ( .NOT.LQUERY ) ) THEN
+ IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 ) ) THEN
+ LMINWS = .TRUE.
+ NB = 1
+ MB = M
END IF
- IF (LWORK2.LT.NB*N) THEN
- LMINWS = .TRUE.
- NB = 1
+ IF( LWORK.LT.NB*N ) THEN
+ LMINWS = .TRUE.
+ NB = 1
END IF
END IF
*
@@ -222,44 +254,52 @@
INFO = -2
ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
INFO = -4
- ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 )
- $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+ ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
+ $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
INFO = -6
- ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY)
- $ .AND.(.NOT.LMINWS)) THEN
+ ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+ $ .AND. ( .NOT.LMINWS ) ) THEN
INFO = -8
END IF
-
- IF( INFO.EQ.0) THEN
- WORK1(1) = 1
- WORK1(2) = NB * N * NBLCKS + 5
- WORK1(3) = MINLW1
- WORK1(4) = MB
- WORK1(5) = NB
- WORK2(1) = NB * N
- WORK2(2) = N
+*
+ IF( INFO.EQ.0 ) THEN
+ IF( MINT ) THEN
+ T( 1 ) = MINTSZ
+ ELSE
+ T( 1 ) = NB*N*NBLCKS + 5
+ END IF
+ T( 2 ) = MB
+ T( 3 ) = NB
+ IF( MINW ) THEN
+ WORK( 1 ) = MAX( 1, N )
+ ELSE
+ WORK( 1 ) = MAX( 1, NB*N )
+ END IF
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGEQR', -INFO )
RETURN
- ELSE IF (LQUERY) THEN
- RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
END IF
*
* Quick return if possible
*
- IF( MIN(M,N).EQ.0 ) THEN
- RETURN
+ IF( MIN( M, N ).EQ.0 ) THEN
+ RETURN
END IF
*
* The QR Decomposition
*
- IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
- CALL ZGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+ IF( ( M.LE.N ) .OR. ( MB.LE.N ) .OR. ( MB.GE.M ) ) THEN
+ CALL ZGEQRT( M, N, NB, A, LDA, T( 6 ), NB, WORK, INFO )
ELSE
- CALL ZLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2,
- $ LWORK2, INFO)
+ CALL ZLATSQR( M, N, MB, NB, A, LDA, T( 6 ), NB, WORK,
+ $ LWORK, INFO )
END IF
+*
+ WORK( 1 ) = MAX( 1, NB*N )
+*
RETURN
*
* End of ZGEQR
diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f
index d61b88c3..6dc6a843 100644
--- a/SRC/zgetsls.f
+++ b/SRC/zgetsls.f
@@ -1,16 +1,15 @@
* Definition:
* ===========
*
-* SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
-* $ , WORK, LWORK, INFO )
-
+* SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+* $ WORK, LWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
-* COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
+* COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
* ..
*
*
@@ -19,10 +18,11 @@
*>
*> \verbatim
*>
-*> ZGETSLS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a tall skinny
-*> QR or short wide LQfactorization of A. It is assumed that A has
-*> full rank.
+*> ZGETSLS solves overdetermined or underdetermined complex linear systems
+*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ
+*> factorization of A. It is assumed that A has full rank.
+*>
+*>
*>
*> The following options are provided:
*>
@@ -80,10 +80,8 @@
*> A is COMPLEX*16 array, dimension (LDA,N)
*> On entry, the M-by-N matrix A.
*> On exit,
-*> if M >= N, A is overwritten by details of its QR
-*> factorization as returned by DGEQRF;
-*> if M < N, A is overwritten by details of its LQ
-*> factorization as returned by DGELQF.
+*> A is overwritten by details of its QR or LQ
+*> factorization as returned by ZGEQR or ZGELQ.
*> \endverbatim
*>
*> \param[in] LDA
@@ -97,21 +95,17 @@
*> B is COMPLEX*16 array, dimension (LDB,NRHS)
*> On entry, the matrix B of right hand side vectors, stored
*> columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
-*> if TRANS = 'T'.
+*> if TRANS = 'C'.
*> On exit, if INFO = 0, B is overwritten by the solution
*> vectors, stored columnwise:
*> if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
-*> squares solution vectors; the residual sum of squares for the
-*> solution in each column is given by the sum of squares of
-*> elements N+1 to M in that column;
+*> squares solution vectors.
*> if TRANS = 'N' and m < n, rows 1 to N of B contain the
*> minimum norm solution vectors;
-*> if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*> if TRANS = 'C' and m >= n, rows 1 to M of B contain the
*> minimum norm solution vectors;
-*> if TRANS = 'T' and m < n, rows 1 to M of B contain the
-*> least squares solution vectors; the residual sum of squares
-*> for the solution in each column is given by the sum of
-*> squares of elements M+1 to N in that column.
+*> if TRANS = 'C' and m < n, rows 1 to M of B contain the
+*> least squares solution vectors.
*> \endverbatim
*>
*> \param[in] LDB
@@ -122,23 +116,21 @@
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
-*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
+*> or optimal, if query was assumed) LWORK.
+*> See LWORK for details.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
-*> LWORK >= max( 1, MN + max( MN, NRHS ) ).
-*> For optimal performance,
-*> LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
-*> where MN = min(M,N) and NB is the optimum block size.
-*>
-*> If LWORK = -1, then a workspace query is assumed; the routine
-*> only calculates the optimal size of the WORK array, returns
-*> this value as the first entry of the WORK array, and no error
-*> message related to LWORK is issued by XERBLA.
+*> If LWORK = -1 or -2, then a workspace query is assumed.
+*> If LWORK = -1, the routine calculates optimal size of WORK for the
+*> optimal performance and returns this value in WORK(1).
+*> If LWORK = -2, the routine calculates minimal size of WORK and
+*> returns this value in WORK(1).
*> \endverbatim
*>
*> \param[out] INFO
@@ -160,23 +152,25 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date November 2016
+*
+*> \ingroup complex16GEsolve
*
* =====================================================================
- SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
- $ , WORK, LWORK, INFO )
+ SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
+ $ WORK, LWORK, INFO )
*
-* -- LAPACK driver routine (version 3.4.0) --
+* -- LAPACK driver 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 2011
+* November 2016
*
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, MB, NB
+ INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* ..
* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
*
* ..
*
@@ -190,9 +184,11 @@
* ..
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
- INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+ INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
+ $ SCLLEN, MNK, TSZO, TSZM, LWO, LWM, LW1, LW2,
+ $ WSIZEO, WSIZEM, INFO2
DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
+ COMPLEX*16 TQ( 5 ), WORKQ
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -205,19 +201,19 @@
$ ZTRTRS, XERBLA, ZGELQ, ZGEMLQ
* ..
* .. Intrinsic Functions ..
- INTRINSIC DBLE, MAX, MIN
+ INTRINSIC DBLE, MAX, MIN, INT
* ..
* .. Executable Statements ..
*
* Test the input arguments.
*
- INFO=0
+ INFO = 0
MINMN = MIN( M, N )
MAXMN = MAX( M, N )
- MNK = MAX(MINMN,NRHS)
+ MNK = MAX( MINMN, NRHS )
TRAN = LSAME( TRANS, 'C' )
*
- LQUERY = ( LWORK.EQ.-1 )
+ LQUERY = ( LWORK.EQ.-1 .OR. LWORK.EQ.-2 )
IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'C' ) ) ) THEN
INFO = -1
@@ -233,60 +229,71 @@
INFO = -8
END IF
*
- IF( INFO.EQ.0) THEN
+ IF( INFO.EQ.0 ) THEN
*
* Determine the block size and minimum LWORK
*
- IF ( M.GE.N ) THEN
- CALL ZGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- ELSE
- CALL ZGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
- $ INFO2)
- MB = INT(WORK(4))
- NB = INT(WORK(5))
- LW = INT(WORK(6))
- CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
- $ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
- WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
- WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- END IF
+ IF( M.GE.N ) THEN
+ CALL ZGEQR( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL ZGEQR( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, TQ,
+ $ TSZM, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
+ ELSE
+ CALL ZGELQ( M, N, A, LDA, TQ, -1, WORKQ, -1, INFO2 )
+ TSZO = INT( TQ( 1 ) )
+ LWO = INT( WORKQ )
+ CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWO = MAX( LWO, INT( WORKQ ) )
+ CALL ZGELQ( M, N, A, LDA, TQ, -2, WORKQ, -2, INFO2 )
+ TSZM = INT( TQ( 1 ) )
+ LWM = INT( WORKQ )
+ CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
+ $ TSZO, B, LDB, WORKQ, -1, INFO2 )
+ LWM = MAX( LWM, INT( WORKQ ) )
+ WSIZEO = TSZO + LWO
+ WSIZEM = TSZM + LWM
+ END IF
*
- IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
- INFO=-10
+ IF( ( LWORK.LT.WSIZEM ).AND.( .NOT.LQUERY ) ) THEN
+ INFO = -10
END IF
+*
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZGETSLS', -INFO )
WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
RETURN
- ELSE IF (LQUERY) THEN
- WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
+ END IF
+ IF( LQUERY ) THEN
+ IF( LWORK.EQ.-1 ) WORK( 1 ) = REAL( WSIZEO )
+ IF( LWORK.EQ.-2 ) WORK( 1 ) = REAL( WSIZEM )
RETURN
END IF
- IF(LWORK.LT.WSIZEO) THEN
- LW1=INT(WORK(3))
- LW2=MAX(LW,INT(WORK(6)))
+ IF( LWORK.LT.WSIZEO ) THEN
+ LW1 = TSZM
+ LW2 = LWM
ELSE
- LW1=INT(WORK(2))
- LW2=MAX(LW,INT(WORK(6)))
+ LW1 = TSZO
+ LW2 = LWO
END IF
*
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
CALL ZLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
- $ B, LDB )
+ $ B, LDB )
RETURN
END IF
*
@@ -342,26 +349,27 @@
IBSCL = 2
END IF
*
- IF ( M.GE.N) THEN
+ IF ( M.GE.N ) THEN
*
* compute QR factorization of A
*
- CALL ZGEQR( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
- IF (.NOT.TRAN) THEN
+ CALL ZGEQR( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
+ IF ( .NOT.TRAN ) THEN
*
* Least-Squares Problem min || A * X - B ||
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
CALL ZGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
- $ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
+ $ INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL ZTRTRS( 'U', 'N', 'N', N, NRHS,
- $ A, LDA, B, LDB, INFO )
- IF(INFO.GT.0) THEN
+ $ A, LDA, B, LDB, INFO )
+ IF( INFO.GT.0 ) THEN
RETURN
END IF
SCLLEN = N
@@ -389,7 +397,7 @@
* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
*
CALL ZGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
SCLLEN = M
@@ -400,8 +408,8 @@
*
* Compute LQ factorization of A
*
- CALL ZGELQ( M, N, A, LDA, WORK(LW2+1), LW1
- $ , WORK(1), LW2, INFO )
+ CALL ZGELQ( M, N, A, LDA, WORK( LW2+1 ), LW1,
+ $ WORK( 1 ), LW2, INFO )
*
* workspace at least M, optimally M*NB.
*
@@ -429,7 +437,7 @@
* B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
*
CALL ZGEMLQ( 'L', 'C', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -443,7 +451,7 @@
* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
*
CALL ZGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
- $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+ $ WORK( LW2+1 ), LW1, B, LDB, WORK( 1 ), LW2,
$ INFO )
*
* workspace at least NRHS, optimally NRHS*NB
@@ -467,22 +475,21 @@
*
IF( IASCL.EQ.1 ) THEN
CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ INFO )
ELSE IF( IASCL.EQ.2 ) THEN
CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ $ NFO )
END IF
IF( IBSCL.EQ.1 ) THEN
- CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
ELSE IF( IBSCL.EQ.2 ) THEN
- CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
- $ INFO )
+ CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+ $ INFO )
END IF
*
50 CONTINUE
- WORK( 1 ) = DBLE( WSIZEO )
- WORK( 2 ) = DBLE( WSIZEM )
+ WORK( 1 ) = DBLE( TSZO + LWO )
RETURN
*
* End of ZGETSLS
diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f
index 365530c3..a0268d86 100644
--- a/SRC/zlamswlq.f
+++ b/SRC/zlamswlq.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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
@@ -115,18 +120,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
@@ -137,8 +147,8 @@
*> only calculates the optimal size of the WORK array, returns
*> this value as the first entry of the WORK array, and no error
*> message related to LWORK is issued by XERBLA.
-*>
*> \endverbatim
+*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f
index 7195f9e1..103049c2 100644
--- a/SRC/zlamtsqr.f
+++ b/SRC/zlamtsqr.f
@@ -33,14 +33,19 @@
* ==========
*
*> \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;
*> = 'C': Conjugate Transpose, apply Q**C.
+*> \endverbatim
+*>
*> \param[in] M
*> \verbatim
*> M is INTEGER
@@ -109,12 +114,17 @@
*> \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
@@ -310,9 +320,9 @@
*
KK = MOD((M-K),(MB-K))
II=M-KK+1
+ CTR = 1
CALL ZGEMQRT('L','C',MB , N, K, NB, A(1,1), LDA, T
$ ,LDT ,C(1,1), LDC, WORK, INFO )
- CTR = 1
*
DO I=MB+1,II-MB+K,(MB-K)
*
@@ -350,11 +360,11 @@
END IF
*
DO I=II-(MB-K),MB+1,-(MB-K)
- CTR = CTR - 1
*
* Multiply Q to the current block of C (1:M,I:I+MB)
*
- CALL ZTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
+ CTR = CTR - 1
+ CALL ZTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
$ T(1, CTR * K + 1), LDT, C(1,1), LDC,
$ C(1,I), LDC, WORK, INFO )
@@ -371,9 +381,9 @@
*
KK = MOD((N-K),(MB-K))
II=N-KK+1
+ CTR = 1
CALL ZGEMQRT('R','N', M, MB , K, NB, A(1,1), LDA, T
$ ,LDT ,C(1,1), LDC, WORK, INFO )
- CTR = 1
*
DO I=MB+1,II-MB+K,(MB-K)
*