200 SUBROUTINE zlatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
209 INTEGER LDA, LDW, N, NB
212 DOUBLE PRECISION E( * )
213 COMPLEX*16 A( lda, * ), TAU( * ), W( ldw, * )
219 COMPLEX*16 ZERO, ONE, HALF
220 parameter ( zero = ( 0.0d+0, 0.0d+0 ),
221 $ one = ( 1.0d+0, 0.0d+0 ),
222 $ half = ( 0.5d+0, 0.0d+0 ) )
234 EXTERNAL lsame, zdotc
246 IF( lsame( uplo,
'U' ) )
THEN
250 DO 10 i = n, n - nb + 1, -1
256 a( i, i ) = dble( a( i, i ) )
257 CALL zlacgv( n-i, w( i, iw+1 ), ldw )
258 CALL zgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
259 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
260 CALL zlacgv( n-i, w( i, iw+1 ), ldw )
261 CALL zlacgv( n-i, a( i, i+1 ), lda )
262 CALL zgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
263 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
264 CALL zlacgv( n-i, a( i, i+1 ), lda )
265 a( i, i ) = dble( a( i, i ) )
273 CALL zlarfg( i-1, alpha, a( 1, i ), 1, tau( i-1 ) )
279 CALL zhemv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
280 $ zero, w( 1, iw ), 1 )
282 CALL zgemv(
'Conjugate transpose', i-1, n-i, one,
283 $ w( 1, iw+1 ), ldw, a( 1, i ), 1, zero,
285 CALL zgemv(
'No transpose', i-1, n-i, -one,
286 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
288 CALL zgemv(
'Conjugate transpose', i-1, n-i, one,
289 $ a( 1, i+1 ), lda, a( 1, i ), 1, zero,
291 CALL zgemv(
'No transpose', i-1, n-i, -one,
292 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
295 CALL zscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
296 alpha = -half*tau( i-1 )*zdotc( i-1, w( 1, iw ), 1,
298 CALL zaxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
310 a( i, i ) = dble( a( i, i ) )
311 CALL zlacgv( i-1, w( i, 1 ), ldw )
312 CALL zgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
313 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
314 CALL zlacgv( i-1, w( i, 1 ), ldw )
315 CALL zlacgv( i-1, a( i, 1 ), lda )
316 CALL zgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
317 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
318 CALL zlacgv( i-1, a( i, 1 ), lda )
319 a( i, i ) = dble( a( i, i ) )
326 CALL zlarfg( n-i, alpha, a( min( i+2, n ), i ), 1,
333 CALL zhemv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
334 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
335 CALL zgemv(
'Conjugate transpose', n-i, i-1, one,
336 $ w( i+1, 1 ), ldw, a( i+1, i ), 1, zero,
338 CALL zgemv(
'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 zgemv(
'Conjugate transpose', n-i, i-1, one,
341 $ a( i+1, 1 ), lda, a( i+1, i ), 1, zero,
343 CALL zgemv(
'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 zscal( n-i, tau( i ), w( i+1, i ), 1 )
346 alpha = -half*tau( i )*zdotc( n-i, w( i+1, i ), 1,
348 CALL zaxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
subroutine zlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
ZLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL