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