1 DOUBLE PRECISION FUNCTION DNRM2(N,X,INCX)
2 * .. Scalar Arguments ..
3 INTEGER INCX,N
4 * ..
5 * .. Array Arguments ..
6 DOUBLE PRECISION X(*)
7 * ..
8 *
9 * 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 * Further Details
18 * ===============
19 *
20 * -- This version written on 25-October-1982.
21 * Modified on 14-October-1993 to inline the call to DLASSQ.
22 * Sven Hammarling, Nag Ltd.
23 *
24 * =====================================================================
25 *
26 * .. Parameters ..
27 DOUBLE PRECISION ONE,ZERO
28 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
29 * ..
30 * .. Local Scalars ..
31 DOUBLE PRECISION 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 DLASSQ( 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 DNRM2 = NORM
63 RETURN
64 *
65 * End of DNRM2.
66 *
67 END
2 * .. Scalar Arguments ..
3 INTEGER INCX,N
4 * ..
5 * .. Array Arguments ..
6 DOUBLE PRECISION X(*)
7 * ..
8 *
9 * 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 * Further Details
18 * ===============
19 *
20 * -- This version written on 25-October-1982.
21 * Modified on 14-October-1993 to inline the call to DLASSQ.
22 * Sven Hammarling, Nag Ltd.
23 *
24 * =====================================================================
25 *
26 * .. Parameters ..
27 DOUBLE PRECISION ONE,ZERO
28 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
29 * ..
30 * .. Local Scalars ..
31 DOUBLE PRECISION 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 DLASSQ( 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 DNRM2 = NORM
63 RETURN
64 *
65 * End of DNRM2.
66 *
67 END