int
lu_decomp_backsub_driver ( double **coeff_matrix,
double *rhs_vector,
int *indx,
int sys_size,
int lu_dcmp_flag )
{
static double *d=NULL;
static int first_call=1;
if( first_call )
{
d = (double *) smalloc (1 * sizeof(double));
first_call = 0;
}
if ( lu_dcmp_flag == 1 ) {
if ( lu_decomp ( coeff_matrix,
sys_size,
indx,
d ) == -1 ) {
fprintf ( stdout,
" Error occurred in lu_decomp_backsub_driver\n");
return (-1);
}
}
lu_backsub ( coeff_matrix,
sys_size,
indx,
rhs_vector );
return (0);
}
int
test(
int n, /* Dimensionality */
double **a, /* A[][] input matrix, returns LU decimposition of A */
double *b /* B[] input array, returns solution X[] */
) {
int i, j;
double rip; /* Row interchange parity */
int *pivx;
int rv = 0;
double **sa; /* save input matrix values */
double *sb; /* save input vector values */
pivx = ivector(0, n-1);
sa = dmatrix(0, n-1, 0, n-1);
sb = dvector(0, n-1);
/* Copy input matrix and vector values */
for (i = 0; i < n; i++) {
sb[i] = b[i];
for (j = 0; j < n; j++)
sa[i][j] = a[i][j];
}
if (lu_decomp(a, n, pivx, &rip)) {
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
free_ivector(pivx, 0, n-1);
return 1;
}
lu_backsub(a, n, pivx, b);
/* Check that the solution is correct */
for (i = 0; i < n; i++) {
double sum, temp;
sum = 0.0;
for (j = 0; j < n; j++)
sum += sa[i][j] * b[j];
//printf("~~ check %d = %f, against %f\n",i,sum,sb[i]);
temp = fabs(sum - sb[i]);
if (temp > 1e-6)
rv = 2;
}
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
free_ivector(pivx, 0, n-1);
return rv;
}
/* Improve a solution of equations */
void
lu_polish(
double **a, /* Original A[][] matrix */
double **lua, /* LU decomposition of A[][] */
int n, /* Dimensionality */
double *b, /* B[] vector of equation */
double *x, /* X[] solution to be polished */
int *pivx /* Pivoting row permutations record */
) {
int i, j;
double *r, R[10]; /* Residuals */
if (n <= 10)
r = R;
else
r = dvector(0, n-1);
/* Accumulate the residual error */
for (i = 0; i < n; i++) {
double sum;
sum = -b[i];
for (j = 0; j < n; j++)
sum += a[i][j] * x[j];
r[i] = sum;
}
/* Solve for the error */
lu_backsub(lua, n, pivx, r);
/* Subtract error from the old solution */
for (i = 0; i < n; i++)
x[i] -= r[i];
if (r != R)
free_dvector(r, 0, n-1);
}
/* Return 1 if the matrix is singular, 0 if OK */
int
solve_se(
double **a, /* A[][] input matrix, returns LU decomposition of A */
double *b, /* B[] input array, returns solution X[] */
int n /* Dimensionality */
) {
double rip; /* Row interchange parity */
int *pivx, PIVX[10];
#if defined(DO_POLISH) || defined(DO_CHECK)
double **sa; /* save input matrix values */
double *sb; /* save input vector values */
#endif
if (n <= 10)
pivx = PIVX;
else
pivx = ivector(0, n-1);
#if defined(DO_POLISH) || defined(DO_CHECK)
sa = dmatrix(0, n-1, 0, n-1);
sb = dvector(0, n-1);
/* Copy input matrix and vector values */
for (i = 0; i < n; i++) {
sb[i] = b[i];
for (j = 0; j < n; j++)
sa[i][j] = a[i][j];
}
#endif
if (lu_decomp(a, n, pivx, &rip)) {
#if defined(DO_POLISH) || defined(DO_CHECK)
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
if (pivx != PIVX)
free_ivector(pivx, 0, n-1);
#endif
return 1;
}
lu_backsub(a, n, pivx, b);
#ifdef DO_POLISH
lu_polish(n, sa, a, pivx, sb, b); /* Improve the solution */
#endif
#ifdef DO_CHECK
/* Check that the solution is correct */
for (i = 0; i < n; i++) {
double sum, temp;
sum = 0.0;
for (j = 0; j < n; j++)
sum += sa[i][j] * b[j];
temp = fabs(sum - sb[i]);
if (temp > 1e-6) {
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
if (pivx != PIVX)
free_ivector(pivx, 0, n-1);
return 2;
}
}
#endif
#if defined(DO_POLISH) || defined(DO_CHECK)
free_dvector(sb, 0, n-1);
free_dmatrix(sa, 0, n-1, 0, n-1);
#endif
if (pivx != PIVX)
free_ivector(pivx, 0, n-1);
return 0;
}
