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
246 DOUBLE PRECISION DLAMCH, DLANST
247 EXTERNAL lsame, ilaenv, dlamch, dlanst
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 )
387 eps = dlamch(
'Epsilon' )
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
465 IF( d( j ).LT.p )
THEN
473 CALL zswap( n, z( 1, i ), 1, z( 1, k ), 1 )
subroutine dsterf(N, D, E, INFO)
DSTERF
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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
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 dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC
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...
subroutine zlacrm(M, N, A, LDA, B, LDB, C, LDC, RWORK)
ZLACRM multiplies a complex matrix by a square real matrix.