210 SUBROUTINE dlabrd( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
219 INTEGER lda, ldx, ldy, m, n, nb
222 DOUBLE PRECISION a( lda, * ), d( * ), e( * ), taup( * ),
223 $ tauq( * ),
x( ldx, * ), y( ldy, * )
229 DOUBLE PRECISION zero, one
230 parameter( zero = 0.0d0, one = 1.0d0 )
245 IF( m.LE.0 .OR. n.LE.0 )
256 CALL
dgemv(
'No transpose', m-i+1, i-1, -one, a( i, 1 ),
257 $ lda, y( i, 1 ), ldy, one, a( i, i ), 1 )
258 CALL
dgemv(
'No transpose', m-i+1, i-1, -one,
x( i, 1 ),
259 $ ldx, a( 1, i ), 1, one, a( i, i ), 1 )
263 CALL
dlarfg( m-i+1, a( i, i ), a( min( i+1, m ), i ), 1,
271 CALL
dgemv(
'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
dgemv(
'Transpose', m-i+1, i-1, one, a( i, 1 ), lda,
274 $ a( i, i ), 1, zero, y( 1, i ), 1 )
275 CALL
dgemv(
'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
dgemv(
'Transpose', m-i+1, i-1, one,
x( i, 1 ), ldx,
278 $ a( i, i ), 1, zero, y( 1, i ), 1 )
279 CALL
dgemv(
'Transpose', i-1, n-i, -one, a( 1, i+1 ),
280 $ lda, y( 1, i ), 1, one, y( i+1, i ), 1 )
281 CALL
dscal( n-i, tauq( i ), y( i+1, i ), 1 )
285 CALL
dgemv(
'No transpose', n-i, i, -one, y( i+1, 1 ),
286 $ ldy, a( i, 1 ), lda, one, a( i, i+1 ), lda )
287 CALL
dgemv(
'Transpose', i-1, n-i, -one, a( 1, i+1 ),
288 $ lda,
x( i, 1 ), ldx, one, a( i, i+1 ), lda )
292 CALL
dlarfg( n-i, a( i, i+1 ), a( i, min( i+2, n ) ),
299 CALL
dgemv(
'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
dgemv(
'Transpose', n-i, i, one, y( i+1, 1 ), ldy,
302 $ a( i, i+1 ), lda, zero,
x( 1, i ), 1 )
303 CALL
dgemv(
'No transpose', m-i, i, -one, a( i+1, 1 ),
304 $ lda,
x( 1, i ), 1, one,
x( i+1, i ), 1 )
305 CALL
dgemv(
'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
dgemv(
'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
dscal( m-i, taup( i ),
x( i+1, i ), 1 )
320 CALL
dgemv(
'No transpose', n-i+1, i-1, -one, y( i, 1 ),
321 $ ldy, a( i, 1 ), lda, one, a( i, i ), lda )
322 CALL
dgemv(
'Transpose', i-1, n-i+1, -one, a( 1, i ), lda,
323 $
x( i, 1 ), ldx, one, a( i, i ), lda )
327 CALL
dlarfg( n-i+1, a( i, i ), a( i, min( i+1, n ) ), lda,
335 CALL
dgemv(
'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
dgemv(
'Transpose', n-i+1, i-1, one, y( i, 1 ), ldy,
338 $ a( i, i ), lda, zero,
x( 1, i ), 1 )
339 CALL
dgemv(
'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
dgemv(
'No transpose', i-1, n-i+1, one, a( 1, i ),
342 $ lda, a( i, i ), lda, zero,
x( 1, i ), 1 )
343 CALL
dgemv(
'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
dscal( m-i, taup( i ),
x( i+1, i ), 1 )
349 CALL
dgemv(
'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
dgemv(
'No transpose', m-i, i, -one,
x( i+1, 1 ),
352 $ ldx, a( 1, i ), 1, one, a( i+1, i ), 1 )
356 CALL
dlarfg( m-i, a( i+1, i ), a( min( i+2, m ), i ), 1,
363 CALL
dgemv(
'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
dgemv(
'Transpose', m-i, i-1, one, a( i+1, 1 ), lda,
366 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
367 CALL
dgemv(
'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
dgemv(
'Transpose', m-i, i, one,
x( i+1, 1 ), ldx,
370 $ a( i+1, i ), 1, zero, y( 1, i ), 1 )
371 CALL
dgemv(
'Transpose', i, n-i, -one, a( 1, i+1 ), lda,
372 $ y( 1, i ), 1, one, y( i+1, i ), 1 )
373 CALL
dscal( n-i, tauq( i ), y( i+1, i ), 1 )
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dlabrd(M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y, LDY)
DLABRD reduces the first nb rows and columns of a general matrix to a bidiagonal form.