SRC/spoequb.f

   1 *> \brief \b SPOEQUB
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SPOEQUB + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spoequb.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spoequb.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spoequb.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       INTEGER            INFO, LDA, N
  25 *       REAL               AMAX, SCOND
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       REAL               A( LDA, * ), S( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> SPOEQU computes row and column scalings intended to equilibrate a
  38 *> symmetric positive definite matrix A and reduce its condition number
  39 *> (with respect to the two-norm).  S contains the scale factors,
  40 *> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
  41 *> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal.  This
  42 *> choice of S puts the condition number of B within a factor N of the
  43 *> smallest possible condition number over all possible diagonal
  44 *> scalings.
  45 *> \endverbatim
  46 *
  47 *  Arguments:
  48 *  ==========
  49 *
  50 *> \param[in] N
  51 *> \verbatim
  52 *>          N is INTEGER
  53 *>          The order of the matrix A.  N >= 0.
  54 *> \endverbatim
  55 *>
  56 *> \param[in] A
  57 *> \verbatim
  58 *>          A is REAL array, dimension (LDA,N)
  59 *>          The N-by-N symmetric positive definite matrix whose scaling
  60 *>          factors are to be computed.  Only the diagonal elements of A
  61 *>          are referenced.
  62 *> \endverbatim
  63 *>
  64 *> \param[in] LDA
  65 *> \verbatim
  66 *>          LDA is INTEGER
  67 *>          The leading dimension of the array A.  LDA >= max(1,N).
  68 *> \endverbatim
  69 *>
  70 *> \param[out] S
  71 *> \verbatim
  72 *>          S is REAL array, dimension (N)
  73 *>          If INFO = 0, S contains the scale factors for A.
  74 *> \endverbatim
  75 *>
  76 *> \param[out] SCOND
  77 *> \verbatim
  78 *>          SCOND is REAL
  79 *>          If INFO = 0, S contains the ratio of the smallest S(i) to
  80 *>          the largest S(i).  If SCOND >= 0.1 and AMAX is neither too
  81 *>          large nor too small, it is not worth scaling by S.
  82 *> \endverbatim
  83 *>
  84 *> \param[out] AMAX
  85 *> \verbatim
  86 *>          AMAX is REAL
  87 *>          Absolute value of largest matrix element.  If AMAX is very
  88 *>          close to overflow or very close to underflow, the matrix
  89 *>          should be scaled.
  90 *> \endverbatim
  91 *>
  92 *> \param[out] INFO
  93 *> \verbatim
  94 *>          INFO is INTEGER
  95 *>          = 0:  successful exit
  96 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  97 *>          > 0:  if INFO = i, the i-th diagonal element is nonpositive.
  98 *> \endverbatim
  99 *
 100 *  Authors:
 101 *  ========
 102 *
 103 *> \author Univ. of Tennessee
 104 *> \author Univ. of California Berkeley
 105 *> \author Univ. of Colorado Denver
 106 *> \author NAG Ltd.
 107 *
 108 *> \date November 2011
 109 *
 110 *> \ingroup realPOcomputational
 111 *
 112 *  =====================================================================
 113       SUBROUTINE SPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
 114 *
 115 *  -- LAPACK computational routine (version 3.4.0) --
 116 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 117 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 118 *     November 2011
 119 *
 120 *     .. Scalar Arguments ..
 121       INTEGER            INFO, LDA, N
 122       REAL               AMAX, SCOND
 123 *     ..
 124 *     .. Array Arguments ..
 125       REAL               A( LDA, * ), S( * )
 126 *     ..
 127 *
 128 *  =====================================================================
 129 *
 130 *     .. Parameters ..
 131       REAL               ZERO, ONE
 132       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
 133 *     ..
 134 *     .. Local Scalars ..
 135       INTEGER            I
 136       REAL               SMIN, BASE, TMP
 137 *     ..
 138 *     .. External Functions ..
 139       REAL               SLAMCH
 140       EXTERNAL           SLAMCH
 141 *     ..
 142 *     .. External Subroutines ..
 143       EXTERNAL           XERBLA
 144 *     ..
 145 *     .. Intrinsic Functions ..
 146       INTRINSIC          MAX, MIN, SQRT, LOG, INT
 147 *     ..
 148 *     .. Executable Statements ..
 149 *
 150 *     Test the input parameters.
 151 *
 152 *     Positive definite only performs 1 pass of equilibration.
 153 *
 154       INFO = 0
 155       IF( N.LT.0 ) THEN
 156          INFO = -1
 157       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 158          INFO = -3
 159       END IF
 160       IF( INFO.NE.0 ) THEN
 161          CALL XERBLA( 'SPOEQUB', -INFO )
 162          RETURN
 163       END IF
 164 *
 165 *     Quick return if possible.
 166 *
 167       IF( N.EQ.0 ) THEN
 168          SCOND = ONE
 169          AMAX = ZERO
 170          RETURN
 171       END IF
 172
 173       BASE = SLAMCH( 'B' )
 174       TMP = -0.5 / LOG ( BASE )
 175 *
 176 *     Find the minimum and maximum diagonal elements.
 177 *
 178       S( 1 ) = A( 1, 1 )
 179       SMIN = S( 1 )
 180       AMAX = S( 1 )
 181       DO 10 I = 2, N
 182          S( I ) = A( I, I )
 183          SMIN = MIN( SMIN, S( I ) )
 184          AMAX = MAX( AMAX, S( I ) )
 185    10 CONTINUE
 186 *
 187       IF( SMIN.LE.ZERO ) THEN
 188 *
 189 *        Find the first non-positive diagonal element and return.
 190 *
 191          DO 20 I = 1, N
 192             IF( S( I ).LE.ZERO ) THEN
 193                INFO = I
 194                RETURN
 195             END IF
 196    20    CONTINUE
 197       ELSE
 198 *
 199 *        Set the scale factors to the reciprocals
 200 *        of the diagonal elements.
 201 *
 202          DO 30 I = 1, N
 203             S( I ) = BASE ** INT( TMP * LOG( S( I ) ) )
 204    30    CONTINUE
 205 *
 206 *        Compute SCOND = min(S(I)) / max(S(I)).
 207 *
 208          SCOND = SQRT( SMIN ) / SQRT( AMAX )
 209       END IF
 210 *
 211       RETURN
 212 *
 213 *     End of SPOEQUB
 214 *
 215       END