/* ************************************************************************* */
int compare_array_2d(N_array_2d * a, N_array_2d * b)
{
int rows, cols, type;
int i, j, res = 0;
cols = a->cols;
rows = a->rows;
type = N_get_array_2d_type(a);
#pragma omp parallel for private (i, j) shared (cols, rows, type, a, b) reduction(+:res)
for (j = 0; j < rows; j++) {
for (i = 0; i < cols; i++) {
if (type == CELL_TYPE) {
if (N_get_array_2d_c_value(a, i, j) !=
N_get_array_2d_c_value(b, i, j))
res++;
}
if (type == FCELL_TYPE) {
if (N_get_array_2d_f_value(a, i, j) !=
N_get_array_2d_f_value(b, i, j))
res++;
}
if (type == DCELL_TYPE) {
if (N_get_array_2d_d_value(a, i, j) !=
N_get_array_2d_d_value(b, i, j))
res++;
}
}
}
return res;
}
/*!
* \brief Compute the transmission boundary condition in 2d
*
* This function calculates the transmission boundary condition
* for each cell with status N_CELL_TRANSMISSION. The surrounding
* gradient field is used to verfiy the flow direction. If a flow
* goes into a cell, the concentration (data->c) from the neighbour cell is
* added to the transmission cell. If the flow from several neighbour
* cells goes into the cell, the concentration mean is calculated.
*
* The new concentrations are written into the data->c_start array,
* so they can be handled by the matrix assembling function.
*
* \param data N_solute_transport_data2d *
* \return void *
* */
void N_calc_solute_transport_transmission_2d(N_solute_transport_data2d * data)
{
int i, j, count = 1;
int cols, rows;
double c;
N_gradient_2d grad;
cols = data->grad->cols;
rows = data->grad->rows;
G_debug(2,
"N_calc_solute_transport_transmission_2d: calculating transmission boundary");
for (j = 0; j < rows; j++) {
for (i = 0; i < cols; i++) {
if (N_get_array_2d_d_value(data->status, i, j) ==
N_CELL_TRANSMISSION) {
count = 0;
/*get the gradient neighbours */
N_get_gradient_2d(data->grad, &grad, i, j);
c = 0;
/*
c = N_get_array_2d_d_value(data->c_start, i, j);
if(c > 0)
count++;
*/
if (grad.WC > 0 &&
!N_is_array_2d_value_null(data->c, i - 1, j)) {
c += N_get_array_2d_d_value(data->c, i - 1, j);
count++;
}
if (grad.EC < 0 &&
!N_is_array_2d_value_null(data->c, i + 1, j)) {
c += N_get_array_2d_d_value(data->c, i + 1, j);
count++;
}
if (grad.NC < 0 &&
!N_is_array_2d_value_null(data->c, i, j - 1)) {
c += N_get_array_2d_d_value(data->c, i, j - 1);
count++;
}
if (grad.SC > 0 &&
!N_is_array_2d_value_null(data->c, i, j + 1)) {
c += N_get_array_2d_d_value(data->c, i, j + 1);
count++;
}
if (count != 0)
c = c / (double)count;
/*make sure it is not NAN */
if (c > 0 || c == 0 || c < 0)
N_put_array_2d_d_value(data->c_start, i, j, c);
}
}
}
return;
}
/* ************************************************************************* */
int fill_array_2d(N_array_2d * a)
{
int rows, cols, type;
int i, j, res = 0;
rows = a->rows;
cols = a->cols;
type = N_get_array_2d_type(a);
#pragma omp parallel for private (i, j) shared (cols, rows, type, a) reduction(+:res)
for (j = 0; j < rows; j++) {
for (i = 0; i < cols; i++) {
if (type == CELL_TYPE) {
N_put_array_2d_c_value(a, i, j, (CELL) i * (CELL) j);
if (N_get_array_2d_c_value(a, i, j) != (CELL) i * (CELL) j)
res++;
}
if (type == FCELL_TYPE) {
N_put_array_2d_f_value(a, i, j, (FCELL) i * (FCELL) j);
if (N_get_array_2d_f_value(a, i, j) != (FCELL) i * (FCELL) j)
res++;
}
if (type == DCELL_TYPE) {
N_put_array_2d_d_value(a, i, j, (DCELL) i * (DCELL) j);
if (N_get_array_2d_d_value(a, i, j) != (DCELL) i * (DCELL) j)
res++;
}
}
}
return res;
}
/* ************************************************************************* */
void
copy_result(N_array_2d * status, N_array_2d * phead_start, double *result,
struct Cell_head *region, N_array_2d * target)
{
int y, x, rows, cols, count, stat;
double d1 = 0;
DCELL val;
rows = region->rows;
cols = region->cols;
count = 0;
for (y = 0; y < rows; y++) {
G_percent(y, rows - 1, 10);
for (x = 0; x < cols; x++) {
stat = N_get_array_2d_c_value(status, x, y);
if (stat == N_CELL_ACTIVE) { /*only active cells */
d1 = result[count];
val = (DCELL) d1;
count++;
}
else if (stat == N_CELL_DIRICHLET) { /*dirichlet cells */
d1 = N_get_array_2d_d_value(phead_start, x, y);
val = (DCELL) d1;
count++;
}
else {
G_set_null_value(&val, 1, DCELL_TYPE);
}
N_put_array_2d_d_value(target, x, y, val);
}
}
return;
}
/* **************************************************************** */
int make_les_entry_2d(int i, int j, int offset_i, int offset_j, int count,
int pos, N_les * les, G_math_spvector * spvect,
N_array_2d * cell_count, N_array_2d * status,
N_array_2d * start_val, double entry, int cell_type)
{
int K;
int di = offset_i;
int dj = offset_j;
K = N_get_array_2d_c_value(cell_count, i + di, j + dj) -
N_get_array_2d_c_value(cell_count, i, j);
/* active cells build the linear equation system */
if (cell_type == N_CELL_ACTIVE) {
/* dirichlet or transmission cells must be handled like this */
if (N_get_array_2d_c_value(status, i + di, j + dj) > N_CELL_ACTIVE &&
N_get_array_2d_c_value(status, i + di, j + dj) < N_MAX_CELL_STATE)
les->b[count] -=
N_get_array_2d_d_value(start_val, i + di, j + dj) * entry;
else if (N_get_array_2d_c_value(status, i + di, j + dj) ==
N_CELL_ACTIVE) {
if ((count + K) >= 0 && (count + K) < les->cols) {
G_debug(5,
" make_les_entry_2d: (N_CELL_ACTIVE) create matrix entry at row[%i] col[%i] value %g\n",
count, count + K, entry);
pos++;
if (les->type == N_SPARSE_LES) {
spvect->index[pos] = count + K;
spvect->values[pos] = entry;
}
else {
les->A[count][count + K] = entry;
}
}
}
} /* if dirichlet cells should be used then check for all valid cell neighbours */
else if (cell_type == N_CELL_DIRICHLET) {
/* all valid cells */
if (N_get_array_2d_c_value(status, i + di, j + dj) > N_CELL_INACTIVE
&& N_get_array_2d_c_value(status, i + di,
j + dj) < N_MAX_CELL_STATE) {
if ((count + K) >= 0 && (count + K) < les->cols) {
G_debug(5,
" make_les_entry_2d: (N_CELL_DIRICHLET) create matrix entry at row[%i] col[%i] value %g\n",
count, count + K, entry);
pos++;
if (les->type == N_SPARSE_LES) {
spvect->index[pos] = count + K;
spvect->values[pos] = entry;
}
else {
les->A[count][count + K] = entry;
}
}
}
}
return pos;
}
/*!
* \brief Write info and content of the N_array_2d struct to stdout
*
* Offsets are ignored
*
* \param data N_array_2d *
* \return void
* */
void N_print_array_2d(N_array_2d * data)
{
int i, j;
N_print_array_2d_info(data);
for (j = 0 - data->offset; j < data->rows + data->offset; j++) {
for (i = 0 - data->offset; i < data->cols + data->offset; i++) {
if (data->type == CELL_TYPE)
fprintf(stdout, "%6d ", N_get_array_2d_c_value(data, i, j));
else if (data->type == FCELL_TYPE)
fprintf(stdout, "%6.6f ", N_get_array_2d_f_value(data, i, j));
else if (data->type == DCELL_TYPE)
printf("%6.6f ", N_get_array_2d_d_value(data, i, j));
}
fprintf(stdout, "\n");
}
fprintf(stdout, "\n");
return;
}
/*!
* \brief This callback function creates the mass balance of a 5 point star
*
* The mass balance is based on the common solute transport equation:
*
* \f[\frac{\partial c_g}{\partial t} R = \nabla \cdot ({\bf D} \nabla c_g - {\bf u} c_g) + \sigma + \frac{q}{n_f}(c_g - c_in) \f]
*
* This equation is discretizised with the finite volume method in two dimensions.
*
*
* \param solutedata * N_solute_transport_data2d - a void pointer to the data structure
* \param geom N_geom_data *
* \param col int
* \param row int
* \return N_data_star * - a five point data star
*
* */
N_data_star *N_callback_solute_transport_2d(void *solutedata,
N_geom_data * geom, int col,
int row)
{
double Df_e = 0, Df_w = 0, Df_n = 0, Df_s = 0;
double z_e = 0, z_w = 0, z_n = 0, z_s = 0;
double dx, dy, Az;
double diff_x, diff_y;
double disp_x, disp_y;
double z;
double diff_xw, diff_yn;
double disp_xw, disp_yn;
double z_xw, z_yn;
double diff_xe, diff_ys;
double disp_xe, disp_ys;
double z_xe, z_ys;
double cin = 0, cg, cg_start;
double R, nf, cs, q;
double C, W, E, N, S, V, NE, NW, SW, SE;
double vw = 0, ve = 0, vn = 0, vs = 0;
double Ds_w = 0, Ds_e = 0, Ds_n = 0, Ds_s = 0;
double Dw = 0, De = 0, Dn = 0, Ds = 0;
double rw = 0.5, re = 0.5, rn = 0.5, rs = 0.5;
N_solute_transport_data2d *data = NULL;
N_data_star *mat_pos;
N_gradient_2d grad;
/*cast the void pointer to the right data structure */
data = (N_solute_transport_data2d *) solutedata;
N_get_gradient_2d(data->grad, &grad, col, row);
dx = geom->dx;
dy = geom->dy;
Az = N_get_geom_data_area_of_cell(geom, row);
/*read the data from the arrays */
cg_start = N_get_array_2d_d_value(data->c_start, col, row);
cg = N_get_array_2d_d_value(data->c, col, row);
/* calculate the cell height */
z = N_get_array_2d_d_value(data->top, col,
row) -
N_get_array_2d_d_value(data->bottom, col, row);
z_xw =
N_get_array_2d_d_value(data->top, col - 1,
row) -
N_get_array_2d_d_value(data->bottom, col - 1, row);
z_xe =
N_get_array_2d_d_value(data->top, col + 1,
row) -
N_get_array_2d_d_value(data->bottom, col + 1, row);
z_yn =
N_get_array_2d_d_value(data->top, col,
row - 1) -
N_get_array_2d_d_value(data->bottom, col, row - 1);
z_ys =
N_get_array_2d_d_value(data->top, col,
row + 1) -
N_get_array_2d_d_value(data->bottom, col, row + 1);
/*geometrical mean of cell height */
z_w = N_calc_geom_mean(z_xw, z);
z_e = N_calc_geom_mean(z_xe, z);
z_n = N_calc_geom_mean(z_yn, z);
z_s = N_calc_geom_mean(z_ys, z);
/*get the surrounding diffusion tensor entries */
diff_x = N_get_array_2d_d_value(data->diff_x, col, row);
diff_y = N_get_array_2d_d_value(data->diff_y, col, row);
diff_xw = N_get_array_2d_d_value(data->diff_x, col - 1, row);
diff_xe = N_get_array_2d_d_value(data->diff_x, col + 1, row);
diff_yn = N_get_array_2d_d_value(data->diff_y, col, row - 1);
diff_ys = N_get_array_2d_d_value(data->diff_y, col, row + 1);
/* calculate the diffusion at the cell borders using the harmonical mean */
Df_w = N_calc_harmonic_mean(diff_xw, diff_x);
Df_e = N_calc_harmonic_mean(diff_xe, diff_x);
Df_n = N_calc_harmonic_mean(diff_yn, diff_y);
Df_s = N_calc_harmonic_mean(diff_ys, diff_y);
/* calculate the dispersion */
/*get the surrounding dispersion tensor entries */
disp_x = N_get_array_2d_d_value(data->disp_xx, col, row);
disp_y = N_get_array_2d_d_value(data->disp_yy, col, row);
if (N_get_array_2d_d_value(data->status, col - 1, row) ==
N_CELL_TRANSMISSION) {
disp_xw = disp_x;
}
else {
disp_xw = N_get_array_2d_d_value(data->disp_xx, col - 1, row);
}
if (N_get_array_2d_d_value(data->status, col + 1, row) ==
N_CELL_TRANSMISSION) {
disp_xe = disp_x;
}
else {
disp_xe = N_get_array_2d_d_value(data->disp_xx, col + 1, row);
}
if (N_get_array_2d_d_value(data->status, col, row - 1) ==
N_CELL_TRANSMISSION) {
disp_yn = disp_y;
}
else {
disp_yn = N_get_array_2d_d_value(data->disp_yy, col, row - 1);
}
if (N_get_array_2d_d_value(data->status, col, row + 1) ==
N_CELL_TRANSMISSION) {
disp_ys = disp_y;
}
else {
disp_ys = N_get_array_2d_d_value(data->disp_yy, col, row + 1);
}
/* calculate the dispersion at the cell borders using the harmonical mean */
Ds_w = N_calc_harmonic_mean(disp_xw, disp_x);
Ds_e = N_calc_harmonic_mean(disp_xe, disp_x);
Ds_n = N_calc_harmonic_mean(disp_yn, disp_y);
Ds_s = N_calc_harmonic_mean(disp_ys, disp_y);
/* put the diffusion and dispersion together */
Dw = ((Df_w + Ds_w)) / dx;
De = ((Df_e + Ds_e)) / dx;
Ds = ((Df_s + Ds_s)) / dy;
Dn = ((Df_n + Ds_n)) / dy;
vw = -1.0 * grad.WC;
ve = grad.EC;
vs = -1.0 * grad.SC;
vn = grad.NC;
if (data->stab == N_UPWIND_FULL) {
rw = N_full_upwinding(vw, dx, Dw);
re = N_full_upwinding(ve, dx, De);
rs = N_full_upwinding(vs, dy, Ds);
rn = N_full_upwinding(vn, dy, Dn);
}
else if (data->stab == N_UPWIND_EXP) {
rw = N_exp_upwinding(vw, dx, Dw);
re = N_exp_upwinding(ve, dx, De);
rs = N_exp_upwinding(vs, dy, Ds);
rn = N_exp_upwinding(vn, dy, Dn);
}
/*mass balance center cell to western cell */
W = -1 * (Dw) * dy * z_w + vw * (1 - rw) * dy * z_w;
/*mass balance center cell to eastern cell */
E = -1 * (De) * dy * z_e + ve * (1 - re) * dy * z_e;
/*mass balance center cell to southern cell */
S = -1 * (Ds) * dx * z_s + vs * (1 - rs) * dx * z_s;
/*mass balance center cell to northern cell */
N = -1 * (Dn) * dx * z_n + vn * (1 - rn) * dx * z_n;
NW = 0.0;
SW = 0.0;
NE = 0.0;
SE = 0.0;
/* Retardation */
R = N_get_array_2d_d_value(data->R, col, row);
/* Inner sources */
cs = N_get_array_2d_d_value(data->cs, col, row);
/* effective porosity */
nf = N_get_array_2d_d_value(data->nf, col, row);
/* groundwater sources and sinks */
q = N_get_array_2d_d_value(data->q, col, row);
/* concentration of influent water */
cin = N_get_array_2d_d_value(data->cin, col, row);
/*the diagonal entry of the matrix */
C = (Dw + vw * rw) * dy * z_w +
(De + ve * re) * dy * z_e +
(Ds + vs * rs) * dx * z_s +
(Dn + vn * rn) * dx * z_n + Az * z * R / data->dt - q / nf;
/*the entry in the right side b of Ax = b */
V = (cs + cg_start * Az * z * R / data->dt + q / nf * cin);
/*
fprintf(stderr, "nf %g\n", nf);
fprintf(stderr, "q %g\n", q);
fprintf(stderr, "cs %g\n", cs);
fprintf(stderr, "cin %g\n", cin);
fprintf(stderr, "cg %g\n", cg);
fprintf(stderr, "cg_start %g\n", cg_start);
fprintf(stderr, "Az %g\n", Az);
fprintf(stderr, "z %g\n", z);
fprintf(stderr, "R %g\n", R);
fprintf(stderr, "dt %g\n", data->dt);
*/
G_debug(6, "N_callback_solute_transport_2d: called [%i][%i]", row, col);
/*create the 9 point star entries */
mat_pos = N_create_9star(C, W, E, N, S, NW, SW, NE, SE, V);
return mat_pos;
}
/*!
* \brief Integrate Dirichlet or Transmission boundary conditions into the les (2s)
*
* Dirichlet and Transmission boundary conditions will be integrated into
* the provided linear equation system. This is meaningfull if
* the les was created with #N_assemble_les_2d_dirichlet, because in
* this case Dirichlet boundary conditions are not automatically included.
*
* The provided les will be modified:
*
* Ax = b will be splitted into Ax_u + Ax_d = b
*
* x_u - the unknowns
* x_d - the Dirichlet cells
*
* Ax_u = b -Ax_d will be computed. Then the matrix A will be modified to
*
* | A_u 0 | x_u
* | 0 I | x_d
*
* \param les N_les* -- the linear equation system
* \param geom N_geom_data* -- geometrical data information
* \param status N_array_2d* -- the status array containing the cell types
* \param start_val N_array_2d* -- an array with start values
* \return int -- 1 = success, 0 = failure
* */
int N_les_integrate_dirichlet_2d(N_les * les, N_geom_data * geom,
N_array_2d * status, N_array_2d * start_val)
{
int rows, cols;
int count = 0;
int i, j, x, y, stat;
double *dvect1;
double *dvect2;
G_debug(2,
"N_les_integrate_dirichlet_2d: integrating the dirichlet boundary condition");
rows = geom->rows;
cols = geom->cols;
/*we nned to additional vectors */
dvect1 = (double *)G_calloc(les->cols, sizeof(double));
dvect2 = (double *)G_calloc(les->cols, sizeof(double));
/*fill the first one with the x vector data of Dirichlet cells */
count = 0;
for (y = 0; y < rows; y++) {
for (x = 0; x < cols; x++) {
stat = N_get_array_2d_c_value(status, x, y);
if (stat > N_CELL_ACTIVE && stat < N_MAX_CELL_STATE) {
dvect1[count] = N_get_array_2d_d_value(start_val, x, y);
count++;
}
else if (stat == N_CELL_ACTIVE) {
dvect1[count] = 0.0;
count++;
}
}
}
#pragma omp parallel default(shared)
{
/*perform the matrix vector product and */
if (les->type == N_SPARSE_LES)
G_math_Ax_sparse(les->Asp, dvect1, dvect2, les->rows);
else
G_math_d_Ax(les->A, dvect1, dvect2, les->rows, les->cols);
#pragma omp for schedule (static) private(i)
for (i = 0; i < les->cols; i++)
les->b[i] = les->b[i] - dvect2[i];
}
/*now set the Dirichlet cell rows and cols to zero and the
* diagonal entry to 1*/
count = 0;
for (y = 0; y < rows; y++) {
for (x = 0; x < cols; x++) {
stat = N_get_array_2d_c_value(status, x, y);
if (stat > N_CELL_ACTIVE && stat < N_MAX_CELL_STATE) {
if (les->type == N_SPARSE_LES) {
/*set the rows to zero */
for (i = 0; i < les->Asp[count]->cols; i++)
les->Asp[count]->values[i] = 0.0;
/*set the cols to zero */
for (i = 0; i < les->rows; i++) {
for (j = 0; j < les->Asp[i]->cols; j++) {
if (les->Asp[i]->index[j] == count)
les->Asp[i]->values[j] = 0.0;
}
}
/*entry on the diagonal */
les->Asp[count]->values[0] = 1.0;
}
else {
/*set the rows to zero */
for (i = 0; i < les->cols; i++)
les->A[count][i] = 0.0;
/*set the cols to zero */
for (i = 0; i < les->rows; i++)
les->A[i][count] = 0.0;
/*entry on the diagonal */
les->A[count][count] = 1.0;
}
}
if (stat >= N_CELL_ACTIVE)
count++;
}
}
return 0;
}
/*!
* \brief Assemble a linear equation system (les) based on 2d location data (raster)
*
*
* The linear equation system type can be set to N_NORMAL_LES to create a regular
* matrix, or to N_SPARSE_LES to create a sparse matrix. This function returns
* a new created linear equation system which can be solved with
* linear equation solvers. An 2d array with start values and an 2d status array
* must be provided as well as the location geometry and a void pointer to data
* passed to the callback which creates the les row entries. This callback
* must be defined in the N_les_callback_2d strcuture.
*
* The creation of the les is parallelized with OpenMP.
* If you implement new callbacks, please make sure that the
* function calls are thread safe.
*
*
* the les can be created in two ways, with dirichlet and similar cells and without them,
* to spare some memory. If the les is created with dirichlet cell, the dirichlet boundary condition
* must be added.
*
* \param les_type int
* \param geom N_geom_data*
* \param status N_array_2d *
* \param start_val N_array_2d *
* \param data void *
* \param cell_type int -- les assemble based on N_CELL_ACTIVE or N_CELL_DIRICHLET
* \param call N_les_callback_2d *
* \return N_les *
* */
N_les *N_assemble_les_2d_param(int les_type, N_geom_data * geom,
N_array_2d * status, N_array_2d * start_val,
void *data, N_les_callback_2d * call,
int cell_type)
{
int i, j, count = 0, pos = 0;
int cell_type_count = 0;
int **index_ij;
N_array_2d *cell_count;
N_les *les = NULL;
G_debug(2,
"N_assemble_les_2d: starting to assemble the linear equation system");
/* At first count the number of valid cells and save
* each number in a new 2d array. Those numbers are used
* to create the linear equation system.
* */
cell_count = N_alloc_array_2d(geom->cols, geom->rows, 1, CELL_TYPE);
/* include dirichlet cells in the les */
if (cell_type == N_CELL_DIRICHLET) {
for (j = 0; j < geom->rows; j++) {
for (i = 0; i < geom->cols; i++) {
/*use all non-inactive cells for les creation */
if (N_CELL_INACTIVE < N_get_array_2d_c_value(status, i, j) &&
N_get_array_2d_c_value(status, i, j) < N_MAX_CELL_STATE)
cell_type_count++;
}
}
}
/*use only active cell in the les */
if (cell_type == N_CELL_ACTIVE) {
for (j = 0; j < geom->rows; j++) {
for (i = 0; i < geom->cols; i++) {
/*count only active cells */
if (N_CELL_ACTIVE == N_get_array_2d_d_value(status, i, j))
cell_type_count++;
}
}
}
G_debug(2, "N_assemble_les_2d: number of used cells %i\n",
cell_type_count);
if (cell_type_count == 0)
G_fatal_error
("Not enough cells [%i] to create the linear equation system. Check the cell status. Only active cells (value = 1) are used to create the equation system.",
cell_type_count);
/* Then allocate the memory for the linear equation system (les).
* Only valid cells are used to create the les. */
index_ij = (int **)G_calloc(cell_type_count, sizeof(int *));
for (i = 0; i < cell_type_count; i++)
index_ij[i] = (int *)G_calloc(2, sizeof(int));
les = N_alloc_les_Ax_b(cell_type_count, les_type);
count = 0;
/*count the number of cells which should be used to create the linear equation system */
/*save the i and j indices and create a ordered numbering */
for (j = 0; j < geom->rows; j++) {
for (i = 0; i < geom->cols; i++) {
/*count every non-inactive cell */
if (cell_type == N_CELL_DIRICHLET) {
if (N_CELL_INACTIVE < N_get_array_2d_c_value(status, i, j) &&
N_get_array_2d_c_value(status, i, j) < N_MAX_CELL_STATE) {
N_put_array_2d_c_value(cell_count, i, j, count);
index_ij[count][0] = i;
index_ij[count][1] = j;
count++;
G_debug(5,
"N_assemble_les_2d: non-inactive cells count %i at pos x[%i] y[%i]\n",
count, i, j);
}
/*count every active cell */
}
else if (N_CELL_ACTIVE == N_get_array_2d_c_value(status, i, j)) {
N_put_array_2d_c_value(cell_count, i, j, count);
index_ij[count][0] = i;
index_ij[count][1] = j;
count++;
G_debug(5,
"N_assemble_les_2d: active cells count %i at pos x[%i] y[%i]\n",
count, i, j);
}
}
}
G_debug(2, "N_assemble_les_2d: starting the parallel assemble loop");
/* Assemble the matrix in parallel */
#pragma omp parallel for private(i, j, pos, count) schedule(static)
for (count = 0; count < cell_type_count; count++) {
i = index_ij[count][0];
j = index_ij[count][1];
/*create the entries for the */
N_data_star *items = call->callback(data, geom, i, j);
/* we need a sparse vector pointer anytime */
G_math_spvector *spvect = NULL;
/*allocate a sprase vector */
if (les_type == N_SPARSE_LES) {
spvect = G_math_alloc_spvector(items->count);
}
/* initial conditions */
les->x[count] = N_get_array_2d_d_value(start_val, i, j);
/* the entry in the vector b */
les->b[count] = items->V;
/* pos describes the position in the sparse vector.
* the first entry is always the diagonal entry of the matrix*/
pos = 0;
if (les_type == N_SPARSE_LES) {
spvect->index[pos] = count;
spvect->values[pos] = items->C;
}
else {
les->A[count][count] = items->C;
}
/* western neighbour, entry is col - 1 */
if (i > 0) {
pos = make_les_entry_2d(i, j, -1, 0, count, pos, les, spvect,
cell_count, status, start_val, items->W,
cell_type);
}
/* eastern neighbour, entry col + 1 */
if (i < geom->cols - 1) {
pos = make_les_entry_2d(i, j, 1, 0, count, pos, les, spvect,
cell_count, status, start_val, items->E,
cell_type);
}
/* northern neighbour, entry row - 1 */
if (j > 0) {
pos =
make_les_entry_2d(i, j, 0, -1, count, pos, les, spvect,
cell_count, status, start_val, items->N,
cell_type);
}
/* southern neighbour, entry row + 1 */
if (j < geom->rows - 1) {
pos = make_les_entry_2d(i, j, 0, 1, count, pos, les, spvect,
cell_count, status, start_val, items->S,
cell_type);
}
/*in case of a nine point star, we have additional entries */
if (items->type == N_9_POINT_STAR) {
/* north-western neighbour, entry is col - 1 row - 1 */
if (i > 0 && j > 0) {
pos = make_les_entry_2d(i, j, -1, -1, count, pos, les, spvect,
cell_count, status, start_val,
items->NW, cell_type);
}
/* north-eastern neighbour, entry col + 1 row - 1 */
if (i < geom->cols - 1 && j > 0) {
pos = make_les_entry_2d(i, j, 1, -1, count, pos, les, spvect,
cell_count, status, start_val,
items->NE, cell_type);
}
/* south-western neighbour, entry is col - 1 row + 1 */
if (i > 0 && j < geom->rows - 1) {
pos = make_les_entry_2d(i, j, -1, 1, count, pos, les, spvect,
cell_count, status, start_val,
items->SW, cell_type);
}
/* south-eastern neighbour, entry col + 1 row + 1 */
if (i < geom->cols - 1 && j < geom->rows - 1) {
pos = make_les_entry_2d(i, j, 1, 1, count, pos, les, spvect,
cell_count, status, start_val,
items->SE, cell_type);
}
}
/*How many entries in the les */
if (les->type == N_SPARSE_LES) {
spvect->cols = pos + 1;
G_math_add_spvector(les->Asp, spvect, count);
}
if (items)
G_free(items);
}
/*release memory */
N_free_array_2d(cell_count);
for (i = 0; i < cell_type_count; i++)
G_free(index_ij[i]);
G_free(index_ij);
return les;
}
/* ************************************************************************* */
int main(int argc, char *argv[])
{
struct GModule *module = NULL;
N_solute_transport_data2d *data = NULL;
N_geom_data *geom = NULL;
N_les *les = NULL;
N_les_callback_2d *call = NULL;
struct Cell_head region;
double error, sor;
char *solver;
int x, y, stat, i, maxit = 1;
double loops = 1;
N_array_2d *xcomp = NULL;
N_array_2d *ycomp = NULL;
N_array_2d *hc_x = NULL;
N_array_2d *hc_y = NULL;
N_array_2d *phead = NULL;
double time_step, cfl, length, time_loops, time_sum;
/* Initialize GRASS */
G_gisinit(argv[0]);
module = G_define_module();
G_add_keyword(_("raster"));
G_add_keyword(_("hydrology"));
G_add_keyword(_("solute transport"));
module->description =
_("Numerical calculation program for transient, confined and unconfined "
"solute transport in two dimensions");
/* Get parameters from user */
set_params();
if (G_parser(argc, argv))
exit(EXIT_FAILURE);
/* Make sure that the current projection is not lat/long */
if ((G_projection() == PROJECTION_LL))
G_fatal_error(_("Lat/Long location is not supported by %s. Please reproject map first."),
G_program_name());
/*Set the maximum iterations */
sscanf(param.maxit->answer, "%i", &(maxit));
/*Set the calculation error break criteria */
sscanf(param.error->answer, "%lf", &(error));
sscanf(param.sor->answer, "%lf", &(sor));
/*number of loops*/
sscanf(param.loops->answer, "%lf", &(loops));
/*Set the solver */
solver = param.solver->answer;
if (strcmp(solver, G_MATH_SOLVER_DIRECT_LU) == 0 && !param.full_les->answer)
G_fatal_error(_("The direct LU solver do not work with sparse matrices"));
if (strcmp(solver, G_MATH_SOLVER_DIRECT_GAUSS) == 0 && !param.full_les->answer)
G_fatal_error(_("The direct Gauss solver do not work with sparse matrices"));
/*get the current region */
G_get_set_window(®ion);
/*allocate the geometry structure for geometry and area calculation */
geom = N_init_geom_data_2d(®ion, geom);
/*Set the function callback to the groundwater flow function */
call = N_alloc_les_callback_2d();
N_set_les_callback_2d_func(call, (*N_callback_solute_transport_2d)); /*solute_transport 2d */
/*Allocate the groundwater flow data structure */
data = N_alloc_solute_transport_data2d(geom->cols, geom->rows);
/*Set the stabilizing scheme*/
if (strncmp("full", param.stab->answer, 4) == 0) {
data->stab = N_UPWIND_FULL;
}
if (strncmp("exp", param.stab->answer, 3) == 0) {
data->stab = N_UPWIND_EXP;
}
/*the dispersivity lengths*/
sscanf(param.al->answer, "%lf", &(data->al));
sscanf(param.at->answer, "%lf", &(data->at));
/*Set the calculation time */
sscanf(param.dt->answer, "%lf", &(data->dt));
/*read all input maps into the memory and take care of the
* null values.*/
N_read_rast_to_array_2d(param.c->answer, data->c);
N_convert_array_2d_null_to_zero(data->c);
N_read_rast_to_array_2d(param.c->answer, data->c_start);
N_convert_array_2d_null_to_zero(data->c_start);
N_read_rast_to_array_2d(param.status->answer, data->status);
N_convert_array_2d_null_to_zero(data->status);
N_read_rast_to_array_2d(param.diff_x->answer, data->diff_x);
N_convert_array_2d_null_to_zero(data->diff_x);
N_read_rast_to_array_2d(param.diff_y->answer, data->diff_y);
N_convert_array_2d_null_to_zero(data->diff_y);
N_read_rast_to_array_2d(param.q->answer, data->q);
N_convert_array_2d_null_to_zero(data->q);
N_read_rast_to_array_2d(param.nf->answer, data->nf);
N_convert_array_2d_null_to_zero(data->nf);
N_read_rast_to_array_2d(param.cs->answer, data->cs);
N_convert_array_2d_null_to_zero(data->cs);
N_read_rast_to_array_2d(param.top->answer, data->top);
N_convert_array_2d_null_to_zero(data->top);
N_read_rast_to_array_2d(param.bottom->answer, data->bottom);
N_convert_array_2d_null_to_zero(data->bottom);
N_read_rast_to_array_2d(param.r->answer, data->R);
N_convert_array_2d_null_to_zero(data->R);
if(param.cin->answer) {
N_read_rast_to_array_2d(param.cin->answer, data->cin);
N_convert_array_2d_null_to_zero(data->cin);
}
/*initiate the values for velocity calculation*/
hc_x = N_alloc_array_2d(geom->cols, geom->rows, 1, DCELL_TYPE);
hc_x = N_read_rast_to_array_2d(param.hc_x->answer, hc_x);
N_convert_array_2d_null_to_zero(hc_x);
hc_y = N_alloc_array_2d(geom->cols, geom->rows, 1, DCELL_TYPE);
hc_y = N_read_rast_to_array_2d(param.hc_y->answer, hc_y);
N_convert_array_2d_null_to_zero(hc_y);
phead = N_alloc_array_2d(geom->cols, geom->rows, 1, DCELL_TYPE);
phead = N_read_rast_to_array_2d(param.phead->answer, phead);
N_convert_array_2d_null_to_zero(phead);
/* Set the inactive values to zero, to assure a no flow boundary */
for (y = 0; y < geom->rows; y++) {
for (x = 0; x < geom->cols; x++) {
stat = (int)N_get_array_2d_d_value(data->status, x, y);
if (stat == N_CELL_INACTIVE) { /*only inactive cells */
N_put_array_2d_d_value(data->diff_x, x, y, 0);
N_put_array_2d_d_value(data->diff_y, x, y, 0);
N_put_array_2d_d_value(data->cs, x, y, 0);
N_put_array_2d_d_value(data->q, x, y, 0);
}
}
}
/*compute the velocities */
N_math_array_2d(hc_x, data->nf, hc_x, N_ARRAY_DIV);
N_math_array_2d(hc_y, data->nf, hc_y, N_ARRAY_DIV);
N_compute_gradient_field_2d(phead, hc_x, hc_y, geom, data->grad);
/*Now compute the dispersivity tensor*/
N_calc_solute_transport_disptensor_2d(data);
/***************************************/
/*the Courant-Friedrichs-Lewy criteria */
/*Compute the correct time step */
if (geom->dx > geom->dy)
length = geom->dx;
else
length = geom->dy;
if (fabs(data->grad->max) > fabs(data->grad->min)) {
cfl = (double)data->dt * fabs(data->grad->max) / length;
time_step = 1*length / fabs(data->grad->max);
}
else {
cfl = (double)data->dt * fabs(data->grad->min) / length;
time_step = 1*length / fabs(data->grad->min);
}
G_message(_("The Courant-Friedrichs-Lewy criteria is %g it should be within [0:1]"), cfl);
G_message(_("The largest stable time step is %g"), time_step);
/*Set the number of inner loops and the time step*/
if (data->dt > time_step && param.cfl->answer) {
/*safe the user time step */
time_sum = data->dt;
time_loops = data->dt / time_step;
time_loops = floor(time_loops) + 1;
data->dt = data->dt / time_loops;
G_message(_("Number of inner loops is %g"), time_loops);
G_message(_("Time step for each loop %g"), data->dt);
}
else {
if(data->dt > time_step)
G_warning(_("The time step is to large: %gs. The largest time step should be of size %gs."), data->dt, time_step);
time_loops = loops;
data->dt = data->dt / loops;
}
N_free_array_2d(phead);
N_free_array_2d(hc_x);
N_free_array_2d(hc_y);
/*Compute for each time step*/
for (i = 0; i < time_loops; i++) {
G_message(_("Time step %i with time sum %g"), i + 1, (i + 1)*data->dt);
/*assemble the linear equation system and solve it */
les = create_solve_les(geom, data, call, solver, maxit, error, sor);
/* copy the result into the c array for output */
copy_result(data->status, data->c_start, les->x, ®ion, data->c, 1);
N_convert_array_2d_null_to_zero(data->c_start);
if (les)
N_free_les(les);
/*Set the start array*/
N_copy_array_2d(data->c, data->c_start);
/*Set the transmission boundary*/
N_calc_solute_transport_transmission_2d(data);
}
/*write the result to the output file */
N_write_array_2d_to_rast(data->c, param.output->answer);
/*Compute the the velocity field if required and write the result into three rast maps */
if (param.vector_x->answer || param.vector_y->answer) {
xcomp = N_alloc_array_2d(geom->cols, geom->rows, 1, DCELL_TYPE);
ycomp = N_alloc_array_2d(geom->cols, geom->rows, 1, DCELL_TYPE);
N_compute_gradient_field_components_2d(data->grad, xcomp, ycomp);
if (param.vector_x->answer)
N_write_array_2d_to_rast(xcomp, param.vector_x->answer);
if (param.vector_y->answer)
N_write_array_2d_to_rast(ycomp, param.vector_y->answer);
if (xcomp)
N_free_array_2d(xcomp);
if (ycomp)
N_free_array_2d(ycomp);
}
if (data)
N_free_solute_transport_data2d(data);
if (geom)
N_free_geom_data(geom);
if (call)
G_free(call);
return (EXIT_SUCCESS);
}
