~ubuntu-branches/ubuntu/lucid/igraph/lucid

« back to all changes in this revision

Viewing changes to src/blas/dnrm2.c

  • Committer: Bazaar Package Importer
  • Author(s): Mathieu Malaterre
  • Date: 2009-11-16 18:12:42 UTC
  • Revision ID: james.westby@ubuntu.com-20091116181242-mzv9p5fz9uj57xd1
Tags: upstream-0.5.3
ImportĀ upstreamĀ versionĀ 0.5.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*  -- translated by f2c (version 20050501).
 
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 "config.h"
 
14
#include "arpack_internal.h"
 
15
#include "f2c.h"
 
16
 
 
17
doublereal igraphdnrm2_(integer *n, doublereal *x, integer *incx)
 
18
{
 
19
    /* System generated locals */
 
20
    integer i__1, i__2;
 
21
    doublereal ret_val, d__1;
 
22
 
 
23
    /* Builtin functions */
 
24
    double sqrt(doublereal);
 
25
 
 
26
    /* Local variables */
 
27
    static integer ix;
 
28
    static doublereal ssq, norm, scale, absxi;
 
29
 
 
30
/*     .. Scalar Arguments .. */
 
31
/*     .. Array Arguments .. */
 
32
/*     .. */
 
33
 
 
34
/*  DNRM2 returns the euclidean norm of a vector via the function */
 
35
/*  name, so that */
 
36
 
 
37
/*     DNRM2 := sqrt( x'*x ) */
 
38
 
 
39
 
 
40
 
 
41
/*  -- This version written on 25-October-1982. */
 
42
/*     Modified on 14-October-1993 to inline the call to DLASSQ. */
 
43
/*     Sven Hammarling, Nag Ltd. */
 
44
 
 
45
 
 
46
/*     .. Parameters .. */
 
47
/*     .. Local Scalars .. */
 
48
/*     .. Intrinsic Functions .. */
 
49
/*     .. */
 
50
/*     .. Executable Statements .. */
 
51
    /* Parameter adjustments */
 
52
    --x;
 
53
 
 
54
    /* Function Body */
 
55
    if (*n < 1 || *incx < 1) {
 
56
        norm = 0.;
 
57
    } else if (*n == 1) {
 
58
        norm = abs(x[1]);
 
59
    } else {
 
60
        scale = 0.;
 
61
        ssq = 1.;
 
62
/*        The following loop is equivalent to this call to the LAPACK */
 
63
/*        auxiliary routine: */
 
64
/*        CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
 
65
 
 
66
        i__1 = (*n - 1) * *incx + 1;
 
67
        i__2 = *incx;
 
68
        for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
 
69
            if (x[ix] != 0.) {
 
70
                absxi = (d__1 = x[ix], abs(d__1));
 
71
                if (scale < absxi) {
 
72
/* Computing 2nd power */
 
73
                    d__1 = scale / absxi;
 
74
                    ssq = ssq * (d__1 * d__1) + 1.;
 
75
                    scale = absxi;
 
76
                } else {
 
77
/* Computing 2nd power */
 
78
                    d__1 = absxi / scale;
 
79
                    ssq += d__1 * d__1;
 
80
                }
 
81
            }
 
82
/* L10: */
 
83
        }
 
84
        norm = scale * sqrt(ssq);
 
85
    }
 
86
 
 
87
    ret_val = norm;
 
88
    return ret_val;
 
89
 
 
90
/*     End of DNRM2. */
 
91
 
 
92
} /* igraphdnrm2_ */
 
93