LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
scnrm2.f
Go to the documentation of this file.
1 *> \brief \b SCNRM2
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 SCNRM2(N,X,INCX)
12 *
13 * .. Scalar Arguments ..
14 * INTEGER INCX,N
15 * ..
16 * .. Array Arguments ..
17 * COMPLEX X(*)
18 * ..
19 *
20 *
21 *> \par Purpose:
22 * =============
23 *>
24 *> \verbatim
25 *>
26 *> SCNRM2 returns the euclidean norm of a vector via the function
27 *> name, so that
28 *>
29 *> SCNRM2 := sqrt( x**H*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 CLASSQ.
51 *> Sven Hammarling, Nag Ltd.
52 *> \endverbatim
53 *>
54 * =====================================================================
55  REAL FUNCTION scnrm2(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  COMPLEX 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 norm,scale,ssq,temp
77  INTEGER ix
78 * ..
79 * .. Intrinsic Functions ..
80  INTRINSIC abs,aimag,REAL,sqrt
81 * ..
82  IF (n.LT.1 .OR. incx.LT.1) THEN
83  norm = zero
84  ELSE
85  scale = zero
86  ssq = one
87 * The following loop is equivalent to this call to the LAPACK
88 * auxiliary routine:
89 * CALL CLASSQ( N, X, INCX, SCALE, SSQ )
90 *
91  DO 10 ix = 1,1 + (n-1)*incx,incx
92  IF (REAL(x(ix)).NE.zero) then
93  temp = abs(REAL(x(ix)))
94  IF (scale.LT.temp) THEN
95  ssq = one + ssq* (scale/temp)**2
96  scale = temp
97  ELSE
98  ssq = ssq + (temp/scale)**2
99  END IF
100  END IF
101  IF (aimag(x(ix)).NE.zero) THEN
102  temp = abs(aimag(x(ix)))
103  IF (scale.LT.temp) THEN
104  ssq = one + ssq* (scale/temp)**2
105  scale = temp
106  ELSE
107  ssq = ssq + (temp/scale)**2
108  END IF
109  END IF
110  10 CONTINUE
111  norm = scale*sqrt(ssq)
112  END IF
113 *
114  scnrm2 = norm
115  RETURN
116 *
117 * End of SCNRM2.
118 *
119  END