259 SUBROUTINE chbevd_2stage( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
260 $ work, lwork, rwork, lrwork, iwork,
272 INTEGER INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
276 REAL RWORK( * ), W( * )
277 COMPLEX AB( ldab, * ), WORK( * ), Z( ldz, * )
284 parameter ( zero = 0.0e0, one = 1.0e0 )
286 parameter ( czero = ( 0.0e0, 0.0e0 ),
287 $ cone = ( 1.0e0, 0.0e0 ) )
290 LOGICAL LOWER, LQUERY, WANTZ
291 INTEGER IINFO, IMAX, INDE, INDWK2, INDRWK, ISCALE,
292 $ llwork, indwk, lhtrd, lwtrd, ib, indhous,
293 $ liwmin, llrwk, llwk2, lrwmin, lwmin
294 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
301 EXTERNAL lsame, slamch, clanhb, ilaenv
314 wantz = lsame( jobz,
'V' )
315 lower = lsame( uplo,
'L' )
316 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 .OR. lrwork.EQ.-1 )
324 ib = ilaenv( 18,
'CHETRD_HB2ST', jobz, n, kd, -1, -1 )
325 lhtrd = ilaenv( 19,
'CHETRD_HB2ST', jobz, n, kd, ib, -1 )
326 lwtrd = ilaenv( 20,
'CHETRD_HB2ST', jobz, n, kd, ib, -1 )
329 lrwmin = 1 + 5*n + 2*n**2
332 lwmin = max( n, lhtrd + lwtrd )
337 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
339 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
341 ELSE IF( n.LT.0 )
THEN
343 ELSE IF( kd.LT.0 )
THEN
345 ELSE IF( ldab.LT.kd+1 )
THEN
347 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
356 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
358 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
360 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
366 CALL xerbla(
'CHBEVD_2STAGE', -info )
368 ELSE IF( lquery )
THEN
378 w( 1 ) =
REAL( AB( 1, 1 ) )
386 safmin = slamch(
'Safe minimum' )
387 eps = slamch(
'Precision' )
388 smlnum = safmin / eps
389 bignum = one / smlnum
390 rmin = sqrt( smlnum )
391 rmax = sqrt( bignum )
395 anrm = clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
397 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
400 ELSE IF( anrm.GT.rmax )
THEN
404 IF( iscale.EQ.1 )
THEN
406 CALL clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
408 CALL clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
416 llrwk = lrwork - indrwk + 1
418 indwk = indhous + lhtrd
419 llwork = lwork - indwk + 1
421 llwk2 = lwork - indwk2 + 1
423 CALL chetrd_hb2st(
"N", jobz, uplo, n, kd, ab, ldab, w,
424 $ rwork( inde ), work( indhous ), lhtrd,
425 $ work( indwk ), llwork, iinfo )
429 IF( .NOT.wantz )
THEN
430 CALL ssterf( n, w, rwork( inde ), info )
432 CALL cstedc(
'I', n, w, rwork( inde ), work, n, work( indwk2 ),
433 $ llwk2, rwork( indrwk ), llrwk, iwork, liwork,
435 CALL cgemm(
'N',
'N', n, n, n, cone, z, ldz, work, n, czero,
436 $ work( indwk2 ), n )
437 CALL clacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
442 IF( iscale.EQ.1 )
THEN
448 CALL sscal( imax, one / sigma, w, 1 )
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine chbevd_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC