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