LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ dlabrd()

subroutine dlabrd ( integer  M,
integer  N,
integer  NB,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  D,
double precision, dimension( * )  E,
double precision, dimension( * )  TAUQ,
double precision, dimension( * )  TAUP,
double precision, dimension( ldx, * )  X,
integer  LDX,
double precision, dimension( ldy, * )  Y,
integer  LDY 
)

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

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

Purpose:
 DLABRD reduces the first NB rows and columns of a real general
 m by n matrix A to upper or lower bidiagonal form by an orthogonal
 transformation Q**T * 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 DGEBRD
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 DOUBLE PRECISION 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 orthogonal
            matrix Q as a product of elementary reflectors; and
            elements above the diagonal in the first NB rows, with the
            array TAUP, represent the orthogonal 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 orthogonal
            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 orthogonal 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 DOUBLE PRECISION array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the orthogonal matrix Q. See Further Details.
[out]TAUP
          TAUP is DOUBLE PRECISION array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the orthogonal matrix P. See Further Details.
[out]X
          X is DOUBLE PRECISION 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 DOUBLE PRECISION 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**T  and G(i) = I - taup * u * u**T

  where tauq and taup are real scalars, and v and u are real 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**T 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**T - X*U**T.

  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 208 of file dlabrd.f.

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