Arkode::~Arkode() { if (_z) delete[] _z; if (_zInit) delete[] _zInit; if (_zeroSign) delete[] _zeroSign; if (_absTol) delete[] _absTol; if (_zWrite) delete[] _zWrite; //add free arkode if (_arkode_initialized) { N_VDestroy_Serial(_ARK_y0); N_VDestroy_Serial(_ARK_y); N_VDestroy_Serial(_ARK_yWrite); N_VDestroy_Serial(_ARK_absTol); ARKodeFree(&_arkodeMem); } // free Cvode /* if (_colorOfColumn) delete [] _colorOfColumn; if(_delta) delete [] _delta; if(_deltaInv) delete [] _deltaInv; if(_ysave) delete [] _ysave; */ }
/* Fortran interface to C routine ARKodeFree; see farkode.h for further details */ void FARK_FREE() { ARKodeMem ark_mem; ark_mem = (ARKodeMem) ARK_arkodemem; free(ark_mem->ark_user_data); ark_mem->ark_user_data = NULL; ARKodeFree(&ARK_arkodemem); N_VSetArrayPointer(NULL, F2C_ARKODE_vec); N_VDestroy(F2C_ARKODE_vec); return; }
/***************************** 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); }
/* Main Program */ int main() { /* general problem parameters */ realtype T0 = RCONST(0.0); /* initial time */ realtype Tf = RCONST(10.0); /* final time */ realtype dTout = RCONST(1.0); /* time between outputs */ long int NEQ = 3; /* number of dependent vars. */ int Nt = ceil(Tf/dTout); /* number of output times */ int test = 2; /* test problem to run */ realtype reltol = 1.0e-6; /* tolerances */ realtype abstol = 1.0e-10; realtype a, b, ep, u0, v0, w0; /* general problem variables */ int flag; /* reusable error-checking flag */ N_Vector y = NULL; /* empty vector for storing solution */ void *arkode_mem = NULL; /* empty ARKode memory structure */ realtype rdata[3]; FILE *UFID; realtype t, tout; int iout; long int nst, nst_a, nfe, nfi, nsetups, nje, nfeLS, nni, ncfn, netf; /* set up the test problem according to the desired test */ if (test == 1) { u0 = RCONST(3.9); v0 = RCONST(1.1); w0 = RCONST(2.8); a = RCONST(1.2); b = RCONST(2.5); ep = RCONST(1.0e-5); } else if (test == 3) { u0 = RCONST(3.0); v0 = RCONST(3.0); w0 = RCONST(3.5); a = RCONST(0.5); b = RCONST(3.0); ep = RCONST(5.0e-4); } else { u0 = RCONST(1.2); v0 = RCONST(3.1); w0 = RCONST(3.0); a = RCONST(1.0); b = RCONST(3.5); ep = RCONST(5.0e-6); } /* Initial problem output */ printf("\nBrusselator ODE test problem:\n"); printf(" initial conditions: u0 = %g, v0 = %g, w0 = %g\n",u0,v0,w0); printf(" problem parameters: a = %g, b = %g, ep = %g\n",a,b,ep); printf(" reltol = %.1e, abstol = %.1e\n\n",reltol,abstol); /* Initialize data structures */ rdata[0] = a; /* set user data */ rdata[1] = b; rdata[2] = ep; y = N_VNew_Serial(NEQ); /* Create serial vector for solution */ if (check_flag((void *)y, "N_VNew_Serial", 0)) return 1; NV_Ith_S(y,0) = u0; /* Set initial conditions */ 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 routines */ flag = ARKodeSetUserData(arkode_mem, (void *) rdata); /* Pass rdata 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; /* 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 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; tout = T0+dTout; printf(" t u v w\n"); printf(" -------------------------------------------\n"); for (iout=0; iout<Nt; iout++) { flag = ARKode(arkode_mem, tout, y, &t, ARK_NORMAL); /* call integrator */ if (check_flag(&flag, "ARKode", 1)) break; printf(" %10.6f %10.6f %10.6f %10.6f\n", /* access/print solution */ t, 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 >= 0) { /* successful solve: update time */ tout += dTout; tout = (tout > Tf) ? Tf : tout; } else { /* unsuccessful solve: break */ fprintf(stderr,"Solver failure, stopping integration\n"); break; } } 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); 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 number of linear solver convergence failures = %li\n", ncfn); printf(" Total number of error test failures = %li\n\n", netf); /* Clean up and return with successful completion */ N_VDestroy_Serial(y); /* Free y vector */ ARKodeFree(&arkode_mem); /* Free integrator memory */ return 0; }
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 Tf = RCONST(10.0); /* final time */ int Nt = 100; /* total number of output times */ int Nvar = 3; /* number of solution fields */ UserData udata = NULL; realtype *data; long 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; long int NEQ, i; /* general problem variables */ int flag; /* reusable error-checking flag */ N_Vector y = NULL; /* empty vector for storing solution */ N_Vector umask = NULL; /* empty mask vectors for viewing solution components */ N_Vector vmask = NULL; N_Vector wmask = NULL; void *arkode_mem = NULL; /* empty ARKode memory structure */ realtype pi, t, dTout, tout, u, v, w; FILE *FID, *UFID, *VFID, *WFID; int iout; long int nst, nst_a, nfe, nfi, nsetups, nje, nfeLS, 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; /* set total allocated vector length */ NEQ = Nvar*udata->N; /* Initial problem output */ printf("\n1D Brusselator PDE test problem:\n"); printf(" N = %li, 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(RCONST(1.0)); 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)] = RCONST(1.0); 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)] = RCONST(1.0); 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)] = RCONST(1.0); /* 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 right-hand 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; /* Linear solver specification */ flag = ARKBand(arkode_mem, NEQ, 4, 4); /* Specify the band linear solver */ if (check_flag(&flag, "ARKBand", 1)) return 1; flag = ARKDlsSetBandJacFn(arkode_mem, Jac); /* Set the Jacobian routine */ if (check_flag(&flag, "ARKDlsSetBandJacFn", 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 streams for results, access data array */ UFID=fopen("bruss_u.txt","w"); VFID=fopen("bruss_v.txt","w"); WFID=fopen("bruss_w.txt","w"); /* output initial condition to disk */ data = N_VGetArrayPointer(y); if (check_flag((void *)data, "N_VGetArrayPointer", 0)) return 1; 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-T0)/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 */ if (check_flag(&flag, "ARKode", 1)) break; u = N_VWL2Norm(y,umask); /* access/print solution statistics */ u = SUNRsqrt(u*u/N); v = N_VWL2Norm(y,vmask); v = SUNRsqrt(v*v/N); w = N_VWL2Norm(y,wmask); w = SUNRsqrt(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 = ARKDlsGetNumJacEvals(arkode_mem, &nje); check_flag(&flag, "ARKDlsGetNumJacEvals", 1); flag = ARKDlsGetNumRhsEvals(arkode_mem, &nfeLS); check_flag(&flag, "ARKDlsGetNumRhsEvals", 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 number of nonlinear solver convergence failures = %li\n", ncfn); printf(" Total number of error test failures = %li\n\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); free(udata); /* Free user data */ ARKodeFree(&arkode_mem); /* Free integrator memory */ 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); }
/* 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; }
/* Main Program */ int main() { /* general problem parameters */ realtype T0 = RCONST(0.0); /* initial time */ realtype Tf = RCONST(1.0); /* final time */ realtype rtol = 1.e-3; /* relative tolerance */ realtype atol = 1.e-10; /* absolute tolerance */ realtype hscale = 1.0; /* time step change factor on resizes */ UserData udata = NULL; realtype *data; long int N = 21; /* initial spatial mesh size */ realtype refine = 3.e-3; /* adaptivity refinement tolerance */ realtype k = 0.5; /* heat conductivity */ long int i, nni, nni_cur=0, nni_tot=0, nli, nli_tot=0; int iout=0; /* general problem variables */ int flag; /* reusable error-checking flag */ N_Vector y = NULL; /* empty vector for storing solution */ N_Vector y2 = NULL; /* empty vector for storing solution */ N_Vector yt = NULL; /* empty vector for swapping */ void *arkode_mem = NULL; /* empty ARKode memory structure */ FILE *XFID, *UFID; realtype t, olddt, newdt; realtype *xnew = NULL; long int Nnew; /* allocate and fill initial udata structure */ udata = (UserData) malloc(sizeof(*udata)); udata->N = N; udata->k = k; udata->refine_tol = refine; udata->x = malloc(N * sizeof(realtype)); for (i=0; i<N; i++) udata->x[i] = 1.0*i/(N-1); /* Initial problem output */ printf("\n1D adaptive Heat PDE test problem:\n"); printf(" diffusion coefficient: k = %g\n", udata->k); printf(" initial N = %li\n", udata->N); /* Initialize data structures */ y = N_VNew_Serial(N); /* Create initial serial vector for solution */ if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1; N_VConst(0.0, y); /* Set initial conditions */ /* output mesh to disk */ XFID=fopen("heat_mesh.txt","w"); /* output initial mesh to disk */ for (i=0; i<udata->N; i++) fprintf(XFID," %.16e", udata->x[i]); fprintf(XFID,"\n"); /* Open output stream for results, access data array */ UFID=fopen("heat1D.txt","w"); /* output initial condition to disk */ data = N_VGetArrayPointer(y); for (i=0; i<udata->N; i++) fprintf(UFID," %.16e", data[i]); fprintf(UFID,"\n"); /* Create the solver memory */ arkode_mem = ARKodeCreate(); if (check_flag((void *) arkode_mem, "ARKodeCreate", 0)) return 1; /* Initialize the integrator memory */ 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 = ARKodeSetMaxNumSteps(arkode_mem, 10000); /* Increase max num steps */ if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return 1; flag = ARKodeSStolerances(arkode_mem, rtol, atol); /* Specify tolerances */ if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1; flag = ARKodeSetAdaptivityMethod(arkode_mem, 2, 1, 0, NULL); /* Set adaptivity method */ if (check_flag(&flag, "ARKodeSetAdaptivityMethod", 1)) return 1; flag = ARKodeSetPredictorMethod(arkode_mem, 0); /* Set predictor method */ if (check_flag(&flag, "ARKodeSetPredictorMethod", 1)) return 1; /* Linear solver specification */ flag = ARKPcg(arkode_mem, 0, N); if (check_flag(&flag, "ARKPcg", 1)) return 1; flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac); if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1; /* Main time-stepping loop: calls ARKode to perform the integration, then prints results. Stops when the final time has been reached */ t = T0; olddt = 0.0; newdt = 0.0; printf(" iout dt_old dt_new ||u||_rms N NNI NLI\n"); printf(" ----------------------------------------------------------------------------------------\n"); printf(" %4i %19.15e %19.15e %19.15e %li %2i %3i\n", iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, 0, 0); while (t < Tf) { /* "set" routines */ flag = ARKodeSetStopTime(arkode_mem, Tf); if (check_flag(&flag, "ARKodeSetStopTime", 1)) return 1; flag = ARKodeSetInitStep(arkode_mem, newdt); if (check_flag(&flag, "ARKodeSetInitStep", 1)) return 1; /* call integrator */ flag = ARKode(arkode_mem, Tf, y, &t, ARK_ONE_STEP); if (check_flag(&flag, "ARKode", 1)) return 1; /* "get" routines */ flag = ARKodeGetLastStep(arkode_mem, &olddt); if (check_flag(&flag, "ARKodeGetLastStep", 1)) return 1; flag = ARKodeGetCurrentStep(arkode_mem, &newdt); if (check_flag(&flag, "ARKodeGetCurrentStep", 1)) return 1; flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni); if (check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1)) return 1; flag = ARKSpilsGetNumLinIters(arkode_mem, &nli); if (check_flag(&flag, "ARKSpilsGetNumLinIters", 1)) return 1; /* print current solution stats */ iout++; printf(" %4i %19.15e %19.15e %19.15e %li %2li %3li\n", iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, nni-nni_cur, nli); nni_cur = nni; nni_tot = nni; nli_tot += nli; /* output results and current mesh to disk */ data = N_VGetArrayPointer(y); for (i=0; i<udata->N; i++) fprintf(UFID," %.16e", data[i]); fprintf(UFID,"\n"); for (i=0; i<udata->N; i++) fprintf(XFID," %.16e", udata->x[i]); fprintf(XFID,"\n"); /* adapt the spatial mesh */ xnew = adapt_mesh(y, &Nnew, udata); if (check_flag(xnew, "ark_adapt", 0)) return 1; /* create N_Vector of new length */ y2 = N_VNew_Serial(Nnew); if (check_flag((void *) y2, "N_VNew_Serial", 0)) return 1; /* project solution onto new mesh */ flag = project(udata->N, udata->x, y, Nnew, xnew, y2); if (check_flag(&flag, "project", 1)) return 1; /* delete old vector, old mesh */ N_VDestroy_Serial(y); free(udata->x); /* swap x and xnew so that new mesh is stored in udata structure */ udata->x = xnew; xnew = NULL; udata->N = Nnew; /* store size of new mesh */ /* swap y and y2 so that y holds new solution */ yt = y; y = y2; y2 = yt; /* call ARKodeResize to notify integrator of change in mesh */ flag = ARKodeResize(arkode_mem, y, hscale, t, NULL, NULL); if (check_flag(&flag, "ARKodeResize", 1)) return 1; /* destroy and re-allocate linear solver memory */ flag = ARKPcg(arkode_mem, 0, udata->N); if (check_flag(&flag, "ARKPcg", 1)) return 1; flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac); if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1; } printf(" ----------------------------------------------------------------------------------------\n"); /* Free integrator memory */ ARKodeFree(&arkode_mem); /* print some final statistics */ printf(" Final solver statistics:\n"); printf(" Total number of time steps = %i\n", iout); printf(" Total nonlinear iterations = %li\n", nni_tot); printf(" Total linear iterations = %li\n\n", nli_tot); /* Clean up and return with successful completion */ fclose(UFID); fclose(XFID); N_VDestroy_Serial(y); /* Free vectors */ free(udata->x); /* Free user data */ free(udata); return 0; }