001:       SUBROUTINE DPOEQU( N, A, LDA, S, SCOND, AMAX, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            INFO, LDA, N
010:       DOUBLE PRECISION   AMAX, SCOND
011: *     ..
012: *     .. Array Arguments ..
013:       DOUBLE PRECISION   A( LDA, * ), S( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DPOEQU computes row and column scalings intended to equilibrate a
020: *  symmetric positive definite matrix A and reduce its condition number
021: *  (with respect to the two-norm).  S contains the scale factors,
022: *  S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
023: *  elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal.  This
024: *  choice of S puts the condition number of B within a factor N of the
025: *  smallest possible condition number over all possible diagonal
026: *  scalings.
027: *
028: *  Arguments
029: *  =========
030: *
031: *  N       (input) INTEGER
032: *          The order of the matrix A.  N >= 0.
033: *
034: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
035: *          The N-by-N symmetric positive definite matrix whose scaling
036: *          factors are to be computed.  Only the diagonal elements of A
037: *          are referenced.
038: *
039: *  LDA     (input) INTEGER
040: *          The leading dimension of the array A.  LDA >= max(1,N).
041: *
042: *  S       (output) DOUBLE PRECISION array, dimension (N)
043: *          If INFO = 0, S contains the scale factors for A.
044: *
045: *  SCOND   (output) DOUBLE PRECISION
046: *          If INFO = 0, S contains the ratio of the smallest S(i) to
047: *          the largest S(i).  If SCOND >= 0.1 and AMAX is neither too
048: *          large nor too small, it is not worth scaling by S.
049: *
050: *  AMAX    (output) DOUBLE PRECISION
051: *          Absolute value of largest matrix element.  If AMAX is very
052: *          close to overflow or very close to underflow, the matrix
053: *          should be scaled.
054: *
055: *  INFO    (output) INTEGER
056: *          = 0:  successful exit
057: *          < 0:  if INFO = -i, the i-th argument had an illegal value
058: *          > 0:  if INFO = i, the i-th diagonal element is nonpositive.
059: *
060: *  =====================================================================
061: *
062: *     .. Parameters ..
063:       DOUBLE PRECISION   ZERO, ONE
064:       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
065: *     ..
066: *     .. Local Scalars ..
067:       INTEGER            I
068:       DOUBLE PRECISION   SMIN
069: *     ..
070: *     .. External Subroutines ..
071:       EXTERNAL           XERBLA
072: *     ..
073: *     .. Intrinsic Functions ..
074:       INTRINSIC          MAX, MIN, SQRT
075: *     ..
076: *     .. Executable Statements ..
077: *
078: *     Test the input parameters.
079: *
080:       INFO = 0
081:       IF( N.LT.0 ) THEN
082:          INFO = -1
083:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
084:          INFO = -3
085:       END IF
086:       IF( INFO.NE.0 ) THEN
087:          CALL XERBLA( 'DPOEQU', -INFO )
088:          RETURN
089:       END IF
090: *
091: *     Quick return if possible
092: *
093:       IF( N.EQ.0 ) THEN
094:          SCOND = ONE
095:          AMAX = ZERO
096:          RETURN
097:       END IF
098: *
099: *     Find the minimum and maximum diagonal elements.
100: *
101:       S( 1 ) = A( 1, 1 )
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
138: