187 SUBROUTINE cpbrfs( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B,
188 $ LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO )
196 INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
199 REAL BERR( * ), FERR( * ), RWORK( * )
200 COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
201 $ work( * ), x( ldx, * )
208 parameter( itmax = 5 )
210 parameter( zero = 0.0e+0 )
212 parameter( one = ( 1.0e+0, 0.0e+0 ) )
214 parameter( two = 2.0e+0 )
216 parameter( three = 3.0e+0 )
220 INTEGER COUNT, I, J, K, KASE, L, NZ
221 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
231 INTRINSIC abs, aimag, max, min, real
236 EXTERNAL lsame, slamch
242 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
249 upper = lsame( uplo,
'U' )
250 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
252 ELSE IF( n.LT.0 )
THEN
254 ELSE IF( kd.LT.0 )
THEN
256 ELSE IF( nrhs.LT.0 )
THEN
258 ELSE IF( ldab.LT.kd+1 )
THEN
260 ELSE IF( ldafb.LT.kd+1 )
THEN
262 ELSE IF( ldb.LT.max( 1, n ) )
THEN
264 ELSE IF( ldx.LT.max( 1, n ) )
THEN
268 CALL xerbla(
'CPBRFS', -info )
274 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
284 nz = min( n+1, 2*kd+2 )
285 eps = slamch(
'Epsilon' )
286 safmin = slamch(
'Safe minimum' )
302 CALL ccopy( n, b( 1, j ), 1, work, 1 )
303 CALL chbmv( uplo, n, kd, -one, ab, ldab, x( 1, j ), 1, one,
316 rwork( i ) = cabs1( b( i, j ) )
324 xk = cabs1( x( k, j ) )
326 DO 40 i = max( 1, k-kd ), k - 1
327 rwork( i ) = rwork( i ) + cabs1( ab( l+i, k ) )*xk
328 s = s + cabs1( ab( l+i, k ) )*cabs1( x( i, j ) )
330 rwork( k ) = rwork( k ) + abs( real( ab( kd+1, k ) ) )*
336 xk = cabs1( x( k, j ) )
337 rwork( k ) = rwork( k ) + abs( real( ab( 1, k ) ) )*xk
339 DO 60 i = k + 1, min( n, k+kd )
340 rwork( i ) = rwork( i ) + cabs1( ab( l+i, k ) )*xk
341 s = s + cabs1( ab( l+i, k ) )*cabs1( x( i, j ) )
343 rwork( k ) = rwork( k ) + s
348 IF( rwork( i ).GT.safe2 )
THEN
349 s = max( s, cabs1( work( i ) ) / rwork( i ) )
351 s = max( s, ( cabs1( work( i ) )+safe1 ) /
352 $ ( rwork( i )+safe1 ) )
363 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
364 $ count.LE.itmax )
THEN
368 CALL cpbtrs( uplo, n, kd, 1, afb, ldafb, work, n, info )
369 CALL caxpy( n, one, work, 1, x( 1, j ), 1 )
398 IF( rwork( i ).GT.safe2 )
THEN
399 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i )
401 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
408 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
414 CALL cpbtrs( uplo, n, kd, 1, afb, ldafb, work, n, info )
416 work( i ) = rwork( i )*work( i )
418 ELSE IF( kase.EQ.2 )
THEN
423 work( i ) = rwork( i )*work( i )
425 CALL cpbtrs( uplo, n, kd, 1, afb, ldafb, work, n, info )
434 lstres = max( lstres, cabs1( x( i, j ) ) )
437 $ ferr( j ) = ferr( j ) / lstres
subroutine xerbla(srname, info)
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine chbmv(uplo, n, k, alpha, a, lda, x, incx, beta, y, incy)
CHBMV
subroutine clacn2(n, v, x, est, kase, isave)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine cpbrfs(uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPBRFS
subroutine cpbtrs(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
CPBTRS