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