void PrintVectorAll(
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);
PrintSubvectorAll(file, VectorSubvector(v, g));
}
amps_Fprintf(file, "===================================================\n");
fflush(file);
amps_Fclose(file);
}
/*
* 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];
});
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 BCInternal(
Problem * problem,
ProblemData *problem_data,
Matrix * A,
Vector * f,
double time)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
PFModule *phase_density = ProblemPhaseDensity(problem);
WellData *well_data = ProblemDataWellData(problem_data);
WellDataPhysical *well_data_physical;
WellDataValue *well_data_value;
TimeCycleData *time_cycle_data;
int num_conditions = (public_xtra->num_conditions);
Type0 *dummy0;
Grid *grid = VectorGrid(f);
SubgridArray *internal_bc_subgrids;
Subgrid *subgrid, *ibc_subgrid, *well_subgrid, *new_subgrid;
Submatrix *A_sub;
Subvector *f_sub;
double *internal_bc_conditions, *mp;
double Z;
double dx, dy, dz;
int ix, iy, iz;
int nx, ny, nz;
int rx, ry, rz;
int process;
int i, j, k, i_sft, j_sft, k_sft;
int grid_index, ibc_sg, well, index;
int cycle_number, interval_number;
double dtmp, ptmp, head, phead;
int stencil[7][3] = { { 0, 0, 0 },
{ -1, 0, 0 },
{ 1, 0, 0 },
{ 0, -1, 0 },
{ 0, 1, 0 },
{ 0, 0, -1 },
{ 0, 0, 1 } };
/***** Some constants for the routine *****/
/* Hard-coded assumption for constant density. */
PFModuleInvokeType(PhaseDensityInvoke, phase_density, (0, NULL, NULL, &ptmp, &dtmp, CALCFCN));
dtmp = ProblemGravity(problem) * dtmp;
/*--------------------------------------------------------------------
* gridify the internal boundary locations (should be done elsewhere?)
*--------------------------------------------------------------------*/
if (num_conditions > 0)
{
internal_bc_subgrids = NewSubgridArray();
internal_bc_conditions = ctalloc(double, num_conditions);
for (i = 0; i < num_conditions; i++)
{
switch ((public_xtra->type[i]))
{
case 0:
{
dummy0 = (Type0*)(public_xtra->data[i]);
ix = IndexSpaceX((dummy0->xlocation), 0);
iy = IndexSpaceY((dummy0->ylocation), 0);
iz = IndexSpaceZ((dummy0->zlocation), 0);
nx = 1;
ny = 1;
nz = 1;
rx = 0;
ry = 0;
rz = 0;
process = amps_Rank(amps_CommWorld);
new_subgrid = NewSubgrid(ix, iy, iz,
nx, ny, nz,
rx, ry, rz,
process);
AppendSubgrid(new_subgrid, internal_bc_subgrids);
internal_bc_conditions[i] = (dummy0->value);
break;
}
}
}
}
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 ICPhaseSatur(
Vector *ic_phase_satur,
int phase,
ProblemData *problem_data)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module);
Grid *grid = VectorGrid(ic_phase_satur);
Type0 *dummy0;
SubgridArray *subgrids = GridSubgrids(grid);
Subgrid *subgrid;
Subvector *ps_sub;
double *data;
int ix, iy, iz;
int nx, ny, nz;
int r;
double field_sum;
int is, i, j, k, ips;
/*-----------------------------------------------------------------------
* Initial saturation conditions for this phase
*-----------------------------------------------------------------------*/
InitVector(ic_phase_satur, 0.0);
switch((public_xtra -> type[phase]))
{
case 0:
{
int num_regions;
int *region_indices;
double *values;
GrGeomSolid *gr_solid;
double value;
int ir;
dummy0 = (Type0 *)(public_xtra -> data[phase]);
num_regions = (dummy0 -> num_regions);
region_indices = (dummy0 -> region_indices);
values = (dummy0 -> values);
for (ir = 0; ir < num_regions; ir++)
{
gr_solid = ProblemDataGrSolid(problem_data, region_indices[ir]);
value = values[ir];
ForSubgridI(is, subgrids)
{
subgrid = SubgridArraySubgrid(subgrids, is);
ps_sub = VectorSubvector(ic_phase_satur, is);
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);
data = SubvectorData(ps_sub);
GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz,
{
ips = SubvectorEltIndex(ps_sub, i, j, k);
data[ips] = value;
});
}
}
break;
}
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 RichardsBCInternal(
Problem *problem,
ProblemData *problem_data,
Vector *f,
Matrix *A,
double time,
Vector *pressure,
int fcn)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module);
WellData *well_data = ProblemDataWellData(problem_data);
WellDataPhysical *well_data_physical;
WellDataValue *well_data_value;
TimeCycleData *time_cycle_data;
int num_conditions = (public_xtra -> num_conditions);
int num_wells, total_num;
Type0 *dummy0;
Grid *grid = VectorGrid(pressure);
SubgridArray *internal_bc_subgrids = NULL;
Subgrid *subgrid, *subgrid_ind, *new_subgrid;
Subvector *p_sub;
double *pp;
double *internal_bc_conditions = NULL;
double dx, dy, dz;
double value;
int ix, iy, iz;
int nx, ny, nz;
int rx, ry, rz;
int process;
int i, j, k;
int grid_index, well, index;
int cycle_number, interval_number;
int ip, im;
/*--------------------------------------------------------------------
* gridify the internal boundary locations (should be done elsewhere?)
*--------------------------------------------------------------------*/
if ( num_conditions > 0 )
{
internal_bc_subgrids = NewSubgridArray();
internal_bc_conditions = ctalloc(double, num_conditions);
for (i = 0; i < num_conditions;i++)
{
switch((public_xtra -> type[i]))
{
case 0:
{
dummy0 = (Type0 *)(public_xtra -> data[i]);
ix = IndexSpaceX((dummy0 -> xlocation), 0);
iy = IndexSpaceY((dummy0 -> ylocation), 0);
iz = IndexSpaceZ((dummy0 -> zlocation), 0);
nx = 1;
ny = 1;
nz = 1;
rx = 0;
ry = 0;
rz = 0;
process = amps_Rank(amps_CommWorld);
new_subgrid = NewSubgrid(ix, iy, iz,
nx, ny, nz,
rx, ry, rz,
process);
AppendSubgrid(new_subgrid, internal_bc_subgrids);
internal_bc_conditions[i] = (dummy0 -> value);
break;
}
}
}
}
void BCPhaseSaturation(
Vector * saturation,
int phase,
GrGeomSolid *gr_domain)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
Type0 *dummy0;
Type1 *dummy1;
Type2 *dummy2;
int num_patches = (public_xtra->num_patches);
int *patch_indexes = (public_xtra->patch_indexes);
int *input_types = (public_xtra->input_types);
int *bc_types = (public_xtra->bc_types);
Grid *grid = VectorGrid(saturation);
SubgridArray *subgrids = GridSubgrids(grid);
Subgrid *subgrid;
Subvector *sat_sub;
double *satp;
BCStruct *bc_struct;
int patch_index;
int nx_v, ny_v, nz_v;
int sx_v, sy_v, sz_v;
int *fdir;
int indx, ipatch, is, i, j, k, ival, iv, sv;
/*-----------------------------------------------------------------------
* Get an offset into the PublicXtra data
*-----------------------------------------------------------------------*/
indx = (phase * num_patches);
/*-----------------------------------------------------------------------
* Set up bc_struct with NULL values component
*-----------------------------------------------------------------------*/
bc_struct = NewBCStruct(subgrids, gr_domain,
num_patches, patch_indexes, bc_types, NULL);
/*-----------------------------------------------------------------------
* Implement BC's
*-----------------------------------------------------------------------*/
for (ipatch = 0; ipatch < num_patches; ipatch++)
{
patch_index = patch_indexes[ipatch];
ForSubgridI(is, subgrids)
{
subgrid = SubgridArraySubgrid(subgrids, is);
sat_sub = VectorSubvector(saturation, is);
nx_v = SubvectorNX(sat_sub);
ny_v = SubvectorNY(sat_sub);
nz_v = SubvectorNZ(sat_sub);
sx_v = 1;
sy_v = nx_v;
sz_v = ny_v * nx_v;
satp = SubvectorData(sat_sub);
switch (input_types[indx + ipatch])
{
case 0:
{
double constant;
dummy0 = (Type0*)(public_xtra->data[indx + ipatch]);
constant = (dummy0->constant);
BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is,
{
sv = 0;
if (fdir[0])
sv = fdir[0] * sx_v;
else if (fdir[1])
sv = fdir[1] * sy_v;
else if (fdir[2])
sv = fdir[2] * sz_v;
iv = SubvectorEltIndex(sat_sub, i, j, k);
satp[iv ] = constant;
satp[iv + sv] = constant;
satp[iv + 2 * sv] = constant;
});
break;
}
case 1:
{
double height;
double lower;
double upper;
double z, dz2;
dummy1 = (Type1*)(public_xtra->data[indx + ipatch]);
height = (dummy1->height);
lower = (dummy1->lower);
upper = (dummy1->upper);
dz2 = SubgridDZ(subgrid) / 2.0;
BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is,
{
sv = 0;
if (fdir[0])
sv = fdir[0] * sx_v;
else if (fdir[1])
sv = fdir[1] * sy_v;
else if (fdir[2])
sv = fdir[2] * sz_v;
iv = SubvectorEltIndex(sat_sub, i, j, k);
z = RealSpaceZ(k, SubgridRZ(subgrid)) + fdir[2] * dz2;
if (z <= height)
{
satp[iv ] = lower;
satp[iv + sv] = lower;
satp[iv + 2 * sv] = lower;
}
else
{
satp[iv ] = upper;
satp[iv + sv] = upper;
satp[iv + 2 * sv] = upper;
}
});
break;
}
case 2:
{
int ip, num_points;
double *point;
double *height;
double lower;
double upper;
double x, y, z, dx2, dy2, dz2;
double unitx, unity, line_min, line_length, xy, slope;
double interp_height;
dummy2 = (Type2*)(public_xtra->data[indx + ipatch]);
num_points = (dummy2->num_points);
point = (dummy2->point);
height = (dummy2->height);
lower = (dummy2->lower);
upper = (dummy2->upper);
dx2 = SubgridDX(subgrid) / 2.0;
dy2 = SubgridDY(subgrid) / 2.0;
dz2 = SubgridDZ(subgrid) / 2.0;
/* compute unit direction vector for piecewise linear line */
unitx = (dummy2->xupper) - (dummy2->xlower);
unity = (dummy2->yupper) - (dummy2->ylower);
line_length = sqrt(unitx * unitx + unity * unity);
unitx /= line_length;
unity /= line_length;
line_min = (dummy2->xlower) * unitx + (dummy2->ylower) * unity;
BCStructPatchLoop(i, j, k, fdir, ival, bc_struct, ipatch, is,
{
sv = 0;
if (fdir[0])
sv = fdir[0] * sx_v;
else if (fdir[1])
sv = fdir[1] * sy_v;
else if (fdir[2])
sv = fdir[2] * sz_v;
iv = SubvectorEltIndex(sat_sub, i, j, k);
x = RealSpaceX(i, SubgridRX(subgrid)) + fdir[0] * dx2;
y = RealSpaceY(j, SubgridRY(subgrid)) + fdir[1] * dy2;
z = RealSpaceZ(k, SubgridRZ(subgrid)) + fdir[2] * dz2;
/* project center of BC face onto piecewise linear line */
xy = x * unitx + y * unity;
xy = (xy - line_min) / line_length;
/* find two neighboring points */
ip = 1;
for (; ip < (num_points - 1); ip++)
{
if (xy < point[ip])
break;
}
/* compute the slope */
slope = ((height[ip] - height[ip - 1]) /
(point[ip] - point[ip - 1]));
interp_height = height[ip - 1] + slope * (xy - point[ip - 1]);
if (z <= interp_height)
{
satp[iv ] = lower;
satp[iv + sv] = lower;
satp[iv + 2 * sv] = lower;
}
else
{
satp[iv ] = upper;
satp[iv + sv] = upper;
satp[iv + 2 * sv] = upper;
}
});
break;
}
void ComputeTop(Problem * problem, /* General problem information */
ProblemData *problem_data /* Contains geometry information for the problem */
)
{
GrGeomSolid *gr_solid = ProblemDataGrDomain(problem_data);
Vector *top = ProblemDataIndexOfDomainTop(problem_data);
Vector *perm_x = ProblemDataPermeabilityX(problem_data);
Grid *grid2d = VectorGrid(top);
SubgridArray *grid2d_subgrids = GridSubgrids(grid2d);
/* use perm grid as top is 2D and want to loop over Z */
Grid *grid3d = VectorGrid(perm_x);
SubgridArray *grid3d_subgrids = GridSubgrids(grid3d);
double *top_data;
int index;
VectorUpdateCommHandle *handle;
(void)problem;
InitVectorAll(top, -1);
// PFVConstInit(-1, top);
int is;
ForSubgridI(is, grid3d_subgrids)
{
Subgrid *grid2d_subgrid = SubgridArraySubgrid(grid2d_subgrids, is);
Subgrid *grid3d_subgrid = SubgridArraySubgrid(grid3d_subgrids, is);
Subvector *top_subvector = VectorSubvector(top, is);
int grid3d_ix = SubgridIX(grid3d_subgrid);
int grid3d_iy = SubgridIY(grid3d_subgrid);
int grid3d_iz = SubgridIZ(grid3d_subgrid);
int grid2d_iz = SubgridIZ(grid2d_subgrid);
int grid3d_nx = SubgridNX(grid3d_subgrid);
int grid3d_ny = SubgridNY(grid3d_subgrid);
int grid3d_nz = SubgridNZ(grid3d_subgrid);
int grid3d_r = SubgridRX(grid3d_subgrid);
top_data = SubvectorData(top_subvector);
int i, j, k;
GrGeomInLoop(i, j, k,
gr_solid, grid3d_r,
grid3d_ix, grid3d_iy, grid3d_iz,
grid3d_nx, grid3d_ny, grid3d_nz,
{
index = SubvectorEltIndex(top_subvector, i, j, grid2d_iz);
if (top_data[index] < k)
{
top_data[index] = k;
}
});
void PFMG(
Vector *soln,
Vector *rhs,
double tol,
int zero)
{
(void)zero;
#ifdef HAVE_HYPRE
PFModule *this_module = ThisPFModule;
InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
HYPRE_StructMatrix hypre_mat = instance_xtra->hypre_mat;
HYPRE_StructVector hypre_b = instance_xtra->hypre_b;
HYPRE_StructVector hypre_x = instance_xtra->hypre_x;
HYPRE_StructSolver hypre_pfmg_data = instance_xtra->hypre_pfmg_data;
Grid *grid = VectorGrid(rhs);
Subgrid *subgrid;
int sg;
Subvector *rhs_sub;
Subvector *soln_sub;
double *rhs_ptr;
double *soln_ptr;
double value;
int index[3];
int ix, iy, iz;
int nx, ny, nz;
int nx_v, ny_v, nz_v;
int i, j, k;
int iv;
int num_iterations;
double rel_norm;
/* Copy rhs to hypre_b vector. */
BeginTiming(public_xtra->time_index_copy_hypre);
ForSubgridI(sg, GridSubgrids(grid))
{
subgrid = SubgridArraySubgrid(GridSubgrids(grid), sg);
rhs_sub = VectorSubvector(rhs, sg);
rhs_ptr = SubvectorData(rhs_sub);
ix = SubgridIX(subgrid);
iy = SubgridIY(subgrid);
iz = SubgridIZ(subgrid);
nx = SubgridNX(subgrid);
ny = SubgridNY(subgrid);
nz = SubgridNZ(subgrid);
nx_v = SubvectorNX(rhs_sub);
ny_v = SubvectorNY(rhs_sub);
nz_v = SubvectorNZ(rhs_sub);
iv = SubvectorEltIndex(rhs_sub, ix, iy, iz);
BoxLoopI1(i, j, k, ix, iy, iz, nx, ny, nz,
iv, nx_v, ny_v, nz_v, 1, 1, 1,
{
index[0] = i;
index[1] = j;
index[2] = k;
HYPRE_StructVectorSetValues(hypre_b, index, rhs_ptr[iv]);
});
