/* dznrm2.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" #include "blaswrap.h" doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3; doublereal ret_val, d__1; /* Builtin functions */ double d_imag(doublecomplex *), sqrt(doublereal); /* Local variables */ integer ix; doublereal ssq, temp, norm, scale; /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* DZNRM2 returns the euclidean norm of a vector via the function */ /* name, so that */ /* DZNRM2 := sqrt( conjg( x' )*x ) */ /* -- This version written on 25-October-1982. */ /* Modified on 14-October-1993 to inline the call to ZLASSQ. */ /* Sven Hammarling, Nag Ltd. */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* Parameter adjustments */ --x; /* Function Body */ if (*n < 1 || *incx < 1) { norm = 0.; } else { scale = 0.; ssq = 1.; /* The following loop is equivalent to this call to the LAPACK */ /* auxiliary routine: */ /* CALL ZLASSQ( N, X, INCX, SCALE, SSQ ) */ i__1 = (*n - 1) * *incx + 1; i__2 = *incx; for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { i__3 = ix; if (x[i__3].r != 0.) { i__3 = ix; temp = (d__1 = x[i__3].r, abs(d__1)); if (scale < temp) { /* Computing 2nd power */ d__1 = scale / temp; ssq = ssq * (d__1 * d__1) + 1.; scale = temp; } else { /* Computing 2nd power */ d__1 = temp / scale; ssq += d__1 * d__1; } } if (d_imag(&x[ix]) != 0.) { temp = (d__1 = d_imag(&x[ix]), abs(d__1)); if (scale < temp) { /* Computing 2nd power */ d__1 = scale / temp; ssq = ssq * (d__1 * d__1) + 1.; scale = temp; } else { /* Computing 2nd power */ d__1 = temp / scale; ssq += d__1 * d__1; } } /* L10: */ } norm = scale * sqrt(ssq); } ret_val = norm; return ret_val; /* End of DZNRM2. */ } /* dznrm2_ */