01:       DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
02: *     .. Scalar Arguments ..
03:       INTEGER INCX,N
04: *     ..
05: *     .. Array Arguments ..
06:       DOUBLE PRECISION X(*)
07: *     ..
08: *
09: *  Purpose
10: *  =======
11: *
12: *  DNRM2 returns the euclidean norm of a vector via the function
13: *  name, so that
14: *
15: *     DNRM2 := sqrt( x'*x )
16: *
17: *
18: *  -- This version written on 25-October-1982.
19: *     Modified on 14-October-1993 to inline the call to DLASSQ.
20: *     Sven Hammarling, Nag Ltd.
21: *
22: *
23: *     .. Parameters ..
24:       DOUBLE PRECISION ONE,ZERO
25:       PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
26: *     ..
27: *     .. Local Scalars ..
28:       DOUBLE PRECISION ABSXI,NORM,SCALE,SSQ
29:       INTEGER IX
30: *     ..
31: *     .. Intrinsic Functions ..
32:       INTRINSIC ABS,SQRT
33: *     ..
34:       IF (N.LT.1 .OR. INCX.LT.1) THEN
35:           NORM = ZERO
36:       ELSE IF (N.EQ.1) THEN
37:           NORM = ABS(X(1))
38:       ELSE
39:           SCALE = ZERO
40:           SSQ = ONE
41: *        The following loop is equivalent to this call to the LAPACK
42: *        auxiliary routine:
43: *        CALL DLASSQ( N, X, INCX, SCALE, SSQ )
44: *
45:           DO 10 IX = 1,1 + (N-1)*INCX,INCX
46:               IF (X(IX).NE.ZERO) THEN
47:                   ABSXI = ABS(X(IX))
48:                   IF (SCALE.LT.ABSXI) THEN
49:                       SSQ = ONE + SSQ* (SCALE/ABSXI)**2
50:                       SCALE = ABSXI
51:                   ELSE
52:                       SSQ = SSQ + (ABSXI/SCALE)**2
53:                   END IF
54:               END IF
55:    10     CONTINUE
56:           NORM = SCALE*SQRT(SSQ)
57:       END IF
58: *
59:       DNRM2 = NORM
60:       RETURN
61: *
62: *     End of DNRM2.
63: *
64:       END
65: