1 /* dznrm2.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */
2 #include "FLA_f2c.h"
dznrm2_(integer * n,doublecomplex * x,integer * incx)3 doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx)
4 {
5     /* System generated locals */
6     integer i__1, i__2, i__3;
7     doublereal ret_val, d__1;
8     /* Builtin functions */
9     double d_imag(doublecomplex *), sqrt(doublereal);
10     /* Local variables */
11     doublereal temp, norm, scale;
12     integer ix;
13     doublereal ssq;
14     /* .. Scalar Arguments .. */
15     /* .. Array Arguments .. */
16     /* .. */
17     /* DZNRM2 returns the euclidean norm of a vector via the function */
18     /* name, so that */
19     /* DZNRM2 := sqrt( conjg( x' )*x ) */
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     /* .. Parameters .. */
24     /* .. Local Scalars .. */
25     /* .. Intrinsic Functions .. */
26     /* .. */
27     /* .. Executable Statements .. */
28     /* Parameter adjustments */
29     --x;
30     /* Function Body */
31     if (*n < 1 || *incx < 1)
32     {
33         norm = 0.;
34     }
35     else
36     {
37         scale = 0.;
38         ssq = 1.;
39         /* The following loop is equivalent to this call to the LAPACK */
40         /* auxiliary routine: */
41         /* CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) */
42         i__1 = (*n - 1) * *incx + 1;
43         i__2 = *incx;
44         for (ix = 1;
45                 i__2 < 0 ? ix >= i__1 : ix <= i__1;
46                 ix += i__2)
47         {
48             i__3 = ix;
49             if (x[i__3].r != 0.)
50             {
51                 i__3 = ix;
52                 temp = (d__1 = x[i__3].r, f2c_abs(d__1));
53                 if (scale < temp)
54                 {
55                     /* Computing 2nd power */
56                     d__1 = scale / temp;
57                     ssq = ssq * (d__1 * d__1) + 1.;
58                     scale = temp;
59                 }
60                 else
61                 {
62                     /* Computing 2nd power */
63                     d__1 = temp / scale;
64                     ssq += d__1 * d__1;
65                 }
66             }
67             if (d_imag(&x[ix]) != 0.)
68             {
69                 temp = (d__1 = d_imag(&x[ix]), f2c_abs(d__1));
70                 if (scale < temp)
71                 {
72                     /* Computing 2nd power */
73                     d__1 = scale / temp;
74                     ssq = ssq * (d__1 * d__1) + 1.;
75                     scale = temp;
76                 }
77                 else
78                 {
79                     /* Computing 2nd power */
80                     d__1 = temp / scale;
81                     ssq += d__1 * d__1;
82                 }
83             }
84             /* L10: */
85         }
86         norm = scale * sqrt(ssq);
87     }
88     ret_val = norm;
89     return ret_val;
90     /* End of DZNRM2. */
91 }
92 /* dznrm2_ */
93 
94