/* Fortran interface to C routine ARKode (the main integrator); see farkode.h for further details */ void FARK_ARKODE(realtype *tout, realtype *t, realtype *y, int *itask, int *ier) { /* attach user solution array to solver memory */ N_VSetArrayPointer(y, F2C_ARKODE_vec); /* call ARKode solver */ *ier = ARKode(ARK_arkodemem, *tout, F2C_ARKODE_vec, t, *itask); /* detach user solution array from solver memory */ N_VSetArrayPointer(NULL, F2C_ARKODE_vec); /* Load optional outputs in iout & rout */ ARKodeGetWorkSpace(ARK_arkodemem, &ARK_iout[0], /* LENRW */ &ARK_iout[1]); /* LENIW */ ARKodeGetIntegratorStats(ARK_arkodemem, &ARK_iout[2], /* NST */ &ARK_iout[3], /* NST_STB */ &ARK_iout[4], /* NST_ACC */ &ARK_iout[5], /* NST_ATT */ &ARK_iout[6], /* NFE */ &ARK_iout[7], /* NFI */ &ARK_iout[8], /* NSETUPS */ &ARK_iout[9], /* NETF */ &ARK_rout[0], /* H0U */ &ARK_rout[1], /* HU */ &ARK_rout[2], /* HCUR */ &ARK_rout[3]); /* TCUR */ ARKodeGetTolScaleFactor(ARK_arkodemem, &ARK_rout[4]); /* TOLSFAC */ ARKodeGetNonlinSolvStats(ARK_arkodemem, &ARK_iout[10], /* NNI */ &ARK_iout[11]); /* NCFN */ /* If root finding is on, load those outputs as well */ if (ARK_nrtfn != 0) ARKodeGetNumGEvals(ARK_arkodemem, &ARK_iout[12]); /* NGE */ /* Attach linear solver outputs */ switch(ARK_ls) { case ARK_LS_DENSE: case ARK_LS_BAND: case ARK_LS_LAPACKDENSE: case ARK_LS_LAPACKBAND: ARKDlsGetWorkSpace(ARK_arkodemem, &ARK_iout[13], &ARK_iout[14]); /* LENRWLS, LENIWLS */ ARKDlsGetLastFlag(ARK_arkodemem, &ARK_iout[15]); /* LSTF */ ARKDlsGetNumRhsEvals(ARK_arkodemem, &ARK_iout[16]); /* NFELS */ ARKDlsGetNumJacEvals(ARK_arkodemem, &ARK_iout[17]); /* NJE */ break; case ARK_LS_KLU: case ARK_LS_SUPERLUMT: ARKSlsGetLastFlag(ARK_arkodemem, &ARK_iout[15]); /* LSTF */ ARKSlsGetNumJacEvals(ARK_arkodemem, &ARK_iout[17]); /* NJE */ break; case ARK_LS_SPGMR: case ARK_LS_SPBCG: case ARK_LS_SPTFQMR: case ARK_LS_SPFGMR: case ARK_LS_PCG: ARKSpilsGetWorkSpace(ARK_arkodemem, &ARK_iout[13], &ARK_iout[14]); /* LENRWLS, LENIWLS */ ARKSpilsGetLastFlag(ARK_arkodemem, &ARK_iout[15]); /* LSTF */ ARKSpilsGetNumRhsEvals(ARK_arkodemem, &ARK_iout[16]); /* NFELS */ ARKSpilsGetNumJtimesEvals(ARK_arkodemem, &ARK_iout[17]); /* NJTV */ ARKSpilsGetNumPrecEvals(ARK_arkodemem, &ARK_iout[18]); /* NPE */ ARKSpilsGetNumPrecSolves(ARK_arkodemem, &ARK_iout[19]); /* NPS */ ARKSpilsGetNumLinIters(ARK_arkodemem, &ARK_iout[20]); /* NLI */ ARKSpilsGetNumConvFails(ARK_arkodemem, &ARK_iout[21]); /* NCFL */ } /* Attach mass matrix linear solver outputs */ switch(ARK_mass_ls) { case ARK_LS_DENSE: case ARK_LS_BAND: case ARK_LS_LAPACKDENSE: case ARK_LS_LAPACKBAND: ARKDlsGetMassWorkSpace(ARK_arkodemem, &ARK_iout[22], &ARK_iout[23]); /* LENRWMS, LENIWMS */ ARKDlsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]); /* LSTMF */ ARKDlsGetNumMassEvals(ARK_arkodemem, &ARK_iout[25]); /* NME */ break; case ARK_LS_KLU: case ARK_LS_SUPERLUMT: ARKSlsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]); /* LSTMF */ ARKSlsGetNumMassEvals(ARK_arkodemem, &ARK_iout[25]); /* NME */ break; case ARK_LS_SPGMR: case ARK_LS_SPBCG: case ARK_LS_SPTFQMR: case ARK_LS_SPFGMR: case ARK_LS_PCG: ARKSpilsGetMassWorkSpace(ARK_arkodemem, &ARK_iout[22], &ARK_iout[23]); /* LENRWMS, LENIWMS */ ARKSpilsGetLastMassFlag(ARK_arkodemem, &ARK_iout[24]); /* LSTMF */ ARKSpilsGetNumMassPrecEvals(ARK_arkodemem, &ARK_iout[25]); /* NMPE */ ARKSpilsGetNumMassPrecSolves(ARK_arkodemem, &ARK_iout[26]); /* NMPS */ ARKSpilsGetNumMassIters(ARK_arkodemem, &ARK_iout[27]); /* NMLI */ ARKSpilsGetNumMassConvFails(ARK_arkodemem, &ARK_iout[28]); /* NMCFL */ } return; }
/* 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; }