/***************************** Main Program ******************************/
int main(int argc, char *argv[])
{
realtype abstol, reltol, t, tout;
N_Vector u;
UserData data;
void *arkode_mem;
int iout, flag;
MPI_Comm comm;
HYPRE_Int local_N, npes, my_pe;
HYPRE_ParVector Upar; /* Declare HYPRE parallel vector */
HYPRE_IJVector Uij; /* Declare "IJ" interface to HYPRE vector */
u = NULL;
data = NULL;
arkode_mem = 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 hypre vector */
HYPRE_IJVectorCreate(comm, my_pe*local_N, (my_pe + 1)*local_N - 1, &Uij);
HYPRE_IJVectorSetObjectType(Uij, HYPRE_PARCSR);
HYPRE_IJVectorInitialize(Uij);
/* Allocate and load user data block; allocate preconditioner block */
data = (UserData) malloc(sizeof *data);
if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1);
InitUserData(my_pe, comm, data);
/* Set initial values and allocate u */
SetInitialProfiles(Uij, data, local_N, my_pe*local_N);
HYPRE_IJVectorAssemble(Uij);
HYPRE_IJVectorGetObject(Uij, (void**) &Upar);
u = N_VMake_ParHyp(Upar); /* Create wrapper u around hypre vector */
if (check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1);
/* Set tolerances */
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, 1000000);
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, "ARKSpgmr", 1, my_pe)) MPI_Abort(comm, 1);
/* Set preconditioner setup and solve routines Precond and PSolve,
and the pointer to the user-defined block data */
flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve);
if (check_flag(&flag, "ARKSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1);
if (my_pe == 0)
printf("\n2-species diurnal advection-diffusion problem\n\n");
/* 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);
/* Free memory */
N_VDestroy(u); /* Free hypre vector wrapper */
HYPRE_IJVectorDestroy(Uij); /* Free the underlying hypre vector */
FreeUserData(data);
ARKodeFree(&arkode_mem);
MPI_Finalize();
return(0);
}
/*---------------------------------------------------------------
Initialization, Free, and Get Functions
NOTE: The band linear solver assumes a serial implementation
of the NVECTOR package. Therefore, ARKBandPrecInit will
first test for a compatible N_Vector internal
representation by checking that the function
N_VGetArrayPointer exists.
---------------------------------------------------------------*/
int ARKBandPrecInit(void *arkode_mem, long int N,
long int mu, long int ml)
{
ARKodeMem ark_mem;
ARKSpilsMem arkspils_mem;
ARKBandPrecData pdata;
long int mup, mlp, storagemu;
int flag;
if (arkode_mem == NULL) {
arkProcessError(NULL, ARKSPILS_MEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_NULL);
return(ARKSPILS_MEM_NULL);
}
ark_mem = (ARKodeMem) arkode_mem;
/* Test if one of the SPILS linear solvers has been attached */
if (ark_mem->ark_lmem == NULL) {
arkProcessError(ark_mem, ARKSPILS_LMEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_LMEM_NULL);
return(ARKSPILS_LMEM_NULL);
}
arkspils_mem = (ARKSpilsMem) ark_mem->ark_lmem;
/* Test if the NVECTOR package is compatible with the BAND preconditioner */
if(ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) {
arkProcessError(ark_mem, ARKSPILS_ILL_INPUT, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_BAD_NVECTOR);
return(ARKSPILS_ILL_INPUT);
}
pdata = NULL;
pdata = (ARKBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */
if (pdata == NULL) {
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
return(ARKSPILS_MEM_FAIL);
}
/* Load pointers and bandwidths into pdata block. */
pdata->arkode_mem = arkode_mem;
pdata->N = N;
pdata->mu = mup = SUNMIN(N-1, SUNMAX(0,mu));
pdata->ml = mlp = SUNMIN(N-1, SUNMAX(0,ml));
/* Initialize nfeBP counter */
pdata->nfeBP = 0;
/* Allocate memory for saved banded Jacobian approximation. */
pdata->savedJ = NULL;
pdata->savedJ = NewBandMat(N, mup, mlp, mup);
if (pdata->savedJ == NULL) {
free(pdata); pdata = NULL;
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
return(ARKSPILS_MEM_FAIL);
}
/* Allocate memory for banded preconditioner. */
storagemu = SUNMIN(N-1, mup+mlp);
pdata->savedP = NULL;
pdata->savedP = NewBandMat(N, mup, mlp, storagemu);
if (pdata->savedP == NULL) {
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
return(ARKSPILS_MEM_FAIL);
}
/* Allocate memory for pivot array. */
pdata->lpivots = NULL;
pdata->lpivots = NewLintArray(N);
if (pdata->lpivots == NULL) {
DestroyMat(pdata->savedP);
DestroyMat(pdata->savedJ);
free(pdata); pdata = NULL;
arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL);
return(ARKSPILS_MEM_FAIL);
}
/* make sure s_P_data is free from any previous allocations */
if (arkspils_mem->s_pfree != NULL) {
arkspils_mem->s_pfree(ark_mem);
}
/* Point to the new P_data field in the SPILS memory */
arkspils_mem->s_P_data = pdata;
/* Attach the pfree function */
arkspils_mem->s_pfree = ARKBandPrecFree;
/* Attach preconditioner solve and setup functions */
flag = ARKSpilsSetPreconditioner(arkode_mem, ARKBandPrecSetup, ARKBandPrecSolve);
return(flag);
}
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);
}
