void PrintVector( char *filename, Vector *v) { amps_File file; int g; Grid *grid; if ((file = amps_Fopen(filename, "w")) == NULL) { amps_Printf("Error: can't open output file %s\n", filename); exit(1); } amps_Fprintf(file, "===================================================\n"); grid = VectorGrid(v); for(g = 0; g < GridNumSubgrids(grid); g++) { amps_Fprintf(file, "Subvector Number: %d\n", g); PrintSubvector(file, VectorSubvector(v, g), GridSubgrid(grid, g)); } amps_Fprintf(file, "===================================================\n"); fflush(file); amps_Fclose(file); }
/*-------------------------------------------------------------------------- * InputPorosity *--------------------------------------------------------------------------*/ void InputPorosity( GeomSolid * geounit, GrGeomSolid *gr_geounit, Vector * field) { /*----------------------------------------------------------------------- * Local variables *-----------------------------------------------------------------------*/ PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); double field_value = (public_xtra->field_value); Grid *grid = (instance_xtra->grid); Subgrid *subgrid; Subvector *field_sub; double *fieldp; int subgrid_loop; int i, j, k; int ix, iy, iz; int nx, ny, nz; int r; int index; (void)geounit; /*----------------------------------------------------------------------- * Assign constant values to field *-----------------------------------------------------------------------*/ /* extra variables for reading from file */ Type3 * dummy3; dummy3 = (Type3*)(public_xtra->data); Vector *ic_values = dummy3->ic_values; Subvector *ic_values_sub; double *ic_values_dat; for (subgrid_loop = 0; subgrid_loop < GridNumSubgrids(grid); subgrid_loop++) { subgrid = GridSubgrid(grid, subgrid_loop); field_sub = VectorSubvector(field, subgrid_loop); /* new subvector from file */ ic_values_sub = VectorSubvector(ic_values, subgrid_loop); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); /* RDF: assume resolution is the same in all 3 directions */ r = SubgridRX(subgrid); fieldp = SubvectorData(field_sub); /* new subvector data to read from */ ic_values_dat = SubvectorData(ic_values_sub); GrGeomInLoop(i, j, k, gr_geounit, r, ix, iy, iz, nx, ny, nz, { index = SubvectorEltIndex(field_sub, i, j, k); /* now assign the value from file to field */ // fieldp[index] = field_value; fieldp[index] = ic_values_dat[index]; }); }
/* * Copy data from a WRF array to a PF vector based on the * k-index data for the top of the domain. */ void WRF2PF( float * wrf_array, /* WRF array */ int wrf_depth, /* Depth (Z) of WRF array, X,Y are assumed * to be same as PF vector subgrid */ int ghost_size_i_lower, /* Number of ghost cells */ int ghost_size_j_lower, int ghost_size_i_upper, int ghost_size_j_upper, Vector *pf_vector, Vector *top) { Grid *grid = VectorGrid(pf_vector); int sg; (void)ghost_size_j_upper; ForSubgridI(sg, GridSubgrids(grid)) { Subgrid *subgrid = GridSubgrid(grid, sg); int ix = SubgridIX(subgrid); int iy = SubgridIY(subgrid); int nx = SubgridNX(subgrid); int ny = SubgridNY(subgrid); int wrf_nx = nx + ghost_size_i_lower + ghost_size_i_upper; Subvector *subvector = VectorSubvector(pf_vector, sg); double *subvector_data = SubvectorData(subvector); Subvector *top_subvector = VectorSubvector(top, sg); double *top_data = SubvectorData(top_subvector); int i, j, k; for (i = ix; i < ix + nx; i++) { for (j = iy; j < iy + ny; j++) { int top_index = SubvectorEltIndex(top_subvector, i, j, 0); // SGS What to do if near bottom such that // there are not wrf_depth values? int iz = (int)top_data[top_index] - (wrf_depth - 1); for (k = iz; k < iz + wrf_depth; k++) { int pf_index = SubvectorEltIndex(subvector, i, j, k); int wrf_index = (i - ix + ghost_size_i_lower) + ((wrf_depth - (k - iz) - 1) * wrf_nx) + ((j - iy + ghost_size_j_lower) * (wrf_nx * wrf_depth)); subvector_data[pf_index] = (double)(wrf_array[wrf_index]); } } } }
double InnerProd( Vector *x, Vector *y) { Grid *grid = VectorGrid(x); Subgrid *subgrid; Subvector *y_sub; Subvector *x_sub; double *yp, *xp; double result = 0.0; int ix, iy, iz; int nx, ny, nz; int nx_v, ny_v, nz_v; int i_s, i, j, k, iv; amps_Invoice result_invoice; result_invoice = amps_NewInvoice("%d", &result); ForSubgridI(i_s, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, i_s); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); y_sub = VectorSubvector(y, i_s); x_sub = VectorSubvector(x, i_s); nx_v = SubvectorNX(y_sub); ny_v = SubvectorNY(y_sub); nz_v = SubvectorNZ(y_sub); yp = SubvectorElt(y_sub, ix, iy, iz); xp = SubvectorElt(x_sub, ix, iy, iz); iv = 0; BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz, iv, nx_v, ny_v, nz_v, 1, 1, 1, { result += yp[iv] * xp[iv]; });
void Axpy( double alpha, Vector *x, Vector *y) { Grid *grid = VectorGrid(x); Subgrid *subgrid; Subvector *y_sub; Subvector *x_sub; double *yp, *xp; int ix, iy, iz; int nx, ny, nz; int nx_v, ny_v, nz_v; int i_s, i, j, k, iv; ForSubgridI(i_s, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, i_s); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); y_sub = VectorSubvector(y, i_s); x_sub = VectorSubvector(x, i_s); nx_v = SubvectorNX(y_sub); ny_v = SubvectorNY(y_sub); nz_v = SubvectorNZ(y_sub); yp = SubvectorElt(y_sub, ix, iy, iz); xp = SubvectorElt(x_sub, ix, iy, iz); iv = 0; BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz, iv, nx_v, ny_v, nz_v, 1, 1, 1, { yp[iv] += alpha * xp[iv]; });
double ComputeTotalConcen( GrGeomSolid *gr_domain, Grid * grid, Vector * substance) { Subgrid *subgrid; double cell_volume, field_sum; double dx, dy, dz; Subvector *s_sub; int i, j, k, r, ix, iy, iz, nx, ny, nz, is, ips; int *fdir; double *data; amps_Invoice result_invoice; field_sum = 0.0; ForSubgridI(is, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, is); s_sub = VectorSubvector(substance, is); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); dx = SubgridDX(subgrid); dy = SubgridDY(subgrid); dz = SubgridDZ(subgrid); /* RDF: assume resolution is the same in all 3 directions */ r = SubgridRX(subgrid); data = SubvectorData(s_sub); cell_volume = dx * dy * dz; GrGeomSurfLoop(i, j, k, fdir, gr_domain, r, ix, iy, iz, nx, ny, nz, { ips = SubvectorEltIndex(s_sub, i, j, k); data[ips] = 0.0; });
void PFVLinearSum( /* LinearSum : z = a * x + b * y */ double a, Vector *x, double b, Vector *y, Vector *z) { double c; Vector *v1, *v2; int test; Grid *grid = VectorGrid(x); Subgrid *subgrid; Subvector *x_sub; Subvector *y_sub; Subvector *z_sub; double *yp, *xp, *zp; int ix, iy, iz; int nx, ny, nz; int nx_x, ny_x, nz_x; int nx_y, ny_y, nz_y; int nx_z, ny_z, nz_z; int sg, i, j, k, i_x, i_y, i_z; if ((b == ONE) && (z == y)) /* BLAS usage: axpy y <- ax+y */ { PFVAxpy(a, x, y); return; } if ((a == ONE) && (z == x)) /* BLAS usage: axpy x <- by+x */ { PFVAxpy(b, y, x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { PFVSum(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; PFVDiff(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; PFVLin1(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; PFVLin2(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { PFVScaleSum(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { PFVScaleDiff(a, x, y, z); return; } /* Do all cases not handled above: * (1) a == other, b == 0.0 - user should have called N_VScale * (2) a == 0.0, b == other - user should have called N_VScale * (3) a,b == other, a !=b, a != -b */ ForSubgridI(sg, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, sg); z_sub = VectorSubvector(z, sg); x_sub = VectorSubvector(x, sg); y_sub = VectorSubvector(y, sg); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); nx_x = SubvectorNX(x_sub); ny_x = SubvectorNY(x_sub); nz_x = SubvectorNZ(x_sub); nx_y = SubvectorNX(y_sub); ny_y = SubvectorNY(y_sub); nz_y = SubvectorNZ(y_sub); nx_z = SubvectorNX(z_sub); ny_z = SubvectorNY(z_sub); nz_z = SubvectorNZ(z_sub); zp = SubvectorElt(z_sub, ix, iy, iz); xp = SubvectorElt(x_sub, ix, iy, iz); yp = SubvectorElt(y_sub, ix, iy, iz); i_x = 0; i_y = 0; i_z = 0; BoxLoopI3(i, j, k, ix, iy, iz, nx, ny, nz, i_x, nx_x, ny_x, nz_x, 1, 1, 1, i_y, nx_y, ny_y, nz_y, 1, 1, 1, i_z, nx_z, ny_z, nz_z, 1, 1, 1, { zp[i_z] = a * xp[i_x] + b * yp[i_y]; });
void PhaseDensity( int phase, /* Phase */ Vector *phase_pressure, /* Vector of phase pressures at each block */ Vector *density_v, /* Vector of return densities at each block */ double *pressure_d, /* Double array of pressures */ double *density_d, /* Double array return density */ int fcn) /* Flag determining what to calculate * fcn = CALCFCN => calculate the function value * fcn = CALCDER => calculate the function * derivative */ /* Module returns either a double array or Vector of densities. * If density_v is NULL, then a double array is returned. * This "overloading" was provided so that the density module written * for the Richards' solver modules would be backward compatible with * the Impes modules. */ { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); Type0 *dummy0; Type1 *dummy1; Grid *grid; Subvector *p_sub; Subvector *d_sub; double *pp; double *dp; Subgrid *subgrid; int sg; int ix, iy, iz; int nx, ny, nz; int nx_p, ny_p, nz_p; int nx_d, ny_d, nz_d; int i, j, k, ip, id; switch((public_xtra -> type[phase])) { case 0: { double constant; dummy0 = (Type0 *)(public_xtra -> data[phase]); constant = (dummy0 -> constant); if ( density_v != NULL) { grid = VectorGrid(density_v); ForSubgridI(sg, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, sg); d_sub = VectorSubvector(density_v, sg); ix = SubgridIX(subgrid) - 1; iy = SubgridIY(subgrid) - 1; iz = SubgridIZ(subgrid) - 1; nx = SubgridNX(subgrid) + 2; ny = SubgridNY(subgrid) + 2; nz = SubgridNZ(subgrid) + 2; nx_d = SubvectorNX(d_sub); ny_d = SubvectorNY(d_sub); nz_d = SubvectorNZ(d_sub); dp = SubvectorElt(d_sub, ix, iy, iz); id = 0; if ( fcn == CALCFCN ) { BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz, id, nx_d, ny_d, nz_d, 1, 1, 1, { dp[id] = constant; }); }
void OverlandSum(ProblemData *problem_data, Vector *pressure, /* Current pressure values */ double dt, Vector *overland_sum) { GrGeomSolid *gr_domain = ProblemDataGrDomain(problem_data); double dx, dy, dz; int i, j, r, is; int ix, iy, iz; int nx, ny; Subgrid *subgrid; Grid *grid = VectorGrid(pressure); Vector *slope_x = ProblemDataTSlopeX(problem_data); Vector *slope_y = ProblemDataTSlopeY(problem_data); Vector *mannings = ProblemDataMannings(problem_data); Vector *top = ProblemDataIndexOfDomainTop(problem_data); Subvector *overland_sum_subvector; Subvector *slope_x_subvector; Subvector *slope_y_subvector; Subvector *mannings_subvector; Subvector *pressure_subvector; Subvector *top_subvector; int index_overland_sum; int index_slope_x; int index_slope_y; int index_mannings; int index_pressure; int index_top; double *overland_sum_ptr; double *slope_x_ptr; double *slope_y_ptr; double *mannings_ptr; double *pressure_ptr; double *top_ptr; int ipatch; BCStruct *bc_struct; BCPressureData *bc_pressure_data = ProblemDataBCPressureData(problem_data); int num_patches = BCPressureDataNumPatches(bc_pressure_data); bc_struct = NewBCStruct(GridSubgrids(grid), gr_domain, num_patches, BCPressureDataPatchIndexes(bc_pressure_data), BCPressureDataBCTypes(bc_pressure_data), NULL); if (num_patches > 0) { for (ipatch = 0; ipatch < num_patches; ipatch++) { switch(BCPressureDataType(bc_pressure_data,ipatch)) { case 7: { ForSubgridI(is, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, is); overland_sum_subvector = VectorSubvector(overland_sum, is); slope_x_subvector = VectorSubvector(slope_x, is); slope_y_subvector = VectorSubvector(slope_y, is); mannings_subvector = VectorSubvector(mannings, is); pressure_subvector = VectorSubvector(pressure, is); top_subvector = VectorSubvector(top, is); r = SubgridRX(subgrid); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); dx = SubgridDX(subgrid); dy = SubgridDY(subgrid); dz = SubgridDZ(subgrid); overland_sum_ptr = SubvectorData(overland_sum_subvector); slope_x_ptr = SubvectorData(slope_x_subvector); slope_y_ptr = SubvectorData(slope_y_subvector); mannings_ptr = SubvectorData(mannings_subvector); pressure_ptr = SubvectorData(pressure_subvector); top_ptr = SubvectorData(top_subvector); int state; const int inactive = -1; const int active = 1; for(i = ix; i < ix + nx; i++) { j = iy - 1; index_top = SubvectorEltIndex(top_subvector, i, j, 0); int k = (int)top_ptr[index_top]; if( k < 0 ) { state = inactive; } else { state = active; } while( j < iy + ny) { if( state == inactive) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; while( k < 0 && j <= iy + ny) { j++; index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; } // If still in interior if( j < iy + ny) { if ( k >=0 ) { // inactive to active index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); // sloping to inactive active from active if( slope_y_ptr[index_slope_y] > 0) { index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if(pressure_ptr[index_pressure] > 0) { index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt; } } } state = active; } } else { index_top = SubvectorEltIndex(top_subvector, i, j+1, 0); k = (int)top_ptr[index_top]; while( k >= 0 && j <= iy + ny) { j++; index_top = SubvectorEltIndex(top_subvector, i, j+1, 0); k = (int)top_ptr[index_top]; } // If still in interior if( j < iy + ny) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; // active to inactive index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); // sloping from active to inactive if( slope_y_ptr[index_slope_y] < 0) { index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if(pressure_ptr[index_pressure] > 0) { index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt; } } } state = inactive; } j++; } } #if 0 for(i = ix; i < ix + nx; i++) { for(j = iy; j < iy + ny; j++) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); int k = (int)top_ptr[index_top]; if ( !(k < 0)) { /* Compute runnoff if slope is running off of active region */ index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if( slope_y_ptr[index_slope_y] > 0 ) { if(pressure_ptr[index_pressure] > 0) { overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt; } } /* Loop until going back outside of active area */ while( (j + 1 < iy + ny) && !(top_ptr[SubvectorEltIndex(top_subvector, i, j+1, 0)] < 0) ) { j++; } /* Found either domain boundary or outside of active area. Compute runnoff if slope is running off of active region. */ index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if( slope_y_ptr[index_slope_y] < 0 ) { if(pressure_ptr[index_pressure] > 0) { overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_y_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dx * dt; } } } } } #endif for(j = iy; j < iy + ny; j++) { i = ix - 1; index_top = SubvectorEltIndex(top_subvector, i, j, 0); int k = (int)top_ptr[index_top]; if( k < 0 ) { state = inactive; } else { state = active; } while( i < ix + nx) { if( state == inactive) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; while( k < 0 && i <= ix + nx) { i++; index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; } // If still in interior if( i < ix + nx) { if ( k >=0 ) { // inactive to active index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); // sloping to inactive active from active if( slope_x_ptr[index_slope_x] > 0) { index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if(pressure_ptr[index_pressure] > 0) { index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt; } } } state = active; } } else { index_top = SubvectorEltIndex(top_subvector, i+1, j, 0); k = (int)top_ptr[index_top]; while( k >= 0 && i <= ix + nx) { i++; index_top = SubvectorEltIndex(top_subvector, i+1, j, 0); k = (int)top_ptr[index_top]; } // If still in interior if( i < ix + nx) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; // active to inactive index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); // sloping from active to inactive if( slope_x_ptr[index_slope_x] < 0) { index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if(pressure_ptr[index_pressure] > 0) { index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt; } } } state = inactive; } i++; } } #if 0 for(j = iy; j < iy + ny; j++) { for(i = ix; i < ix + nx; i++) { index_top = SubvectorEltIndex(top_subvector, i, j, 0); int k = (int)top_ptr[index_top]; if ( !(k < 0)) { /* Compute runnoff if slope is running off of active region */ index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if( slope_x_ptr[index_slope_x] > 0 ) { if(pressure_ptr[index_pressure] > 0) { overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_x_ptr[index_slope_y]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt; } } /* Loop until going back outside of active area */ while( (i + 1 < ix + nx) && !(top_ptr[SubvectorEltIndex(top_subvector, i+1, j, 0)] < 0) ) { i++; } /* Found either domain boundary or outside of active area. Compute runnoff if slope is running off of active region. */ index_top = SubvectorEltIndex(top_subvector, i, j, 0); k = (int)top_ptr[index_top]; index_overland_sum = SubvectorEltIndex(overland_sum_subvector, i, j, 0); index_slope_x = SubvectorEltIndex(slope_x_subvector, i, j, 0); index_slope_y = SubvectorEltIndex(slope_y_subvector, i, j, 0); index_mannings = SubvectorEltIndex(mannings_subvector, i, j, 0); index_pressure = SubvectorEltIndex(pressure_subvector, i, j, k); if( slope_x_ptr[index_slope_x] < 0 ) { if(pressure_ptr[index_pressure] > 0) { overland_sum_ptr[index_overland_sum] += (sqrt( fabs(slope_x_ptr[index_slope_x]) ) / mannings_ptr[index_mannings] ) * pow(pressure_ptr[index_pressure], 5.0 / 3.0) * dy * dt; } } } } } #endif } } } } }
void PGSRF( GeomSolid * geounit, GrGeomSolid *gr_geounit, Vector * field, RFCondData * cdata) { /*-----------------* * Local variables * *-----------------*/ PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module); /* Input parameters (see PGSRFNewPublicXtra() below) */ double lambdaX = (public_xtra->lambdaX); double lambdaY = (public_xtra->lambdaY); double lambdaZ = (public_xtra->lambdaZ); double mean = (public_xtra->mean); double sigma = (public_xtra->sigma); int dist_type = (public_xtra->dist_type); double low_cutoff = (public_xtra->low_cutoff); double high_cutoff = (public_xtra->high_cutoff); int max_search_rad = (public_xtra->max_search_rad); int max_npts = (public_xtra->max_npts); int max_cpts = (public_xtra->max_cpts); Vector *tmpRF = NULL; /* Conditioning data */ int nc = (cdata->nc); double *x = (cdata->x); double *y = (cdata->y); double *z = (cdata->z); double *v = (cdata->v); /* Grid parameters */ Grid *grid = (instance_xtra->grid); Subgrid *subgrid; Subvector *sub_field; Subvector *sub_tmpRF; int NX, NY, NZ; /* Subgrid parameters */ int nx, ny, nz; double dx, dy, dz; int nx_v, ny_v, nz_v; int nx_v2, ny_v2, nz_v2; int nxG, nyG, nzG; /* Counters, indices, flags */ int gridloop; int i, j, k, n, m; int ii, jj, kk; int i2, j2, k2; int imin, jmin, kmin; int rpx, rpy, rpz; int npts; int index1, index2, index3; /* Spatial variables */ double *fieldp; double *tmpRFp; int iLx, iLy, iLz; /* Correlation length in terms of grid points */ int iLxp1, iLyp1, iLzp1; /* One more than each of the above */ int nLx, nLy, nLz; /* Size of correlation neighborhood in grid pts. */ int iLxyz; /* iLxyz = iLx*iLy*iLz */ int nLxyz; /* nLxyz = nLx*nLy*nLz */ int ix, iy, iz; int ref; int ix2, iy2, iz2; int i_search, j_search, k_search; int ci_search, cj_search, ck_search; double X0, Y0, Z0; /* Variables used in kriging algorithm */ double cmean, csigma; /* Conditional mean and std. dev. from kriging */ double A; double *A_sub; /* Sub-covariance matrix for external cond pts */ double *A11; /* Submatrix; note that A11 is 1-dim */ double **A12, **A21, **A22;/* Submatrices for external conditioning data */ double **M; /* Used as a temporary matrix */ double *b; /* Covariance vector for conditioning points */ double *b_tmp, *b2; double *w, *w_tmp; /* Solution vector to Aw=b */ int *ixx, *iyy, *izz; double *value; int di, dj, dk; double uni, gau; double ***cov; int ierr; /* Conditioning data variables */ int cpts; /* N cond pts for a single simulated node */ double *cval; /* Values for cond data for single node */ /* Communications */ VectorUpdateCommHandle *handle; int update_mode; /* Miscellaneous variables */ int **rand_path; char ***marker; int p, r, modulus; double a1, a2, a3; double cx, cy, cz; double sum; // FIXME Shouldn't we get this from numeric_limits? double Tiny = 1.0e-12; (void)geounit; /*----------------------------------------------------------------------- * Allocate temp vectors *-----------------------------------------------------------------------*/ tmpRF = NewVectorType(instance_xtra->grid, 1, max_search_rad, vector_cell_centered); /*----------------------------------------------------------------------- * Start sequential Gaussian simulator algorithm *-----------------------------------------------------------------------*/ /* Begin timing */ BeginTiming(public_xtra->time_index); /* initialize random number generators */ SeedRand(public_xtra->seed); /* For now, we will assume that all subgrids have the same uniform spacing */ subgrid = GridSubgrid(grid, 0); dx = SubgridDX(subgrid); dy = SubgridDY(subgrid); dz = SubgridDZ(subgrid); /* Size of search neighborhood through which random path must be defined */ iLx = (int)(lambdaX / dx); iLy = (int)(lambdaY / dy); iLz = (int)(lambdaZ / dz); /* For computational efficiency, we'll limit the * size of the search neighborhood. */ if (iLx > max_search_rad) iLx = max_search_rad; if (iLy > max_search_rad) iLy = max_search_rad; if (iLz > max_search_rad) iLz = max_search_rad; iLxp1 = iLx + 1; iLyp1 = iLy + 1; iLzp1 = iLz + 1; iLxyz = iLxp1 * iLyp1 * iLzp1; /* Define the size of a correlation neighborhood */ nLx = 2 * iLx + 1; nLy = 2 * iLy + 1; nLz = 2 * iLz + 1; nLxyz = nLx * nLy * nLz; /*------------------------ * Define a random path through the points in this subgrid. * The random path generation procedure of Srivastava and * Gomez has been adopted in this subroutine. A linear * congruential generator of the form: r(i) = 5*r(i-1)+1 mod(2**n) * has a cycle length of 2**n. By choosing the smallest power of * 2 that is still larger than the total number of points to be * simulated, the method ensures that all indices will be * generated once and only once. *------------------------*/ rand_path = talloc(int*, iLxyz); for (i = 0; i < iLxyz; i++) rand_path[i] = talloc(int, 3); modulus = 2; while (modulus < iLxyz + 1) modulus *= 2; /* Compute a random starting node */ p = (int)Rand(); r = 1 + p * (iLxyz - 1); k = (r - 1) / (iLxp1 * iLyp1); j = (r - 1 - iLxp1 * iLyp1 * k) / iLxp1; i = (r - 1) - (k * iLyp1 + j) * iLxp1; rand_path[0][2] = k; rand_path[0][1] = j; rand_path[0][0] = i; /* Determine the next nodes */ for (n = 1; n < iLxyz; n++) { r = (5 * r + 1) % modulus; while ((r < 1) || (r > iLxyz)) r = (5 * r + 1) % modulus; k = ((r - 1) / (iLxp1 * iLyp1)); j = (((r - 1) - iLxp1 * iLyp1 * k) / iLxp1); i = (r - 1) - (k * iLyp1 + j) * iLxp1; rand_path[n][0] = i; rand_path[n][1] = j; rand_path[n][2] = k; } /*----------------------------------------------------------------------- * Compute correlation lookup table *-----------------------------------------------------------------------*/ /* First compute a covariance lookup table */ cov = talloc(double**, nLx); for (i = 0; i < nLx; i++) { cov[i] = talloc(double*, nLy); for (j = 0; j < nLy; j++) cov[i][j] = ctalloc(double, nLz); } /* Note that in the construction of the covariance matrix * the max_search_rad is not used. Covariance depends upon * the correlation lengths, lambdaX/Y/Z, and the grid spacing. * The max_search_rad can be longer or shorter than the correlation * lengths. The bigger the search radius, the more accurately * the random field will match the correlation structure of the * covariance function. But the run time will increase greatly * as max_search_rad gets bigger because of the kriging matrix * that must be solved (see below). */ cx = 0.0; cy = 0.0; cz = 0.0; if (lambdaX != 0.0) cx = dx * dx / (lambdaX * lambdaX); if (lambdaY != 0.0) cy = dy * dy / (lambdaY * lambdaY); if (lambdaZ != 0.0) cz = dz * dz / (lambdaZ * lambdaZ); for (k = 0; k < nLz; k++) for (j = 0; j < nLy; j++) for (i = 0; i < nLx; i++) { a1 = i * i * cx; a2 = j * j * cy; a3 = k * k * cz; cov[i][j][k] = exp(-sqrt(a1 + a2 + a3)); } /* Allocate memory for variables that will be used in kriging */ A11 = ctalloc(double, nLxyz * nLxyz); A_sub = ctalloc(double, nLxyz * nLxyz); A12 = ctalloc(double*, nLxyz); A21 = ctalloc(double*, nLxyz); A22 = ctalloc(double*, nLxyz); M = ctalloc(double*, nLxyz); for (i = 0; i < nLxyz; i++) { A12[i] = ctalloc(double, nLxyz); A21[i] = ctalloc(double, nLxyz); A22[i] = ctalloc(double, nLxyz); M[i] = ctalloc(double, nLxyz); } b = ctalloc(double, nLxyz); b2 = ctalloc(double, nLxyz); b_tmp = ctalloc(double, nLxyz); w = ctalloc(double, nLxyz); w_tmp = ctalloc(double, nLxyz); value = ctalloc(double, nLxyz); cval = ctalloc(double, nLxyz); ixx = ctalloc(int, nLxyz); iyy = ctalloc(int, nLxyz); izz = ctalloc(int, nLxyz); /* Allocate space for the "marker" used to keep track of which * points in a representative correlation box have been simulated * already. */ marker = talloc(char**, (3 * iLx + 1)); marker += iLx; for (i = -iLx; i <= 2 * iLx; i++) { marker[i] = talloc(char*, (3 * iLy + 1)); marker[i] += iLy; for (j = -iLy; j <= 2 * iLy; j++) { marker[i][j] = ctalloc(char, (3 * iLz + 1)); marker[i][j] += iLz; for (k = -iLz; k <= 2 * iLz; k++) marker[i][j][k] = 0; } } /* Convert the cutoff values to a gaussian if they're lognormal on input */ if ((dist_type == 1) || (dist_type == 3)) { if (low_cutoff <= 0.0) { low_cutoff = Tiny; } else { low_cutoff = (log(low_cutoff / mean)) / sigma; } if (high_cutoff <= 0.0) { high_cutoff = DBL_MAX; } else { high_cutoff = (log(high_cutoff / mean)) / sigma; } } /*-------------------------------------------------------------------- * Start pGs algorithm *--------------------------------------------------------------------*/ for (gridloop = 0; gridloop < GridNumSubgrids(grid); gridloop++) { subgrid = GridSubgrid(grid, gridloop); sub_tmpRF = VectorSubvector(tmpRF, gridloop); sub_field = VectorSubvector(field, gridloop); tmpRFp = SubvectorData(sub_tmpRF); fieldp = SubvectorData(sub_field); X0 = RealSpaceX(0, SubgridRX(subgrid)); Y0 = RealSpaceY(0, SubgridRY(subgrid)); Z0 = RealSpaceZ(0, SubgridRZ(subgrid)); ix = SubgridIX(subgrid); iy = SubgridIY(subgrid); iz = SubgridIZ(subgrid); nx = SubgridNX(subgrid); ny = SubgridNY(subgrid); nz = SubgridNZ(subgrid); NX = ix + nx; NY = iy + ny; NZ = iz + nz; /* RDF: assume resolution is the same in all 3 directions */ ref = SubgridRX(subgrid); nx_v = SubvectorNX(sub_field); ny_v = SubvectorNY(sub_field); nz_v = SubvectorNZ(sub_field); nx_v2 = SubvectorNX(sub_tmpRF); ny_v2 = SubvectorNY(sub_tmpRF); nz_v2 = SubvectorNZ(sub_tmpRF); /* Initialize tmpRF vector */ GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz, { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); tmpRFp[index2] = 0.0; }); /* Convert conditioning data to N(0,1) distribution if * it's assumed to be lognormal. Then copy it into tmpRFp */ if ((dist_type == 1) || (dist_type == 3)) { for (n = 0; n < nc; n++) { i = (int)((x[n] - X0) / dx + 0.5); j = (int)((y[n] - Y0) / dy + 0.5); k = (int)((z[n] - Z0) / dz + 0.5); if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) && (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) && (iz - max_search_rad <= k && k <= iz + nz + max_search_rad)) { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); if (v[n] <= 0.0) tmpRFp[index2] = Tiny; else tmpRFp[index2] = (log(v[n] / mean)) / sigma; } } } /* Otherwise, shift data to N(0,1) distribution */ else { for (n = 0; n < nc; n++) { i = (int)((x[n] - X0) / dx + 0.5); j = (int)((y[n] - Y0) / dy + 0.5); k = (int)((z[n] - Z0) / dz + 0.5); if ((ix - max_search_rad <= i && i <= ix + nx + max_search_rad) && (iy - max_search_rad <= j && j <= iy + ny + max_search_rad) && (iz - max_search_rad <= k && k <= iz + nz + max_search_rad)) { index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); tmpRFp[index2] = (v[n] - mean) / sigma; } } } /* Set the search radii in each direction. If the maximum * number of points in a neighborhood is exceeded, these limits * will be reduced. */ i_search = iLx; j_search = iLy; k_search = iLz; /* Compute values at all points using all templates */ for (n = 0; n < iLxyz; n++) { /* Update the ghost layer before proceeding */ if (n > 0) { /* First reset max_search_radius */ max_search_rad = i_search; if (j_search > max_search_rad) max_search_rad = j_search; if (k_search > max_search_rad) max_search_rad = k_search; /* Reset the comm package based on the new max_search_radius */ if (max_search_rad == 1) update_mode = VectorUpdatePGS1; else if (max_search_rad == 2) update_mode = VectorUpdatePGS2; else if (max_search_rad == 3) update_mode = VectorUpdatePGS3; else update_mode = VectorUpdatePGS4; handle = InitVectorUpdate(tmpRF, update_mode); FinalizeVectorUpdate(handle); } rpx = rand_path[n][0]; rpy = rand_path[n][1]; rpz = rand_path[n][2]; ix2 = rpx; while (ix2 < ix) ix2 += iLxp1; iy2 = rpy; while (iy2 < iy) iy2 += iLyp1; iz2 = rpz; while (iz2 < iz) iz2 += iLzp1; /* This if clause checks to see if there are, in fact, * any points at all in this subgrid, for this * particular region. Note that each value of n in the * above n-loop corresponds to a different region. */ if ((ix2 < ix + nx) && (iy2 < iy + ny) && (iz2 < iz + nz)) { /* * Construct the input matrix and vector for kriging, * solve the linear system, and compute csigma. * These depend only on the spatial distribution of * conditioning data, not on the actual values of * the data. Only the conditional mean (cmean) depends * on actual values, so it must be computed for every * point. Thus, it's found within the pgs_Boxloop below. * The size of the linear system that must be solved here * will be no larger than (2r+1)^3, where r=max_search_rad. * It is clear from this why it is necessary to limit * the size of the search radius. */ /* Here the marker array indicates which points within * the search radius have been simulated already. This * spatial pattern of conditioning points will be the * same for every point in the current template. Thus, * this system can be solved once *outside* of the * GrGeomInLoop2 below. */ npts = 9999; while (npts > max_npts) { m = 0; /* Count the number of points in search ellipse */ for (k = rpz - k_search; k <= rpz + k_search; k++) for (j = rpy - j_search; j <= rpy + j_search; j++) for (i = rpx - i_search; i <= rpx + i_search; i++) { if (marker[i][j][k]) { ixx[m] = i; iyy[m] = j; izz[m++] = k; } } npts = m; /* If npts is too large, reduce the size of the * search ellipse one axis at a time. */ if (npts > max_npts) { /* If i_search is the biggest, reduce it by one. */ if ((i_search >= j_search) && (i_search >= k_search)) { i_search--; } /* Or, if j_search is the biggest, reduce it by one. */ else if ((j_search >= i_search) && (j_search >= k_search)) { j_search--; } /* Otherwise, reduce k_search by one. */ else { k_search--; } } } m = 0; for (j = 0; j < npts; j++) { di = abs(rpx - ixx[j]); dj = abs(rpy - iyy[j]); dk = abs(rpz - izz[j]); b[j] = cov[di][dj][dk]; for (i = 0; i < npts; i++) { di = abs(ixx[i] - ixx[j]); dj = abs(iyy[i] - iyy[j]); dk = abs(izz[i] - izz[j]); A11[m++] = cov[di][dj][dk]; } } /* Solve the linear system */ for (i = 0; i < npts; i++) w[i] = b[i]; if (npts > 0) { dpofa_(A11, &npts, &npts, &ierr); dposl_(A11, &npts, &npts, w); } /* Compute the conditional standard deviation for the RV * to be simulated. */ csigma = 0.0; for (i = 0; i < npts; i++) csigma += w[i] * b[i]; csigma = sqrt(cov[0][0][0] - csigma); /* The following loop hits every point in the current * region. That is, it skips by max_search_rad+1 * through the subgrid. In this way, all the points * in this loop may simulated simultaneously; each is * outside the search radius of all the others. */ nxG = (nx + ix); nyG = (ny + iy); nzG = (nz + iz); for (k = iz2; k < nzG; k += iLzp1) for (j = iy2; j < nyG; j += iLyp1) for (i = ix2; i < nxG; i += iLxp1) { index1 = SubvectorEltIndex(sub_field, i, j, k); index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); /* Only simulate points in this geounit and that don't * already have a value. If a node already has a value, * it was assigned as external conditioning data, * so we don't need to simulate it. */ if (fabs(tmpRFp[index2]) < Tiny) { /* Condition the random variable */ m = 0; cpts = 0; for (kk = -k_search; kk <= k_search; kk++) for (jj = -j_search; jj <= j_search; jj++) for (ii = -i_search; ii <= i_search; ii++) { value[m] = 0.0; index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk); if (marker[ii + rpx][jj + rpy][kk + rpz]) { value[m++] = tmpRFp[index3]; } /* In this case, there is a value at this point, * but it wasn't simulated yet (as indicated by the * fact that the marker has no place for it). Thus, * it must be external conditioning data. */ else if (fabs(tmpRFp[index3]) > Tiny) { ixx[npts + cpts] = rpx + ii; iyy[npts + cpts] = rpy + jj; izz[npts + cpts] = rpz + kk; cval[cpts++] = tmpRFp[index3]; } } /* If cpts is too large, reduce the size of the * search neighborhood, one axis at a time. */ /* Define the size of the search neighborhood */ ci_search = i_search; cj_search = j_search; ck_search = k_search; while (cpts > max_cpts) { /* If ci_search is the biggest, reduce it by one. */ if ((ci_search >= cj_search) && (ci_search >= ck_search)) ci_search--; /* Or, if cj_search is the biggest, reduce it by one. */ else if ((cj_search >= ci_search) && (cj_search >= ck_search)) cj_search--; /* Otherwise, reduce ck_search by one. */ else ck_search--; /* Now recount the conditioning data points */ m = 0; cpts = 0; for (kk = -ck_search; kk <= ck_search; kk++) for (jj = -cj_search; jj <= cj_search; jj++) for (ii = -ci_search; ii <= ci_search; ii++) { index3 = SubvectorEltIndex(sub_tmpRF, i + ii, j + jj, k + kk); if (!(marker[rpx + ii][rpy + jj][rpz + kk]) && (fabs(tmpRFp[index3]) > Tiny)) { ixx[npts + cpts] = rpx + ii; iyy[npts + cpts] = rpy + jj; izz[npts + cpts] = rpz + kk; cval[cpts++] = tmpRFp[index3]; } } } for (i2 = 0; i2 < npts; i2++) w_tmp[i2] = w[i2]; /*-------------------------------------------------- * Conditioning to external data is done here. *--------------------------------------------------*/ if (cpts > 0) { /* Compute the submatrices */ for (j2 = 0; j2 < npts + cpts; j2++) { di = abs(rpx - ixx[j2]); dj = abs(rpy - iyy[j2]); dk = abs(rpz - izz[j2]); b[j2] = cov[di][dj][dk]; for (i2 = 0; i2 < npts + cpts; i2++) { di = abs(ixx[i2] - ixx[j2]); dj = abs(iyy[i2] - iyy[j2]); dk = abs(izz[i2] - izz[j2]); A = cov[di][dj][dk]; if (i2 < npts && j2 >= npts) A12[i2][j2 - npts] = A; if (i2 >= npts && j2 < npts) A21[i2 - npts][j2] = A; if (i2 >= npts && j2 >= npts) A22[i2 - npts][j2 - npts] = A; } } /* Compute b2' = b2 - A21 * A11_inv * b1 and augment b1 */ for (i2 = 0; i2 < cpts; i2++) b2[i2] = b[i2 + npts]; for (i2 = 0; i2 < npts; i2++) b_tmp[i2] = b[i2]; dposl_(A11, &npts, &npts, b_tmp); for (i2 = 0; i2 < cpts; i2++) { sum = 0.0; for (j2 = 0; j2 < npts; j2++) { sum += A21[i2][j2] * b_tmp[j2]; } b2[i2] -= sum; } for (i2 = 0; i2 < cpts; i2++) b[i2 + npts] = b2[i2]; /* Compute A22' = A22 - A21 * A11_inv * A12 */ for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < npts; i2++) M[j2][i2] = A12[i2][j2]; if (npts > 0) { for (i2 = 0; i2 < cpts; i2++) dposl_(A11, &npts, &npts, M[i2]); } for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < cpts; i2++) { sum = 0.0; for (k2 = 0; k2 < npts; k2++) sum += A21[i2][k2] * M[j2][k2]; A22[i2][j2] -= sum; } m = 0; for (j2 = 0; j2 < cpts; j2++) for (i2 = 0; i2 < cpts; i2++) A_sub[m++] = A22[i2][j2]; /* Compute x2 where A22*x2 = b2' */ dpofa_(A_sub, &cpts, &cpts, &ierr); dposl_(A_sub, &cpts, &cpts, b2); /* Compute w_tmp where A11*w_tmp = (b1 - A12*b2) */ if (npts > 0) { for (i2 = 0; i2 < npts; i2++) { sum = 0.0; for (k2 = 0; k2 < cpts; k2++) sum += A12[i2][k2] * b2[k2]; w_tmp[i2] = b[i2] - sum; } dposl_(A11, &npts, &npts, w_tmp); } /* Fill in the rest of w_tmp with b2 */ for (i2 = npts; i2 < npts + cpts; i2++) { w_tmp[i2] = b2[i2]; value[i2] = cval[i2 - npts]; } /* Recompute csigma */ csigma = 0.0; for (i2 = 0; i2 < npts + cpts; i2++) csigma += w_tmp[i2] * b[i2]; csigma = sqrt(cov[0][0][0] - csigma); } /*-------------------------------------------------- * End of external conditioning *--------------------------------------------------*/ cmean = 0.0; for (m = 0; m < npts + cpts; m++) cmean += w_tmp[m] * value[m]; /* uni = fieldp[index1]; */ uni = Rand(); gauinv_(&uni, &gau, &ierr); tmpRFp[index2] = csigma * gau + cmean; /* Cutoff tail values if required */ if (dist_type > 1) { if (tmpRFp[index2] < low_cutoff) tmpRFp[index2] = low_cutoff; if (tmpRFp[index2] > high_cutoff) tmpRFp[index2] = high_cutoff; } } /* if( abs(tmpRFp[index2]) < Tiny ) */ } /* end of triple for-loops over i,j,k */ /* Update the marker vector */ imin = rpx - iLxp1; if (imin < -iLx) imin += iLxp1; jmin = rpy - iLyp1; if (jmin < -iLy) jmin += iLyp1; kmin = rpz - iLzp1; if (kmin < -iLz) kmin += iLzp1; for (kk = kmin; kk <= 2 * iLz; kk += iLzp1) for (jj = jmin; jj <= 2 * iLy; jj += iLyp1) for (ii = imin; ii <= 2 * iLx; ii += iLxp1) { marker[ii][jj][kk] = 1; } } /* if(...) */ } /* n loop */ /* Make log-normal if requested. Note that low * and high cutoffs are already accomplished. */ if ((dist_type == 1) || (dist_type == 3)) { GrGeomInLoop(i, j, k, gr_geounit, ref, ix, iy, iz, nx, ny, nz, { index1 = SubvectorEltIndex(sub_field, i, j, k); index2 = SubvectorEltIndex(sub_tmpRF, i, j, k); fieldp[index1] = mean * exp((sigma) * tmpRFp[index2]); });
void TurningBandsRF( GeomSolid *geounit, GrGeomSolid *gr_geounit, Vector *field, RFCondData *cdata) { PFModule *this_module = ThisPFModule; PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module); InstanceXtra *instance_xtra = (InstanceXtra *)PFModuleInstanceXtra(this_module); double lambdaX = (public_xtra -> lambdaX); double lambdaY = (public_xtra -> lambdaY); double lambdaZ = (public_xtra -> lambdaZ); double mean = (public_xtra -> mean); double sigma = (public_xtra -> sigma); int num_lines = (public_xtra -> num_lines); double rzeta = (public_xtra -> rzeta); double Kmax = (public_xtra -> Kmax); double dK = (public_xtra -> dK); int log_normal = (public_xtra -> log_normal); int strat_type = (public_xtra -> strat_type); double low_cutoff = (public_xtra -> low_cutoff); double high_cutoff= (public_xtra -> high_cutoff); double pi = acos(-1.0); Grid *grid = (instance_xtra -> grid); Subgrid *subgrid; Subvector *field_sub; double xlo, ylo, zlo, sh_zlo; double xhi, yhi, zhi, sh_zhi; int ix, iy, iz; int nx, ny, nz; int r; double dx, dy, dz; double phi, theta; double *theta_array, *phi_array; double unitx, unity, unitz; double **shear_arrays, *shear_array; double *shear_min, *shear_max; double zeta, dzeta; int izeta, nzeta; double *Z; int is, l, i, j, k; int index; int doing_TB; double x, y, z; double *fieldp; double sqrtnl; Statistics *stats; /*----------------------------------------------------------------------- * start turning bands algorithm *-----------------------------------------------------------------------*/ /* initialize random number generator */ SeedRand(public_xtra -> seed); /* malloc space for theta_array and phi_array */ theta_array = talloc(double, num_lines); phi_array = talloc(double, num_lines); /* compute line directions */ for (l = 0; l < num_lines; l++) { theta_array[l] = 2.0*pi*Rand(); phi_array[l] = acos(1.0 - 2.0*Rand()); } /*----------------------------------------------------------------------- * Determine by how much to shear the field: * If there is no GeomSolid representation of the geounit, then * we do regular turning bands (by setting the shear_arrays to * all zeros). *-----------------------------------------------------------------------*/ /* Do regular turning bands */ if ( (strat_type == 0) || (!geounit) ) { shear_arrays = ctalloc(double *, GridNumSubgrids(grid)); shear_min = ctalloc(double, GridNumSubgrids(grid)); shear_max = ctalloc(double, GridNumSubgrids(grid)); ForSubgridI(is, GridSubgrids(grid)) { subgrid = GridSubgrid(grid, is); shear_arrays[is] = ctalloc(double, (SubgridNX(subgrid)*SubgridNY(subgrid))); }