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
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' ) )
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
logical function lsame(CA, CB)
LSAME
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 cgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGERFS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
real function clantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU