213 SUBROUTINE zstedc( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
214 $ lrwork, iwork, liwork, info )
223 INTEGER info, ldz, liwork, lrwork, lwork, n
227 DOUBLE PRECISION d( * ), e( * ), rwork( * )
228 COMPLEX*16 work( * ), z( ldz, * )
234 DOUBLE PRECISION zero, one, two
235 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
239 INTEGER finish, i, icompz, ii,
j, k, lgn, liwmin, ll,
240 $ lrwmin, lwmin, m, smlsiz, start
241 DOUBLE PRECISION eps, orgnrm, p, tiny
254 INTRINSIC abs, dble, int, log, max, mod, sqrt
261 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
263 IF(
lsame( compz,
'N' ) )
THEN
265 ELSE IF(
lsame( compz,
'V' ) )
THEN
267 ELSE IF(
lsame( compz,
'I' ) )
THEN
272 IF( icompz.LT.0 )
THEN
274 ELSE IF( n.LT.0 )
THEN
276 ELSE IF( ( ldz.LT.1 ) .OR.
277 $ ( icompz.GT.0 .AND. ldz.LT.max( 1, n ) ) )
THEN
285 smlsiz =
ilaenv( 9,
'ZSTEDC',
' ', 0, 0, 0, 0 )
286 IF( n.LE.1 .OR. icompz.EQ.0 )
THEN
290 ELSE IF( n.LE.smlsiz )
THEN
294 ELSE IF( icompz.EQ.1 )
THEN
295 lgn = int( log( dble( n ) ) / log( two ) )
301 lrwmin = 1 + 3*n + 2*n*lgn + 4*n**2
302 liwmin = 6 + 6*n + 5*n*lgn
303 ELSE IF( icompz.EQ.2 )
THEN
305 lrwmin = 1 + 4*n + 2*n**2
312 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
314 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
316 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
322 CALL
xerbla(
'ZSTEDC', -info )
324 ELSE IF( lquery )
THEN
349 IF( icompz.EQ.0 )
THEN
350 CALL
dsterf( n, d, e, info )
357 IF( n.LE.smlsiz )
THEN
359 CALL
zsteqr( compz, n, d, e, z, ldz, rwork, info )
365 IF( icompz.EQ.2 )
THEN
366 CALL
dlaset(
'Full', n, n, zero, one, rwork, n )
368 CALL
dstedc(
'I', n, d, e, rwork, n,
369 $ rwork( ll ), lrwork-ll+1, iwork, liwork, info )
372 z( i,
j ) = rwork( (
j-1 )*n+i )
383 orgnrm =
dlanst(
'M', n, d, e )
394 IF( start.LE.n )
THEN
404 IF( finish.LT.n )
THEN
405 tiny = eps*sqrt( abs( d( finish ) ) )*
406 $ sqrt( abs( d( finish+1 ) ) )
407 IF( abs( e( finish ) ).GT.tiny )
THEN
415 m = finish - start + 1
416 IF( m.GT.smlsiz )
THEN
420 orgnrm =
dlanst(
'M', m, d( start ), e( start ) )
421 CALL
dlascl(
'G', 0, 0, orgnrm, one, m, 1, d( start ), m,
423 CALL
dlascl(
'G', 0, 0, orgnrm, one, m-1, 1, e( start ),
426 CALL
zlaed0( n, m, d( start ), e( start ), z( 1, start ),
427 $ ldz, work, n, rwork, iwork, info )
429 info = ( info / ( m+1 )+start-1 )*( n+1 ) +
430 $ mod( info, ( m+1 ) ) + start - 1
436 CALL
dlascl(
'G', 0, 0, one, orgnrm, m, 1, d( start ), m,
440 CALL
dsteqr(
'I', m, d( start ), e( start ), rwork, m,
441 $ rwork( m*m+1 ), info )
442 CALL
zlacrm( n, m, z( 1, start ), ldz, rwork, m, work, n,
444 CALL
zlacpy(
'A', n, m, work, n, z( 1, start ), ldz )
446 info = start*( n+1 ) + finish
470 IF( d(
j ).LT.p )
THEN
478 CALL
zswap( n, z( 1, i ), 1, z( 1, k ), 1 )
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEBZ
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacrm(M, N, A, LDA, B, LDB, C, LDC, RWORK)
ZLACRM multiplies a complex matrix by a square real matrix.
logical function lsame(CA, CB)
LSAME
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
double precision function dlanst(NORM, N, D, E)
DLANST 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.
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zlaed0(QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, IWORK, INFO)
ZLAED0 used by sstedc. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmet...