1*> \brief \b DNRM2
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
12*
13*       .. Scalar Arguments ..
14*       INTEGER INCX,N
15*       ..
16*       .. Array Arguments ..
17*       DOUBLE PRECISION X(*)
18*       ..
19*
20*
21*> \par Purpose:
22*  =============
23*>
24*> \verbatim
25*>
26*> DNRM2 returns the euclidean norm of a vector via the function
27*> name, so that
28*>
29*>    DNRM2 := 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 double_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 DLASSQ.
51*>     Sven Hammarling, Nag Ltd.
52*> \endverbatim
53*>
54*  =====================================================================
55      DOUBLE PRECISION FUNCTION DNRM2(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      DOUBLE PRECISION X(*)
67*     ..
68*
69*  =====================================================================
70*
71*     .. Parameters ..
72      DOUBLE PRECISION ONE,ZERO
73      PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
74*     ..
75*     .. Local Scalars ..
76      DOUBLE PRECISION 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 DLASSQ( 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      DNRM2 = NORM
108      RETURN
109*
110*     End of DNRM2.
111*
112      END
113