200 SUBROUTINE clatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
209 INTEGER lda, ldw, n, nb
213 COMPLEX a( lda, * ), tau( * ), w( ldw, * )
219 COMPLEX zero, one, half
220 parameter( zero = ( 0.0e+0, 0.0e+0 ),
221 $ one = ( 1.0e+0, 0.0e+0 ),
222 $ half = ( 0.5e+0, 0.0e+0 ) )
246 IF(
lsame( uplo,
'U' ) )
THEN
250 DO 10 i = n, n - nb + 1, -1
256 a( i, i ) =
REAL( A( I, I ) )
257 CALL
clacgv( n-i, w( i, iw+1 ), ldw )
258 CALL
cgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
259 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
260 CALL
clacgv( n-i, w( i, iw+1 ), ldw )
261 CALL
clacgv( n-i, a( i, i+1 ), lda )
262 CALL
cgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
263 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
264 CALL
clacgv( n-i, a( i, i+1 ), lda )
265 a( i, i ) =
REAL( A( I, I ) )
273 CALL
clarfg( i-1, alpha, a( 1, i ), 1, tau( i-1 ) )
279 CALL
chemv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
280 $ zero, w( 1, iw ), 1 )
282 CALL
cgemv(
'Conjugate transpose', i-1, n-i, one,
283 $ w( 1, iw+1 ), ldw, a( 1, i ), 1, zero,
285 CALL
cgemv(
'No transpose', i-1, n-i, -one,
286 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
288 CALL
cgemv(
'Conjugate transpose', i-1, n-i, one,
289 $ a( 1, i+1 ), lda, a( 1, i ), 1, zero,
291 CALL
cgemv(
'No transpose', i-1, n-i, -one,
292 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
295 CALL
cscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
296 alpha = -half*tau( i-1 )*
cdotc( i-1, w( 1, iw ), 1,
298 CALL
caxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
310 a( i, i ) =
REAL( A( I, I ) )
311 CALL
clacgv( i-1, w( i, 1 ), ldw )
312 CALL
cgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
313 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
314 CALL
clacgv( i-1, w( i, 1 ), ldw )
315 CALL
clacgv( i-1, a( i, 1 ), lda )
316 CALL
cgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
317 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
318 CALL
clacgv( i-1, a( i, 1 ), lda )
319 a( i, i ) =
REAL( A( I, I ) )
326 CALL
clarfg( n-i, alpha, a( min( i+2, n ), i ), 1,
333 CALL
chemv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
334 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
335 CALL
cgemv(
'Conjugate transpose', n-i, i-1, one,
336 $ w( i+1, 1 ), ldw, a( i+1, i ), 1, zero,
338 CALL
cgemv(
'No transpose', n-i, i-1, -one, a( i+1, 1 ),
339 $ lda, w( 1, i ), 1, one, w( i+1, i ), 1 )
340 CALL
cgemv(
'Conjugate transpose', n-i, i-1, one,
341 $ a( i+1, 1 ), lda, a( i+1, i ), 1, zero,
343 CALL
cgemv(
'No transpose', n-i, i-1, -one, w( i+1, 1 ),
344 $ ldw, w( 1, i ), 1, one, w( i+1, i ), 1 )
345 CALL
cscal( n-i, tau( i ), w( i+1, i ), 1 )
346 alpha = -half*tau( i )*
cdotc( n-i, w( i+1, i ), 1,
348 CALL
caxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine clatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
CLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHEMV
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
COMPLEX function cdotc(N, CX, INCX, CY, INCY)
CDOTC