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; }
int Brusselator(int argc,char **argv,PetscInt cycle) { TS ts; /* nonlinear solver */ Vec X; /* solution, residual vectors */ Mat J; /* Jacobian matrix */ PetscInt steps,maxsteps,mx; PetscErrorCode ierr; DM da; PetscReal ftime,hx,dt,xmax,xmin; struct _User user; /* user-defined work context */ TSConvergedReason reason; PetscInitialize(&argc,&argv,(char*)0,help); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create distributed array (DMDA) to manage parallel grid and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,-11,2,2,NULL,&da);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Extract global vectors from DMDA; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr); /* Initialize user application context */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Advection-reaction options",""); { user.A = 1; user.B = 3; user.alpha = 0.1; user.uleft = 1; user.uright = 1; user.vleft = 3; user.vright = 3; ierr = PetscOptionsReal("-A","Reaction rate","",user.A,&user.A,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-B","Reaction rate","",user.B,&user.B,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-alpha","Diffusion coefficient","",user.alpha,&user.alpha,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-uleft","Dirichlet boundary condition","",user.uleft,&user.uleft,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-uright","Dirichlet boundary condition","",user.uright,&user.uright,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-vleft","Dirichlet boundary condition","",user.vleft,&user.vleft,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-vright","Dirichlet boundary condition","",user.vright,&user.vright,NULL);CHKERRQ(ierr); } ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetDM(ts,da);CHKERRQ(ierr); ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr); ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr); ftime = 1.0; maxsteps = 10000; ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr); ierr = TSSetSolution(ts,X);CHKERRQ(ierr); ierr = VecGetSize(X,&mx);CHKERRQ(ierr); hx = 1.0/(PetscReal)(mx/2-1); dt = 0.4 * PetscSqr(hx) / user.alpha; /* Diffusive stability limit */ dt *= PetscPowRealInt(0.2,cycle); /* Shrink the time step in convergence study. */ ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); ierr = TSSetTolerances(ts,1e-3*PetscPowRealInt(0.5,cycle),NULL,1e-3*PetscPowRealInt(0.5,cycle),NULL);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 = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr); ierr = VecMin(X,NULL,&xmin);CHKERRQ(ierr); ierr = VecMax(X,NULL,&xmax);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %g after % 3D steps. Range [%6.4f,%6.4f]\n",TSConvergedReasons[reason],(double)ftime,steps,(double)xmin,(double)xmax);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = VecDestroy(&X);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
/* 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); }
void PETSC_STDCALL tssettolerances_(TS ts,PetscReal *atol,Vec vatol,PetscReal *rtol,Vec vrtol, int *__ierr ){ *__ierr = TSSetTolerances( (TS)PetscToPointer((ts) ),*atol, (Vec)PetscToPointer((vatol) ),*rtol, (Vec)PetscToPointer((vrtol) )); }