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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
subroutine xerbla(SRNAME, INFO)
XERBLA
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 zptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
ZPTCON