1: DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
2: * .. Scalar Arguments ..
3: INTEGER INCX,N
4: * ..
5: * .. Array Arguments ..
6: DOUBLE COMPLEX X(*)
7: * ..
8: *
9: * Purpose
10: * =======
11: *
12: * DZNRM2 returns the euclidean norm of a vector via the function
13: * name, so that
14: *
15: * DZNRM2 := 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 ZLASSQ.
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 NORM,SCALE,SSQ,TEMP
32: INTEGER IX
33: * ..
34: * .. Intrinsic Functions ..
35: INTRINSIC ABS,DBLE,DIMAG,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 ZLASSQ( N, X, INCX, SCALE, SSQ )
45: *
46: DO 10 IX = 1,1 + (N-1)*INCX,INCX
47: IF (DBLE(X(IX)).NE.ZERO) THEN
48: TEMP = ABS(DBLE(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 (DIMAG(X(IX)).NE.ZERO) THEN
57: TEMP = ABS(DIMAG(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: DZNRM2 = NORM
70: RETURN
71: *
72: * End of DZNRM2.
73: *
74: END
CVSweb interface <joel.bertrand@systella.fr>