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

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

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

Purpose: 
 SLABRD 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 SGEBRD
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 REAL 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 REAL 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 REAL array, dimension (NB)
          The off-diagonal elements of the first NB rows and columns of
          the reduced matrix.
[out]TAUQ
          TAUQ is REAL array dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the orthogonal matrix Q. See Further Details.
[out]TAUP
          TAUP is REAL array, dimension (NB)
          The scalar factors of the elementary reflectors which
          represent the orthogonal matrix P. See Further Details.
[out]X
          X is REAL 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 REAL 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**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 212 of file slabrd.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: