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