lu.c 2.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. #include <math.h>
  2. #include <grass/gis.h>
  3. #include <grass/gmath.h>
  4. #define TINY 1.0e-20;
  5. /*!
  6. * \brief LU decomposition
  7. *
  8. * \param a double **
  9. * \param n int
  10. * \param indx int *
  11. * \param d double *
  12. *
  13. * \return 0 on singular matrix, 1 on success
  14. */
  15. int G_ludcmp(double **a, int n, int *indx, double *d)
  16. {
  17. int i, imax = 0, j, k;
  18. double big, dum, sum, temp;
  19. double *vv;
  20. int is_singular = FALSE;
  21. vv = G_alloc_vector(n);
  22. *d = 1.0;
  23. /* this pragma works, but doesn't really help speed things up */
  24. /* #pragma omp parallel for private(i, j, big, temp) shared(n, a, vv, is_singular) */
  25. for (i = 0; i < n; i++) {
  26. big = 0.0;
  27. for (j = 0; j < n; j++)
  28. if ((temp = fabs(a[i][j])) > big)
  29. big = temp;
  30. if (big == 0.0)
  31. is_singular = TRUE;
  32. vv[i] = 1.0 / big;
  33. }
  34. if (is_singular) {
  35. *d = 0.0;
  36. return 0; /* Singular matrix */
  37. }
  38. for (j = 0; j < n; j++) {
  39. for (i = 0; i < j; i++) {
  40. sum = a[i][j];
  41. for (k = 0; k < i; k++)
  42. sum -= a[i][k] * a[k][j];
  43. a[i][j] = sum;
  44. }
  45. big = 0.0;
  46. /* not very efficent, but this pragma helps speed things up a bit */
  47. #pragma omp parallel for private(i, k, sum, dum) shared(j, n, a, vv, big, imax)
  48. for (i = j; i < n; i++) {
  49. sum = a[i][j];
  50. for (k = 0; k < j; k++)
  51. sum -= a[i][k] * a[k][j];
  52. a[i][j] = sum;
  53. if ((dum = vv[i] * fabs(sum)) >= big) {
  54. big = dum;
  55. imax = i;
  56. }
  57. }
  58. if (j != imax) {
  59. for (k = 0; k < n; k++) {
  60. dum = a[imax][k];
  61. a[imax][k] = a[j][k];
  62. a[j][k] = dum;
  63. }
  64. *d = -(*d);
  65. vv[imax] = vv[j];
  66. }
  67. indx[j] = imax;
  68. if (a[j][j] == 0.0)
  69. a[j][j] = TINY;
  70. if (j != n) {
  71. dum = 1.0 / (a[j][j]);
  72. for (i = j + 1; i < n; i++)
  73. a[i][j] *= dum;
  74. }
  75. }
  76. G_free_vector(vv);
  77. return 1;
  78. }
  79. #undef TINY
  80. /*!
  81. * \brief LU backward substitution
  82. *
  83. * \param a double **
  84. * \param n int
  85. * \param indx int *
  86. * \param b double []
  87. *
  88. * \return void
  89. */
  90. void G_lubksb(double **a, int n, int *indx, double b[])
  91. {
  92. int i, ii, ip, j;
  93. double sum;
  94. ii = -1;
  95. for (i = 0; i < n; i++) {
  96. ip = indx[i];
  97. sum = b[ip];
  98. b[ip] = b[i];
  99. if (ii >= 0)
  100. for (j = ii; j < i; j++)
  101. sum -= a[i][j] * b[j];
  102. else if (sum)
  103. ii = i;
  104. b[i] = sum;
  105. }
  106. for (i = n - 1; i >= 0; i--) {
  107. sum = b[i];
  108. for (j = i + 1; j < n; j++)
  109. sum -= a[i][j] * b[j];
  110. b[i] = sum / a[i][i];
  111. }
  112. }