290 SUBROUTINE sgtsvx( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
291 $ DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR,
292 $ WORK, IWORK, INFO )
299 CHARACTER FACT, TRANS
300 INTEGER INFO, LDB, LDX, N, NRHS
304 INTEGER IPIV( * ), IWORK( * )
305 REAL B( LDB, * ), BERR(
307 $ ferr( * ), work( * ), x( ldx, * )
314 PARAMETER ( = 0.0e+0 )
324 EXTERNAL lsame, slamch, slangt
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(
'SGTSVX', -info )
361 CALL scopy( n, d, 1, df, 1 )
363 CALL scopy( n-1, dl, 1, dlf, 1 )
364 CALL scopy( n-1, du, 1, duf, 1 )
366 CALL sgttrf( n, dlf, df, duf, du2, ipiv, info )
383 anorm = slangt( norm, n, dl, d, du )
387 CALL sgtcon( norm, n, dlf, df, duf, du2, ipiv, anorm, rcond, work,
392 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
393 CALL sgttrs( trans, n, nrhs, dlf, df, duf, du2, ipiv, x, ldx,
399 CALL sgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv,
400 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
404 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGTRFS
subroutine sgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
SGTCON
subroutine sgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
SGTTRS
subroutine sgtsvx(fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
SGTSVX computes the solution to system of linear equations A * X = B for GT matrices