284 SUBROUTINE chesvx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B,
285 $ ldb, x, ldx, rcond, ferr, berr, work, lwork,
295 INTEGER INFO, LDA, LDAF, LDB, LDX, LWORK, N, NRHS
300 REAL BERR( * ), FERR( * ), RWORK( * )
301 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
302 $ work( * ), x( ldx, * )
309 parameter ( zero = 0.0e+0 )
312 LOGICAL LQUERY, NOFACT
320 EXTERNAL ilaenv, lsame, clanhe, slamch
333 nofact = lsame( fact,
'N' )
334 lquery = ( lwork.EQ.-1 )
335 IF( .NOT.nofact .AND. .NOT.lsame( fact,
'F' ) )
THEN
337 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND. .NOT.lsame( uplo,
'L' ) )
340 ELSE IF( n.LT.0 )
THEN
342 ELSE IF( nrhs.LT.0 )
THEN
344 ELSE IF( lda.LT.max( 1, n ) )
THEN
346 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
348 ELSE IF( ldb.LT.max( 1, n ) )
THEN
350 ELSE IF( ldx.LT.max( 1, n ) )
THEN
352 ELSE IF( lwork.LT.max( 1, 2*n ) .AND. .NOT.lquery )
THEN
357 lwkopt = max( 1, 2*n )
359 nb = ilaenv( 1,
'CHETRF', uplo, n, -1, -1, -1 )
360 lwkopt = max( lwkopt, n*nb )
366 CALL xerbla(
'CHESVX', -info )
368 ELSE IF( lquery )
THEN
376 CALL clacpy( uplo, n, n, a, lda, af, ldaf )
377 CALL chetrf( uplo, n, af, ldaf, ipiv, work, lwork, info )
389 anorm = clanhe(
'I', uplo, n, a, lda, rwork )
393 CALL checon( uplo, n, af, ldaf, ipiv, anorm, rcond, work, info )
397 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
398 CALL chetrs( uplo, n, nrhs, af, ldaf, ipiv, x, ldx, info )
403 CALL cherfs( uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x,
404 $ ldx, ferr, berr, work, rwork, info )
408 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine chesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS