199 SUBROUTINE slatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
208 INTEGER lda, ldw, n, nb
211 REAL a( lda, * ), e( * ), tau( * ), w( ldw, * )
218 parameter( zero = 0.0e+0, one = 1.0e+0, half = 0.5e+0 )
242 IF(
lsame( uplo,
'U' ) )
THEN
246 DO 10 i = n, n - nb + 1, -1
252 CALL
sgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
253 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
254 CALL
sgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
255 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
262 CALL
slarfg( i-1, a( i-1, i ), a( 1, i ), 1, tau( i-1 ) )
263 e( i-1 ) = a( i-1, i )
268 CALL
ssymv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
269 $ zero, w( 1, iw ), 1 )
271 CALL
sgemv(
'Transpose', i-1, n-i, one, w( 1, iw+1 ),
272 $ ldw, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
273 CALL
sgemv(
'No transpose', i-1, n-i, -one,
274 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
276 CALL
sgemv(
'Transpose', i-1, n-i, one, a( 1, i+1 ),
277 $ lda, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
278 CALL
sgemv(
'No transpose', i-1, n-i, -one,
279 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
282 CALL
sscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
283 alpha = -half*tau( i-1 )*
sdot( i-1, w( 1, iw ), 1,
285 CALL
saxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
297 CALL
sgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
298 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
299 CALL
sgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
300 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
306 CALL
slarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
313 CALL
ssymv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
314 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
315 CALL
sgemv(
'Transpose', n-i, i-1, one, w( i+1, 1 ), ldw,
316 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
317 CALL
sgemv(
'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
sgemv(
'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
320 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
321 CALL
sgemv(
'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
sscal( n-i, tau( i ), w( i+1, i ), 1 )
324 alpha = -half*tau( i )*
sdot( n-i, w( i+1, i ), 1,
326 CALL
saxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
subroutine slatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
SLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
real function sdot(N, SX, INCX, SY, INCY)
SDOT
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
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 sscal(N, SA, SX, INCX)
SSCAL