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