qrbdi.c 1.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. /* qrbdi.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 qrbdi(double *dm, double *em, int m)
  10. {
  11. int i, j, k, n;
  12. double u, x, y, a, b, c, s, t;
  13. for (j = 1, t = fabs(dm[0]); j < m; ++j)
  14. if ((s = fabs(dm[j]) + fabs(em[j - 1])) > t)
  15. t = s;
  16. t *= 1.e-15;
  17. n = 100 * m;
  18. for (j = 0; m > 1 && j < n; ++j) {
  19. for (k = m - 1; k > 0; --k) {
  20. if (fabs(em[k - 1]) < t)
  21. break;
  22. if (fabs(dm[k - 1]) < t) {
  23. for (i = k, s = 1., c = 0.; i < m; ++i) {
  24. a = s * em[i - 1];
  25. b = dm[i];
  26. em[i - 1] *= c;
  27. dm[i] = u = sqrt(a * a + b * b);
  28. s = -a / u;
  29. c = b / u;
  30. }
  31. break;
  32. }
  33. }
  34. y = dm[k];
  35. x = dm[m - 1];
  36. u = em[m - 2];
  37. a = (y + x) * (y - x) - u * u;
  38. s = y * em[k];
  39. b = s + s;
  40. u = sqrt(a * a + b * b);
  41. if (u > 0.) {
  42. c = sqrt((u + a) / (u + u));
  43. if (c != 0.)
  44. s /= (c * u);
  45. else
  46. s = 1.;
  47. for (i = k; i < m - 1; ++i) {
  48. b = em[i];
  49. if (i > k) {
  50. a = s * em[i];
  51. b *= c;
  52. em[i - 1] = u = sqrt(x * x + a * a);
  53. c = x / u;
  54. s = a / u;
  55. }
  56. a = c * y + s * b;
  57. b = c * b - s * y;
  58. s *= dm[i + 1];
  59. dm[i] = u = sqrt(a * a + s * s);
  60. y = c * dm[i + 1];
  61. c = a / u;
  62. s /= u;
  63. x = c * b + s * y;
  64. y = c * y - s * b;
  65. }
  66. }
  67. em[m - 2] = x;
  68. dm[m - 1] = y;
  69. if (fabs(x) < t)
  70. --m;
  71. if (m == k + 1)
  72. --m;
  73. }
  74. return j;
  75. }