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

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