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