293 SUBROUTINE zgtsvx( FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF,
294 $ du2, ipiv,
b, ldb,
x, ldx, rcond, ferr, berr,
295 $ work, rwork, info )
303 CHARACTER fact, trans
304 INTEGER info, ldb, ldx, n, nrhs
305 DOUBLE PRECISION rcond
309 DOUBLE PRECISION berr( * ), ferr( * ), rwork( * )
310 COMPLEX*16 b( ldb, * ), d( * ), df( * ), dl( * ),
311 $ dlf( * ), du( * ), du2( * ), duf( * ),
312 $ work( * ),
x( ldx, * )
318 DOUBLE PRECISION zero
319 parameter( zero = 0.0d+0 )
322 LOGICAL nofact, notran
324 DOUBLE PRECISION anorm
341 nofact =
lsame( fact,
'N' )
342 notran =
lsame( trans,
'N' )
343 IF( .NOT.nofact .AND. .NOT.
lsame( fact,
'F' ) )
THEN
345 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
346 $
lsame( trans,
'C' ) )
THEN
348 ELSE IF( n.LT.0 )
THEN
350 ELSE IF( nrhs.LT.0 )
THEN
352 ELSE IF( ldb.LT.max( 1, n ) )
THEN
354 ELSE IF( ldx.LT.max( 1, n ) )
THEN
358 CALL
xerbla(
'ZGTSVX', -info )
366 CALL
zcopy( n, d, 1, df, 1 )
368 CALL
zcopy( n-1, dl, 1, dlf, 1 )
369 CALL
zcopy( n-1, du, 1, duf, 1 )
371 CALL
zgttrf( n, dlf, df, duf, du2, ipiv, info )
388 anorm =
zlangt( norm, n, dl, d, du )
392 CALL
zgtcon( norm, n, dlf, df, duf, du2, ipiv, anorm, rcond, work,
397 CALL
zlacpy(
'Full', n, nrhs,
b, ldb,
x, ldx )
398 CALL
zgttrs( trans, n, nrhs, dlf, df, duf, du2, ipiv,
x, ldx,
404 CALL
zgtrfs( trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv,
405 $
b, ldb,
x, ldx, ferr, berr, work, rwork, info )
409 IF( rcond.LT.
dlamch(
'Epsilon' ) )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
DOUBLE PRECISION function zlangt(NORM, N, DL, D, DU)
ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGTRFS
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON