LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zungql.f
Go to the documentation of this file.
1*> \brief \b ZUNGQL
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZUNGQL + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zungql.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zungql.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zungql.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZUNGQL( 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*16 A( LDA, * ), TAU( * ), WORK( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> ZUNGQL generates an M-by-N complex matrix Q with orthonormal columns,
37*> which is defined as the last N columns of a product of K elementary
38*> reflectors of order M
39*>
40*> Q = H(k) . . . H(2) H(1)
41*>
42*> as returned by ZGEQLF.
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. M >= N >= 0.
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. N >= K >= 0.
65*> \endverbatim
66*>
67*> \param[in,out] A
68*> \verbatim
69*> A is COMPLEX*16 array, dimension (LDA,N)
70*> On entry, the (n-k+i)-th column must contain the vector which
71*> defines the elementary reflector H(i), for i = 1,2,...,k, as
72*> returned by ZGEQLF in the last k columns of its array
73*> argument A.
74*> On exit, the M-by-N matrix Q.
75*> \endverbatim
76*>
77*> \param[in] LDA
78*> \verbatim
79*> LDA is INTEGER
80*> The first dimension of the array A. LDA >= max(1,M).
81*> \endverbatim
82*>
83*> \param[in] TAU
84*> \verbatim
85*> TAU is COMPLEX*16 array, dimension (K)
86*> TAU(i) must contain the scalar factor of the elementary
87*> reflector H(i), as returned by ZGEQLF.
88*> \endverbatim
89*>
90*> \param[out] WORK
91*> \verbatim
92*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
93*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
94*> \endverbatim
95*>
96*> \param[in] LWORK
97*> \verbatim
98*> LWORK is INTEGER
99*> The dimension of the array WORK. LWORK >= max(1,N).
100*> For optimum performance LWORK >= N*NB, where NB is the
101*> 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 has 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 ungql
125*
126* =====================================================================
127 SUBROUTINE zungql( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
128*
129* -- LAPACK computational routine --
130* -- LAPACK is a software package provided by Univ. of Tennessee, --
131* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132*
133* .. Scalar Arguments ..
134 INTEGER INFO, K, LDA, LWORK, M, N
135* ..
136* .. Array Arguments ..
137 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
138* ..
139*
140* =====================================================================
141*
142* .. Parameters ..
143 COMPLEX*16 ZERO
144 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
145* ..
146* .. Local Scalars ..
147 LOGICAL LQUERY
148 INTEGER I, IB, IINFO, IWS, J, KK, L, LDWORK, LWKOPT,
149 $ NB, NBMIN, NX
150* ..
151* .. External Subroutines ..
152 EXTERNAL xerbla, zlarfb, zlarft, zung2l
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC max, min
156* ..
157* .. External Functions ..
158 INTEGER ILAENV
159 EXTERNAL ilaenv
160* ..
161* .. Executable Statements ..
162*
163* Test the input arguments
164*
165 info = 0
166 lquery = ( lwork.EQ.-1 )
167 IF( m.LT.0 ) THEN
168 info = -1
169 ELSE IF( n.LT.0 .OR. n.GT.m ) THEN
170 info = -2
171 ELSE IF( k.LT.0 .OR. k.GT.n ) THEN
172 info = -3
173 ELSE IF( lda.LT.max( 1, m ) ) THEN
174 info = -5
175 END IF
176*
177 IF( info.EQ.0 ) THEN
178 IF( n.EQ.0 ) THEN
179 lwkopt = 1
180 ELSE
181 nb = ilaenv( 1, 'ZUNGQL', ' ', m, n, k, -1 )
182 lwkopt = n*nb
183 END IF
184 work( 1 ) = lwkopt
185*
186 IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery ) THEN
187 info = -8
188 END IF
189 END IF
190*
191 IF( info.NE.0 ) THEN
192 CALL xerbla( 'ZUNGQL', -info )
193 RETURN
194 ELSE IF( lquery ) THEN
195 RETURN
196 END IF
197*
198* Quick return if possible
199*
200 IF( n.LE.0 ) THEN
201 RETURN
202 END IF
203*
204 nbmin = 2
205 nx = 0
206 iws = n
207 IF( nb.GT.1 .AND. nb.LT.k ) THEN
208*
209* Determine when to cross over from blocked to unblocked code.
210*
211 nx = max( 0, ilaenv( 3, 'ZUNGQL', ' ', m, n, k, -1 ) )
212 IF( nx.LT.k ) THEN
213*
214* Determine if workspace is large enough for blocked code.
215*
216 ldwork = n
217 iws = ldwork*nb
218 IF( lwork.LT.iws ) THEN
219*
220* Not enough workspace to use optimal NB: reduce NB and
221* determine the minimum value of NB.
222*
223 nb = lwork / ldwork
224 nbmin = max( 2, ilaenv( 2, 'ZUNGQL', ' ', m, n, k, -1 ) )
225 END IF
226 END IF
227 END IF
228*
229 IF( nb.GE.nbmin .AND. nb.LT.k .AND. nx.LT.k ) THEN
230*
231* Use blocked code after the first block.
232* The last kk columns are handled by the block method.
233*
234 kk = min( k, ( ( k-nx+nb-1 ) / nb )*nb )
235*
236* Set A(m-kk+1:m,1:n-kk) to zero.
237*
238 DO 20 j = 1, n - kk
239 DO 10 i = m - kk + 1, m
240 a( i, j ) = zero
241 10 CONTINUE
242 20 CONTINUE
243 ELSE
244 kk = 0
245 END IF
246*
247* Use unblocked code for the first or only block.
248*
249 CALL zung2l( m-kk, n-kk, k-kk, a, lda, tau, work, iinfo )
250*
251 IF( kk.GT.0 ) THEN
252*
253* Use blocked code
254*
255 DO 50 i = k - kk + 1, k, nb
256 ib = min( nb, k-i+1 )
257 IF( n-k+i.GT.1 ) THEN
258*
259* Form the triangular factor of the block reflector
260* H = H(i+ib-1) . . . H(i+1) H(i)
261*
262 CALL zlarft( 'Backward', 'Columnwise', m-k+i+ib-1, ib,
263 $ a( 1, n-k+i ), lda, tau( i ), work, ldwork )
264*
265* Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
266*
267 CALL zlarfb( 'Left', 'No transpose', 'Backward',
268 $ 'Columnwise', m-k+i+ib-1, n-k+i-1, ib,
269 $ a( 1, n-k+i ), lda, work, ldwork, a, lda,
270 $ work( ib+1 ), ldwork )
271 END IF
272*
273* Apply H to rows 1:m-k+i+ib-1 of current block
274*
275 CALL zung2l( m-k+i+ib-1, ib, ib, a( 1, n-k+i ), lda,
276 $ tau( i ), work, iinfo )
277*
278* Set rows m-k+i+ib:m of current block to zero
279*
280 DO 40 j = n - k + i, n - k + i + ib - 1
281 DO 30 l = m - k + i + ib, m
282 a( l, j ) = zero
283 30 CONTINUE
284 40 CONTINUE
285 50 CONTINUE
286 END IF
287*
288 work( 1 ) = iws
289 RETURN
290*
291* End of ZUNGQL
292*
293 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zlarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
Definition zlarfb.f:197
subroutine zlarft(direct, storev, n, k, v, ldv, tau, t, ldt)
ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
Definition zlarft.f:163
subroutine zung2l(m, n, k, a, lda, tau, work, info)
ZUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (un...
Definition zung2l.f:114
subroutine zungql(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQL
Definition zungql.f:128