348 SUBROUTINE sgesvx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
349 $ equed, r, c,
b, ldb, x, ldx, rcond, ferr, berr,
350 $ work, iwork, info )
358 CHARACTER equed, fact, trans
359 INTEGER info, lda, ldaf, ldb, ldx, n, nrhs
363 INTEGER ipiv( * ), iwork( * )
364 REAL a( lda, * ), af( ldaf, * ),
b( ldb, * ),
365 $ berr( * ), c( * ), ferr( * ), r( * ),
366 $ work( * ), x( ldx, * )
373 parameter( zero = 0.0e+0, one = 1.0e+0 )
376 LOGICAL colequ, equil, nofact, notran, rowequ
379 REAL amax, anorm, bignum, colcnd, rcmax, rcmin,
380 $ rowcnd, rpvgrw, smlnum
397 nofact =
lsame( fact,
'N' )
398 equil =
lsame( fact,
'E' )
399 notran =
lsame( trans,
'N' )
400 IF( nofact .OR. equil )
THEN
405 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
406 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
407 smlnum =
slamch(
'Safe minimum' )
408 bignum = one / smlnum
413 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
416 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
417 $
lsame( trans,
'C' ) )
THEN
419 ELSE IF( n.LT.0 )
THEN
421 ELSE IF( nrhs.LT.0 )
THEN
423 ELSE IF( lda.LT.max( 1, n ) )
THEN
425 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
427 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
428 $ ( rowequ .OR. colequ .OR.
lsame( equed,
'N' ) ) )
THEN
435 rcmin = min( rcmin, r(
j ) )
436 rcmax = max( rcmax, r(
j ) )
438 IF( rcmin.LE.zero )
THEN
440 ELSE IF( n.GT.0 )
THEN
441 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
446 IF( colequ .AND. info.EQ.0 )
THEN
450 rcmin = min( rcmin, c(
j ) )
451 rcmax = max( rcmax, c(
j ) )
453 IF( rcmin.LE.zero )
THEN
455 ELSE IF( n.GT.0 )
THEN
456 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
462 IF( ldb.LT.max( 1, n ) )
THEN
464 ELSE IF( ldx.LT.max( 1, n ) )
THEN
471 CALL
xerbla(
'SGESVX', -info )
479 CALL
sgeequ( n, n, a, lda, r, c, rowcnd, colcnd, amax, infequ )
480 IF( infequ.EQ.0 )
THEN
484 CALL
slaqge( n, n, a, lda, r, c, rowcnd, colcnd, amax,
486 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
487 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
497 b( i,
j ) = r( i )*
b( i,
j )
501 ELSE IF( colequ )
THEN
504 b( i,
j ) = c( i )*
b( i,
j )
509 IF( nofact .OR. equil )
THEN
513 CALL
slacpy(
'Full', n, n, a, lda, af, ldaf )
514 CALL
sgetrf( n, n, af, ldaf, ipiv, info )
523 rpvgrw =
slantr(
'M',
'U',
'N', info, info, af, ldaf,
525 IF( rpvgrw.EQ.zero )
THEN
528 rpvgrw =
slange(
'M', n, info, a, lda, work ) / rpvgrw
544 anorm =
slange( norm, n, n, a, lda, work )
545 rpvgrw =
slantr(
'M',
'U',
'N', n, n, af, ldaf, work )
546 IF( rpvgrw.EQ.zero )
THEN
549 rpvgrw =
slange(
'M', n, n, a, lda, work ) / rpvgrw
554 CALL
sgecon( norm, n, af, ldaf, anorm, rcond, work, iwork, info )
558 CALL
slacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
559 CALL
sgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
564 CALL
sgerfs( trans, n, nrhs, a, lda, af, ldaf, ipiv,
b, ldb, x,
565 $ ldx, ferr, berr, work, iwork, info )
574 x( i,
j ) = c( i )*x( i,
j )
578 ferr(
j ) = ferr(
j ) / colcnd
581 ELSE IF( rowequ )
THEN
584 x( i,
j ) = r( i )*x( i,
j )
588 ferr(
j ) = ferr(
j ) / rowcnd
594 IF( rcond.LT.
slamch(
'Epsilon' ) )
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine slaqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
SLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY 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 sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
real function slantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
SLANTR 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.