311 SUBROUTINE cppsvx( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB,
312 $
x, ldx, rcond, ferr, berr, work, rwork, info )
320 CHARACTER equed, fact, uplo
321 INTEGER info, ldb, ldx, n, nrhs
325 REAL berr( * ), ferr( * ), rwork( * ), s( * )
326 COMPLEX afp( * ), ap( * ),
b( ldb, * ), work( * ),
334 parameter( zero = 0.0e+0, one = 1.0e+0 )
337 LOGICAL equil, nofact, rcequ
339 REAL amax, anorm, bignum, scond, smax, smin, smlnum
356 nofact =
lsame( fact,
'N' )
357 equil =
lsame( fact,
'E' )
358 IF( nofact .OR. equil )
THEN
362 rcequ =
lsame( equed,
'Y' )
363 smlnum =
slamch(
'Safe minimum' )
364 bignum = one / smlnum
369 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
372 ELSE IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
375 ELSE IF( n.LT.0 )
THEN
377 ELSE IF( nrhs.LT.0 )
THEN
379 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
380 $ ( rcequ .OR.
lsame( equed,
'N' ) ) )
THEN
387 smin = min( smin, s(
j ) )
388 smax = max( smax, s(
j ) )
390 IF( smin.LE.zero )
THEN
392 ELSE IF( n.GT.0 )
THEN
393 scond = max( smin, smlnum ) / min( smax, bignum )
399 IF( ldb.LT.max( 1, n ) )
THEN
401 ELSE IF( ldx.LT.max( 1, n ) )
THEN
408 CALL
xerbla(
'CPPSVX', -info )
416 CALL
cppequ( uplo, n, ap, s, scond, amax, infequ )
417 IF( infequ.EQ.0 )
THEN
421 CALL
claqhp( uplo, n, ap, s, scond, amax, equed )
422 rcequ =
lsame( equed,
'Y' )
431 b( i,
j ) = s( i )*
b( i,
j )
436 IF( nofact .OR. equil )
THEN
440 CALL
ccopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
441 CALL
cpptrf( uplo, n, afp, info )
453 anorm =
clanhp(
'I', uplo, n, ap, rwork )
457 CALL
cppcon( uplo, n, afp, anorm, rcond, work, rwork, info )
461 CALL
clacpy(
'Full', n, nrhs,
b, ldb,
x, ldx )
462 CALL
cpptrs( uplo, n, nrhs, afp,
x, ldx, info )
467 CALL
cpprfs( uplo, n, nrhs, ap, afp,
b, ldb,
x, ldx, ferr, berr,
468 $ work, rwork, info )
476 x( i,
j ) = s( i )*
x( i,
j )
480 ferr(
j ) = ferr(
j ) / scond
486 IF( rcond.LT.
slamch(
'Epsilon' ) )
LOGICAL function lsame(CA, CB)
LSAME
subroutine cpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPTRS
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cpptrf(UPLO, N, AP, INFO)
CPPTRF
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine claqhp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
CLAQHP scales a Hermitian matrix stored in packed form.
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
REAL function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP 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 supplied in packed form.
subroutine cpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPPRFS
subroutine cppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...