234 SUBROUTINE zptsvx( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
235 $ rcond, ferr, berr, work, rwork, info )
244 INTEGER INFO, LDB, LDX, N, NRHS
245 DOUBLE PRECISION RCOND
248 DOUBLE PRECISION BERR( * ), D( * ), DF( * ), FERR( * ),
250 COMPLEX*16 B( ldb, * ), E( * ), EF( * ), WORK( * ),
257 DOUBLE PRECISION ZERO
258 parameter( zero = 0.0d+0 )
262 DOUBLE PRECISION ANORM
266 DOUBLE PRECISION DLAMCH, ZLANHT
267 EXTERNAL lsame, dlamch, zlanht
281 nofact = lsame( fact,
'N' )
282 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
284 ELSE IF( n.LT.0 )
THEN
286 ELSE IF( nrhs.LT.0 )
THEN
288 ELSE IF( ldb.LT.max( 1, n ) )
THEN
290 ELSE IF( ldx.LT.max( 1, n ) )
THEN
294 CALL
xerbla(
'ZPTSVX', -info )
302 CALL
dcopy( n, d, 1, df, 1 )
304 $ CALL
zcopy( n-1, e, 1, ef, 1 )
305 CALL
zpttrf( n, df, ef, info )
317 anorm = zlanht(
'1', n, d, e )
321 CALL
zptcon( n, df, ef, anorm, rcond, rwork, info )
325 CALL
zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
326 CALL
zpttrs(
'Lower', n, nrhs, df, ef, x, ldx, info )
331 CALL
zptrfs(
'Lower', n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,
332 $ berr, work, rwork, info )
336 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
subroutine zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPTRFS
subroutine zptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...