File:  [local] / rpl / lapack / lapack / zgbequ.f
Revision 1.17: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:15 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    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: *> \ingroup complex16GBcomputational
  150: *
  151: *  =====================================================================
  152:       SUBROUTINE ZGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
  153:      $                   AMAX, INFO )
  154: *
  155: *  -- LAPACK computational routine --
  156: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  157: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  158: *
  159: *     .. Scalar Arguments ..
  160:       INTEGER            INFO, KL, KU, LDAB, M, N
  161:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
  162: *     ..
  163: *     .. Array Arguments ..
  164:       DOUBLE PRECISION   C( * ), R( * )
  165:       COMPLEX*16         AB( LDAB, * )
  166: *     ..
  167: *
  168: *  =====================================================================
  169: *
  170: *     .. Parameters ..
  171:       DOUBLE PRECISION   ONE, ZERO
  172:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  173: *     ..
  174: *     .. Local Scalars ..
  175:       INTEGER            I, J, KD
  176:       DOUBLE PRECISION   BIGNUM, RCMAX, RCMIN, SMLNUM
  177:       COMPLEX*16         ZDUM
  178: *     ..
  179: *     .. External Functions ..
  180:       DOUBLE PRECISION   DLAMCH
  181:       EXTERNAL           DLAMCH
  182: *     ..
  183: *     .. External Subroutines ..
  184:       EXTERNAL           XERBLA
  185: *     ..
  186: *     .. Intrinsic Functions ..
  187:       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
  188: *     ..
  189: *     .. Statement Functions ..
  190:       DOUBLE PRECISION   CABS1
  191: *     ..
  192: *     .. Statement Function definitions ..
  193:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
  194: *     ..
  195: *     .. Executable Statements ..
  196: *
  197: *     Test the input parameters
  198: *
  199:       INFO = 0
  200:       IF( M.LT.0 ) THEN
  201:          INFO = -1
  202:       ELSE IF( N.LT.0 ) THEN
  203:          INFO = -2
  204:       ELSE IF( KL.LT.0 ) THEN
  205:          INFO = -3
  206:       ELSE IF( KU.LT.0 ) THEN
  207:          INFO = -4
  208:       ELSE IF( LDAB.LT.KL+KU+1 ) THEN
  209:          INFO = -6
  210:       END IF
  211:       IF( INFO.NE.0 ) THEN
  212:          CALL XERBLA( 'ZGBEQU', -INFO )
  213:          RETURN
  214:       END IF
  215: *
  216: *     Quick return if possible
  217: *
  218:       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
  219:          ROWCND = ONE
  220:          COLCND = ONE
  221:          AMAX = ZERO
  222:          RETURN
  223:       END IF
  224: *
  225: *     Get machine constants.
  226: *
  227:       SMLNUM = DLAMCH( 'S' )
  228:       BIGNUM = ONE / SMLNUM
  229: *
  230: *     Compute row scale factors.
  231: *
  232:       DO 10 I = 1, M
  233:          R( I ) = ZERO
  234:    10 CONTINUE
  235: *
  236: *     Find the maximum element in each row.
  237: *
  238:       KD = KU + 1
  239:       DO 30 J = 1, N
  240:          DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
  241:             R( I ) = MAX( R( I ), CABS1( AB( KD+I-J, J ) ) )
  242:    20    CONTINUE
  243:    30 CONTINUE
  244: *
  245: *     Find the maximum and minimum scale factors.
  246: *
  247:       RCMIN = BIGNUM
  248:       RCMAX = ZERO
  249:       DO 40 I = 1, M
  250:          RCMAX = MAX( RCMAX, R( I ) )
  251:          RCMIN = MIN( RCMIN, R( I ) )
  252:    40 CONTINUE
  253:       AMAX = RCMAX
  254: *
  255:       IF( RCMIN.EQ.ZERO ) THEN
  256: *
  257: *        Find the first zero scale factor and return an error code.
  258: *
  259:          DO 50 I = 1, M
  260:             IF( R( I ).EQ.ZERO ) THEN
  261:                INFO = I
  262:                RETURN
  263:             END IF
  264:    50    CONTINUE
  265:       ELSE
  266: *
  267: *        Invert the scale factors.
  268: *
  269:          DO 60 I = 1, M
  270:             R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
  271:    60    CONTINUE
  272: *
  273: *        Compute ROWCND = min(R(I)) / max(R(I))
  274: *
  275:          ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  276:       END IF
  277: *
  278: *     Compute column scale factors
  279: *
  280:       DO 70 J = 1, N
  281:          C( J ) = ZERO
  282:    70 CONTINUE
  283: *
  284: *     Find the maximum element in each column,
  285: *     assuming the row scaling computed above.
  286: *
  287:       KD = KU + 1
  288:       DO 90 J = 1, N
  289:          DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
  290:             C( J ) = MAX( C( J ), CABS1( AB( KD+I-J, J ) )*R( I ) )
  291:    80    CONTINUE
  292:    90 CONTINUE
  293: *
  294: *     Find the maximum and minimum scale factors.
  295: *
  296:       RCMIN = BIGNUM
  297:       RCMAX = ZERO
  298:       DO 100 J = 1, N
  299:          RCMIN = MIN( RCMIN, C( J ) )
  300:          RCMAX = MAX( RCMAX, C( J ) )
  301:   100 CONTINUE
  302: *
  303:       IF( RCMIN.EQ.ZERO ) THEN
  304: *
  305: *        Find the first zero scale factor and return an error code.
  306: *
  307:          DO 110 J = 1, N
  308:             IF( C( J ).EQ.ZERO ) THEN
  309:                INFO = M + J
  310:                RETURN
  311:             END IF
  312:   110    CONTINUE
  313:       ELSE
  314: *
  315: *        Invert the scale factors.
  316: *
  317:          DO 120 J = 1, N
  318:             C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
  319:   120    CONTINUE
  320: *
  321: *        Compute COLCND = min(C(J)) / max(C(J))
  322: *
  323:          COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
  324:       END IF
  325: *
  326:       RETURN
  327: *
  328: *     End of ZGBEQU
  329: *
  330:       END

CVSweb interface <joel.bertrand@systella.fr>