LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zlabrd ( integer  M,
integer  N,
integer  NB,
complex*16, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  D,
double precision, dimension( * )  E,
complex*16, dimension( * )  TAUQ,
complex*16, dimension( * )  TAUP,
complex*16, dimension( ldx, * )  X,
integer  LDX,
complex*16, dimension( ldy, * )  Y,
integer  LDY 
)

ZLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.

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

Purpose: 
 ZLABRD reduces the first NB rows and columns of a complex general
 m by n matrix A to upper or lower real bidiagonal form by a unitary
 transformation Q**H * A * P, and returns the matrices X and Y which
 are needed to apply the transformation to the unreduced part of A.

 If m >= n, A is reduced to upper bidiagonal form; if m < n, to lower
 bidiagonal form.

 This is an auxiliary routine called by ZGEBRD
Parameters
[in]M
          M is INTEGER
          The number of rows in the matrix A.
[in]N
          N is INTEGER
          The number of columns in the matrix A.
[in]NB
          NB is INTEGER
          The number of leading rows and columns of A to be reduced.
[in,out]A
          A is COMPLEX*16 array, dimension (LDA,N)
          On entry, the m by n general matrix to be reduced.
          On exit, the first NB rows and columns of the matrix are
          overwritten; the rest of the array is unchanged.
          If m >= n, elements on and below the diagonal in the first NB
            columns, with the array TAUQ, represent the unitary
            matrix Q as a product of elementary reflectors; and
            elements above the diagonal in the first NB rows, with the
            array TAUP, represent the unitary matrix P as a product
            of elementary reflectors.
          If m < n, elements below the diagonal in the first NB
            columns, with the array TAUQ, represent the unitary
            matrix Q as a product of elementary reflectors, and
            elements on and above the diagonal in the first NB rows,
            with the array TAUP, represent the unitary matrix P as
            a product of elementary reflectors.
          See Further Details.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,M).
[out]D
          D is DOUBLE PRECISION array, dimension (NB)
          The diagonal elements of the first NB rows and columns of
          the reduced matrix.  D(i) = A(i,i).
[out]E
          E is DOUBLE PRECISION array, dimension (NB)
          The off-diagonal elements of the first NB rows and columns of
          the reduced matrix.
[out]TAUQ
          TAUQ is COMPLEX*16 array dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the unitary matrix Q. See Further Details.
[out]TAUP
          TAUP is COMPLEX*16 array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the unitary matrix P. See Further Details.
[out]X
          X is COMPLEX*16 array, dimension (LDX,NB)
          The m-by-nb matrix X required to update the unreduced part
          of A.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X. LDX >= max(1,M).
[out]Y
          Y is COMPLEX*16 array, dimension (LDY,NB)
          The n-by-nb matrix Y required to update the unreduced part
          of A.
[in]LDY
          LDY is INTEGER
          The leading dimension of the array Y. LDY >= max(1,N).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012
Further Details: 
  The matrices Q and P are represented as products of elementary
  reflectors:

     Q = H(1) H(2) . . . H(nb)  and  P = G(1) G(2) . . . G(nb)

  Each H(i) and G(i) has the form:

     H(i) = I - tauq * v * v**H  and G(i) = I - taup * u * u**H

  where tauq and taup are complex scalars, and v and u are complex
  vectors.

  If m >= n, v(1:i-1) = 0, v(i) = 1, and v(i:m) is stored on exit in
  A(i:m,i); u(1:i) = 0, u(i+1) = 1, and u(i+1:n) is stored on exit in
  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).

  If m < n, v(1:i) = 0, v(i+1) = 1, and v(i+1:m) is stored on exit in
  A(i+2:m,i); u(1:i-1) = 0, u(i) = 1, and u(i:n) is stored on exit in
  A(i,i+1:n); tauq is stored in TAUQ(i) and taup in TAUP(i).

  The elements of the vectors v and u together form the m-by-nb matrix
  V and the nb-by-n matrix U**H which are needed, with X and Y, to apply
  the transformation to the unreduced part of the matrix, using a block
  update of the form:  A := A - V*Y**H - X*U**H.

  The contents of A on exit are illustrated by the following examples
  with nb = 2:

  m = 6 and n = 5 (m > n):          m = 5 and n = 6 (m < n):

    (  1   1   u1  u1  u1 )           (  1   u1  u1  u1  u1  u1 )
    (  v1  1   1   u2  u2 )           (  1   1   u2  u2  u2  u2 )
    (  v1  v2  a   a   a  )           (  v1  1   a   a   a   a  )
    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
    (  v1  v2  a   a   a  )           (  v1  v2  a   a   a   a  )
    (  v1  v2  a   a   a  )

  where a denotes an element of the original matrix which is unchanged,
  vi denotes an element of the vector defining H(i), and ui an element
  of the vector defining G(i).

Definition at line 214 of file zlabrd.f.

214 *
215 * -- LAPACK auxiliary routine (version 3.4.2) --
216 * -- LAPACK is a software package provided by Univ. of Tennessee, --
217 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
218 * September 2012
219 *
220 * .. Scalar Arguments ..
221  INTEGER lda, ldx, ldy, m, n, nb
222 * ..
223 * .. Array Arguments ..
224  DOUBLE PRECISION d( * ), e( * )
225  COMPLEX*16 a( lda, * ), taup( * ), tauq( * ), x( ldx, * ),
226  $ y( ldy, * )
227 * ..
228 *
229 * =====================================================================
230 *
231 * .. Parameters ..
232  COMPLEX*16 zero, one
233  parameter ( zero = ( 0.0d+0, 0.0d+0 ),
234  $ one = ( 1.0d+0, 0.0d+0 ) )
235 * ..
236 * .. Local Scalars ..
237  INTEGER i
238  COMPLEX*16 alpha
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL zgemv, zlacgv, zlarfg, zscal
242 * ..
243 * .. Intrinsic Functions ..
244  INTRINSIC min
245 * ..
246 * .. Executable Statements ..
247 *
248 * Quick return if possible
249 *
250  IF( m.LE.0 .OR. n.LE.0 )
251  $ RETURN
252 *
253  IF( m.GE.n ) THEN
254 *
255 * Reduce to upper bidiagonal form
256 *
257  DO 10 i = 1, nb
258 *
259 * Update A(i:m,i)
260 *
261  CALL zlacgv( i-1, y( i, 1 ), ldy )
262  CALL zgemv( 'No transpose', m-i+1, i-1, -one, a( i, 1 ),
263  $ lda, y( i, 1 ), ldy, one, a( i, i ), 1 )
264  CALL zlacgv( i-1, y( i, 1 ), ldy )
265  CALL zgemv( 'No transpose', m-i+1, i-1, -one, x( i, 1 ),
266  $ ldx, a( 1, i ), 1, one, a( i, i ), 1 )
267 *
268 * Generate reflection Q(i) to annihilate A(i+1:m,i)
269 *
270  alpha = a( i, i )
271  CALL zlarfg( m-i+1, alpha, a( min( i+1, m ), i ), 1,
272  $ tauq( i ) )
273  d( i ) = alpha
274  IF( i.LT.n ) THEN
275  a( i, i ) = one
276 *
277 * Compute Y(i+1:n,i)
278 *
279  CALL zgemv( 'Conjugate transpose', m-i+1, n-i, one,
280  $ a( i, i+1 ), lda, a( i, i ), 1, zero,
281  $ y( i+1, i ), 1 )
282  CALL zgemv( 'Conjugate transpose', m-i+1, i-1, one,
283  $ a( i, 1 ), lda, a( i, i ), 1, zero,
284  $ y( 1, i ), 1 )
285  CALL zgemv( 'No transpose', n-i, i-1, -one, y( i+1, 1 ),
286  $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
287  CALL zgemv( 'Conjugate transpose', m-i+1, i-1, one,
288  $ x( i, 1 ), ldx, a( i, i ), 1, zero,
289  $ y( 1, i ), 1 )
290  CALL zgemv( 'Conjugate transpose', i-1, n-i, -one,
291  $ a( 1, i+1 ), lda, y( 1, i ), 1, one,
292  $ y( i+1, i ), 1 )
293  CALL zscal( n-i, tauq( i ), y( i+1, i ), 1 )
294 *
295 * Update A(i,i+1:n)
296 *
297  CALL zlacgv( n-i, a( i, i+1 ), lda )
298  CALL zlacgv( i, a( i, 1 ), lda )
299  CALL zgemv( 'No transpose', n-i, i, -one, y( i+1, 1 ),
300  $ ldy, a( i, 1 ), lda, one, a( i, i+1 ), lda )
301  CALL zlacgv( i, a( i, 1 ), lda )
302  CALL zlacgv( i-1, x( i, 1 ), ldx )
303  CALL zgemv( 'Conjugate transpose', i-1, n-i, -one,
304  $ a( 1, i+1 ), lda, x( i, 1 ), ldx, one,
305  $ a( i, i+1 ), lda )
306  CALL zlacgv( i-1, x( i, 1 ), ldx )
307 *
308 * Generate reflection P(i) to annihilate A(i,i+2:n)
309 *
310  alpha = a( i, i+1 )
311  CALL zlarfg( n-i, alpha, a( i, min( i+2, n ) ), lda,
312  $ taup( i ) )
313  e( i ) = alpha
314  a( i, i+1 ) = one
315 *
316 * Compute X(i+1:m,i)
317 *
318  CALL zgemv( 'No transpose', m-i, n-i, one, a( i+1, i+1 ),
319  $ lda, a( i, i+1 ), lda, zero, x( i+1, i ), 1 )
320  CALL zgemv( 'Conjugate transpose', n-i, i, one,
321  $ y( i+1, 1 ), ldy, a( i, i+1 ), lda, zero,
322  $ x( 1, i ), 1 )
323  CALL zgemv( 'No transpose', m-i, i, -one, a( i+1, 1 ),
324  $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
325  CALL zgemv( 'No transpose', i-1, n-i, one, a( 1, i+1 ),
326  $ lda, a( i, i+1 ), lda, zero, x( 1, i ), 1 )
327  CALL zgemv( 'No transpose', m-i, i-1, -one, x( i+1, 1 ),
328  $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
329  CALL zscal( m-i, taup( i ), x( i+1, i ), 1 )
330  CALL zlacgv( n-i, a( i, i+1 ), lda )
331  END IF
332  10 CONTINUE
333  ELSE
334 *
335 * Reduce to lower bidiagonal form
336 *
337  DO 20 i = 1, nb
338 *
339 * Update A(i,i:n)
340 *
341  CALL zlacgv( n-i+1, a( i, i ), lda )
342  CALL zlacgv( i-1, a( i, 1 ), lda )
343  CALL zgemv( 'No transpose', n-i+1, i-1, -one, y( i, 1 ),
344  $ ldy, a( i, 1 ), lda, one, a( i, i ), lda )
345  CALL zlacgv( i-1, a( i, 1 ), lda )
346  CALL zlacgv( i-1, x( i, 1 ), ldx )
347  CALL zgemv( 'Conjugate transpose', i-1, n-i+1, -one,
348  $ a( 1, i ), lda, x( i, 1 ), ldx, one, a( i, i ),
349  $ lda )
350  CALL zlacgv( i-1, x( i, 1 ), ldx )
351 *
352 * Generate reflection P(i) to annihilate A(i,i+1:n)
353 *
354  alpha = a( i, i )
355  CALL zlarfg( n-i+1, alpha, a( i, min( i+1, n ) ), lda,
356  $ taup( i ) )
357  d( i ) = alpha
358  IF( i.LT.m ) THEN
359  a( i, i ) = one
360 *
361 * Compute X(i+1:m,i)
362 *
363  CALL zgemv( 'No transpose', m-i, n-i+1, one, a( i+1, i ),
364  $ lda, a( i, i ), lda, zero, x( i+1, i ), 1 )
365  CALL zgemv( 'Conjugate transpose', n-i+1, i-1, one,
366  $ y( i, 1 ), ldy, a( i, i ), lda, zero,
367  $ x( 1, i ), 1 )
368  CALL zgemv( 'No transpose', m-i, i-1, -one, a( i+1, 1 ),
369  $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
370  CALL zgemv( 'No transpose', i-1, n-i+1, one, a( 1, i ),
371  $ lda, a( i, i ), lda, zero, x( 1, i ), 1 )
372  CALL zgemv( 'No transpose', m-i, i-1, -one, x( i+1, 1 ),
373  $ ldx, x( 1, i ), 1, one, x( i+1, i ), 1 )
374  CALL zscal( m-i, taup( i ), x( i+1, i ), 1 )
375  CALL zlacgv( n-i+1, a( i, i ), lda )
376 *
377 * Update A(i+1:m,i)
378 *
379  CALL zlacgv( i-1, y( i, 1 ), ldy )
380  CALL zgemv( 'No transpose', m-i, i-1, -one, a( i+1, 1 ),
381  $ lda, y( i, 1 ), ldy, one, a( i+1, i ), 1 )
382  CALL zlacgv( i-1, y( i, 1 ), ldy )
383  CALL zgemv( 'No transpose', m-i, i, -one, x( i+1, 1 ),
384  $ ldx, a( 1, i ), 1, one, a( i+1, i ), 1 )
385 *
386 * Generate reflection Q(i) to annihilate A(i+2:m,i)
387 *
388  alpha = a( i+1, i )
389  CALL zlarfg( m-i, alpha, a( min( i+2, m ), i ), 1,
390  $ tauq( i ) )
391  e( i ) = alpha
392  a( i+1, i ) = one
393 *
394 * Compute Y(i+1:n,i)
395 *
396  CALL zgemv( 'Conjugate transpose', m-i, n-i, one,
397  $ a( i+1, i+1 ), lda, a( i+1, i ), 1, zero,
398  $ y( i+1, i ), 1 )
399  CALL zgemv( 'Conjugate transpose', m-i, i-1, one,
400  $ a( i+1, 1 ), lda, a( i+1, i ), 1, zero,
401  $ y( 1, i ), 1 )
402  CALL zgemv( 'No transpose', n-i, i-1, -one, y( i+1, 1 ),
403  $ ldy, y( 1, i ), 1, one, y( i+1, i ), 1 )
404  CALL zgemv( 'Conjugate transpose', m-i, i, one,
405  $ x( i+1, 1 ), ldx, a( i+1, i ), 1, zero,
406  $ y( 1, i ), 1 )
407  CALL zgemv( 'Conjugate transpose', i, n-i, -one,
408  $ a( 1, i+1 ), lda, y( 1, i ), 1, one,
409  $ y( i+1, i ), 1 )
410  CALL zscal( n-i, tauq( i ), y( i+1, i ), 1 )
411  ELSE
412  CALL zlacgv( n-i+1, a( i, i ), lda )
413  END IF
414  20 CONTINUE
415  END IF
416  RETURN
417 *
418 * End of ZLABRD
419 *
zgemv
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
Definition: zgemv.f:160
zlarfg
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
Definition: zlarfg.f:108
zscal
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
Definition: zscal.f:54
zlacgv
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
Definition: zlacgv.f:76

Here is the call graph for this function:

Here is the caller graph for this function: