/* *************************************************************** */ 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 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); }