LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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.
Date
November 2015

Definition at line 169 of file zunmlq.f.

169 *
170 * -- LAPACK computational routine (version 3.6.0) --
171 * -- LAPACK is a software package provided by Univ. of Tennessee, --
172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173 * November 2015
174 *
175 * .. Scalar Arguments ..
176  CHARACTER side, trans
177  INTEGER info, k, lda, ldc, lwork, m, n
178 * ..
179 * .. Array Arguments ..
180  COMPLEX*16 a( lda, * ), c( ldc, * ), tau( * ), work( * )
181 * ..
182 *
183 * =====================================================================
184 *
185 * .. Parameters ..
186  INTEGER nbmax, ldt, tsize
187  parameter ( nbmax = 64, ldt = nbmax+1,
188  $ tsize = ldt*nbmax )
189 * ..
190 * .. Local Scalars ..
191  LOGICAL left, lquery, notran
192  CHARACTER transt
193  INTEGER i, i1, i2, i3, ib, ic, iinfo, iwt, jc, ldwork,
194  $ lwkopt, mi, nb, nbmin, ni, nq, nw
195 * ..
196 * .. External Functions ..
197  LOGICAL lsame
198  INTEGER ilaenv
199  EXTERNAL lsame, ilaenv
200 * ..
201 * .. External Subroutines ..
202  EXTERNAL xerbla, zlarfb, zlarft, zunml2
203 * ..
204 * .. Intrinsic Functions ..
205  INTRINSIC max, min
206 * ..
207 * .. Executable Statements ..
208 *
209 * Test the input arguments
210 *
211  info = 0
212  left = lsame( side, 'L' )
213  notran = lsame( trans, 'N' )
214  lquery = ( lwork.EQ.-1 )
215 *
216 * NQ is the order of Q and NW is the minimum dimension of WORK
217 *
218  IF( left ) THEN
219  nq = m
220  nw = n
221  ELSE
222  nq = n
223  nw = m
224  END IF
225  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
226  info = -1
227  ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'C' ) ) THEN
228  info = -2
229  ELSE IF( m.LT.0 ) THEN
230  info = -3
231  ELSE IF( n.LT.0 ) THEN
232  info = -4
233  ELSE IF( k.LT.0 .OR. k.GT.nq ) THEN
234  info = -5
235  ELSE IF( lda.LT.max( 1, k ) ) THEN
236  info = -7
237  ELSE IF( ldc.LT.max( 1, m ) ) THEN
238  info = -10
239  ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery ) THEN
240  info = -12
241  END IF
242 *
243  IF( info.EQ.0 ) THEN
244 *
245 * Compute the workspace requirements
246 *
247  nb = min( nbmax, ilaenv( 1, 'ZUNMLQ', side // trans, m, n, k,
248  $ -1 ) )
249  lwkopt = max( 1, nw )*nb + tsize
250  work( 1 ) = lwkopt
251  END IF
252 *
253  IF( info.NE.0 ) THEN
254  CALL xerbla( 'ZUNMLQ', -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 .OR. k.EQ.0 ) THEN
263  work( 1 ) = 1
264  RETURN
265  END IF
266 *
267  nbmin = 2
268  ldwork = nw
269  IF( nb.GT.1 .AND. nb.LT.k ) THEN
270  IF( lwork.LT.nw*nb+tsize ) THEN
271  nb = (lwork-tsize) / ldwork
272  nbmin = max( 2, ilaenv( 2, 'ZUNMLQ', side // trans, m, n, 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 zunml2( side, trans, m, n, k, a, lda, tau, c, ldc, work,
282  $ iinfo )
283  ELSE
284 *
285 * Use blocked code
286 *
287  iwt = 1 + nw*nb
288  IF( ( left .AND. notran ) .OR.
289  $ ( .NOT.left .AND. .NOT.notran ) ) THEN
290  i1 = 1
291  i2 = k
292  i3 = nb
293  ELSE
294  i1 = ( ( k-1 ) / nb )*nb + 1
295  i2 = 1
296  i3 = -nb
297  END IF
298 *
299  IF( left ) THEN
300  ni = n
301  jc = 1
302  ELSE
303  mi = m
304  ic = 1
305  END IF
306 *
307  IF( notran ) THEN
308  transt = 'C'
309  ELSE
310  transt = 'N'
311  END IF
312 *
313  DO 10 i = i1, i2, i3
314  ib = min( nb, k-i+1 )
315 *
316 * Form the triangular factor of the block reflector
317 * H = H(i) H(i+1) . . . H(i+ib-1)
318 *
319  CALL zlarft( 'Forward', 'Rowwise', nq-i+1, ib, a( i, i ),
320  $ lda, tau( i ), work( iwt ), ldt )
321  IF( left ) THEN
322 *
323 * H or H**H is applied to C(i:m,1:n)
324 *
325  mi = m - i + 1
326  ic = i
327  ELSE
328 *
329 * H or H**H is applied to C(1:m,i:n)
330 *
331  ni = n - i + 1
332  jc = i
333  END IF
334 *
335 * Apply H or H**H
336 *
337  CALL zlarfb( side, transt, 'Forward', 'Rowwise', mi, ni, ib,
338  $ a( i, i ), lda, work( iwt ), ldt,
339  $ c( ic, jc ), ldc, work, ldwork )
340  10 CONTINUE
341  END IF
342  work( 1 ) = lwkopt
343  RETURN
344 *
345 * End of ZUNMLQ
346 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
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:165
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:161
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: