LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
sgelqf.f
Go to the documentation of this file.
1 *> \brief \b SGELQF
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SGELQF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelqf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgelqf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelqf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INFO, LDA, LWORK, M, N
25 * ..
26 * .. Array Arguments ..
27 * REAL A( LDA, * ), TAU( * ), WORK( * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> SGELQF computes an LQ factorization of a real M-by-N matrix A:
37 *> A = L * Q.
38 *> \endverbatim
39 *
40 * Arguments:
41 * ==========
42 *
43 *> \param[in] M
44 *> \verbatim
45 *> M is INTEGER
46 *> The number of rows of the matrix A. M >= 0.
47 *> \endverbatim
48 *>
49 *> \param[in] N
50 *> \verbatim
51 *> N is INTEGER
52 *> The number of columns of the matrix A. N >= 0.
53 *> \endverbatim
54 *>
55 *> \param[in,out] A
56 *> \verbatim
57 *> A is REAL array, dimension (LDA,N)
58 *> On entry, the M-by-N matrix A.
59 *> On exit, the elements on and below the diagonal of the array
60 *> contain the m-by-min(m,n) lower trapezoidal matrix L (L is
61 *> lower triangular if m <= n); the elements above the diagonal,
62 *> with the array TAU, represent the orthogonal matrix Q as a
63 *> product of elementary reflectors (see Further Details).
64 *> \endverbatim
65 *>
66 *> \param[in] LDA
67 *> \verbatim
68 *> LDA is INTEGER
69 *> The leading dimension of the array A. LDA >= max(1,M).
70 *> \endverbatim
71 *>
72 *> \param[out] TAU
73 *> \verbatim
74 *> TAU is REAL array, dimension (min(M,N))
75 *> The scalar factors of the elementary reflectors (see Further
76 *> Details).
77 *> \endverbatim
78 *>
79 *> \param[out] WORK
80 *> \verbatim
81 *> WORK is REAL array, dimension (MAX(1,LWORK))
82 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
83 *> \endverbatim
84 *>
85 *> \param[in] LWORK
86 *> \verbatim
87 *> LWORK is INTEGER
88 *> The dimension of the array WORK. LWORK >= max(1,M).
89 *> For optimum performance LWORK >= M*NB, where NB is the
90 *> optimal blocksize.
91 *>
92 *> If LWORK = -1, then a workspace query is assumed; the routine
93 *> only calculates the optimal size of the WORK array, returns
94 *> this value as the first entry of the WORK array, and no error
95 *> message related to LWORK is issued by XERBLA.
96 *> \endverbatim
97 *>
98 *> \param[out] INFO
99 *> \verbatim
100 *> INFO is INTEGER
101 *> = 0: successful exit
102 *> < 0: if INFO = -i, the i-th argument had an illegal value
103 *> \endverbatim
104 *
105 * Authors:
106 * ========
107 *
108 *> \author Univ. of Tennessee
109 *> \author Univ. of California Berkeley
110 *> \author Univ. of Colorado Denver
111 *> \author NAG Ltd.
112 *
113 *> \date November 2011
114 *
115 *> \ingroup realGEcomputational
116 *
117 *> \par Further Details:
118 * =====================
119 *>
120 *> \verbatim
121 *>
122 *> The matrix Q is represented as a product of elementary reflectors
123 *>
124 *> Q = H(k) . . . H(2) H(1), where k = min(m,n).
125 *>
126 *> Each H(i) has the form
127 *>
128 *> H(i) = I - tau * v * v**T
129 *>
130 *> where tau is a real scalar, and v is a real vector with
131 *> v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
132 *> and tau in TAU(i).
133 *> \endverbatim
134 *>
135 * =====================================================================
136  SUBROUTINE sgelqf( M, N, A, LDA, TAU, WORK, LWORK, INFO )
137 *
138 * -- LAPACK computational routine (version 3.4.0) --
139 * -- LAPACK is a software package provided by Univ. of Tennessee, --
140 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141 * November 2011
142 *
143 * .. Scalar Arguments ..
144  INTEGER info, lda, lwork, m, n
145 * ..
146 * .. Array Arguments ..
147  REAL a( lda, * ), tau( * ), work( * )
148 * ..
149 *
150 * =====================================================================
151 *
152 * .. Local Scalars ..
153  LOGICAL lquery
154  INTEGER i, ib, iinfo, iws, k, ldwork, lwkopt, nb,
155  $ nbmin, nx
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL sgelq2, slarfb, slarft, xerbla
159 * ..
160 * .. Intrinsic Functions ..
161  INTRINSIC max, min
162 * ..
163 * .. External Functions ..
164  INTEGER ilaenv
165  EXTERNAL ilaenv
166 * ..
167 * .. Executable Statements ..
168 *
169 * Test the input arguments
170 *
171  info = 0
172  nb = ilaenv( 1, 'SGELQF', ' ', m, n, -1, -1 )
173  lwkopt = m*nb
174  work( 1 ) = lwkopt
175  lquery = ( lwork.EQ.-1 )
176  IF( m.LT.0 ) THEN
177  info = -1
178  ELSE IF( n.LT.0 ) THEN
179  info = -2
180  ELSE IF( lda.LT.max( 1, m ) ) THEN
181  info = -4
182  ELSE IF( lwork.LT.max( 1, m ) .AND. .NOT.lquery ) THEN
183  info = -7
184  END IF
185  IF( info.NE.0 ) THEN
186  CALL xerbla( 'SGELQF', -info )
187  return
188  ELSE IF( lquery ) THEN
189  return
190  END IF
191 *
192 * Quick return if possible
193 *
194  k = min( m, n )
195  IF( k.EQ.0 ) THEN
196  work( 1 ) = 1
197  return
198  END IF
199 *
200  nbmin = 2
201  nx = 0
202  iws = m
203  IF( nb.GT.1 .AND. nb.LT.k ) THEN
204 *
205 * Determine when to cross over from blocked to unblocked code.
206 *
207  nx = max( 0, ilaenv( 3, 'SGELQF', ' ', m, n, -1, -1 ) )
208  IF( nx.LT.k ) THEN
209 *
210 * Determine if workspace is large enough for blocked code.
211 *
212  ldwork = m
213  iws = ldwork*nb
214  IF( lwork.LT.iws ) THEN
215 *
216 * Not enough workspace to use optimal NB: reduce NB and
217 * determine the minimum value of NB.
218 *
219  nb = lwork / ldwork
220  nbmin = max( 2, ilaenv( 2, 'SGELQF', ' ', m, n, -1,
221  $ -1 ) )
222  END IF
223  END IF
224  END IF
225 *
226  IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
227 *
228 * Use blocked code initially
229 *
230  DO 10 i = 1, k - nx, nb
231  ib = min( k-i+1, nb )
232 *
233 * Compute the LQ factorization of the current block
234 * A(i:i+ib-1,i:n)
235 *
236  CALL sgelq2( ib, n-i+1, a( i, i ), lda, tau( i ), work,
237  $ iinfo )
238  IF( i+ib.LE.m ) THEN
239 *
240 * Form the triangular factor of the block reflector
241 * H = H(i) H(i+1) . . . H(i+ib-1)
242 *
243  CALL slarft( 'Forward', 'Rowwise', n-i+1, ib, a( i, i ),
244  $ lda, tau( i ), work, ldwork )
245 *
246 * Apply H to A(i+ib:m,i:n) from the right
247 *
248  CALL slarfb( 'Right', 'No transpose', 'Forward',
249  $ 'Rowwise', m-i-ib+1, n-i+1, ib, a( i, i ),
250  $ lda, work, ldwork, a( i+ib, i ), lda,
251  $ work( ib+1 ), ldwork )
252  END IF
253  10 continue
254  ELSE
255  i = 1
256  END IF
257 *
258 * Use unblocked code to factor the last or only block.
259 *
260  IF( i.LE.k )
261  $ CALL sgelq2( m-i+1, n-i+1, a( i, i ), lda, tau( i ), work,
262  $ iinfo )
263 *
264  work( 1 ) = iws
265  return
266 *
267 * End of SGELQF
268 *
269  END