LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ slabrd()

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.
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 slabrd.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 REAL A( LDA, * ), D( * ), E( * ), TAUP( * ),
220 $ TAUQ( * ), X( LDX, * ), Y( LDY, * )
221* ..
222*
223* =====================================================================
224*
225* .. Parameters ..
226 REAL ZERO, ONE
227 parameter( zero = 0.0e0, one = 1.0e0 )
228* ..
229* .. Local Scalars ..
230 INTEGER I
231* ..
232* .. External Subroutines ..
233 EXTERNAL sgemv, slarfg, sscal
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 sgemv( 'No transpose', m-i+1, i-1, -one, a( i, 1 ),
254 $ lda, y( i, 1 ), ldy, one, a( i, i ), 1 )
255 CALL sgemv( '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 slarfg( 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 sgemv( '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 sgemv( 'Transpose', m-i+1, i-1, one, a( i, 1 ), lda,
271 $ a( i, i ), 1, zero, y( 1, i ), 1 )
272 CALL sgemv( '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 sgemv( 'Transpose', m-i+1, i-1, one, x( i, 1 ), ldx,
275 $ a( i, i ), 1, zero, y( 1, i ), 1 )
276 CALL sgemv( 'Transpose', i-1, n-i, -one, a( 1, i+1 ),
277 $ lda, y( 1, i ), 1, one, y( i+1, i ), 1 )
278 CALL sscal( n-i, tauq( i ), y( i+1, i ), 1 )
279*
280* Update A(i,i+1:n)
281*
282 CALL sgemv( 'No transpose', n-i, i, -one, y( i+1, 1 ),
283 $ ldy, a( i, 1 ), lda, one, a( i, i+1 ), lda )
284 CALL sgemv( '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 slarfg( 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 sgemv( '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 sgemv( 'Transpose', n-i, i, one, y( i+1, 1 ), ldy,
299 $ a( i, i+1 ), lda, zero, x( 1, i ), 1 )
300 CALL sgemv( 'No transpose', m-i, i, -one, a( i+1, 1 ),
301 $ lda, x( 1, i ), 1, one, x( i+1, i ), 1 )
302 CALL sgemv( '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 sgemv( '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 sscal( 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 sgemv( 'No transpose', n-i+1, i-1, -one, y( i, 1 ),
318 $ ldy, a( i, 1 ), lda, one, a( i, i ), lda )
319 CALL sgemv( '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 slarfg( 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 sgemv( '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 sgemv( 'Transpose', n-i+1, i-1, one, y( i, 1 ), ldy,
335 $ a( i, i ), lda, zero, x( 1, i ), 1 )
336 CALL sgemv( '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 sgemv( 'No transpose', i-1, n-i+1, one, a( 1, i ),
339 $ lda, a( i, i ), lda, zero, x( 1, i ), 1 )
340 CALL sgemv( '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 sscal( m-i, taup( i ), x( i+1, i ), 1 )
343*
344* Update A(i+1:m,i)
345*
346 CALL sgemv( '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 sgemv( '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 slarfg( 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 sgemv( '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 sgemv( 'Transpose', m-i, i-1, one, a( i+1, 1 ), lda,
363 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
364 CALL sgemv( '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 sgemv( 'Transpose', m-i, i, one, x( i+1, 1 ), ldx,
367 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
368 CALL sgemv( 'Transpose', i, n-i, -one, a( 1, i+1 ), lda,
369 $ y( 1, i ), 1, one, y( i+1, i ), 1 )
370 CALL sscal( n-i, tauq( i ), y( i+1, i ), 1 )
371 END IF
372 20 CONTINUE
373 END IF
374 RETURN
375*
376* End of SLABRD
377*
sgemv
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:158
slarfg
subroutine slarfg(n, alpha, x, incx, tau)
SLARFG generates an elementary reflector (Householder matrix).
Definition slarfg.f:106
sscal
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79
Here is the call graph for this function:
Here is the caller graph for this function: