234 SUBROUTINE ssbevd_2stage( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
235 $ work, lwork, iwork, liwork, info )
246 INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
250 REAL AB( ldab, * ), W( * ), WORK( * ), Z( ldz, * )
257 parameter ( zero = 0.0e+0, one = 1.0e+0 )
260 LOGICAL LOWER, LQUERY, WANTZ
261 INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
262 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
264 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
271 EXTERNAL lsame, slamch, slansb, ilaenv
284 wantz = lsame( jobz,
'V' )
285 lower = lsame( uplo,
'L' )
286 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
293 ib = ilaenv( 18,
'SSYTRD_SB2ST', jobz, n, kd, -1, -1 )
294 lhtrd = ilaenv( 19,
'SSYTRD_SB2ST', jobz, n, kd, ib, -1 )
295 lwtrd = ilaenv( 20,
'SSYTRD_SB2ST', jobz, n, kd, ib, -1 )
298 lwmin = 1 + 5*n + 2*n**2
301 lwmin = max( 2*n, n+lhtrd+lwtrd )
304 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
306 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
308 ELSE IF( n.LT.0 )
THEN
310 ELSE IF( kd.LT.0 )
THEN
312 ELSE IF( ldab.LT.kd+1 )
THEN
314 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
322 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
324 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
330 CALL xerbla(
'SSBEVD_2STAGE', -info )
332 ELSE IF( lquery )
THEN
350 safmin = slamch(
'Safe minimum' )
351 eps = slamch(
'Precision' )
352 smlnum = safmin / eps
353 bignum = one / smlnum
354 rmin = sqrt( smlnum )
355 rmax = sqrt( bignum )
359 anrm = slansb(
'M', uplo, n, kd, ab, ldab, work )
361 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
364 ELSE IF( anrm.GT.rmax )
THEN
368 IF( iscale.EQ.1 )
THEN
370 CALL slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
372 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
380 indwrk = indhous + lhtrd
381 llwork = lwork - indwrk + 1
382 indwk2 = indwrk + n*n
383 llwrk2 = lwork - indwk2 + 1
385 CALL ssytrd_sb2st(
"N", jobz, uplo, n, kd, ab, ldab, w,
386 $ work( inde ), work( indhous ), lhtrd,
387 $ work( indwrk ), llwork, iinfo )
391 IF( .NOT.wantz )
THEN
392 CALL ssterf( n, w, work( inde ), info )
394 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
395 $ work( indwk2 ), llwrk2, iwork, liwork, info )
396 CALL sgemm(
'N',
'N', n, n, n, one, z, ldz, work( indwrk ), n,
397 $ zero, work( indwk2 ), n )
398 CALL slacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
404 $
CALL sscal( n, one / sigma, w, 1 )
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssbevd_2stage(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...