File:  [local] / rpl / lapack / lapack / dlaqgb.f
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:55 2023 UTC (9 months 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 DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLAQGB + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqgb.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqgb.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqgb.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
   22: *                          AMAX, EQUED )
   23: *
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          EQUED
   26: *       INTEGER            KL, KU, LDAB, M, N
   27: *       DOUBLE PRECISION   AMAX, COLCND, ROWCND
   28: *       ..
   29: *       .. Array Arguments ..
   30: *       DOUBLE PRECISION   AB( LDAB, * ), C( * ), R( * )
   31: *       ..
   32: *
   33: *
   34: *> \par Purpose:
   35: *  =============
   36: *>
   37: *> \verbatim
   38: *>
   39: *> DLAQGB equilibrates a general M by N band matrix A with KL
   40: *> subdiagonals and KU superdiagonals using the row and scaling factors
   41: *> in the vectors R and C.
   42: *> \endverbatim
   43: *
   44: *  Arguments:
   45: *  ==========
   46: *
   47: *> \param[in] M
   48: *> \verbatim
   49: *>          M is INTEGER
   50: *>          The number of rows of the matrix A.  M >= 0.
   51: *> \endverbatim
   52: *>
   53: *> \param[in] N
   54: *> \verbatim
   55: *>          N is INTEGER
   56: *>          The number of columns of the matrix A.  N >= 0.
   57: *> \endverbatim
   58: *>
   59: *> \param[in] KL
   60: *> \verbatim
   61: *>          KL is INTEGER
   62: *>          The number of subdiagonals within the band of A.  KL >= 0.
   63: *> \endverbatim
   64: *>
   65: *> \param[in] KU
   66: *> \verbatim
   67: *>          KU is INTEGER
   68: *>          The number of superdiagonals within the band of A.  KU >= 0.
   69: *> \endverbatim
   70: *>
   71: *> \param[in,out] AB
   72: *> \verbatim
   73: *>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
   74: *>          On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
   75: *>          The j-th column of A is stored in the j-th column of the
   76: *>          array AB as follows:
   77: *>          AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
   78: *>
   79: *>          On exit, the equilibrated matrix, in the same storage format
   80: *>          as A.  See EQUED for the form of the equilibrated matrix.
   81: *> \endverbatim
   82: *>
   83: *> \param[in] LDAB
   84: *> \verbatim
   85: *>          LDAB is INTEGER
   86: *>          The leading dimension of the array AB.  LDA >= KL+KU+1.
   87: *> \endverbatim
   88: *>
   89: *> \param[in] R
   90: *> \verbatim
   91: *>          R is DOUBLE PRECISION array, dimension (M)
   92: *>          The row scale factors for A.
   93: *> \endverbatim
   94: *>
   95: *> \param[in] C
   96: *> \verbatim
   97: *>          C is DOUBLE PRECISION array, dimension (N)
   98: *>          The column scale factors for A.
   99: *> \endverbatim
  100: *>
  101: *> \param[in] ROWCND
  102: *> \verbatim
  103: *>          ROWCND is DOUBLE PRECISION
  104: *>          Ratio of the smallest R(i) to the largest R(i).
  105: *> \endverbatim
  106: *>
  107: *> \param[in] COLCND
  108: *> \verbatim
  109: *>          COLCND is DOUBLE PRECISION
  110: *>          Ratio of the smallest C(i) to the largest C(i).
  111: *> \endverbatim
  112: *>
  113: *> \param[in] AMAX
  114: *> \verbatim
  115: *>          AMAX is DOUBLE PRECISION
  116: *>          Absolute value of largest matrix entry.
  117: *> \endverbatim
  118: *>
  119: *> \param[out] EQUED
  120: *> \verbatim
  121: *>          EQUED is CHARACTER*1
  122: *>          Specifies the form of equilibration that was done.
  123: *>          = 'N':  No equilibration
  124: *>          = 'R':  Row equilibration, i.e., A has been premultiplied by
  125: *>                  diag(R).
  126: *>          = 'C':  Column equilibration, i.e., A has been postmultiplied
  127: *>                  by diag(C).
  128: *>          = 'B':  Both row and column equilibration, i.e., A has been
  129: *>                  replaced by diag(R) * A * diag(C).
  130: *> \endverbatim
  131: *
  132: *> \par Internal Parameters:
  133: *  =========================
  134: *>
  135: *> \verbatim
  136: *>  THRESH is a threshold value used to decide if row or column scaling
  137: *>  should be done based on the ratio of the row or column scaling
  138: *>  factors.  If ROWCND < THRESH, row scaling is done, and if
  139: *>  COLCND < THRESH, column scaling is done.
  140: *>
  141: *>  LARGE and SMALL are threshold values used to decide if row scaling
  142: *>  should be done based on the absolute size of the largest matrix
  143: *>  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
  144: *> \endverbatim
  145: *
  146: *  Authors:
  147: *  ========
  148: *
  149: *> \author Univ. of Tennessee
  150: *> \author Univ. of California Berkeley
  151: *> \author Univ. of Colorado Denver
  152: *> \author NAG Ltd.
  153: *
  154: *> \ingroup doubleGBauxiliary
  155: *
  156: *  =====================================================================
  157:       SUBROUTINE DLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
  158:      $                   AMAX, EQUED )
  159: *
  160: *  -- LAPACK auxiliary routine --
  161: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  162: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  163: *
  164: *     .. Scalar Arguments ..
  165:       CHARACTER          EQUED
  166:       INTEGER            KL, KU, LDAB, M, N
  167:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
  168: *     ..
  169: *     .. Array Arguments ..
  170:       DOUBLE PRECISION   AB( LDAB, * ), C( * ), R( * )
  171: *     ..
  172: *
  173: *  =====================================================================
  174: *
  175: *     .. Parameters ..
  176:       DOUBLE PRECISION   ONE, THRESH
  177:       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
  178: *     ..
  179: *     .. Local Scalars ..
  180:       INTEGER            I, J
  181:       DOUBLE PRECISION   CJ, LARGE, SMALL
  182: *     ..
  183: *     .. External Functions ..
  184:       DOUBLE PRECISION   DLAMCH
  185:       EXTERNAL           DLAMCH
  186: *     ..
  187: *     .. Intrinsic Functions ..
  188:       INTRINSIC          MAX, MIN
  189: *     ..
  190: *     .. Executable Statements ..
  191: *
  192: *     Quick return if possible
  193: *
  194:       IF( M.LE.0 .OR. N.LE.0 ) THEN
  195:          EQUED = 'N'
  196:          RETURN
  197:       END IF
  198: *
  199: *     Initialize LARGE and SMALL.
  200: *
  201:       SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
  202:       LARGE = ONE / SMALL
  203: *
  204:       IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
  205:      $     THEN
  206: *
  207: *        No row scaling
  208: *
  209:          IF( COLCND.GE.THRESH ) THEN
  210: *
  211: *           No column scaling
  212: *
  213:             EQUED = 'N'
  214:          ELSE
  215: *
  216: *           Column scaling
  217: *
  218:             DO 20 J = 1, N
  219:                CJ = C( J )
  220:                DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
  221:                   AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
  222:    10          CONTINUE
  223:    20       CONTINUE
  224:             EQUED = 'C'
  225:          END IF
  226:       ELSE IF( COLCND.GE.THRESH ) THEN
  227: *
  228: *        Row scaling, no column scaling
  229: *
  230:          DO 40 J = 1, N
  231:             DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
  232:                AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
  233:    30       CONTINUE
  234:    40    CONTINUE
  235:          EQUED = 'R'
  236:       ELSE
  237: *
  238: *        Row and column scaling
  239: *
  240:          DO 60 J = 1, N
  241:             CJ = C( J )
  242:             DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
  243:                AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
  244:    50       CONTINUE
  245:    60    CONTINUE
  246:          EQUED = 'B'
  247:       END IF
  248: *
  249:       RETURN
  250: *
  251: *     End of DLAQGB
  252: *
  253:       END

CVSweb interface <joel.bertrand@systella.fr>