167 SUBROUTINE dlarrj( N, D, E2, IFIRST, ILAST,
168 $ rtol, offset, w, werr, work, iwork,
169 $ pivmin, spdiam, info )
177 INTEGER ifirst, ilast, info, n, offset
178 DOUBLE PRECISION pivmin, rtol, spdiam
182 DOUBLE PRECISION d( * ), e2( * ), w( * ),
183 $ werr( * ), work( * )
189 DOUBLE PRECISION zero, one, two, half
190 parameter( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
195 INTEGER cnt, i, i1, i2, ii, iter,
j, k, next, nint,
196 $ olnint, p, prev, savi1
197 DOUBLE PRECISION dplus, fac, left, mid, right, s, tmp, width
207 maxitr = int( ( log( spdiam+pivmin )-log( pivmin ) ) /
227 left = w( ii ) - werr( ii )
229 right = w( ii ) + werr( ii )
231 tmp = max( abs( left ), abs( right ) )
234 IF( width.LT.rtol*tmp )
THEN
241 IF((i.EQ.i1).AND.(i.LT.i2)) i1 = i + 1
242 IF((prev.GE.i1).AND.(i.LE.i2)) iwork( 2*prev-1 ) = i + 1
255 IF( dplus.LT.zero ) cnt = cnt + 1
257 dplus = d(
j ) - s - e2(
j-1 )/dplus
258 IF( dplus.LT.zero ) cnt = cnt + 1
260 IF( cnt.GT.i-1 )
THEN
261 left = left - werr( ii )*fac
273 IF( dplus.LT.zero ) cnt = cnt + 1
275 dplus = d(
j ) - s - e2(
j-1 )/dplus
276 IF( dplus.LT.zero ) cnt = cnt + 1
279 right = right + werr( ii )*fac
309 mid = half*( left + right )
313 tmp = max( abs( left ), abs( right ) )
315 IF( ( width.LT.rtol*tmp ) .OR.
316 $ (iter.EQ.maxitr) )
THEN
325 IF(prev.GE.i1) iwork( 2*prev-1 ) = next
337 IF( dplus.LT.zero ) cnt = cnt + 1
339 dplus = d(
j ) - s - e2(
j-1 )/dplus
340 IF( dplus.LT.zero ) cnt = cnt + 1
342 IF( cnt.LE.i-1 )
THEN
354 IF( ( nint.GT.0 ).AND.(iter.LE.maxitr) ) go to 80
358 DO 110 i = savi1, ilast
362 IF( iwork( k-1 ).EQ.0 )
THEN
363 w( ii ) = half*( work( k-1 )+work( k ) )
364 werr( ii ) = work( k ) - w( ii )
subroutine dlarrj(N, D, E2, IFIRST, ILAST, RTOL, OFFSET, W, WERR, WORK, IWORK, PIVMIN, SPDIAM, INFO)
DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j