266 SUBROUTINE zhbevx( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
267 $ vu, il, iu, abstol, m, w, z, ldz, work, rwork,
268 $ iwork, ifail, info )
276 CHARACTER JOBZ, RANGE, UPLO
277 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
278 DOUBLE PRECISION ABSTOL, VL, VU
281 INTEGER IFAIL( * ), IWORK( * )
282 DOUBLE PRECISION RWORK( * ), W( * )
283 COMPLEX*16 AB( ldab, * ), Q( ldq, * ), WORK( * ),
290 DOUBLE PRECISION ZERO, ONE
291 parameter ( zero = 0.0d0, one = 1.0d0 )
292 COMPLEX*16 CZERO, CONE
293 parameter ( czero = ( 0.0d0, 0.0d0 ),
294 $ cone = ( 1.0d0, 0.0d0 ) )
297 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
299 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
300 $ indisp, indiwk, indrwk, indwrk, iscale, itmp1,
302 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
303 $ sigma, smlnum, tmp1, vll, vuu
308 DOUBLE PRECISION DLAMCH, ZLANHB
309 EXTERNAL lsame, dlamch, zlanhb
317 INTRINSIC dble, max, min, sqrt
323 wantz = lsame( jobz,
'V' )
324 alleig = lsame( range,
'A' )
325 valeig = lsame( range,
'V' )
326 indeig = lsame( range,
'I' )
327 lower = lsame( uplo,
'L' )
330 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
332 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
334 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
336 ELSE IF( n.LT.0 )
THEN
338 ELSE IF( kd.LT.0 )
THEN
340 ELSE IF( ldab.LT.kd+1 )
THEN
342 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
346 IF( n.GT.0 .AND. vu.LE.vl )
348 ELSE IF( indeig )
THEN
349 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
351 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
357 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
362 CALL xerbla(
'ZHBEVX', -info )
377 ctmp1 = ab( kd+1, 1 )
381 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
394 safmin = dlamch(
'Safe minimum' )
395 eps = dlamch(
'Precision' )
396 smlnum = safmin / eps
397 bignum = one / smlnum
398 rmin = sqrt( smlnum )
399 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
412 anrm = zlanhb(
'M', uplo, n, kd, ab, ldab, rwork )
413 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
416 ELSE IF( anrm.GT.rmax )
THEN
420 IF( iscale.EQ.1 )
THEN
422 CALL zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
424 CALL zlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
427 $ abstll = abstol*sigma
440 CALL zhbtrd( jobz, uplo, n, kd, ab, ldab, rwork( indd ),
441 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
449 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
453 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
454 CALL dcopy( n, rwork( indd ), 1, w, 1 )
456 IF( .NOT.wantz )
THEN
457 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
458 CALL dsterf( n, w, rwork( indee ), info )
460 CALL zlacpy(
'A', n, n, q, ldq, z, ldz )
461 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
462 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
463 $ rwork( indrwk ), info )
487 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
488 $ rwork( indd ), rwork( inde ), m, nsplit, w,
489 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
490 $ iwork( indiwk ), info )
493 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
494 $ iwork( indibl ), iwork( indisp ), z, ldz,
495 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
501 CALL zcopy( n, z( 1, j ), 1, work( 1 ), 1 )
502 CALL zgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
510 IF( iscale.EQ.1 )
THEN
516 CALL dscal( imax, one / sigma, w, 1 )
527 IF( w( jj ).LT.tmp1 )
THEN
534 itmp1 = iwork( indibl+i-1 )
536 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
538 iwork( indibl+j-1 ) = itmp1
539 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
542 ifail( i ) = ifail( j )
subroutine zhbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
ZHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine zhbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
ZHBTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL