LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zlabrd()

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.
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 210 of file zlabrd.f.

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