01:       REAL FUNCTION SCNRM2(N,X,INCX)
02: *     .. Scalar Arguments ..
03:       INTEGER INCX,N
04: *     ..
05: *     .. Array Arguments ..
06:       COMPLEX X(*)
07: *     ..
08: *
09: *  Purpose
10: *  =======
11: *
12: *  SCNRM2 returns the euclidean norm of a vector via the function
13: *  name, so that
14: *
15: *     SCNRM2 := sqrt( conjg( 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 CLASSQ.
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 NORM,SCALE,SSQ,TEMP
32:       INTEGER IX
33: *     ..
34: *     .. Intrinsic Functions ..
35:       INTRINSIC ABS,AIMAG,REAL,SQRT
36: *     ..
37:       IF (N.LT.1 .OR. INCX.LT.1) THEN
38:           NORM = ZERO
39:       ELSE
40:           SCALE = ZERO
41:           SSQ = ONE
42: *        The following loop is equivalent to this call to the LAPACK
43: *        auxiliary routine:
44: *        CALL CLASSQ( N, X, INCX, SCALE, SSQ )
45: *
46:           DO 10 IX = 1,1 + (N-1)*INCX,INCX
47:               IF (REAL(X(IX)).NE.ZERO) THEN
48:                   TEMP = ABS(REAL(X(IX)))
49:                   IF (SCALE.LT.TEMP) THEN
50:                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
51:                       SCALE = TEMP
52:                   ELSE
53:                       SSQ = SSQ + (TEMP/SCALE)**2
54:                   END IF
55:               END IF
56:               IF (AIMAG(X(IX)).NE.ZERO) THEN
57:                   TEMP = ABS(AIMAG(X(IX)))
58:                   IF (SCALE.LT.TEMP) THEN
59:                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
60:                       SCALE = TEMP
61:                   ELSE
62:                       SSQ = SSQ + (TEMP/SCALE)**2
63:                   END IF
64:               END IF
65:    10     CONTINUE
66:           NORM = SCALE*SQRT(SSQ)
67:       END IF
68: *
69:       SCNRM2 = NORM
70:       RETURN
71: *
72: *     End of SCNRM2.
73: *
74:       END
75: