snrm2.c 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. /* snrm2.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. doublereal snrm2_(integer *n, real *x, integer *incx)
  14. {
  15. /* System generated locals */
  16. integer i__1, i__2;
  17. real ret_val, r__1;
  18. /* Builtin functions */
  19. double sqrt(doublereal);
  20. /* Local variables */
  21. integer ix;
  22. real ssq, norm, scale, absxi;
  23. /* .. Scalar Arguments .. */
  24. /* .. */
  25. /* .. Array Arguments .. */
  26. /* .. */
  27. /* Purpose */
  28. /* ======= */
  29. /* SNRM2 returns the euclidean norm of a vector via the function */
  30. /* name, so that */
  31. /* SNRM2 := sqrt( x'*x ). */
  32. /* Further Details */
  33. /* =============== */
  34. /* -- This version written on 25-October-1982. */
  35. /* Modified on 14-October-1993 to inline the call to SLASSQ. */
  36. /* Sven Hammarling, Nag Ltd. */
  37. /* .. Parameters .. */
  38. /* .. */
  39. /* .. Local Scalars .. */
  40. /* .. */
  41. /* .. Intrinsic Functions .. */
  42. /* .. */
  43. /* Parameter adjustments */
  44. --x;
  45. /* Function Body */
  46. if (*n < 1 || *incx < 1) {
  47. norm = 0.f;
  48. } else if (*n == 1) {
  49. norm = dabs(x[1]);
  50. } else {
  51. scale = 0.f;
  52. ssq = 1.f;
  53. /* The following loop is equivalent to this call to the LAPACK */
  54. /* auxiliary routine: */
  55. /* CALL SLASSQ( N, X, INCX, SCALE, SSQ ) */
  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.f) {
  60. absxi = (r__1 = x[ix], dabs(r__1));
  61. if (scale < absxi) {
  62. /* Computing 2nd power */
  63. r__1 = scale / absxi;
  64. ssq = ssq * (r__1 * r__1) + 1.f;
  65. scale = absxi;
  66. } else {
  67. /* Computing 2nd power */
  68. r__1 = absxi / scale;
  69. ssq += r__1 * r__1;
  70. }
  71. }
  72. /* L10: */
  73. }
  74. norm = scale * sqrt(ssq);
  75. }
  76. ret_val = norm;
  77. return ret_val;
  78. /* End of SNRM2. */
  79. } /* snrm2_ */