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
338 DOUBLE PRECISION DLAMCH, ZLANHE
339 EXTERNAL lsame, dlamch, zlanhe
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 zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
subroutine zlaqhe(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
ZLAQHE scales a Hermitian matrix.
subroutine zporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPORFS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON
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 zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS