146 SUBROUTINE dsbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
156 INTEGER INFO, KD, LDAB, LDZ, N
159 DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
165 DOUBLE PRECISION ZERO, ONE
166 parameter( zero = 0.0d0, one = 1.0d0 )
170 INTEGER IINFO, IMAX, INDE, INDWRK, ISCALE
171 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
176 DOUBLE PRECISION DLAMCH, DLANSB
177 EXTERNAL lsame, dlamch, dlansb
189 wantz = lsame( jobz,
'V' )
190 lower = lsame( uplo,
'L' )
193 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
195 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
197 ELSE IF( n.LT.0 )
THEN
199 ELSE IF( kd.LT.0 )
THEN
201 ELSE IF( ldab.LT.kd+1 )
THEN
203 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
208 CALL xerbla(
'DSBEV ', -info )
221 w( 1 ) = ab( kd+1, 1 )
230 safmin = dlamch(
'Safe minimum' )
231 eps = dlamch(
'Precision' )
232 smlnum = safmin / eps
233 bignum = one / smlnum
234 rmin = sqrt( smlnum )
235 rmax = sqrt( bignum )
239 anrm = dlansb(
'M', uplo, n, kd, ab, ldab, work )
241 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
244 ELSE IF( anrm.GT.rmax )
THEN
248 IF( iscale.EQ.1 )
THEN
250 CALL dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
252 CALL dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
260 CALL dsbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z, ldz,
261 $ work( indwrk ), iinfo )
265 IF( .NOT.wantz )
THEN
266 CALL dsterf( n, w, work( inde ), info )
268 CALL dsteqr( jobz, n, w, work( inde ), z, ldz, work( indwrk ),
274 IF( iscale.EQ.1 )
THEN
280 CALL dscal( imax, one / sigma, w, 1 )