234 SUBROUTINE cptsvx( 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
248 REAL BERR( * ), D( * ), DF( * ), FERR( * ),
250 COMPLEX B( ldb, * ), E( * ), EF( * ), WORK( * ),
258 parameter ( zero = 0.0e+0 )
267 EXTERNAL lsame, clanht, slamch
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(
'CPTSVX', -info )
302 CALL scopy( n, d, 1, df, 1 )
304 $
CALL ccopy( n-1, e, 1, ef, 1 )
305 CALL cpttrf( n, df, ef, info )
317 anorm = clanht(
'1', n, d, e )
321 CALL cptcon( n, df, ef, anorm, rcond, rwork, info )
325 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
326 CALL cpttrs(
'Lower', n, nrhs, df, ef, x, ldx, info )
331 CALL cptrfs(
'Lower', n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr,
332 $ berr, work, rwork, info )
336 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine cpttrf(N, D, E, INFO)
CPTTRF
subroutine cptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
CPTCON
subroutine cpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
CPTTRS
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPTRFS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY