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 sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
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