LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
snrm2.f
Go to the documentation of this file.
1 *> \brief \b SNRM2
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * REAL FUNCTION SNRM2(N,X,INCX)
12 *
13 * .. Scalar Arguments ..
14 * INTEGER INCX,N
15 * ..
16 * .. Array Arguments ..
17 * REAL X(*)
18 * ..
19 *
20 *
21 *> \par Purpose:
22 * =============
23 *>
24 *> \verbatim
25 *>
26 *> SNRM2 returns the euclidean norm of a vector via the function
27 *> name, so that
28 *>
29 *> SNRM2 := sqrt( x'*x ).
30 *> \endverbatim
31 *
32 * Authors:
33 * ========
34 *
35 *> \author Univ. of Tennessee
36 *> \author Univ. of California Berkeley
37 *> \author Univ. of Colorado Denver
38 *> \author NAG Ltd.
39 *
40 *> \date November 2011
41 *
42 *> \ingroup single_blas_level1
43 *
44 *> \par Further Details:
45 * =====================
46 *>
47 *> \verbatim
48 *>
49 *> -- This version written on 25-October-1982.
50 *> Modified on 14-October-1993 to inline the call to SLASSQ.
51 *> Sven Hammarling, Nag Ltd.
52 *> \endverbatim
53 *>
54 * =====================================================================
55  REAL FUNCTION snrm2(N,X,INCX)
56 *
57 * -- Reference BLAS level1 routine (version 3.4.0) --
58 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  INTEGER incx,n
64 * ..
65 * .. Array Arguments ..
66  REAL x(*)
67 * ..
68 *
69 * =====================================================================
70 *
71 * .. Parameters ..
72  REAL one,zero
73  parameter(one=1.0e+0,zero=0.0e+0)
74 * ..
75 * .. Local Scalars ..
76  REAL absxi,norm,scale,ssq
77  INTEGER ix
78 * ..
79 * .. Intrinsic Functions ..
80  INTRINSIC abs,sqrt
81 * ..
82  IF (n.LT.1 .OR. incx.LT.1) THEN
83  norm = zero
84  ELSE IF (n.EQ.1) THEN
85  norm = abs(x(1))
86  ELSE
87  scale = zero
88  ssq = one
89 * The following loop is equivalent to this call to the LAPACK
90 * auxiliary routine:
91 * CALL SLASSQ( N, X, INCX, SCALE, SSQ )
92 *
93  DO 10 ix = 1,1 + (n-1)*incx,incx
94  IF (x(ix).NE.zero) THEN
95  absxi = abs(x(ix))
96  IF (scale.LT.absxi) THEN
97  ssq = one + ssq* (scale/absxi)**2
98  scale = absxi
99  ELSE
100  ssq = ssq + (absxi/scale)**2
101  END IF
102  END IF
103  10 CONTINUE
104  norm = scale*sqrt(ssq)
105  END IF
106 *
107  snrm2 = norm
108  RETURN
109 *
110 * End of SNRM2.
111 *
112  END