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
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 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 xerbla(SRNAME, INFO)
XERBLA
subroutine zpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
ZPPTRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
logical function lsame(CA, CB)
LSAME
subroutine zpptrf(UPLO, N, AP, INFO)
ZPPTRF
subroutine zpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPPRFS
subroutine zlaqhp(UPLO, N, AP, S, SCOND, AMAX, EQUED)
ZLAQHP scales a Hermitian matrix stored in packed form.
double precision function zlanhp(NORM, UPLO, N, AP, WORK)
ZLANHP 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 zppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
ZPPEQU
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
ZPPCON