housev.c 2.0 KB

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