142 SUBROUTINE ssbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
151 INTEGER INFO, KD, LDAB, LDZ, N
154 REAL AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
161 parameter( zero = 0.0e0, one = 1.0e0 )
165 INTEGER IINFO, IMAX, INDE, INDWRK, ISCALE
166 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
172 EXTERNAL lsame, slamch, slansb
185 wantz = lsame( jobz,
'V' )
186 lower = lsame( uplo,
'L' )
189 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
191 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
195 ELSE IF( kd.LT.0 )
THEN
197 ELSE IF( ldab.LT.kd+1 )
THEN
199 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
204 CALL xerbla(
'SSBEV ', -info )
217 w( 1 ) = ab( kd+1, 1 )
226 safmin = slamch(
'Safe minimum' )
227 eps = slamch(
'Precision' )
228 smlnum = safmin / eps
229 bignum = one / smlnum
230 rmin = sqrt( smlnum )
231 rmax = sqrt( bignum )
235 anrm = slansb(
'M', uplo, n, kd, ab, ldab, work )
237 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
240 ELSE IF( anrm.GT.rmax )
THEN
244 IF( iscale.EQ.1 )
THEN
246 CALL slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab,
249 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab,
258 CALL ssbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z,
260 $ work( indwrk ), iinfo )
264 IF( .NOT.wantz )
THEN
265 CALL ssterf( n, w, work( inde ), info )
267 CALL ssteqr( jobz, n, w, work( inde ), z, ldz,
274 IF( iscale.EQ.1 )
THEN
280 CALL sscal( imax, one / sigma, w, 1 )
subroutine ssbev(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, info)
SSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
subroutine ssbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
SSBTRD
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.