/* Fortran interface to C "set" routines having real arguments; see farkode.h for further details */ void FARK_SETRIN(char key_name[], realtype *rval, int *ier) { if (!strncmp(key_name, "INIT_STEP", 9)) *ier = ARKodeSetInitStep(ARK_arkodemem, *rval); else if (!strncmp(key_name, "MAX_STEP", 8)) *ier = ARKodeSetMaxStep(ARK_arkodemem, *rval); else if (!strncmp(key_name, "MIN_STEP", 8)) *ier = ARKodeSetMinStep(ARK_arkodemem, *rval); else if (!strncmp(key_name, "STOP_TIME", 9)) *ier = ARKodeSetStopTime(ARK_arkodemem, *rval); else if (!strncmp(key_name, "NLCONV_COEF", 11)) *ier = ARKodeSetNonlinConvCoef(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_CFL", 9)) *ier = ARKodeSetCFLFraction(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_SAFETY", 12)) *ier = ARKodeSetSafetyFactor(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_BIAS", 10)) *ier = ARKodeSetErrorBias(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_GROWTH", 12)) *ier = ARKodeSetMaxGrowth(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_BOUNDS", 12)) *ier = ARKodeSetFixedStepBounds(ARK_arkodemem, rval[0], rval[1]); else if (!strncmp(key_name, "ADAPT_ETAMX1", 12)) *ier = ARKodeSetMaxFirstGrowth(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_ETAMXF", 12)) *ier = ARKodeSetMaxEFailGrowth(ARK_arkodemem, *rval); else if (!strncmp(key_name, "ADAPT_ETACF", 11)) *ier = ARKodeSetMaxCFailGrowth(ARK_arkodemem, *rval); else if (!strncmp(key_name, "NONLIN_CRDOWN", 11)) *ier = ARKodeSetNonlinCRDown(ARK_arkodemem, *rval); else if (!strncmp(key_name, "NONLIN_RDIV", 9)) *ier = ARKodeSetNonlinRDiv(ARK_arkodemem, *rval); else if (!strncmp(key_name, "LSETUP_DGMAX", 12)) *ier = ARKodeSetDeltaGammaMax(ARK_arkodemem, *rval); else if (!strncmp(key_name, "FIXED_STEP", 10)) *ier = ARKodeSetFixedStep(ARK_arkodemem, *rval); else { *ier = -99; printf("FARKSETRIN: Unrecognized key: %s\n\n",key_name); } 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() { /* general problem parameters */ realtype T0 = RCONST(0.0); /* initial time */ realtype T1 = RCONST(0.4); /* first output time */ realtype TMult = RCONST(10.0); /* output time multiplication factor */ int Nt = 12; /* total number of output times */ long int NEQ = 3; /* number of dependent vars. */ realtype reltol; int rootsfound[2]; long int nst, nst_a, nfe, nfi, nsetups; long int nje, nfeLS, nni, ncfn, netf, nge; int flag, rtflag; /* reusable error-checking flags */ FILE *UFID; realtype t, tout; int iout; /* general problem variables */ N_Vector y = NULL; /* empty vector for storing solution */ N_Vector atols = NULL; /* empty vector for absolute tolerances */ void *arkode_mem = NULL; /* empty ARKode memory structure */ /* set up the initial conditions */ realtype u0 = RCONST(1.0); realtype v0 = RCONST(0.0); realtype w0 = RCONST(0.0); /* Initial problem output */ printf("\nRobertson ODE test problem (with rootfinding):\n"); printf(" initial conditions: u0 = %g, v0 = %g, w0 = %g\n",u0,v0,w0); /* Initialize data structures */ y = N_VNew_Serial(NEQ); /* Create serial vector for solution */ if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1; atols = N_VNew_Serial(NEQ); /* Create serial vector absolute tolerances */ if (check_flag((void *) atols, "N_VNew_Serial", 0)) return 1; NV_Ith_S(y,0) = u0; /* Set initial conditions into y */ NV_Ith_S(y,1) = v0; NV_Ith_S(y,2) = w0; arkode_mem = ARKodeCreate(); /* Create the solver memory */ if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1; /* Call ARKodeInit to initialize the integrator memory and specify the hand-side side function in y'=f(t,y), the inital time T0, and the initial dependent variable vector y. Note: since this problem is fully implicit, we set f_E to NULL and f_I to f. */ flag = ARKodeInit(arkode_mem, NULL, f, T0, y); if (check_flag(&flag, "ARKodeInit", 1)) return 1; /* Set tolerances */ reltol = RCONST(1.0e-4); NV_Ith_S(atols,0) = RCONST(1.0e-8); NV_Ith_S(atols,1) = RCONST(1.0e-11); NV_Ith_S(atols,2) = RCONST(1.0e-8); /* Set routines */ flag = ARKodeSetMaxErrTestFails(arkode_mem, 20); /* Increase max error test fails */ if (check_flag(&flag, "ARKodeSetMaxErrTestFails", 1)) return 1; flag = ARKodeSetMaxNonlinIters(arkode_mem, 8); /* Increase max nonlinear iterations */ if (check_flag(&flag, "ARKodeSetMaxNonlinIters", 1)) return 1; flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-7); /* Update nonlinear solver convergence coeff. */ if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return 1; flag = ARKodeSetMaxNumSteps(arkode_mem, 100000); /* Increase max number of steps */ if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return 1; flag = ARKodeSVtolerances(arkode_mem, reltol, atols); /* Specify tolerances */ if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1; /* Specify the root-finding function, having 2 equations */ flag = ARKodeRootInit(arkode_mem, 2, g); if (check_flag(&flag, "ARKodeRootInit", 1)) return 1; /* Linear solver specification */ flag = ARKDense(arkode_mem, NEQ); /* Specify dense linear solver */ if (check_flag(&flag, "ARKDense", 1)) return 1; flag = ARKDlsSetDenseJacFn(arkode_mem, Jac); /* Set the Jacobian routine */ if (check_flag(&flag, "ARKDlsSetDenseJacFn", 1)) return 1; /* Open output stream for results, output comment line */ UFID = fopen("solution.txt","w"); fprintf(UFID,"# t u v w\n"); /* output initial condition to disk */ fprintf(UFID," %.16e %.16e %.16e %.16e\n", T0, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2)); /* Main time-stepping loop: calls ARKode to perform the integration, then prints results. Stops when the final time has been reached */ t = T0; printf(" t u v w\n"); printf(" -----------------------------------------------------\n"); printf(" %12.5e %12.5e %12.5e %12.5e\n", t, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2)); tout = T1; iout = 0; while(1) { flag = ARKode(arkode_mem, tout, y, &t, ARK_NORMAL); /* call integrator */ if (check_flag(&flag, "ARKode", 1)) break; printf(" %12.5e %12.5e %12.5e %12.5e\n", t, /* access/print solution */ NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2)); fprintf(UFID," %.16e %.16e %.16e %.16e\n", t, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2)); if (flag == ARK_ROOT_RETURN) { /* check if a root was found */ rtflag = ARKodeGetRootInfo(arkode_mem, rootsfound); if (check_flag(&rtflag, "ARKodeGetRootInfo", 1)) return 1; printf(" rootsfound[] = %3d %3d\n", rootsfound[0], rootsfound[1]); } if (flag >= 0) { /* successful solve: update output time */ iout++; tout *= TMult; } else { /* unsuccessful solve: break */ fprintf(stderr,"Solver failure, stopping integration\n"); break; } if (iout == Nt) break; /* stop after enough outputs */ } printf(" -----------------------------------------------------\n"); fclose(UFID); /* Print some final statistics */ flag = ARKodeGetNumSteps(arkode_mem, &nst); check_flag(&flag, "ARKodeGetNumSteps", 1); flag = ARKodeGetNumStepAttempts(arkode_mem, &nst_a); check_flag(&flag, "ARKodeGetNumStepAttempts", 1); flag = ARKodeGetNumRhsEvals(arkode_mem, &nfe, &nfi); check_flag(&flag, "ARKodeGetNumRhsEvals", 1); flag = ARKodeGetNumLinSolvSetups(arkode_mem, &nsetups); check_flag(&flag, "ARKodeGetNumLinSolvSetups", 1); flag = ARKodeGetNumErrTestFails(arkode_mem, &netf); check_flag(&flag, "ARKodeGetNumErrTestFails", 1); flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni); check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1); flag = ARKodeGetNumNonlinSolvConvFails(arkode_mem, &ncfn); check_flag(&flag, "ARKodeGetNumNonlinSolvConvFails", 1); flag = ARKDlsGetNumJacEvals(arkode_mem, &nje); check_flag(&flag, "ARKDlsGetNumJacEvals", 1); flag = ARKDlsGetNumRhsEvals(arkode_mem, &nfeLS); check_flag(&flag, "ARKDlsGetNumRhsEvals", 1); flag = ARKodeGetNumGEvals(arkode_mem, &nge); check_flag(&flag, "ARKodeGetNumGEvals", 1); printf("\nFinal Solver Statistics:\n"); printf(" Internal solver steps = %li (attempted = %li)\n", nst, nst_a); printf(" Total RHS evals: Fe = %li, Fi = %li\n", nfe, nfi); printf(" Total linear solver setups = %li\n", nsetups); printf(" Total RHS evals for setting up the linear system = %li\n", nfeLS); printf(" Total number of Jacobian evaluations = %li\n", nje); printf(" Total number of Newton iterations = %li\n", nni); printf(" Total root-function g evals = %li\n", nge); printf(" Total number of nonlinear solver convergence failures = %li\n", ncfn); printf(" Total number of error test failures = %li\n", netf); /* Clean up and return with successful completion */ N_VDestroy_Serial(y); /* Free y vector */ ARKodeFree(&arkode_mem); /* Free integrator memory */ return 0; }