LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
dgerqf.f
Go to the documentation of this file.
1*> \brief \b DGERQF
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgerqf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgerqf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgerqf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER INFO, LDA, LWORK, M, N
25* ..
26* .. Array Arguments ..
27* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> DGERQF 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 dgerqf( 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 DOUBLE PRECISION 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 dgerq2, dlarfb, dlarft, xerbla
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC max, min
163* ..
164* .. External Functions ..
165 INTEGER ILAENV
166 EXTERNAL ilaenv
167* ..
168* .. Executable Statements ..
169*
170* Test the input arguments
171*
172 info = 0
173 lquery = ( lwork.EQ.-1 )
174 IF( m.LT.0 ) THEN
175 info = -1
176 ELSE IF( n.LT.0 ) THEN
177 info = -2
178 ELSE IF( lda.LT.max( 1, m ) ) THEN
179 info = -4
180 END IF
181*
182 IF( info.EQ.0 ) THEN
183 k = min( m, n )
184 IF( k.EQ.0 ) THEN
185 lwkopt = 1
186 ELSE
187 nb = ilaenv( 1, 'DGERQF', ' ', m, n, -1, -1 )
188 lwkopt = m*nb
189 END IF
190 work( 1 ) = lwkopt
191*
192 IF ( .NOT.lquery ) THEN
193 IF( lwork.LE.0 .OR. ( n.GT.0 .AND. lwork.LT.max( 1, m ) ) )
194 \$ info = -7
195 END IF
196 END IF
197*
198 IF( info.NE.0 ) THEN
199 CALL xerbla( 'DGERQF', -info )
200 RETURN
201 ELSE IF( lquery ) THEN
202 RETURN
203 END IF
204*
205* Quick return if possible
206*
207 IF( k.EQ.0 ) THEN
208 RETURN
209 END IF
210*
211 nbmin = 2
212 nx = 1
213 iws = m
214 IF( nb.GT.1 .AND. nb.LT.k ) THEN
215*
216* Determine when to cross over from blocked to unblocked code.
217*
218 nx = max( 0, ilaenv( 3, 'DGERQF', ' ', m, n, -1, -1 ) )
219 IF( nx.LT.k ) THEN
220*
221* Determine if workspace is large enough for blocked code.
222*
223 ldwork = m
224 iws = ldwork*nb
225 IF( lwork.LT.iws ) THEN
226*
227* Not enough workspace to use optimal NB: reduce NB and
228* determine the minimum value of NB.
229*
230 nb = lwork / ldwork
231 nbmin = max( 2, ilaenv( 2, 'DGERQF', ' ', m, n, -1,
232 \$ -1 ) )
233 END IF
234 END IF
235 END IF
236*
237 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
238*
239* Use blocked code initially.
240* The last kk rows are handled by the block method.
241*
242 ki = ( ( k-nx-1 ) / nb )*nb
243 kk = min( k, ki+nb )
244*
245 DO 10 i = k - kk + ki + 1, k - kk + 1, -nb
246 ib = min( k-i+1, nb )
247*
248* Compute the RQ factorization of the current block
249* A(m-k+i:m-k+i+ib-1,1:n-k+i+ib-1)
250*
251 CALL dgerq2( ib, n-k+i+ib-1, a( m-k+i, 1 ), lda, tau( i ),
252 \$ work, iinfo )
253 IF( m-k+i.GT.1 ) THEN
254*
255* Form the triangular factor of the block reflector
256* H = H(i+ib-1) . . . H(i+1) H(i)
257*
258 CALL dlarft( 'Backward', 'Rowwise', n-k+i+ib-1, ib,
259 \$ a( m-k+i, 1 ), lda, tau( i ), work, ldwork )
260*
261* Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
262*
263 CALL dlarfb( 'Right', 'No transpose', 'Backward',
264 \$ 'Rowwise', m-k+i-1, n-k+i+ib-1, ib,
265 \$ a( m-k+i, 1 ), lda, work, ldwork, a, lda,
266 \$ work( ib+1 ), ldwork )
267 END IF
268 10 CONTINUE
269 mu = m - k + i + nb - 1
270 nu = n - k + i + nb - 1
271 ELSE
272 mu = m
273 nu = n
274 END IF
275*
276* Use unblocked code to factor the last or only block
277*
278 IF( mu.GT.0 .AND. nu.GT.0 )
279 \$ CALL dgerq2( mu, nu, a, lda, tau, work, iinfo )
280*
281 work( 1 ) = iws
282 RETURN
283*
284* End of DGERQF
285*
286 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dgerq2(m, n, a, lda, tau, work, info)
DGERQ2 computes the RQ factorization of a general rectangular matrix using an unblocked algorithm.
Definition dgerq2.f:123
subroutine dgerqf(m, n, a, lda, tau, work, lwork, info)
DGERQF
Definition dgerqf.f:139
subroutine dlarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
DLARFB applies a block reflector or its transpose to a general rectangular matrix.
Definition dlarfb.f:197
subroutine dlarft(direct, storev, n, k, v, ldv, tau, t, ldt)
DLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition dlarft.f:163