166 REAL function
sla_gbrcond( trans, n, kl, ku, ab, ldab, afb, ldafb,
167 $ ipiv, cmode, c, info, work, iwork )
175 INTEGER n, ldab, ldafb, info, kl, ku, cmode
178 INTEGER iwork( * ), ipiv( * )
179 REAL ab( ldab, * ), afb( ldafb, * ), work( * ),
187 INTEGER kase, i, j, kd, ke
208 notrans =
lsame( trans,
'N' )
209 IF ( .NOT. notrans .AND. .NOT.
lsame(trans,
'T')
210 $ .AND. .NOT.
lsame(trans,
'C') )
THEN
212 ELSE IF( n.LT.0 )
THEN
214 ELSE IF( kl.LT.0 .OR. kl.GT.n-1 )
THEN
216 ELSE IF( ku.LT.0 .OR. ku.GT.n-1 )
THEN
218 ELSE IF( ldab.LT.kl+ku+1 )
THEN
220 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
224 CALL xerbla(
'SLA_GBRCOND', -info )
240 IF ( cmode .EQ. 1 )
THEN
241 DO j = max( i-kl, 1 ), min( i+ku, n )
242 tmp = tmp + abs( ab( kd+i-j, j ) * c( j ) )
244 ELSE IF ( cmode .EQ. 0 )
THEN
245 DO j = max( i-kl, 1 ), min( i+ku, n )
246 tmp = tmp + abs( ab( kd+i-j, j ) )
249 DO j = max( i-kl, 1 ), min( i+ku, n )
250 tmp = tmp + abs( ab( kd+i-j, j ) / c( j ) )
258 IF ( cmode .EQ. 1 )
THEN
259 DO j = max( i-kl, 1 ), min( i+ku, n )
260 tmp = tmp + abs( ab( ke-i+j, i ) * c( j ) )
262 ELSE IF ( cmode .EQ. 0 )
THEN
263 DO j = max( i-kl, 1 ), min( i+ku, n )
264 tmp = tmp + abs( ab( ke-i+j, i ) )
267 DO j = max( i-kl, 1 ), min( i+ku, n )
268 tmp = tmp + abs( ab( ke-i+j, i ) / c( j ) )
281 CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
288 work( i ) = work( i ) * work( 2*n+i )
292 CALL sgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
293 $ ipiv, work, n, info )
295 CALL sgbtrs(
'Transpose', n, kl, ku, 1, afb, ldafb, ipiv,
301 IF ( cmode .EQ. 1 )
THEN
303 work( i ) = work( i ) / c( i )
305 ELSE IF ( cmode .EQ. -1 )
THEN
307 work( i ) = work( i ) * c( i )
314 IF ( cmode .EQ. 1 )
THEN
316 work( i ) = work( i ) / c( i )
318 ELSE IF ( cmode .EQ. -1 )
THEN
320 work( i ) = work( i ) * c( i )
325 CALL sgbtrs(
'Transpose', n, kl, ku, 1, afb, ldafb, ipiv,
328 CALL sgbtrs(
'No transpose', n, kl, ku, 1, afb, ldafb,
329 $ ipiv, work, n, info )
335 work( i ) = work( i ) * work( 2*n+i )
343 IF( ainvnm .NE. 0.0 )
subroutine xerbla(srname, info)
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
real function sla_gbrcond(trans, n, kl, ku, ab, ldab, afb, ldafb, ipiv, cmode, c, info, work, iwork)
SLA_GBRCOND estimates the Skeel condition number for a general banded matrix.
subroutine slacn2(n, v, x, isgn, est, kase, isave)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
logical function lsame(ca, cb)
LSAME