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