307 SUBROUTINE zppsvx( FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B,
309 $ X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO )
316 CHARACTER EQUED, FACT, UPLO
317 INTEGER INFO, LDB, LDX, N, NRHS
318 DOUBLE PRECISION RCOND
321 DOUBLE PRECISION BERR( * ), FERR( * ), RWORK( * ), S( * )
322 COMPLEX*16 AFP( * ), AP( * ), B( LDB, * ), WORK( * ),
329 DOUBLE PRECISION ZERO, ONE
330 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
333 LOGICAL EQUIL, NOFACT, RCEQU
335 DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
339 DOUBLE PRECISION DLAMCH, ZLANHP
340 EXTERNAL lsame, dlamch, zlanhp
353 nofact = lsame( fact,
'N' )
354 equil = lsame( fact,
'E' )
355 IF( nofact .OR. equil )
THEN
359 rcequ = lsame( equed,
'Y' )
360 smlnum = dlamch(
'Safe minimum' )
361 bignum = one / smlnum
366 IF( .NOT.nofact .AND.
368 $ .NOT.lsame( fact,
'F' ) )
371 ELSE IF( .NOT.lsame( uplo,
'U' ) .AND.
372 $ .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,
469 $ work, rwork, info )
477 x( i, j ) = s( i )*x( i, j )
481 ferr( j ) = ferr( j ) / scond
487 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 zlaqhp(uplo, n, ap, s, scond, amax, equed)
ZLAQHP scales a Hermitian matrix stored in packed form.
subroutine zpprfs(uplo, n, nrhs, ap, afp, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZPPRFS
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