qreval.c 1.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. /* qreval.c CCMATH mathematics library source code.
  2. *
  3. * Copyright (C) 2000 Daniel A. Atkinson All rights reserved.
  4. * This code may be redistributed under the terms of the GNU library
  5. * public license (LGPL). ( See the lgpl.license file for details.)
  6. * ------------------------------------------------------------------------
  7. */
  8. #include "ccmath.h"
  9. int qreval(double *ev, double *dp, int n)
  10. {
  11. double cc, sc = 0.0, d, x, y, h, tzr = 1.e-15;
  12. int j, k, m, mqr = 8 * n;
  13. for (j = 0, m = n - 1;; ++j) {
  14. while (1) {
  15. if (m < 1)
  16. return 0;
  17. k = m - 1;
  18. if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
  19. --m;
  20. else {
  21. x = (ev[k] - ev[m]) / 2.;
  22. h = sqrt(x * x + dp[k] * dp[k]);
  23. if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
  24. break;
  25. x += ev[m];
  26. ev[m--] = x - h;
  27. ev[m--] = x + h;
  28. }
  29. }
  30. if (j > mqr)
  31. return -1;
  32. if (x > 0.)
  33. d = ev[m] + x - h;
  34. else
  35. d = ev[m] + x + h;
  36. cc = 1.;
  37. y = 0.;
  38. ev[0] -= d;
  39. for (k = 0; k < m; ++k) {
  40. x = ev[k] * cc - y;
  41. y = dp[k] * cc;
  42. h = sqrt(x * x + dp[k] * dp[k]);
  43. if (k > 0)
  44. dp[k - 1] = sc * h;
  45. ev[k] = cc * h;
  46. cc = x / h;
  47. sc = dp[k] / h;
  48. ev[k + 1] -= d;
  49. y *= sc;
  50. ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
  51. }
  52. ev[k] = ev[k] * cc - y;
  53. dp[k - 1] = ev[k] * sc;
  54. ev[k] = ev[k] * cc + d;
  55. }
  56. return 0;
  57. }