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