220 SUBROUTINE dstevx( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
221 $ m, w, z, ldz, work, iwork, ifail, info )
229 CHARACTER jobz, range
230 INTEGER il, info, iu, ldz, m, n
231 DOUBLE PRECISION abstol, vl, vu
234 INTEGER ifail( * ), iwork( * )
235 DOUBLE PRECISION d( * ), e( * ), w( * ), work( * ), z( ldz, * )
241 DOUBLE PRECISION zero, one
242 parameter( zero = 0.0d0, one = 1.0d0 )
245 LOGICAL alleig, indeig, test, valeig, wantz
247 INTEGER i, imax, indibl, indisp, indiwo, indwrk,
248 $ iscale, itmp1,
j, jj, nsplit
249 DOUBLE PRECISION bignum, eps, rmax, rmin, safmin, sigma, smlnum,
250 $ tmp1, tnrm, vll, vuu
262 INTRINSIC max, min, sqrt
268 wantz =
lsame( jobz,
'V' )
269 alleig =
lsame( range,
'A' )
270 valeig =
lsame( range,
'V' )
271 indeig =
lsame( range,
'I' )
274 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
276 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
278 ELSE IF( n.LT.0 )
THEN
282 IF( n.GT.0 .AND. vu.LE.vl )
284 ELSE IF( indeig )
THEN
285 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
287 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
293 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
298 CALL
xerbla(
'DSTEVX', -info )
309 IF( alleig .OR. indeig )
THEN
313 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
325 safmin =
dlamch(
'Safe minimum' )
326 eps =
dlamch(
'Precision' )
327 smlnum = safmin / eps
328 bignum = one / smlnum
329 rmin = sqrt( smlnum )
330 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
342 tnrm =
dlanst(
'M', n, d, e )
343 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
346 ELSE IF( tnrm.GT.rmax )
THEN
350 IF( iscale.EQ.1 )
THEN
351 CALL
dscal( n, sigma, d, 1 )
352 CALL
dscal( n-1, sigma, e( 1 ), 1 )
365 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
369 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
370 CALL
dcopy( n, d, 1, w, 1 )
371 CALL
dcopy( n-1, e( 1 ), 1, work( 1 ), 1 )
373 IF( .NOT.wantz )
THEN
374 CALL
dsterf( n, w, work, info )
376 CALL
dsteqr(
'I', n, w, work, z, ldz, work( indwrk ), info )
401 CALL
dstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
402 $ nsplit, w, iwork( indibl ), iwork( indisp ),
403 $ work( indwrk ), iwork( indiwo ), info )
406 CALL
dstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
407 $ z, ldz, work( indwrk ), iwork( indiwo ), ifail,
414 IF( iscale.EQ.1 )
THEN
420 CALL
dscal( imax, one / sigma, w, 1 )
431 IF( w( jj ).LT.tmp1 )
THEN
438 itmp1 = iwork( indibl+i-1 )
440 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
442 iwork( indibl+
j-1 ) = itmp1
443 CALL
dswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
446 ifail( i ) = ifail(
j )
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
LOGICAL function lsame(CA, CB)
LSAME
subroutine dstevx(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
DOUBLE PRECISION function dlanst(NORM, N, D, E)
DLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ