1*> \brief \b CLAQHE scales a Hermitian matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLAQHE + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqhe.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqhe.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqhe.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          EQUED, UPLO
25*       INTEGER            LDA, N
26*       REAL               AMAX, SCOND
27*       ..
28*       .. Array Arguments ..
29*       REAL               S( * )
30*       COMPLEX            A( LDA, * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> CLAQHE equilibrates a Hermitian matrix A using the scaling factors
40*> in the vector S.
41*> \endverbatim
42*
43*  Arguments:
44*  ==========
45*
46*> \param[in] UPLO
47*> \verbatim
48*>          UPLO is CHARACTER*1
49*>          Specifies whether the upper or lower triangular part of the
50*>          Hermitian matrix A is stored.
51*>          = 'U':  Upper triangular
52*>          = 'L':  Lower triangular
53*> \endverbatim
54*>
55*> \param[in] N
56*> \verbatim
57*>          N is INTEGER
58*>          The order of the matrix A.  N >= 0.
59*> \endverbatim
60*>
61*> \param[in,out] A
62*> \verbatim
63*>          A is COMPLEX array, dimension (LDA,N)
64*>          On entry, the Hermitian matrix A.  If UPLO = 'U', the leading
65*>          n by n upper triangular part of A contains the upper
66*>          triangular part of the matrix A, and the strictly lower
67*>          triangular part of A is not referenced.  If UPLO = 'L', the
68*>          leading n by n lower triangular part of A contains the lower
69*>          triangular part of the matrix A, and the strictly upper
70*>          triangular part of A is not referenced.
71*>
72*>          On exit, if EQUED = 'Y', the equilibrated matrix:
73*>          diag(S) * A * diag(S).
74*> \endverbatim
75*>
76*> \param[in] LDA
77*> \verbatim
78*>          LDA is INTEGER
79*>          The leading dimension of the array A.  LDA >= max(N,1).
80*> \endverbatim
81*>
82*> \param[in] S
83*> \verbatim
84*>          S is REAL array, dimension (N)
85*>          The scale factors for A.
86*> \endverbatim
87*>
88*> \param[in] SCOND
89*> \verbatim
90*>          SCOND is REAL
91*>          Ratio of the smallest S(i) to the largest S(i).
92*> \endverbatim
93*>
94*> \param[in] AMAX
95*> \verbatim
96*>          AMAX is REAL
97*>          Absolute value of largest matrix entry.
98*> \endverbatim
99*>
100*> \param[out] EQUED
101*> \verbatim
102*>          EQUED is CHARACTER*1
103*>          Specifies whether or not equilibration was done.
104*>          = 'N':  No equilibration.
105*>          = 'Y':  Equilibration was done, i.e., A has been replaced by
106*>                  diag(S) * A * diag(S).
107*> \endverbatim
108*
109*> \par Internal Parameters:
110*  =========================
111*>
112*> \verbatim
113*>  THRESH is a threshold value used to decide if scaling should be done
114*>  based on the ratio of the scaling factors.  If SCOND < THRESH,
115*>  scaling is done.
116*>
117*>  LARGE and SMALL are threshold values used to decide if scaling should
118*>  be done based on the absolute size of the largest matrix element.
119*>  If AMAX > LARGE or AMAX < SMALL, scaling is done.
120*> \endverbatim
121*
122*  Authors:
123*  ========
124*
125*> \author Univ. of Tennessee
126*> \author Univ. of California Berkeley
127*> \author Univ. of Colorado Denver
128*> \author NAG Ltd.
129*
130*> \ingroup complexHEauxiliary
131*
132*  =====================================================================
133      SUBROUTINE CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
134*
135*  -- LAPACK auxiliary routine --
136*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
137*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
138*
139*     .. Scalar Arguments ..
140      CHARACTER          EQUED, UPLO
141      INTEGER            LDA, N
142      REAL               AMAX, SCOND
143*     ..
144*     .. Array Arguments ..
145      REAL               S( * )
146      COMPLEX            A( LDA, * )
147*     ..
148*
149*  =====================================================================
150*
151*     .. Parameters ..
152      REAL               ONE, THRESH
153      PARAMETER          ( ONE = 1.0E+0, THRESH = 0.1E+0 )
154*     ..
155*     .. Local Scalars ..
156      INTEGER            I, J
157      REAL               CJ, LARGE, SMALL
158*     ..
159*     .. External Functions ..
160      LOGICAL            LSAME
161      REAL               SLAMCH
162      EXTERNAL           LSAME, SLAMCH
163*     ..
164*     .. Intrinsic Functions ..
165      INTRINSIC          REAL
166*     ..
167*     .. Executable Statements ..
168*
169*     Quick return if possible
170*
171      IF( N.LE.0 ) THEN
172         EQUED = 'N'
173         RETURN
174      END IF
175*
176*     Initialize LARGE and SMALL.
177*
178      SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
179      LARGE = ONE / SMALL
180*
181      IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
182*
183*        No equilibration
184*
185         EQUED = 'N'
186      ELSE
187*
188*        Replace A by diag(S) * A * diag(S).
189*
190         IF( LSAME( UPLO, 'U' ) ) THEN
191*
192*           Upper triangle of A is stored.
193*
194            DO 20 J = 1, N
195               CJ = S( J )
196               DO 10 I = 1, J - 1
197                  A( I, J ) = CJ*S( I )*A( I, J )
198   10          CONTINUE
199               A( J, J ) = CJ*CJ*REAL( A( J, J ) )
200   20       CONTINUE
201         ELSE
202*
203*           Lower triangle of A is stored.
204*
205            DO 40 J = 1, N
206               CJ = S( J )
207               A( J, J ) = CJ*CJ*REAL( A( J, J ) )
208               DO 30 I = J + 1, N
209                  A( I, J ) = CJ*S( I )*A( I, J )
210   30          CONTINUE
211   40       CONTINUE
212         END IF
213         EQUED = 'Y'
214      END IF
215*
216      RETURN
217*
218*     End of CLAQHE
219*
220      END
221