181 SUBROUTINE slasq3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL,
182 $ iter, ndiv, ieee, ttype, dmin1, dmin2, dn, dn1,
192 INTEGER I0, ITER, N0, NDIV, NFAIL, PP
193 REAL DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
204 parameter ( cbias = 1.50e0 )
205 REAL ZERO, QURTR, HALF, ONE, TWO, HUNDRD
206 parameter ( zero = 0.0e0, qurtr = 0.250e0, half = 0.5e0,
207 $ one = 1.0e0, two = 2.0e0, hundrd = 100.0e0 )
210 INTEGER IPN4, J4, N0IN, NN, TTYPE
211 REAL EPS, S, T, TEMP, TOL, TOL2
219 EXTERNAL sisnan, slamch
222 INTRINSIC abs, max, min, sqrt
227 eps = slamch(
'Precision' )
245 IF( z( nn-5 ).GT.tol2*( sigma+z( nn-3 ) ) .AND.
246 $ z( nn-2*pp-4 ).GT.tol2*z( nn-7 ) )
251 z( 4*n0-3 ) = z( 4*n0+pp-3 ) + sigma
259 IF( z( nn-9 ).GT.tol2*sigma .AND.
260 $ z( nn-2*pp-8 ).GT.tol2*z( nn-11 ) )
265 IF( z( nn-3 ).GT.z( nn-7 ) )
THEN
267 z( nn-3 ) = z( nn-7 )
270 t = half*( ( z( nn-7 )-z( nn-3 ) )+z( nn-5 ) )
271 IF( z( nn-5 ).GT.z( nn-3 )*tol2.AND.t.NE.zero )
THEN
272 s = z( nn-3 )*( z( nn-5 ) / t )
274 s = z( nn-3 )*( z( nn-5 ) /
275 $ ( t*( one+sqrt( one+s / t ) ) ) )
277 s = z( nn-3 )*( z( nn-5 ) / ( t+sqrt( t )*sqrt( t+s ) ) )
279 t = z( nn-7 ) + ( s+z( nn-5 ) )
280 z( nn-3 ) = z( nn-3 )*( z( nn-7 ) / t )
283 z( 4*n0-7 ) = z( nn-7 ) + sigma
284 z( 4*n0-3 ) = z( nn-3 ) + sigma
294 IF( dmin.LE.zero .OR. n0.LT.n0in )
THEN
295 IF( cbias*z( 4*i0+pp-3 ).LT.z( 4*n0+pp-3 ) )
THEN
297 DO 60 j4 = 4*i0, 2*( i0+n0-1 ), 4
299 z( j4-3 ) = z( ipn4-j4-3 )
300 z( ipn4-j4-3 ) = temp
302 z( j4-2 ) = z( ipn4-j4-2 )
303 z( ipn4-j4-2 ) = temp
305 z( j4-1 ) = z( ipn4-j4-5 )
306 z( ipn4-j4-5 ) = temp
308 z( j4 ) = z( ipn4-j4-4 )
309 z( ipn4-j4-4 ) = temp
311 IF( n0-i0.LE.4 )
THEN
312 z( 4*n0+pp-1 ) = z( 4*i0+pp-1 )
313 z( 4*n0-pp ) = z( 4*i0-pp )
315 dmin2 = min( dmin2, z( 4*n0+pp-1 ) )
316 z( 4*n0+pp-1 ) = min( z( 4*n0+pp-1 ), z( 4*i0+pp-1 ),
318 z( 4*n0-pp ) = min( z( 4*n0-pp ), z( 4*i0-pp ),
320 qmax = max( qmax, z( 4*i0+pp-3 ), z( 4*i0+pp+1 ) )
327 CALL slasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1,
328 $ dn2, tau, ttype, g )
334 CALL slasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2, dn,
335 $ dn1, dn2, ieee, eps )
337 ndiv = ndiv + ( n0-i0+2 )
342 IF( dmin.GE.zero .AND. dmin1.GE.zero )
THEN
348 ELSE IF( dmin.LT.zero .AND. dmin1.GT.zero .AND.
349 $ z( 4*( n0-1 )-pp ).LT.tol*( sigma+dn1 ) .AND.
350 $ abs( dn ).LT.tol*sigma )
THEN
354 z( 4*( n0-1 )-pp+2 ) = zero
357 ELSE IF( dmin.LT.zero )
THEN
362 IF( ttype.LT.-22 )
THEN
367 ELSE IF( dmin1.GT.zero )
THEN
371 tau = ( tau+dmin )*( one-two*eps )
381 ELSE IF( sisnan( dmin ) )
THEN
385 IF( tau.EQ.zero )
THEN
401 CALL slasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn, dn1, dn2 )
402 ndiv = ndiv + ( n0-i0+2 )
407 IF( tau.LT.sigma )
THEN
410 desig = desig - ( t-sigma )
413 desig = sigma - ( t-tau ) + desig
subroutine slasq4(I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU, TTYPE, G)
SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous trans...
subroutine slasq3(I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, DN2, G, TAU)
SLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr.
subroutine slasq5(I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, IEEE, EPS)
SLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr.
subroutine slasq6(I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN, DNM1, DNM2)
SLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr.