144 SUBROUTINE slasq5( I0, N0, Z, PP, TAU, SIGMA, DMIN, DMIN1, DMIN2,
145 $ dn, dnm1, dnm2, ieee, eps )
155 REAL DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU,
166 parameter ( zero = 0.0e0, half = 0.5 )
170 REAL D, EMIN, TEMP, DTHRESH
177 IF( ( n0-i0-1 ).LE.0 )
180 dthresh = eps*(sigma+tau)
181 IF( tau.LT.dthresh*half ) tau = zero
182 IF( tau.NE.zero )
THEN
194 DO 10 j4 = 4*i0, 4*( n0-3 ), 4
195 z( j4-2 ) = d + z( j4-1 )
196 temp = z( j4+1 ) / z( j4-2 )
198 dmin = min( dmin, d )
199 z( j4 ) = z( j4-1 )*temp
200 emin = min( z( j4 ), emin )
203 DO 20 j4 = 4*i0, 4*( n0-3 ), 4
204 z( j4-3 ) = d + z( j4 )
205 temp = z( j4+2 ) / z( j4-3 )
207 dmin = min( dmin, d )
208 z( j4-1 ) = z( j4 )*temp
209 emin = min( z( j4-1 ), emin )
219 z( j4-2 ) = dnm2 + z( j4p2 )
220 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
221 dnm1 = z( j4p2+2 )*( dnm2 / z( j4-2 ) ) - tau
222 dmin = min( dmin, dnm1 )
227 z( j4-2 ) = dnm1 + z( j4p2 )
228 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
229 dn = z( j4p2+2 )*( dnm1 / z( j4-2 ) ) - tau
230 dmin = min( dmin, dn )
237 DO 30 j4 = 4*i0, 4*( n0-3 ), 4
238 z( j4-2 ) = d + z( j4-1 )
242 z( j4 ) = z( j4+1 )*( z( j4-1 ) / z( j4-2 ) )
243 d = z( j4+1 )*( d / z( j4-2 ) ) - tau
245 dmin = min( dmin, d )
246 emin = min( emin, z( j4 ) )
249 DO 40 j4 = 4*i0, 4*( n0-3 ), 4
250 z( j4-3 ) = d + z( j4 )
254 z( j4-1 ) = z( j4+2 )*( z( j4 ) / z( j4-3 ) )
255 d = z( j4+2 )*( d / z( j4-3 ) ) - tau
257 dmin = min( dmin, d )
258 emin = min( emin, z( j4-1 ) )
268 z( j4-2 ) = dnm2 + z( j4p2 )
269 IF( dnm2.LT.zero )
THEN
272 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
273 dnm1 = z( j4p2+2 )*( dnm2 / z( j4-2 ) ) - tau
275 dmin = min( dmin, dnm1 )
280 z( j4-2 ) = dnm1 + z( j4p2 )
281 IF( dnm1.LT.zero )
THEN
284 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
285 dn = z( j4p2+2 )*( dnm1 / z( j4-2 ) ) - tau
287 dmin = min( dmin, dn )
303 DO 50 j4 = 4*i0, 4*( n0-3 ), 4
304 z( j4-2 ) = d + z( j4-1 )
305 temp = z( j4+1 ) / z( j4-2 )
307 IF( d.LT.dthresh ) d = zero
308 dmin = min( dmin, d )
309 z( j4 ) = z( j4-1 )*temp
310 emin = min( z( j4 ), emin )
313 DO 60 j4 = 4*i0, 4*( n0-3 ), 4
314 z( j4-3 ) = d + z( j4 )
315 temp = z( j4+2 ) / z( j4-3 )
317 IF( d.LT.dthresh ) d = zero
318 dmin = min( dmin, d )
319 z( j4-1 ) = z( j4 )*temp
320 emin = min( z( j4-1 ), emin )
330 z( j4-2 ) = dnm2 + z( j4p2 )
331 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
332 dnm1 = z( j4p2+2 )*( dnm2 / z( j4-2 ) ) - tau
333 dmin = min( dmin, dnm1 )
338 z( j4-2 ) = dnm1 + z( j4p2 )
339 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
340 dn = z( j4p2+2 )*( dnm1 / z( j4-2 ) ) - tau
341 dmin = min( dmin, dn )
348 DO 70 j4 = 4*i0, 4*( n0-3 ), 4
349 z( j4-2 ) = d + z( j4-1 )
353 z( j4 ) = z( j4+1 )*( z( j4-1 ) / z( j4-2 ) )
354 d = z( j4+1 )*( d / z( j4-2 ) ) - tau
356 IF( d.LT.dthresh ) d = zero
357 dmin = min( dmin, d )
358 emin = min( emin, z( j4 ) )
361 DO 80 j4 = 4*i0, 4*( n0-3 ), 4
362 z( j4-3 ) = d + z( j4 )
366 z( j4-1 ) = z( j4+2 )*( z( j4 ) / z( j4-3 ) )
367 d = z( j4+2 )*( d / z( j4-3 ) ) - tau
369 IF( d.LT.dthresh ) d = zero
370 dmin = min( dmin, d )
371 emin = min( emin, z( j4-1 ) )
381 z( j4-2 ) = dnm2 + z( j4p2 )
382 IF( dnm2.LT.zero )
THEN
385 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
386 dnm1 = z( j4p2+2 )*( dnm2 / z( j4-2 ) ) - tau
388 dmin = min( dmin, dnm1 )
393 z( j4-2 ) = dnm1 + z( j4p2 )
394 IF( dnm1.LT.zero )
THEN
397 z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
398 dn = z( j4p2+2 )*( dnm1 / z( j4-2 ) ) - tau
400 dmin = min( dmin, dn )
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. ...