SubgridArray *GetGridSubgrids(
SubgridArray *all_subgrids)
{
SubgridArray *subgrids;
Subgrid *s;
int i, my_proc;
my_proc = amps_Rank(amps_CommWorld);
subgrids = NewSubgridArray();
ForSubgridI(i, all_subgrids)
{
s = SubgridArraySubgrid(all_subgrids, i);
if (SubgridProcess(s) == my_proc)
AppendSubgrid(s, subgrids);
}
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;
}
}
}
}
/**
*
* \Ref{amps_SFBCast} is used to read data from a shared file. Note
* that the input is described by an \Ref{amps_Invoice} rather than the
* standard {\bf printf} syntax. This is to allow a closer mapping to
* the communication routines. Due to this change be careful; items in
* the input file must match what is in the invoice description. As it's
* name implies this function reads from a file and broadcasts the data
* in the file to all the nodes who are in the {\bf comm} context. Think
* of it as doing an \Ref{amps_BCAST} with a file replacing the node as
* the source. The data is stored in ASCII format and read in using
* the Standard C library function {\bf scanf} so it's formatting rules
* apply.
*
* {\large Example:}
* \begin{verbatim}
* amps_File file;
* amps_Invoice invoice;
*
* file = amps_SFopen(filename, "r");
*
* amps_SFBCast(amps_CommWorld, file, invoice);
*
* amps_SFclose(file);
* \end{verbatim}
*
* {\large Notes:}
*
* @memo Broadcast from a shared file
* @param comm Communication context [IN]
* @param file Shared file handle [IN]
* @param invoice Descriptions of data to read from file and distribute [IN/OUT]
* @return Error code
*/
int amps_SFBCast(amps_Comm comm, amps_File file, amps_Invoice invoice)
{
amps_InvoiceEntry *ptr;
int stride, len;
int malloced = 0;
if (!amps_Rank(comm))
{
amps_ClearInvoice(invoice);
invoice->combuf_flags |= AMPS_INVOICE_NON_OVERLAYED;
invoice->comm = comm;
/* for each entry in the invoice read the value from the input file */
ptr = invoice->list;
while (ptr != NULL)
{
/* invoke the packing convert out for the entry */
/* if user then call user ones */
/* else switch on builtin type */
if (ptr->len_type == AMPS_INVOICE_POINTER)
len = *(ptr->ptr_len);
else
len = ptr->len;
if (ptr->stride_type == AMPS_INVOICE_POINTER)
stride = *(ptr->ptr_stride);
else
stride = ptr->stride;
switch (ptr->type)
{
case AMPS_INVOICE_CHAR_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(char) * (size_t)(len * stride));
amps_ScanChar(file, *( char**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanChar(file, (char*)ptr->data, len, stride);
break;
case AMPS_INVOICE_SHORT_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(short) * (size_t)(len * stride));
amps_ScanShort(file, *( short**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanShort(file, (short*)ptr->data, len, stride);
break;
case AMPS_INVOICE_INT_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(int) * (size_t)(len * stride));
amps_ScanInt(file, *( int**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanInt(file, (int*)ptr->data, len, stride);
break;
case AMPS_INVOICE_LONG_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(long) * (size_t)(len * stride));
amps_ScanLong(file, *( long**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanLong(file, (long*)ptr->data, len, stride);
break;
case AMPS_INVOICE_FLOAT_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(float) * (size_t)(len * stride));
amps_ScanFloat(file, *( float**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanFloat(file, (float*)ptr->data, len, stride);
break;
case AMPS_INVOICE_DOUBLE_CTYPE:
if (ptr->data_type == AMPS_INVOICE_POINTER)
{
*((void**)(ptr->data)) = (void*)malloc(sizeof(double) * (size_t)(len * stride));
amps_ScanDouble(file, *( double**)(ptr->data), len, stride);
malloced = TRUE;
}
else
amps_ScanDouble(file, (double*)ptr->data, len, stride);
break;
}
ptr = ptr->next;
}
}
return amps_BCast(comm, 0, invoice);
}
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 *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);
}
