SRC/cgeequ.f

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