212 SUBROUTINE cstedc( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
213 $ lrwork, iwork, liwork, info )
222 INTEGER info, ldz, liwork, lrwork, lwork, n
226 REAL d( * ), e( * ), rwork( * )
227 COMPLEX work( * ), z( ldz, * )
234 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
238 INTEGER finish, i, icompz, ii,
j, k, lgn, liwmin, ll,
239 $ lrwmin, lwmin, m, smlsiz, start
240 REAL eps, orgnrm, p, tiny
253 INTRINSIC abs, int, log, max, mod,
REAL, sqrt
260 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
262 IF(
lsame( compz,
'N' ) )
THEN
264 ELSE IF(
lsame( compz,
'V' ) )
THEN
266 ELSE IF(
lsame( compz,
'I' ) )
THEN
271 IF( icompz.LT.0 )
THEN
273 ELSE IF( n.LT.0 )
THEN
275 ELSE IF( ( ldz.LT.1 ) .OR.
276 $ ( icompz.GT.0 .AND. ldz.LT.max( 1, n ) ) )
THEN
284 smlsiz =
ilaenv( 9,
'CSTEDC',
' ', 0, 0, 0, 0 )
285 IF( n.LE.1 .OR. icompz.EQ.0 )
THEN
289 ELSE IF( n.LE.smlsiz )
THEN
293 ELSE IF( icompz.EQ.1 )
THEN
294 lgn = int( log(
REAL( N ) ) / log( two ) )
300 lrwmin = 1 + 3*n + 2*n*lgn + 4*n**2
301 liwmin = 6 + 6*n + 5*n*lgn
302 ELSE IF( icompz.EQ.2 )
THEN
304 lrwmin = 1 + 4*n + 2*n**2
311 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
313 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
315 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
321 CALL
xerbla(
'CSTEDC', -info )
323 ELSE IF( lquery )
THEN
348 IF( icompz.EQ.0 )
THEN
349 CALL
ssterf( n, d, e, info )
356 IF( n.LE.smlsiz )
THEN
358 CALL
csteqr( compz, n, d, e, z, ldz, rwork, info )
364 IF( icompz.EQ.2 )
THEN
365 CALL
slaset(
'Full', n, n, zero, one, rwork, n )
367 CALL
sstedc(
'I', n, d, e, rwork, n,
368 $ rwork( ll ), lrwork-ll+1, iwork, liwork, info )
371 z( i,
j ) = rwork( (
j-1 )*n+i )
382 orgnrm =
slanst(
'M', n, d, e )
393 IF( start.LE.n )
THEN
403 IF( finish.LT.n )
THEN
404 tiny = eps*sqrt( abs( d( finish ) ) )*
405 $ sqrt( abs( d( finish+1 ) ) )
406 IF( abs( e( finish ) ).GT.tiny )
THEN
414 m = finish - start + 1
415 IF( m.GT.smlsiz )
THEN
419 orgnrm =
slanst(
'M', m, d( start ), e( start ) )
420 CALL
slascl(
'G', 0, 0, orgnrm, one, m, 1, d( start ), m,
422 CALL
slascl(
'G', 0, 0, orgnrm, one, m-1, 1, e( start ),
425 CALL
claed0( n, m, d( start ), e( start ), z( 1, start ),
426 $ ldz, work, n, rwork, iwork, info )
428 info = ( info / ( m+1 )+start-1 )*( n+1 ) +
429 $ mod( info, ( m+1 ) ) + start - 1
435 CALL
slascl(
'G', 0, 0, one, orgnrm, m, 1, d( start ), m,
439 CALL
ssteqr(
'I', m, d( start ), e( start ), rwork, m,
440 $ rwork( m*m+1 ), info )
441 CALL
clacrm( n, m, z( 1, start ), ldz, rwork, m, work, n,
443 CALL
clacpy(
'A', n, m, work, n, z( 1, start ), ldz )
445 info = start*( n+1 ) + finish
469 IF( d(
j ).LT.p )
THEN
477 CALL
cswap( n, z( 1, i ), 1, z( 1, k ), 1 )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
REAL function slanst(NORM, N, D, E)
SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine claed0(QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, IWORK, INFO)
CLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmet...
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEBZ
subroutine clacrm(M, N, A, LDA, B, LDB, C, LDC, RWORK)
CLACRM multiplies a complex matrix by a square real matrix.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR