181 SUBROUTINE dlasq3( 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 DOUBLE PRECISION desig, dmin, dmin1, dmin2, dn, dn1, dn2, g,
197 DOUBLE PRECISION z( * )
203 DOUBLE PRECISION cbias
204 parameter( cbias = 1.50d0 )
205 DOUBLE PRECISION zero, qurtr, half, one, two, hundrd
206 parameter( zero = 0.0d0, qurtr = 0.250d0, half = 0.5d0,
207 $ one = 1.0d0, two = 2.0d0, hundrd = 100.0d0 )
210 INTEGER ipn4, j4, n0in, nn, ttype
211 DOUBLE PRECISION eps, s, t, temp, tol, tol2
214 EXTERNAL dlasq4, dlasq5, dlasq6
217 DOUBLE PRECISION dlamch
219 EXTERNAL disnan, dlamch
222 INTRINSIC abs, max, min, sqrt
227 eps = dlamch(
'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 IF( z( nn-5 ).GT.z( nn-3 )*tol2 )
THEN 271 t = half*( ( z( nn-7 )-z( nn-3 ) )+z( nn-5 ) )
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 dlasq4( i0, n0, z, pp, n0in, dmin, dmin1, dmin2, dn, dn1,
328 $ dn2, tau, ttype, g )
334 CALL dlasq5( i0, n0, z, pp, tau, dmin, dmin1, dmin2, dn,
337 ndiv = ndiv + ( n0-i0+2 )
342 IF( dmin.GE.zero .AND. dmin1.GT.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( disnan( dmin ) )
THEN 385 IF( tau.EQ.zero )
THEN 401 CALL dlasq6( 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