ENH: Improving the travis dashboard name
[platform/upstream/lapack.git] / SRC / dlassq.f
1 *> \brief \b DLASSQ updates a sum of squares represented in scaled form.
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 *            http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DLASSQ + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
22 *
23 *       .. Scalar Arguments ..
24 *       INTEGER            INCX, N
25 *       DOUBLE PRECISION   SCALE, SUMSQ
26 *       ..
27 *       .. Array Arguments ..
28 *       DOUBLE PRECISION   X( * )
29 *       ..
30 *
31 *
32 *> \par Purpose:
33 *  =============
34 *>
35 *> \verbatim
36 *>
37 *> DLASSQ  returns the values  scl  and  smsq  such that
38 *>
39 *>    ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
40 *>
41 *> where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
42 *> assumed to be non-negative and  scl  returns the value
43 *>
44 *>    scl = max( scale, abs( x( i ) ) ).
45 *>
46 *> scale and sumsq must be supplied in SCALE and SUMSQ and
47 *> scl and smsq are overwritten on SCALE and SUMSQ respectively.
48 *>
49 *> The routine makes only one pass through the vector x.
50 *> \endverbatim
51 *
52 *  Arguments:
53 *  ==========
54 *
55 *> \param[in] N
56 *> \verbatim
57 *>          N is INTEGER
58 *>          The number of elements to be used from the vector X.
59 *> \endverbatim
60 *>
61 *> \param[in] X
62 *> \verbatim
63 *>          X is DOUBLE PRECISION array, dimension (N)
64 *>          The vector for which a scaled sum of squares is computed.
65 *>             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
66 *> \endverbatim
67 *>
68 *> \param[in] INCX
69 *> \verbatim
70 *>          INCX is INTEGER
71 *>          The increment between successive values of the vector X.
72 *>          INCX > 0.
73 *> \endverbatim
74 *>
75 *> \param[in,out] SCALE
76 *> \verbatim
77 *>          SCALE is DOUBLE PRECISION
78 *>          On entry, the value  scale  in the equation above.
79 *>          On exit, SCALE is overwritten with  scl , the scaling factor
80 *>          for the sum of squares.
81 *> \endverbatim
82 *>
83 *> \param[in,out] SUMSQ
84 *> \verbatim
85 *>          SUMSQ is DOUBLE PRECISION
86 *>          On entry, the value  sumsq  in the equation above.
87 *>          On exit, SUMSQ is overwritten with  smsq , the basic sum of
88 *>          squares from which  scl  has been factored out.
89 *> \endverbatim
90 *
91 *  Authors:
92 *  ========
93 *
94 *> \author Univ. of Tennessee
95 *> \author Univ. of California Berkeley
96 *> \author Univ. of Colorado Denver
97 *> \author NAG Ltd.
98 *
99 *> \date September 2012
100 *
101 *> \ingroup auxOTHERauxiliary
102 *
103 *  =====================================================================
104       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
105 *
106 *  -- LAPACK auxiliary routine (version 3.4.2) --
107 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
108 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109 *     September 2012
110 *
111 *     .. Scalar Arguments ..
112       INTEGER            INCX, N
113       DOUBLE PRECISION   SCALE, SUMSQ
114 *     ..
115 *     .. Array Arguments ..
116       DOUBLE PRECISION   X( * )
117 *     ..
118 *
119 * =====================================================================
120 *
121 *     .. Parameters ..
122       DOUBLE PRECISION   ZERO
123       PARAMETER          ( ZERO = 0.0D+0 )
124 *     ..
125 *     .. Local Scalars ..
126       INTEGER            IX
127       DOUBLE PRECISION   ABSXI
128 *     ..
129 *     .. External Functions ..
130       LOGICAL            DISNAN
131       EXTERNAL           DISNAN
132 *     ..
133 *     .. Intrinsic Functions ..
134       INTRINSIC          ABS
135 *     ..
136 *     .. Executable Statements ..
137 *
138       IF( N.GT.0 ) THEN
139          DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
140             ABSXI = ABS( X( IX ) )
141             IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
142                IF( SCALE.LT.ABSXI ) THEN
143                   SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
144                   SCALE = ABSXI
145                ELSE
146                   SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
147                END IF
148             END IF
149    10    CONTINUE
150       END IF
151       RETURN
152 *
153 *     End of DLASSQ
154 *
155       END