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
344 EXTERNAL lsame, clanhp, slamch
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' ) )
subroutine claqhp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
CLAQHP scales a Hermitian matrix stored 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 ...
subroutine cppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
CPPEQU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
CPPCON
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 cpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPTRS
subroutine cpptrf(UPLO, N, AP, INFO)
CPPTRF