258 SUBROUTINE slaed7( ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q,
259 $ ldq, indxq, rho, cutpnt, qstore, qptr, prmptr,
260 $ perm, givptr, givcol, givnum, work, iwork,
269 INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N,
274 INTEGER GIVCOL( 2, * ), GIVPTR( * ), INDXQ( * ),
275 $ iwork( * ), perm( * ), prmptr( * ), qptr( * )
276 REAL D( * ), GIVNUM( 2, * ), Q( ldq, * ),
277 $ qstore( * ), work( * )
284 parameter( one = 1.0e0, zero = 0.0e0 )
287 INTEGER COLTYP, CURR, I, IDLMDA, INDX, INDXC, INDXP,
288 $ iq2, is, iw, iz, k, ldq2, n1, n2, ptr
302 IF( icompq.LT.0 .OR. icompq.GT.1 )
THEN
304 ELSE IF( n.LT.0 )
THEN
306 ELSE IF( icompq.EQ.1 .AND. qsiz.LT.n )
THEN
308 ELSE IF( ldq.LT.max( 1, n ) )
THEN
310 ELSE IF( min( 1, n ).GT.cutpnt .OR. n.LT.cutpnt )
THEN
314 CALL
xerbla(
'SLAED7', -info )
327 IF( icompq.EQ.1 )
THEN
348 DO 10 i = 1, curlvl - 1
349 ptr = ptr + 2**( tlvls-i )
352 CALL
slaeda( n, tlvls, curlvl, curpbm, prmptr, perm, givptr,
353 $ givcol, givnum, qstore, qptr, work( iz ),
354 $ work( iz+n ), info )
360 IF( curlvl.EQ.tlvls )
THEN
368 CALL
slaed8( icompq, k, n, qsiz, d, q, ldq, indxq, rho, cutpnt,
369 $ work( iz ), work( idlmda ), work( iq2 ), ldq2,
370 $ work( iw ), perm( prmptr( curr ) ), givptr( curr+1 ),
371 $ givcol( 1, givptr( curr ) ),
372 $ givnum( 1, givptr( curr ) ), iwork( indxp ),
373 $ iwork( indx ), info )
374 prmptr( curr+1 ) = prmptr( curr ) + n
375 givptr( curr+1 ) = givptr( curr+1 ) + givptr( curr )
380 CALL
slaed9( k, 1, k, n, d, work( is ), k, rho, work( idlmda ),
381 $ work( iw ), qstore( qptr( curr ) ), k, info )
384 IF( icompq.EQ.1 )
THEN
385 CALL
sgemm(
'N',
'N', qsiz, k, k, one, work( iq2 ), ldq2,
386 $ qstore( qptr( curr ) ), k, zero, q, ldq )
388 qptr( curr+1 ) = qptr( curr ) + k**2
394 CALL
slamrg( n1, n2, d, 1, -1, indxq )
396 qptr( curr+1 ) = qptr( curr )
subroutine slaed8(ICOMPQ, K, N, QSIZ, D, Q, LDQ, INDXQ, RHO, CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR, GIVCOL, GIVNUM, INDXP, INDX, INFO)
SLAED8 used by sstedc. Merges eigenvalues and deflates secular equation. Used when the original matri...
subroutine slamrg(N1, N2, A, STRD1, STRD2, INDEX)
SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaeda(N, TLVLS, CURLVL, CURPBM, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, Q, QPTR, Z, ZTEMP, INFO)
SLAEDA used by sstedc. Computes the Z vector determining the rank-one modification of the diagonal ma...
subroutine slaed9(K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, S, LDS, INFO)
SLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine slaed7(ICOMPQ, N, QSIZ, TLVLS, CURLVL, CURPBM, D, Q, LDQ, INDXQ, RHO, CUTPNT, QSTORE, QPTR, PRMPTR, PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, INFO)
SLAED7 used by sstedc. Computes the updated eigensystem of a diagonal matrix after modification by a ...