188 SUBROUTINE dtbrfs( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B,
189 $ ldb, x, ldx, ferr, berr, work, iwork, info )
197 CHARACTER DIAG, TRANS, UPLO
198 INTEGER INFO, KD, LDAB, LDB, LDX, N, NRHS
202 DOUBLE PRECISION AB( ldab, * ), B( ldb, * ), BERR( * ),
203 $ ferr( * ), work( * ), x( ldx, * )
209 DOUBLE PRECISION ZERO
210 parameter ( zero = 0.0d+0 )
212 parameter ( one = 1.0d+0 )
215 LOGICAL NOTRAN, NOUNIT, UPPER
217 INTEGER I, J, K, KASE, NZ
218 DOUBLE PRECISION EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
227 INTRINSIC abs, max, min
231 DOUBLE PRECISION DLAMCH
232 EXTERNAL lsame, dlamch
239 upper = lsame( uplo,
'U' )
240 notran = lsame( trans,
'N' )
241 nounit = lsame( diag,
'N' )
243 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
245 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
246 $ lsame( trans,
'C' ) )
THEN
248 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag,
'U' ) )
THEN
250 ELSE IF( n.LT.0 )
THEN
252 ELSE IF( kd.LT.0 )
THEN
254 ELSE IF( nrhs.LT.0 )
THEN
256 ELSE IF( ldab.LT.kd+1 )
THEN
258 ELSE IF( ldb.LT.max( 1, n ) )
THEN
260 ELSE IF( ldx.LT.max( 1, n ) )
THEN
264 CALL xerbla(
'DTBRFS', -info )
270 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
287 eps = dlamch(
'Epsilon' )
288 safmin = dlamch(
'Safe minimum' )
299 CALL dcopy( n, x( 1, j ), 1, work( n+1 ), 1 )
300 CALL dtbmv( uplo, trans, diag, n, kd, ab, ldab, work( n+1 ),
302 CALL daxpy( n, -one, b( 1, j ), 1, work( n+1 ), 1 )
314 work( i ) = abs( b( i, j ) )
324 xk = abs( x( k, j ) )
325 DO 30 i = max( 1, k-kd ), k
326 work( i ) = work( i ) +
327 $ abs( ab( kd+1+i-k, k ) )*xk
332 xk = abs( x( k, j ) )
333 DO 50 i = max( 1, k-kd ), k - 1
334 work( i ) = work( i ) +
335 $ abs( ab( kd+1+i-k, k ) )*xk
337 work( k ) = work( k ) + xk
343 xk = abs( x( k, j ) )
344 DO 70 i = k, min( n, k+kd )
345 work( i ) = work( i ) + abs( ab( 1+i-k, k ) )*xk
350 xk = abs( x( k, j ) )
351 DO 90 i = k + 1, min( n, k+kd )
352 work( i ) = work( i ) + abs( ab( 1+i-k, k ) )*xk
354 work( k ) = work( k ) + xk
366 DO 110 i = max( 1, k-kd ), k
367 s = s + abs( ab( kd+1+i-k, k ) )*
370 work( k ) = work( k ) + s
375 DO 130 i = max( 1, k-kd ), k - 1
376 s = s + abs( ab( kd+1+i-k, k ) )*
379 work( k ) = work( k ) + s
386 DO 150 i = k, min( n, k+kd )
387 s = s + abs( ab( 1+i-k, k ) )*abs( x( i, j ) )
389 work( k ) = work( k ) + s
394 DO 170 i = k + 1, min( n, k+kd )
395 s = s + abs( ab( 1+i-k, k ) )*abs( x( i, j ) )
397 work( k ) = work( k ) + s
404 IF( work( i ).GT.safe2 )
THEN
405 s = max( s, abs( work( n+i ) ) / work( i ) )
407 s = max( s, ( abs( work( n+i ) )+safe1 ) /
408 $ ( work( i )+safe1 ) )
436 IF( work( i ).GT.safe2 )
THEN
437 work( i ) = abs( work( n+i ) ) + nz*eps*work( i )
439 work( i ) = abs( work( n+i ) ) + nz*eps*work( i ) + safe1
445 CALL dlacn2( n, work( 2*n+1 ), work( n+1 ), iwork, ferr( j ),
452 CALL dtbsv( uplo, transt, diag, n, kd, ab, ldab,
455 work( n+i ) = work( i )*work( n+i )
462 work( n+i ) = work( i )*work( n+i )
464 CALL dtbsv( uplo, trans, diag, n, kd, ab, ldab,
474 lstres = max( lstres, abs( x( i, j ) ) )
477 $ ferr( j ) = ferr( j ) / lstres
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBSV
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBMV
subroutine dtbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DTBRFS
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...