chousv.c 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. /* chousv.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 <stdlib.h>
  9. #include "ccmath.h"
  10. void chousv(Cpx * a, double *d, double *dp, int n)
  11. {
  12. double sc, x, y;
  13. Cpx cc, u, *qs;
  14. int i, j, k, m, e;
  15. Cpx *qw, *pc, *p, *q;
  16. qs = (Cpx *) calloc(2 * n, sizeof(Cpx));
  17. q = qs + n;
  18. for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1, ++q) {
  19. m = n - j - 1;
  20. for (i = 1, sc = 0.; i <= m; ++i)
  21. sc += pc[i].re * pc[i].re + pc[i].im * pc[i].im;
  22. if (sc > 0.) {
  23. sc = sqrt(sc);
  24. p = pc + 1;
  25. y = sc + (x = sqrt(p->re * p->re + p->im * p->im));
  26. if (x > 0.) {
  27. cc.re = p->re / x;
  28. cc.im = p->im / x;
  29. }
  30. else {
  31. cc.re = 1.;
  32. cc.im = 0.;
  33. }
  34. q->re = -cc.re;
  35. q->im = -cc.im;
  36. x = 1. / sqrt(2. * sc * y);
  37. y *= x;
  38. for (i = 0, qw = pc + 1; i < m; ++i) {
  39. qs[i].re = qs[i].im = 0.;
  40. if (i) {
  41. qw[i].re *= x;
  42. qw[i].im *= -x;
  43. }
  44. else {
  45. qw[0].re = y * cc.re;
  46. qw[0].im = -y * cc.im;
  47. }
  48. }
  49. for (i = 0, e = j + 2, p = pc + n + 1, y = 0.; i < m;
  50. ++i, p += e++) {
  51. qs[i].re += (u.re = qw[i].re) * p->re - (u.im =
  52. qw[i].im) * p->im;
  53. qs[i].im += u.re * p->im + u.im * p->re;
  54. ++p;
  55. for (k = i + 1; k < m; ++k, ++p) {
  56. qs[i].re += qw[k].re * p->re - qw[k].im * p->im;
  57. qs[i].im += qw[k].im * p->re + qw[k].re * p->im;
  58. qs[k].re += u.re * p->re + u.im * p->im;
  59. qs[k].im += u.im * p->re - u.re * p->im;
  60. }
  61. y += u.re * qs[i].re + u.im * qs[i].im;
  62. }
  63. for (i = 0; i < m; ++i) {
  64. qs[i].re -= y * qw[i].re;
  65. qs[i].re += qs[i].re;
  66. qs[i].im -= y * qw[i].im;
  67. qs[i].im += qs[i].im;
  68. }
  69. for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
  70. for (k = i; k < m; ++k, ++p) {
  71. p->re -= qw[i].re * qs[k].re + qw[i].im * qs[k].im
  72. + qs[i].re * qw[k].re + qs[i].im * qw[k].im;
  73. p->im -= qw[i].im * qs[k].re - qw[i].re * qs[k].im
  74. + qs[i].im * qw[k].re - qs[i].re * qw[k].im;
  75. }
  76. }
  77. }
  78. d[j] = pc->re;
  79. dp[j] = sc;
  80. }
  81. d[j] = pc->re;
  82. cc = *(pc + 1);
  83. d[j + 1] = (pc += n + 1)->re;
  84. dp[j] = sc = sqrt(cc.re * cc.re + cc.im * cc.im);
  85. q->re = cc.re /= sc;
  86. q->im = cc.im /= sc;
  87. for (i = 0, m = n + n, p = pc; i < m; ++i, --p)
  88. p->re = p->im = 0.;
  89. pc->re = 1.;
  90. (pc -= n + 1)->re = 1.;
  91. qw = pc - n;
  92. for (m = 2; m < n; ++m, qw -= n + 1) {
  93. for (j = 0, p = pc, pc->re = 1.; j < m; ++j, p += n) {
  94. for (i = 0, q = p, u.re = u.im = 0.; i < m; ++i, ++q) {
  95. u.re += qw[i].re * q->re - qw[i].im * q->im;
  96. u.im += qw[i].re * q->im + qw[i].im * q->re;
  97. }
  98. for (i = 0, q = p, u.re += u.re, u.im += u.im; i < m; ++i, ++q) {
  99. q->re -= u.re * qw[i].re + u.im * qw[i].im;
  100. q->im -= u.im * qw[i].re - u.re * qw[i].im;
  101. }
  102. }
  103. for (i = 0, p = qw + m - 1; i < n; ++i, --p)
  104. p->re = p->im = 0.;
  105. (pc -= n + 1)->re = 1.;
  106. }
  107. for (j = 1, p = a + n + 1, q = qs + n, u.re = 1., u.im = 0.; j < n;
  108. ++j, ++p, ++q) {
  109. sc = u.re * q->re - u.im * q->im;
  110. u.im = u.im * q->re + u.re * q->im;
  111. u.re = sc;
  112. for (i = 1; i < n; ++i, ++p) {
  113. sc = u.re * p->re - u.im * p->im;
  114. p->im = u.re * p->im + u.im * p->re;
  115. p->re = sc;
  116. }
  117. }
  118. free(qs);
  119. }