227 $ WORK, LWORK, IWORK, LIWORK, INFO )
237 INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
241 REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
248 parameter( zero = 0.0e+0, one = 1.0e+0 )
251 LOGICAL LOWER, LQUERY, WANTZ
252 INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
253 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
255 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
261 REAL SLAMCH, SLANSB, SROUNDUP_LWORK
262 EXTERNAL lsame, slamch, slansb, ilaenv2stage,
276 wantz = lsame( jobz,
'V' )
277 lower = lsame( uplo,
'L' )
278 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
285 ib = ilaenv2stage( 2,
'SSYTRD_SB2ST', jobz, n, kd, -1, -1 )
286 lhtrd = ilaenv2stage( 3,
'SSYTRD_SB2ST', jobz, n, kd, ib, -1 )
287 lwtrd = ilaenv2stage( 4,
'SSYTRD_SB2ST', jobz, n, kd, ib, -1 )
290 lwmin = 1 + 5*n + 2*n**2
293 lwmin = max( 2*n, n+lhtrd+lwtrd )
296 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
298 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
300 ELSE IF( n.LT.0 )
THEN
302 ELSE IF( kd.LT.0 )
THEN
304 ELSE IF( ldab.LT.kd+1 )
THEN
306 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
311 work( 1 ) = sroundup_lwork(lwmin)
314 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
316 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
322 CALL xerbla(
'SSBEVD_2STAGE', -info )
324 ELSE IF( lquery )
THEN
342 safmin = slamch(
'Safe minimum' )
343 eps = slamch(
'Precision' )
344 smlnum = safmin / eps
345 bignum = one / smlnum
346 rmin = sqrt( smlnum )
347 rmax = sqrt( bignum )
351 anrm = slansb(
'M', uplo, n, kd, ab, ldab, work )
353 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
356 ELSE IF( anrm.GT.rmax )
THEN
360 IF( iscale.EQ.1 )
THEN
362 CALL slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
364 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
372 indwrk = indhous + lhtrd
373 llwork = lwork - indwrk + 1
374 indwk2 = indwrk + n*n
375 llwrk2 = lwork - indwk2 + 1
378 $ work( inde ), work( indhous ), lhtrd,
379 $ work( indwrk ), llwork, iinfo )
383 IF( .NOT.wantz )
THEN
384 CALL ssterf( n, w, work( inde ), info )
386 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
387 $ work( indwk2 ), llwrk2, iwork, liwork, info )
388 CALL sgemm(
'N',
'N', n, n, n, one, z, ldz, work( indwrk ), n,
389 $ zero, work( indwk2 ), n )
390 CALL slacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
396 $
CALL sscal( n, one / sigma, w, 1 )
398 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
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 ...
subroutine ssytrd_sb2st(stage1, vect, uplo, n, kd, ab, ldab, d, e, hous, lhous, work, lwork, info)
SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
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 ssterf(n, d, e, info)
SSTERF