226 SUBROUTINE dspevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
227 $ abstol, m, w, z, ldz, work, iwork, ifail,
236 CHARACTER jobz, range, uplo
237 INTEGER il, info, iu, ldz, m, n
238 DOUBLE PRECISION abstol, vl, vu
241 INTEGER ifail( * ), iwork( * )
242 DOUBLE PRECISION ap( * ), w( * ), work( * ), z( ldz, * )
248 DOUBLE PRECISION zero, one
249 parameter( zero = 0.0d0, one = 1.0d0 )
252 LOGICAL alleig, indeig, test, valeig, wantz
254 INTEGER i, iinfo, imax, indd, inde, indee, indibl,
255 $ indisp, indiwo, indtau, indwrk, iscale, itmp1,
257 DOUBLE PRECISION abstll, anrm, bignum, eps, rmax, rmin, safmin,
258 $ sigma, smlnum, tmp1, vll, vuu
270 INTRINSIC max, min, sqrt
276 wantz =
lsame( jobz,
'V' )
277 alleig =
lsame( range,
'A' )
278 valeig =
lsame( range,
'V' )
279 indeig =
lsame( range,
'I' )
282 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
284 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
286 ELSE IF( .NOT.(
lsame( uplo,
'L' ) .OR.
lsame( uplo,
'U' ) ) )
289 ELSE IF( n.LT.0 )
THEN
293 IF( n.GT.0 .AND. vu.LE.vl )
295 ELSE IF( indeig )
THEN
296 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
298 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
304 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
309 CALL
xerbla(
'DSPEVX', -info )
320 IF( alleig .OR. indeig )
THEN
324 IF( vl.LT.ap( 1 ) .AND. vu.GE.ap( 1 ) )
THEN
336 safmin =
dlamch(
'Safe minimum' )
337 eps =
dlamch(
'Precision' )
338 smlnum = safmin / eps
339 bignum = one / smlnum
340 rmin = sqrt( smlnum )
341 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
354 anrm =
dlansp(
'M', uplo, n, ap, work )
355 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
358 ELSE IF( anrm.GT.rmax )
THEN
362 IF( iscale.EQ.1 )
THEN
363 CALL
dscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
365 $ abstll = abstol*sigma
378 CALL
dsptrd( uplo, n, ap, work( indd ), work( inde ),
379 $ work( indtau ), iinfo )
387 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
391 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
392 CALL
dcopy( n, work( indd ), 1, w, 1 )
394 IF( .NOT.wantz )
THEN
395 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
396 CALL
dsterf( n, w, work( indee ), info )
398 CALL
dopgtr( uplo, n, ap, work( indtau ), z, ldz,
399 $ work( indwrk ), iinfo )
400 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
401 CALL
dsteqr( jobz, n, w, work( indee ), z, ldz,
402 $ work( indwrk ), info )
426 CALL
dstebz( range, order, n, vll, vuu, il, iu, abstll,
427 $ work( indd ), work( inde ), m, nsplit, w,
428 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
429 $ iwork( indiwo ), info )
432 CALL
dstein( n, work( indd ), work( inde ), m, w,
433 $ iwork( indibl ), iwork( indisp ), z, ldz,
434 $ work( indwrk ), iwork( indiwo ), ifail, info )
439 CALL
dopmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
440 $ work( indwrk ), iinfo )
446 IF( iscale.EQ.1 )
THEN
452 CALL
dscal( imax, one / sigma, w, 1 )
463 IF( w( jj ).LT.tmp1 )
THEN
470 itmp1 = iwork( indibl+i-1 )
472 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
474 iwork( indibl+
j-1 ) = itmp1
475 CALL
dswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
478 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
subroutine dsptrd(UPLO, N, AP, D, E, TAU, INFO)
DSPTRD
LOGICAL function lsame(CA, CB)
LSAME
subroutine dopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
DOPGTR
subroutine dopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
DOPMTR
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 dlansp(NORM, UPLO, N, AP, WORK)
DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
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
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 matric...