/* ************************************************************************* */ int compare_array_3d(N_array_3d * a, N_array_3d * b) { int rows, cols, depths, type; int i, j, k, res = 0; rows = a->rows; cols = a->cols; depths = a->depths; type = N_get_array_3d_type(a); #pragma omp parallel for private (i, j, k) shared (depths, rows, cols, type, a, b) reduction(+:res) for (k = 0; k < depths; k++) { for (i = 0; i < rows; i++) { for (j = 0; j < cols; j++) { if (type == FCELL_TYPE) { if (N_get_array_3d_f_value(a, i, j, k) != N_get_array_3d_f_value(b, i, j, k)) res++; } if (type == DCELL_TYPE) { if (N_get_array_3d_d_value(a, i, j, k) != N_get_array_3d_d_value(b, i, j, k)) res++; } } } } return res; }
/* ************************************************************************* */ int fill_array_3d(N_array_3d * a) { int rows, cols, depths, type; int i, j, k, res = 0; cols = a->cols; rows = a->rows; depths = a->depths; type = N_get_array_3d_type(a); #pragma omp parallel for private (i, j, k) shared (depths, rows, cols, type, a) reduction(+:res) for (k = 0; k < depths; k++) { for (j = 0; j < rows; j++) { for (i = 0; i < cols; i++) { if (type == FCELL_TYPE) { N_put_array_3d_f_value(a, i, j, k, (float)i * (float)j * (float)k); if (N_get_array_3d_f_value(a, i, j, k) != (float)i * (float)j * (float)k) res++; } if (type == DCELL_TYPE) { N_put_array_3d_d_value(a, i, j, k, (double)i * (double)j * (double)k); if (N_get_array_3d_d_value(a, i, j, k) != (double)i * (double)j * (double)k) res++; } } } } return res; }
/* **************************************************************** */ int make_les_entry_3d(int i, int j, int k, int offset_i, int offset_j, int offset_k, int count, int pos, N_les * les, G_math_spvector * spvect, N_array_3d * cell_count, N_array_3d * status, N_array_3d * start_val, double entry, int cell_type) { int K; int di = offset_i; int dj = offset_j; int dk = offset_k; K = (int)N_get_array_3d_d_value(cell_count, i + di, j + dj, k + dk) - (int)N_get_array_3d_d_value(cell_count, i, j, k); if (cell_type == N_CELL_ACTIVE) { if ((int)N_get_array_3d_d_value(status, i + di, j + dj, k + dk) > N_CELL_ACTIVE && (int)N_get_array_3d_d_value(status, i + di, j + dj, k + dk) < N_MAX_CELL_STATE) les->b[count] -= N_get_array_3d_d_value(start_val, i + di, j + dj, k + dk) * entry; else if ((int)N_get_array_3d_d_value(status, i + di, j + dj, k + dk) == N_CELL_ACTIVE) { if ((count + K) >= 0 && (count + K) < les->cols) { G_debug(5, " make_les_entry_3d: (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; } } } } else if (cell_type == N_CELL_DIRICHLET) { if ((int)N_get_array_3d_d_value(status, i + di, j + dj, k + dk) != N_CELL_INACTIVE) { if ((count + K) >= 0 && (count + K) < les->cols) { G_debug(5, " make_les_entry_3d: (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 array data to stdout * * Offsets are ignored * * \param data N_array_2d * * \return void * */ void N_print_array_3d(N_array_3d * data) { int i, j, k; N_print_array_3d_info(data); for (k = 0; k < data->depths; k++) { for (j = 0; j < data->rows; j++) { for (i = 0; i < data->cols; i++) { if (data->type == FCELL_TYPE) printf("%6.6f ", N_get_array_3d_f_value(data, i, j, k)); else if (data->type == DCELL_TYPE) printf("%6.6f ", N_get_array_3d_d_value(data, i, j, k)); } printf("\n"); } printf("\n"); } printf("\n"); return; }
/*! \brief This is just a placeholder * * */ N_data_star *N_callback_solute_transport_3d(void *solutedata, N_geom_data * geom, int col, int row, int depth) { double Df_e = 0, Df_w = 0, Df_n = 0, Df_s = 0, Df_t = 0, Df_b = 0; double dx, dy, dz, Az; double diff_x, diff_y, diff_z; double diff_xw, diff_yn; double diff_xe, diff_ys; double diff_zt, diff_zb; double cin = 0, cg, cg_start; double R, nf, cs, q; double C, W, E, N, S, T, B, V; double vw = 0, ve = 0, vn = 0, vs = 0, vt = 0, vb = 0; double Ds_w = 0, Ds_e = 0, Ds_n = 0, Ds_s = 0, Ds_t = 0, Ds_b = 0; double Dw = 0, De = 0, Dn = 0, Ds = 0, Dt = 0, Db = 0; double rw = 0.5, re = 0.5, rn = 0.5, rs = 0.5, rt = 0.5, rb = 0.5; N_solute_transport_data3d *data = NULL; N_data_star *mat_pos; N_gradient_3d grad; /*cast the void pointer to the right data structure */ data = (N_solute_transport_data3d *) solutedata; N_get_gradient_3d(data->grad, &grad, col, row, depth); dx = geom->dx; dy = geom->dy; dz = geom->dz; Az = N_get_geom_data_area_of_cell(geom, row); /*read the data from the arrays */ cg_start = N_get_array_3d_d_value(data->c_start, col, row, depth); cg = N_get_array_3d_d_value(data->c, col, row, depth); /*get the surrounding diffusion tensor entries */ diff_x = N_get_array_3d_d_value(data->diff_x, col, row, depth); diff_y = N_get_array_3d_d_value(data->diff_y, col, row, depth); diff_z = N_get_array_3d_d_value(data->diff_z, col, row, depth); diff_xw = N_get_array_3d_d_value(data->diff_x, col - 1, row, depth); diff_xe = N_get_array_3d_d_value(data->diff_x, col + 1, row, depth); diff_yn = N_get_array_3d_d_value(data->diff_y, col, row - 1, depth); diff_ys = N_get_array_3d_d_value(data->diff_y, col, row + 1, depth); diff_zt = N_get_array_3d_d_value(data->diff_z, col, row, depth + 1); diff_zb = N_get_array_3d_d_value(data->diff_z, col, row, depth - 1); /* calculate the diffusion on 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); Df_t = N_calc_harmonic_mean(diff_zt, diff_z); Df_b = N_calc_harmonic_mean(diff_zb, diff_z); /* calculate the dispersion */ /*todo */ /* calculate the velocity parts with full upwinding scheme */ vw = grad.WC; ve = grad.EC; vn = grad.NC; vs = grad.SC; vt = grad.TC; vb = grad.BC; /* put the diffusion and dispersion together */ Dw = ((Df_w + Ds_w)) / dx; De = ((Df_e + Ds_e)) / dx; Dn = ((Df_n + Ds_n)) / dy; Ds = ((Df_s + Ds_s)) / dy; Dt = ((Df_t + Ds_t)) / dz; Db = ((Df_b + Ds_b)) / dz; rw = N_exp_upwinding(-1 * vw, dx, Dw); re = N_exp_upwinding(ve, dx, De); rs = N_exp_upwinding(-1 * vs, dy, Ds); rn = N_exp_upwinding(vn, dy, Dn); rb = N_exp_upwinding(-1 * vb, dz, Dn); rt = N_exp_upwinding(vt, dz, Dn); /*mass balance center cell to western cell */ W = -1 * (Dw) * dy * dz - vw * (1 - rw) * dy * dz; /*mass balance center cell to eastern cell */ E = -1 * (De) * dy * dz + ve * (1 - re) * dy * dz; /*mass balance center cell to southern cell */ S = -1 * (Ds) * dx * dz - vs * (1 - rs) * dx * dz; /*mass balance center cell to northern cell */ N = -1 * (Dn) * dx * dz + vn * (1 - rn) * dx * dz; /*mass balance center cell to bottom cell */ B = -1 * (Db) * Az - vb * (1 - rb) * Az; /*mass balance center cell to top cell */ T = -1 * (Dt) * Az + vt * (1 - rt) * Az; /* Retardation */ R = N_get_array_3d_d_value(data->R, col, row, depth); /* Inner sources */ cs = N_get_array_3d_d_value(data->cs, col, row, depth); /* effective porosity */ nf = N_get_array_3d_d_value(data->nf, col, row, depth); /* groundwater sources and sinks */ q = N_get_array_3d_d_value(data->q, col, row, depth); /* concentration of influent water */ cin = N_get_array_3d_d_value(data->cin, col, row, depth); /*the diagonal entry of the matrix */ C = ((Dw - vw) * dy * dz + (De + ve) * dy * dz + (Ds - vs) * dx * dz + (Dn + vn) * dx * dz + (Db - vb) * Az + (Dt + vt) * Az + Az * dz * R / data->dt - q / nf); /*the entry in the right side b of Ax = b */ V = (cs + cg_start * Az * dz * R / data->dt - q / nf * cin); /* * printf("nf %g\n", nf); * printf("q %g\n", q); * printf("cs %g\n", cs); * printf("cin %g\n", cin); * printf("cg %g\n", cg); * printf("cg_start %g\n", cg_start); * printf("Az %g\n", Az); * printf("z %g\n", z); * printf("R %g\n", R); * printf("dt %g\n", data->dt); */ G_debug(6, "N_callback_solute_transport_3d: called [%i][%i][%i]", row, col, depth); /*create the 7 point star entries */ mat_pos = N_create_7star(C, W, E, N, S, T, B, V); return mat_pos; }
/*! * \brief Integrate Dirichlet or Transmission boundary conditions into the les (3d) * * 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_3d(N_les * les, N_geom_data * geom, N_array_3d * status, N_array_3d * start_val) { int rows, cols, depths; int count = 0; int i, j, x, y, z, stat; double *dvect1; double *dvect2; G_debug(2, "N_les_integrate_dirichlet_3d: integrating the dirichlet boundary condition"); rows = geom->rows; cols = geom->cols; depths = geom->depths; /*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 (z = 0; z < depths; z++) { for (y = 0; y < rows; y++) { for (x = 0; x < cols; x++) { stat = (int)N_get_array_3d_d_value(status, x, y, z); if (stat > N_CELL_ACTIVE && stat < N_MAX_CELL_STATE) { dvect1[count] = N_get_array_3d_d_value(start_val, x, y, z); 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 (z = 0; z < depths; z++) { for (y = 0; y < rows; y++) { for (x = 0; x < cols; x++) { stat = (int)N_get_array_3d_d_value(status, x, y, z); 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; } } count++; } } } return 0; }
/*! * \brief Assemble a linear equation system (les) based on 3d location data (g3d) * * 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 3d array with start values and an 3d 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_3d structure. * * 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_3d * * \param start_val N_array_3d * * \param data void * * \param call N_les_callback_3d * * \param cell_type int -- les assemble based on N_CELL_ACTIVE or N_CELL_DIRICHLET * \return N_les * * */ N_les *N_assemble_les_3d_param(int les_type, N_geom_data * geom, N_array_3d * status, N_array_3d * start_val, void *data, N_les_callback_3d * call, int cell_type) { int i, j, k, count = 0, pos = 0; int cell_type_count = 0; N_array_3d *cell_count; N_les *les = NULL; int **index_ij; G_debug(2, "N_assemble_les_3d: starting to assemble the linear equation system"); cell_count = N_alloc_array_3d(geom->cols, geom->rows, geom->depths, 1, DCELL_TYPE); /* First count the number of valid cells and save * each number in a new 3d array. Those numbers are used * to create the linear equation system.*/ if (cell_type == N_CELL_DIRICHLET) { /* include dirichlet cells in the les */ for (k = 0; k < geom->depths; k++) { 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 < (int)N_get_array_3d_d_value(status, i, j, k) && (int)N_get_array_3d_d_value(status, i, j, k) < N_MAX_CELL_STATE) cell_type_count++; } } } } else { /*use only active cell in the les */ for (k = 0; k < geom->depths; k++) { for (j = 0; j < geom->rows; j++) { for (i = 0; i < geom->cols; i++) { /*count only active cells */ if (N_CELL_ACTIVE == (int)N_get_array_3d_d_value(status, i, j, k)) cell_type_count++; } } } } G_debug(2, "N_assemble_les_3d: number of used cells %i\n", cell_type_count); if (cell_type_count == 0.0) G_fatal_error ("Not enough active 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); /* allocate the memory for the linear equation system (les). * Only valid cells are used to create the les. */ les = N_alloc_les_Ax_b(cell_type_count, les_type); index_ij = (int **)G_calloc(cell_type_count, sizeof(int *)); for (i = 0; i < cell_type_count; i++) index_ij[i] = (int *)G_calloc(3, sizeof(int)); count = 0; /*count the number of cells which should be used to create the linear equation system */ /*save the k, i and j indices and create a ordered numbering */ for (k = 0; k < geom->depths; k++) { for (j = 0; j < geom->rows; j++) { for (i = 0; i < geom->cols; i++) { if (cell_type == N_CELL_DIRICHLET) { if (N_CELL_INACTIVE < (int)N_get_array_3d_d_value(status, i, j, k) && (int)N_get_array_3d_d_value(status, i, j, k) < N_MAX_CELL_STATE) { N_put_array_3d_d_value(cell_count, i, j, k, count); index_ij[count][0] = i; index_ij[count][1] = j; index_ij[count][2] = k; count++; G_debug(5, "N_assemble_les_3d: non-inactive cells count %i at pos x[%i] y[%i] z[%i]\n", count, i, j, k); } } else if (N_CELL_ACTIVE == (int)N_get_array_3d_d_value(status, i, j, k)) { N_put_array_3d_d_value(cell_count, i, j, k, count); index_ij[count][0] = i; index_ij[count][1] = j; index_ij[count][2] = k; count++; G_debug(5, "N_assemble_les_3d: active cells count %i at pos x[%i] y[%i] z[%i]\n", count, i, j, k); } } } } G_debug(2, "N_assemble_les_3d: starting the parallel assemble loop"); #pragma omp parallel for private(i, j, k, pos, count) schedule(static) for (count = 0; count < cell_type_count; count++) { i = index_ij[count][0]; j = index_ij[count][1]; k = index_ij[count][2]; /*create the entries for the */ N_data_star *items = call->callback(data, geom, i, j, k); 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_3d_d_value(start_val, i, j, k); /* 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_3d(i, j, k, -1, 0, 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_3d(i, j, k, 1, 0, 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_3d(i, j, k, 0, -1, 0, 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_3d(i, j, k, 0, 1, 0, count, pos, les, spvect, cell_count, status, start_val, items->S, cell_type); } /*only for a 7 star entry needed */ if (items->type == N_7_POINT_STAR || items->type == N_27_POINT_STAR) { /* the upper cell (top), entry depth + 1 */ if (k < geom->depths - 1) { pos = make_les_entry_3d(i, j, k, 0, 0, 1, count, pos, les, spvect, cell_count, status, start_val, items->T, cell_type); } /* the lower cell (bottom), entry depth - 1 */ if (k > 0) { pos = make_les_entry_3d(i, j, k, 0, 0, -1, count, pos, les, spvect, cell_count, status, start_val, items->B, 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); } N_free_array_3d(cell_count); for (i = 0; i < cell_type_count; i++) G_free(index_ij[i]); G_free(index_ij); return les; }