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
384 REAL SLAMCH, SLANGE, SLANTR
385 EXTERNAL lsame, slamch, slange, slantr
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 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 sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
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 sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.