LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dgelq.f
Go to the documentation of this file.
1*> \brief \b DGELQ
2*
3* Definition:
4* ===========
5*
6* SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
7* INFO )
8*
9* .. Scalar Arguments ..
10* INTEGER INFO, LDA, M, N, TSIZE, LWORK
11* ..
12* .. Array Arguments ..
13* DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
14* ..
15*
16*
17*> \par Purpose:
18* =============
19*>
20*> \verbatim
21*>
22*> DGELQ computes an LQ factorization of a real M-by-N matrix A:
23*>
24*> A = ( L 0 ) * Q
25*>
26*> where:
27*>
28*> Q is a N-by-N orthogonal matrix;
29*> L is a lower-triangular M-by-M matrix;
30*> 0 is a M-by-(N-M) zero matrix, if M < N.
31*>
32*> \endverbatim
33*
34* Arguments:
35* ==========
36*
37*> \param[in] M
38*> \verbatim
39*> M is INTEGER
40*> The number of rows of the matrix A. M >= 0.
41*> \endverbatim
42*>
43*> \param[in] N
44*> \verbatim
45*> N is INTEGER
46*> The number of columns of the matrix A. N >= 0.
47*> \endverbatim
48*>
49*> \param[in,out] A
50*> \verbatim
51*> A is DOUBLE PRECISION array, dimension (LDA,N)
52*> On entry, the M-by-N matrix A.
53*> On exit, the elements on and below the diagonal of the array
54*> contain the M-by-min(M,N) lower trapezoidal matrix L
55*> (L is lower triangular if M <= N);
56*> the elements above the diagonal are used to store part of the
57*> data structure to represent Q.
58*> \endverbatim
59*>
60*> \param[in] LDA
61*> \verbatim
62*> LDA is INTEGER
63*> The leading dimension of the array A. LDA >= max(1,M).
64*> \endverbatim
65*>
66*> \param[out] T
67*> \verbatim
68*> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE))
69*> On exit, if INFO = 0, T(1) returns optimal (or either minimal
70*> or optimal, if query is assumed) TSIZE. See TSIZE for details.
71*> Remaining T contains part of the data structure used to represent Q.
72*> If one wants to apply or construct Q, then one needs to keep T
73*> (in addition to A) and pass it to further subroutines.
74*> \endverbatim
75*>
76*> \param[in] TSIZE
77*> \verbatim
78*> TSIZE is INTEGER
79*> If TSIZE >= 5, the dimension of the array T.
80*> If TSIZE = -1 or -2, then a workspace query is assumed. The routine
81*> only calculates the sizes of the T and WORK arrays, returns these
82*> values as the first entries of the T and WORK arrays, and no error
83*> message related to T or WORK is issued by XERBLA.
84*> If TSIZE = -1, the routine calculates optimal size of T for the
85*> optimum performance and returns this value in T(1).
86*> If TSIZE = -2, the routine calculates minimal size of T and
87*> returns this value in T(1).
88*> \endverbatim
89*>
90*> \param[out] WORK
91*> \verbatim
92*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
93*> On exit, if INFO = 0, WORK(1) contains optimal (or either minimal
94*> or optimal, if query was assumed) LWORK.
95*> See LWORK for details.
96*> \endverbatim
97*>
98*> \param[in] LWORK
99*> \verbatim
100*> LWORK is INTEGER
101*> The dimension of the array WORK.
102*> If LWORK = -1 or -2, then a workspace query is assumed. The routine
103*> only calculates the sizes of the T and WORK arrays, returns these
104*> values as the first entries of the T and WORK arrays, and no error
105*> message related to T or WORK is issued by XERBLA.
106*> If LWORK = -1, the routine calculates optimal size of WORK for the
107*> optimal performance and returns this value in WORK(1).
108*> If LWORK = -2, the routine calculates minimal size of WORK and
109*> returns this value in WORK(1).
110*> \endverbatim
111*>
112*> \param[out] INFO
113*> \verbatim
114*> INFO is INTEGER
115*> = 0: successful exit
116*> < 0: if INFO = -i, the i-th argument had an illegal value
117*> \endverbatim
118*
119* Authors:
120* ========
121*
122*> \author Univ. of Tennessee
123*> \author Univ. of California Berkeley
124*> \author Univ. of Colorado Denver
125*> \author NAG Ltd.
126*
127*> \par Further Details
128* ====================
129*>
130*> \verbatim
131*>
132*> The goal of the interface is to give maximum freedom to the developers for
133*> creating any LQ factorization algorithm they wish. The triangular
134*> (trapezoidal) L has to be stored in the lower part of A. The lower part of A
135*> and the array T can be used to store any relevant information for applying or
136*> constructing the Q factor. The WORK array can safely be discarded after exit.
137*>
138*> Caution: One should not expect the sizes of T and WORK to be the same from one
139*> LAPACK implementation to the other, or even from one execution to the other.
140*> A workspace query (for T and WORK) is needed at each execution. However,
141*> for a given execution, the size of T and WORK are fixed and will not change
142*> from one query to the next.
143*>
144*> \endverbatim
145*>
146*> \par Further Details particular to this LAPACK implementation:
147* ==============================================================
148*>
149*> \verbatim
150*>
151*> These details are particular for this LAPACK implementation. Users should not
152*> take them for granted. These details may change in the future, and are not likely
153*> true for another LAPACK implementation. These details are relevant if one wants
154*> to try to understand the code. They are not part of the interface.
155*>
156*> In this version,
157*>
158*> T(2): row block size (MB)
159*> T(3): column block size (NB)
160*> T(6:TSIZE): data structure needed for Q, computed by
161*> DLASWLQ or DGELQT
162*>
163*> Depending on the matrix dimensions M and N, and row and column
164*> block sizes MB and NB returned by ILAENV, DGELQ will use either
165*> DLASWLQ (if the matrix is short-and-wide) or DGELQT to compute
166*> the LQ factorization.
167*> \endverbatim
168*>
169*> \ingroup gelq
170*>
171* =====================================================================
172 SUBROUTINE dgelq( M, N, A, LDA, T, TSIZE, WORK, LWORK,
173 $ INFO )
174*
175* -- LAPACK computational routine --
176* -- LAPACK is a software package provided by Univ. of Tennessee, --
177* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
178*
179* .. Scalar Arguments ..
180 INTEGER INFO, LDA, M, N, TSIZE, LWORK
181* ..
182* .. Array Arguments ..
183 DOUBLE PRECISION A( LDA, * ), T( * ), WORK( * )
184* ..
185*
186* =====================================================================
187*
188* ..
189* .. Local Scalars ..
190 LOGICAL LQUERY, LMINWS, MINT, MINW
191 INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
192* ..
193* .. External Functions ..
194 LOGICAL LSAME
195 EXTERNAL lsame
196* ..
197* .. External Subroutines ..
198 EXTERNAL dgelqt, dlaswlq, xerbla
199* ..
200* .. Intrinsic Functions ..
201 INTRINSIC max, min, mod
202* ..
203* .. External Functions ..
204 INTEGER ILAENV
205 EXTERNAL ilaenv
206* ..
207* .. Executable Statements ..
208*
209* Test the input arguments
210*
211 info = 0
212*
213 lquery = ( tsize.EQ.-1 .OR. tsize.EQ.-2 .OR.
214 $ lwork.EQ.-1 .OR. lwork.EQ.-2 )
215*
216 mint = .false.
217 minw = .false.
218 IF( tsize.EQ.-2 .OR. lwork.EQ.-2 ) THEN
219 IF( tsize.NE.-1 ) mint = .true.
220 IF( lwork.NE.-1 ) minw = .true.
221 END IF
222*
223* Determine the block size
224*
225 IF( min( m, n ).GT.0 ) THEN
226 mb = ilaenv( 1, 'DGELQ ', ' ', m, n, 1, -1 )
227 nb = ilaenv( 1, 'DGELQ ', ' ', m, n, 2, -1 )
228 ELSE
229 mb = 1
230 nb = n
231 END IF
232 IF( mb.GT.min( m, n ) .OR. mb.LT.1 ) mb = 1
233 IF( nb.GT.n .OR. nb.LE.m ) nb = n
234 mintsz = m + 5
235 IF ( nb.GT.m .AND. n.GT.m ) THEN
236 IF( mod( n - m, nb - m ).EQ.0 ) THEN
237 nblcks = ( n - m ) / ( nb - m )
238 ELSE
239 nblcks = ( n - m ) / ( nb - m ) + 1
240 END IF
241 ELSE
242 nblcks = 1
243 END IF
244*
245* Determine if the workspace size satisfies minimal size
246*
247 IF( ( n.LE.m ) .OR. ( nb.LE.m ) .OR. ( nb.GE.n ) ) THEN
248 lwmin = max( 1, n )
249 lwopt = max( 1, mb*n )
250 ELSE
251 lwmin = max( 1, m )
252 lwopt = max( 1, mb*m )
253 END IF
254 lminws = .false.
255 IF( ( tsize.LT.max( 1, mb*m*nblcks + 5 ) .OR. lwork.LT.lwopt )
256 $ .AND. ( lwork.GE.lwmin ) .AND. ( tsize.GE.mintsz )
257 $ .AND. ( .NOT.lquery ) ) THEN
258 IF( tsize.LT.max( 1, mb*m*nblcks + 5 ) ) THEN
259 lminws = .true.
260 mb = 1
261 nb = n
262 END IF
263 IF( lwork.LT.lwopt ) THEN
264 lminws = .true.
265 mb = 1
266 END IF
267 END IF
268 IF( ( n.LE.m ) .OR. ( nb.LE.m ) .OR. ( nb.GE.n ) ) THEN
269 lwreq = max( 1, mb*n )
270 ELSE
271 lwreq = max( 1, mb*m )
272 END IF
273*
274 IF( m.LT.0 ) THEN
275 info = -1
276 ELSE IF( n.LT.0 ) THEN
277 info = -2
278 ELSE IF( lda.LT.max( 1, m ) ) THEN
279 info = -4
280 ELSE IF( tsize.LT.max( 1, mb*m*nblcks + 5 )
281 $ .AND. ( .NOT.lquery ) .AND. ( .NOT.lminws ) ) THEN
282 info = -6
283 ELSE IF( ( lwork.LT.lwreq ) .and .( .NOT.lquery )
284 $ .AND. ( .NOT.lminws ) ) THEN
285 info = -8
286 END IF
287*
288 IF( info.EQ.0 ) THEN
289 IF( mint ) THEN
290 t( 1 ) = mintsz
291 ELSE
292 t( 1 ) = mb*m*nblcks + 5
293 END IF
294 t( 2 ) = mb
295 t( 3 ) = nb
296 IF( minw ) THEN
297 work( 1 ) = lwmin
298 ELSE
299 work( 1 ) = lwreq
300 END IF
301 END IF
302 IF( info.NE.0 ) THEN
303 CALL xerbla( 'DGELQ', -info )
304 RETURN
305 ELSE IF( lquery ) THEN
306 RETURN
307 END IF
308*
309* Quick return if possible
310*
311 IF( min( m, n ).EQ.0 ) THEN
312 RETURN
313 END IF
314*
315* The LQ Decomposition
316*
317 IF( ( n.LE.m ) .OR. ( nb.LE.m ) .OR. ( nb.GE.n ) ) THEN
318 CALL dgelqt( m, n, mb, a, lda, t( 6 ), mb, work, info )
319 ELSE
320 CALL dlaswlq( m, n, mb, nb, a, lda, t( 6 ), mb, work,
321 $ lwork, info )
322 END IF
323*
324 work( 1 ) = lwreq
325*
326 RETURN
327*
328* End of DGELQ
329*
330 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dgelq(m, n, a, lda, t, tsize, work, lwork, info)
DGELQ
Definition dgelq.f:174
subroutine dgelqt(m, n, mb, a, lda, t, ldt, work, info)
DGELQT
Definition dgelqt.f:139
subroutine dlaswlq(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
DLASWLQ
Definition dlaswlq.f:167