210 SUBROUTINE cstedc( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
211 $ LRWORK, IWORK, LIWORK, INFO )
219 INTEGER INFO, LDZ, LIWORK, LRWORK, LWORK, N
223 REAL D( * ), E( * ), RWORK( * )
224 COMPLEX WORK( * ), Z( LDZ, * )
231 parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
235 INTEGER FINISH, I, ICOMPZ, II, J, K, LGN, LIWMIN, LL,
236 $ lrwmin, lwmin, m, smlsiz, start
237 REAL EPS, ORGNRM, P, TINY
243 EXTERNAL ilaenv, lsame, slamch, slanst
250 INTRINSIC abs, int, log, max, mod, real, sqrt
257 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
259 IF( lsame( compz,
'N' ) )
THEN
261 ELSE IF( lsame( compz,
'V' ) )
THEN
263 ELSE IF( lsame( compz,
'I' ) )
THEN
268 IF( icompz.LT.0 )
THEN
270 ELSE IF( n.LT.0 )
THEN
272 ELSE IF( ( ldz.LT.1 ) .OR.
273 $ ( icompz.GT.0 .AND. ldz.LT.max( 1, n ) ) )
THEN
281 smlsiz = ilaenv( 9,
'CSTEDC',
' ', 0, 0, 0, 0 )
282 IF( n.LE.1 .OR. icompz.EQ.0 )
THEN
286 ELSE IF( n.LE.smlsiz )
THEN
290 ELSE IF( icompz.EQ.1 )
THEN
291 lgn = int( log( real( n ) ) / log( two ) )
297 lrwmin = 1 + 3*n + 2*n*lgn + 4*n**2
298 liwmin = 6 + 6*n + 5*n*lgn
299 ELSE IF( icompz.EQ.2 )
THEN
301 lrwmin = 1 + 4*n + 2*n**2
308 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
310 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
312 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
318 CALL xerbla(
'CSTEDC', -info )
320 ELSE IF( lquery )
THEN
345 IF( icompz.EQ.0 )
THEN
346 CALL ssterf( n, d, e, info )
353 IF( n.LE.smlsiz )
THEN
355 CALL csteqr( compz, n, d, e, z, ldz, rwork, info )
361 IF( icompz.EQ.2 )
THEN
362 CALL slaset(
'Full', n, n, zero, one, rwork, n )
364 CALL sstedc(
'I', n, d, e, rwork, n,
365 $ rwork( ll ), lrwork-ll+1, iwork, liwork, info )
368 z( i, j ) = rwork( ( j-1 )*n+i )
379 orgnrm = slanst(
'M', n, d, e )
383 eps = slamch(
'Epsilon' )
390 IF( start.LE.n )
THEN
400 IF( finish.LT.n )
THEN
401 tiny = eps*sqrt( abs( d( finish ) ) )*
402 $ sqrt( abs( d( finish+1 ) ) )
403 IF( abs( e( finish ) ).GT.tiny )
THEN
411 m = finish - start + 1
412 IF( m.GT.smlsiz )
THEN
416 orgnrm = slanst(
'M', m, d( start ), e( start ) )
417 CALL slascl(
'G', 0, 0, orgnrm, one, m, 1, d( start ), m,
419 CALL slascl(
'G', 0, 0, orgnrm, one, m-1, 1, e( start ),
422 CALL claed0( n, m, d( start ), e( start ), z( 1, start ),
423 $ ldz, work, n, rwork, iwork, info )
425 info = ( info / ( m+1 )+start-1 )*( n+1 ) +
426 $ mod( info, ( m+1 ) ) + start - 1
432 CALL slascl(
'G', 0, 0, one, orgnrm, m, 1, d( start ), m,
436 CALL ssteqr(
'I', m, d( start ), e( start ), rwork, m,
437 $ rwork( m*m+1 ), info )
438 CALL clacrm( n, m, z( 1, start ), ldz, rwork, m, work, n,
440 CALL clacpy(
'A', n, m, work, n, z( 1, start ), ldz )
442 info = start*( n+1 ) + finish
461 IF( d( j ).LT.p )
THEN
469 CALL cswap( n, z( 1, i ), 1, z( 1, k ), 1 )
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.
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.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine clacrm(M, N, A, LDA, B, LDB, C, LDC, RWORK)
CLACRM multiplies a complex matrix by a square real matrix.
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine claed0(QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK, IWORK, INFO)
CLAED0 used by CSTEDC. Computes all eigenvalues and corresponding eigenvectors of an unreduced symmet...
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC