SRC/slaqge.f

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