/*!
* \brief Creates system of linear equations from interpolated points
*
* Creates system of linear equations represented by matrix using given
* points and interpolating function interp()
*
* \param params struct interp_params *
* \param points points for interpolation as struct triple
* \param n_points number of points
* \param[out] matrix the matrix
* \param indx
*
* \return -1 on failure, 1 on success
*/
int IL_matrix_create(struct interp_params *params,
struct triple *points, /* points for interpolation */
int n_points, /* number of points */
double **matrix, /* matrix */
int *indx)
{
double xx, yy;
double rfsta2, r;
double d;
int n1, k1, k2, k, i1, l, m, i, j;
double fstar2 = params->fi * params->fi / 4.;
static double *A = NULL;
double RO, amaxa;
double rsin = 0, rcos = 0, teta, scale = 0; /*anisotropy parameters - added by JH 2002 */
double xxr, yyr;
if (params->theta) {
teta = params->theta * (M_PI / 180); /* deg to rad */
rsin = sin(teta);
rcos = cos(teta);
}
if (params->scalex)
scale = params->scalex;
n1 = n_points + 1;
if (!A) {
if (!
(A =
G_alloc_vector((params->KMAX2 + 2) * (params->KMAX2 + 2) + 1))) {
fprintf(stderr, "Cannot allocate memory for A\n");
return -1;
}
}
/*
C GENERATION OF MATRIX
C FIRST COLUMN
*/
A[1] = 0.;
for (k = 1; k <= n_points; k++) {
i1 = k + 1;
A[i1] = 1.;
}
/*
C OTHER COLUMNS
*/
RO = -params->rsm;
/* fprintf (stderr, "sm[%d] = %f, ro=%f\n", 1, points[1].smooth, RO); */
for (k = 1; k <= n_points; k++) {
k1 = k * n1 + 1;
k2 = k + 1;
i1 = k1 + k;
if (params->rsm < 0.) { /*indicates variable smoothing */
A[i1] = -points[k - 1].sm; /* added by Mitasova nov. 96 */
/* G_debug(5, "sm[%d]=%f, a=%f", k, points[k-1].sm, A[i1]); */
}
else {
A[i1] = RO; /* constant smoothing */
}
/* if (i1 == 100) fprintf (stderr,i "A[%d] = %f\n", i1, A[i1]); */
/* A[i1] = RO; */
for (l = k2; l <= n_points; l++) {
xx = points[k - 1].x - points[l - 1].x;
yy = points[k - 1].y - points[l - 1].y;
if ((params->theta) && (params->scalex)) {
/* re run anisotropy */
xxr = xx * rcos + yy * rsin;
yyr = yy * rcos - xx * rsin;
xx = xxr;
yy = yyr;
r = scale * xx * xx + yy * yy;
rfsta2 = fstar2 * (scale * xx * xx + yy * yy);
}
else {
r = xx * xx + yy * yy;
rfsta2 = fstar2 * (xx * xx + yy * yy);
}
if (rfsta2 == 0.) {
fprintf(stderr, "ident. points in segm.\n");
fprintf(stderr, "x[%d]=%f, x[%d]=%f, y[%d]=%f, y[%d]=%f\n",
k - 1, points[k - 1].x, l - 1, points[l - 1].x, k - 1,
points[k - 1].y, l - 1, points[l - 1].y);
return -1;
}
i1 = k1 + l;
A[i1] = params->interp(r, params->fi);
}
}
/* C SYMMETRISATION */
amaxa = 1.;
for (k = 1; k <= n1; k++) {
k1 = (k - 1) * n1;
k2 = k + 1;
for (l = k2; l <= n1; l++) {
m = (l - 1) * n1 + k;
A[m] = A[k1 + l];
amaxa = amax1(A[m], amaxa);
}
}
m = 0;
for (i = 0; i <= n_points; i++) {
for (j = 0; j <= n_points; j++) {
m++;
matrix[i][j] = A[m];
}
}
G_debug(3, "calling G_ludcmp() n=%d indx=%d", n_points, *indx);
if (G_ludcmp(matrix, n_points + 1, indx, &d) <= 0) {
/* find the inverse of the matrix */
fprintf(stderr, "G_ludcmp() failed! n=%d d=%.2f\n", n_points, d);
return -1;
}
/* G_free_vector(A); */
return 1;
}
void process(void)
{
/*--------------------------------------------------------------------------*/
/* INITIALISE */
/*--------------------------------------------------------------------------*/
DCELL *row_in, /* Buffer large enough to hold `wsize' */
*row_out = NULL, /* raster rows. When GRASS reads in a */
/* raster row, each element is of type */
/* DCELL */
*window_ptr, /* Stores local terrain window. */
centre; /* Elevation of central cell in window. */
CELL *featrow_out = NULL; /* store features in CELL */
struct Cell_head region; /* Structure to hold region information */
int nrows, /* Will store the current number of */
ncols, /* rows and columns in the raster. */
row, col, /* Counts through each row and column */
/* of the input raster. */
wind_row, /* Counts through each row and column */
wind_col, /* of the local neighbourhood window. */
*index_ptr; /* Row permutation vector for LU decomp. */
double **normal_ptr, /* Cross-products matrix. */
*obs_ptr, /* Observed vector. */
temp; /* Unused */
double *weight_ptr; /* Weighting matrix for observed values. */
/*--------------------------------------------------------------------------*/
/* GET RASTER AND WINDOW DETAILS */
/*--------------------------------------------------------------------------*/
G_get_window(®ion); /* Fill out the region structure (the */
/* geographical limits etc.) */
nrows = Rast_window_rows(); /* Find out the number of rows and */
ncols = Rast_window_cols(); /* columns of the raster. */
if ((region.ew_res / region.ns_res >= 1.01) || /* If EW and NS resolns are */
(region.ns_res / region.ew_res >= 1.01)) { /* >1% different, warn user. */
G_warning(_("E-W and N-S grid resolutions are different. Taking average."));
resoln = (region.ns_res + region.ew_res) / 2;
}
else
resoln = region.ns_res;
/*--------------------------------------------------------------------------*/
/* RESERVE MEMORY TO HOLD Z VALUES AND MATRICES */
/*--------------------------------------------------------------------------*/
row_in = (DCELL *) G_malloc(ncols * sizeof(DCELL) * wsize);
/* Reserve `wsize' rows of memory. */
if (mparam != FEATURE)
row_out = Rast_allocate_buf(DCELL_TYPE); /* Initialise output row buffer. */
else
featrow_out = Rast_allocate_buf(CELL_TYPE); /* Initialise output row buffer. */
window_ptr = (DCELL *) G_malloc(SQR(wsize) * sizeof(DCELL));
/* Reserve enough memory for local wind. */
weight_ptr = (double *)G_malloc(SQR(wsize) * sizeof(double));
/* Reserve enough memory weights matrix. */
normal_ptr = dmatrix(0, 5, 0, 5); /* Allocate memory for 6*6 matrix */
index_ptr = ivector(0, 5); /* and for 1D vector holding indices */
obs_ptr = dvector(0, 5); /* and for 1D vector holding observed z */
/* ---------------------------------------------------------------- */
/* - CALCULATE LEAST SQUARES COEFFICIENTS - */
/* ---------------------------------------------------------------- */
/*--- Calculate weighting matrix. ---*/
find_weight(weight_ptr);
/* Initial coefficients need only be found once since they are
constant for any given window size. The only element that
changes is the observed vector (RHS of normal equations). */
/*--- Find normal equations in matrix form. ---*/
find_normal(normal_ptr, weight_ptr);
/*--- Apply LU decomposition to normal equations. ---*/
if (constrained) {
G_ludcmp(normal_ptr, 5, index_ptr, &temp);
/* To constrain the quadtratic
through the central cell, ignore
the calculations involving the
coefficient f. Since these are
all in the last row and column of
the matrix, simply redimension. */
/* disp_matrix(normal_ptr,obs_ptr,obs_ptr,5);
*/
}
else {
G_ludcmp(normal_ptr, 6, index_ptr, &temp);
/* disp_matrix(normal_ptr,obs_ptr,obs_ptr,6);
*/
}
/*--------------------------------------------------------------------------*/
/* PROCESS INPUT RASTER AND WRITE OUT RASTER LINE BY LINE */
/*--------------------------------------------------------------------------*/
if (mparam != FEATURE)
for (wind_row = 0; wind_row < EDGE; wind_row++)
Rast_put_row(fd_out, row_out, DCELL_TYPE); /* Write out the edge cells as NULL. */
else
for (wind_row = 0; wind_row < EDGE; wind_row++)
Rast_put_row(fd_out, featrow_out, CELL_TYPE); /* Write out the edge cells as NULL. */
for (wind_row = 0; wind_row < wsize - 1; wind_row++)
Rast_get_row(fd_in, row_in + (wind_row * ncols), wind_row,
DCELL_TYPE);
/* Read in enough of the first rows to */
/* allow window to be examined. */
for (row = EDGE; row < (nrows - EDGE); row++) {
G_percent(row + 1, nrows - EDGE, 2);
Rast_get_row(fd_in, row_in + ((wsize - 1) * ncols), row + EDGE,
DCELL_TYPE);
for (col = EDGE; col < (ncols - EDGE); col++) {
/* Find central z value */
centre = *(row_in + EDGE * ncols + col);
for (wind_row = 0; wind_row < wsize; wind_row++)
for (wind_col = 0; wind_col < wsize; wind_col++)
/* Express all window values relative */
/* to the central elevation. */
*(window_ptr + (wind_row * wsize) + wind_col) =
*(row_in + (wind_row * ncols) + col + wind_col -
EDGE) - centre;
/*--- Use LU back substitution to solve normal equations. ---*/
find_obs(window_ptr, obs_ptr, weight_ptr);
/* disp_wind(window_ptr);
disp_matrix(normal_ptr,obs_ptr,obs_ptr,6);
*/
if (constrained) {
G_lubksb(normal_ptr, 5, index_ptr, obs_ptr);
/*
disp_matrix(normal_ptr,obs_ptr,obs_ptr,5);
*/
}
else {
G_lubksb(normal_ptr, 6, index_ptr, obs_ptr);
/*
disp_matrix(normal_ptr,obs_ptr,obs_ptr,6);
*/
}
/*--- Calculate terrain parameter based on quad. coefficients. ---*/
if (mparam == FEATURE)
*(featrow_out + col) = (CELL) feature(obs_ptr);
else
*(row_out + col) = param(mparam, obs_ptr);
if (mparam == ELEV)
*(row_out + col) += centre; /* Add central elevation back */
}
if (mparam != FEATURE)
Rast_put_row(fd_out, row_out, DCELL_TYPE); /* Write the row buffer to the output */
/* raster. */
else /* write FEATURE to CELL */
Rast_put_row(fd_out, featrow_out, CELL_TYPE); /* Write the row buffer to the output */
/* raster. */
/* 'Shuffle' rows down one, and read in */
/* one new row. */
for (wind_row = 0; wind_row < wsize - 1; wind_row++)
for (col = 0; col < ncols; col++)
*(row_in + (wind_row * ncols) + col) =
*(row_in + ((wind_row + 1) * ncols) + col);
}
for (wind_row = 0; wind_row < EDGE; wind_row++) {
if (mparam != FEATURE)
Rast_put_row(fd_out, row_out, DCELL_TYPE); /* Write out the edge cells as NULL. */
else
Rast_put_row(fd_out, featrow_out, CELL_TYPE); /* Write out the edge cells as NULL. */
}
/*--------------------------------------------------------------------------*/
/* FREE MEMORY USED TO STORE RASTER ROWS, LOCAL WINDOW AND MATRICES */
/*--------------------------------------------------------------------------*/
G_free(row_in);
if (mparam != FEATURE)
G_free(row_out);
else
G_free(featrow_out);
G_free(window_ptr);
free_dmatrix(normal_ptr, 0, 5, 0, 5);
free_dvector(obs_ptr, 0, 5);
free_ivector(index_ptr, 0, 5);
}
