/* 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 Tf = RCONST(10.0); /* final time */ int Nt = 10; /* total number of output times */ int Nvar = 3; UserData udata = NULL; realtype *data; int N = 201; /* spatial mesh size */ realtype a = 0.6; /* problem parameters */ realtype b = 2.0; realtype du = 0.025; realtype dv = 0.025; realtype dw = 0.025; realtype ep = 1.0e-5; /* stiffness parameter */ realtype reltol = 1.0e-6; /* tolerances */ realtype abstol = 1.0e-10; int i; long int NEQ, NNZ; /* general problem variables */ int flag; /* reusable error-checking flag */ N_Vector y = NULL; N_Vector umask = NULL; N_Vector vmask = NULL; N_Vector wmask = NULL; void *arkode_mem = NULL; realtype pi; FILE *FID, *UFID, *VFID, *WFID; realtype t = T0; realtype dTout = (Tf-T0)/Nt; realtype tout = T0+dTout; realtype u, v, w; int iout; long int nst, nst_a, nfe, nfi, nsetups, nje, nni, ncfn, netf; /* allocate udata structure */ udata = (UserData) malloc(sizeof(*udata)); if (check_flag((void *) udata, "malloc", 2)) return 1; /* store the inputs in the UserData structure */ udata->N = N; udata->a = a; udata->b = b; udata->du = du; udata->dv = dv; udata->dw = dw; udata->ep = ep; udata->R = NULL; /* set total allocated vector length */ NEQ = Nvar*udata->N; /* Initial problem output */ printf("\n1D Brusselator PDE test problem (KLU solver):\n"); printf(" N = %i, NEQ = %li\n", udata->N, NEQ); printf(" problem parameters: a = %g, b = %g, ep = %g\n", udata->a, udata->b, udata->ep); printf(" diffusion coefficients: du = %g, dv = %g, dw = %g\n", udata->du, udata->dv, udata->dw); printf(" reltol = %.1e, abstol = %.1e\n\n", reltol, abstol); /* Initialize data structures */ y = N_VNew_Serial(NEQ); /* Create serial vector for solution */ if (check_flag((void *)y, "N_VNew_Serial", 0)) return 1; udata->dx = RCONST(1.0)/(N-1); /* set spatial mesh spacing */ data = N_VGetArrayPointer(y); /* Access data array for new NVector y */ if (check_flag((void *)data, "N_VGetArrayPointer", 0)) return 1; umask = N_VNew_Serial(NEQ); /* Create serial vector masks */ if (check_flag((void *)umask, "N_VNew_Serial", 0)) return 1; vmask = N_VNew_Serial(NEQ); if (check_flag((void *)vmask, "N_VNew_Serial", 0)) return 1; wmask = N_VNew_Serial(NEQ); if (check_flag((void *)wmask, "N_VNew_Serial", 0)) return 1; /* Set initial conditions into y */ pi = RCONST(4.0)*atan(ONE); for (i=0; i<N; i++) { data[IDX(i,0)] = a + RCONST(0.1)*sin(pi*i*udata->dx); /* u */ data[IDX(i,1)] = b/a + RCONST(0.1)*sin(pi*i*udata->dx); /* v */ data[IDX(i,2)] = b + RCONST(0.1)*sin(pi*i*udata->dx); /* w */ } /* Set mask array values for each solution component */ N_VConst(0.0, umask); data = N_VGetArrayPointer(umask); if (check_flag((void *) data, "N_VGetArrayPointer", 0)) return 1; for (i=0; i<N; i++) data[IDX(i,0)] = ONE; N_VConst(0.0, vmask); data = N_VGetArrayPointer(vmask); if (check_flag((void *) data, "N_VGetArrayPointer", 0)) return 1; for (i=0; i<N; i++) data[IDX(i,1)] = ONE; N_VConst(0.0, wmask); data = N_VGetArrayPointer(wmask); if (check_flag((void *) data, "N_VGetArrayPointer", 0)) return 1; for (i=0; i<N; i++) data[IDX(i,2)] = ONE; /* Create the solver memory */ arkode_mem = ARKodeCreate(); 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 routines */ flag = ARKodeSetUserData(arkode_mem, (void *) udata); /* Pass udata to user functions */ if (check_flag(&flag, "ARKodeSetUserData", 1)) return 1; flag = ARKodeSStolerances(arkode_mem, reltol, abstol); /* Specify tolerances */ if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1; /* Specify the KLU sparse linear solver and Jacobian function */ NNZ = 5*NEQ; flag = ARKKLU(arkode_mem, NEQ, NNZ); if (check_flag(&flag, "ARKKLU", 1)) return 1; flag = ARKSlsSetSparseJacFn(arkode_mem, Jac); if (check_flag(&flag, "ARKSlsSetSparseJacFn", 1)) return 1; /* output spatial mesh to disk */ FID = fopen("bruss_mesh.txt","w"); for (i=0; i<N; i++) fprintf(FID," %.16e\n", udata->dx*i); fclose(FID); /* Open output stream for results, access data arrays */ UFID=fopen("bruss_u.txt","w"); VFID=fopen("bruss_v.txt","w"); WFID=fopen("bruss_w.txt","w"); data = N_VGetArrayPointer(y); if (check_flag((void *) data, "N_VGetArrayPointer", 0)) return 1; /* output initial condition to disk */ for (i=0; i<N; i++) fprintf(UFID," %.16e", data[IDX(i,0)]); for (i=0; i<N; i++) fprintf(VFID," %.16e", data[IDX(i,1)]); for (i=0; i<N; i++) fprintf(WFID," %.16e", data[IDX(i,2)]); fprintf(UFID,"\n"); fprintf(VFID,"\n"); fprintf(WFID,"\n"); /* Main time-stepping loop: calls ARKode to perform the integration, then prints results. Stops when the final time has been reached */ t = T0; dTout = Tf/Nt; tout = T0+dTout; printf(" t ||u||_rms ||v||_rms ||w||_rms\n"); printf(" ----------------------------------------------\n"); for (iout=0; iout<Nt; iout++) { flag = ARKode(arkode_mem, tout, y, &t, ARK_NORMAL); /* call integrator */ u = N_VWL2Norm(y,umask); u = sqrt(u*u/N); v = N_VWL2Norm(y,vmask); v = sqrt(v*v/N); w = N_VWL2Norm(y,wmask); w = sqrt(w*w/N); printf(" %10.6f %10.6f %10.6f %10.6f\n", t, u, v, w); if (flag >= 0) { /* successful solve: update output time */ tout += dTout; tout = (tout > Tf) ? Tf : tout; } else { /* unsuccessful solve: break */ fprintf(stderr,"Solver failure, stopping integration\n"); break; } /* output results to disk */ for (i=0; i<N; i++) fprintf(UFID," %.16e", data[IDX(i,0)]); for (i=0; i<N; i++) fprintf(VFID," %.16e", data[IDX(i,1)]); for (i=0; i<N; i++) fprintf(WFID," %.16e", data[IDX(i,2)]); fprintf(UFID,"\n"); fprintf(VFID,"\n"); fprintf(WFID,"\n"); } printf(" ----------------------------------------------\n"); fclose(UFID); fclose(VFID); fclose(WFID); /* 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 = ARKSlsGetNumJacEvals(arkode_mem, &nje); check_flag(&flag, "ARKSlsGetNumJacEvals", 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 number of Jacobian evaluations = %li\n", nje); printf(" Total number of nonlinear iterations = %li\n", nni); 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 vectors */ N_VDestroy_Serial(umask); N_VDestroy_Serial(vmask); N_VDestroy_Serial(wmask); DestroySparseMat(udata->R); /* Free user data */ free(udata); ARKodeFree(&arkode_mem); return 0; }