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 zpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
ZPTTRS
subroutine zptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPTRFS
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 ...
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON