/* *************************************************************** */
N_solute_transport_data2d *create_solute_transport_data_2d(void)
{
int i, j;
N_solute_transport_data2d *data;
data =
N_alloc_solute_transport_data2d(TEST_N_NUM_COLS_LOCAL,
TEST_N_NUM_ROWS_LOCAL);
#pragma omp parallel for private (i, j) shared (data)
for (j = 0; j < TEST_N_NUM_ROWS_LOCAL; j++) {
for (i = 0; i < TEST_N_NUM_COLS_LOCAL; i++) {
if (j == 0) {
N_put_array_2d_d_value(data->c, i, j, 0);
N_put_array_2d_d_value(data->c_start, i, j, 0);
N_put_array_2d_d_value(data->status, i, j, 2);
}
else {
N_put_array_2d_d_value(data->c, i, j, 0);
N_put_array_2d_d_value(data->c_start, i, j, 0);
N_put_array_2d_d_value(data->status, i, j, 1);
}
N_put_array_2d_d_value(data->diff_x, i, j, 0.000001);
N_put_array_2d_d_value(data->diff_y, i, j, 0.000001);
N_put_array_2d_d_value(data->cs, i, j, 0.0);
N_put_array_2d_d_value(data->R, i, j, 1.0);
N_put_array_2d_d_value(data->q, i, j, 0.0);
N_put_array_2d_d_value(data->nf, i, j, 0.1);
N_put_array_2d_d_value(data->top, i, j, 20.0);
N_put_array_2d_d_value(data->bottom, i, j, 0.0);
if (j == 1 && i == 1)
N_put_array_2d_d_value(data->cs, i, j, 1.0);
}
}
/*dispersivity length */
data->al = 0.2;
data->at = 0.02;
return data;
}
/* ************************************************************************* */
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);
}
