199 SUBROUTINE dlatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
208 INTEGER lda, ldw, n, nb
211 DOUBLE PRECISION a( lda, * ), e( * ), tau( * ), w( ldw, * )
217 DOUBLE PRECISION zero, one, half
218 parameter( zero = 0.0d+0, one = 1.0d+0, half = 0.5d+0 )
222 DOUBLE PRECISION alpha
229 DOUBLE PRECISION ddot
242 IF(
lsame( uplo,
'U' ) )
THEN
246 DO 10 i = n, n - nb + 1, -1
252 CALL
dgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
253 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
254 CALL
dgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
255 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
262 CALL
dlarfg( i-1, a( i-1, i ), a( 1, i ), 1, tau( i-1 ) )
263 e( i-1 ) = a( i-1, i )
268 CALL
dsymv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
269 $ zero, w( 1, iw ), 1 )
271 CALL
dgemv(
'Transpose', i-1, n-i, one, w( 1, iw+1 ),
272 $ ldw, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
273 CALL
dgemv(
'No transpose', i-1, n-i, -one,
274 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
276 CALL
dgemv(
'Transpose', i-1, n-i, one, a( 1, i+1 ),
277 $ lda, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
278 CALL
dgemv(
'No transpose', i-1, n-i, -one,
279 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
282 CALL
dscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
283 alpha = -half*tau( i-1 )*
ddot( i-1, w( 1, iw ), 1,
285 CALL
daxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
297 CALL
dgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
298 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
299 CALL
dgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
300 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
306 CALL
dlarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
313 CALL
dsymv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
314 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
315 CALL
dgemv(
'Transpose', n-i, i-1, one, w( i+1, 1 ), ldw,
316 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
317 CALL
dgemv(
'No transpose', n-i, i-1, -one, a( i+1, 1 ),
318 $ lda, w( 1, i ), 1, one, w( i+1, i ), 1 )
319 CALL
dgemv(
'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
320 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
321 CALL
dgemv(
'No transpose', n-i, i-1, -one, w( i+1, 1 ),
322 $ ldw, w( 1, i ), 1, one, w( i+1, i ), 1 )
323 CALL
dscal( n-i, tau( i ), w( i+1, i ), 1 )
324 alpha = -half*tau( i )*
ddot( n-i, w( i+1, i ), 1,
326 CALL
daxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
DOUBLE PRECISION function ddot(N, DX, INCX, DY, INCY)
DDOT
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DSYMV
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV