chouse.c 2.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. /* chouse.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 chouse(Cpx * a, double *d, double *dp, int n)
  11. {
  12. double sc, x, y;
  13. Cpx cc, u, *q0;
  14. int i, j, k, m, e;
  15. Cpx *qw, *pc, *p;
  16. q0 = (Cpx *) calloc(2 * n, sizeof(Cpx));
  17. for (i = 0, p = q0 + n, pc = a; i < n; ++i, pc += n + 1)
  18. *p++ = *pc;
  19. for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) {
  20. m = n - j - 1;
  21. for (i = 1, sc = 0.; i <= m; ++i)
  22. sc += pc[i].re * pc[i].re + pc[i].im * pc[i].im;
  23. if (sc > 0.) {
  24. sc = sqrt(sc);
  25. p = pc + 1;
  26. y = sc + (x = sqrt(p->re * p->re + p->im * p->im));
  27. if (x > 0.) {
  28. cc.re = p->re / x;
  29. cc.im = p->im / x;
  30. }
  31. else {
  32. cc.re = 1.;
  33. cc.im = 0.;
  34. }
  35. x = 1. / sqrt(2. * sc * y);
  36. y *= x;
  37. for (i = 0, qw = pc + 1; i < m; ++i) {
  38. q0[i].re = q0[i].im = 0.;
  39. if (i) {
  40. qw[i].re *= x;
  41. qw[i].im *= -x;
  42. }
  43. else {
  44. qw[0].re = y * cc.re;
  45. qw[0].im = -y * cc.im;
  46. }
  47. }
  48. for (i = 0, e = j + 2, p = pc + n + 1, y = 0.; i < m;
  49. ++i, p += e++) {
  50. q0[i].re += (u.re = qw[i].re) * p->re - (u.im =
  51. qw[i].im) * p->im;
  52. q0[i].im += u.re * p->im + u.im * p->re;
  53. ++p;
  54. for (k = i + 1; k < m; ++k, ++p) {
  55. q0[i].re += qw[k].re * p->re - qw[k].im * p->im;
  56. q0[i].im += qw[k].im * p->re + qw[k].re * p->im;
  57. q0[k].re += u.re * p->re + u.im * p->im;
  58. q0[k].im += u.im * p->re - u.re * p->im;
  59. }
  60. y += u.re * q0[i].re + u.im * q0[i].im;
  61. }
  62. for (i = 0; i < m; ++i) {
  63. q0[i].re -= y * qw[i].re;
  64. q0[i].re += q0[i].re;
  65. q0[i].im -= y * qw[i].im;
  66. q0[i].im += q0[i].im;
  67. }
  68. for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
  69. for (k = i; k < m; ++k, ++p) {
  70. p->re -= qw[i].re * q0[k].re + qw[i].im * q0[k].im
  71. + q0[i].re * qw[k].re + q0[i].im * qw[k].im;
  72. p->im -= qw[i].im * q0[k].re - qw[i].re * q0[k].im
  73. + q0[i].im * qw[k].re - q0[i].re * qw[k].im;
  74. }
  75. }
  76. }
  77. d[j] = pc->re;
  78. dp[j] = sc;
  79. }
  80. d[j] = pc->re;
  81. d[j + 1] = (pc + n + 1)->re;
  82. u = *(pc + 1);
  83. dp[j] = sqrt(u.re * u.re + u.im * u.im);
  84. for (j = 0, pc = a, qw = q0 + n; j < n; ++j, pc += n + 1) {
  85. *pc = qw[j];
  86. for (i = 1, p = pc + n; i < n - j; ++i, p += n) {
  87. pc[i].re = p->re;
  88. pc[i].im = -p->im;
  89. }
  90. }
  91. free(q0);
  92. }