File:
[local] /
rpl /
lapack /
blas /
dnrm2.f
Revision
1.6:
download - view:
text,
annotated -
select for diffs -
revision graph
Tue Dec 21 13:51:24 2010 UTC (14 years, 4 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_3,
rpl-4_1_2,
rpl-4_1_1,
rpl-4_1_0,
rpl-4_0_24,
rpl-4_0_22,
rpl-4_0_21,
rpl-4_0_20,
rpl-4_0,
HEAD
Mise à jour de lapack vers la version 3.3.0
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>