Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016 doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
00017 {
00018
00019 integer i__1, i__2;
00020 doublereal ret_val, d__1;
00021
00022
00023 double sqrt(doublereal);
00024
00025
00026 integer ix;
00027 doublereal ssq, norm, scale, absxi;
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055 --x;
00056
00057
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
00066
00067
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
00076 d__1 = scale / absxi;
00077 ssq = ssq * (d__1 * d__1) + 1.;
00078 scale = absxi;
00079 } else {
00080
00081 d__1 = absxi / scale;
00082 ssq += d__1 * d__1;
00083 }
00084 }
00085
00086 }
00087 norm = scale * sqrt(ssq);
00088 }
00089
00090 ret_val = norm;
00091 return ret_val;
00092
00093
00094
00095 }