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

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

CVSweb interface <joel.bertrand@systella.fr>