304 $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
305 $ LWORK, RWORK, IWORK, IFAIL, INFO )
314 CHARACTER JOBZ, RANGE, UPLO
315 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
319 INTEGER IFAIL( * ), IWORK( * )
320 REAL RWORK( * ), W( * )
321 COMPLEX A( LDA, * ), WORK( * ), Z( LDZ, * )
328 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
330 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
333 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
336 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
337 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
338 $ itmp1, j, jj, llwork,
339 $ nsplit, lwmin, lhtrd, lwtrd, kd, ib, indhous
340 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
341 $ SIGMA, SMLNUM, TMP1, VLL, VUU
346 REAL SLAMCH, CLANHE, SROUNDUP_LWORK
347 EXTERNAL lsame, slamch, clanhe, ilaenv2stage,
356 INTRINSIC real, max, min, sqrt
362 lower = lsame( uplo,
'L' )
363 wantz = lsame( jobz,
'V' )
364 alleig = lsame( range,
'A' )
365 valeig = lsame( range,
'V' )
366 indeig = lsame( range,
'I' )
367 lquery = ( lwork.EQ.-1 )
370 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
372 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
374 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
376 ELSE IF( n.LT.0 )
THEN
378 ELSE IF( lda.LT.max( 1, n ) )
THEN
382 IF( n.GT.0 .AND. vu.LE.vl )
384 ELSE IF( indeig )
THEN
385 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
387 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
393 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
401 work( 1 ) = sroundup_lwork(lwmin)
403 kd = ilaenv2stage( 1,
'CHETRD_2STAGE', jobz,
405 ib = ilaenv2stage( 2,
'CHETRD_2STAGE', jobz,
407 lhtrd = ilaenv2stage( 3,
'CHETRD_2STAGE', jobz,
409 lwtrd = ilaenv2stage( 4,
'CHETRD_2STAGE', jobz,
411 lwmin = n + lhtrd + lwtrd
412 work( 1 ) = sroundup_lwork(lwmin)
415 IF( lwork.LT.lwmin .AND. .NOT.lquery )
420 CALL xerbla(
'CHEEVX_2STAGE', -info )
422 ELSE IF( lquery )
THEN
434 IF( alleig .OR. indeig )
THEN
436 w( 1 ) = real( a( 1, 1 ) )
437 ELSE IF( valeig )
THEN
438 IF( vl.LT.real( a( 1, 1 ) ) .AND. vu.GE.real( a( 1, 1 ) ) )
441 w( 1 ) = real( a( 1, 1 ) )
451 safmin = slamch(
'Safe minimum' )
452 eps = slamch(
'Precision' )
453 smlnum = safmin / eps
454 bignum = one / smlnum
455 rmin = sqrt( smlnum )
456 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
466 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
467 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
470 ELSE IF( anrm.GT.rmax )
THEN
474 IF( iscale.EQ.1 )
THEN
477 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
481 CALL csscal( j, sigma, a( 1, j ), 1 )
485 $ abstll = abstol*sigma
499 indwrk = indhous + lhtrd
500 llwork = lwork - indwrk + 1
503 $ rwork( inde ), work( indtau ),
504 $ work( indhous ), lhtrd, work( indwrk ),
513 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
517 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
518 CALL scopy( n, rwork( indd ), 1, w, 1 )
520 IF( .NOT.wantz )
THEN
521 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
522 CALL ssterf( n, w, rwork( indee ), info )
524 CALL clacpy(
'A', n, n, a, lda, z, ldz )
525 CALL cungtr( uplo, n, z, ldz, work( indtau ),
526 $ work( indwrk ), llwork, iinfo )
527 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
528 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
529 $ rwork( indrwk ), info )
553 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
554 $ rwork( indd ), rwork( inde ), m, nsplit, w,
555 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
556 $ iwork( indiwk ), info )
559 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
560 $ iwork( indibl ), iwork( indisp ), z, ldz,
561 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
566 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
567 $ ldz, work( indwrk ), llwork, iinfo )
573 IF( iscale.EQ.1 )
THEN
579 CALL sscal( imax, one / sigma, w, 1 )
590 IF( w( jj ).LT.tmp1 )
THEN
597 itmp1 = iwork( indibl+i-1 )
599 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
601 iwork( indibl+j-1 ) = itmp1
602 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
605 ifail( i ) = ifail( j )
614 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine cheevx_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine chetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
CHETRD_2STAGE
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine cstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
CSTEIN
subroutine csteqr(compz, n, d, e, z, ldz, work, info)
CSTEQR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
subroutine cungtr(uplo, n, a, lda, tau, work, lwork, info)
CUNGTR
subroutine cunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
CUNMTR