static
int nlsKinsolErrorHandler(int errorCode, DATA *data, NONLINEAR_SYSTEM_DATA *nlsData, NLS_KINSOL_DATA *kinsolData)
{
int retValue, i, retValue2=0;
double fNorm;
double *xStart = NV_DATA_S(kinsolData->initialGuess);
double *xScaling = NV_DATA_S(kinsolData->xScale);
/* check what kind of error
* retValue < 0 -> a non recoverable issue
* retValue == 1 -> try with other settings
*/
KINSetNoInitSetup(kinsolData->kinsolMemory, FALSE);
switch(errorCode)
{
case KIN_MEM_NULL:
case KIN_ILL_INPUT:
case KIN_NO_MALLOC:
errorStreamPrint(LOG_NLS, 0, "kinsol has a serious memory issue ERROR %d\n", errorCode);
return errorCode;
break;
/* just retry with new initial guess */
case KIN_MXNEWT_5X_EXCEEDED:
warningStreamPrint(LOG_NLS, 0, "initial guess was too far away from the solution. Try again.\n");
return 1;
break;
/* just retry without line search */
case KIN_LINESEARCH_NONCONV:
warningStreamPrint(LOG_NLS, 0, "kinsols line search did not convergence. Try without.\n");
kinsolData->kinsolStrategy = KIN_NONE;
return 1;
/* maybe happened because of an out-dated factorization, so just retry */
case KIN_LSETUP_FAIL:
case KIN_LSOLVE_FAIL:
warningStreamPrint(LOG_NLS, 0, "kinsols matrix need new factorization. Try again.\n");
KINKLUReInit(kinsolData->kinsolMemory, kinsolData->size, kinsolData->nnz, 2);
return 1;
case KIN_MAXITER_REACHED:
case KIN_REPTD_SYSFUNC_ERR:
warningStreamPrint(LOG_NLS, 0, "kinsols runs into issues retry with differnt configuration.\n");
retValue = 1;
break;
default:
errorStreamPrint(LOG_STDOUT, 0, "kinsol has a serious solving issue ERROR %d\n", errorCode);
return errorCode;
break;
}
/* check if the current solution is sufficient anyway */
KINGetFuncNorm(kinsolData->kinsolMemory, &fNorm);
if (fNorm<FTOL_WITH_LESS_ACCURANCY)
{
warningStreamPrint(LOG_NLS, 0, "Move forward with a less accurate solution.");
KINSetFuncNormTol(kinsolData->kinsolMemory, FTOL_WITH_LESS_ACCURANCY);
KINSetScaledStepTol(kinsolData->kinsolMemory, FTOL_WITH_LESS_ACCURANCY);
retValue2 = 1;
}
else
{
warningStreamPrint(LOG_NLS, 0, "Current status of fx = %f", fNorm);
}
/* reconfigure kinsol for an other try */
if (retValue == 1 && !retValue2)
{
switch(kinsolData->retries)
{
case 0:
/* try without x scaling */
nlsKinsolXScaling(data, kinsolData, nlsData, SCALING_ONES);
break;
case 1:
/* try without line-search and oldValues */
nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_OLDVALUES);
kinsolData->kinsolStrategy = KIN_LINESEARCH;
break;
case 2:
/* try without line-search and oldValues */
nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_EXTRAPOLATION);
kinsolData->kinsolStrategy = KIN_NONE;
break;
case 3:
/* try with exact newton */
nlsKinsolXScaling(data, kinsolData, nlsData, SCALING_NOMINALSTART);
nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_EXTRAPOLATION);
KINSetMaxSetupCalls(kinsolData->kinsolMemory, 1);
kinsolData->kinsolStrategy = KIN_LINESEARCH;
break;
case 4:
/* try with exact newton to with out x scaling values */
nlsKinsolXScaling(data, kinsolData, nlsData, SCALING_ONES);
nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_OLDVALUES);
KINSetMaxSetupCalls(kinsolData->kinsolMemory, 1);
kinsolData->kinsolStrategy = KIN_LINESEARCH;
break;
default:
retValue = 0;
break;
}
}
return retValue+retValue2;
}
static void KIM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
const char *fnames_solver[]= {
"nfe",
"nni",
"nbcf",
"nbops",
"fnorm",
"step",
"LSInfo",
};
const char *fnames_dense[]= {
"name",
"njeD",
"nfeD"
};
const char *fnames_spils[]= {
"name",
"nli",
"npe",
"nps",
"ncfl",
};
long int nfe, nni, nbcf, nbops;
double fnorm, step;
long int njeD, nfeD;
long int nli, npe, nps, ncfl;
int flag;
mxArray *mx_ls;
int nfields;
if (kim_Kdata == NULL) return;
flag = KINGetNumNonlinSolvIters(kin_mem, &nni);
flag = KINGetNumFuncEvals(kin_mem, &nfe);
flag = KINGetNumBetaCondFails(kin_mem, &nbcf);
flag = KINGetNumBacktrackOps(kin_mem, &nbops);
flag = KINGetFuncNorm(kin_mem, &fnorm);
flag = KINGetStepLength(kin_mem, &step);
nfields = sizeof(fnames_solver)/sizeof(*fnames_solver);
plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_solver);
mxSetField(plhs[0], 0, "nfe", mxCreateScalarDouble((double)nfe));
mxSetField(plhs[0], 0, "nni", mxCreateScalarDouble((double)nni));
mxSetField(plhs[0], 0, "nbcf", mxCreateScalarDouble((double)nbcf));
mxSetField(plhs[0], 0, "nbops", mxCreateScalarDouble((double)nbops));
mxSetField(plhs[0], 0, "fnorm", mxCreateScalarDouble(fnorm));
mxSetField(plhs[0], 0, "step", mxCreateScalarDouble(step));
/* Linear Solver Statistics */
switch(ls) {
case LS_DENSE:
flag = KINDenseGetNumJacEvals(kin_mem, &njeD);
flag = KINDenseGetNumFuncEvals(kin_mem, &nfeD);
nfields = sizeof(fnames_dense)/sizeof(*fnames_dense);
mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_dense);
mxSetField(mx_ls, 0, "name", mxCreateString("Dense"));
mxSetField(mx_ls, 0, "njeD", mxCreateScalarDouble((double)njeD));
mxSetField(mx_ls, 0, "nfeD", mxCreateScalarDouble((double)nfeD));
break;
case LS_SPGMR:
case LS_SPBCG:
case LS_SPTFQMR:
flag = KINSpilsGetNumLinIters(kin_mem, &nli);
flag = KINSpilsGetNumPrecEvals(kin_mem, &npe);
flag = KINSpilsGetNumPrecSolves(kin_mem, &nps);
flag = KINSpilsGetNumConvFails(kin_mem, &ncfl);
nfields = sizeof(fnames_spils)/sizeof(*fnames_spils);
mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_spils);
if (ls == LS_SPGMR)
mxSetField(mx_ls, 0, "name", mxCreateString("GMRES"));
else if (ls == LS_SPBCG)
mxSetField(mx_ls, 0, "name", mxCreateString("BiCGStab"));
else
mxSetField(mx_ls, 0, "name", mxCreateString("TFQMR"));
mxSetField(mx_ls, 0, "nli", mxCreateScalarDouble((double)nli));
mxSetField(mx_ls, 0, "npe", mxCreateScalarDouble((double)npe));
mxSetField(mx_ls, 0, "nps", mxCreateScalarDouble((double)nps));
mxSetField(mx_ls, 0, "ncfl", mxCreateScalarDouble((double)ncfl));
break;
}
mxSetField(plhs[0], 0, "LSInfo", mx_ls);
return;
}
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, 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);
}
