1       SUBROUTINE DPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
  2 *
  3 *  -- LAPACK routine (version 3.2) --
  4 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  5 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  6 *     November 2006
  7 *
  8 *     .. Scalar Arguments ..
  9       INTEGER            INFO, LDA, N
 10       DOUBLE PRECISION   AMAX, SCOND
 11 *     ..
 12 *     .. Array Arguments ..
 13       DOUBLE PRECISION   A( LDA, * ), S( * )
 14 *     ..
 15 *
 16 *  Purpose
 17 *  =======
 18 *
 19 *  DPOEQU computes row and column scalings intended to equilibrate a
 20 *  symmetric positive definite matrix A and reduce its condition number
 21 *  (with respect to the two-norm).  S contains the scale factors,
 22 *  S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
 23 *  elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal.  This
 24 *  choice of S puts the condition number of B within a factor N of the
 25 *  smallest possible condition number over all possible diagonal
 26 *  scalings.
 27 *
 28 *  Arguments
 29 *  =========
 30 *
 31 *  N       (input) INTEGER
 32 *          The order of the matrix A.  N >= 0.
 33 *
 34 *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
 35 *          The N-by-N symmetric positive definite matrix whose scaling
 36 *          factors are to be computed.  Only the diagonal elements of A
 37 *          are referenced.
 38 *
 39 *  LDA     (input) INTEGER
 40 *          The leading dimension of the array A.  LDA >= max(1,N).
 41 *
 42 *  S       (output) DOUBLE PRECISION array, dimension (N)
 43 *          If INFO = 0, S contains the scale factors for A.
 44 *
 45 *  SCOND   (output) DOUBLE PRECISION
 46 *          If INFO = 0, S contains the ratio of the smallest S(i) to
 47 *          the largest S(i).  If SCOND >= 0.1 and AMAX is neither too
 48 *          large nor too small, it is not worth scaling by S.
 49 *
 50 *  AMAX    (output) DOUBLE PRECISION
 51 *          Absolute value of largest matrix element.  If AMAX is very
 52 *          close to overflow or very close to underflow, the matrix
 53 *          should be scaled.
 54 *
 55 *  INFO    (output) INTEGER
 56 *          = 0:  successful exit
 57 *          < 0:  if INFO = -i, the i-th argument had an illegal value
 58 *          > 0:  if INFO = i, the i-th diagonal element is nonpositive.
 59 *
 60 *  =====================================================================
 61 *
 62 *     .. Parameters ..
 63       DOUBLE PRECISION   ZERO, ONE
 64       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 65 *     ..
 66 *     .. Local Scalars ..
 67       INTEGER            I
 68       DOUBLE PRECISION   SMIN
 69 *     ..
 70 *     .. External Subroutines ..
 71       EXTERNAL           XERBLA
 72 *     ..
 73 *     .. Intrinsic Functions ..
 74       INTRINSIC          MAXMINSQRT
 75 *     ..
 76 *     .. Executable Statements ..
 77 *
 78 *     Test the input parameters.
 79 *
 80       INFO = 0
 81       IF( N.LT.0 ) THEN
 82          INFO = -1
 83       ELSE IF( LDA.LT.MAX1, N ) ) THEN
 84          INFO = -3
 85       END IF
 86       IF( INFO.NE.0 ) THEN
 87          CALL XERBLA( 'DPOEQU'-INFO )
 88          RETURN
 89       END IF
 90 *
 91 *     Quick return if possible
 92 *
 93       IF( N.EQ.0 ) THEN
 94          SCOND = ONE
 95          AMAX = ZERO
 96          RETURN
 97       END IF
 98 *
 99 *     Find the minimum and maximum diagonal elements.
100 *
101       S( 1 ) = A( 11 )
102       SMIN = S( 1 )
103       AMAX = S( 1 )
104       DO 10 I = 2, N
105          S( I ) = A( I, I )
106          SMIN = MIN( SMIN, S( I ) )
107          AMAX = MAX( AMAX, S( I ) )
108    10 CONTINUE
109 *
110       IF( SMIN.LE.ZERO ) THEN
111 *
112 *        Find the first non-positive diagonal element and return.
113 *
114          DO 20 I = 1, N
115             IF( S( I ).LE.ZERO ) THEN
116                INFO = I
117                RETURN
118             END IF
119    20    CONTINUE
120       ELSE
121 *
122 *        Set the scale factors to the reciprocals
123 *        of the diagonal elements.
124 *
125          DO 30 I = 1, N
126             S( I ) = ONE / SQRT( S( I ) )
127    30    CONTINUE
128 *
129 *        Compute SCOND = min(S(I)) / max(S(I))
130 *
131          SCOND = SQRT( SMIN ) / SQRT( AMAX )
132       END IF
133       RETURN
134 *
135 *     End of DPOEQU
136 *
137       END