int KINBBDSpgmr(void *kinmem, int maxl, void *p_data)
{
KINMem kin_mem;
int flag;
flag = KINSpgmr(kinmem, maxl);
if (flag != KINSPILS_SUCCESS) return(flag);
kin_mem = (KINMem) kinmem;
if (p_data == NULL) {
KINProcessError(kin_mem, KINBBDPRE_PDATA_NULL, "KINBBDPRE", "KINBBDSpgmr", MSGBBD_PDATA_NULL);
return(KINBBDPRE_PDATA_NULL);
}
flag = KINSpilsSetPreconditioner(kinmem,
KINBBDPrecSetup,
KINBBDPrecSolve,
p_data);
if (flag != KINSPILS_SUCCESS) return(flag);
return(KINSPILS_SUCCESS);
}
int main(void)
{
int globalstrategy;
realtype fnormtol, scsteptol;
N_Vector cc, sc, constraints;
UserData data;
int flag, maxl, maxlrst;
void *kmem;
cc = sc = constraints = NULL;
kmem = NULL;
data = NULL;
/* Allocate memory, and set problem data, initial values, tolerances */
globalstrategy = KIN_NONE;
data = AllocUserData();
if (check_flag((void *)data, "AllocUserData", 2)) return(1);
InitUserData(data);
/* Create serial vectors of length NEQ */
cc = N_VNew_Serial(NEQ);
if (check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);
sc = N_VNew_Serial(NEQ);
if (check_flag((void *)sc, "N_VNew_Serial", 0)) return(1);
data->rates = N_VNew_Serial(NEQ);
if (check_flag((void *)data->rates, "N_VNew_Serial", 0)) return(1);
constraints = N_VNew_Serial(NEQ);
if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
N_VConst(TWO, constraints);
SetInitialProfiles(cc, sc);
fnormtol=FTOL; scsteptol=STOL;
/* Call KINCreate/KINInit to initialize KINSOL.
A pointer to KINSOL problem memory is returned and stored in kmem. */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0)) return(1);
/* Vector cc passed as template vector. */
flag = KINInit(kmem, func, cc);
if (check_flag(&flag, "KINInit", 1)) return(1);
flag = KINSetUserData(kmem, data);
if (check_flag(&flag, "KINSetUserData", 1)) return(1);
flag = KINSetConstraints(kmem, constraints);
if (check_flag(&flag, "KINSetConstraints", 1)) return(1);
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);
flag = KINSetScaledStepTol(kmem, scsteptol);
if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1);
/* We no longer need the constraints vector since KINSetConstraints
creates a private copy for KINSOL to use. */
N_VDestroy_Serial(constraints);
/* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner
routines PrecSetupBD and PrecSolveBD. */
maxl = 15;
maxlrst = 2;
flag = KINSpgmr(kmem, maxl);
if (check_flag(&flag, "KINSpgmr", 1)) return(1);
flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1)) return(1);
flag = KINSpilsSetPreconditioner(kmem,
PrecSetupBD,
PrecSolveBD);
if (check_flag(&flag, "KINSpilsSetPreconditioner", 1)) return(1);
/* Print out the problem size, solution parameters, initial guess. */
PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol);
/* Call KINSol and print output concentration profile */
flag = KINSol(kmem, /* KINSol memory block */
cc, /* initial guess on input; solution vector */
globalstrategy, /* global stragegy choice */
sc, /* scaling vector, for the variable cc */
sc); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1)) return(1);
printf("\n\nComputed equilibrium species concentrations:\n");
PrintOutput(cc);
/* Print final statistics and free memory */
PrintFinalStats(kmem);
N_VDestroy_Serial(cc);
N_VDestroy_Serial(sc);
KINFree(&kmem);
FreeUserData(data);
return(0);
}
int main(int argc, char *argv[])
{
MPI_Comm comm;
void *kmem;
UserData data;
N_Vector cc, sc, constraints;
int globalstrategy;
long int Nlocal;
realtype fnormtol, scsteptol, dq_rel_uu;
int flag, maxl, maxlrst;
long int mudq, mldq, mukeep, mlkeep;
int my_pe, npes, npelast = NPEX*NPEY-1;
data = NULL;
kmem = NULL;
cc = sc = constraints = NULL;
/* Get processor number and total number of pe's */
MPI_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_size(comm, &npes);
MPI_Comm_rank(comm, &my_pe);
if (npes != NPEX*NPEY) {
if (my_pe == 0)
printf("\nMPI_ERROR(0): npes=%d is not equal to NPEX*NPEY=%d\n", npes,
NPEX*NPEY);
return(1);
}
/* Allocate memory, and set problem data, initial values, tolerances */
/* Set local length */
Nlocal = NUM_SPECIES*MXSUB*MYSUB;
/* Allocate and initialize user data block */
data = AllocUserData();
if (check_flag((void *)data, "AllocUserData", 2, my_pe)) MPI_Abort(comm, 1);
InitUserData(my_pe, Nlocal, comm, data);
/* Choose global strategy */
globalstrategy = KIN_NONE;
/* Allocate and initialize vectors */
cc = N_VNew_Parallel(comm, Nlocal, NEQ);
if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
sc = N_VNew_Parallel(comm, Nlocal, NEQ);
if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
data->rates = N_VNew_Parallel(comm, Nlocal, NEQ);
if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe))
MPI_Abort(comm, 1);
constraints = N_VNew_Parallel(comm, Nlocal, NEQ);
if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe))
MPI_Abort(comm, 1);
N_VConst(ZERO, constraints);
SetInitialProfiles(cc, sc);
fnormtol = FTOL; scsteptol = STOL;
/* Call KINCreate/KINInit to initialize KINSOL:
nvSpec points to machine environment data
A pointer to KINSOL problem memory is returned and stored in kmem. */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1);
/* Vector cc passed as template vector. */
flag = KINInit(kmem, func, cc);
if (check_flag(&flag, "KINInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetUserData(kmem, data);
if (check_flag(&flag, "KINSetUserData", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetConstraints(kmem, constraints);
if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1);
/* We no longer need the constraints vector since KINSetConstraints
creates a private copy for KINSOL to use. */
N_VDestroy_Parallel(constraints);
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetScaledStepTol(kmem, scsteptol);
if (check_flag(&flag, "KINSetScaledStepTol", 1, my_pe)) MPI_Abort(comm, 1);
/* Call KINBBDPrecInit to initialize and allocate memory for the
band-block-diagonal preconditioner, and specify the local and
communication functions func_local and gcomm=NULL (all communication
needed for the func_local is already done in func). */
dq_rel_uu = ZERO;
mudq = mldq = 2*NUM_SPECIES - 1;
mukeep = mlkeep = NUM_SPECIES;
/* Call KINBBDSpgmr to specify the linear solver KINSPGMR */
maxl = 20; maxlrst = 2;
flag = KINSpgmr(kmem, maxl);
if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1);
/* Initialize BBD preconditioner */
flag = KINBBDPrecInit(kmem, Nlocal, mudq, mldq, mukeep, mlkeep,
dq_rel_uu, func_local, NULL);
if (check_flag(&flag, "KINBBDPrecInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe))
MPI_Abort(comm, 1);
/* Print out the problem size, solution parameters, initial guess. */
if (my_pe == 0)
PrintHeader(globalstrategy, maxl, maxlrst, mudq, mldq, mukeep,
mlkeep, fnormtol, scsteptol);
/* call KINSol and print output concentration profile */
flag = KINSol(kmem, /* KINSol memory block */
cc, /* initial guesss on input; solution vector */
globalstrategy, /* global stragegy choice */
sc, /* scaling vector, for the variable cc */
sc); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1);
if (my_pe == 0) printf("\n\nComputed equilibrium species concentrations:\n");
if (my_pe == 0 || my_pe==npelast) PrintOutput(my_pe, comm, cc);
/* Print final statistics and free memory */
if (my_pe == 0)
PrintFinalStats(kmem);
N_VDestroy_Parallel(cc);
N_VDestroy_Parallel(sc);
KINFree(&kmem);
FreeUserData(data);
MPI_Finalize();
return(0);
}
void FKIN_SPGMR(int *maxl, int *maxlrst, int *ier)
{
*ier = KINSpgmr(KIN_kinmem, *maxl);
KINSpilsSetMaxRestarts(KIN_kinmem, *maxlrst);
KIN_ls = KIN_LS_SPGMR;
}
int main(int argc, char *argv[])
{
int globalstrategy;
long int local_N;
realtype fnormtol, scsteptol;
N_Vector cc, sc, constraints;
UserData data;
int flag, maxl, maxlrst;
int my_pe, npes, npelast = NPEX*NPEY-1;
void *kmem;
MPI_Comm comm;
cc = sc = constraints = NULL;
data = NULL;
kmem = NULL;
/* Get processor number and total number of pe's */
MPI_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_size(comm, &npes);
MPI_Comm_rank(comm, &my_pe);
if (npes != NPEX*NPEY) {
if (my_pe == 0)
fprintf(stderr, "\nMPI_ERROR(0); npes = %d is not equal to NPEX*NPEY = %d\n",
npes,NPEX*NPEY);
MPI_Finalize();
return(1);
}
/* Allocate memory, and set problem data, initial values, tolerances */
/* Set local vector length */
local_N = NUM_SPECIES*MXSUB*MYSUB;
/* Allocate and initialize user data block */
data = AllocUserData();
if (check_flag((void *)data, "AllocUserData", 0, my_pe)) MPI_Abort(comm, 1);
InitUserData(my_pe, comm, data);
/* Set global strategy flag */
globalstrategy = KIN_NONE;
/* Allocate and initialize vectors */
cc = N_VNew_Parallel(comm, local_N, NEQ);
if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
sc = N_VNew_Parallel(comm, local_N, NEQ);
if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
data->rates = N_VNew_Parallel(comm, local_N, NEQ);
if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
constraints = N_VNew_Parallel(comm, local_N, NEQ);
if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
N_VConst(ZERO, constraints);
SetInitialProfiles(cc, sc);
fnormtol=FTOL; scsteptol=STOL;
/* Call KINCreate/KINMalloc to initialize KINSOL:
nvSpec is the nvSpec pointer used in the parallel version
A pointer to KINSOL problem memory is returned and stored in kmem. */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1);
/* Vector cc passed as template vector. */
flag = KINMalloc(kmem, funcprpr, cc);
if (check_flag(&flag, "KINMalloc", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetNumMaxIters(kmem, 250);
if (check_flag(&flag, "KINSetNumMaxIters", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetFdata(kmem, data);
if (check_flag(&flag, "KINSetFdata", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetConstraints(kmem, constraints);
if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSetScaledStepTol(kmem, scsteptol);
if (check_flag(&flag, "KINSetScaledStepTop", 1, my_pe)) MPI_Abort(comm, 1);
/* We no longer need the constraints vector since KINSetConstraints
creates a private copy for KINSOL to use. */
N_VDestroy_Parallel(constraints);
/* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner
routines Precondbd and PSolvebd, and the pointer to the user data block. */
maxl = 20; maxlrst = 2;
flag = KINSpgmr(kmem, maxl);
if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe)) MPI_Abort(comm, 1);
flag = KINSpilsSetPreconditioner(kmem,
Precondbd,
PSolvebd,
data);
if (check_flag(&flag, "KINSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1);
/* Print out the problem size, solution parameters, initial guess. */
if (my_pe == 0)
PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol);
/* Call KINSol and print output concentration profile */
flag = KINSol(kmem, /* KINSol memory block */
cc, /* initial guess on input; solution vector */
globalstrategy, /* global stragegy choice */
sc, /* scaling vector for the variable cc */
sc); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1);
if (my_pe == 0)
printf("\n\nComputed equilibrium species concentrations:\n");
if (my_pe == 0 || my_pe == npelast)
PrintOutput(my_pe, comm, cc);
/* Print final statistics and free memory */
if (my_pe == 0)
PrintFinalStats(kmem);
N_VDestroy_Parallel(cc);
N_VDestroy_Parallel(sc);
KINFree(&kmem);
FreeUserData(data);
MPI_Finalize();
return(0);
}
static void KIM_Malloc(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
int status;
mxArray *mx_in[3], *mx_out[2];
int mxiter, msbset, msbsetsub, etachoice, mxnbcf;
double eta, egamma, ealpha, mxnewtstep, relfunc, fnormtol, scsteptol;
booleantype verbose, noInitSetup, noMinEps;
double *constraints;
N_Vector NVconstraints;
int ptype;
int mudq, mldq, mupper, mlower;
int maxl, maxrs;
double dqrely;
/*
* -----------------------------
* Find out the vector type and
* then pass it to the vector
* library.
* -----------------------------
*/
/* Send vec_type and mx_comm */
InitVectors();
/*
* -----------------------------
* Extract stuff from arguments:
* - SYS function
* - problem dimension
* - solver options
* - user data
* -----------------------------
*/
/* Matlab user-provided function */
mxDestroyArray(mx_SYSfct);
mx_SYSfct = mxDuplicateArray(prhs[0]);
/* problem dimension */
N = (int) mxGetScalar(prhs[1]);
/* Solver Options -- optional argument */
status = get_SolverOptions(prhs[2],
&verbose,
&mxiter, &msbset, &msbsetsub, &etachoice, &mxnbcf,
&eta, &egamma, &ealpha, &mxnewtstep,
&relfunc, &fnormtol, &scsteptol,
&constraints,
&noInitSetup, &noMinEps);
/* User data -- optional argument */
mxDestroyArray(mx_data);
mx_data = mxDuplicateArray(prhs[3]);
/*
* -----------------------------------------------------
* Set solution vector (used as a template to KINMAlloc)
* -----------------------------------------------------
*/
y = NewVector(N);
/*
* ----------------------------------------
* Create kinsol object and allocate memory
* ----------------------------------------
*/
kin_mem = KINCreate();
/* attach error handler function */
status = KINSetErrHandlerFn(kin_mem, mtlb_KINErrHandler, NULL);
if (verbose) {
status = KINSetPrintLevel(kin_mem,3);
/* attach info handler function */
status = KINSetInfoHandlerFn(kin_mem, mtlb_KINInfoHandler, NULL);
/* initialize the output window */
mx_in[0] = mxCreateScalarDouble(0);
mx_in[1] = mxCreateScalarDouble(0); /* ignored */
mx_in[2] = mxCreateScalarDouble(0); /* ignored */
mexCallMATLAB(1,mx_out,3,mx_in,"kim_info");
fig_handle = (int)*mxGetPr(mx_out[0]);
}
/* Call KINMalloc */
status = KINMalloc(kin_mem, mtlb_KINSys, y);
/* Redirect output */
status = KINSetErrFile(kin_mem, stdout);
/* Optional inputs */
status = KINSetNumMaxIters(kin_mem,mxiter);
status = KINSetNoInitSetup(kin_mem,noInitSetup);
status = KINSetNoMinEps(kin_mem,noMinEps);
status = KINSetMaxSetupCalls(kin_mem,msbset);
status = KINSetMaxSubSetupCalls(kin_mem,msbsetsub);
status = KINSetMaxBetaFails(kin_mem,mxnbcf);
status = KINSetEtaForm(kin_mem,etachoice);
status = KINSetEtaConstValue(kin_mem,eta);
status = KINSetEtaParams(kin_mem,egamma,ealpha);
status = KINSetMaxNewtonStep(kin_mem,mxnewtstep);
status = KINSetRelErrFunc(kin_mem,relfunc);
status = KINSetFuncNormTol(kin_mem,fnormtol);
status = KINSetScaledStepTol(kin_mem,scsteptol);
if (constraints != NULL) {
NVconstraints = N_VCloneEmpty(y);
N_VSetArrayPointer(constraints, NVconstraints);
status = KINSetConstraints(kin_mem,NVconstraints);
N_VDestroy(NVconstraints);
}
status = get_LinSolvOptions(prhs[2],
&mupper, &mlower,
&mudq, &mldq, &dqrely,
&ptype, &maxrs, &maxl);
switch (ls) {
case LS_NONE:
mexErrMsgTxt("KINMalloc:: no linear solver specified.");
break;
case LS_DENSE:
status = KINDense(kin_mem, N);
if (!mxIsEmpty(mx_JACfct))
status = KINDenseSetJacFn(kin_mem, mtlb_KINDenseJac, NULL);
break;
case LS_BAND:
status = KINBand(kin_mem, N, mupper, mlower);
if (!mxIsEmpty(mx_JACfct))
status = KINBandSetJacFn(kin_mem, mtlb_KINBandJac, NULL);
break;
case LS_SPGMR:
switch(pm) {
case PM_NONE:
status = KINSpgmr(kin_mem, maxl);
if (!mxIsEmpty(mx_PSOLfct)) {
if (!mxIsEmpty(mx_PSETfct))
status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
else
status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
}
break;
case PM_BBDPRE:
if (!mxIsEmpty(mx_GCOMfct))
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
else
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
status = KINBBDSpgmr(kin_mem, maxl, bbd_data);
break;
}
status = KINSpilsSetMaxRestarts(kin_mem, maxrs);
if (!mxIsEmpty(mx_JACfct))
status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);
break;
case LS_SPBCG:
switch(pm) {
case PM_NONE:
status = KINSpbcg(kin_mem, maxl);
if (!mxIsEmpty(mx_PSOLfct)) {
if (!mxIsEmpty(mx_PSETfct))
status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
else
status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
}
break;
case PM_BBDPRE:
if (!mxIsEmpty(mx_GCOMfct))
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
else
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
status = KINBBDSpbcg(kin_mem, maxl, bbd_data);
break;
}
if (!mxIsEmpty(mx_JACfct))
status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);
break;
case LS_SPTFQMR:
switch(pm) {
case PM_NONE:
status = KINSptfqmr(kin_mem, maxl);
if (!mxIsEmpty(mx_PSOLfct)) {
if (!mxIsEmpty(mx_PSETfct))
status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
else
status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
}
break;
case PM_BBDPRE:
if (!mxIsEmpty(mx_GCOMfct))
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
else
bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
status = KINBBDSptfqmr(kin_mem, maxl, bbd_data);
break;
}
if (!mxIsEmpty(mx_JACfct))
status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);
break;
}
return;
}
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;
}