177 SUBROUTINE dlasq3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX,
179 $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1,
188 INTEGER I0, ITER, N0, NDIV, NFAIL, PP
189 DOUBLE PRECISION DESIG, DMIN, DMIN1, DMIN2, DN, DN1, DN2, G,
193 DOUBLE PRECISION Z( * )
199 DOUBLE PRECISION CBIAS
200 PARAMETER ( CBIAS = 1.50d0 )
201 DOUBLE PRECISION ZERO, QURTR, HALF, ONE, TWO, HUNDRD
202 parameter( zero = 0.0d0, qurtr = 0.250d0, half = 0.5d0,
203 $ one = 1.0d0, two = 2.0d0, hundrd = 100.0d0 )
206 INTEGER IPN4, J4, N0IN, NN, TTYPE
207 DOUBLE PRECISION EPS, S, T, TEMP, TOL, TOL2
213 DOUBLE PRECISION DLAMCH
215 EXTERNAL DISNAN, DLAMCH
218 INTRINSIC abs, max, min, sqrt
223 eps = dlamch(
'Precision' )
241 IF( z( nn-5 ).GT.tol2*( sigma+z( nn-3 ) ) .AND.
242 $ z( nn-2*pp-4 ).GT.tol2*z( nn-7 ) )
247 z( 4*n0-3 ) = z( 4*n0+pp-3 ) + sigma
255 IF( z( nn-9 ).GT.tol2*sigma .AND.
256 $ z( nn-2*pp-8 ).GT.tol2*z( nn-11 ) )
261 IF( z( nn-3 ).GT.z( nn-7 ) )
THEN
263 z( nn-3 ) = z( nn-7 )
266 t = half*( ( z( nn-7 )-z( nn-3 ) )+z( nn-5 ) )
267 IF( z( nn-5 ).GT.z( nn-3 )*tol2.AND.t.NE.zero )
THEN
268 s = z( nn-3 )*( z( nn-5 ) / t )
270 s = z( nn-3 )*( z( nn-5 ) /
271 $ ( t*( one+sqrt( one+s / t ) ) ) )
273 s = z( nn-3 )*( z( nn-5 ) / ( t+sqrt( t )*sqrt( t+s ) ) )
275 t = z( nn-7 ) + ( s+z( nn-5 ) )
276 z( nn-3 ) = z( nn-3 )*( z( nn-7 ) / t )
279 z( 4*n0-7 ) = z( nn-7 ) + sigma
280 z( 4*n0-3 ) = z( nn-3 ) + sigma
290 IF( dmin.LE.zero .OR. n0.LT.n0in )
THEN
291 IF( cbias*z( 4*i0+pp-3 ).LT.z( 4*n0+pp-3 ) )
THEN
293 DO 60 j4 = 4*i0, 2*( i0+n0-1 ), 4
295 z( j4-3 ) = z( ipn4-j4-3 )
296 z( ipn4-j4-3 ) = temp
298 z( j4-2 ) = z( ipn4-j4-2 )
299 z( ipn4-j4-2 ) = temp
301 z( j4-1 ) = z( ipn4-j4-5 )
302 z( ipn4-j4-5 ) = temp
304 z( j4 ) = z( ipn4-j4-4 )
305 z( ipn4-j4-4 ) = temp
307 IF( n0-i0.LE.4 )
THEN
308 z( 4*n0+pp-1 ) = z( 4*i0+pp-1 )
309 z( 4*n0-pp ) = z( 4*i0-pp )
311 dmin2 = min( dmin2, z( 4*n0+pp-1 ) )
312 z( 4*n0+pp-1 ) = min( z( 4*n0+pp-1 ), z( 4*i0+pp-1 ),
314 z( 4*n0-pp ) = min( z( 4*n0-pp ), z( 4*i0-pp ),
316 qmax = max( qmax, z( 4*i0+pp-3 ), z( 4*i0+pp+1 ) )
323 CALL dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1,
324 $ dn2, tau, ttype, g )
330 CALL dlasq5( i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2, dn,
331 $ dn1, dn2, ieee, eps )
333 ndiv = ndiv + ( n0-i0+2 )
338 IF( dmin.GE.zero .AND. dmin1.GE.zero )
THEN
344 ELSE IF( dmin.LT.zero .AND. dmin1.GT.zero .AND.
345 $ z( 4*( n0-1 )-pp ).LT.tol*( sigma+dn1 ) .AND.
346 $ abs( dn ).LT.tol*sigma )
THEN
350 z( 4*( n0-1 )-pp+2 ) = zero
353 ELSE IF( dmin.LT.zero )
THEN
358 IF( ttype.LT.-22 )
THEN
363 ELSE IF( dmin1.GT.zero )
THEN
367 tau = ( tau+dmin )*( one-two*eps )
377 ELSE IF( disnan( dmin ) )
THEN
381 IF( tau.EQ.zero )
THEN
397 CALL dlasq6( i0, n0, z, pp, dmin, dmin1, dmin2, dn, dn1, dn2 )
398 ndiv = ndiv + ( n0-i0+2 )
403 IF( tau.LT.sigma )
THEN
406 desig = desig - ( t-sigma )
409 desig = sigma - ( t-tau ) + desig
subroutine dlasq3(i0, n0, z, pp, dmin, sigma, desig, qmax, nfail, iter, ndiv, ieee, ttype, dmin1, dmin2, dn, dn1, dn2, g, tau)
DLASQ3 checks for deflation, computes a shift and calls dqds. Used by sbdsqr.
subroutine dlasq4(i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1, dn2, tau, ttype, g)
DLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous trans...
subroutine dlasq5(i0, n0, z, pp, tau, sigma, dmin, dmin1, dmin2, dn, dnm1, dnm2, ieee, eps)
DLASQ5 computes one dqds transform in ping-pong form. Used by sbdsqr and sstegr.