349 SUBROUTINE zgesvx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
350 $ equed, r, c, b, ldb, x, ldx, rcond, ferr, berr,
351 $ work, rwork, info )
359 CHARACTER EQUED, FACT, TRANS
360 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
361 DOUBLE PRECISION RCOND
365 DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ),
367 COMPLEX*16 A( lda, * ), AF( ldaf, * ), B( ldb, * ),
368 $ work( * ), x( ldx, * )
374 DOUBLE PRECISION ZERO, ONE
375 parameter( zero = 0.0d+0, one = 1.0d+0 )
378 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
381 DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
382 $ rowcnd, rpvgrw, smlnum
386 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANTR
387 EXTERNAL lsame, dlamch, zlange, zlantr
399 nofact = lsame( fact,
'N' )
400 equil = lsame( fact,
'E' )
401 notran = lsame( trans,
'N' )
402 IF( nofact .OR. equil )
THEN
407 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
408 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
409 smlnum = dlamch(
'Safe minimum' )
410 bignum = one / smlnum
415 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
418 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
419 $ lsame( trans,
'C' ) )
THEN
421 ELSE IF( n.LT.0 )
THEN
423 ELSE IF( nrhs.LT.0 )
THEN
425 ELSE IF( lda.LT.max( 1, n ) )
THEN
427 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
429 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
430 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
437 rcmin = min( rcmin, r( j ) )
438 rcmax = max( rcmax, r( j ) )
440 IF( rcmin.LE.zero )
THEN
442 ELSE IF( n.GT.0 )
THEN
443 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
448 IF( colequ .AND. info.EQ.0 )
THEN
452 rcmin = min( rcmin, c( j ) )
453 rcmax = max( rcmax, c( j ) )
455 IF( rcmin.LE.zero )
THEN
457 ELSE IF( n.GT.0 )
THEN
458 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
464 IF( ldb.LT.max( 1, n ) )
THEN
466 ELSE IF( ldx.LT.max( 1, n ) )
THEN
473 CALL
xerbla(
'ZGESVX', -info )
481 CALL
zgeequ( n, n, a, lda, r, c, rowcnd, colcnd, amax, infequ )
482 IF( infequ.EQ.0 )
THEN
486 CALL
zlaqge( n, n, a, lda, r, c, rowcnd, colcnd, amax,
488 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
489 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
499 b( i, j ) = r( i )*b( i, j )
503 ELSE IF( colequ )
THEN
506 b( i, j ) = c( i )*b( i, j )
511 IF( nofact .OR. equil )
THEN
515 CALL
zlacpy(
'Full', n, n, a, lda, af, ldaf )
516 CALL
zgetrf( n, n, af, ldaf, ipiv, info )
525 rpvgrw = zlantr(
'M',
'U',
'N', info, info, af, ldaf,
527 IF( rpvgrw.EQ.zero )
THEN
530 rpvgrw = zlange(
'M', n, info, a, lda, rwork ) /
547 anorm = zlange( norm, n, n, a, lda, rwork )
548 rpvgrw = zlantr(
'M',
'U',
'N', n, n, af, ldaf, rwork )
549 IF( rpvgrw.EQ.zero )
THEN
552 rpvgrw = zlange(
'M', n, n, a, lda, rwork ) / rpvgrw
557 CALL
zgecon( norm, n, af, ldaf, anorm, rcond, work, rwork, info )
561 CALL
zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
562 CALL
zgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
567 CALL
zgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x,
568 $ ldx, ferr, berr, work, rwork, info )
577 x( i, j ) = c( i )*x( i, j )
581 ferr( j ) = ferr( j ) / colcnd
584 ELSE IF( rowequ )
THEN
587 x( i, j ) = r( i )*x( i, j )
591 ferr( j ) = ferr( j ) / rowcnd
597 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 zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zlaqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.