SRC/sgeequ.f

   1 *> \brief \b SGEEQU
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SGEEQU + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeequ.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeequ.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeequ.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
  22 *                          INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       INTEGER            INFO, LDA, M, N
  26 *       REAL               AMAX, COLCND, ROWCND
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       REAL               A( LDA, * ), C( * ), R( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> SGEEQU 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 REAL 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 REAL 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 REAL 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 REAL
  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 REAL
 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 REAL
 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 realGEcomputational
 137 *
 138 *  =====================================================================
 139       SUBROUTINE SGEEQU( 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       REAL               AMAX, COLCND, ROWCND
 150 *     ..
 151 *     .. Array Arguments ..
 152       REAL               A( LDA, * ), C( * ), R( * )
 153 *     ..
 154 *
 155 *  =====================================================================
 156 *
 157 *     .. Parameters ..
 158       REAL               ONE, ZERO
 159       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 160 *     ..
 161 *     .. Local Scalars ..
 162       INTEGER            I, J
 163       REAL               BIGNUM, RCMAX, RCMIN, SMLNUM
 164 *     ..
 165 *     .. External Functions ..
 166       REAL               SLAMCH
 167       EXTERNAL           SLAMCH
 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( 'SGEEQU', -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 = SLAMCH( '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 SGEEQU
 303 *
 304       END