LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zunmbr.f
Go to the documentation of this file.
1*> \brief \b ZUNMBR
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZUNMBR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunmbr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunmbr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunmbr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZUNMBR( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
22* LDC, WORK, LWORK, INFO )
23*
24* .. Scalar Arguments ..
25* CHARACTER SIDE, TRANS, VECT
26* INTEGER INFO, K, LDA, LDC, LWORK, M, N
27* ..
28* .. Array Arguments ..
29* COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> If VECT = 'Q', ZUNMBR overwrites the general complex M-by-N matrix C
39*> with
40*> SIDE = 'L' SIDE = 'R'
41*> TRANS = 'N': Q * C C * Q
42*> TRANS = 'C': Q**H * C C * Q**H
43*>
44*> If VECT = 'P', ZUNMBR overwrites the general complex M-by-N matrix C
45*> with
46*> SIDE = 'L' SIDE = 'R'
47*> TRANS = 'N': P * C C * P
48*> TRANS = 'C': P**H * C C * P**H
49*>
50*> Here Q and P**H are the unitary matrices determined by ZGEBRD when
51*> reducing a complex matrix A to bidiagonal form: A = Q * B * P**H. Q
52*> and P**H are defined as products of elementary reflectors H(i) and
53*> G(i) respectively.
54*>
55*> Let nq = m if SIDE = 'L' and nq = n if SIDE = 'R'. Thus nq is the
56*> order of the unitary matrix Q or P**H that is applied.
57*>
58*> If VECT = 'Q', A is assumed to have been an NQ-by-K matrix:
59*> if nq >= k, Q = H(1) H(2) . . . H(k);
60*> if nq < k, Q = H(1) H(2) . . . H(nq-1).
61*>
62*> If VECT = 'P', A is assumed to have been a K-by-NQ matrix:
63*> if k < nq, P = G(1) G(2) . . . G(k);
64*> if k >= nq, P = G(1) G(2) . . . G(nq-1).
65*> \endverbatim
66*
67* Arguments:
68* ==========
69*
70*> \param[in] VECT
71*> \verbatim
72*> VECT is CHARACTER*1
73*> = 'Q': apply Q or Q**H;
74*> = 'P': apply P or P**H.
75*> \endverbatim
76*>
77*> \param[in] SIDE
78*> \verbatim
79*> SIDE is CHARACTER*1
80*> = 'L': apply Q, Q**H, P or P**H from the Left;
81*> = 'R': apply Q, Q**H, P or P**H from the Right.
82*> \endverbatim
83*>
84*> \param[in] TRANS
85*> \verbatim
86*> TRANS is CHARACTER*1
87*> = 'N': No transpose, apply Q or P;
88*> = 'C': Conjugate transpose, apply Q**H or P**H.
89*> \endverbatim
90*>
91*> \param[in] M
92*> \verbatim
93*> M is INTEGER
94*> The number of rows of the matrix C. M >= 0.
95*> \endverbatim
96*>
97*> \param[in] N
98*> \verbatim
99*> N is INTEGER
100*> The number of columns of the matrix C. N >= 0.
101*> \endverbatim
102*>
103*> \param[in] K
104*> \verbatim
105*> K is INTEGER
106*> If VECT = 'Q', the number of columns in the original
107*> matrix reduced by ZGEBRD.
108*> If VECT = 'P', the number of rows in the original
109*> matrix reduced by ZGEBRD.
110*> K >= 0.
111*> \endverbatim
112*>
113*> \param[in] A
114*> \verbatim
115*> A is COMPLEX*16 array, dimension
116*> (LDA,min(nq,K)) if VECT = 'Q'
117*> (LDA,nq) if VECT = 'P'
118*> The vectors which define the elementary reflectors H(i) and
119*> G(i), whose products determine the matrices Q and P, as
120*> returned by ZGEBRD.
121*> \endverbatim
122*>
123*> \param[in] LDA
124*> \verbatim
125*> LDA is INTEGER
126*> The leading dimension of the array A.
127*> If VECT = 'Q', LDA >= max(1,nq);
128*> if VECT = 'P', LDA >= max(1,min(nq,K)).
129*> \endverbatim
130*>
131*> \param[in] TAU
132*> \verbatim
133*> TAU is COMPLEX*16 array, dimension (min(nq,K))
134*> TAU(i) must contain the scalar factor of the elementary
135*> reflector H(i) or G(i) which determines Q or P, as returned
136*> by ZGEBRD in the array argument TAUQ or TAUP.
137*> \endverbatim
138*>
139*> \param[in,out] C
140*> \verbatim
141*> C is COMPLEX*16 array, dimension (LDC,N)
142*> On entry, the M-by-N matrix C.
143*> On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q
144*> or P*C or P**H*C or C*P or C*P**H.
145*> \endverbatim
146*>
147*> \param[in] LDC
148*> \verbatim
149*> LDC is INTEGER
150*> The leading dimension of the array C. LDC >= max(1,M).
151*> \endverbatim
152*>
153*> \param[out] WORK
154*> \verbatim
155*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
156*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
157*> \endverbatim
158*>
159*> \param[in] LWORK
160*> \verbatim
161*> LWORK is INTEGER
162*> The dimension of the array WORK.
163*> If SIDE = 'L', LWORK >= max(1,N);
164*> if SIDE = 'R', LWORK >= max(1,M);
165*> if N = 0 or M = 0, LWORK >= 1.
166*> For optimum performance LWORK >= max(1,N*NB) if SIDE = 'L',
167*> and LWORK >= max(1,M*NB) if SIDE = 'R', where NB is the
168*> optimal blocksize. (NB = 0 if M = 0 or N = 0.)
169*>
170*> If LWORK = -1, then a workspace query is assumed; the routine
171*> only calculates the optimal size of the WORK array, returns
172*> this value as the first entry of the WORK array, and no error
173*> message related to LWORK is issued by XERBLA.
174*> \endverbatim
175*>
176*> \param[out] INFO
177*> \verbatim
178*> INFO is INTEGER
179*> = 0: successful exit
180*> < 0: if INFO = -i, the i-th argument had an illegal value
181*> \endverbatim
182*
183* Authors:
184* ========
185*
186*> \author Univ. of Tennessee
187*> \author Univ. of California Berkeley
188*> \author Univ. of Colorado Denver
189*> \author NAG Ltd.
190*
191*> \ingroup unmbr
192*
193* =====================================================================
194 SUBROUTINE zunmbr( VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C,
195 $ LDC, WORK, LWORK, INFO )
196*
197* -- LAPACK computational routine --
198* -- LAPACK is a software package provided by Univ. of Tennessee, --
199* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
200*
201* .. Scalar Arguments ..
202 CHARACTER SIDE, TRANS, VECT
203 INTEGER INFO, K, LDA, LDC, LWORK, M, N
204* ..
205* .. Array Arguments ..
206 COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
207* ..
208*
209* =====================================================================
210*
211* .. Local Scalars ..
212 LOGICAL APPLYQ, LEFT, LQUERY, NOTRAN
213 CHARACTER TRANST
214 INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW
215* ..
216* .. External Functions ..
217 LOGICAL LSAME
218 INTEGER ILAENV
219 EXTERNAL lsame, ilaenv
220* ..
221* .. External Subroutines ..
222 EXTERNAL xerbla, zunmlq, zunmqr
223* ..
224* .. Intrinsic Functions ..
225 INTRINSIC max, min
226* ..
227* .. Executable Statements ..
228*
229* Test the input arguments
230*
231 info = 0
232 applyq = lsame( vect, 'Q' )
233 left = lsame( side, 'L' )
234 notran = lsame( trans, 'N' )
235 lquery = ( lwork.EQ.-1 )
236*
237* NQ is the order of Q or P and NW is the minimum dimension of WORK
238*
239 IF( left ) THEN
240 nq = m
241 nw = max( 1, n )
242 ELSE
243 nq = n
244 nw = max( 1, m )
245 END IF
246 IF( .NOT.applyq .AND. .NOT.lsame( vect, 'P' ) ) THEN
247 info = -1
248 ELSE IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
249 info = -2
250 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
251 info = -3
252 ELSE IF( m.LT.0 ) THEN
253 info = -4
254 ELSE IF( n.LT.0 ) THEN
255 info = -5
256 ELSE IF( k.LT.0 ) THEN
257 info = -6
258 ELSE IF( ( applyq .AND. lda.LT.max( 1, nq ) ) .OR.
259 $ ( .NOT.applyq .AND. lda.LT.max( 1, min( nq, k ) ) ) )
260 $ THEN
261 info = -8
262 ELSE IF( ldc.LT.max( 1, m ) ) THEN
263 info = -11
264 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
265 info = -13
266 END IF
267*
268 IF( info.EQ.0 ) THEN
269 IF( m.GT.0 .AND. n.GT.0 ) THEN
270 IF( applyq ) THEN
271 IF( left ) THEN
272 nb = ilaenv( 1, 'ZUNMQR', side // trans, m-1, n, m-1,
273 $ -1 )
274 ELSE
275 nb = ilaenv( 1, 'ZUNMQR', side // trans, m, n-1, n-1,
276 $ -1 )
277 END IF
278 ELSE
279 IF( left ) THEN
280 nb = ilaenv( 1, 'ZUNMLQ', side // trans, m-1, n, m-1,
281 $ -1 )
282 ELSE
283 nb = ilaenv( 1, 'ZUNMLQ', side // trans, m, n-1, n-1,
284 $ -1 )
285 END IF
286 END IF
287 lwkopt = nw*nb
288 ELSE
289 lwkopt = 1
290 END IF
291 work( 1 ) = lwkopt
292 END IF
293*
294 IF( info.NE.0 ) THEN
295 CALL xerbla( 'ZUNMBR', -info )
296 RETURN
297 ELSE IF( lquery ) THEN
298 RETURN
299 END IF
300*
301* Quick return if possible
302*
303 IF( m.EQ.0 .OR. n.EQ.0 )
304 $ RETURN
305*
306 IF( applyq ) THEN
307*
308* Apply Q
309*
310 IF( nq.GE.k ) THEN
311*
312* Q was determined by a call to ZGEBRD with nq >= k
313*
314 CALL zunmqr( side, trans, m, n, k, a, lda, tau, c, ldc,
315 $ work, lwork, iinfo )
316 ELSE IF( nq.GT.1 ) THEN
317*
318* Q was determined by a call to ZGEBRD with nq < k
319*
320 IF( left ) THEN
321 mi = m - 1
322 ni = n
323 i1 = 2
324 i2 = 1
325 ELSE
326 mi = m
327 ni = n - 1
328 i1 = 1
329 i2 = 2
330 END IF
331 CALL zunmqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
332 $ c( i1, i2 ), ldc, work, lwork, iinfo )
333 END IF
334 ELSE
335*
336* Apply P
337*
338 IF( notran ) THEN
339 transt = 'C'
340 ELSE
341 transt = 'N'
342 END IF
343 IF( nq.GT.k ) THEN
344*
345* P was determined by a call to ZGEBRD with nq > k
346*
347 CALL zunmlq( side, transt, m, n, k, a, lda, tau, c, ldc,
348 $ work, lwork, iinfo )
349 ELSE IF( nq.GT.1 ) THEN
350*
351* P was determined by a call to ZGEBRD with nq <= k
352*
353 IF( left ) THEN
354 mi = m - 1
355 ni = n
356 i1 = 2
357 i2 = 1
358 ELSE
359 mi = m
360 ni = n - 1
361 i1 = 1
362 i2 = 2
363 END IF
364 CALL zunmlq( side, transt, mi, ni, nq-1, a( 1, 2 ), lda,
365 $ tau, c( i1, i2 ), ldc, work, lwork, iinfo )
366 END IF
367 END IF
368 work( 1 ) = lwkopt
369 RETURN
370*
371* End of ZUNMBR
372*
373 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zunmbr(vect, side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMBR
Definition zunmbr.f:196
subroutine zunmlq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMLQ
Definition zunmlq.f:167
subroutine zunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMQR
Definition zunmqr.f:167