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