qrevec.c 1.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576
  1. /* qrevec.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 <math.h>
  9. int qrevec(double *ev, double *evec, double *dp, int n)
  10. {
  11. double cc, sc = 0.0, d, x, y, h, tzr = 1.e-15;
  12. int i, j, k, m, mqr = 8 * n;
  13. double *p;
  14. for (j = 0, m = n - 1;; ++j) {
  15. while (1) {
  16. if (m < 1)
  17. return 0;
  18. k = m - 1;
  19. if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
  20. --m;
  21. else {
  22. x = (ev[k] - ev[m]) / 2.;
  23. h = sqrt(x * x + dp[k] * dp[k]);
  24. if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
  25. break;
  26. if ((cc = sqrt((1. + x / h) / 2.)) != 0.)
  27. sc = dp[k] / (2. * cc * h);
  28. else
  29. sc = 1.;
  30. x += ev[m];
  31. ev[m--] = x - h;
  32. ev[m--] = x + h;
  33. for (i = 0, p = evec + n * (m + 1); i < n; ++i, ++p) {
  34. h = p[0];
  35. p[0] = cc * h + sc * p[n];
  36. p[n] = cc * p[n] - sc * h;
  37. }
  38. }
  39. }
  40. if (j > mqr)
  41. return -1;
  42. if (x > 0.)
  43. d = ev[m] + x - h;
  44. else
  45. d = ev[m] + x + h;
  46. cc = 1.;
  47. y = 0.;
  48. ev[0] -= d;
  49. for (k = 0; k < m; ++k) {
  50. x = ev[k] * cc - y;
  51. y = dp[k] * cc;
  52. h = sqrt(x * x + dp[k] * dp[k]);
  53. if (k > 0)
  54. dp[k - 1] = sc * h;
  55. ev[k] = cc * h;
  56. cc = x / h;
  57. sc = dp[k] / h;
  58. ev[k + 1] -= d;
  59. y *= sc;
  60. ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
  61. for (i = 0, p = evec + n * k; i < n; ++i, ++p) {
  62. h = p[0];
  63. p[0] = cc * h + sc * p[n];
  64. p[n] = cc * p[n] - sc * h;
  65. }
  66. }
  67. ev[k] = ev[k] * cc - y;
  68. dp[k - 1] = ev[k] * sc;
  69. ev[k] = ev[k] * cc + d;
  70. }
  71. return 0;
  72. }