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 ) )
234 EXTERNAL lsame, cdotc
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 )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
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 chemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHEMV
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).