288 SUBROUTINE sgtsvx( 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
303 INTEGER IPIV( * ), IWORK( * )
304 REAL B( LDB, * ), BERR( * ), D( * ), DF( * ),
305 $ DL( * ), DLF( * ), DU( * ), DU2( * ), DUF( * ),
306 $ ferr( * ), work( * ), x( ldx, * )
313 PARAMETER ( ZERO = 0.0e+0 )
316 LOGICAL NOFACT, NOTRAN
323 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,
393 CALL slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
394 CALL sgttrs( trans, n, nrhs, dlf, df, duf, du2, ipiv, x, ldx,
400 CALL sgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2,
402 $ b, ldb, x, ldx, ferr, berr, work, iwork, info )
406 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine sgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
SGTCON
subroutine sgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGTRFS
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
subroutine sgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
SGTTRS
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.