305 SUBROUTINE zposvx( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
306 $ s,
b, ldb, x, ldx, rcond, ferr, berr, work,
315 CHARACTER equed, fact, uplo
316 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs
317 DOUBLE PRECISION rcond
320 DOUBLE PRECISION berr( * ), ferr( * ), rwork( * ), s( * )
321 COMPLEX*16 a( lda, * ), af( ldaf, * ),
b( ldb, * ),
322 $ work( * ), x( ldx, * )
328 DOUBLE PRECISION zero, one
329 parameter( zero = 0.0d+0, one = 1.0d+0 )
332 LOGICAL equil, nofact, rcequ
334 DOUBLE PRECISION amax, anorm, bignum, scond, smax, smin, smlnum
351 nofact =
lsame( fact,
'N' )
352 equil =
lsame( fact,
'E' )
353 IF( nofact .OR. equil )
THEN
357 rcequ =
lsame( equed,
'Y' )
358 smlnum =
dlamch(
'Safe minimum' )
359 bignum = one / smlnum
364 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
367 ELSE IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
370 ELSE IF( n.LT.0 )
THEN
372 ELSE IF( nrhs.LT.0 )
THEN
374 ELSE IF( lda.LT.max( 1, n ) )
THEN
376 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
378 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
379 $ ( rcequ .OR.
lsame( equed,
'N' ) ) )
THEN
386 smin = min( smin, s(
j ) )
387 smax = max( smax, s(
j ) )
389 IF( smin.LE.zero )
THEN
391 ELSE IF( n.GT.0 )
THEN
392 scond = max( smin, smlnum ) / min( smax, bignum )
398 IF( ldb.LT.max( 1, n ) )
THEN
400 ELSE IF( ldx.LT.max( 1, n ) )
THEN
407 CALL
xerbla(
'ZPOSVX', -info )
415 CALL
zpoequ( n, a, lda, s, scond, amax, infequ )
416 IF( infequ.EQ.0 )
THEN
420 CALL
zlaqhe( uplo, n, a, lda, s, scond, amax, equed )
421 rcequ =
lsame( equed,
'Y' )
430 b( i,
j ) = s( i )*
b( i,
j )
435 IF( nofact .OR. equil )
THEN
439 CALL
zlacpy( uplo, n, n, a, lda, af, ldaf )
440 CALL
zpotrf( uplo, n, af, ldaf, info )
452 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
456 CALL
zpocon( uplo, n, af, ldaf, anorm, rcond, work, rwork, info )
460 CALL
zlacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
461 CALL
zpotrs( uplo, n, nrhs, af, ldaf, x, ldx, info )
466 CALL
zporfs( uplo, n, nrhs, a, lda, af, ldaf,
b, ldb, x, ldx,
467 $ ferr, berr, work, rwork, info )
475 x( i,
j ) = s( i )*x( i,
j )
479 ferr(
j ) = ferr(
j ) / scond
485 IF( rcond.LT.
dlamch(
'Epsilon' ) )
subroutine zposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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.
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
subroutine zporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPORFS
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON