205      SUBROUTINE zhbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
 
  207     $                   LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO )
 
  215      INTEGER            INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
 
  219      DOUBLE PRECISION   RWORK( * ), W( * )
 
  220      COMPLEX*16         AB( LDAB, * ), WORK( * ), Z( LDZ, * )
 
  226      DOUBLE PRECISION   ZERO, ONE
 
  227      PARAMETER          ( ZERO = 0.0d0, one = 1.0d0 )
 
  228      COMPLEX*16         CZERO, CONE
 
  229      parameter( czero = ( 0.0d0, 0.0d0 ),
 
  230     $                   cone = ( 1.0d0, 0.0d0 ) )
 
  233      LOGICAL            LOWER, LQUERY, WANTZ
 
  234      INTEGER            IINFO, IMAX, INDE, INDWK2, INDWRK, ISCALE,
 
  235     $                   liwmin, llrwk, llwk2, lrwmin, lwmin
 
  236      DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
 
  241      DOUBLE PRECISION   DLAMCH, ZLANHB
 
  242      EXTERNAL           lsame, dlamch, zlanhb
 
  256      wantz = lsame( jobz, 
'V' )
 
  257      lower = lsame( uplo, 
'L' )
 
  258      lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 .OR. lrwork.EQ.-1 )
 
  268            lrwmin = 1 + 5*n + 2*n**2
 
  276      IF( .NOT.( wantz .OR. lsame( jobz, 
'N' ) ) ) 
THEN 
  278      ELSE IF( .NOT.( lower .OR. lsame( uplo, 
'U' ) ) ) 
THEN 
  280      ELSE IF( n.LT.0 ) 
THEN 
  282      ELSE IF( kd.LT.0 ) 
THEN 
  284      ELSE IF( ldab.LT.kd+1 ) 
THEN 
  286      ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) 
THEN 
  292         rwork( 1 ) = real( lrwmin )
 
  295         IF( lwork.LT.lwmin .AND. .NOT.lquery ) 
THEN 
  297         ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery ) 
THEN 
  299         ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) 
THEN 
  305         CALL xerbla( 
'ZHBEVD', -info )
 
  307      ELSE IF( lquery ) 
THEN 
  317         w( 1 ) = dble( ab( 1, 1 ) )
 
  325      safmin = dlamch( 
'Safe minimum' )
 
  326      eps = dlamch( 
'Precision' )
 
  327      smlnum = safmin / eps
 
  328      bignum = one / smlnum
 
  329      rmin = sqrt( smlnum )
 
  330      rmax = sqrt( bignum )
 
  334      anrm = zlanhb( 
'M', uplo, n, kd, ab, ldab, rwork )
 
  336      IF( anrm.GT.zero .AND. anrm.LT.rmin ) 
THEN 
  339      ELSE IF( anrm.GT.rmax ) 
THEN 
  343      IF( iscale.EQ.1 ) 
THEN 
  345            CALL zlascl( 
'B', kd, kd, one, sigma, n, n, ab, ldab,
 
  348            CALL zlascl( 
'Q', kd, kd, one, sigma, n, n, ab, ldab,
 
  358      llwk2 = lwork - indwk2 + 1
 
  359      llrwk = lrwork - indwrk + 1
 
  360      CALL zhbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
 
  365      IF( .NOT.wantz ) 
THEN 
  366         CALL dsterf( n, w, rwork( inde ), info )
 
  368         CALL zstedc( 
'I', n, w, rwork( inde ), work, n,
 
  370     $                llwk2, rwork( indwrk ), llrwk, iwork, liwork,
 
  372         CALL zgemm( 
'N', 
'N', n, n, n, cone, z, ldz, work, n, czero,
 
  373     $               work( indwk2 ), n )
 
  374         CALL zlacpy( 
'A', n, n, work( indwk2 ), n, z, ldz )
 
  379      IF( iscale.EQ.1 ) 
THEN 
  385         CALL dscal( imax, one / sigma, w, 1 )
 
  389      rwork( 1 ) = real( lrwmin )
 
 
subroutine zhbevd(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
ZHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...