1*> \brief \b CLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLAQSY + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqsy.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqsy.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqsy.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CLAQSY( 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*> CLAQSY equilibrates a symmetric 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*>          symmetric 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 symmetric 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 complexSYauxiliary
131*
132*  =====================================================================
133      SUBROUTINE CLAQSY( 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*     .. Executable Statements ..
165*
166*     Quick return if possible
167*
168      IF( N.LE.0 ) THEN
169         EQUED = 'N'
170         RETURN
171      END IF
172*
173*     Initialize LARGE and SMALL.
174*
175      SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
176      LARGE = ONE / SMALL
177*
178      IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
179*
180*        No equilibration
181*
182         EQUED = 'N'
183      ELSE
184*
185*        Replace A by diag(S) * A * diag(S).
186*
187         IF( LSAME( UPLO, 'U' ) ) THEN
188*
189*           Upper triangle of A is stored.
190*
191            DO 20 J = 1, N
192               CJ = S( J )
193               DO 10 I = 1, J
194                  A( I, J ) = CJ*S( I )*A( I, J )
195   10          CONTINUE
196   20       CONTINUE
197         ELSE
198*
199*           Lower triangle of A is stored.
200*
201            DO 40 J = 1, N
202               CJ = S( J )
203               DO 30 I = J, N
204                  A( I, J ) = CJ*S( I )*A( I, J )
205   30          CONTINUE
206   40       CONTINUE
207         END IF
208         EQUED = 'Y'
209      END IF
210*
211      RETURN
212*
213*     End of CLAQSY
214*
215      END
216