/src/igraph/vendor/lapack/dlassq.c
Line | Count | Source (jump to first uncovered line) |
1 | | /* -- translated by f2c (version 20191129). |
2 | | You must link the resulting object file with libf2c: |
3 | | on Microsoft Windows system, link with libf2c.lib; |
4 | | on Linux or Unix systems, link with .../path/to/libf2c.a -lm |
5 | | or, if you install libf2c.a in a standard place, with -lf2c -lm |
6 | | -- in that order, at the end of the command line, as in |
7 | | cc *.o -lf2c -lm |
8 | | Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., |
9 | | |
10 | | http://www.netlib.org/f2c/libf2c.zip |
11 | | */ |
12 | | |
13 | | #include "f2c.h" |
14 | | |
15 | | /* > \brief \b DLASSQ updates a sum of squares represented in scaled form. |
16 | | |
17 | | =========== DOCUMENTATION =========== |
18 | | |
19 | | Online html documentation available at |
20 | | http://www.netlib.org/lapack/explore-html/ |
21 | | |
22 | | > \htmlonly |
23 | | > Download DLASSQ + dependencies |
24 | | > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq. |
25 | | f"> |
26 | | > [TGZ]</a> |
27 | | > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq. |
28 | | f"> |
29 | | > [ZIP]</a> |
30 | | > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq. |
31 | | f"> |
32 | | > [TXT]</a> |
33 | | > \endhtmlonly |
34 | | |
35 | | Definition: |
36 | | =========== |
37 | | |
38 | | SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ ) |
39 | | |
40 | | INTEGER INCX, N |
41 | | DOUBLE PRECISION SCALE, SUMSQ |
42 | | DOUBLE PRECISION X( * ) |
43 | | |
44 | | |
45 | | > \par Purpose: |
46 | | ============= |
47 | | > |
48 | | > \verbatim |
49 | | > |
50 | | > DLASSQ returns the values scl and smsq such that |
51 | | > |
52 | | > ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, |
53 | | > |
54 | | > where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is |
55 | | > assumed to be non-negative and scl returns the value |
56 | | > |
57 | | > scl = max( scale, abs( x( i ) ) ). |
58 | | > |
59 | | > scale and sumsq must be supplied in SCALE and SUMSQ and |
60 | | > scl and smsq are overwritten on SCALE and SUMSQ respectively. |
61 | | > |
62 | | > The routine makes only one pass through the vector x. |
63 | | > \endverbatim |
64 | | |
65 | | Arguments: |
66 | | ========== |
67 | | |
68 | | > \param[in] N |
69 | | > \verbatim |
70 | | > N is INTEGER |
71 | | > The number of elements to be used from the vector X. |
72 | | > \endverbatim |
73 | | > |
74 | | > \param[in] X |
75 | | > \verbatim |
76 | | > X is DOUBLE PRECISION array, dimension (N) |
77 | | > The vector for which a scaled sum of squares is computed. |
78 | | > x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. |
79 | | > \endverbatim |
80 | | > |
81 | | > \param[in] INCX |
82 | | > \verbatim |
83 | | > INCX is INTEGER |
84 | | > The increment between successive values of the vector X. |
85 | | > INCX > 0. |
86 | | > \endverbatim |
87 | | > |
88 | | > \param[in,out] SCALE |
89 | | > \verbatim |
90 | | > SCALE is DOUBLE PRECISION |
91 | | > On entry, the value scale in the equation above. |
92 | | > On exit, SCALE is overwritten with scl , the scaling factor |
93 | | > for the sum of squares. |
94 | | > \endverbatim |
95 | | > |
96 | | > \param[in,out] SUMSQ |
97 | | > \verbatim |
98 | | > SUMSQ is DOUBLE PRECISION |
99 | | > On entry, the value sumsq in the equation above. |
100 | | > On exit, SUMSQ is overwritten with smsq , the basic sum of |
101 | | > squares from which scl has been factored out. |
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 September 2012 |
113 | | |
114 | | > \ingroup auxOTHERauxiliary |
115 | | |
116 | | ===================================================================== |
117 | | Subroutine */ int igraphdlassq_(integer *n, doublereal *x, integer *incx, |
118 | | doublereal *scale, doublereal *sumsq) |
119 | 0 | { |
120 | | /* System generated locals */ |
121 | 0 | integer i__1, i__2; |
122 | 0 | doublereal d__1; |
123 | | |
124 | | /* Local variables */ |
125 | 0 | integer ix; |
126 | 0 | doublereal absxi; |
127 | 0 | extern logical igraphdisnan_(doublereal *); |
128 | | |
129 | | |
130 | | /* -- LAPACK auxiliary routine (version 3.4.2) -- |
131 | | -- LAPACK is a software package provided by Univ. of Tennessee, -- |
132 | | -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
133 | | September 2012 |
134 | | |
135 | | |
136 | | ===================================================================== |
137 | | |
138 | | |
139 | | Parameter adjustments */ |
140 | 0 | --x; |
141 | | |
142 | | /* Function Body */ |
143 | 0 | if (*n > 0) { |
144 | 0 | i__1 = (*n - 1) * *incx + 1; |
145 | 0 | i__2 = *incx; |
146 | 0 | for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { |
147 | 0 | absxi = (d__1 = x[ix], abs(d__1)); |
148 | 0 | if (absxi > 0. || igraphdisnan_(&absxi)) { |
149 | 0 | if (*scale < absxi) { |
150 | | /* Computing 2nd power */ |
151 | 0 | d__1 = *scale / absxi; |
152 | 0 | *sumsq = *sumsq * (d__1 * d__1) + 1; |
153 | 0 | *scale = absxi; |
154 | 0 | } else { |
155 | | /* Computing 2nd power */ |
156 | 0 | d__1 = absxi / *scale; |
157 | 0 | *sumsq += d__1 * d__1; |
158 | 0 | } |
159 | 0 | } |
160 | | /* L10: */ |
161 | 0 | } |
162 | 0 | } |
163 | 0 | return 0; |
164 | | |
165 | | /* End of DLASSQ */ |
166 | |
|
167 | 0 | } /* igraphdlassq_ */ |
168 | | |