/* Fortran interface to C routine ARKSptfqmr and it's associated
"set" routines; see farkode.h for further details */
void FARK_SPTFQMR(int *pretype, int *maxl, realtype *delt, int *ier) {
*ier = ARKSptfqmr(ARK_arkodemem, *pretype, *maxl);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetEpsLin(ARK_arkodemem, *delt);
if (*ier != ARKSPILS_SUCCESS) return;
ARK_ls = ARK_LS_SPTFQMR;
return;
}
/* Fortran interface to C routine ARKPcg and it's associated
"set" routines; see farkode.h for further details */
void FARK_PCG(int *pretype, int *maxl, realtype *delt, int *ier) {
*ier = ARKPcg(ARK_arkodemem, *pretype, *maxl);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetEpsLin(ARK_arkodemem, *delt);
if (*ier != ARKSPILS_SUCCESS) return;
ARK_ls = ARK_LS_PCG;
return;
}
/* Fortran interface to C "set" routines for the ARKSpfgmr solver;
see farkode.h for further details */
void FARK_SPFGMRREINIT(int *pretype, int *gstype,
realtype *delt, int *ier) {
*ier = ARKSpilsSetPrecType(ARK_arkodemem, *pretype);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetGSType(ARK_arkodemem, *gstype);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetEpsLin(ARK_arkodemem, *delt);
if (*ier != ARKSPILS_SUCCESS) return;
ARK_ls = ARK_LS_SPFGMR;
return;
}
/* Fortran interface to C "set" routines for the ARKSpbcg solver;
see farkode.h for further details */
void FARK_SPBCGREINIT(int *pretype, int *maxl,
realtype *delt, int *ier) {
*ier = ARKSpilsSetPrecType(ARK_arkodemem, *pretype);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetMaxl(ARK_arkodemem, *maxl);
if (*ier != ARKSPILS_SUCCESS) return;
*ier = ARKSpilsSetEpsLin(ARK_arkodemem, *delt);
if (*ier != ARKSPILS_SUCCESS) return;
ARK_ls = ARK_LS_SPBCG;
return;
}
int main()
{
realtype abstol=ATOL, reltol=RTOL, t, tout;
N_Vector c;
WebData wdata;
void *arkode_mem;
booleantype firstrun;
int jpre, gstype, flag;
int ns, mxns, iout;
c = NULL;
wdata = NULL;
arkode_mem = NULL;
/* Initializations */
c = N_VNew_Serial(NEQ);
if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1);
wdata = AllocUserData();
if(check_flag((void *)wdata, "AllocUserData", 2)) return(1);
InitUserData(wdata);
ns = wdata->ns;
mxns = wdata->mxns;
/* Print problem description */
PrintIntro();
/* Loop over jpre and gstype (four cases) */
for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) {
for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) {
/* Initialize c and print heading */
CInit(c, wdata);
PrintHeader(jpre, gstype);
/* Call ARKodeInit or ARKodeReInit, then ARKSpgmr to set up problem */
firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS);
if (firstrun) {
arkode_mem = ARKodeCreate();
if(check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return(1);
wdata->arkode_mem = arkode_mem;
flag = ARKodeSetUserData(arkode_mem, wdata);
if(check_flag(&flag, "ARKodeSetUserData", 1)) return(1);
flag = ARKodeInit(arkode_mem, NULL, f, T0, c);
if(check_flag(&flag, "ARKodeInit", 1)) return(1);
flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
if (check_flag(&flag, "ARKodeSStolerances", 1)) return(1);
flag = ARKodeSetMaxNumSteps(arkode_mem, 1000);
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return(1);
flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-3);
if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return(1);
flag = ARKSpgmr(arkode_mem, jpre, MAXL);
if(check_flag(&flag, "ARKSpgmr", 1)) return(1);
flag = ARKSpilsSetGSType(arkode_mem, gstype);
if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);
flag = ARKSpilsSetEpsLin(arkode_mem, DELT);
if(check_flag(&flag, "ARKSpilsSetEpsLin", 1)) return(1);
flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve);
if(check_flag(&flag, "ARKSpilsSetPreconditioner", 1)) return(1);
} else {
flag = ARKodeReInit(arkode_mem, NULL, f, T0, c);
if(check_flag(&flag, "ARKodeReInit", 1)) return(1);
flag = ARKSpilsSetPrecType(arkode_mem, jpre);
check_flag(&flag, "ARKSpilsSetPrecType", 1);
flag = ARKSpilsSetGSType(arkode_mem, gstype);
if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);
}
/* Print initial values */
if (firstrun) PrintAllSpecies(c, ns, mxns, T0);
/* Loop over output points, call ARKode, print sample solution values. */
tout = T1;
for (iout = 1; iout <= NOUT; iout++) {
flag = ARKode(arkode_mem, tout, c, &t, ARK_NORMAL);
PrintOutput(arkode_mem, t);
if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t);
if(check_flag(&flag, "ARKode", 1)) break;
if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT;
}
/* Print final statistics, and loop for next case */
PrintFinalStats(arkode_mem);
}
}
/* Free all memory */
ARKodeFree(&arkode_mem);
N_VDestroy_Serial(c);
FreeUserData(wdata);
return(0);
}
