227 SUBROUTINE claed8( K, N, QSIZ, Q, LDQ, D, RHO, CUTPNT, Z, DLAMDA,
228 $ q2, ldq2, w, indxp, indx, indxq, perm, givptr,
229 $ givcol, givnum, info )
237 INTEGER cutpnt, givptr, info, k, ldq, ldq2, n, qsiz
241 INTEGER givcol( 2, * ), indx( * ), indxp( * ),
242 $ indxq( * ), perm( * )
243 REAL d( * ), dlamda( * ), givnum( 2, * ), w( * ),
245 COMPLEX q( ldq, * ), q2( ldq2, * )
251 REAL mone, zero, one, two, eight
252 parameter( mone = -1.0e0, zero = 0.0e0, one = 1.0e0,
253 $ two = 2.0e0, eight = 8.0e0 )
256 INTEGER i, imax, j, jlam, jmax, jp, k2, n1, n1p1, n2
257 REAL c, eps, s, t, tau, tol
269 INTRINSIC abs, max, min, sqrt
279 ELSE IF( qsiz.LT.n )
THEN
281 ELSE IF( ldq.LT.max( 1, n ) )
THEN
283 ELSE IF( cutpnt.LT.min( 1, n ) .OR. cutpnt.GT.n )
THEN
285 ELSE IF( ldq2.LT.max( 1, n ) )
THEN
289 CALL
xerbla(
'CLAED8', -info )
309 IF( rho.LT.zero )
THEN
310 CALL
sscal( n2, mone, z( n1p1 ), 1 )
315 t = one / sqrt( two )
319 CALL
sscal( n, t, z, 1 )
324 DO 20 i = cutpnt + 1, n
325 indxq( i ) = indxq( i ) + cutpnt
328 dlamda( i ) = d( indxq( i ) )
329 w( i ) = z( indxq( i ) )
333 CALL
slamrg( n1, n2, dlamda, 1, 1, indx )
335 d( i ) = dlamda( indx( i ) )
336 z( i ) = w( indx( i ) )
344 tol = eight*eps*abs( d( jmax ) )
350 IF( rho*abs( z( imax ) ).LE.tol )
THEN
353 perm( j ) = indxq( indx( j ) )
354 CALL
ccopy( qsiz, q( 1, perm( j ) ), 1, q2( 1, j ), 1 )
356 CALL
clacpy(
'A', qsiz, n, q2( 1, 1 ), ldq2, q( 1, 1 ), ldq )
369 IF( rho*abs( z( j ) ).LE.tol )
THEN
386 IF( rho*abs( z( j ) ).LE.tol )
THEN
403 t = d( j ) - d( jlam )
406 IF( abs( t*c*s ).LE.tol )
THEN
416 givcol( 1, givptr ) = indxq( indx( jlam ) )
417 givcol( 2, givptr ) = indxq( indx( j ) )
418 givnum( 1, givptr ) = c
419 givnum( 2, givptr ) = s
420 CALL
csrot( qsiz, q( 1, indxq( indx( jlam ) ) ), 1,
421 $ q( 1, indxq( indx( j ) ) ), 1, c, s )
422 t = d( jlam )*c*c + d( j )*s*s
423 d( j ) = d( jlam )*s*s + d( j )*c*c
429 IF( d( jlam ).LT.d( indxp( k2+i ) ) )
THEN
430 indxp( k2+i-1 ) = indxp( k2+i )
435 indxp( k2+i-1 ) = jlam
438 indxp( k2+i-1 ) = jlam
444 dlamda( k ) = d( jlam )
456 dlamda( k ) = d( jlam )
468 dlamda( j ) = d( jp )
469 perm( j ) = indxq( indx( jp ) )
470 CALL
ccopy( qsiz, q( 1, perm( j ) ), 1, q2( 1, j ), 1 )
477 CALL
scopy( n-k, dlamda( k+1 ), 1, d( k+1 ), 1 )
478 CALL
clacpy(
'A', qsiz, n-k, q2( 1, k+1 ), ldq2, q( 1, k+1 ),