File:  [local] / rpl / lapack / lapack / dgeequ.f
Revision 1.13: download - view: text, annotated - select for diffs - revision graph
Sat Aug 27 15:34:20 2016 UTC (7 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_25, HEAD
Cohérence Lapack.

    1: *> \brief \b DGEEQU
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download DGEEQU + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeequ.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeequ.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeequ.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
   22: *                          INFO )
   23:    24: *       .. Scalar Arguments ..
   25: *       INTEGER            INFO, LDA, M, N
   26: *       DOUBLE PRECISION   AMAX, COLCND, ROWCND
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
   30: *       ..
   31: *  
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *> DGEEQU computes row and column scalings intended to equilibrate an
   39: *> M-by-N matrix A and reduce its condition number.  R returns the row
   40: *> scale factors and C the column scale factors, chosen to try to make
   41: *> the largest element in each row and column of the matrix B with
   42: *> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
   43: *>
   44: *> R(i) and C(j) are restricted to be between SMLNUM = smallest safe
   45: *> number and BIGNUM = largest safe number.  Use of these scaling
   46: *> factors is not guaranteed to reduce the condition number of A but
   47: *> works well in practice.
   48: *> \endverbatim
   49: *
   50: *  Arguments:
   51: *  ==========
   52: *
   53: *> \param[in] M
   54: *> \verbatim
   55: *>          M is INTEGER
   56: *>          The number of rows of the matrix A.  M >= 0.
   57: *> \endverbatim
   58: *>
   59: *> \param[in] N
   60: *> \verbatim
   61: *>          N is INTEGER
   62: *>          The number of columns of the matrix A.  N >= 0.
   63: *> \endverbatim
   64: *>
   65: *> \param[in] A
   66: *> \verbatim
   67: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
   68: *>          The M-by-N matrix whose equilibration factors are
   69: *>          to be computed.
   70: *> \endverbatim
   71: *>
   72: *> \param[in] LDA
   73: *> \verbatim
   74: *>          LDA is INTEGER
   75: *>          The leading dimension of the array A.  LDA >= max(1,M).
   76: *> \endverbatim
   77: *>
   78: *> \param[out] R
   79: *> \verbatim
   80: *>          R is DOUBLE PRECISION array, dimension (M)
   81: *>          If INFO = 0 or INFO > M, R contains the row scale factors
   82: *>          for A.
   83: *> \endverbatim
   84: *>
   85: *> \param[out] C
   86: *> \verbatim
   87: *>          C is DOUBLE PRECISION array, dimension (N)
   88: *>          If INFO = 0,  C contains the column scale factors for A.
   89: *> \endverbatim
   90: *>
   91: *> \param[out] ROWCND
   92: *> \verbatim
   93: *>          ROWCND is DOUBLE PRECISION
   94: *>          If INFO = 0 or INFO > M, ROWCND contains the ratio of the
   95: *>          smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and
   96: *>          AMAX is neither too large nor too small, it is not worth
   97: *>          scaling by R.
   98: *> \endverbatim
   99: *>
  100: *> \param[out] COLCND
  101: *> \verbatim
  102: *>          COLCND is DOUBLE PRECISION
  103: *>          If INFO = 0, COLCND contains the ratio of the smallest
  104: *>          C(i) to the largest C(i).  If COLCND >= 0.1, it is not
  105: *>          worth scaling by C.
  106: *> \endverbatim
  107: *>
  108: *> \param[out] AMAX
  109: *> \verbatim
  110: *>          AMAX is DOUBLE PRECISION
  111: *>          Absolute value of largest matrix element.  If AMAX is very
  112: *>          close to overflow or very close to underflow, the matrix
  113: *>          should be scaled.
  114: *> \endverbatim
  115: *>
  116: *> \param[out] INFO
  117: *> \verbatim
  118: *>          INFO is INTEGER
  119: *>          = 0:  successful exit
  120: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  121: *>          > 0:  if INFO = i,  and i is
  122: *>                <= M:  the i-th row of A is exactly zero
  123: *>                >  M:  the (i-M)-th column of A is exactly zero
  124: *> \endverbatim
  125: *
  126: *  Authors:
  127: *  ========
  128: *
  129: *> \author Univ. of Tennessee 
  130: *> \author Univ. of California Berkeley 
  131: *> \author Univ. of Colorado Denver 
  132: *> \author NAG Ltd. 
  133: *
  134: *> \date November 2011
  135: *
  136: *> \ingroup doubleGEcomputational
  137: *
  138: *  =====================================================================
  139:       SUBROUTINE DGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
  140:      $                   INFO )
  141: *
  142: *  -- LAPACK computational routine (version 3.4.0) --
  143: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  144: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  145: *     November 2011
  146: *
  147: *     .. Scalar Arguments ..
  148:       INTEGER            INFO, LDA, M, N
  149:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
  150: *     ..
  151: *     .. Array Arguments ..
  152:       DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
  153: *     ..
  154: *
  155: *  =====================================================================
  156: *
  157: *     .. Parameters ..
  158:       DOUBLE PRECISION   ONE, ZERO
  159:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  160: *     ..
  161: *     .. Local Scalars ..
  162:       INTEGER            I, J
  163:       DOUBLE PRECISION   BIGNUM, RCMAX, RCMIN, SMLNUM
  164: *     ..
  165: *     .. External Functions ..
  166:       DOUBLE PRECISION   DLAMCH
  167:       EXTERNAL           DLAMCH
  168: *     ..
  169: *     .. External Subroutines ..
  170:       EXTERNAL           XERBLA
  171: *     ..
  172: *     .. Intrinsic Functions ..
  173:       INTRINSIC          ABS, MAX, MIN
  174: *     ..
  175: *     .. Executable Statements ..
  176: *
  177: *     Test the input parameters.
  178: *
  179:       INFO = 0
  180:       IF( M.LT.0 ) THEN
  181:          INFO = -1
  182:       ELSE IF( N.LT.0 ) THEN
  183:          INFO = -2
  184:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  185:          INFO = -4
  186:       END IF
  187:       IF( INFO.NE.0 ) THEN
  188:          CALL XERBLA( 'DGEEQU', -INFO )
  189:          RETURN
  190:       END IF
  191: *
  192: *     Quick return if possible
  193: *
  194:       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
  195:          ROWCND = ONE
  196:          COLCND = ONE
  197:          AMAX = ZERO
  198:          RETURN
  199:       END IF
  200: *
  201: *     Get machine constants.
  202: *
  203:       SMLNUM = DLAMCH( 'S' )
  204:       BIGNUM = ONE / SMLNUM
  205: *
  206: *     Compute row scale factors.
  207: *
  208:       DO 10 I = 1, M
  209:          R( I ) = ZERO
  210:    10 CONTINUE
  211: *
  212: *     Find the maximum element in each row.
  213: *
  214:       DO 30 J = 1, N
  215:          DO 20 I = 1, M
  216:             R( I ) = MAX( R( I ), ABS( A( I, J ) ) )
  217:    20    CONTINUE
  218:    30 CONTINUE
  219: *
  220: *     Find the maximum and minimum scale factors.
  221: *
  222:       RCMIN = BIGNUM
  223:       RCMAX = ZERO
  224:       DO 40 I = 1, M
  225:          RCMAX = MAX( RCMAX, R( I ) )
  226:          RCMIN = MIN( RCMIN, R( I ) )
  227:    40 CONTINUE
  228:       AMAX = RCMAX
  229: *
  230:       IF( RCMIN.EQ.ZERO ) THEN
  231: *
  232: *        Find the first zero scale factor and return an error code.
  233: *
  234:          DO 50 I = 1, M
  235:             IF( R( I ).EQ.ZERO ) THEN
  236:                INFO = I
  237:                RETURN
  238:             END IF
  239:    50    CONTINUE
  240:       ELSE
  241: *
  242: *        Invert the scale factors.
  243: *
  244:          DO 60 I = 1, M
  245:             R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
  246:    60    CONTINUE
  247: *
  248: *        Compute ROWCND = min(R(I)) / max(R(I))
  249: *
  250:          ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  251:       END IF
  252: *
  253: *     Compute column scale factors
  254: *
  255:       DO 70 J = 1, N
  256:          C( J ) = ZERO
  257:    70 CONTINUE
  258: *
  259: *     Find the maximum element in each column,
  260: *     assuming the row scaling computed above.
  261: *
  262:       DO 90 J = 1, N
  263:          DO 80 I = 1, M
  264:             C( J ) = MAX( C( J ), ABS( A( I, J ) )*R( I ) )
  265:    80    CONTINUE
  266:    90 CONTINUE
  267: *
  268: *     Find the maximum and minimum scale factors.
  269: *
  270:       RCMIN = BIGNUM
  271:       RCMAX = ZERO
  272:       DO 100 J = 1, N
  273:          RCMIN = MIN( RCMIN, C( J ) )
  274:          RCMAX = MAX( RCMAX, C( J ) )
  275:   100 CONTINUE
  276: *
  277:       IF( RCMIN.EQ.ZERO ) THEN
  278: *
  279: *        Find the first zero scale factor and return an error code.
  280: *
  281:          DO 110 J = 1, N
  282:             IF( C( J ).EQ.ZERO ) THEN
  283:                INFO = M + J
  284:                RETURN
  285:             END IF
  286:   110    CONTINUE
  287:       ELSE
  288: *
  289: *        Invert the scale factors.
  290: *
  291:          DO 120 J = 1, N
  292:             C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
  293:   120    CONTINUE
  294: *
  295: *        Compute COLCND = min(C(J)) / max(C(J))
  296: *
  297:          COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  298:       END IF
  299: *
  300:       RETURN
  301: *
  302: *     End of DGEEQU
  303: *
  304:       END

CVSweb interface <joel.bertrand@systella.fr>