288 SUBROUTINE dgtsvx( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF,
290 $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
291 $ WORK, IWORK, INFO )
298 CHARACTER FACT, TRANS
299 INTEGER INFO, LDB, LDX, N, NRHS
300 DOUBLE PRECISION RCOND
303 INTEGER IPIV( * ), IWORK( * )
304 DOUBLE PRECISION B( LDB, * ), BERR( * ), D( * ), DF( * ),
305 $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
306 $ ferr( * ), work( * ), x( ldx, * )
312 DOUBLE PRECISION ZERO
313 PARAMETER ( ZERO = 0.0d+0 )
316 LOGICAL NOFACT, NOTRAN
318 DOUBLE PRECISION ANORM
322 DOUBLE PRECISION DLAMCH, DLANGT
323 EXTERNAL LSAME, DLAMCH, DLANGT
336 nofact = lsame( fact,
'N' )
337 notran = lsame( trans,
'N' )
338 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
340 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
341 $ lsame( trans,
'C' ) )
THEN
343 ELSE IF( n.LT.0 )
THEN
345 ELSE IF( nrhs.LT.0 )
THEN
347 ELSE IF( ldb.LT.max( 1, n ) )
THEN
349 ELSE IF( ldx.LT.max( 1, n ) )
THEN
353 CALL xerbla(
'DGTSVX', -info )
361 CALL dcopy( n, d, 1, df, 1 )
363 CALL dcopy( n-1, dl, 1, dlf, 1 )
364 CALL dcopy( n-1, du, 1, duf, 1 )
366 CALL dgttrf( n, dlf, df, duf, du2, ipiv, info )
383 anorm = dlangt( norm, n, dl, d, du )
387 CALL dgtcon( norm, n, dlf, df, duf, du2, ipiv, anorm, rcond,
393 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
394 CALL dgttrs( trans, n, nrhs, dlf, df, duf, du2, ipiv, x, ldx,
400 CALL dgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,
402 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
406 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine dgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
DGTCON
subroutine dgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGTRFS
subroutine dgtsvx(fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DGTSVX computes the solution to system of linear equations A * X = B for GT matrices
subroutine dgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
DGTTRS
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.