247 SUBROUTINE zlaed7( N, CUTPNT, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
248 $ ldq, rho, indxq, qstore, qptr, prmptr, perm,
249 $ givptr, givcol, givnum, work, rwork, iwork,
258 INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ,
263 INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
264 $ iwork( * ), perm( * ), prmptr( * ), qptr( * )
265 DOUBLE PRECISION D( * ), GIVNUM( 2, * ), QSTORE( * ), RWORK( * )
266 COMPLEX*16 Q( ldq, * ), WORK( * )
272 INTEGER COLTYP, CURR, I, IDLMDA, INDX,
273 $ indxc, indxp, iq, iw, iz, k, n1, n2, ptr
292 ELSE IF( min( 1, n ).GT.cutpnt .OR. n.LT.cutpnt )
THEN
294 ELSE IF( qsiz.LT.n )
THEN
296 ELSE IF( ldq.LT.max( 1, n ) )
THEN
300 CALL xerbla(
'ZLAED7', -info )
327 DO 10 i = 1, curlvl - 1
328 ptr = ptr + 2**( tlvls-i )
331 CALL dlaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,
332 $ givcol, givnum, qstore, qptr, rwork( iz ),
333 $ rwork( iz+n ), info )
339 IF( curlvl.EQ.tlvls )
THEN
347 CALL zlaed8( k, n, qsiz, q, ldq, d, rho, cutpnt, rwork( iz ),
348 $ rwork( idlmda ), work, qsiz, rwork( iw ),
349 $ iwork( indxp ), iwork( indx ), indxq,
350 $ perm( prmptr( curr ) ), givptr( curr+1 ),
351 $ givcol( 1, givptr( curr ) ),
352 $ givnum( 1, givptr( curr ) ), info )
353 prmptr( curr+1 ) = prmptr( curr ) + n
354 givptr( curr+1 ) = givptr( curr+1 ) + givptr( curr )
359 CALL dlaed9( k, 1, k, n, d, rwork( iq ), k, rho,
360 $ rwork( idlmda ), rwork( iw ),
361 $ qstore( qptr( curr ) ), k, info )
362 CALL zlacrm( qsiz, k, work, qsiz, qstore( qptr( curr ) ), k, q,
364 qptr( curr+1 ) = qptr( curr ) + k**2
373 CALL dlamrg( n1, n2, d, 1, -1, indxq )
375 qptr( curr+1 ) = qptr( curr )
subroutine dlaed9(K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, S, LDS, INFO)
DLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
subroutine zlaed8(K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA, Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR, GIVCOL, GIVNUM, INFO)
ZLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matri...
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 dlamrg(N1, N2, A, DTRD1, DTRD2, INDEX)
DLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlaeda(N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO)
DLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal ma...
subroutine zlacrm(M, N, A, LDA, B, LDB, C, LDC, RWORK)
ZLACRM multiplies a complex matrix by a square real matrix.