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