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: *
26: *     .. Parameters ..
27:       REAL ONE,ZERO
28:       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
29: *     ..
30: *     .. Local Scalars ..
31:       REAL ABSXI,NORM,SCALE,SSQ
32:       INTEGER IX
33: *     ..
34: *     .. Intrinsic Functions ..
35:       INTRINSIC ABS,SQRT
36: *     ..
37:       IF (N.LT.1 .OR. INCX.LT.1) THEN
38:           NORM = ZERO
39:       ELSE IF (N.EQ.1) THEN
40:           NORM = ABS(X(1))
41:       ELSE
42:           SCALE = ZERO
43:           SSQ = ONE
44: *        The following loop is equivalent to this call to the LAPACK
45: *        auxiliary routine:
46: *        CALL SLASSQ( N, X, INCX, SCALE, SSQ )
47: *
48:           DO 10 IX = 1,1 + (N-1)*INCX,INCX
49:               IF (X(IX).NE.ZERO) THEN
50:                   ABSXI = ABS(X(IX))
51:                   IF (SCALE.LT.ABSXI) THEN
52:                       SSQ = ONE + SSQ* (SCALE/ABSXI)**2
53:                       SCALE = ABSXI
54:                   ELSE
55:                       SSQ = SSQ + (ABSXI/SCALE)**2
56:                   END IF
57:               END IF
58:    10     CONTINUE
59:           NORM = SCALE*SQRT(SSQ)
60:       END IF
61: *
62:       SNRM2 = NORM
63:       RETURN
64: *
65: *     End of SNRM2.
66: *
67:       END
68: