/* Fortran interface to C "set" routines for the ARKPcg solver;
see farkode.h for further details */
void FARK_PCGREINIT(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_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;
}
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);
}
/***************************** Main Program ******************************/
int main(int argc, char *argv[])
{
UserData data;
void *arkode_mem;
realtype abstol, reltol, t, tout;
N_Vector u;
int iout, my_pe, npes, flag, jpre;
long int neq, local_N, mudq, mldq, mukeep, mlkeep;
MPI_Comm comm;
data = NULL;
arkode_mem = NULL;
u = NULL;
/* Set problem size neq */
neq = NVARS*MX*MY;
/* 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\n",
npes, NPEX*NPEY);
MPI_Finalize();
return(1);
}
/* Set local length */
local_N = NVARS*MXSUB*MYSUB;
/* Allocate and load user data block */
data = (UserData) malloc(sizeof *data);
if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1);
InitUserData(my_pe, local_N, comm, data);
/* Allocate and initialize u, and set tolerances */
u = N_VNew_Parallel(comm, local_N, neq);
if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
SetInitialProfiles(u, data);
abstol = ATOL;
reltol = RTOL;
/* Call ARKodeCreate to create the solver memory */
arkode_mem = ARKodeCreate();
if(check_flag((void *)arkode_mem, "ARKodeCreate", 0, my_pe)) MPI_Abort(comm, 1);
/* Set the pointer to user-defined data */
flag = ARKodeSetUserData(arkode_mem, data);
if(check_flag(&flag, "ARKodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1);
/* Call ARKodeInit to initialize the integrator memory and specify the
user's right hand side functions in u'=fe(t,u)+fi(t,u) [here fe is NULL],
the inital time T0, and the initial dependent variable vector u. */
flag = ARKodeInit(arkode_mem, NULL, f, T0, u);
if(check_flag(&flag, "ARKodeInit", 1, my_pe)) return(1);
/* Call ARKodeSetMaxNumSteps to increase default */
flag = ARKodeSetMaxNumSteps(arkode_mem, 10000);
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1, my_pe)) return(1);
/* Call ARKodeSStolerances to specify the scalar relative tolerance
and scalar absolute tolerances */
flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
if (check_flag(&flag, "ARKodeSStolerances", 1, my_pe)) return(1);
/* Call ARKSpgmr to specify the linear solver ARKSPGMR with left
preconditioning and the default Krylov dimension maxl */
flag = ARKSpgmr(arkode_mem, PREC_LEFT, 0);
if(check_flag(&flag, "ARKBBDSpgmr", 1, my_pe)) MPI_Abort(comm, 1);
/* Initialize BBD preconditioner */
mudq = mldq = NVARS*MXSUB;
mukeep = mlkeep = NVARS;
flag = ARKBBDPrecInit(arkode_mem, local_N, mudq, mldq,
mukeep, mlkeep, ZERO, flocal, NULL);
if(check_flag(&flag, "ARKBBDPrecAlloc", 1, my_pe)) MPI_Abort(comm, 1);
/* Print heading */
if (my_pe == 0) PrintIntro(npes, mudq, mldq, mukeep, mlkeep);
/* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */
for (jpre=PREC_LEFT; jpre<=PREC_RIGHT; jpre++) {
/* On second run, re-initialize u, the integrator, ARKBBDPRE, and ARKSPGMR */
if (jpre == PREC_RIGHT) {
SetInitialProfiles(u, data);
flag = ARKodeReInit(arkode_mem, NULL, f, T0, u);
if(check_flag(&flag, "ARKodeReInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = ARKBBDPrecReInit(arkode_mem, mudq, mldq, ZERO);
if(check_flag(&flag, "ARKBBDPrecReInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = ARKSpilsSetPrecType(arkode_mem, PREC_RIGHT);
check_flag(&flag, "ARKSpilsSetPrecType", 1, my_pe);
if (my_pe == 0) {
printf("\n\n-------------------------------------------------------");
printf("------------\n");
}
}
if (my_pe == 0) {
printf("\n\nPreconditioner type is: jpre = %s\n\n",
(jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT");
}
/* In loop over output points, call ARKode, print results, test for error */
for (iout=1, tout=TWOHR; iout<=NOUT; iout++, tout+=TWOHR) {
flag = ARKode(arkode_mem, tout, u, &t, ARK_NORMAL);
if(check_flag(&flag, "ARKode", 1, my_pe)) break;
PrintOutput(arkode_mem, my_pe, comm, u, t);
}
/* Print final statistics */
if (my_pe == 0) PrintFinalStats(arkode_mem);
} /* End of jpre loop */
/* Free memory */
N_VDestroy_Parallel(u);
free(data);
ARKodeFree(&arkode_mem);
MPI_Finalize();
return(0);
}
