311 SUBROUTINE zppsvx( 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
322 DOUBLE PRECISION RCOND
325 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * ), S( * )
326 COMPLEX*16 AFP( * ), AP( * ), B( ldb, * ), WORK( * ),
333 DOUBLE PRECISION ZERO, ONE
334 parameter ( zero = 0.0d+0, one = 1.0d+0 )
337 LOGICAL EQUIL, NOFACT, RCEQU
339 DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
343 DOUBLE PRECISION DLAMCH, ZLANHP
344 EXTERNAL lsame, dlamch, zlanhp
356 nofact = lsame( fact,
'N' )
357 equil = lsame( fact,
'E' )
358 IF( nofact .OR. equil )
THEN
362 rcequ = lsame( equed,
'Y' )
363 smlnum = dlamch(
'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(
'ZPPSVX', -info )
416 CALL zppequ( uplo, n, ap, s, scond, amax, infequ )
417 IF( infequ.EQ.0 )
THEN
421 CALL zlaqhp( 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 zcopy( n*( n+1 ) / 2, ap, 1, afp, 1 )
441 CALL zpptrf( uplo, n, afp, info )
453 anorm = zlanhp(
'I', uplo, n, ap, rwork )
457 CALL zppcon( uplo, n, afp, anorm, rcond, work, rwork, info )
461 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
462 CALL zpptrs( uplo, n, nrhs, afp, x, ldx, info )
467 CALL zpprfs( 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.dlamch(
'Epsilon' ) )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPPRFS
subroutine zpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
ZPPTRS
subroutine zlaqhp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
ZLAQHP scales a Hermitian matrix stored in packed form.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
ZPPCON
subroutine zppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
ZPPEQU
subroutine zppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine zpptrf(UPLO, N, AP, INFO)
ZPPTRF