PFModule *WRFSelectTimeStepNewPublicXtra(
double initial_step,
double growth_factor,
double max_step,
double min_step)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra;
Type1 *dummy1;
public_xtra = ctalloc(PublicXtra, 1);
public_xtra -> type = 1;
dummy1 = ctalloc(Type1, 1);
dummy1 -> initial_step = initial_step;
dummy1 -> factor = growth_factor;
dummy1 -> max_step = max_step;
dummy1 -> min_step = min_step;
(public_xtra -> data) = (void *) dummy1;
PFModulePublicXtra(this_module) = public_xtra;
return this_module;
}
void WRFSelectTimeStepFreePublicXtra()
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module);
Type0 *dummy0;
Type1 *dummy1;
if ( public_xtra )
{
switch((public_xtra -> type))
{
case 0:
{
dummy0 = (Type0 *)(public_xtra -> data);
tfree(dummy0);
break;
}
case 1:
{
dummy1 = (Type1 *)(public_xtra -> data);
tfree(dummy1);
break;
}
}
tfree(public_xtra);
}
}
PFModule *NewPFModule(
void *call,
void *init_instance_xtra,
void *free_instance_xtra,
void *new_public_xtra,
void *free_public_xtra,
void *sizeof_temp_data,
void *instance_xtra,
void *public_xtra)
{
PFModule *new_module;
new_module = talloc(PFModule, 1);
(new_module -> call) = (void (*)())call;
(new_module -> init_instance_xtra) = (void (*)())init_instance_xtra;
(new_module -> free_instance_xtra) = (void (*)())free_instance_xtra;
(new_module -> new_public_xtra) = (void (*)())new_public_xtra;
(new_module -> free_public_xtra) = (void (*)())free_public_xtra;
(new_module -> sizeof_temp_data) = (int (*)())sizeof_temp_data;
PFModuleInstanceXtra(new_module) = instance_xtra;
PFModulePublicXtra(new_module) = public_xtra;
return new_module;
}
PFModule *SelectTimeStepNewPublicXtra()
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra;
Type0 *dummy0;
Type1 *dummy1;
char *switch_name;
NameArray type_na;
type_na = NA_NewNameArray("Constant Growth");
public_xtra = ctalloc(PublicXtra, 1);
switch_name = GetString("TimeStep.Type");
public_xtra -> type = NA_NameToIndex(type_na, switch_name);
switch((public_xtra -> type))
{
case 0:
{
dummy0 = ctalloc(Type0, 1);
dummy0 -> step = GetDouble("TimeStep.Value");
(public_xtra -> data) = (void *) dummy0;
break;
}
case 1:
{
dummy1 = ctalloc(Type1, 1);
dummy1 -> initial_step = GetDouble("TimeStep.InitialStep");
dummy1 -> factor = GetDouble("TimeStep.GrowthFactor");
dummy1 -> max_step = GetDouble("TimeStep.MaxStep");
dummy1 -> min_step = GetDouble("TimeStep.MinStep");
(public_xtra -> data) = (void *) dummy1;
break;
}
default:
{
InputError("Error: invalid type <%s> for key <%s>\n",
switch_name, "TimeStep.Type");
}
}
NA_FreeNameArray(type_na);
PFModulePublicXtra(this_module) = public_xtra;
return this_module;
}
/*--------------------------------------------------------------------------
* 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];
});
}
PFModule *DupPFModule(PFModule *pf_module)
{
return NewPFModule((void *)(pf_module -> call),
(void *)(pf_module -> init_instance_xtra),
(void *)(pf_module -> free_instance_xtra),
(void *)(pf_module -> new_public_xtra),
(void *)(pf_module -> free_public_xtra),
(void *)(pf_module -> sizeof_temp_data),
PFModuleInstanceXtra(pf_module),
PFModulePublicXtra(pf_module));
}
void KinsolNonlinSolverFreePublicXtra()
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
if (public_xtra)
{
if (public_xtra->richards_jacobian_eval != NULL)
{
PFModuleFreeModule(public_xtra->richards_jacobian_eval);
}
if (public_xtra->precond != NULL)
{
PFModuleFreeModule(public_xtra->precond);
}
PFModuleFreeModule(public_xtra->nl_function_eval);
tfree(public_xtra);
}
}
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;
}
}
}
}
PFModule *KinsolNonlinSolverNewPublicXtra()
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra;
char *switch_name;
char key[IDB_MAX_KEY_LEN];
int switch_value;
NameArray switch_na;
NameArray verbosity_switch_na;
NameArray eta_switch_na;
NameArray globalization_switch_na;
NameArray precond_switch_na;
public_xtra = ctalloc(PublicXtra, 1);
sprintf(key, "Solver.Nonlinear.ResidualTol");
(public_xtra->residual_tol) = GetDoubleDefault(key, 1e-7);
sprintf(key, "Solver.Nonlinear.StepTol");
(public_xtra->step_tol) = GetDoubleDefault(key, 1e-7);
sprintf(key, "Solver.Nonlinear.MaxIter");
(public_xtra->max_iter) = GetIntDefault(key, 15);
sprintf(key, "Solver.Linear.KrylovDimension");
(public_xtra->krylov_dimension) = GetIntDefault(key, 10);
sprintf(key, "Solver.Linear.MaxRestarts");
(public_xtra->max_restarts) = GetIntDefault(key, 0);
verbosity_switch_na = NA_NewNameArray("NoVerbosity LowVerbosity "
"NormalVerbosity HighVerbosity");
sprintf(key, "Solver.Nonlinear.PrintFlag");
switch_name = GetStringDefault(key, "LowVerbosity");
(public_xtra->print_flag) = NA_NameToIndex(verbosity_switch_na,
switch_name);
NA_FreeNameArray(verbosity_switch_na);
eta_switch_na = NA_NewNameArray("EtaConstant Walker1 Walker2");
sprintf(key, "Solver.Nonlinear.EtaChoice");
switch_name = GetStringDefault(key, "Walker2");
switch_value = NA_NameToIndex(eta_switch_na, switch_name);
switch (switch_value)
{
case 0:
{
public_xtra->eta_choice = ETACONSTANT;
public_xtra->eta_value
= GetDoubleDefault("Solver.Nonlinear.EtaValue", 1e-4);
public_xtra->eta_alpha = 0.0;
public_xtra->eta_gamma = 0.0;
break;
}
case 1:
{
public_xtra->eta_choice = ETACHOICE1;
public_xtra->eta_alpha = 0.0;
public_xtra->eta_gamma = 0.0;
break;
}
case 2:
{
public_xtra->eta_choice = ETACHOICE2;
public_xtra->eta_alpha
= GetDoubleDefault("Solver.Nonlinear.EtaAlpha", 2.0);
public_xtra->eta_gamma
= GetDoubleDefault("Solver.Nonlinear.EtaGamma", 0.9);
public_xtra->eta_value = 0.0;
break;
}
default:
{
InputError("Error: Invalid value <%s> for key <%s>\n", switch_name,
key);
}
}
NA_FreeNameArray(eta_switch_na);
switch_na = NA_NewNameArray("False True");
sprintf(key, "Solver.Nonlinear.UseJacobian");
switch_name = GetStringDefault(key, "False");
switch_value = NA_NameToIndex(switch_na, switch_name);
switch (switch_value)
{
case 0:
{
(public_xtra->matvec) = NULL;
break;
}
case 1:
{
(public_xtra->matvec) = KINSolMatVec;
break;
}
default:
{
InputError("Error: Invalid value <%s> for key <%s>\n", switch_name,
key);
}
}
NA_FreeNameArray(switch_na);
sprintf(key, "Solver.Nonlinear.DerivativeEpsilon");
(public_xtra->derivative_epsilon) = GetDoubleDefault(key, 1e-7);
globalization_switch_na = NA_NewNameArray("InexactNewton LineSearch");
sprintf(key, "Solver.Nonlinear.Globalization");
switch_name = GetStringDefault(key, "LineSearch");
switch_value = NA_NameToIndex(globalization_switch_na, switch_name);
switch (switch_value)
{
case 0:
{
(public_xtra->globalization) = INEXACT_NEWTON;
break;
}
case 1:
{
(public_xtra->globalization) = LINESEARCH;
break;
}
default:
{
InputError("Error: Invalid value <%s> for key <%s>\n", switch_name,
key);
}
}
NA_FreeNameArray(globalization_switch_na);
precond_switch_na = NA_NewNameArray("NoPC MGSemi SMG PFMG PFMGOctree");
sprintf(key, "Solver.Linear.Preconditioner");
switch_name = GetStringDefault(key, "MGSemi");
switch_value = NA_NameToIndex(precond_switch_na, switch_name);
if (switch_value == 0)
{
(public_xtra->precond) = NULL;
(public_xtra->pcinit) = NULL;
(public_xtra->pcsolve) = NULL;
}
else if (switch_value > 0)
{
(public_xtra->precond) = PFModuleNewModuleType(
KinsolPCNewPublicXtraInvoke,
KinsolPC,
(key, switch_name));
(public_xtra->pcinit) = (KINSpgmrPrecondFn)KINSolInitPC;
(public_xtra->pcsolve) = (KINSpgmrPrecondSolveFn)KINSolCallPC;
}
else
{
InputError("Error: Invalid value <%s> for key <%s>\n", switch_name,
key);
}
NA_FreeNameArray(precond_switch_na);
public_xtra->nl_function_eval = PFModuleNewModule(NlFunctionEval, ());
public_xtra->neq = ((public_xtra->max_restarts) + 1)
* (public_xtra->krylov_dimension);
if (public_xtra->matvec != NULL)
public_xtra->richards_jacobian_eval =
PFModuleNewModuleType(
RichardsJacobianEvalNewPublicXtraInvoke,
RichardsJacobianEval,
("Solver.Nonlinear.Jacobian"));
else
public_xtra->richards_jacobian_eval = NULL;
(public_xtra->time_index) = RegisterTiming("KINSol");
PFModulePublicXtra(this_module) = public_xtra;
return this_module;
}
PFModule *KinsolNonlinSolverInitInstanceXtra(
Problem * problem,
Grid * grid,
ProblemData *problem_data,
double * temp_data)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
InstanceXtra *instance_xtra;
int neq = public_xtra->neq;
int max_restarts = public_xtra->max_restarts;
int krylov_dimension = public_xtra->krylov_dimension;
int max_iter = public_xtra->max_iter;
int print_flag = public_xtra->print_flag;
int eta_choice = public_xtra->eta_choice;
long int *iopt;
double *ropt;
double eta_value = public_xtra->eta_value;
double eta_alpha = public_xtra->eta_alpha;
double eta_gamma = public_xtra->eta_gamma;
double derivative_epsilon = public_xtra->derivative_epsilon;
Vector *fscale;
Vector *uscale;
State *current_state;
KINSpgmruserAtimesFn matvec = public_xtra->matvec;
KINSpgmrPrecondFn pcinit = public_xtra->pcinit;
KINSpgmrPrecondSolveFn pcsolve = public_xtra->pcsolve;
KINMem kin_mem;
FILE *kinsol_file;
char filename[255];
int i;
if (PFModuleInstanceXtra(this_module) == NULL)
instance_xtra = ctalloc(InstanceXtra, 1);
else
instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
/*-----------------------------------------------------------------------
* Initialize module instances
*-----------------------------------------------------------------------*/
if (PFModuleInstanceXtra(this_module) == NULL)
{
if (public_xtra->precond != NULL)
instance_xtra->precond =
PFModuleNewInstanceType(KinsolPCInitInstanceXtraInvoke, public_xtra->precond,
(problem, grid, problem_data, temp_data,
NULL, NULL, NULL, 0, 0));
else
instance_xtra->precond = NULL;
instance_xtra->nl_function_eval =
PFModuleNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, public_xtra->nl_function_eval,
(problem, grid, temp_data));
if (public_xtra->richards_jacobian_eval != NULL)
/* Initialize instance for nonsymmetric matrix */
instance_xtra->richards_jacobian_eval =
PFModuleNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, public_xtra->richards_jacobian_eval,
(problem, grid, problem_data, temp_data, 0));
else
instance_xtra->richards_jacobian_eval = NULL;
}
else
{
if (instance_xtra->precond != NULL)
PFModuleReNewInstanceType(KinsolPCInitInstanceXtraInvoke,
instance_xtra->precond,
(problem, grid, problem_data, temp_data,
NULL, NULL, NULL, 0, 0));
PFModuleReNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, instance_xtra->nl_function_eval,
(problem, grid, temp_data));
if (instance_xtra->richards_jacobian_eval != NULL)
PFModuleReNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, instance_xtra->richards_jacobian_eval,
(problem, grid, problem_data, temp_data, 0));
}
/*-----------------------------------------------------------------------
* Initialize KINSol input parameters and memory instance
*-----------------------------------------------------------------------*/
if (PFModuleInstanceXtra(this_module) == NULL)
{
current_state = ctalloc(State, 1);
/* Set up the grid data for the kinsol stuff */
SetPf2KinsolData(grid, 1);
/* Initialize KINSol parameters */
sprintf(filename, "%s.%s", GlobalsOutFileName, "kinsol.log");
if (!amps_Rank(amps_CommWorld))
kinsol_file = fopen(filename, "w");
else
kinsol_file = NULL;
instance_xtra->kinsol_file = kinsol_file;
/* Initialize KINSol memory */
kin_mem = (KINMem)KINMalloc(neq, kinsol_file, NULL);
/* Initialize the gmres linear solver in KINSol */
KINSpgmr((void*)kin_mem, /* Memory allocated above */
krylov_dimension, /* Max. Krylov dimension */
max_restarts, /* Max. no. of restarts - 0 is none */
1, /* Max. calls to PC Solve w/o PC Set */
pcinit, /* PC Set function */
pcsolve, /* PC Solve function */
matvec, /* ATimes routine */
current_state /* User data for PC stuff */
);
/* Initialize optional arguments for KINSol */
iopt = instance_xtra->int_optional_input;
ropt = instance_xtra->real_optional_input;
// Only print on rank 0
iopt[PRINTFL] = amps_Rank(amps_CommWorld) ? 0 : print_flag;
iopt[MXITER] = max_iter;
iopt[PRECOND_NO_INIT] = 0;
iopt[NNI] = 0;
iopt[NFE] = 0;
iopt[NBCF] = 0;
iopt[NBKTRK] = 0;
iopt[ETACHOICE] = eta_choice;
iopt[NO_MIN_EPS] = 0;
ropt[MXNEWTSTEP] = 0.0;
ropt[RELFUNC] = derivative_epsilon;
ropt[RELU] = 0.0;
ropt[FNORM] = 0.0;
ropt[STEPL] = 0.0;
ropt[ETACONST] = eta_value;
ropt[ETAALPHA] = eta_alpha;
/* Put in conditional assignment of eta_gamma since KINSOL aliases */
/* ETAGAMMA and ETACONST */
if (eta_value == 0.0)
ropt[ETAGAMMA] = eta_gamma;
/* Initialize iteration counts */
for (i = 0; i < OPT_SIZE; i++)
instance_xtra->integer_outputs[i] = 0;
/* Scaling vectors*/
uscale = NewVectorType(grid, 1, 1, vector_cell_centered);
InitVectorAll(uscale, 1.0);
instance_xtra->uscale = uscale;
fscale = NewVectorType(grid, 1, 1, vector_cell_centered);
InitVectorAll(fscale, 1.0);
instance_xtra->fscale = fscale;
instance_xtra->feval = KINSolFunctionEval;
instance_xtra->kin_mem = kin_mem;
instance_xtra->current_state = current_state;
}
PFModuleInstanceXtra(this_module) = instance_xtra;
return this_module;
}
int KinsolNonlinSolver(Vector *pressure, Vector *density, Vector *old_density, Vector *saturation, Vector *old_saturation, double t, double dt, ProblemData *problem_data, Vector *old_pressure, Vector *evap_trans, Vector *ovrl_bc_flx, Vector *x_velocity, Vector *y_velocity, Vector *z_velocity)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
Matrix *jacobian_matrix = (instance_xtra->jacobian_matrix);
Matrix *jacobian_matrix_C = (instance_xtra->jacobian_matrix_C);
Vector *uscale = (instance_xtra->uscale);
Vector *fscale = (instance_xtra->fscale);
PFModule *nl_function_eval = instance_xtra->nl_function_eval;
PFModule *richards_jacobian_eval = instance_xtra->richards_jacobian_eval;
PFModule *precond = instance_xtra->precond;
State *current_state = (instance_xtra->current_state);
int globalization = (public_xtra->globalization);
int neq = (public_xtra->neq);
double residual_tol = (public_xtra->residual_tol);
double step_tol = (public_xtra->step_tol);
SysFn feval = (instance_xtra->feval);
KINMem kin_mem = (instance_xtra->kin_mem);
FILE *kinsol_file = (instance_xtra->kinsol_file);
long int *integer_outputs = (instance_xtra->integer_outputs);
long int *iopt = (instance_xtra->int_optional_input);
double *ropt = (instance_xtra->real_optional_input);
int ret = 0;
StateFunc(current_state) = nl_function_eval;
StateProblemData(current_state) = problem_data;
StateTime(current_state) = t;
StateDt(current_state) = dt;
StateOldDensity(current_state) = old_density;
StateOldPressure(current_state) = old_pressure;
StateOldSaturation(current_state) = old_saturation;
StateDensity(current_state) = density;
StateSaturation(current_state) = saturation;
StateJacEval(current_state) = richards_jacobian_eval;
StateJac(current_state) = jacobian_matrix;
StateJacC(current_state) = jacobian_matrix_C; //dok
StatePrecond(current_state) = precond;
StateEvapTrans(current_state) = evap_trans; /*sk*/
StateOvrlBcFlx(current_state) = ovrl_bc_flx; /*sk*/
StateXvel(current_state) = x_velocity; //jjb
StateYvel(current_state) = y_velocity; //jjb
StateZvel(current_state) = z_velocity; //jjb
if (!amps_Rank(amps_CommWorld))
fprintf(kinsol_file, "\nKINSOL starting step for time %f\n", t);
BeginTiming(public_xtra->time_index);
ret = KINSol((void*)kin_mem, /* Memory allocated above */
neq, /* Dummy variable here */
pressure, /* Initial guess @ this was "pressure before" */
feval, /* Nonlinear function */
globalization, /* Globalization method */
uscale, /* Scalings for the variable */
fscale, /* Scalings for the function */
residual_tol, /* Stopping tolerance on func */
step_tol, /* Stop tol. for sucessive steps */
NULL, /* Constraints */
TRUE, /* Optional inputs */
iopt, /* Opt. integer inputs */
ropt, /* Opt. double inputs */
current_state /* User-supplied input */
);
EndTiming(public_xtra->time_index);
integer_outputs[NNI] += iopt[NNI];
integer_outputs[NFE] += iopt[NFE];
integer_outputs[NBCF] += iopt[NBCF];
integer_outputs[NBKTRK] += iopt[NBKTRK];
integer_outputs[SPGMR_NLI] += iopt[SPGMR_NLI];
integer_outputs[SPGMR_NPE] += iopt[SPGMR_NPE];
integer_outputs[SPGMR_NPS] += iopt[SPGMR_NPS];
integer_outputs[SPGMR_NCFL] += iopt[SPGMR_NCFL];
if (!amps_Rank(amps_CommWorld))
PrintFinalStats(kinsol_file, iopt, integer_outputs);
if (ret == KINSOL_SUCCESS || ret == KINSOL_INITIAL_GUESS_OK)
{
ret = 0;
}
return(ret);
}
void SelectTimeStep(
double *dt, /* Time step size */
char *dt_info, /* Character flag indicating what requirement
chose the time step */
double time,
Problem *problem,
ProblemData *problem_data)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module);
Type0 *dummy0;
Type1 *dummy1;
double well_dt, bc_dt;
switch((public_xtra -> type))
{
case 0:
{
double constant;
dummy0 = (Type0 *)(public_xtra -> data);
constant = (dummy0 -> step);
(*dt) = constant;
break;
} /* End case 0 */
case 1:
{
double initial_step;
double factor;
double max_step;
double min_step;
dummy1 = (Type1 *)(public_xtra -> data);
initial_step = (dummy1 -> initial_step);
factor = (dummy1 -> factor);
max_step = (dummy1 -> max_step);
min_step = (dummy1 -> min_step);
if ((*dt) == 0.0)
{
(*dt) = initial_step;
}
else
{
(*dt) = (*dt)*factor;
if ((*dt) < min_step) (*dt) = min_step;
if ((*dt) > max_step) (*dt) = max_step;
}
break;
} /* End case 1 */
} /* End switch */
/*-----------------------------------------------------------------
* Get delta t's for all wells and boundary conditions.
*-----------------------------------------------------------------*/
well_dt = TimeCycleDataComputeNextTransition(problem, time,
WellDataTimeCycleData(ProblemDataWellData(problem_data)));
bc_dt = TimeCycleDataComputeNextTransition(problem, time,
BCPressureDataTimeCycleData(ProblemDataBCPressureData(problem_data)));
/*-----------------------------------------------------------------
* Compute the new dt value based on time stepping criterion imposed
* by the user or on system parameter changes. Indicate what
* determined the value of `dt'.
*-----------------------------------------------------------------*/
if ( well_dt <= 0.0 ) well_dt = (*dt);
if ( bc_dt <= 0.0 ) bc_dt = (*dt);
if ((*dt) > well_dt)
{
(*dt) = well_dt;
(*dt_info) = 'w';
}
else if ((*dt) > bc_dt)
{
(*dt) = bc_dt;
(*dt_info) = 'b';
}
else
{
(*dt_info) = 'p';
}
}
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 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 XSlope(
ProblemData *problem_data,
Vector * x_slope,
Vector * dummy)
{
PFModule *this_module = ThisPFModule;
PublicXtra *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);
Grid *grid3d = instance_xtra->grid3d;
GrGeomSolid *gr_solid, *gr_domain;
Type0 *dummy0;
Type1 *dummy1;
Type2 *dummy2;
Type3 *dummy3;
VectorUpdateCommHandle *handle;
SubgridArray *subgrids = GridSubgrids(grid3d);
Subgrid *subgrid;
Subvector *ps_sub;
Subvector *sx_values_sub;
double *data;
double *psdat, *sx_values_dat;
//double slopex[60][32][392];
int ix, iy, iz;
int nx, ny, nz;
int r;
int is, i, j, k, ips, ipicv;
double time = 0.0;
(void)dummy;
/*-----------------------------------------------------------------------
* Put in any user defined sources for this phase
*-----------------------------------------------------------------------*/
InitVectorAll(x_slope, 0.0);
switch ((public_xtra->type))
{
case 0:
{
int num_regions;
int *region_indices;
double *values;
double x, y, z;
double value;
int ir;
dummy0 = (Type0*)(public_xtra->data);
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(x_slope, 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);
/*
* TODO
* SGS this does not match the loop in nl_function_eval. That
* loop is going over more than the inner geom locations. Is that
* important? Originally the x_slope array was not being allocated
* by ctalloc, just alloc and unitialized memory reads were being
* caused. Switched that to be ctalloc to init to 0 to "hack" a
* fix but is this really a sign of deeper indexing problems?
*/
/* @RMM: todo. the looping to set slopes only goes over interior nodes
* not ALL nodes (including ghost) as in nl fn eval and now the overland eval
* routines. THis is fine in the KW approximation which only needs interior values
* but for diffusive wave and for the terrain following grid (which uses the surface
* topo slopes as subsurface slopes) this can cuase bddy problems. */
data = SubvectorData(ps_sub);
GrGeomInLoop(i, j, k, gr_solid, r, ix, iy, iz, nx, ny, nz,
{
ips = SubvectorEltIndex(ps_sub, i, j, 0);
x = RealSpaceX(i, SubgridRX(subgrid));
//data[ips] = sin(x)/8.0 + (1/8)*pow(x,-(7/8)) +sin(x/5.0)/(5.0*8.0);
data[ips] = value;
});
}
}
break;
} /* End case 0 */
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 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 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]);
});
void PermeabilityFace(
Vector *zperm,
Vector *permeability)
{
PFModule *this_module = ThisPFModule;
InstanceXtra *instance_xtra = (InstanceXtra *)PFModuleInstanceXtra(this_module);
PublicXtra *public_xtra = (PublicXtra *)PFModulePublicXtra(this_module);
Grid *z_grid = (instance_xtra -> z_grid);
VectorUpdateCommHandle *handle;
SubgridArray *subgrids;
Subgrid *subgrid;
Subvector *subvector_pc, *subvector_pf;
int ix, iy, iz;
int nx, ny, nz;
double dx, dy, dz;
int nx_pc, ny_pc, nz_pc;
int nx_pf, ny_pf, nz_pf;
int pci, pfi;
int sg, i, j, k;
int flopest;
double *pf, *pc_l, *pc_u;
/*-----------------------------------------------------------------------
* Begin timing
*-----------------------------------------------------------------------*/
BeginTiming(public_xtra -> time_index);
/*-----------------------------------------------------------------------
* exchange boundary data for cell permeability values
*-----------------------------------------------------------------------*/
handle = InitVectorUpdate(permeability, VectorUpdateAll);
FinalizeVectorUpdate(handle);
/*-----------------------------------------------------------------------
* compute the z-face permeabilities for each subgrid
*-----------------------------------------------------------------------*/
subgrids = GridSubgrids(z_grid);
ForSubgridI(sg, subgrids)
{
subgrid = SubgridArraySubgrid(subgrids, sg);
subvector_pc = VectorSubvector(permeability, sg);
subvector_pf = VectorSubvector(zperm, sg);
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);
nx_pc = SubvectorNX(subvector_pc);
ny_pc = SubvectorNY(subvector_pc);
nz_pc = SubvectorNZ(subvector_pc);
nx_pf = SubvectorNX(subvector_pf);
ny_pf = SubvectorNY(subvector_pf);
nz_pf = SubvectorNZ(subvector_pf);
flopest = nx_pf * ny_pf * nz_pf;
pc_l = SubvectorElt(subvector_pc, ix ,iy ,iz-1);
pc_u = SubvectorElt(subvector_pc, ix ,iy ,iz );
pf = SubvectorElt(subvector_pf, ix ,iy ,iz);
pci = 0; pfi = 0;
BoxLoopI2(i,j,k,
ix,iy,iz,nx,ny,nz,
pci,nx_pc,ny_pc,nz_pc,1,1,1,
pfi,nx_pf,ny_pf,nz_pf,1,1,1,
{
pf[pfi] = Mean( pc_l[pci], pc_u[pci] );
});
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 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)));
}