static int SolveIt(void *kmem, N_Vector u, N_Vector s, int glstr, int mset)
{
int flag;
printf("\n");
if (mset==1)
printf("Exact Newton");
else
printf("Modified Newton");
if (glstr == KIN_NONE)
printf("\n");
else
printf(" with line search\n");
flag = KINSetMaxSetupCalls(kmem, mset);
if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1);
flag = KINSol(kmem, u, glstr, s, s);
if (check_flag(&flag, "KINSol", 1)) return(1);
printf("Solution:\n [x1,x2] = ");
PrintOutput(u);
PrintFinalStats(kmem);
return(0);
}
static void KIM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
double *y0, *ys, *fs;
N_Vector yscale, fscale;
int buflen, status, strategy;
char *bufval;
if ( kim_Kdata == NULL) return ;
/* Exract y0 and load initial guess in y */
y0 = mxGetPr(prhs[0]);
PutData(y, y0, N);
/* Extract strategy */
buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1;
bufval = mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[1], bufval, buflen);
if(!strcmp(bufval,"None")) strategy = KIN_NONE;
if(!strcmp(bufval,"LineSearch")) strategy = KIN_LINESEARCH;
/* Extract yscale */
ys = mxGetPr(prhs[2]);
yscale = N_VCloneEmpty(y);
N_VSetArrayPointer(ys, yscale);
/* Extract fscale */
fs = mxGetPr(prhs[3]);
fscale = N_VCloneEmpty(y);
N_VSetArrayPointer(fs, fscale);
/* call KINSol() */
status = KINSol(kin_mem, y, strategy, yscale, fscale);
/* KINSOL return flag */
plhs[0] = mxCreateScalarDouble((double)status);
/* Solution vector */
plhs[1] = mxCreateDoubleMatrix(N,1,mxREAL);
GetData(y, mxGetPr(plhs[1]), N);
/* Free temporary N_Vectors */
N_VDestroy(yscale);
N_VDestroy(fscale);
return;
}
int nlsKinsolSolve(DATA *data, threadData_t *threadData, int sysNumber)
{
NONLINEAR_SYSTEM_DATA *nlsData = &(data->simulationInfo->nonlinearSystemData[sysNumber]);
NLS_KINSOL_DATA *kinsolData = (NLS_KINSOL_DATA*)nlsData->solverData;
long eqSystemNumber = nlsData->equationIndex;
int indexes[2] = {1,eqSystemNumber};
int flag, i;
long nFEval;
int success = 0;
int retry = 0;
double *xStart = NV_DATA_S(kinsolData->initialGuess);
double *xScaling = NV_DATA_S(kinsolData->xScale);
double *fScaling = NV_DATA_S(kinsolData->fScale);
double fNormValue;
/* set user data */
kinsolData->userData.data = data;
kinsolData->userData.threadData = threadData;
kinsolData->userData.sysNumber = sysNumber;
/* reset configuration settings */
nlsKinsolConfigSetup(kinsolData);
infoStreamPrint(LOG_NLS, 0, "------------------------------------------------------");
infoStreamPrintWithEquationIndexes(LOG_NLS, 1, indexes, "Start solving non-linear system >>%ld<< using Kinsol solver at time %g", eqSystemNumber, data->localData[0]->timeValue);
nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_EXTRAPOLATION);
/* set x scaling */
nlsKinsolXScaling(data, kinsolData, nlsData, SCALING_NOMINALSTART);
/* set f scaling */
_omc_fillVector(_omc_createVector(nlsData->size, fScaling), 1.);
/* */
do{
/* dump configuration */
nlsKinsolConfigPrint(kinsolData, nlsData);
flag = KINSol(kinsolData->kinsolMemory, /* KINSol memory block */
kinsolData->initialGuess, /* initial guess on input; solution vector */
kinsolData->kinsolStrategy, /* global strategy choice */
kinsolData->xScale, /* scaling vector, for the variable cc */
kinsolData->fScale); /* scaling vector for function values fval */
infoStreamPrint(LOG_NLS_V, 0, "KINSol finished with errorCode %d.", flag);
/* check for errors */
if(flag < 0)
{
retry = nlsKinsolErrorHandler(flag, data, nlsData, kinsolData);
}
/* solution found */
if ((flag == KIN_SUCCESS) || (flag == KIN_INITIAL_GUESS_OK) || (flag == KIN_STEP_LT_STPTOL))
{
success = 1;
}
kinsolData->retries++;
/* write statistics */
KINGetNumNonlinSolvIters(kinsolData->kinsolMemory, &nFEval);
nlsData->numberOfIterations += nFEval;
nlsData->numberOfFEval += kinsolData->countResCalls;
infoStreamPrint(LOG_NLS_V, 0, "Next try? success = %d, retry = %d, retries = %d = %s\n", success, retry, kinsolData->retries,!success && !(retry<1) && kinsolData->retries<RETRY_MAX ? "true" : "false" );
}while(!success && !(retry<0) && kinsolData->retries < RETRY_MAX);
/* solution found */
if (success)
{
/* check if solution really solves the residuals */
nlsKinsolResiduals(kinsolData->initialGuess, kinsolData->fRes, &kinsolData->userData);
fNormValue = N_VWL2Norm(kinsolData->fRes, kinsolData->fRes);
infoStreamPrint(LOG_NLS, 0, "scaled Euclidean norm of F(u) = %e", fNormValue);
if (FTOL_WITH_LESS_ACCURANCY<fNormValue)
{
warningStreamPrint(LOG_NLS, 0, "False positive solution. FNorm is too small.");
success = 0;
}
else /* solved system for reuse linear solver information */
{
kinsolData->solved = 1;
}
/* copy solution */
memcpy(nlsData->nlsx, xStart, nlsData->size*(sizeof(double)));
/* dump solution */
if(ACTIVE_STREAM(LOG_NLS))
{
infoStreamPrintWithEquationIndexes(LOG_NLS, 1, indexes, "solution for NLS %ld at t=%g", eqSystemNumber, kinsolData->userData.data->localData[0]->timeValue);
for(i=0; i<nlsData->size; ++i)
{
infoStreamPrintWithEquationIndexes(LOG_NLS, 0, indexes, "[%d] %s = %g", i+1, modelInfoGetEquation(&kinsolData->userData.data->modelData->modelDataXml,eqSystemNumber).vars[i], nlsData->nlsx[i]);
}
messageClose(LOG_NLS);
}
}
messageClose(LOG_NLS);
return 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_SOL(realtype *uu, int *globalstrategy,
realtype *uscale , realtype *fscale, int *ier)
{
N_Vector uuvec, uscalevec, fscalevec;
*ier = 0;
uuvec = uscalevec = fscalevec = NULL;
uuvec = F2C_KINSOL_vec;
N_VSetArrayPointer(uu, uuvec);
uscalevec = NULL;
uscalevec = N_VCloneEmpty(F2C_KINSOL_vec);
if (uscalevec == NULL) {
*ier = -4; /* KIN_MEM_FAIL */
return;
}
N_VSetArrayPointer(uscale, uscalevec);
fscalevec = NULL;
fscalevec = N_VCloneEmpty(F2C_KINSOL_vec);
if (fscalevec == NULL) {
N_VDestroy(uscalevec);
*ier = -4; /* KIN_MEM_FAIL */
return;
}
N_VSetArrayPointer(fscale, fscalevec);
/* Call main solver function */
*ier = KINSol(KIN_kinmem, uuvec, *globalstrategy, uscalevec, fscalevec);
N_VSetArrayPointer(NULL, uuvec);
N_VSetArrayPointer(NULL, uscalevec);
N_VDestroy(uscalevec);
N_VSetArrayPointer(NULL, fscalevec);
N_VDestroy(fscalevec);
/* load optional outputs into iout[] and rout[] */
KINGetWorkSpace(KIN_kinmem, &KIN_iout[0], &KIN_iout[1]); /* LENRW & LENIW */
KINGetNumNonlinSolvIters(KIN_kinmem, &KIN_iout[2]); /* NNI */
KINGetNumFuncEvals(KIN_kinmem, &KIN_iout[3]); /* NFE */
KINGetNumBetaCondFails(KIN_kinmem, &KIN_iout[4]); /* NBCF */
KINGetNumBacktrackOps(KIN_kinmem, &KIN_iout[5]); /* NBCKTRK */
KINGetFuncNorm(KIN_kinmem, &KIN_rout[0]); /* FNORM */
KINGetStepLength(KIN_kinmem, &KIN_rout[1]); /* SSTEP */
switch(KIN_ls) {
case KIN_LS_DENSE:
case KIN_LS_BAND:
case KIN_LS_LAPACKDENSE:
case KIN_LS_LAPACKBAND:
KINDlsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */
KINDlsGetLastFlag(KIN_kinmem, (int *) &KIN_iout[8]); /* LSTF */
KINDlsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]); /* NFE */
KINDlsGetNumJacEvals(KIN_kinmem, &KIN_iout[10]); /* NJE */
case KIN_LS_SPTFQMR:
case KIN_LS_SPBCG:
case KIN_LS_SPGMR:
KINSpilsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */
KINSpilsGetLastFlag(KIN_kinmem, (int *) &KIN_iout[8]); /* LSTF */
KINSpilsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]); /* NFE */
KINSpilsGetNumJtimesEvals(KIN_kinmem, &KIN_iout[10]); /* NJE */
KINSpilsGetNumPrecEvals(KIN_kinmem, &KIN_iout[11]); /* NPE */
KINSpilsGetNumPrecSolves(KIN_kinmem, &KIN_iout[12]); /* NPS */
KINSpilsGetNumLinIters(KIN_kinmem, &KIN_iout[13]); /* NLI */
KINSpilsGetNumConvFails(KIN_kinmem, &KIN_iout[14]); /* NCFL */
break;
}
return;
}
int main()
{
realtype fnormtol, scsteptol;
N_Vector y, scale, constraints;
int mset, flag, i;
void *kmem;
SUNMatrix J;
SUNLinearSolver LS;
y = scale = constraints = NULL;
kmem = NULL;
J = NULL;
LS = NULL;
printf("\nRobot Kinematics Example\n");
printf("8 variables; -1 <= x_i <= 1\n");
printf("KINSOL problem size: 8 + 2*8 = 24 \n\n");
/* Create vectors for solution, scales, and constraints */
y = N_VNew_Serial(NEQ);
if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1);
scale = N_VNew_Serial(NEQ);
if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1);
constraints = N_VNew_Serial(NEQ);
if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
/* Initialize and allocate memory for KINSOL */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0)) return(1);
flag = KINInit(kmem, func, y); /* y passed as a template */
if (check_flag(&flag, "KINInit", 1)) return(1);
/* Set optional inputs */
N_VConst_Serial(ZERO,constraints);
for (i = NVAR+1; i <= NEQ; i++) Ith(constraints, i) = ONE;
flag = KINSetConstraints(kmem, constraints);
if (check_flag(&flag, "KINSetConstraints", 1)) return(1);
fnormtol = FTOL;
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);
scsteptol = STOL;
flag = KINSetScaledStepTol(kmem, scsteptol);
if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1);
/* Create dense SUNMatrix */
J = SUNDenseMatrix(NEQ, NEQ);
if(check_flag((void *)J, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver object */
LS = SUNLinSol_Dense(y, J);
if(check_flag((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver to KINSOL */
flag = KINSetLinearSolver(kmem, LS, J);
if(check_flag(&flag, "KINSetLinearSolver", 1)) return(1);
/* Set the Jacobian function */
flag = KINSetJacFn(kmem, jac);
if (check_flag(&flag, "KINSetJacFn", 1)) return(1);
/* Indicate exact Newton */
mset = 1;
flag = KINSetMaxSetupCalls(kmem, mset);
if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1);
/* Initial guess */
N_VConst_Serial(ONE, y);
for(i = 1; i <= NVAR; i++) Ith(y,i) = SUNRsqrt(TWO)/TWO;
printf("Initial guess:\n");
PrintOutput(y);
/* Call KINSol to solve problem */
N_VConst_Serial(ONE,scale);
flag = KINSol(kmem, /* KINSol memory block */
y, /* initial guess on input; solution vector */
KIN_LINESEARCH, /* global strategy choice */
scale, /* scaling vector, for the variable cc */
scale); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1)) return(1);
printf("\nComputed solution:\n");
PrintOutput(y);
/* Print final statistics and free memory */
PrintFinalStats(kmem);
N_VDestroy_Serial(y);
N_VDestroy_Serial(scale);
N_VDestroy_Serial(constraints);
KINFree(&kmem);
SUNLinSolFree(LS);
SUNMatDestroy(J);
return(0);
}
/*! \fn kinsol_initialization
*
* \param [ref] [data]
* \param [in] [initData]
* \param [ref] [initialResiduals]
*
* \author lochel
*/
int kinsol_initialization(DATA* data, INIT_DATA* initData, int useScaling)
{
long i, indz;
KINSOL_DATA* kdata = NULL;
double fnormtol = 1.e-9; /* function tolerance */
double scsteptol = 1.e-9; /* step tolerance */
long int nni, nfe, nje, nfeD;
N_Vector z = NULL;
N_Vector sVars = NULL;
N_Vector sEqns = NULL;
N_Vector c = NULL;
int glstr = KIN_NONE; /* globalization strategy applied to the Newton method. It must be one of KIN_NONE or KIN_LINESEARCH */
long int mset = 1; /* maximum number of nonlinear iterations without a call to the preconditioner setup function. Pass 0 to indicate the default [10]. */
void *kmem = NULL;
int error_code = -1;
ASSERT(data->modelData.nInitResiduals == initData->nz, "The number of initial equations are not consistent with the number of unfixed variables. Select a different initialization.");
do /* Try it first with KIN_NONE. If that fails, try it with KIN_LINESEARCH. */
{
if(mset == 1 && glstr == KIN_NONE)
DEBUG_INFO(LOG_INIT, "using exact Newton");
else if(mset == 1)
DEBUG_INFO(LOG_INIT, "using exact Newton with line search");
else if(glstr == KIN_NONE)
DEBUG_INFO(LOG_INIT, "using modified Newton");
else
DEBUG_INFO(LOG_INIT, "using modified Newton with line search");
DEBUG_INFO_AL1(LOG_INIT, "| mset = %10ld", mset);
DEBUG_INFO_AL1(LOG_INIT, "| function tolerance = %10.6g", fnormtol);
DEBUG_INFO_AL1(LOG_INIT, "| step tolerance = %10.6g", scsteptol);
kdata = (KINSOL_DATA*)malloc(sizeof(KINSOL_DATA));
ASSERT(kdata, "out of memory");
kdata->initData = initData;
kdata->data = data;
z = N_VNew_Serial(3*initData->nz);
ASSERT(z, "out of memory");
sVars = N_VNew_Serial(3*initData->nz);
ASSERT(sVars, "out of memory");
sEqns = N_VNew_Serial(3*initData->nz);
ASSERT(sEqns, "out of memory");
c = N_VNew_Serial(3*initData->nz);
ASSERT(c, "out of memory");
/* initial guess */
for(i=0; i<initData->nz; ++i)
{
NV_Ith_S(z, i) = initData->start[i];
NV_Ith_S(z, initData->nInitResiduals+2*i+0) = NV_Ith_S(z, i) - initData->min[i];
NV_Ith_S(z, initData->nInitResiduals+2*i+1) = NV_Ith_S(z, i) - initData->max[i];
}
kdata->useScaling=useScaling;
if(useScaling)
{
computeInitialResidualScalingCoefficients(data, initData);
for(i=0; i<initData->nz; ++i)
{
NV_Ith_S(sVars, i) = 1.0 / (initData->nominal[i] == 0.0 ? 1.0 : initData->nominal[i]);
NV_Ith_S(sVars, initData->nInitResiduals+2*i+0) = NV_Ith_S(sVars, i);
NV_Ith_S(sVars, initData->nInitResiduals+2*i+1) = NV_Ith_S(sVars, i);
NV_Ith_S(sEqns, i) = 1.0 / (initData->residualScalingCoefficients[i] == 0.0 ? 1.0 : initData->residualScalingCoefficients[i]);
NV_Ith_S(sEqns, initData->nInitResiduals+2*i+0) = NV_Ith_S(sEqns, i);
NV_Ith_S(sEqns, initData->nInitResiduals+2*i+1) = NV_Ith_S(sEqns, i);
}
}
else
{
N_VConst_Serial(1.0, sVars); /* no scaling */
N_VConst_Serial(1.0, sEqns); /* no scaling */
}
for(i=0; i<initData->nz; ++i)
{
NV_Ith_S(c, i) = 0.0; /* no constraint on z[i] */
NV_Ith_S(c, initData->nInitResiduals+2*i+0) = 1.0;
NV_Ith_S(c, initData->nInitResiduals+2*i+1) = -1.0;
}
kmem = KINCreate();
ASSERT(kmem, "out of memory");
KINSetErrHandlerFn(kmem, kinsol_errorHandler, NULL);
KINSetUserData(kmem, kdata);
KINSetConstraints(kmem, c);
KINSetFuncNormTol(kmem, fnormtol);
KINSetScaledStepTol(kmem, scsteptol);
KINInit(kmem, kinsol_residuals, z);
/* Call KINDense to specify the linear solver */
KINDense(kmem, 3*initData->nz);
KINSetMaxSetupCalls(kmem, mset);
/*KINSetNumMaxIters(kmem, 2000);*/
globalInitialResiduals = initData->initialResiduals;
error_code = KINSol(kmem, /* KINSol memory block */
z, /* initial guess on input; solution vector */
glstr, /* global stragegy choice */
sVars, /* scaling vector, for the variable cc */
sEqns); /* scaling vector for function values fval */
globalInitialResiduals = NULL;
KINGetNumNonlinSolvIters(kmem, &nni);
KINGetNumFuncEvals(kmem, &nfe);
KINDlsGetNumJacEvals(kmem, &nje);
KINDlsGetNumFuncEvals(kmem, &nfeD);
DEBUG_INFO(LOG_INIT, "final kinsol statistics");
DEBUG_INFO_AL1(LOG_INIT, "| KINGetNumNonlinSolvIters = %5ld", nni);
DEBUG_INFO_AL1(LOG_INIT, "| KINGetNumFuncEvals = %5ld", nfe);
DEBUG_INFO_AL1(LOG_INIT, "| KINDlsGetNumJacEvals = %5ld", nje);
DEBUG_INFO_AL1(LOG_INIT, "| KINDlsGetNumFuncEvals = %5ld", nfeD);
/* Free memory */
N_VDestroy_Serial(z);
N_VDestroy_Serial(sVars);
N_VDestroy_Serial(sEqns);
N_VDestroy_Serial(c);
KINFree(&kmem);
free(kdata);
if(error_code < 0)
glstr++; /* try next globalization strategy */
}while(error_code < 0 && glstr <= KIN_LINESEARCH);
/* debug output */
indz = 0;
DEBUG_INFO(LOG_INIT, "solution");
for(i=0; i<data->modelData.nStates; ++i)
if(data->modelData.realVarsData[i].attribute.fixed==0)
DEBUG_INFO_AL2(LOG_INIT, "| %s = %g", initData->name[indz++], data->localData[0]->realVars[i]);
for(i=0; i<data->modelData.nParametersReal; ++i)
if(data->modelData.realParameterData[i].attribute.fixed == 0)
DEBUG_INFO_AL2(LOG_INIT, "| %s = %g", initData->name[indz++], data->simulationInfo.realParameter[i]);
if(error_code < 0)
THROW("kinsol failed. see last warning. use [-lv LOG_INIT] for more output.");
return 0;
}
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);
}
int main()
{
realtype fnormtol, fnorm;
N_Vector y, scale;
int flag;
void *kmem;
y = scale = NULL;
kmem = NULL;
/* -------------------------
* Print problem description
* ------------------------- */
printf("\n2D elliptic PDE on unit square\n");
printf(" d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0\n");
printf(" + homogeneous Dirichlet boundary conditions\n\n");
printf("Solution method: Anderson accelerated Picard iteration with band linear solver.\n");
printf("Problem size: %2ld x %2ld = %4ld\n",
(long int) NX, (long int) NY, (long int) NEQ);
/* --------------------------------------
* Create vectors for solution and scales
* -------------------------------------- */
y = N_VNew_Serial(NEQ);
if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1);
scale = N_VNew_Serial(NEQ);
if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1);
/* ----------------------------------------------------------------------------------
* Initialize and allocate memory for KINSOL, set parametrs for Anderson acceleration
* ---------------------------------------------------------------------------------- */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0)) return(1);
/* y is used as a template */
/* Use acceleration with up to 3 prior residuals */
flag = KINSetMAA(kmem, 3);
if (check_flag(&flag, "KINSetMAA", 1)) return(1);
flag = KINInit(kmem, func, y);
if (check_flag(&flag, "KINInit", 1)) return(1);
/* -------------------
* Set optional inputs
* ------------------- */
/* Specify stopping tolerance based on residual */
fnormtol = FTOL;
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);
/* -------------------------
* Attach band linear solver
* ------------------------- */
flag = KINBand(kmem, NEQ, NX, NX);
if (check_flag(&flag, "KINBand", 1)) return(1);
flag = KINDlsSetBandJacFn(kmem, jac);
if (check_flag(&flag, "KINDlsBandJacFn", 1)) return(1);
/* -------------
* Initial guess
* ------------- */
N_VConst_Serial(ZERO, y);
IJth(NV_DATA_S(y), 2, 2) = ONE;
/* ----------------------------
* Call KINSol to solve problem
* ---------------------------- */
/* No scaling used */
N_VConst_Serial(ONE,scale);
/* Call main solver */
flag = KINSol(kmem, /* KINSol memory block */
y, /* initial guess on input; solution vector */
KIN_PICARD, /* global strategy choice */
scale, /* scaling vector, for the variable cc */
scale); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1)) return(1);
/* ------------------------------------
* Print solution and solver statistics
* ------------------------------------ */
/* Get scaled norm of the system function */
flag = KINGetFuncNorm(kmem, &fnorm);
if (check_flag(&flag, "KINGetfuncNorm", 1)) return(1);
printf("\nComputed solution (||F|| = %g):\n\n",fnorm);
PrintOutput(y);
PrintFinalStats(kmem);
/* -----------
* Free memory
* ----------- */
N_VDestroy_Serial(y);
N_VDestroy_Serial(scale);
KINFree(&kmem);
return(0);
}
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);
}
bool kinsol_solve(void) {
double fnormtol;
N_Vector y, scale, constraints;
int mset, flag;
void *kmem;
y = scale = constraints = NULL;
kmem = NULL;
/* Create vectors for solution, scales, and constraints */
y = N_VMake_Serial(nvariables, variables);
if (y == NULL) goto cleanup;
scale = N_VNew_Serial(nvariables);
if (scale == NULL) goto cleanup;
constraints = N_VNew_Serial(nvariables);
if (constraints == NULL) goto cleanup;
/* Initialize and allocate memory for KINSOL */
kmem = KINCreate();
if (kmem == NULL) goto cleanup;
flag = KINInit(kmem, _f, y);
if (flag < 0) goto cleanup;
// This constrains metabolites >= 0
N_VConst_Serial(1.0, constraints);
flag = KINSetConstraints(kmem, constraints);
if (flag < 0) goto cleanup;
fnormtol = ARGS.ABSTOL;
flag = KINSetFuncNormTol(kmem, fnormtol);
if (flag < 0) goto cleanup;
//scsteptol = ARGS.RELTOL;
//flag = KINSetScaledStepTol(kmem, scsteptol);
//if (flag < 0) goto cleanup;
/* Attach dense linear solver */
flag = KINDense(kmem, nvariables);
if (flag < 0) goto cleanup;
flag = KINDlsSetDenseJacFn(kmem, _dfdy);
if (flag < 0) goto cleanup;
/* Indicate exact Newton */
//This makes sure that the user-supplied Jacobian gets evaluated onevery step.
mset = 1;
flag = KINSetMaxSetupCalls(kmem, mset);
if (flag < 0) goto cleanup;
/* Initial guess is the intial variable concentrations */
/* Call KINSol to solve problem */
N_VConst_Serial(1.0,scale);
flag = KINSol(kmem, /* KINSol memory block */
y, /* initial guess on input; solution vector */
KIN_NONE, /* basic Newton iteration */
scale, /* scaling vector, for the variable cc */
scale); /* scaling vector for function values fval */
if((ARGS.MODE != ABC) and (ARGS.MODE != ABCSIM) and (ARGS.MODE != Prior))
OUT_nums();
if (flag < 0) goto cleanup;
N_VDestroy_Serial(y);
N_VDestroy_Serial(scale);
N_VDestroy_Serial(constraints);
KINFree(&kmem);
return true;
cleanup:
error("Could not integrate!\n");
if (y!=NULL) N_VDestroy_Serial(y);
if (scale!=NULL) N_VDestroy_Serial(scale);
if (constraints!=NULL) N_VDestroy_Serial(constraints);
if (kmem!=NULL) KINFree(&kmem);
return false;
}
void KinsolSolver::solve() const
{
// Solve the linear system
KINSol(mSolver, mParametersVector, KIN_LINESEARCH, mOnesVector, mOnesVector);
}
