210 SUBROUTINE slabrd( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
219 INTEGER LDA, LDX, LDY, M, N, NB
222 REAL A( lda, * ), D( * ), E( * ), TAUP( * ),
223 $ tauq( * ), x( ldx, * ), y( ldy, * )
230 parameter ( zero = 0.0e0, one = 1.0e0 )
245 IF( m.LE.0 .OR. n.LE.0 )
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 )
263 CALL slarfg( m-i+1, a( i, i ), a( min( i+1, m ), i ), 1,
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 )
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 )
292 CALL slarfg( n-i, a( i, i+1 ), a( i, min( i+2, n ) ),
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 )
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 )
327 CALL slarfg( n-i+1, a( i, i ), a( i, min( i+1, n ) ), lda,
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 )
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 )
356 CALL slarfg( m-i, a( i+1, i ), a( min( i+2, m ), i ), 1,
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 )
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slabrd(M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY)
SLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.
subroutine sscal(N, SA, SX, INCX)
SSCAL