305 SUBROUTINE cposvx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
306 $ s,
b, ldb,
x, ldx, rcond, ferr, berr, work,
315 CHARACTER equed, fact, uplo
316 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs
320 REAL berr( * ), ferr( * ), rwork( * ), s( * )
321 COMPLEX a( lda, * ), af( ldaf, * ),
b( ldb, * ),
322 $ work( * ),
x( ldx, * )
329 parameter( zero = 0.0e+0, one = 1.0e+0 )
332 LOGICAL equil, nofact, rcequ
334 REAL amax, anorm, bignum, scond, smax, smin, smlnum
351 nofact =
lsame( fact,
'N' )
352 equil =
lsame( fact,
'E' )
353 IF( nofact .OR. equil )
THEN
357 rcequ =
lsame( equed,
'Y' )
358 smlnum =
slamch(
'Safe minimum' )
359 bignum = one / smlnum
364 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
367 ELSE IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
370 ELSE IF( n.LT.0 )
THEN
372 ELSE IF( nrhs.LT.0 )
THEN
374 ELSE IF( lda.LT.max( 1, n ) )
THEN
376 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
378 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
379 $ ( rcequ .OR.
lsame( equed,
'N' ) ) )
THEN
386 smin = min( smin, s(
j ) )
387 smax = max( smax, s(
j ) )
389 IF( smin.LE.zero )
THEN
391 ELSE IF( n.GT.0 )
THEN
392 scond = max( smin, smlnum ) / min( smax, bignum )
398 IF( ldb.LT.max( 1, n ) )
THEN
400 ELSE IF( ldx.LT.max( 1, n ) )
THEN
407 CALL
xerbla(
'CPOSVX', -info )
415 CALL
cpoequ( n, a, lda, s, scond, amax, infequ )
416 IF( infequ.EQ.0 )
THEN
420 CALL
claqhe( uplo, n, a, lda, s, scond, amax, equed )
421 rcequ =
lsame( equed,
'Y' )
430 b( i,
j ) = s( i )*
b( i,
j )
435 IF( nofact .OR. equil )
THEN
439 CALL
clacpy( uplo, n, n, a, lda, af, ldaf )
440 CALL
cpotrf( uplo, n, af, ldaf, info )
452 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
456 CALL
cpocon( uplo, n, af, ldaf, anorm, rcond, work, rwork, info )
460 CALL
clacpy(
'Full', n, nrhs,
b, ldb,
x, ldx )
461 CALL
cpotrs( uplo, n, nrhs, af, ldaf,
x, ldx, info )
466 CALL
cporfs( uplo, n, nrhs, a, lda, af, ldaf,
b, ldb,
x, ldx,
467 $ ferr, berr, work, rwork, info )
475 x( i,
j ) = s( i )*
x( i,
j )
479 ferr(
j ) = ferr(
j ) / scond
485 IF( rcond.LT.
slamch(
'Epsilon' ) )
LOGICAL function lsame(CA, CB)
LSAME
subroutine cposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
REAL function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
REAL function slamch(CMACH)
SLAMCH
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
CPOEQU
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine claqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
CLAQHE scales a Hermitian matrix.
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS