Annotation of rpl/lapack/blas/dnrm2.f, revision 1.6
1.1 bertrand 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
CVSweb interface <joel.bertrand@systella.fr>