292 SUBROUTINE dgtsvx( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
293 $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
294 $ WORK, IWORK, INFO )
302 CHARACTER FACT, TRANS
303 INTEGER INFO, LDB, LDX, N, NRHS
304 DOUBLE PRECISION RCOND
307 INTEGER IPIV( * ), IWORK( * )
308 DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
309 $ dl( * ), dlf( * ), du( * ), du2( * ), duf( * ),
310 $ ferr( * ), work( * ), x( ldx, * )
316 DOUBLE PRECISION ZERO
317 PARAMETER ( ZERO = 0.0d+0 )
320 LOGICAL NOFACT, NOTRAN
322 DOUBLE PRECISION ANORM
326 DOUBLE PRECISION DLAMCH, DLANGT
327 EXTERNAL lsame, dlamch, dlangt
339 nofact = lsame( fact,
'N' )
340 notran = lsame( trans,
'N' )
341 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
343 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
344 $ lsame( trans,
'C' ) )
THEN
346 ELSE IF( n.LT.0 )
THEN
348 ELSE IF( nrhs.LT.0 )
THEN
350 ELSE IF( ldb.LT.max( 1, n ) )
THEN
352 ELSE IF( ldx.LT.max( 1, n ) )
THEN
356 CALL xerbla(
'DGTSVX', -info )
364 CALL dcopy( n, d, 1, df, 1 )
366 CALL dcopy( n-1, dl, 1, dlf, 1 )
367 CALL dcopy( n-1, du, 1, duf, 1 )
369 CALL dgttrf( n, dlf, df, duf, du2, ipiv, info )
386 anorm = dlangt( norm, n, dl, d, du )
390 CALL dgtcon( norm, n, dlf, df, duf, du2, ipiv, anorm, rcond, work,
395 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
396 CALL dgttrs( trans, n, nrhs, dlf, df, duf, du2, ipiv, x, ldx,
402 CALL dgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv,
403 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
407 IF( rcond.LT.dlamch(
'Epsilon' ) )