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