/* *************************************************************** */
int io_bench_2d(void)
{
int sum = 0, res = 0;
char buff[1024];
struct Cell_head region;
N_array_2d *data1;
N_array_2d *data2;
N_array_2d *data3;
N_array_2d *tmp;
G_get_set_window(®ion);
data1 = N_alloc_array_2d(region.cols, region.rows, 0, CELL_TYPE);
data2 = N_alloc_array_2d(region.cols, region.rows, 0, FCELL_TYPE);
data3 = N_alloc_array_2d(region.cols, region.rows, 0, DCELL_TYPE);
fill_array_2d(data1);
fill_array_2d(data2);
fill_array_2d(data3);
/*raster IO methods */
N_write_array_2d_to_rast(data1, "gpde_lib_test_raster_1");
N_write_array_2d_to_rast(data2, "gpde_lib_test_raster_2");
N_write_array_2d_to_rast(data2, "gpde_lib_test_raster_3");
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_1", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_1", tmp);
N_free_array_2d(tmp);
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_2", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_2", tmp);
N_free_array_2d(tmp);
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_3", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_3", tmp);
N_free_array_2d(tmp);
sprintf(buff,
"g.remove rast=gpde_lib_test_raster_1,gpde_lib_test_raster_2,gpde_lib_test_raster_3");
system(buff);
N_free_array_2d(data1);
N_free_array_2d(data2);
N_free_array_2d(data3);
return sum;
}
/* *************************************************************** */
N_array_2d *create_value_array_2d(void)
{
N_array_2d *data;
int i, j;
data = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, DCELL_TYPE);
#pragma omp parallel for private (i, j) shared (data)
for (j = 0; j < TEST_N_NUM_ROWS; j++) {
for (i = 0; i < TEST_N_NUM_COLS; i++) {
if (j == 1) {
N_put_array_2d_d_value(data, i, j, 50);
}
else {
N_put_array_2d_d_value(data, i, j, 1);
}
}
}
return data;
}
N_solute_transport_data2d *N_alloc_solute_transport_data2d(int cols, int rows)
{
N_solute_transport_data2d *data = NULL;
data =
(N_solute_transport_data2d *) G_calloc(1,
sizeof
(N_solute_transport_data2d));
data->c = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->c_start = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->status = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->diff_x = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->diff_y = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->q = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->cs = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->R = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->nf = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->cin = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->top = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->bottom = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
/*Allocate the dispersivity tensor */
data->disp_xx = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->disp_yy = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->disp_xy = N_alloc_array_2d(cols, rows, 1, DCELL_TYPE);
data->grad = N_alloc_gradient_field_2d(cols, rows);
data->stab = N_UPWIND_EXP;
return data;
}
/* *************************************************************** */
int test_solute_transport_2d(void)
{
N_solute_transport_data2d *data = NULL;
N_geom_data *geom = NULL;
N_les *les = NULL;
N_les_callback_2d *call = NULL;
N_array_2d *pot, *relax = NULL;
N_gradient_field_2d *field = NULL;
int i, j;
/*set the callback */
call = N_alloc_les_callback_2d();
N_set_les_callback_2d_func(call, (*N_callback_solute_transport_2d));
pot =
N_alloc_array_2d(TEST_N_NUM_COLS_LOCAL, TEST_N_NUM_ROWS_LOCAL, 1,
DCELL_TYPE);
relax =
N_alloc_array_2d(TEST_N_NUM_COLS_LOCAL, TEST_N_NUM_ROWS_LOCAL, 1,
DCELL_TYPE);
data = create_solute_transport_data_2d();
data->dt = 600;
geom = N_alloc_geom_data();
geom->dx = 10;
geom->dy = 15;
geom->Az = 150;
geom->rows = TEST_N_NUM_ROWS_LOCAL;
geom->cols = TEST_N_NUM_COLS_LOCAL;
for (j = 0; j < TEST_N_NUM_ROWS_LOCAL; j++) {
for (i = 0; i < TEST_N_NUM_COLS_LOCAL; i++) {
N_put_array_2d_d_value(pot, i, j, j);
N_put_array_2d_d_value(relax, i, j, 1);
}
}
field = N_compute_gradient_field_2d(pot, relax, relax, geom, NULL);
N_copy_gradient_field_2d(field, data->grad);
N_free_gradient_field_2d(field);
N_compute_gradient_field_2d(pot, relax, relax, geom, data->grad);
/*The dispersivity tensor */
N_calc_solute_transport_disptensor_2d(data);
/*Assemble the matrix */
/*
*/
/*Jacobi */ les =
N_assemble_les_2d(N_SPARSE_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_jacobi(les, 100, 1, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*jacobi */ les =
N_assemble_les_2d(N_NORMAL_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_jacobi(les, 100, 1, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*SOR*/ les =
N_assemble_les_2d(N_SPARSE_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_SOR(les, 100, 1, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*SOR*/ les =
N_assemble_les_2d(N_NORMAL_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_SOR(les, 100, 1, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*BICG*/ les =
N_assemble_les_2d(N_SPARSE_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_bicgstab(les, 100, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*BICG*/ les =
N_assemble_les_2d(N_NORMAL_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_bicgstab(les, 100, 0.1e-8);
N_print_les(les);
N_free_les(les);
/*GAUSS*/ les =
N_assemble_les_2d(N_NORMAL_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_gauss(les);
N_print_les(les);
N_free_les(les);
/*LU*/ les =
N_assemble_les_2d(N_NORMAL_LES, geom, data->status, data->c_start,
(void *)data, call);
N_solver_lu(les);
N_print_les(les);
N_free_les(les);
N_free_solute_transport_data2d(data);
G_free(geom);
G_free(call);
return 0;
}
/* *************************************************************** */
int test_array_2d(void)
{
int sum = 0, res = 0;
struct Cell_head region;
N_array_2d *data1;
N_array_2d *data11;
N_array_2d *data2;
N_array_2d *data22;
N_array_2d *data3;
N_array_2d *data33;
char buff[1024];
double min, max, ssum;
int nonzero;
N_array_2d *tmp;
/*Alloacte memory for all arrays */
data1 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, CELL_TYPE);
N_print_array_2d_info(data1);
data11 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, CELL_TYPE);
data2 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, FCELL_TYPE);
N_print_array_2d_info(data2);
data22 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, FCELL_TYPE);
data3 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, DCELL_TYPE);
N_print_array_2d_info(data3);
data33 = N_alloc_array_2d(TEST_N_NUM_COLS, TEST_N_NUM_ROWS, 1, DCELL_TYPE);
/*Fill the first arrays with data */
res = fill_array_2d(data1);
if (res != 0)
G_warning("test_array_2d: error while filling array with values");
sum += res;
res = fill_array_2d(data2);
if (res != 0)
G_warning("test_array_2d: error while filling array with values");
sum += res;
res = fill_array_2d(data3);
if (res != 0)
G_warning("test_array_2d: error while filling array with values");
sum += res;
/*Copy the data */
N_copy_array_2d(data1, data11);
N_copy_array_2d(data2, data22);
N_copy_array_2d(data3, data33);
/*Compare the data */
res = compare_array_2d(data1, data11);
if (res != 0)
G_warning("test_array_2d: error in N_copy_array_2d");
sum += res;
res = compare_array_2d(data2, data22);
if (res != 0)
G_warning("test_array_2d: error in N_copy_array_2d");
sum += res;
res = compare_array_2d(data3, data33);
if (res != 0)
G_warning("test_array_2d: error in N_copy_array_2d");
sum += res;
/*compute statistics */
N_calc_array_2d_stats(data1, &min, &max, &ssum, &nonzero, 0);
G_message("CELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 100) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
N_calc_array_2d_stats(data1, &min, &max, &ssum, &nonzero, 1);
G_message("CELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 144) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
N_calc_array_2d_stats(data2, &min, &max, &ssum, &nonzero, 0);
G_message("FCELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 100) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
N_calc_array_2d_stats(data2, &min, &max, &ssum, &nonzero, 1);
G_message("FCELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 144) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
N_calc_array_2d_stats(data3, &min, &max, &ssum, &nonzero, 0);
G_message("DCELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 100) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
N_calc_array_2d_stats(data3, &min, &max, &ssum, &nonzero, 1);
G_message("DCELL Min %g Max %g Sum %g nonzero %i\n", min, max, ssum,
nonzero);
if (min != 0 || max != 81 || ssum != 2025 || nonzero != 144) {
G_warning("test_array_2d: error in N_calc_array_2d_stats");
sum++;
}
/*test the array math functions */
tmp = N_math_array_2d(data1, data2, NULL, N_ARRAY_SUM);
N_math_array_2d(data2, data2, tmp, N_ARRAY_SUM);
res = N_convert_array_2d_null_to_zero(tmp);
if (res != 0)
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum = res;
N_free_array_2d(tmp);
tmp = N_math_array_2d(data2, data3, NULL, N_ARRAY_DIF);
N_math_array_2d(data1, data2, tmp, N_ARRAY_DIF);
res = N_convert_array_2d_null_to_zero(tmp);
if (res != 0)
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum = res;
N_free_array_2d(tmp);
tmp = N_math_array_2d(data1, data1, NULL, N_ARRAY_MUL);
N_math_array_2d(data1, data1, tmp, N_ARRAY_MUL);
res = N_convert_array_2d_null_to_zero(tmp);
if (res != 0)
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum = res;
N_free_array_2d(tmp);
tmp = N_math_array_2d(data2, data3, NULL, N_ARRAY_DIV);
N_math_array_2d(data1, data2, tmp, N_ARRAY_DIV);
res = N_convert_array_2d_null_to_zero(tmp);
if (res == 0) { /* if a division with zero is detected, the value is set to null, not to nan */
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum++;
}
N_free_array_2d(tmp);
/*check for correct norm calculation */
if (N_norm_array_2d(data1, data11, N_EUKLID_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data1, data11, N_MAXIMUM_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data2, data3, N_EUKLID_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data2, data3, N_MAXIMUM_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
/*fill arrays with null values */
res = fill_array_2d_null(data1);
if (res != 0)
G_warning
("test_array_2d: error while filling array with cell null values");
sum += res;
res = fill_array_2d_null(data2);
if (res != 0)
G_warning
("test_array_2d: error while filling array with fcell null values");
sum += res;
res = fill_array_2d_null(data3);
if (res != 0)
G_warning
("test_array_2d: error while filling array with dcell null values");
sum += res;
/*Copy the data */
N_copy_array_2d(data1, data11);
N_copy_array_2d(data2, data22);
N_copy_array_2d(data3, data33);
/*Compare the data */
compare_array_2d(data1, data11);
compare_array_2d(data2, data22);
compare_array_2d(data3, data33);
/*check for correct norm calculation in case of null values */
if (N_norm_array_2d(data1, data11, N_EUKLID_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data1, data11, N_MAXIMUM_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data2, data3, N_EUKLID_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
if (N_norm_array_2d(data2, data3, N_MAXIMUM_NORM) != 0.0) {
G_warning("test_array_2d: error in N_norm_array_2d");
sum++;
}
/*test the array math functions with null values */
tmp = N_math_array_2d(data1, data11, NULL, N_ARRAY_SUM);
N_math_array_2d(data2, data22, tmp, N_ARRAY_SUM);
res = N_convert_array_2d_null_to_zero(tmp);
if (res == 0) {
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero ");
sum++;
}
N_free_array_2d(tmp);
tmp = N_math_array_2d(data2, data22, NULL, N_ARRAY_DIF);
N_math_array_2d(data3, data33, tmp, N_ARRAY_DIF);
res = N_convert_array_2d_null_to_zero(tmp);
if (res == 0) {
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum++;
}
N_free_array_2d(tmp);
tmp = N_math_array_2d(data1, data11, NULL, N_ARRAY_MUL);
N_math_array_2d(data3, data33, tmp, N_ARRAY_MUL);
res = N_convert_array_2d_null_to_zero(tmp);
if (res == 0) {
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum++;
}
N_free_array_2d(tmp);
tmp = N_math_array_2d(data2, data3, NULL, N_ARRAY_DIV);
N_math_array_2d(data1, data11, tmp, N_ARRAY_DIV);
res = N_convert_array_2d_null_to_zero(tmp);
if (res == 0) {
G_warning("test_array_2d: error in N_convert_array_2d_null_to_zero");
sum++;
}
N_free_array_2d(tmp);
N_free_array_2d(data1);
N_free_array_2d(data2);
N_free_array_2d(data3);
G_get_set_window(®ion);
data1 = N_alloc_array_2d(region.cols, region.rows, 0, CELL_TYPE);
data2 = N_alloc_array_2d(region.cols, region.rows, 0, FCELL_TYPE);
data3 = N_alloc_array_2d(region.cols, region.rows, 0, DCELL_TYPE);
fill_array_2d(data1);
fill_array_2d(data2);
fill_array_2d(data3);
/*raster IO methods */
N_write_array_2d_to_rast(data1, "gpde_lib_test_raster_1");
N_write_array_2d_to_rast(data2, "gpde_lib_test_raster_2");
N_write_array_2d_to_rast(data2, "gpde_lib_test_raster_3");
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_1", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_1", tmp);
N_free_array_2d(tmp);
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_2", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_2", tmp);
N_free_array_2d(tmp);
tmp = N_read_rast_to_array_2d("gpde_lib_test_raster_3", NULL);
N_read_rast_to_array_2d("gpde_lib_test_raster_3", tmp);
N_free_array_2d(tmp);
sprintf(buff,
"g.remove rast=gpde_lib_test_raster_1,gpde_lib_test_raster_2,gpde_lib_test_raster_3");
system(buff);
N_free_array_2d(data1);
N_free_array_2d(data11);
N_free_array_2d(data2);
N_free_array_2d(data22);
N_free_array_2d(data3);
N_free_array_2d(data33);
return sum;
}
/*!
* \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);
}
/* ************************************************************************* */
int main(int argc, char *argv[])
{
struct GModule *module = NULL;
N_gwflow_data2d *data = NULL;
N_geom_data *geom = NULL;
N_les *les = NULL;
N_les_callback_2d *call = NULL;
double *tmp_vect = NULL;
struct Cell_head region;
double error, sor, max_norm = 0, tmp;
int maxit, i, inner_count = 0;
char *solver;
int x, y, stat;
N_gradient_field_2d *field = NULL;
N_array_2d *xcomp = NULL;
N_array_2d *ycomp = NULL;
char *buff = NULL;
int with_river = 0, with_drain = 0;
/* Initialize GRASS */
G_gisinit(argv[0]);
module = G_define_module();
module->keywords = _("raster, hydrology");
module->description =
_("Numerical calculation program for transient, confined and unconfined groundwater flow 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());
/*Check the river parameters */
if (param.river_leak->answer == NULL && param.river_bed->answer == NULL &&
param.river_head->answer == NULL) {
with_river = 0;
}
else if (param.river_leak->answer != NULL &&
param.river_bed->answer != NULL &&
param.river_head->answer != NULL) {
with_river = 1;
}
else {
G_fatal_error
(_("Please provide river_head, river_leak and river_bed maps"));
}
/*Check the drainage parameters */
if (param.drain_leak->answer == NULL && param.drain_bed->answer == NULL) {
with_drain = 0;
}
else if (param.drain_leak->answer != NULL &&
param.drain_bed->answer != NULL) {
with_drain = 1;
}
else {
G_fatal_error(_("Please provide drain_head and drain_leak maps"));
}
/*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));
/*set the solver */
solver = param.solver->answer;
if (strcmp(solver, N_SOLVER_DIRECT_LU) == 0 && param.sparse->answer)
G_fatal_error(_("The direct LU solver do not work with sparse matrices"));
if (strcmp(solver, N_SOLVER_DIRECT_GAUSS) == 0 && param.sparse->answer)
G_fatal_error(_("The direct Gauss solver do not work with sparse matrices"));
if (strcmp(solver, N_SOLVER_DIRECT_CHOLESKY) == 0 && param.sparse->answer)
G_fatal_error(_("The direct cholesky 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_gwflow_2d)); /*gwflow 2d */
/*Allocate the groundwater flow data structure */
data =
N_alloc_gwflow_data2d(geom->cols, geom->rows, with_river, with_drain);
/* set the groundwater type */
if (param.type->answer) {
if (strncmp("unconfined", param.type->answer, 10) == 0) {
data->gwtype = N_GW_UNCONFINED;
}
else {
data->gwtype = N_GW_CONFINED;
}
}
/*Set the calculation time */
sscanf(param.dt->answer, "%lf", &(data->dt));
G_message("Calculation time: %g", data->dt);
/*read all input maps into the memory and take care of the
* null values.*/
N_read_rast_to_array_2d(param.phead->answer, data->phead);
N_convert_array_2d_null_to_zero(data->phead);
N_copy_array_2d(data->phead, data->phead_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.hc_x->answer, data->hc_x);
N_convert_array_2d_null_to_zero(data->hc_x);
N_read_rast_to_array_2d(param.hc_y->answer, data->hc_y);
N_convert_array_2d_null_to_zero(data->hc_y);
N_read_rast_to_array_2d(param.s->answer, data->s);
N_convert_array_2d_null_to_zero(data->s);
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);
/*river is optional */
if (with_river) {
N_read_rast_to_array_2d(param.river_bed->answer, data->river_bed);
N_read_rast_to_array_2d(param.river_head->answer, data->river_head);
N_read_rast_to_array_2d(param.river_leak->answer, data->river_leak);
N_convert_array_2d_null_to_zero(data->river_bed);
N_convert_array_2d_null_to_zero(data->river_head);
N_convert_array_2d_null_to_zero(data->river_leak);
}
/*drainage is optional */
if (with_drain) {
N_read_rast_to_array_2d(param.drain_bed->answer, data->drain_bed);
N_read_rast_to_array_2d(param.drain_leak->answer, data->drain_leak);
N_convert_array_2d_null_to_zero(data->drain_bed);
N_convert_array_2d_null_to_zero(data->drain_leak);
}
/*Recharge is optional */
if (param.r->answer) {
N_read_rast_to_array_2d(param.r->answer, data->r);
N_convert_array_2d_null_to_zero(data->r);
}
/*Sources or sinks are optional */
if (param.q->answer) {
N_read_rast_to_array_2d(param.q->answer, data->q);
N_convert_array_2d_null_to_zero(data->q);
}
/* 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 = N_get_array_2d_c_value(data->status, x, y);
if (stat == N_CELL_INACTIVE) { /*only inactive cells */
N_put_array_2d_d_value(data->hc_x, x, y, 0);
N_put_array_2d_d_value(data->hc_y, x, y, 0);
N_put_array_2d_d_value(data->s, x, y, 0);
N_put_array_2d_d_value(data->q, x, y, 0);
}
}
}
/*assemble the linear equation system and solve it */
les = create_solve_les(geom, data, call, solver, maxit, error, sor);
/* copy the result into the phead array for output or unconfined calculation */
copy_result(data->status, data->phead_start, les->x, ®ion,
data->phead);
N_convert_array_2d_null_to_zero(data->phead);
/****************************************************/
/*explicite calculation of free groundwater surface */
/****************************************************/
if (data->gwtype == N_GW_UNCONFINED) {
/* allocate memory and copy the result into a new temporal vector */
if (!(tmp_vect = (double *)calloc(les->rows, sizeof(double))))
G_fatal_error(_("Out of memory"));
/*copy data */
for (i = 0; i < les->rows; i++)
tmp_vect[i] = les->x[i];
/*count the number of inner iterations */
inner_count = 0;
do {
G_message(_("Calculation of unconfined groundwater flow loop %i\n"),
inner_count + 1);
/* we will allocate a new les for each loop */
if (les)
N_free_les(les);
/*assemble the linear equation system and solve it */
les =
create_solve_les(geom, data, call, solver, maxit, error, sor);
/*calculate the maximum norm of the groundwater height difference */
tmp = 0;
max_norm = 0;
for (i = 0; i < les->rows; i++) {
tmp = fabs(les->x[i] - tmp_vect[i]);
if (max_norm < tmp)
max_norm = tmp;
/*copy the result */
tmp_vect[i] = les->x[i];
}
G_message(_("Maximum difference between this and last increment: %g"),
max_norm);
/* copy the result into the phead array */
copy_result(data->status, data->phead_start, les->x, ®ion,
data->phead);
N_convert_array_2d_null_to_zero(data->phead);
/**/ inner_count++;
}
while (max_norm > 0.01 && inner_count < 50);
if (tmp_vect)
free(tmp_vect);
}
/*write the result to the output file */
N_write_array_2d_to_rast(data->phead, param.output->answer);
/*release the memory */
if (les)
N_free_les(les);
/*Compute the the velocity field if required and write the result into three rast maps */
if (param.vector->answer) {
field =
N_compute_gradient_field_2d(data->phead, data->hc_x, data->hc_y,
geom, NULL);
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(field, xcomp, ycomp);
G_asprintf(&buff, "%s_x", param.vector->answer);
N_write_array_2d_to_rast(xcomp, buff);
G_asprintf(&buff, "%s_y", param.vector->answer);
N_write_array_2d_to_rast(ycomp, buff);
if (buff)
G_free(buff);
if (xcomp)
N_free_array_2d(xcomp);
if (ycomp)
N_free_array_2d(ycomp);
if (field)
N_free_gradient_field_2d(field);
}
if (data)
N_free_gwflow_data2d(data);
if (geom)
N_free_geom_data(geom);
if (call)
G_free(call);
return (EXIT_SUCCESS);
}
