1 REAL FUNCTION SCNRM2(N,X,INCX)
2 * .. Scalar Arguments ..
3 INTEGER INCX,N
4 * ..
5 * .. Array Arguments ..
6 COMPLEX X(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * SCNRM2 returns the euclidean norm of a vector via the function
13 * name, so that
14 *
15 * SCNRM2 := sqrt( x**H*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
2 * .. Scalar Arguments ..
3 INTEGER INCX,N
4 * ..
5 * .. Array Arguments ..
6 COMPLEX X(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * SCNRM2 returns the euclidean norm of a vector via the function
13 * name, so that
14 *
15 * SCNRM2 := sqrt( x**H*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