int CVSpbcg(void *cvode_mem, int pretype, int maxl)
{
CVodeMem cv_mem;
CVSpilsMem cvspils_mem;
SpbcgMem spbcg_mem;
int mxl;
/* Return immediately if cvode_mem is NULL */
if (cvode_mem == NULL) {
CVProcessError(NULL, CVSPILS_MEM_NULL, "CVSPBCG", "CVSpbcg", MSGS_CVMEM_NULL);
return(CVSPILS_MEM_NULL);
}
cv_mem = (CVodeMem) cvode_mem;
/* Check if N_VDotProd is present */
if (vec_tmpl->ops->nvdotprod == NULL) {
CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_NVECTOR);
return(CVSPILS_ILL_INPUT);
}
if (lfree != NULL) lfree(cv_mem);
/* Set four main function fields in cv_mem */
linit = CVSpbcgInit;
lsetup = CVSpbcgSetup;
lsolve = CVSpbcgSolve;
lfree = CVSpbcgFree;
/* Get memory for CVSpilsMemRec */
cvspils_mem = NULL;
cvspils_mem = (CVSpilsMem) malloc(sizeof(CVSpilsMemRec));
if (cvspils_mem == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL);
return(CVSPILS_MEM_FAIL);
}
/* Set ILS type */
cvspils_mem->s_type = SPILS_SPBCG;
/* Set Spbcg parameters that have been passed in call sequence */
cvspils_mem->s_pretype = pretype;
mxl = cvspils_mem->s_maxl = (maxl <= 0) ? CVSPILS_MAXL : maxl;
/* Set default values for the rest of the Spbcg parameters */
cvspils_mem->s_delt = CVSPILS_DELT;
cvspils_mem->s_P_data = NULL;
cvspils_mem->s_pset = NULL;
cvspils_mem->s_psolve = NULL;
cvspils_mem->s_jtimes = CVSpilsDQJtimes;
cvspils_mem->s_j_data = cvode_mem;
cvspils_mem->s_last_flag = CVSPILS_SUCCESS;
setupNonNull = FALSE;
/* Check for legal pretype */
if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) &&
(pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) {
CVProcessError(cv_mem, CVSPILS_ILL_INPUT, "CVSPBCG", "CVSpbcg", MSGS_BAD_PRETYPE);
return(CVSPILS_ILL_INPUT);
}
/* Allocate memory for ytemp and x */
ytemp = NULL;
ytemp = N_VClone(vec_tmpl);
if (ytemp == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL);
free(cvspils_mem); cvspils_mem = NULL;
return(CVSPILS_MEM_FAIL);
}
x = NULL;
x = N_VClone(vec_tmpl);
if (x == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL);
N_VDestroy(ytemp);
free(cvspils_mem); cvspils_mem = NULL;
return(CVSPILS_MEM_FAIL);
}
/* Compute sqrtN from a dot product */
N_VConst(ONE, ytemp);
sqrtN = RSqrt(N_VDotProd(ytemp, ytemp));
/* Call SpbcgMalloc to allocate workspace for Spbcg */
spbcg_mem = NULL;
spbcg_mem = SpbcgMalloc(mxl, vec_tmpl);
if (spbcg_mem == NULL) {
CVProcessError(cv_mem, CVSPILS_MEM_FAIL, "CVSPBCG", "CVSpbcg", MSGS_MEM_FAIL);
N_VDestroy(ytemp);
N_VDestroy(x);
free(cvspils_mem); cvspils_mem = NULL;
return(CVSPILS_MEM_FAIL);
}
/* Attach SPBCG memory to spils memory structure */
spils_mem = (void *) spbcg_mem;
/* Attach linear solver memory to integrator memory */
lmem = cvspils_mem;
return(CVSPILS_SUCCESS);
}
int KINSpbcg(void *kinmem, int maxl)
{
KINMem kin_mem;
KINSpilsMem kinspils_mem;
SpbcgMem spbcg_mem;
int maxl1;
if (kinmem == NULL){
KINProcessError(NULL, KINSPILS_MEM_NULL, "KINSPILS", "KINSpbcg", MSGS_KINMEM_NULL);
return(KINSPILS_MEM_NULL);
}
kin_mem = (KINMem) kinmem;
/* check for required vector operations */
/* Note: do NOT need to check for N_VLinearSum, N_VProd, N_VScale, N_VDiv,
or N_VWL2Norm because they are required by KINSOL */
if ((vec_tmpl->ops->nvconst == NULL) ||
(vec_tmpl->ops->nvdotprod == NULL) ||
(vec_tmpl->ops->nvl1norm == NULL)) {
KINProcessError(NULL, KINSPILS_ILL_INPUT, "KINSPILS", "KINSpbcg", MSGS_BAD_NVECTOR);
return(KINSPILS_ILL_INPUT);
}
if (lfree != NULL) lfree(kin_mem);
/* set four main function fields in kin_mem */
linit = KINSpbcgInit;
lsetup = KINSpbcgSetup;
lsolve = KINSpbcgSolve;
lfree = KINSpbcgFree;
/* get memory for KINSpilsMemRec */
kinspils_mem = NULL;
kinspils_mem = (KINSpilsMem) malloc(sizeof(struct KINSpilsMemRec));
if (kinspils_mem == NULL){
KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpbcg", MSGS_MEM_FAIL);
return(KINSPILS_MEM_FAIL);
}
/* Set ILS type */
kinspils_mem->s_type = SPILS_SPBCG;
/* set SPBCG parameters that were passed in call sequence */
maxl1 = (maxl <= 0) ? KINSPILS_MAXL : maxl;
kinspils_mem->s_maxl = maxl1;
/* Set defaults for Jacobian-related fileds */
jtimesDQ = TRUE;
jtimes = NULL;
J_data = NULL;
/* Set defaults for preconditioner-related fields */
kinspils_mem->s_pset = NULL;
kinspils_mem->s_psolve = NULL;
kinspils_mem->s_pfree = NULL;
kinspils_mem->s_P_data = kin_mem->kin_user_data;
/* Set default values for the rest of the SPBCG parameters */
kinspils_mem->s_pretype = PREC_NONE;
kinspils_mem->s_last_flag = KINSPILS_SUCCESS;
/* Call SpbcgMalloc to allocate workspace for SPBCG */
/* vec_tmpl passed as template vector */
spbcg_mem = NULL;
spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl);
if (spbcg_mem == NULL) {
KINProcessError(NULL, KINSPILS_MEM_FAIL, "KINSPILS", "KINSpbcg", MSGS_MEM_FAIL);
free(kinspils_mem); kinspils_mem = NULL;
return(KINSPILS_MEM_FAIL);
}
/* This is an iterative linear solver */
inexact_ls = TRUE;
/* Attach SPBCG memory to spils memory structure */
spils_mem = (void *) spbcg_mem;
/* attach linear solver memory to KINSOL memory */
lmem = kinspils_mem;
return(KINSPILS_SUCCESS);
}
int IDASpbcg(void *ida_mem, int maxl)
{
IDAMem IDA_mem;
IDASpilsMem idaspils_mem;
SpbcgMem spbcg_mem;
int flag, maxl1;
/* Return immediately if ida_mem is NULL */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL);
return(IDASPILS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Check if N_VDotProd is present */
if (vec_tmpl->ops->nvdotprod == NULL) {
IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR);
return(IDASPILS_ILL_INPUT);
}
if (lfree != NULL) flag = lfree((IDAMem) ida_mem);
/* Set five main function fields in ida_mem */
linit = IDASpbcgInit;
lsetup = IDASpbcgSetup;
lsolve = IDASpbcgSolve;
lperf = IDASpbcgPerf;
lfree = IDASpbcgFree;
/* Get memory for IDASpilsMemRec */
idaspils_mem = NULL;
idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec));
if (idaspils_mem == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
return(IDASPILS_MEM_FAIL);
}
/* Set ILS type */
idaspils_mem->s_type = SPILS_SPBCG;
/* Set SPBCG parameters that were passed in call sequence */
maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl;
idaspils_mem->s_maxl = maxl1;
/* Set defaults for Jacobian-related fileds */
jtimesDQ = TRUE;
jtimes = NULL;
jdata = NULL;
/* Set defaults for preconditioner-related fields */
idaspils_mem->s_pset = NULL;
idaspils_mem->s_psolve = NULL;
idaspils_mem->s_pfree = NULL;
idaspils_mem->s_pdata = IDA_mem->ida_user_data;
/* Set default values for the rest of the Spbcg parameters */
idaspils_mem->s_eplifac = PT05;
idaspils_mem->s_dqincfac = ONE;
idaspils_mem->s_last_flag = IDASPILS_SUCCESS;
/* Set setupNonNull to FALSE */
setupNonNull = FALSE;
/* Allocate memory for ytemp, yptemp, and xx */
ytemp = N_VClone(vec_tmpl);
if (ytemp == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
free(idaspils_mem); idaspils_mem = NULL;
return(IDASPILS_MEM_FAIL);
}
yptemp = N_VClone(vec_tmpl);
if (yptemp == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
N_VDestroy(ytemp);
free(idaspils_mem); idaspils_mem = NULL;
return(IDASPILS_MEM_FAIL);
}
xx = N_VClone(vec_tmpl);
if (xx == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
N_VDestroy(ytemp);
N_VDestroy(yptemp);
free(idaspils_mem); idaspils_mem = NULL;
return(IDASPILS_MEM_FAIL);
}
/* Compute sqrtN from a dot product */
N_VConst(ONE, ytemp);
sqrtN = SUNRsqrt(N_VDotProd(ytemp, ytemp));
/* Call SpbcgMalloc to allocate workspace for Spbcg */
spbcg_mem = NULL;
spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl);
if (spbcg_mem == NULL) {
IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
N_VDestroy(ytemp);
N_VDestroy(yptemp);
N_VDestroy(xx);
free(idaspils_mem); idaspils_mem = NULL;
return(IDASPILS_MEM_FAIL);
}
/* Attach SPBCG memory to spils memory structure */
spils_mem = (void *)spbcg_mem;
/* Attach linear solver memory to the integrator memory */
lmem = idaspils_mem;
return(IDASPILS_SUCCESS);
}
/*---------------------------------------------------------------
ARKSpbcg:
This routine initializes the memory record and sets various
function fields specific to the Spbcg linear solver module.
ARKSpbcg first calls the existing lfree routine if this is not
NULL. It then sets the ark_linit, ark_lsetup, ark_lsolve,
ark_lfree fields in (*arkode_mem) to be ARKSpbcgInit,
ARKSpbcgSetup, ARKSpbcgSolve, and ARKSpbcgFree, respectively.
It allocates memory for a structure of type ARKSpilsMemRec and
sets the ark_lmem field in (*arkode_mem) to the address of
this structure. It sets setupNonNull in (*arkode_mem),
and sets various fields in the ARKSpilsMemRec structure.
Finally, ARKSpbcg allocates memory for ytemp and x, and calls
SpbcgMalloc to allocate memory for the Spbcg solver.
---------------------------------------------------------------*/
int ARKSpbcg(void *arkode_mem, int pretype, int maxl)
{
ARKodeMem ark_mem;
ARKSpilsMem arkspils_mem;
SpbcgMem spbcg_mem;
int mxl;
/* Return immediately if arkode_mem is NULL */
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKSPILS_MEM_NULL, "ARKSPBCG",
"ARKSpbcg", MSGS_ARKMEM_NULL);
return(ARKSPILS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Check if N_VDotProd and N_VProd are present */
if ((ark_mem->ark_tempv->ops->nvdotprod == NULL) ||
(ark_mem->ark_tempv->ops->nvprod == NULL)) {
arkProcessError(ark_mem, ARKSPILS_ILL_INPUT, "ARKSPBCG",
"ARKSpbcg", MSGS_BAD_NVECTOR);
return(ARKSPILS_ILL_INPUT);
}
if (ark_mem->ark_lfree != NULL) ark_mem->ark_lfree(ark_mem);
/* Set four main function fields in ark_mem */
ark_mem->ark_linit = ARKSpbcgInit;
ark_mem->ark_lsetup = ARKSpbcgSetup;
ark_mem->ark_lsolve = ARKSpbcgSolve;
ark_mem->ark_lfree = ARKSpbcgFree;
ark_mem->ark_lsolve_type = 0;
/* Get memory for ARKSpilsMemRec */
arkspils_mem = NULL;
arkspils_mem = (ARKSpilsMem) malloc(sizeof(struct ARKSpilsMemRec));
if (arkspils_mem == NULL) {
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKSPBCG",
"ARKSpbcg", MSGS_MEM_FAIL);
return(ARKSPILS_MEM_FAIL);
}
/* Set ILS type */
arkspils_mem->s_type = SPILS_SPBCG;
/* Set Spbcg parameters that have been passed in call sequence */
arkspils_mem->s_pretype = pretype;
mxl = arkspils_mem->s_maxl = (maxl <= 0) ? ARKSPILS_MAXL : maxl;
/* Set defaults for Jacobian-related fields */
arkspils_mem->s_jtimesDQ = TRUE;
arkspils_mem->s_jtimes = NULL;
arkspils_mem->s_j_data = NULL;
/* Set defaults for preconditioner-related fields */
arkspils_mem->s_pset = NULL;
arkspils_mem->s_psolve = NULL;
arkspils_mem->s_pfree = NULL;
arkspils_mem->s_P_data = ark_mem->ark_user_data;
/* Initialize counters */
arkspils_mem->s_npe = arkspils_mem->s_nli = 0;
arkspils_mem->s_nps = arkspils_mem->s_ncfl = 0;
arkspils_mem->s_nstlpre = arkspils_mem->s_njtimes = 0;
arkspils_mem->s_nfes = 0;
/* Set default values for the rest of the Spbcg parameters */
arkspils_mem->s_eplifac = ARKSPILS_EPLIN;
arkspils_mem->s_last_flag = ARKSPILS_SUCCESS;
ark_mem->ark_setupNonNull = FALSE;
/* Check for legal pretype */
if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) &&
(pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) {
arkProcessError(ark_mem, ARKSPILS_ILL_INPUT, "ARKSPBCG",
"ARKSpbcg", MSGS_BAD_PRETYPE);
free(arkspils_mem); arkspils_mem = NULL;
return(ARKSPILS_ILL_INPUT);
}
/* Allocate memory for ytemp and x */
arkspils_mem->s_ytemp = N_VClone(ark_mem->ark_tempv);
if (arkspils_mem->s_ytemp == NULL) {
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKSPBCG",
"ARKSpbcg", MSGS_MEM_FAIL);
free(arkspils_mem); arkspils_mem = NULL;
return(ARKSPILS_MEM_FAIL);
}
arkspils_mem->s_x = N_VClone(ark_mem->ark_tempv);
if (arkspils_mem->s_x == NULL) {
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKSPBCG",
"ARKSpbcg", MSGS_MEM_FAIL);
N_VDestroy(arkspils_mem->s_ytemp);
free(arkspils_mem); arkspils_mem = NULL;
return(ARKSPILS_MEM_FAIL);
}
/* Compute sqrtN from a dot product */
N_VConst(ONE, arkspils_mem->s_ytemp);
arkspils_mem->s_sqrtN = SUNRsqrt(N_VDotProd(arkspils_mem->s_ytemp,
arkspils_mem->s_ytemp));
/* Call SpbcgMalloc to allocate workspace for Spbcg */
spbcg_mem = NULL;
spbcg_mem = SpbcgMalloc(mxl, ark_mem->ark_tempv);
if (spbcg_mem == NULL) {
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKSPBCG",
"ARKSpbcg", MSGS_MEM_FAIL);
N_VDestroy(arkspils_mem->s_ytemp);
N_VDestroy(arkspils_mem->s_x);
free(arkspils_mem); arkspils_mem = NULL;
return(ARKSPILS_MEM_FAIL);
}
/* Attach SPBCG memory to spils memory structure */
arkspils_mem->s_spils_mem = (void *) spbcg_mem;
/* Attach linear solver memory to integrator memory */
ark_mem->ark_lmem = arkspils_mem;
return(ARKSPILS_SUCCESS);
}
