349 SUBROUTINE cgesvx( 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
365 REAL BERR( * ), C( * ), FERR( * ), R( * ),
367 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
368 $ work( * ), x( ldx, * )
375 parameter ( zero = 0.0e+0, one = 1.0e+0 )
378 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
381 REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN,
382 $ rowcnd, rpvgrw, smlnum
386 REAL CLANGE, CLANTR, SLAMCH
387 EXTERNAL lsame, clange, clantr, slamch
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 = slamch(
'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(
'CGESVX', -info )
481 CALL cgeequ( n, n, a, lda, r, c, rowcnd, colcnd, amax, infequ )
482 IF( infequ.EQ.0 )
THEN
486 CALL claqge( 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 clacpy(
'Full', n, n, a, lda, af, ldaf )
516 CALL cgetrf( n, n, af, ldaf, ipiv, info )
525 rpvgrw = clantr(
'M',
'U',
'N', info, info, af, ldaf,
527 IF( rpvgrw.EQ.zero )
THEN
530 rpvgrw = clange(
'M', n, info, a, lda, rwork ) /
547 anorm = clange( norm, n, n, a, lda, rwork )
548 rpvgrw = clantr(
'M',
'U',
'N', n, n, af, ldaf, rwork )
549 IF( rpvgrw.EQ.zero )
THEN
552 rpvgrw = clange(
'M', n, n, a, lda, rwork ) / rpvgrw
557 CALL cgecon( norm, n, af, ldaf, anorm, rcond, work, rwork, info )
561 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
562 CALL cgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
567 CALL cgerfs( 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.slamch(
'Epsilon' ) )
subroutine cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine claqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
subroutine cgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON