LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zunmlq()

subroutine zunmlq ( character  side,
character  trans,
integer  m,
integer  n,
integer  k,
complex*16, dimension( lda, * )  a,
integer  lda,
complex*16, dimension( * )  tau,
complex*16, dimension( ldc, * )  c,
integer  ldc,
complex*16, dimension( * )  work,
integer  lwork,
integer  info 
)

ZUNMLQ

Download ZUNMLQ + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 ZUNMLQ overwrites the general complex M-by-N matrix C with

                 SIDE = 'L'     SIDE = 'R'
 TRANS = 'N':      Q * C          C * Q
 TRANS = 'C':      Q**H * C       C * Q**H

 where Q is a complex unitary matrix defined as the product of k
 elementary reflectors

       Q = H(k)**H . . . H(2)**H H(1)**H

 as returned by ZGELQF. Q is of order M if SIDE = 'L' and of order N
 if SIDE = 'R'.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': apply Q or Q**H from the Left;
          = 'R': apply Q or Q**H from the Right.
[in]TRANS
          TRANS is CHARACTER*1
          = 'N':  No transpose, apply Q;
          = 'C':  Conjugate transpose, apply Q**H.
[in]M
          M is INTEGER
          The number of rows of the matrix C. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix C. N >= 0.
[in]K
          K is INTEGER
          The number of elementary reflectors whose product defines
          the matrix Q.
          If SIDE = 'L', M >= K >= 0;
          if SIDE = 'R', N >= K >= 0.
[in]A
          A is COMPLEX*16 array, dimension
                               (LDA,M) if SIDE = 'L',
                               (LDA,N) if SIDE = 'R'
          The i-th row must contain the vector which defines the
          elementary reflector H(i), for i = 1,2,...,k, as returned by
          ZGELQF in the first k rows of its array argument A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= max(1,K).
[in]TAU
          TAU is COMPLEX*16 array, dimension (K)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by ZGELQF.
[in,out]C
          C is COMPLEX*16 array, dimension (LDC,N)
          On entry, the M-by-N matrix C.
          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If SIDE = 'L', LWORK >= max(1,N);
          if SIDE = 'R', LWORK >= max(1,M).
          For good performance, LWORK should generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 165 of file zunmlq.f.

167*
168* -- LAPACK computational routine --
169* -- LAPACK is a software package provided by Univ. of Tennessee, --
170* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171*
172* .. Scalar Arguments ..
173 CHARACTER SIDE, TRANS
174 INTEGER INFO, K, LDA, LDC, LWORK, M, N
175* ..
176* .. Array Arguments ..
177 COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
178* ..
179*
180* =====================================================================
181*
182* .. Parameters ..
183 INTEGER NBMAX, LDT, TSIZE
184 parameter( nbmax = 64, ldt = nbmax+1,
185 $ tsize = ldt*nbmax )
186* ..
187* .. Local Scalars ..
188 LOGICAL LEFT, LQUERY, NOTRAN
189 CHARACTER TRANST
190 INTEGER I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,
191 $ LWKOPT, MI, NB, NBMIN, NI, NQ, NW
192* ..
193* .. External Functions ..
194 LOGICAL LSAME
195 INTEGER ILAENV
196 EXTERNAL lsame, ilaenv
197* ..
198* .. External Subroutines ..
199 EXTERNAL xerbla, zlarfb, zlarft, zunml2
200* ..
201* .. Intrinsic Functions ..
202 INTRINSIC max, min
203* ..
204* .. Executable Statements ..
205*
206* Test the input arguments
207*
208 info = 0
209 left = lsame( side, 'L' )
210 notran = lsame( trans, 'N' )
211 lquery = ( lwork.EQ.-1 )
212*
213* NQ is the order of Q and NW is the minimum dimension of WORK
214*
215 IF( left ) THEN
216 nq = m
217 nw = max( 1, n )
218 ELSE
219 nq = n
220 nw = max( 1, m )
221 END IF
222 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
223 info = -1
224 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
225 info = -2
226 ELSE IF( m.LT.0 ) THEN
227 info = -3
228 ELSE IF( n.LT.0 ) THEN
229 info = -4
230 ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
231 info = -5
232 ELSE IF( lda.LT.max( 1, k ) ) THEN
233 info = -7
234 ELSE IF( ldc.LT.max( 1, m ) ) THEN
235 info = -10
236 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
237 info = -12
238 END IF
239*
240 IF( info.EQ.0 ) THEN
241*
242* Compute the workspace requirements
243*
244 nb = min( nbmax, ilaenv( 1, 'ZUNMLQ', side // trans, m, n, k,
245 $ -1 ) )
246 lwkopt = nw*nb + tsize
247 work( 1 ) = lwkopt
248 END IF
249*
250 IF( info.NE.0 ) THEN
251 CALL xerbla( 'ZUNMLQ', -info )
252 RETURN
253 ELSE IF( lquery ) THEN
254 RETURN
255 END IF
256*
257* Quick return if possible
258*
259 IF( m.EQ.0 .OR. n.EQ.0 .OR. k.EQ.0 ) THEN
260 work( 1 ) = 1
261 RETURN
262 END IF
263*
264 nbmin = 2
265 ldwork = nw
266 IF( nb.GT.1 .AND. nb.LT.k ) THEN
267 IF( lwork.LT.lwkopt ) THEN
268 nb = (lwork-tsize) / ldwork
269 nbmin = max( 2, ilaenv( 2, 'ZUNMLQ', side // trans, m, n, k,
270 $ -1 ) )
271 END IF
272 END IF
273*
274 IF( nb.LT.nbmin .OR. nb.GE.k ) THEN
275*
276* Use unblocked code
277*
278 CALL zunml2( side, trans, m, n, k, a, lda, tau, c, ldc, work,
279 $ iinfo )
280 ELSE
281*
282* Use blocked code
283*
284 iwt = 1 + nw*nb
285 IF( ( left .AND. notran ) .OR.
286 $ ( .NOT.left .AND. .NOT.notran ) ) THEN
287 i1 = 1
288 i2 = k
289 i3 = nb
290 ELSE
291 i1 = ( ( k-1 ) / nb )*nb + 1
292 i2 = 1
293 i3 = -nb
294 END IF
295*
296 IF( left ) THEN
297 ni = n
298 jc = 1
299 ELSE
300 mi = m
301 ic = 1
302 END IF
303*
304 IF( notran ) THEN
305 transt = 'C'
306 ELSE
307 transt = 'N'
308 END IF
309*
310 DO 10 i = i1, i2, i3
311 ib = min( nb, k-i+1 )
312*
313* Form the triangular factor of the block reflector
314* H = H(i) H(i+1) . . . H(i+ib-1)
315*
316 CALL zlarft( 'Forward', 'Rowwise', nq-i+1, ib, a( i, i ),
317 $ lda, tau( i ), work( iwt ), ldt )
318 IF( left ) THEN
319*
320* H or H**H is applied to C(i:m,1:n)
321*
322 mi = m - i + 1
323 ic = i
324 ELSE
325*
326* H or H**H is applied to C(1:m,i:n)
327*
328 ni = n - i + 1
329 jc = i
330 END IF
331*
332* Apply H or H**H
333*
334 CALL zlarfb( side, transt, 'Forward', 'Rowwise', mi, ni, ib,
335 $ a( i, i ), lda, work( iwt ), ldt,
336 $ c( ic, jc ), ldc, work, ldwork )
337 10 CONTINUE
338 END IF
339 work( 1 ) = lwkopt
340 RETURN
341*
342* End of ZUNMLQ
343*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
zlarfb
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
zlarft
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
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
zunml2
subroutine zunml2(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
ZUNML2 multiplies a general matrix by the unitary matrix from a LQ factorization determined by cgelqf...
Definition zunml2.f:159
Here is the call graph for this function:
Here is the caller graph for this function: