dnrm2.c
Go to the documentation of this file.
00001 /* dnrm2.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
00017 {
00018     /* System generated locals */
00019     integer i__1, i__2;
00020     doublereal ret_val, d__1;
00021 
00022     /* Builtin functions */
00023     double sqrt(doublereal);
00024 
00025     /* Local variables */
00026     integer ix;
00027     doublereal ssq, norm, scale, absxi;
00028 
00029 /*     .. Scalar Arguments .. */
00030 /*     .. */
00031 /*     .. Array Arguments .. */
00032 /*     .. */
00033 
00034 /*  Purpose */
00035 /*  ======= */
00036 
00037 /*  DNRM2 returns the euclidean norm of a vector via the function */
00038 /*  name, so that */
00039 
00040 /*     DNRM2 := sqrt( x'*x ) */
00041 
00042 
00043 /*  -- This version written on 25-October-1982. */
00044 /*     Modified on 14-October-1993 to inline the call to DLASSQ. */
00045 /*     Sven Hammarling, Nag Ltd. */
00046 
00047 
00048 /*     .. Parameters .. */
00049 /*     .. */
00050 /*     .. Local Scalars .. */
00051 /*     .. */
00052 /*     .. Intrinsic Functions .. */
00053 /*     .. */
00054     /* Parameter adjustments */
00055     --x;
00056 
00057     /* Function Body */
00058     if (*n < 1 || *incx < 1) {
00059         norm = 0.;
00060     } else if (*n == 1) {
00061         norm = abs(x[1]);
00062     } else {
00063         scale = 0.;
00064         ssq = 1.;
00065 /*        The following loop is equivalent to this call to the LAPACK */
00066 /*        auxiliary routine: */
00067 /*        CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
00068 
00069         i__1 = (*n - 1) * *incx + 1;
00070         i__2 = *incx;
00071         for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
00072             if (x[ix] != 0.) {
00073                 absxi = (d__1 = x[ix], abs(d__1));
00074                 if (scale < absxi) {
00075 /* Computing 2nd power */
00076                     d__1 = scale / absxi;
00077                     ssq = ssq * (d__1 * d__1) + 1.;
00078                     scale = absxi;
00079                 } else {
00080 /* Computing 2nd power */
00081                     d__1 = absxi / scale;
00082                     ssq += d__1 * d__1;
00083                 }
00084             }
00085 /* L10: */
00086         }
00087         norm = scale * sqrt(ssq);
00088     }
00089 
00090     ret_val = norm;
00091     return ret_val;
00092 
00093 /*     End of DNRM2. */
00094 
00095 } /* dnrm2_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:47