229 SUBROUTINE dspevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
230 $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
238 CHARACTER JOBZ, RANGE, UPLO
239 INTEGER IL, INFO, IU, LDZ, M, N
240 DOUBLE PRECISION ABSTOL, VL, VU
243 INTEGER IFAIL( * ), IWORK( * )
244 DOUBLE PRECISION AP( * ), W( * ), WORK( * ), Z( LDZ, * )
250 DOUBLE PRECISION ZERO, ONE
251 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
254 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
256 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
257 $ indisp, indiwo, indtau, indwrk, iscale, itmp1,
259 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
260 $ SIGMA, SMLNUM, TMP1, VLL, VUU
264 DOUBLE PRECISION DLAMCH, DLANSP
265 EXTERNAL lsame, dlamch, dlansp
273 INTRINSIC max, min, sqrt
279 wantz = lsame( jobz,
'V' )
280 alleig = lsame( range,
'A' )
281 valeig = lsame( range,
'V' )
282 indeig = lsame( range,
'I' )
285 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
287 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
289 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR.
290 $ lsame( uplo,
'U' ) ) )
293 ELSE IF( n.LT.0 )
THEN
297 IF( n.GT.0 .AND. vu.LE.vl )
299 ELSE IF( indeig )
THEN
300 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
302 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
308 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
313 CALL xerbla(
'DSPEVX', -info )
324 IF( alleig .OR. indeig )
THEN
328 IF( vl.LT.ap( 1 ) .AND. vu.GE.ap( 1 ) )
THEN
340 safmin = dlamch(
'Safe minimum' )
341 eps = dlamch(
'Precision' )
342 smlnum = safmin / eps
343 bignum = one / smlnum
344 rmin = sqrt( smlnum )
345 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
358 anrm = dlansp(
'M', uplo, n, ap, work )
359 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
362 ELSE IF( anrm.GT.rmax )
THEN
366 IF( iscale.EQ.1 )
THEN
367 CALL dscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
369 $ abstll = abstol*sigma
382 CALL dsptrd( uplo, n, ap, work( indd ), work( inde ),
383 $ work( indtau ), iinfo )
391 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
395 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
396 CALL dcopy( n, work( indd ), 1, w, 1 )
398 IF( .NOT.wantz )
THEN
399 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
400 CALL dsterf( n, w, work( indee ), info )
402 CALL dopgtr( uplo, n, ap, work( indtau ), z, ldz,
403 $ work( indwrk ), iinfo )
404 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
405 CALL dsteqr( jobz, n, w, work( indee ), z, ldz,
406 $ work( indwrk ), info )
429 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
430 $ work( indd ), work( inde ), m, nsplit, w,
431 $ iwork( 1 ), iwork( indisp ), work( indwrk ),
432 $ iwork( indiwo ), info )
435 CALL dstein( n, work( indd ), work( inde ), m, w,
436 $ iwork( 1 ), iwork( indisp ), z, ldz,
437 $ work( indwrk ), iwork( indiwo ), ifail, info )
442 CALL dopmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z,
444 $ work( indwrk ), iinfo )
450 IF( iscale.EQ.1 )
THEN
456 CALL dscal( imax, one / sigma, w, 1 )
467 IF( w( jj ).LT.tmp1 )
THEN
474 itmp1 = iwork( 1 + i-1 )
476 iwork( 1 + i-1 ) = iwork( 1 + j-1 )
478 iwork( 1 + j-1 ) = itmp1
479 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
482 ifail( i ) = ifail( j )
subroutine dspevx(jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail, info)
DSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...