145 SUBROUTINE zlaed0( QSIZ, N, D, E, Q, LDQ, QSTORE, LDQS, RWORK,
154 INTEGER INFO, LDQ, LDQS, N, QSIZ
158 DOUBLE PRECISION D( * ), E( * ), RWORK( * )
159 COMPLEX*16 Q( ldq, * ), QSTORE( ldqs, * )
168 parameter ( two = 2.d+0 )
171 INTEGER CURLVL, CURPRB, CURR, I, IGIVCL, IGIVNM,
172 $ igivpt, indxq, iperm, iprmpt, iq, iqptr, iwrem,
173 $ j, k, lgn, ll, matsiz, msd2, smlsiz, smm1,
174 $ spm1, spm2, submat, subpbs, tlvls
175 DOUBLE PRECISION TEMP
185 INTRINSIC abs, dble, int, log, max
197 IF( qsiz.LT.max( 0, n ) )
THEN
199 ELSE IF( n.LT.0 )
THEN
201 ELSE IF( ldq.LT.max( 1, n ) )
THEN
203 ELSE IF( ldqs.LT.max( 1, n ) )
THEN
207 CALL xerbla(
'ZLAED0', -info )
216 smlsiz = ilaenv( 9,
'ZLAED0',
' ', 0, 0, 0, 0 )
225 IF( iwork( subpbs ).GT.smlsiz )
THEN
226 DO 20 j = subpbs, 1, -1
227 iwork( 2*j ) = ( iwork( j )+1 ) / 2
228 iwork( 2*j-1 ) = iwork( j ) / 2
235 iwork( j ) = iwork( j ) + iwork( j-1 )
243 submat = iwork( i ) + 1
245 d( smm1 ) = d( smm1 ) - abs( e( smm1 ) )
246 d( submat ) = d( submat ) - abs( e( smm1 ) )
254 temp = log( dble( n ) ) / log( two )
260 iprmpt = indxq + n + 1
261 iperm = iprmpt + n*lgn
262 iqptr = iperm + n*lgn
263 igivpt = iqptr + n + 2
264 igivcl = igivpt + n*lgn
267 iq = igivnm + 2*n*lgn
268 iwrem = iq + n**2 + 1
271 iwork( iprmpt+i ) = 1
272 iwork( igivpt+i ) = 1
285 submat = iwork( i ) + 1
286 matsiz = iwork( i+1 ) - iwork( i )
288 ll = iq - 1 + iwork( iqptr+curr )
289 CALL dsteqr(
'I', matsiz, d( submat ), e( submat ),
290 $ rwork( ll ), matsiz, rwork, info )
291 CALL zlacrm( qsiz, matsiz, q( 1, submat ), ldq, rwork( ll ),
292 $ matsiz, qstore( 1, submat ), ldqs,
294 iwork( iqptr+curr+1 ) = iwork( iqptr+curr ) + matsiz**2
297 info = submat*( n+1 ) + submat + matsiz - 1
301 DO 60 j = submat, iwork( i+1 )
314 IF( subpbs.GT.1 )
THEN
323 submat = iwork( i ) + 1
324 matsiz = iwork( i+2 ) - iwork( i )
336 CALL zlaed7( matsiz, msd2, qsiz, tlvls, curlvl, curprb,
337 $ d( submat ), qstore( 1, submat ), ldqs,
338 $ e( submat+msd2-1 ), iwork( indxq+submat ),
339 $ rwork( iq ), iwork( iqptr ), iwork( iprmpt ),
340 $ iwork( iperm ), iwork( igivpt ),
341 $ iwork( igivcl ), rwork( igivnm ),
342 $ q( 1, submat ), rwork( iwrem ),
343 $ iwork( subpbs+1 ), info )
345 info = submat*( n+1 ) + submat + matsiz - 1
348 iwork( i / 2+1 ) = iwork( i+2 )
363 CALL zcopy( qsiz, qstore( 1, j ), 1, q( 1, i ), 1 )
365 CALL dcopy( n, rwork, 1, d, 1 )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlaed7(N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, LDQ, RHO, INDXQ, QSTORE, QPTR, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, INFO)
ZLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a ...
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
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.