1 SUBROUTINE dlatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
10 INTEGER LDA, LDW, N, NB
13 DOUBLE PRECISION A( LDA, * ), E( * ), TAU( * ), W( LDW, * )
140 DOUBLE PRECISION ZERO, ONE, HALF
141 parameter( zero = 0.0d+0, one = 1.0d+0, half = 0.5d+0 )
145 DOUBLE PRECISION ALPHA
152 DOUBLE PRECISION DDOT
165 IF( lsame( uplo,
'U' ) )
THEN
169 DO 10 i = n, n - nb + 1, -1
175 CALL dgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
176 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
177 CALL dgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
178 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
185 CALL dlarfg( i-1, a( i-1, i ), a( 1, i ), 1, tau( i-1 ) )
186 e( i-1 ) = a( i-1, i )
191 CALL dsymv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
192 $ zero, w( 1, iw ), 1 )
194 CALL dgemv(
'Transpose', i-1, n-i, one, w( 1, iw+1 ),
195 $ ldw, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
196 CALL dgemv(
'No transpose', i-1, n-i, -one,
197 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
199 CALL dgemv(
'Transpose', i-1, n-i, one, a( 1, i+1 ),
200 $ lda, a( 1, i ), 1, zero, w( i+1, iw ), 1 )
201 CALL dgemv(
'No transpose', i-1, n-i, -one,
202 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
205 CALL dscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
206 alpha = -half*tau( i-1 )*ddot( i-1, w( 1, iw ), 1,
208 CALL daxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
220 CALL dgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
221 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
222 CALL dgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
223 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
229 CALL dlarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
236 CALL dsymv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
237 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
238 CALL dgemv(
'Transpose', n-i, i-1, one, w( i+1, 1 ), ldw,
239 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
240 CALL dgemv(
'No transpose', n-i, i-1, -one, a( i+1, 1 ),
241 $ lda, w( 1, i ), 1, one, w( i+1, i ), 1 )
242 CALL dgemv(
'Transpose', n-i, i-1, one, a( i+1, 1 ), lda,
243 $ a( i+1, i ), 1, zero, w( 1, i ), 1 )
244 CALL dgemv(
'No transpose', n-i, i-1, -one, w( i+1, 1 ),
245 $ ldw, w( 1, i ), 1, one, w( i+1, i ), 1 )
246 CALL dscal( n-i, tau( i ), w( i+1, i ), 1 )
247 alpha = -half*tau( i )*ddot( n-i, w( i+1, i ), 1,
249 CALL daxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
subroutine daxpy(n, da, dx, incx, dy, incy)
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
subroutine dlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
subroutine dscal(n, da, dx, incx)
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)