277 SUBROUTINE zhpsvx( FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X,
278 $ ldx, rcond, ferr, berr, work, rwork, info )
287 INTEGER INFO, LDB, LDX, N, NRHS
288 DOUBLE PRECISION RCOND
292 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * )
293 COMPLEX*16 AFP( * ), AP( * ), B( ldb, * ), WORK( * ),
300 DOUBLE PRECISION ZERO
301 parameter ( zero = 0.0d+0 )
305 DOUBLE PRECISION ANORM
309 DOUBLE PRECISION DLAMCH, ZLANHP
310 EXTERNAL lsame, dlamch, zlanhp
324 nofact = lsame( fact,
'N' )
325 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
327 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
330 ELSE IF( n.LT.0 )
THEN
332 ELSE IF( nrhs.LT.0 )
THEN
334 ELSE IF( ldb.LT.max( 1, n ) )
THEN
336 ELSE IF( ldx.LT.max( 1, n ) )
THEN
340 CALL xerbla(
'ZHPSVX', -info )
348 CALL zcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
349 CALL zhptrf( uplo, n, afp, ipiv, info )
361 anorm = zlanhp(
'I', uplo, n, ap, rwork )
365 CALL zhpcon( uplo, n, afp, ipiv, anorm, rcond, work, info )
369 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
370 CALL zhptrs( uplo, n, nrhs, afp, ipiv, x, ldx, info )
375 CALL zhprfs( uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr,
376 $ berr, work, rwork, info )
380 IF( rcond.LT.dlamch(
'Epsilon' ) )
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
subroutine zhpsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF