int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt time_steps = 100,steps;
PetscMPIInt size;
Vec global;
PetscReal dt,ftime;
TS ts;
MatStructure A_structure;
Mat A = 0;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* set initial conditions */
ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr);
ierr = VecSetSizes(global,PETSC_DECIDE,3);CHKERRQ(ierr);
ierr = VecSetFromOptions(global);CHKERRQ(ierr);
ierr = Initial(global,NULL);CHKERRQ(ierr);
/* make timestep context */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,Monitor,NULL,NULL);CHKERRQ(ierr);
dt = 0.1;
/*
The user provides the RHS and Jacobian
*/
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,3,3);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = RHSJacobian(ts,0.0,global,&A,&A,&A_structure,NULL);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,A,A,RHSJacobian,NULL);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time_steps,1);CHKERRQ(ierr);
ierr = TSSetSolution(ts,global);CHKERRQ(ierr);
ierr = TSSolve(ts,global);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* free the memories */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
TimeStepper( Jac G_u, Matrix& A, times t, TSType solver_type)
: TimeStepper( problem_type::linear, solver_type, A.comm() )
{
static Jac G_u_ = G_u;
TSSetInitialTimeStep( ts, t.ti, t.dt );
TSSetDuration( ts, static_cast<int>( ( t.tf - t.ti ) / t.dt ) + 10,
t.tf );
TSSetRHSFunction( ts, NULL, TSComputeRHSFunctionLinear, NULL );
TSSetRHSJacobian( ts, A.m_, A.m_,
TimeStepper::RHSJacobian_function<Jac>, &G_u_ );
}
TimeIntegration_PETSc::TimeIntegration_PETSc(Setup *setup, Grid *grid, Parallel *parallel, Vlasov *vlasov, Fields *fields, Eigenvalue *eigenvalue) : TimeIntegration(setup, grid, parallel, vlasov, fields,eigenvalue)
{
PetscInitialize(&setup->argc, &setup->argv, (char *) 0, help);
// create Matrix Operations
int subDiv=0;
// create Matrix, a shell for Matrix-free methods
MatCreateShell(parallel->Comm[DIR_ALL], grid->getLocalSize(), grid->getLocalSize(), grid->getGlobalSize(), grid->getGlobalSize(), &subDiv, &A_F1);
MatSetFromOptions(A_F1);
MatShellSetOperation(A_F1, MATOP_MULT, (void(*)()) PETScMatrixVector::MatrixVectorProduct);
// Initialize implicit solver
TSCreate(parallel->Comm[DIR_ALL], &ts);
TSSetProblemType(ts, TS_LINEAR);
TSSetRHSFunction(ts, PETSC_NULL,TSComputeRHSFunctionLinear, PETSC_NULL);
TSSetRHSJacobian(ts, A_F1, A_F1, TSComputeRHSJacobianConstant, PETSC_NULL);
TSSetType(ts, TSBEULER);
TSSetFromOptions(ts);
// Setup inital vector
Vec Vec_init;
cmplxd *init_x = PETScMatrixVector::getCreateVector(grid, Vec_init);
for(int x = NxLlD, n = 0; x <= NxLuD; x++) { for(int y_k = NkyLlD; y_k <= NkyLuD; y_k++) { for(int z = NzLlD; z <= NzLuD; z++) {
for(int v = NvLlD ; v <= NvLuD; v++) { for(int m = NmLlD ; m <= NmLuD ; m++ ) { for(int s = NsLlD; s <= NsLuD; s++) {
init_x[n++] = vlasov->f(x,y_k,z,v,m,s);
}}} }}}
VecRestoreArray(Vec_init, &init_x);
TSSetSolution(ts, Vec_init);
VecDestroy(&Vec_init);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
Mat Jacp; /* Jacobian matrix */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
AppCtx ctx;
PetscScalar *u;
PetscReal du[2] = {0.0,0.0};
PetscBool ensemble = PETSC_FALSE,flg1,flg2;
PetscReal ftime;
PetscInt steps;
PetscScalar *x_ptr,*y_ptr;
Vec lambda[1],q,mu[1];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr);
ierr = MatSetUp(Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr);
{
ctx.beta = 2;
ctx.c = 10000.0;
ctx.u_s = 1.0;
ctx.omega_s = 1.0;
ctx.omega_b = 120.0*PETSC_PI;
ctx.H = 5.0;
ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr);
ctx.D = 5.0;
ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr);
ctx.E = 1.1378;
ctx.V = 1.0;
ctx.X = 0.545;
ctx.Pmax = ctx.E*ctx.V/ctx.X;;
ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr);
ctx.Pm = 1.1;
ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr);
ctx.tf = 0.1;
ctx.tcl = 0.2;
ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr);
if (ensemble) {
ctx.tf = -1;
ctx.tcl = -1;
}
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax);
u[1] = 1.0;
ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr);
n = 2;
ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr);
u[0] += du[0];
u[1] += du[1];
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
if (flg1 || flg2) {
ctx.tf = -1;
ctx.tcl = -1;
}
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,A,A,(TSRHSJacobian)RHSJacobian,&ctx);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = -1.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);
ierr = TSSetCostIntegrand(ts,1,(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,PETSC_TRUE,&ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (ensemble) {
for (du[1] = -2.5; du[1] <= .01; du[1] += .1) {
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax);
u[1] = ctx.omega_s;
u[0] += du[0];
u[1] += du[1];
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
} else {
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Set initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 0.0; y_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = -1.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
/* Set RHS JacobianP */
ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&ctx);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[Psi(tf)]/d[phi0] d[Psi(tf)]/d[omega0]\n");CHKERRQ(ierr);
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = TSGetCostIntegral(ts,&q);CHKERRQ(ierr);
ierr = VecView(q,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n cost function=%g\n",(double)(x_ptr[0]-ctx.Pm));CHKERRQ(ierr);
ierr = VecRestoreArray(q,&x_ptr);CHKERRQ(ierr);
ierr = ComputeSensiP(lambda[0],mu[0],&ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DM da; /* structured grid topology object */
TS ts; /* time-stepping object (contains snes) */
SNES snes; /* Newton solver object */
Vec X,residual; /* solution, residual */
Mat J; /* Jacobian matrix */
PetscInt Mx,My,fsteps,steps;
ISColoring iscoloring;
PetscReal tstart,tend,ftime,secperday=3600.0*24.0,Y0;
PetscBool fdflg = PETSC_FALSE, mfileflg = PETSC_FALSE, optflg = PETSC_FALSE;
char mfile[PETSC_MAX_PATH_LEN] = "out.m";
MatFDColoring matfdcoloring;
PorousCtx user; /* user-defined work context */
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = DMDACreate2d(PETSC_COMM_WORLD,
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, // correct for zero Dirichlet
DMDA_STENCIL_STAR, // nonlinear diffusion but diffusivity
// depends on soln W not grad W
-21,-21, // default to 20x20 grid but override with
// -da_grid_x, -da_grid_y (or -da_refine)
PETSC_DECIDE,PETSC_DECIDE, // num of procs in each dim
2, // dof = 2: node = (W,Y)
// or node = (P,dPsqr)
// or node = (ddxE,ddyN)
1, // s = 1 (stencil extends out one cell)
PETSC_NULL,PETSC_NULL, // no specify proc decomposition
&da);CHKERRQ(ierr);
ierr = DMSetApplicationContext(da,&user);CHKERRQ(ierr);
/* get Vecs and Mats for this grid */
ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr);
ierr = VecDuplicate(X,&residual);CHKERRQ(ierr);
ierr = VecDuplicate(X,&user.geom);CHKERRQ(ierr);
ierr = DMGetMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
/* set up contexts */
tstart = 10.0 * secperday; /* 10 days in seconds */
tend = 30.0 * secperday;
steps = 20;
Y0 = 1.0; /* initial value of Y, for computing initial
value of P; note Ymin = 0.1 is different */
user.da = da;
ierr = DefaultContext(&user);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,
"","options to (W,P)-space better hydrology model alt","");CHKERRQ(ierr);
{
ierr = PetscOptionsReal("-alt_sigma","nonlinear power","",
user.sigma,&user.sigma,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Ymin",
"min capacity thickness (esp. in pressure computation)","",
user.Ymin,&user.Ymin,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Wmin",
"min water amount (esp. in pressure computation)","",
user.Wmin,&user.Wmin,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Y0",
"constant initial capacity thickness","",
Y0,&Y0,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Cmelt",
"additional coefficient for amount of melt","",
user.Cmelt,&user.Cmelt,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Creep",
"creep closure coefficient","",
user.Creep,&user.Creep,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_L","half-width of square region in meters","",
user.L,&user.L,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_tstart_days","start time in days","",
tstart/secperday,&tstart,&optflg);CHKERRQ(ierr);
if (optflg) { tstart *= secperday; }
ierr = PetscOptionsReal("-alt_tend_days","end time in days","",
tend/secperday,&tend,&optflg);CHKERRQ(ierr);
if (optflg) { tend *= secperday; }
ierr = PetscOptionsInt("-alt_steps","number of timesteps to take","",
steps,&steps,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-alt_converge_check",
"run silent and check for convergence",
"",user.run_silent,&user.run_silent,PETSC_NULL);
CHKERRQ(ierr);
ierr = PetscOptionsString("-mfile",
"name of Matlab file to write results","",
mfile,mfile,PETSC_MAX_PATH_LEN,&mfileflg);
CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* fix remaining parameters */
ierr = DerivedConstants(&user);CHKERRQ(ierr);
ierr = VecStrideSet(user.geom,0,user.H0);CHKERRQ(ierr); /* H(x,y) = H0 */
ierr = VecStrideSet(user.geom,1,0.0);CHKERRQ(ierr); /* b(x,y) = 0 */
ierr = DMDASetUniformCoordinates(da, // square domain
-user.L, user.L, -user.L, user.L, 0.0, 1.0);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
user.dx = 2.0 * user.L / (Mx-1);
user.dy = 2.0 * user.L / (My-1);
/* setup TS = timestepping object */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,residual,RHSFunction,&user);CHKERRQ(ierr);
/* use coloring to compute rhs Jacobian efficiently */
ierr = PetscOptionsGetBool(PETSC_NULL,"-fd",&fdflg,PETSC_NULL);CHKERRQ(ierr);
if (fdflg){
ierr = DMGetColoring(da,IS_COLORING_GLOBAL,MATAIJ,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,
(PetscErrorCode (*)(void))RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,J,J,TSDefaultComputeJacobianColor,
matfdcoloring);CHKERRQ(ierr);
} else { /* default case */
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&user);CHKERRQ(ierr);
}
/* set initial state: W = barenblatt, P = pi (W/Y0)^sigma */
ierr = InitialState(da,&user,tstart,Y0,X);CHKERRQ(ierr);
/* set up times for time-stepping */
ierr = TSSetInitialTimeStep(ts,tstart,
(tend - tstart) / (PetscReal)steps);CHKERRQ(ierr);
ierr = TSSetDuration(ts,steps,tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MyTSMonitor,&user,PETSC_NULL);CHKERRQ(ierr);
/* Set SNESVI type and supply upper and lower bounds. */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESVISetComputeVariableBounds(snes,FormPositivityBounds);
CHKERRQ(ierr);
/* ask user to finalize settings */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* report on setup */
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"setup done: square side length = %.3f km\n"
" grid Mx,My = %d,%d\n"
" spacing dx,dy = %.3f,%.3f m\n"
" times tstart:dt:tend = %.3f:%.3f:%.3f days\n",
2.0 * user.L / 1000.0, Mx, My, user.dx, user.dy,
tstart / secperday, (tend-tstart)/(steps*secperday), tend / secperday);
CHKERRQ(ierr);
}
if (mfileflg) {
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"writing initial W,P and geometry H,b to Matlab file %s ...\n",
mfile);CHKERRQ(ierr);
}
ierr = print2vecmatlab(da,X,"W_init","P_init",mfile,PETSC_FALSE);CHKERRQ(ierr);
ierr = print2vecmatlab(da,user.geom,"H","b",mfile,PETSC_TRUE);CHKERRQ(ierr);
}
/* run time-stepping with implicit steps */
ierr = TSSolve(ts,X,&ftime);CHKERRQ(ierr);
/* make a report on run and final state */
ierr = TSGetTimeStepNumber(ts,&fsteps);CHKERRQ(ierr);
if ((!user.run_silent) && (ftime != tend)) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"***WARNING3***: reported final time wrong: ftime(=%.12e) != tend(=%.12e) (days)\n",
ftime / secperday, tend / secperday);CHKERRQ(ierr); }
if ((!user.run_silent) && (fsteps != steps)) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"***WARNING4***: reported number of steps wrong: fsteps(=%D) != steps(=%D)\n",
fsteps, steps);CHKERRQ(ierr); }
if (mfileflg) {
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"writing final fields to %s ...\n",mfile);CHKERRQ(ierr);
}
ierr = print2vecmatlab(da,X,"W_final","P_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
ierr = printfigurematlab(da,2,"W_init","W_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
ierr = printfigurematlab(da,3,"P_init","P_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
}
if (user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "%6d %6d %9.3f %.12e\n",
Mx, My, (tend-tstart)/secperday, user.maxrnorm);CHKERRQ(ierr);
}
/* Free work space. */
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fdflg) { ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr); }
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&user.geom);CHKERRQ(ierr);
ierr = VecDestroy(&residual);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
PetscFunctionReturn((PetscInt)(user.not_converged_warning));
}
int main(int argc,char **argv)
{
TS ts; /* time integrator */
TSAdapt adapt;
Vec X; /* solution vector */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps,ncells,xs,xm,i;
PetscErrorCode ierr;
PetscReal ftime,dt;
char chemfile[PETSC_MAX_PATH_LEN] = "chem.inp",thermofile[PETSC_MAX_PATH_LEN] = "therm.dat";
struct _User user;
TSConvergedReason reason;
PetscBool showsolutions = PETSC_FALSE;
char **snames,*names;
Vec lambda; /* used with TSAdjoint for sensitivities */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Chemistry solver options","");CHKERRQ(ierr);
ierr = PetscOptionsString("-chem","CHEMKIN input file","",chemfile,chemfile,sizeof(chemfile),NULL);CHKERRQ(ierr);
ierr = PetscOptionsString("-thermo","NASA thermo input file","",thermofile,thermofile,sizeof(thermofile),NULL);CHKERRQ(ierr);
user.pressure = 1.01325e5; /* Pascal */
ierr = PetscOptionsReal("-pressure","Pressure of reaction [Pa]","",user.pressure,&user.pressure,NULL);CHKERRQ(ierr);
user.Tini = 1550;
ierr = PetscOptionsReal("-Tini","Initial temperature [K]","",user.Tini,&user.Tini,NULL);CHKERRQ(ierr);
user.diffus = 100;
ierr = PetscOptionsReal("-diffus","Diffusion constant","",user.diffus,&user.diffus,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-draw_solution","Plot the solution for each cell","",showsolutions,&showsolutions,NULL);CHKERRQ(ierr);
user.diffusion = PETSC_TRUE;
ierr = PetscOptionsBool("-diffusion","Have diffusion","",user.diffusion,&user.diffusion,NULL);CHKERRQ(ierr);
user.reactions = PETSC_TRUE;
ierr = PetscOptionsBool("-reactions","Have reactions","",user.reactions,&user.reactions,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = TC_initChem(chemfile, thermofile, 0, 1.0);TCCHKERRQ(ierr);
user.Nspec = TC_getNspec();
user.Nreac = TC_getNreac();
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,-1,user.Nspec+1,1,NULL,&user.dm);CHKERRQ(ierr);
ierr = DMDAGetInfo(user.dm,NULL,&ncells,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
user.dx = 1.0/ncells; /* Set the coordinates of the cell centers; note final ghost cell is at x coordinate 1.0 */
ierr = DMDASetUniformCoordinates(user.dm,0.0,1.0,0.0,1.0,0.0,1.0);CHKERRQ(ierr);
/* set the names of each field in the DMDA based on the species name */
ierr = PetscMalloc1((user.Nspec+1)*LENGTHOFSPECNAME,&names);CHKERRQ(ierr);
ierr = PetscStrcpy(names,"Temp");CHKERRQ(ierr);
TC_getSnames(user.Nspec,names+LENGTHOFSPECNAME);CHKERRQ(ierr);
ierr = PetscMalloc1((user.Nspec+2),&snames);CHKERRQ(ierr);
for (i=0; i<user.Nspec+1; i++) snames[i] = names+i*LENGTHOFSPECNAME;
snames[user.Nspec+1] = NULL;
ierr = DMDASetFieldNames(user.dm,(const char * const *)snames);CHKERRQ(ierr);
ierr = PetscFree(snames);CHKERRQ(ierr);
ierr = PetscFree(names);CHKERRQ(ierr);
ierr = DMCreateMatrix(user.dm,&J);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user.dm,&X);CHKERRQ(ierr);
ierr = PetscMalloc3(user.Nspec+1,&user.tchemwork,PetscSqr(user.Nspec+1),&user.Jdense,user.Nspec+1,&user.rows);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,user.dm);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSARKIMEXSetType(ts,TSARKIMEX4);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,J,J,FormRHSJacobian,&user);CHKERRQ(ierr);
ftime = 1.0;
maxsteps = 10000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,X);CHKERRQ(ierr);
dt = 1e-10; /* Initial time step */
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,1e-12,1e-4);CHKERRQ(ierr); /* Also available with -ts_adapt_dt_min/-ts_adapt_dt_max */
ierr = TSSetMaxSNESFailures(ts,-1);CHKERRQ(ierr); /* Retry step an unlimited number of times */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Pass information to graphical monitoring routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (showsolutions) {
ierr = DMDAGetCorners(user.dm,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
for (i=xs;i<xs+xm;i++) {
ierr = MonitorCell(ts,&user,i);CHKERRQ(ierr);
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set final conditions for sensitivities
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(user.dm,&lambda);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,&lambda,NULL);CHKERRQ(ierr);
ierr = VecSetValue(lambda,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(lambda);CHKERRQ(ierr);
ierr = VecAssemblyEnd(lambda);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve ODE
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %g after %D steps\n",TSConvergedReasons[reason],(double)ftime,steps);CHKERRQ(ierr);
{
Vec max;
const char * const *names;
PetscInt i;
const PetscReal *bmax;
ierr = TSMonitorEnvelopeGetBounds(ts,&max,NULL);CHKERRQ(ierr);
if (max) {
ierr = TSMonitorLGGetVariableNames(ts,&names);CHKERRQ(ierr);
if (names) {
ierr = VecGetArrayRead(max,&bmax);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Species - maximum mass fraction\n");CHKERRQ(ierr);
for (i=1; i<user.Nspec; i++) {
if (bmax[i] > .01) {ierr = PetscPrintf(PETSC_COMM_SELF,"%s %g\n",names[i],bmax[i]);CHKERRQ(ierr);}
}
ierr = VecRestoreArrayRead(max,&bmax);CHKERRQ(ierr);
}
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
TC_reset();
ierr = DMDestroy(&user.dm);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&lambda);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFree3(user.tchemwork,user.Jdense,user.rows);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec x; /* solution */
PetscErrorCode ierr;
DM da;
AppCtx appctx;
Vec lambda[1];
PetscScalar *x_ptr;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
PetscFunctionBeginUser;
appctx.D1 = 8.0e-5;
appctx.D2 = 4.0e-5;
appctx.gamma = .024;
appctx.kappa = .06;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,DM_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,65,65,PETSC_DECIDE,PETSC_DECIDE,2,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMSetFromOptions(da);CHKERRQ(ierr);
ierr = DMSetUp(da);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"v");CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA; then duplicate for remaining
vectors that are the same types
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&appctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,&appctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = InitialConditions(da,x);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/*
Have the TS save its trajectory so that TSAdjointSolve() may be used
*/
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,PETSC_DEFAULT,2000.0);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.0001);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve ODE system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Start the Adjoint model
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDuplicate(x,&lambda[0]);CHKERRQ(ierr);
/* Reset initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&x_ptr);CHKERRQ(ierr);
ierr = InitializeLambda(da,lambda[0],0.5,0.5);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,lambda,NULL);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
AppCtx appctx; /* user-defined application context */
TS ts; /* timestepping context */
Vec U; /* approximate solution vector */
PetscErrorCode ierr;
PetscReal dt;
DM da;
PetscInt M;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program and set problem parameters
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
appctx.a = 1.0;
appctx.d = 0.0;
ierr = PetscOptionsGetScalar(NULL,"-a",&appctx.a,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(NULL,"-d",&appctx.d,NULL);CHKERRQ(ierr);
appctx.upwind = PETSC_TRUE;
ierr = PetscOptionsGetBool(NULL,"-upwind",&appctx.upwind,NULL);CHKERRQ(ierr);
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_PERIODIC, -60, 1, 1,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create vector data structures
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create vector data structures for approximate and exact solutions
*/
ierr = DMCreateGlobalVector(da,&U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
/*
For linear problems with a time-dependent f(U,t) in the equation
u_t = f(u,t), the user provides the discretized right-hand-side
as a time-dependent matrix.
*/
ierr = TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,&appctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSMatrixHeat,&appctx);CHKERRQ(ierr);
ierr = TSSetSolutionFunction(ts,(PetscErrorCode (*)(TS,PetscReal,Vec,void*))Solution,&appctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize timestepping solver:
- Set timestepping duration info
Then set runtime options, which can override these defaults.
For example,
-ts_max_steps <maxsteps> -ts_final_time <maxtime>
to override the defaults set by TSSetDuration().
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDAGetInfo(da,PETSC_IGNORE,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
dt = .48/(M*M);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,1000,100.0);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/*
Evaluate initial conditions
*/
ierr = InitialConditions(ts,U,&appctx);CHKERRQ(ierr);
/*
Run the timestepping solver
*/
ierr = TSSolve(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
PetscScalar *u;
AppCtx app;
PetscInt direction[2];
PetscBool terminate[2];
PetscBool rhs_form=PETSC_FALSE,hist=PETSC_TRUE;
TSAdapt adapt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
app.nbounces = 0;
app.maxbounces = 10;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex40 options","");CHKERRQ(ierr);
ierr = PetscOptionsInt("-maxbounces","","",app.maxbounces,&app.maxbounces,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_adapthistory","","",hist,&hist,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set ODE routines
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
/* Users are advised against the following branching and code duplication.
For problems without a mass matrix like the one at hand, the RHSFunction
(and companion RHSJacobian) interface is enough to support both explicit
and implicit timesteppers. This tutorial example also deals with the
IFunction/IJacobian interface for demonstration and testing purposes. */
ierr = PetscOptionsGetBool(NULL,NULL,"-rhs-form",&rhs_form,NULL);CHKERRQ(ierr);
if (rhs_form) {
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,NULL);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,NULL);CHKERRQ(ierr);
} else {
Mat A; /* Jacobian matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,NULL);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,IJacobian,NULL);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr);
ierr = VecSetSizes(U,n,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetUp(U);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,30.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,0.1);CHKERRQ(ierr);
/* The adapative time step controller could take very large timesteps resulting in
the same event occuring multiple times in the same interval. A maximum step size
limit is enforced here to avoid this issue. */
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
/* Set directions and terminate flags for the two events */
direction[0] = -1; direction[1] = -1;
terminate[0] = PETSC_FALSE; terminate[1] = PETSC_TRUE;
ierr = TSSetEventHandler(ts,2,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
if (hist) { /* replay following history */
TSTrajectory tj;
PetscReal tf,t0,dt;
app.nbounces = 0;
ierr = TSGetTime(ts,&tf);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,tf);CHKERRQ(ierr);
ierr = TSSetStepNumber(ts,0);CHKERRQ(ierr);
ierr = TSRestartStep(ts);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetType(adapt,TSADAPTHISTORY);CHKERRQ(ierr);
ierr = TSGetTrajectory(ts,&tj);CHKERRQ(ierr);
ierr = TSAdaptHistorySetTrajectory(adapt,tj,PETSC_FALSE);CHKERRQ(ierr);
ierr = TSAdaptHistoryGetStep(adapt,0,&t0,&dt);CHKERRQ(ierr);
/* this example fails with single (or smaller) precision */
#if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL__FP16)
ierr = TSAdaptSetType(adapt,TSADAPTBASIC);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
#endif
ierr = TSSetTime(ts,t0);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
ierr = TSResetTrajectory(ts);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec x; /* solution, residual vectors */
Mat A; /* Jacobian matrix */
Mat Jacp; /* JacobianP matrix */
PetscInt steps;
PetscReal ftime =0.5;
PetscBool monitor = PETSC_FALSE;
PetscScalar *x_ptr;
PetscMPIInt size;
struct _n_User user;
PetscErrorCode ierr;
Vec lambda[2],mu[2];
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,NULL,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
user.mu = 1;
user.next_output = 0.0;
ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr);
ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr);
ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr);
ierr = MatSetUp(Jacp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetDuration(ts,PETSC_DEFAULT,ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
if (monitor) {
ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2; x_ptr[1] = 0.66666654321;
ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.001);CHKERRQ(ierr);
/*
Have the TS save its trajectory so that TSAdjointSolve() may be used
*/
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,steps,(double)ftime);CHKERRQ(ierr);
ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Start the Adjoint model
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&lambda[1],NULL);CHKERRQ(ierr);
/* Reset initial conditions for the adjoint integration */
ierr = VecGetArray(lambda[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 1.0; x_ptr[1] = 0.0;
ierr = VecRestoreArray(lambda[0],&x_ptr);CHKERRQ(ierr);
ierr = VecGetArray(lambda[1],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0; x_ptr[1] = 1.0;
ierr = VecRestoreArray(lambda[1],&x_ptr);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(Jacp,&mu[1],NULL);CHKERRQ(ierr);
ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr);
ierr = VecGetArray(mu[1],&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 0.0;
ierr = VecRestoreArray(mu[1],&x_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,2,lambda,mu);CHKERRQ(ierr);
/* Set RHS Jacobian for the adjoint integration */
ierr = TSSetRHSJacobian(ts,A,A,RHSJacobian,&user);CHKERRQ(ierr);
/* Set RHS JacobianP */
ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&user);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(mu[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&Jacp);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&lambda[1]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[1]);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt time_steps=100,iout,NOUT=1;
PetscMPIInt size;
Vec global;
PetscReal dt,ftime,ftime_original;
TS ts;
PetscViewer viewfile;
Mat J = 0;
Vec x;
Data data;
PetscInt mn;
PetscBool flg;
MatColoring mc;
ISColoring iscoloring;
MatFDColoring matfdcoloring = 0;
PetscBool fd_jacobian_coloring = PETSC_FALSE;
SNES snes;
KSP ksp;
PC pc;
PetscViewer viewer;
char pcinfo[120],tsinfo[120];
TSType tstype;
PetscBool sundials;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* set data */
data.m = 9;
data.n = 9;
data.a = 1.0;
data.epsilon = 0.1;
data.dx = 1.0/(data.m+1.0);
data.dy = 1.0/(data.n+1.0);
mn = (data.m)*(data.n);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* set initial conditions */
ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr);
ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr);
ierr = VecSetFromOptions(global);CHKERRQ(ierr);
ierr = Initial(global,&data);CHKERRQ(ierr);
ierr = VecDuplicate(global,&x);CHKERRQ(ierr);
/* create timestep context */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUNDIALS)
ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr);
#else
ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr);
#endif
dt = 0.1;
ftime_original = data.tfinal = 1.0;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr);
ierr = TSSetSolution(ts,global);CHKERRQ(ierr);
/* set user provided RHSFunction and RHSJacobian */
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr);
if (!flg) {
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr);
} else {
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr);
if (fd_jacobian_coloring) { /* Use finite differences with coloring */
/* Get data structure of J */
PetscBool pc_diagonal;
ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr);
if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */
PetscInt rstart,rend,i;
PetscScalar zero=0.0;
ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr);
}
/* create coloring context */
ierr = MatColoringCreate(J,&mc);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else { /* Use finite differences (slow) */
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
}
/* Pick up a Petsc preconditioner */
/* one can always set method or preconditioner during the run time */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
/* Test TSSetPostStep() */
ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr);
if (flg) {
ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
}
ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr);
for (iout=1; iout<=NOUT; iout++) {
ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr);
ierr = TSSolve(ts,global);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr);
}
/* Interpolate solution at tfinal */
ierr = TSGetSolution(ts,&global);CHKERRQ(ierr);
ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr);
if (flg) { /* print solution into a MATLAB file */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = VecView(global,viewfile);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr);
}
/* display solver info for Sundials */
ierr = TSGetType(ts,&tstype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr);
if (sundials) {
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr);
ierr = TSView(ts,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr);
ierr = PCView(pc,viewer);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* free the memories */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
ierr = PetscFinalize();
return 0;
}
/*
* time_step solves for the time_dependence of the system
* that was previously setup using the add_to_ham and add_lin
* routines. Solver selection and parameters can be controlled via PETSc
* command line options. Default solver is TSRK3BS
*
* Inputs:
* Vec x: The density matrix, with appropriate inital conditions
* double dt: initial timestep. For certain explicit methods, this timestep
* can be changed, as those methods have adaptive time steps
* double time_max: the maximum time to integrate to
* int steps_max: max number of steps to take
*/
void time_step(Vec x, PetscReal init_time, PetscReal time_max,PetscReal dt,PetscInt steps_max){
PetscViewer mat_view;
TS ts; /* timestepping context */
PetscInt i,j,Istart,Iend,steps,row,col;
PetscScalar mat_tmp;
PetscReal tmp_real;
Mat AA;
PetscInt nevents,direction;
PetscBool terminate;
operator op;
int num_pop;
double *populations;
Mat solve_A,solve_stiff_A;
PetscLogStagePop();
PetscLogStagePush(solve_stage);
if (_lindblad_terms) {
if (nid==0) {
printf("Lindblad terms found, using Lindblad solver.\n");
}
solve_A = full_A;
if (_stiff_solver) {
if(nid==0) printf("ERROR! Lindblad-stiff solver untested.");
exit(0);
}
} else {
if (nid==0) {
printf("No Lindblad terms found, using (more efficient) Schrodinger solver.\n");
}
solve_A = ham_A;
solve_stiff_A = ham_stiff_A;
if (_num_time_dep&&_stiff_solver) {
if(nid==0) printf("ERROR! Schrodinger-stiff + timedep solver untested.");
exit(0);
}
}
/* Possibly print dense ham. No stabilization is needed? */
if (nid==0) {
/* Print dense ham, if it was asked for */
if (_print_dense_ham){
FILE *fp_ham;
fp_ham = fopen("ham","w");
if (nid==0){
for (i=0;i<total_levels;i++){
for (j=0;j<total_levels;j++){
fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j]));
}
fprintf(fp_ham,"\n");
}
}
fclose(fp_ham);
for (i=0;i<total_levels;i++){
free(_hamiltonian[i]);
}
free(_hamiltonian);
_print_dense_ham = 0;
}
}
/* Remove stabilization if it was previously added */
if (stab_added){
if (nid==0) printf("Removing stabilization...\n");
/*
* We add 1.0 in the 0th spot and every n+1 after
*/
if (nid==0) {
row = 0;
for (i=0;i<total_levels;i++){
col = i*(total_levels+1);
mat_tmp = -1.0 + 0.*PETSC_i;
MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES);
}
}
}
MatGetOwnershipRange(solve_A,&Istart,&Iend);
/*
* Explicitly add 0.0 to all diagonal elements;
* this fixes a 'matrix in wrong state' message that PETSc
* gives if the diagonal was never initialized.
*/
//if (nid==0) printf("Adding 0 to diagonal elements...\n");
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_A,i,i,mat_tmp,ADD_VALUES);
}
if(_stiff_solver){
MatGetOwnershipRange(solve_stiff_A,&Istart,&Iend);
for (i=Istart;i<Iend;i++){
mat_tmp = 0 + 0.*PETSC_i;
MatSetValue(solve_stiff_A,i,i,mat_tmp,ADD_VALUES);
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*
* Create the timestepping solver and set various options *
*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* Create timestepping solver context
*/
TSCreate(PETSC_COMM_WORLD,&ts);
TSSetProblemType(ts,TS_LINEAR);
/*
* Set function to get information at every timestep
*/
if (_ts_monitor!=NULL){
TSMonitorSet(ts,_ts_monitor,_tsctx,NULL);
}
/*
* Set up ODE system
*/
TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL);
if(_stiff_solver) {
/* TSSetIFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
if(nid==0) printf("Using stiff solver - TSROSW\n");
}
if(_num_time_dep+_num_time_dep_lin) {
for(i=0;i<_num_time_dep;i++){
tmp_real = 0.0;
_add_ops_to_mat_ham(tmp_real,solve_A,_time_dep_list[i].num_ops,_time_dep_list[i].ops);
}
for(i=0;i<_num_time_dep_lin;i++){
tmp_real = 0.0;
_add_ops_to_mat_lin(tmp_real,solve_A,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops);
}
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (nid==0) printf("Matrix Assembled.\n");
MatDuplicate(solve_A,MAT_COPY_VALUES,&AA);
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
TSSetRHSJacobian(ts,AA,AA,_RHS_time_dep_ham_p,NULL);
} else {
/* Tell PETSc to assemble the matrix */
MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY);
if (_stiff_solver){
MatAssemblyBegin(solve_stiff_A,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(solve_stiff_A,MAT_FINAL_ASSEMBLY);
/* TSSetIJacobian(ts,solve_stiff_A,solve_stiff_A,TSComputeRHSJacobianConstant,NULL); */
if (nid==0) {
printf("Stiff solver not implemented!\n");
exit(0);
}
}
if (nid==0) printf("Matrix Assembled.\n");
TSSetRHSJacobian(ts,solve_A,solve_A,TSComputeRHSJacobianConstant,NULL);
}
/* Print information about the matrix. */
PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view);
PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO);
/* PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_MATLAB); */
/* MatView(solve_A,mat_view); */
/* PetscInt ncols; */
/* const PetscInt *cols; */
/* const PetscScalar *vals; */
/* for(i=0;i<total_levels*total_levels;i++){ */
/* MatGetRow(solve_A,i,&ncols,&cols,&vals); */
/* for (j=0;j<ncols;j++){ */
/* if(PetscAbsComplex(vals[j])>1e-5){ */
/* printf("%d %d %lf %lf\n",i,cols[j],vals[j]); */
/* } */
/* } */
/* MatRestoreRow(solve_A,i,&ncols,&cols,&vals); */
/* } */
if(_stiff_solver){
MatView(solve_stiff_A,mat_view);
}
PetscViewerPopFormat(mat_view);
PetscViewerDestroy(&mat_view);
TSSetTimeStep(ts,dt);
/*
* Set default options, can be changed at runtime
*/
TSSetMaxSteps(ts,steps_max);
TSSetMaxTime(ts,time_max);
TSSetTime(ts,init_time);
TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
if (_stiff_solver) {
TSSetType(ts,TSROSW);
} else {
TSSetType(ts,TSRK);
TSRKSetType(ts,TSRK3BS);
}
/* If we have gates to apply, set up the event handler. */
if (_num_quantum_gates > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QG_EventFunction,_QG_PostEventFunction,NULL);
}
if (_num_circuits > 0) {
nevents = 1; //Only one event for now (did we cross a gate?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_QC_EventFunction,_QC_PostEventFunction,NULL);
}
if (_discrete_ec > 0) {
nevents = 1; //Only one event for now (did we cross an ec step?)
direction = -1; //We only want to count an event if we go from positive to negative
terminate = PETSC_FALSE; //Keep time stepping after we passed our event
/* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate,
* a function to check event status, a function to apply events, private data context.
*/
TSSetEventHandler(ts,nevents,&direction,&terminate,_DQEC_EventFunction,_DQEC_PostEventFunction,NULL);
}
/* if (_lindblad_terms) { */
/* nevents = 1; //Only one event for now (did we cross a gate?) */
/* direction = 0; //We only want to count an event if we go from positive to negative */
/* terminate = PETSC_FALSE; //Keep time stepping after we passed our event */
/* TSSetEventHandler(ts,nevents,&direction,&terminate,_Normalize_EventFunction,_Normalize_PostEventFunction,NULL); */
/* } */
TSSetFromOptions(ts);
TSSolve(ts,x);
TSGetStepNumber(ts,&steps);
num_pop = get_num_populations();
populations = malloc(num_pop*sizeof(double));
get_populations(x,&populations);
/* if(nid==0){ */
/* printf("Final populations: "); */
/* for(i=0;i<num_pop;i++){ */
/* printf(" %e ",populations[i]); */
/* } */
/* printf("\n"); */
/* } */
/* PetscPrintf(PETSC_COMM_WORLD,"Steps %D\n",steps); */
/* Free work space */
TSDestroy(&ts);
if(_num_time_dep+_num_time_dep_lin){
MatDestroy(&AA);
}
free(populations);
PetscLogStagePop();
PetscLogStagePush(post_solve_stage);
return;
}
int main(int argc,char **argv)
{
TS ts; /* timestepping context */
Vec x,r; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
AppCtx user; /* user-defined work context */
PetscInt its,N; /* iterations for convergence */
PetscErrorCode ierr;
PetscReal param_max = 6.81,param_min = 0.,dt;
PetscReal ftime;
PetscMPIInt size;
PetscInitialize(&argc,&argv,NULL,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
if (size != 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This is a uniprocessor example only");
user.mx = 4;
user.my = 4;
user.param = 6.0;
/*
Allow user to set the grid dimensions and nonlinearity parameter at run-time
*/
PetscOptionsGetInt(NULL,"-mx",&user.mx,NULL);
PetscOptionsGetInt(NULL,"-my",&user.my,NULL);
N = user.mx*user.my;
dt = .5/PetscMax(user.mx,user.my);
PetscOptionsGetReal(NULL,"-param",&user.param,NULL);
if (user.param >= param_max || user.param <= param_min) SETERRQ(PETSC_COMM_SELF,1,"Parameter is out of range");
/*
Create vectors to hold the solution and function value
*/
ierr = VecCreateSeq(PETSC_COMM_SELF,N,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
/*
Create matrix to hold Jacobian. Preallocate 5 nonzeros per row
in the sparse matrix. Note that this is not the optimal strategy; see
the Performance chapter of the users manual for information on
preallocating memory in sparse matrices.
*/
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,N,N,5,0,&J);CHKERRQ(ierr);
/*
Create timestepper context
*/
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
/*
Tell the timestepper context where to compute solutions
*/
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/*
Provide the call-back for the nonlinear function we are
evaluating. Thus whenever the timestepping routines need the
function they will call this routine. Note the final argument
is the application context used by the call-back functions.
*/
ierr = TSSetRHSFunction(ts,NULL,FormFunction,&user);CHKERRQ(ierr);
/*
Set the Jacobian matrix and the function used to compute
Jacobians.
*/
ierr = TSSetRHSJacobian(ts,J,J,FormJacobian,&user);CHKERRQ(ierr);
/*
Form the initial guess for the problem
*/
ierr = FormInitialGuess(x,&user);
/*
This indicates that we are using pseudo timestepping to
find a steady state solution to the nonlinear problem.
*/
ierr = TSSetType(ts,TSPSEUDO);CHKERRQ(ierr);
/*
Set the initial time to start at (this is arbitrary for
steady state problems); and the initial timestep given above
*/
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/*
Set a large number of timesteps and final duration time
to insure convergence to steady state.
*/
ierr = TSSetDuration(ts,1000,1.e12);
/*
Use the default strategy for increasing the timestep
*/
ierr = TSPseudoSetTimeStep(ts,TSPseudoTimeStepDefault,0);CHKERRQ(ierr);
/*
Set any additional options from the options database. This
includes all options for the nonlinear and linear solvers used
internally the the timestepping routines.
*/
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
/*
Perform the solve. This is where the timestepping takes place.
*/
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
/*
Get the number of steps
*/
ierr = TSGetTimeStepNumber(ts,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Number of pseudo timesteps = %D final time %4.2e\n",its,(double)ftime);CHKERRQ(ierr);
/*
Free the data structures constructed above
*/
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
AppCtx appctx; /* user-defined application context */
PetscErrorCode ierr;
PetscInt i, xs, xm, ind, j, lenglob;
PetscReal x, *wrk_ptr1, *wrk_ptr2;
MatNullSpace nsp;
PetscMPIInt size;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program and set problem parameters
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscFunctionBegin;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
/*initialize parameters */
appctx.param.N = 10; /* order of the spectral element */
appctx.param.E = 10; /* number of elements */
appctx.param.L = 4.0; /* length of the domain */
appctx.param.mu = 0.01; /* diffusion coefficient */
appctx.initial_dt = 5e-3;
appctx.param.steps = PETSC_MAX_INT;
appctx.param.Tend = 4;
ierr = PetscOptionsGetInt(NULL,NULL,"-N",&appctx.param.N,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-E",&appctx.param.E,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-Tend",&appctx.param.Tend,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&appctx.param.mu,NULL);CHKERRQ(ierr);
appctx.param.Le = appctx.param.L/appctx.param.E;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (appctx.param.E % size) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_WRONG,"Number of elements must be divisible by number of processes");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create GLL data structures
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscGLLCreate(appctx.param.N,PETSCGLL_VIA_LINEARALGEBRA,&appctx.SEMop.gll);CHKERRQ(ierr);
lenglob = appctx.param.E*(appctx.param.N-1);
/*
Create distributed array (DMDA) to manage parallel grid and vectors
and to set up the ghost point communication pattern. There are E*(Nl-1)+1
total grid values spread equally among all the processors, except first and last
*/
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,lenglob,1,1,NULL,&appctx.da);CHKERRQ(ierr);
ierr = DMSetFromOptions(appctx.da);CHKERRQ(ierr);
ierr = DMSetUp(appctx.da);CHKERRQ(ierr);
/*
Extract global and local vectors from DMDA; we use these to store the
approximate solution. Then duplicate these for remaining vectors that
have the same types.
*/
ierr = DMCreateGlobalVector(appctx.da,&appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.grid);CHKERRQ(ierr);
ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.mass);CHKERRQ(ierr);
ierr = DMDAGetCorners(appctx.da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr);
ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
xs=xs/(appctx.param.N-1);
xm=xm/(appctx.param.N-1);
/*
Build total grid and mass over entire mesh (multi-elemental)
*/
for (i=xs; i<xs+xm; i++) {
for (j=0; j<appctx.param.N-1; j++) {
x = (appctx.param.Le/2.0)*(appctx.SEMop.gll.nodes[j]+1.0)+appctx.param.Le*i;
ind=i*(appctx.param.N-1)+j;
wrk_ptr1[ind]=x;
wrk_ptr2[ind]=.5*appctx.param.Le*appctx.SEMop.gll.weights[j];
if (j==0) wrk_ptr2[ind]+=.5*appctx.param.Le*appctx.SEMop.gll.weights[j];
}
}
ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix data structure; set matrix evaluation routine.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMSetMatrixPreallocateOnly(appctx.da, PETSC_TRUE);CHKERRQ(ierr);
ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.stiff);CHKERRQ(ierr);
ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.grad);CHKERRQ(ierr);
/*
For linear problems with a time-dependent f(u,t) in the equation
u_t = f(u,t), the user provides the discretized right-hand-side
as a time-dependent matrix.
*/
ierr = RHSMatrixLaplaciangllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.stiff,appctx.SEMop.stiff,&appctx);CHKERRQ(ierr);
ierr = RHSMatrixAdvectiongllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.grad,appctx.SEMop.grad,&appctx);CHKERRQ(ierr);
/*
For linear problems with a time-dependent f(u,t) in the equation
u_t = f(u,t), the user provides the discretized right-hand-side
as a time-dependent matrix.
*/
ierr = MatDuplicate(appctx.SEMop.stiff,MAT_COPY_VALUES,&appctx.SEMop.keptstiff);CHKERRQ(ierr);
/* attach the null space to the matrix, this probably is not needed but does no harm */
ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.stiff,nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.keptstiff,nsp);CHKERRQ(ierr);
ierr = MatNullSpaceTest(nsp,appctx.SEMop.stiff,NULL);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr);
/* attach the null space to the matrix, this probably is not needed but does no harm */
ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr);
ierr = MatSetNullSpace(appctx.SEMop.grad,nsp);CHKERRQ(ierr);
ierr = MatNullSpaceTest(nsp,appctx.SEMop.grad,NULL);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr);
/* Create the TS solver that solves the ODE and its adjoint; set its options */
ierr = TSCreate(PETSC_COMM_WORLD,&appctx.ts);CHKERRQ(ierr);
ierr = TSSetProblemType(appctx.ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(appctx.ts,TSRK);CHKERRQ(ierr);
ierr = TSSetDM(appctx.ts,appctx.da);CHKERRQ(ierr);
ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr);
ierr = TSSetTimeStep(appctx.ts,appctx.initial_dt);CHKERRQ(ierr);
ierr = TSSetMaxSteps(appctx.ts,appctx.param.steps);CHKERRQ(ierr);
ierr = TSSetMaxTime(appctx.ts,appctx.param.Tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(appctx.ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetTolerances(appctx.ts,1e-7,NULL,1e-7,NULL);CHKERRQ(ierr);
ierr = TSSetSaveTrajectory(appctx.ts);CHKERRQ(ierr);
ierr = TSSetFromOptions(appctx.ts);CHKERRQ(ierr);
ierr = TSSetRHSFunction(appctx.ts,NULL,RHSFunction,&appctx);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(appctx.ts,appctx.SEMop.stiff,appctx.SEMop.stiff,RHSJacobian,&appctx);CHKERRQ(ierr);
/* Set Initial conditions for the problem */
ierr = TrueSolution(appctx.ts,0,appctx.dat.curr_sol,&appctx);CHKERRQ(ierr);
ierr = TSSetSolutionFunction(appctx.ts,(PetscErrorCode (*)(TS,PetscReal,Vec,void *))TrueSolution,&appctx);CHKERRQ(ierr);
ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr);
ierr = TSSetStepNumber(appctx.ts,0);CHKERRQ(ierr);
ierr = TSSolve(appctx.ts,appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.stiff);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.keptstiff);CHKERRQ(ierr);
ierr = MatDestroy(&appctx.SEMop.grad);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.SEMop.grid);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.SEMop.mass);CHKERRQ(ierr);
ierr = VecDestroy(&appctx.dat.curr_sol);CHKERRQ(ierr);
ierr = PetscGLLDestroy(&appctx.SEMop.gll);CHKERRQ(ierr);
ierr = DMDestroy(&appctx.da);CHKERRQ(ierr);
ierr = TSDestroy(&appctx.ts);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return ierr;
}
/*
FormFunctionGradient - Evaluates the function and corresponding gradient.
Input Parameters:
tao - the Tao context
X - the input vector
ptr - optional user-defined context, as set by TaoSetObjectiveAndGradientRoutine()
Output Parameters:
f - the newly evaluated function
G - the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec IC,PetscReal *f,Vec G,void *ctx)
{
User user = (User)ctx;
TS ts;
PetscScalar *x_ptr,*y_ptr;
PetscErrorCode ierr;
PetscScalar *ic_ptr;
ierr = VecCopy(IC,user->x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,user);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set time
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetTime(ts,0.0);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.001);CHKERRQ(ierr);
ierr = TSSetDuration(ts,2000,0.5);CHKERRQ(ierr);
ierr = TSSetTolerances(ts,1e-7,NULL,1e-7,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Save trajectory of solution so that TSAdjointSolve() may be used
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSolve(ts,user->x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&user->ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&user->steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %.6f, steps %D, ftime %g\n",(double)user->mu,user->steps,(double)user->ftime);CHKERRQ(ierr);
ierr = VecGetArray(IC,&ic_ptr);CHKERRQ(ierr);
ierr = VecGetArray(user->x,&x_ptr);CHKERRQ(ierr);
*f = (x_ptr[0]-user->x_ob[0])*(x_ptr[0]-user->x_ob[0])+(x_ptr[1]-user->x_ob[1])*(x_ptr[1]-user->x_ob[1]);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Observed value y_ob=[%f; %f], ODE solution y=[%f;%f], Cost function f=%f\n",(double)user->x_ob[0],(double)user->x_ob[1],(double)x_ptr[0],(double)x_ptr[1],(double)(*f));CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Redet initial conditions for the adjoint integration */
ierr = VecGetArray(user->lambda[0],&y_ptr);CHKERRQ(ierr);
y_ptr[0] = 2.*(x_ptr[0]-user->x_ob[0]);
y_ptr[1] = 2.*(x_ptr[1]-user->x_ob[1]);
ierr = VecRestoreArray(user->lambda[0],&y_ptr);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,user->lambda,NULL);CHKERRQ(ierr);
/* Set RHS Jacobian for the adjoint integration */
ierr = TSSetRHSJacobian(ts,user->A,user->A,RHSJacobian,user);CHKERRQ(ierr);
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
ierr = VecCopy(user->lambda[0],G);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec u,r; /* solution, residual vector */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps = 1000; /* iterations for convergence */
PetscErrorCode ierr;
DM da;
PetscReal ftime,dt;
AppCtx user; /* user-defined work context */
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,-8,-8,PETSC_DECIDE,PETSC_DECIDE,
1,1,NULL,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&r);CHKERRQ(ierr);
/* Initialize user application context */
user.c = -30.0;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,r,RHSFunction,&user);CHKERRQ(ierr);
/* Set Jacobian */
ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,NULL);CHKERRQ(ierr);
ftime = 1.0;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(da,u,&user);CHKERRQ(ierr);
dt = .01;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,u);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
TS ts; /* time-stepping context */
Vec x; /* State vector */
Mat J; /* Jacobian matrix */
AppCtx user; /* user-defined context */
PetscErrorCode ierr;
PetscReal ftime;
PetscInt its;
PetscMPIInt size;
PetscInitialize(&argc, &argv, NULL, help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);
if(size != 1) SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP, "This is a uniprocessor example only");
/*
* Allow user to set the grid dimensions and the equations parameters
*/
user.nb_cells = 50;
user.alpha = 10.;
user.beta = 1.;
user.rho_a = 1.;
user.rho_h = 2.;
user.mu_a = 2.;
user.mu_h = 3.;
user.D_a = 0.;
user.D_h = 30.;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD, "", "Problem settings", "PROBLEM");
ierr = PetscOptionsInt("-nb_cells", "Number of cells", "ex42.c",user.nb_cells, &user.nb_cells,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha", "Autocatalysis factor", "ex42.c",user.alpha, &user.alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-beta", "Inhibition factor", "ex42.c",user.beta, &user.beta,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-rho_a", "Default production of the activator", "ex42.c",user.rho_a, &user.rho_a,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-mu_a", "Degradation rate of the activator", "ex42.c",user.mu_a, &user.mu_a,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-D_a", "Diffusion rate of the activator", "ex42.c",user.D_a, &user.D_a,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-rho_h", "Default production of the inhibitor", "ex42.c",user.rho_h, &user.rho_h,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-mu_h", "Degradation rate of the inhibitor", "ex42.c",user.mu_h, &user.mu_h,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-D_h", "Diffusion rate of the inhibitor", "ex42.c",user.D_h, &user.D_h,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
ierr = PetscPrintf(PETSC_COMM_WORLD, "nb_cells: %D\n", user.nb_cells);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "alpha: %5.5g\n", user.alpha);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "beta: %5.5g\n", user.beta);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "rho_a: %5.5g\n", user.rho_a);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "mu_a: %5.5g\n", user.mu_a);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "D_a: %5.5g\n", user.D_a);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "rho_h: %5.5g\n", user.rho_h);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "mu_h: %5.5g\n", user.mu_h);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "D_h: %5.5g\n", user.D_h);CHKERRQ(ierr);
/*
* Create vector to hold the solution
*/
ierr = VecCreateSeq(PETSC_COMM_WORLD, 2*user.nb_cells, &x);CHKERRQ(ierr);
/*
* Create time-stepper context
*/
ierr = TSCreate(PETSC_COMM_WORLD, &ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts, TS_NONLINEAR);CHKERRQ(ierr);
/*
* Tell the time-stepper context where to compute the solution
*/
ierr = TSSetSolution(ts, x);CHKERRQ(ierr);
/*
* Allocate the jacobian matrix
*/
ierr = MatCreateSeqAIJ(PETSC_COMM_WORLD, 2*user.nb_cells, 2*user.nb_cells, 4, 0, &J);CHKERRQ(ierr);
/*
* Provide the call-back for the non-linear function we are evaluating.
*/
ierr = TSSetRHSFunction(ts, NULL, RHSFunction, &user);CHKERRQ(ierr);
/*
* Set the Jacobian matrix and the function user to compute Jacobians
*/
ierr = TSSetRHSJacobian(ts, J, J, RHSJacobian, &user);CHKERRQ(ierr);
/*
* Set the function checking the domain
*/
ierr = TSSetFunctionDomainError(ts, &DomainErrorFunction);CHKERRQ(ierr);
/*
* Initialize the problem with random values
*/
ierr = FormInitialState(x, &user);CHKERRQ(ierr);
/*
* Read the solver type from options
*/
ierr = TSSetType(ts, TSPSEUDO);CHKERRQ(ierr);
/*
* Set a large number of timesteps and final duration time to insure
* convergenge to steady state
*/
ierr = TSSetDuration(ts, 5000, 1e12);
/*
* Set a larger number of potential errors
*/
ierr = TSSetMaxStepRejections(ts, 50);CHKERRQ(ierr);
/*
* Also start with a very small dt
*/
ierr = TSSetTimeStep(ts, 0.05);CHKERRQ(ierr);
/*
* Set a larger time step increment
*/
ierr = TSPseudoSetTimeStepIncrement(ts, 1.5);CHKERRQ(ierr);
/*
* Let the user personalise TS
*/
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/*
* Set the context for the time stepper
*/
ierr = TSSetApplicationContext(ts, &user);CHKERRQ(ierr);
/*
* Setup the time stepper, ready for evaluation
*/
ierr = TSSetUp(ts);CHKERRQ(ierr);
/*
* Perform the solve.
*/
ierr = TSSolve(ts, x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts, &ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, "Number of time steps = %D, final time: %4.2e\nResult:\n\n", its, (double)ftime);CHKERRQ(ierr);
ierr = PrintSolution(x, &user);CHKERRQ(ierr);
/*
* Free the data structures
*/
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
