5 * SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK,
8 * .. Scalar Arguments ..
9 * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK
11 * .. Array Arguments ..
12 * COMPLEX A( LDA, * ), T( LDT, * ), WORK( * )
21 *> CLASWLQ computes a blocked Short-Wide LQ factorization of a
22 *> M-by-N matrix A, where N >= M:
32 *> The number of rows of the matrix A. M >= 0.
38 *> The number of columns of the matrix A. N >= M >= 0.
44 *> The row block size to be used in the blocked QR.
50 *> The column block size to be used in the blocked QR.
56 *> A is COMPLEX array, dimension (LDA,N)
57 *> On entry, the M-by-N matrix A.
58 *> On exit, the elements on and bleow the diagonal
59 *> of the array contain the N-by-N lower triangular matrix L;
60 *> the elements above the diagonal represent Q by the rows
61 *> of blocked V (see Further Details).
68 *> The leading dimension of the array A. LDA >= max(1,M).
73 *> T is COMPLEX array,
74 *> dimension (LDT, N * Number_of_row_blocks)
75 *> where Number_of_row_blocks = CEIL((N-M)/(NB-M))
76 *> The blocked upper triangular block reflectors stored in compact form
77 *> as a sequence of upper triangular blocks.
78 *> See Further Details below.
84 *> The leading dimension of the array T. LDT >= MB.
90 *> (workspace) COMPLEX array, dimension (MAX(1,LWORK))
95 *> The dimension of the array WORK. LWORK >= MB*M.
96 *> If LWORK = -1, then a workspace query is assumed; the routine
97 *> only calculates the optimal size of the WORK array, returns
98 *> this value as the first entry of the WORK array, and no error
99 *> message related to LWORK is issued by XERBLA.
105 *> = 0: successful exit
106 *> < 0: if INFO = -i, the i-th argument had an illegal value
112 *> \author Univ. of Tennessee
113 *> \author Univ. of California Berkeley
114 *> \author Univ. of Colorado Denver
117 *> \par Further Details:
118 * =====================
121 *> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
122 *> representing Q as a product of other orthogonal matrices
123 *> Q = Q(1) * Q(2) * . . . * Q(k)
124 *> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
125 *> Q(1) zeros out the upper diagonal entries of rows 1:NB of A
126 *> Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
127 *> Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
130 *> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
131 *> stored under the diagonal of rows 1:MB of A, and by upper triangular
132 *> block reflectors, stored in array T(1:LDT,1:N).
133 *> For more information see Further Details in GELQT.
135 *> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
136 *> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
137 *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
138 *> The last Q(k) may use fewer rows.
139 *> For more information see Further Details in TPQRT.
141 *> For more details of the overall algorithm, see the description of
142 *> Sequential TSQR in Section 2.2 of [1].
144 *> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
145 *> J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
146 *> SIAM J. Sci. Comput, vol. 34, no. 1, 2012
149 * =====================================================================
150 SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK,
153 * -- LAPACK computational routine (version 3.5.0) --
154 * -- LAPACK is a software package provided by Univ. of Tennessee, --
155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
158 * .. Scalar Arguments ..
159 INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT
161 * .. Array Arguments ..
162 COMPLEX A( LDA, * ), WORK( * ), T( LDT, *)
165 * =====================================================================
168 * .. Local Scalars ..
170 INTEGER I, II, KK, CTR
172 * .. EXTERNAL FUNCTIONS ..
175 * .. EXTERNAL SUBROUTINES ..
176 EXTERNAL CGELQT, CTPLQT, XERBLA
177 * .. INTRINSIC FUNCTIONS ..
178 INTRINSIC MAX, MIN, MOD
180 * .. EXTERNAL FUNCTIONS ..
184 * .. EXECUTABLE STATEMENTS ..
186 * TEST THE INPUT ARGUMENTS
190 LQUERY = ( LWORK.EQ.-1 )
194 ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
196 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
198 ELSE IF( NB.LE.M ) THEN
200 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
202 ELSE IF( LDT.LT.MB ) THEN
204 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
212 CALL XERBLA( 'CLASWLQ', -INFO )
214 ELSE IF (LQUERY) THEN
218 * Quick return if possible
220 IF( MIN(M,N).EQ.0 ) THEN
224 * The LQ Decomposition
226 IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
227 CALL CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
231 KK = MOD((N-M),(NB-M))
234 * Compute the LQ factorization of the first block A(1:M,1:NB)
236 CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
239 DO I = NB+1, II-NB+M , (NB-M)
241 * Compute the QR factorization of the current block A(1:M,I:I+NB-M)
243 CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
249 * Compute the QR factorization of the last block A(1:M,II:N)
252 CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
253 $ LDA, T(1,CTR*M+1), LDT,