git.maemo.org Git - opencv/blob - 3rdparty/lapack/dnrm2.c

   1 #include "clapack.h"
   2
   3 doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
   4 {
   5     /* System generated locals */
   6     integer i__1, i__2;
   7     doublereal ret_val, d__1;
   8
   9     /* Builtin functions */
  10     double sqrt(doublereal);
  11
  12     /* Local variables */
  13     integer ix;
  14     doublereal ssq, norm, scale, absxi;
  15
  16 /*     .. Scalar Arguments .. */
  17 /*     .. */
  18 /*     .. Array Arguments .. */
  19 /*     .. */
  20
  21 /*  Purpose */
  22 /*  ======= */
  23
  24 /*  DNRM2 returns the euclidean norm of a vector via the function */
  25 /*  name, so that */
  26
  27 /*     DNRM2 := sqrt( x'*x ) */
  28
  29
  30 /*  -- This version written on 25-October-1982. */
  31 /*     Modified on 14-October-1993 to inline the call to DLASSQ. */
  32 /*     Sven Hammarling, Nag Ltd. */
  33
  34
  35 /*     .. Parameters .. */
  36 /*     .. */
  37 /*     .. Local Scalars .. */
  38 /*     .. */
  39 /*     .. Intrinsic Functions .. */
  40 /*     .. */
  41     /* Parameter adjustments */
  42     --x;
  43
  44     /* Function Body */
  45     if (*n < 1 || *incx < 1) {
  46         norm = 0.;
  47     } else if (*n == 1) {
  48         norm = abs(x[1]);
  49     } else {
  50         scale = 0.;
  51         ssq = 1.;
  52 /*        The following loop is equivalent to this call to the LAPACK */
  53 /*        auxiliary routine: */
  54 /*        CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
  55
  56         i__1 = (*n - 1) * *incx + 1;
  57         i__2 = *incx;
  58         for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
  59             if (x[ix] != 0.) {
  60                 absxi = (d__1 = x[ix], abs(d__1));
  61                 if (scale < absxi) {
  62 /* Computing 2nd power */
  63                     d__1 = scale / absxi;
  64                     ssq = ssq * (d__1 * d__1) + 1.;
  65                     scale = absxi;
  66                 } else {
  67 /* Computing 2nd power */
  68                     d__1 = absxi / scale;
  69                     ssq += d__1 * d__1;
  70                 }
  71             }
  72 /* L10: */
  73         }
  74         norm = scale * sqrt(ssq);
  75     }
  76
  77     ret_val = norm;
  78     return ret_val;
  79
  80 /*     End of DNRM2. */
  81
  82 } /* dnrm2_ */