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