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' ) )