223 SUBROUTINE claed8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z,
225 $ Q2, LDQ2, W, INDXP, INDX, INDXQ, PERM, GIVPTR,
226 $ GIVCOL, GIVNUM, INFO )
233 INTEGER CUTPNT, GIVPTR, INFO, K, LDQ, LDQ2, N, QSIZ
237 INTEGER GIVCOL( 2, * ), INDX( * ), INDXP( * ),
238 $ INDXQ( * ), PERM( * )
239 REAL D( * ), DLAMBDA( * ), GIVNUM( 2, * ), W( * ),
241 COMPLEX Q( LDQ, * ), Q2( LDQ2, * )
247 REAL MONE, ZERO, ONE, TWO, EIGHT
248 PARAMETER ( MONE = -1.0e0, zero = 0.0e0, one = 1.0e0,
249 $ two = 2.0e0, eight = 8.0e0 )
252 INTEGER I, IMAX, J, JLAM, JMAX, JP, K2, N1, N1P1, N2
253 REAL C, EPS, S, T, TAU, TOL
258 EXTERNAL ISAMAX, SLAMCH, SLAPY2
266 INTRINSIC abs, max, min, sqrt
276 ELSE IF( qsiz.LT.n )
THEN
278 ELSE IF( ldq.LT.max( 1, n ) )
THEN
280 ELSE IF( cutpnt.LT.min( 1, n ) .OR. cutpnt.GT.n )
THEN
282 ELSE IF( ldq2.LT.max( 1, n ) )
THEN
286 CALL xerbla(
'CLAED8', -info )
306 IF( rho.LT.zero )
THEN
307 CALL sscal( n2, mone, z( n1p1 ), 1 )
312 t = one / sqrt( two )
316 CALL sscal( n, t, z, 1 )
321 DO 20 i = cutpnt + 1, n
322 indxq( i ) = indxq( i ) + cutpnt
325 dlambda( i ) = d( indxq( i ) )
326 w( i ) = z( indxq( i ) )
330 CALL slamrg( n1, n2, dlambda, 1, 1, indx )
332 d( i ) = dlambda( indx( i ) )
333 z( i ) = w( indx( i ) )
338 imax = isamax( n, z, 1 )
339 jmax = isamax( n, d, 1 )
340 eps = slamch(
'Epsilon' )
341 tol = eight*eps*abs( d( jmax ) )
347 IF( rho*abs( z( imax ) ).LE.tol )
THEN
350 perm( j ) = indxq( indx( j ) )
351 CALL ccopy( qsiz, q( 1, perm( j ) ), 1, q2( 1, j ), 1 )
353 CALL clacpy(
'A', qsiz, n, q2( 1, 1 ), ldq2, q( 1, 1 ),
367 IF( rho*abs( z( j ) ).LE.tol )
THEN
384 IF( rho*abs( z( j ) ).LE.tol )
THEN
401 t = d( j ) - d( jlam )
404 IF( abs( t*c*s ).LE.tol )
THEN
414 givcol( 1, givptr ) = indxq( indx( jlam ) )
415 givcol( 2, givptr ) = indxq( indx( j ) )
416 givnum( 1, givptr ) = c
417 givnum( 2, givptr ) = s
418 CALL csrot( qsiz, q( 1, indxq( indx( jlam ) ) ), 1,
419 $ q( 1, indxq( indx( j ) ) ), 1, c, s )
420 t = d( jlam )*c*c + d( j )*s*s
421 d( j ) = d( jlam )*s*s + d( j )*c*c
427 IF( d( jlam ).LT.d( indxp( k2+i ) ) )
THEN
428 indxp( k2+i-1 ) = indxp( k2+i )
433 indxp( k2+i-1 ) = jlam
436 indxp( k2+i-1 ) = jlam
442 dlambda( k ) = d( jlam )
454 dlambda( k ) = d( jlam )
466 dlambda( j ) = d( jp )
467 perm( j ) = indxq( indx( jp ) )
468 CALL ccopy( qsiz, q( 1, perm( j ) ), 1, q2( 1, j ), 1 )
475 CALL scopy( n-k, dlambda( k+1 ), 1, d( k+1 ), 1 )
476 CALL clacpy(
'A', qsiz, n-k, q2( 1, k+1 ), ldq2, q( 1,
subroutine claed8(k, n, qsiz, q, ldq, d, rho, cutpnt, z, dlambda, q2, ldq2, w, indxp, indx, indxq, perm, givptr, givcol, givnum, info)
CLAED8 used by CSTEDC. Merges eigenvalues and deflates secular equation. Used when the original matri...